Infix- nach UPN-Konvertierung

Bei Klausuren und Prüfungsvorleistungen im Fach Datenverarbeitung wird häufig die Konvertierung einer größeren mathematischen Formel aus der gebräuchlichen Schreibweise (Infix-Notation) in eine maschinenverständliche UPN (umgekehrte polnische Notation) gefordert. Da das teilweise eine enorme Arbeit darstellt, die zum Schluß doch nur ein Taschenrechner/ Computer verstehen kann, dachte ich mir, wieso soll es nicht möglich sein, mir von einem Computer dabei helfen zu lassen?

Aber wofür kann man denn nun diese UPN gebrauchen? Nun, zuerst gibt es einige Taschenrechner auf dem Markt, die mit dieser Art von Befehlseingabe arbeiten. Des weiteren ist die UPN aber auch für Assembler-Programmierer interessant, die Berechnungen nicht über viele Register und Variablen, sondern über einen Stack durchführen wollen. Die UPN unterstützt das Stack-Konzept von Assembler. Ich möchte das mal an einem kleinen Beispiel zeigen.

Addieren zweier Zahlen:

Infix : A+B
UPN: AB +

Was bedeutet das nun? Ganz einfach, schauen wir uns doch mal die UPN genauer an. Zuerst legen wir den Wert A auf dem Stack ab, danach kommt der Wert B ebenfalls darauf. Das Plus-Zeichen besagt nun, daß die beiden Werte auf dem Stack addiert werden und das Ergebnis wieder auf den Stack kommt. Bei einem so einfachen Beispiel ist es wahrscheinlich noch nicht ersichtlich, wieso man eine UPN benutzen sollte. Deshalb hier noch ein Beispiel, das den Vorteil der UPN zeigen soll:

Infix : SQRT(A+B)*C
UPN: AB + SQRT C *

Erklärung:

Lege Wert A auf den Stack.
Lege Wert B auf den Stack.
Addiere die Werte und lege das Ergebnis auf den Stack
Ziehe hiervon die Quadratwurzel und lege das Ergebnis wiederum auf den Stack.
Lege Wert C auf den Stack.
Multipliziere die Werte und lege das Ergebnis auf den Stack.
Hole das Ergebnis der Formel vom Stack.

Wie man nun ganz deutlich sieht, benötigt diese komplizierte Formel in Assembler kein Register oder Variablen sondern kommt nur mit dem Stack aus. Aber wie erzeugt man nun eine UPN aus einer Infix-Notation? Auch das ist eigentlich einfach. Zuerst nimmt man nacheinander die Werte aus der Infix-Notation und untersucht, ob es sich um Zahlen, Variablen, Funktionen oder Klammern handelt. Wenn es sich um Zahlen oder Variablen handelt, werden sie sofort an die UPN angehängt. Klammern und Funktionen werden erstmal auf einem Stack zwischengespeichert, wobei die Funktionen noch gewichtet werden. Wenn eine Funktion mit einer kleineren Wertigkeit auf den Stack kommt, als die, die schon darauf liegt, wird die auf dem Stack befindliche Funktion an die UPN angehängt, andernfalls bleiben beide Funktionen auf dem Stack. Eine Klammer-auf wird auch auf dem Stack abgelegt. Bei einer Klammer-zu wird alles, was sich auf dem Stack befindet, bis zur nächsten Klammer-auf an die UPN angehängt. Zum Schluß wird der Rest des Stacks an die UPN angehängt [1], Das war schon alles.

Hier nochmal ein Beispiel:

Infix : (A+B)*C 
UPN:        Stack:
            (
A           (
A           ( +
AB          ( +
A B +
A B +       *
A B + C     *
A B + C     *

Nun möchte ich aber endlich zum Programm kommen. Nach dessen Start wird zuerst das Resourcefile gesucht. Wenn es nicht gefunden wird, meldet sich das Programm mit einer Textoberfläche, in der es auffordert, einen Ausdruck in Infix-Notation einzugeben. Dieser Ausdruck wird in die UPN überführt und ausgegeben. Wenn das Resourcefile gefunden wurde erscheint eine GEM-Dialogbox, die die Eingaben entgegennimmt und die UPN ausgibt. In dieser Programmversion wird auch das Clipboard unterstützt. Zuerst testet das Programm mit der Procedure SCRP_READ(SC_RPBUFF[1]), ob schon ein Clipboard-Pfad existiert. Wenn nicht, erzeugt das Programm auf Laufwerk A oder C einen Ordner \CLIPBRD und setzt mittels der Procedure SCRP_WRITE(SC_RPBUFF[1]) den Clipboard-Pfad auf diesen Ordner. Von nun an können Texte über das Clipboard ausgetauscht werden.

Eine denkbare Anwendung hierfür ist auch schon beim Erstellen dieses Artikels durchgeführt worden. Mein Programm wurde als Accessory geladen. Danach habe ich einen Editor gestartet und diesen Artikel geschrieben. Als ich für die obigen Beispiele eine Konvertierung in die UPN benötigte, habe ich den passenden Ausdruck in Infix-Notation geschrieben, selektiert und auf das Klemmbrett kopiert. Danach wurde das ACC aufgerufen und durch einen Mausklick auf die Eingabezeilen der Text aus dem Klemmbrett in mein Programm übernommen und in die UPN konvertiert. Durch einen anschließenden Mausklick auf das UPN-Ausgabefenster wurde die UPN in das Klemmbrett zurückkopiert. Nun zurück in den Editor und die UPN aus dem Klemmbrett in den Text übernommen. Das war es schon.

Falls es aus irgendeinem Grund nicht möglich sein sollte, den Clipboard-Pfad zu erzeugen, wird das Clipboard-Icon nicht dargestellt und die Clipboard-Funktionen natürlicherweise auch ausgeschlossen. Bei erfolgreich installiertem Clipboard-Pfad wird das Icon dargestellt und invertiert, falls sich eine Datei SCRAP.TXT im Clipboard befindet. Jetzt zu den einzelnen Listings. Listing 1 enthält die Deklaration von Typen, Konstanten und Variablen sowie die Prozeduren und Funktionen zur Behandlung des Objektbaumes. Einen besonderen Augenmerk möchte ich auf den Umgang mit TEDINFO-Strukturen in MAXON-Pascal legen. Dieses ist meines Wissens bisher noch in keiner Zeitschrift veröffentlicht worden. Listing 2 enthält die Standard-Prozeduren und Funktionen zum Öffnen und Schließen einer VDI-Workstation sowie zum Laden des Resourcefiles. Listing 3 enthält die eigentlichen Prozeduren und Funktionen zur Konvertierung von Infix nach UPN. Die Hauptprozedure MAKE_UPN erwartet als Eingabe einen String „Eingabe“, der den mathematischen Ausdruck in Infix-Notation enthält und entweder mit 0 oder CR/LF abgeschlossen sein muß. Als Ausgabe erhält man wieder einen String „UPN“, der die UPN enthält. Listing 4 enthält die Prozeduren und Funktionen zum Behandeln des Clipboards [2] Listing 5 ist in GfA-BASIC geschrieben und enthält die Werte, die zur Erzeugung des Resource-Files benötigt werden. In jeder Data-Zeile wird eine Prüfsumme berechnet und verglichen, um Eingabefehler auszuschließen. Sollte jedoch trotzdem mal ein Eingabefehler auftreten, gibt das Programm die fehlerhafte Zeile an. Zum Schluß speichert es die Datei UPN.RSC auf das aktuelle Laufwerk.

Vorschläge zur Erweiterung des Programms:

In der Konstanten „operator“ am Anfang von Listing 1 können weitere Funktionen eingetragen werden, die das Programm beim Konvertieren erkennen soll. Eventuell muß dann jedoch die Array-Grenze angepaßt werden.
Logische Funktionen wie AND, OR, NOT, XOR können auch ergänzt werden. Allerdings haben diese Funktionen, im Gegensatz zu den mathematischen, eine Wertigkeit wie +, -, * und /.
Als letztes besteht noch die Möglichkeit, eine EUPN anstelle der normalen UPN auszugeben. Was ist eine EUPN? Eigentlich eine ganz normale UPN, in der zusätzlich Konvertierungen von Integer- nach Real-Werten und umgekehrt besonders markiert werden. Wann treten solche Konvertierungen auf? Als einfachstes Beispiel nehmen wir die Funktion „/“ (Division). A und B sind Integer-Werte. Das Ergebnis der Division liefert aber einen Real-Wert.

Beispiel:

5/2=2.5

Damit als Ergebnis nicht nur der Vorkommawert geliefert wird, muß bei der Division eine Typenkonvertierung erfolgen. Nun jedoch viel Spaß mit diesem nützlichen Tool.

Literatur:

[1] Prof. Jäger, Manuskript zur Vorlesung ADV 1990/91 FH-Meschede 12] Jankowski, Reschke, Rabich,

Atan-ST-Profibuch, Sybex 1988

{***********************************}
{   INFIX ---> UPN-Notation V 1.0   }
{                                   }
{   Peter Hilbring                  }
{   Dietrich-Ottmarstraße 16        }
{   W-4782 Erwitte                  }
{                                   }
{ Programmiert in MAXON-PASCAL v1.5 } 
{ (c) 1992 MAXON-Computer           }
{***********************************}
{                                   }
{ Listing #1 : UPN.PAS              }
{                                   }
{ Deklaration und Objektverwaltung  }
{                                   }
{***********************************}

program infix_2_upn;

uses GemDecl, GemAES, GemVDI, Dos, Bios;

{$R-,S-,I-,F-,D-,V-}
{$M 10,5,200,20}

const
    DIAG    =  0; (* Formular/Dialog *)
    CALC    =  5; (* BUTTON in Baum DIAG *)
    CLIP    =  6; (* IMAGE in Baum DIAG *)
    CLEAR   =  7; (* BUTTON in Baum DIAG *)
    OK      =  8; (* BUTTON in Baum DIAG *)
    UPN_0   =  9; (* BOX in Baum DIAG *)
    UPN_1   = 11; (* STRING in Baum DIAG *)
    UPN_2   = 12; (* STRING in Baum DIAG *)
    UPN_3   = 13; (* STRING in Baum DIAG *)
    UPN_4   = 14; (* STRING in Baum DIAG *)
    UPN_MSK = 15; (* IBOX in Baum DIAG *)
    INF_1   = 16; (* FTEXT in Baum DIAG *)
    INF_2   = 17; (* FTEXT in Baum DIAG *)
    INF_MSK = 18; (* IBOX in Baum DIAG *)
    clr_str : string = { 40 Space }
  '                                        '#0; 
    operator: array[0..20] of string[10] =
                ('DIV','MOD','SQR','SQRT',
                 'TAN','SIN','COS','ATN', 
                 'ASIN','ACOS','###');

type
    c_strings packed array [0..255] of char; 
    string_ptr=^c_string;
    Ob_Type = G_BOX..G_TITLE; 
    rtedinfo= record
                te_ptext,
                te_ptmplt,
                te_pvalid : string_ptr; 
                te_font, 
                te_junk1, 
                te_just, 
                te_color, 
                te_junk2, 
                te_thickness, 
                te_txtlen, 
                te_tmplen : integer 
              end;
    riconblk= record
                ib_pmask,
                ib_pdata,
                ib_pcext : pointer;
                ib_char,
                ib_xchar,
                ib_ychar,
                ib_xicon,
                ib_yicon,
                ib_wicon,
                ib_hicon,
                ib_xtext,
                ib_ytext,
                ib_wtext,
                ib_htext : integer
              end;
    rbitblk = record
                bi_pdata : pointer;
                bi_wb,
                bi_hi,
                bi_x,
                bi_y,
                bi_color : integer
              end;
    rbfobspec= record
                character : char; 
                framesize : shortint; 
                color     : integer
             { color enthält folgende Daten: 
                Bit     Inhalt
                15-12   framecol 
                11-8    textcol 
                7       textmode
                6-4     fillpattern
                3-0     interiorcol }
              end;
    spec_info=record
                case Ob_Type of 
                    G_Text,
                    G_BoxText,
                    G_FText,
                    G_FBoxText: (tedinfo : ^rtedinfo); 
                    G_Icon    : (iconblk : ^riconblk); 
                    G_Image   : (bitblk  : ^rbitblk);
                    G_IBox,
                    G_BoxChar,
                    G_Box     : (bfobspec: ^rbfobspec);
                    G_UserDef,
                    G_Title,
                    G_Button,
                    G_String,
                    G_Title   : (str     : string_ptr)
                end;
    object = record
                    ob_next  : integer; 
                    ob_head  : integer; 
                    ob_tail  : integer; 
                    ob_type  : integer; 
                    ob_flags : integer; 
                    ob_state : integer; 
                    ob_spec  : spec_info; 
                    ob_x     : integer;
                    ob_y     : integer; 
                    ob_w     : integer;
                    ob_h     : integer
             end;
    tree    = array [0..50] of object; 
    treeptr = ^tree; 
    upn_rec = record
                cmd : array[0..160] of string[85]; 
                val : array[0..160] of shortint
              end;
    synt    = record
                flag    : boolean; 
                p, art  : shortint 
              end;

var
    upn_stack   : upn_rec; 
    eingabe     : string[85]; 
    upn         : string[165]; 
    start_pos   : integer;
    stack       : integer; 
    dummy       : char; 
    dialog_adr  : treeptr; 
    vdi_handle  : integer; 
    aes_handle  : integer; 
    charboxheight : integer; 
    old_sep     : shortint; 
    syntax      : synt; 
    acc_name    : string[15];
    msgbuf      : array_8; 
    menu_id     : integer; 
    dosdata     : searchrec; 
    sc_rpscrap  : dirstr; 
    x_res       : integer;
    y_res       : integer;
    err         : string;

{$I INIT_GEM.I} {GEM-Routinen            }
{$I UPN_HDL.I } {INFIX->UPN Konvertierung}
{$I SCRAP.I   } {CLIPBRD Behandlung      }

procedure syntax_error; 
var
    s : string[45); 
    p : shortint; 
begin
    s:='';
    for p :=1 to (syntax.p mod 40)-1 do 
        s:=s+#32;
    s:=s+'^';
    for p:=(syntax.p mod 40)+1 to 40 do 
        s:=s+#32; 
    s:=s+#0;
    move(s[1], dialog_adr^[UPN_1].ob_spec.str^,length(s)-1); 
    s:='        Syntax-Error in Zeile X';
    s:=s+'         '#0;
    s[31]:=chr(48+(syntax.p div 40)); 
    move(s[1], dialog_adr^[UPN_2].ob_spec.str^,length(s)-1);
    s:='';
    for p:=1 to 40 do 
        s:=s+#32; 
    s:=s+#0;
    move(s[1], dialog_adr^[UPN_4].ob_spec.str^, length(s)-q); 
    if (syntax.art<0) then
        s:='        Klammer auf fehlt!';
        s:=s+'              '#0;
    if (syntax.art>0) then
        s:='        Klammer zu fehlt!';
        s:=s+'               '#0;
    move(s[1], dialog_adr^[UPN_3].ob_spec.str^,length(s)-1);
    objc_draw(dialog_adr, UPN_0, $7fff, 0, 0, 0, 0)
end;

procedure make_eingabe; 
var
    s    : string[45];
    p    : integer;
    space: boolean; 
begin
    space:=false; 
    eingabe:=''; 
    s[0]:=#255;
    move(dialog_adr^[INF_1].ob_spec.tedinfo^_te_ptext^, s[1],dialog_adr^[INF_1].ob_spec .tedinfo^.te_txtlen); 
    s[0]:=chr(pos(#0,s); 
    for p:=1 to length(s) do
        if (s[p]<>#0) and (s[p]<>'@') then 
        begin
            if ((space=false) or ((s[p]<>#32) and (space=true))) then eingabe:=eingabe+s[p]; 
            if (s[p]=#32) then 
                space:=true
            else
                space:=false
        end; 
    s[0]:=#41;
    move(dialog_adr^[INF_2].ob_spec.tedinfo^.te_ptext^, s[1],dialog_adr^[INF_2].ob_spec.tedinfo^.te_txtlen); 
    for p:=1 to length(s) do
        if (s[p]<>#0) and (s[p]<>'@') then 
        begin
            if ((space=false) or ((s[p]<>#32) and (space=true))) then eingabe:=eingabe+s[p]; 
            if (s[p]=#32) then 
                space:=true
            else
                space:=false
        end;
    eingabe:=eingabe+#0;
    s:='@' ;
    for p:=0 to 39 do 
        s:=s+#0;
    move(s[1], dialog_adr^[INF_1].ob_spec.tedinfo^.te_ptext^,40); 
    move(s[1], dialog_adr^[INF_2].ob_spec.tedinfo^.te_ptext^,40); 
    if (length(eingabe) div 42=0) then
        move(eingabe[1], dialog_adr^[INF_1].ob_spec.tedinfo^.te_ptext^,length(eingabe)-1)
    else
    begin
        s:=copy(eingabe, 1, 40)+#0;
        move(s[1], dialog_adr^[INF_1].ob_spec.tedinfo^.te_ptext^, 40); 
        move(eingabe[41], dialog_adr^[INF_2].ob_spec.tedinfo^.te_ptext^,length(eingabe)-41)
    end;
    for p:=UPN_1 to UPN_4 do
        move(clr_str[1], dialog_adr^[p].ob_spec.str^, 40); 
        objc_draw(dialog_adr, INF_1, $7fff, 0, 0, 0, 0);
        objc_draw(dialog_adr, INF_2, $7fff, 0, 0, 0, 0); 
        objc_draw(dialog_adr, UPN_0, $7fff, 0, 0, 0, 0)
end;

procedure dialog; 
var
    x, y, w, h: integer;
    i, p      : integer;
    s         : string[45];
begin
    s:='@';
    for p:=0 to 39 do 
        s:=s+#0;
    move(s[1], dialog_adr^[INF_1].ob_spec.tedinfo^.te_ptext^, length(s)-1); 
    move(s[1], dialog_adr^[INF_2].ob_spec.tedinfo^.te_ptext^, length(s)-1); 
    for p:=UPN_1 to UPN_4 do
        move(clr_str[1], dialog_adr^[p].ob_spec.str^, 40); 
    form_center(dialog_adr, x, y, w, h); 
    form_dial(fmd_start, 0, 0, 0, 0, x, y, w, h); 
    form_dial(fmd_grow, 0, 0, 0, 0, x, y, w, h); 
    objc_draw(dialog_adr, DIAG, $7fff, x, y, w, h);
    repeat
        i:=form_do(dialog_adr, INF_1); 
        graf_mouse(BUSYBEE, NIL); 
        case i of
            INF_msk : if not(bittest(7, dialog_adr^[CLIP].ob_flags)) then clip_2_infix;
            UPN_msk : begin
                        if not(bittest(7, dialog_adr^[CLIP].ob_flags)) then upn_2_clip; 
                        if(check_clipbrd)then dialog_adr^[CLIP].ob.State:=SELECTED 
                        else
                            dialog_adr^[CLIP].ob_state:=NORMAL
                      end;
            CALC    : begin
                        make_eingabe;
                        if check_bracket then
                        begin
                            upn:=''; 
                            start_pos:=1;
                            stack:=0;
                            old_sep:=-1; 
                            syntax.flag:=true; 
                            syntax.p:=length(eingabe)-1; 
                            make.upn;
                            if ((syntax.flag)and (old_sep<>3) and (old_sep<>6))then 
                            begin
                                p:=0;
                                for p:=1 to length(upn) div 40 do 
                                begin
                                    s:=copy(upn, p*40-39, 40)+#0;
                                    move(s[1], dialog_adr^[UPN_1+p-1].ob_spec.str^,length(s)-1); 
                                end;
                                s:=copy(upn, p*40-s-1, length(upn) mod 40)+#0;
                                move(s[1], dialog_adr^[UPN_1+p].ob_spec.str^,length(s)-1); 
                                objc_draw(dialog_adr, UPN_0, $7fff,0, 0, 0, 0)
                            end
                            else
                                syntax_error
                        end
                        else
                            syntax_error
                      end;
            CLEAR   : begin
                        upn:=''; 
                        s:='@';
                        for p:=0 to 39 do
                            s:=S+#0;
                        move(s[1], dialog_adr^[INF_1].ob_spec, tedinfo^.te_ptext^, length(s)-1); 
                        objc_draw(dialog_adr, INF_1,$7fff,0,0,0,0); 
                        move(s[1], dialog_adr^[INF_2].ob_spec_tedinfo^.te_ptext^,length(s)-1);
                        objc_draw(dialog_adr,INF_2,$7fff,0,0,0,0); 
                        for p:=UPN_1 to UPN_4 do 
                            move(clr_str[1], dialog_adr^[p].ob_spec.str^, 40); 
                        objc_draw(dialog_adr, UPN_0,$7fff,0,0,0,0)
                      end
        end;
        dialog_adr^[i].ob_state:=dialog_adr^[i].ob_state xor SELECTED; 
        if ((i<>INF_msk) and (i<>UPN_msk)) then 
            objc_draw(dialog_adr,i,$7fff,x,y,w,h) 
        else
            objc_draw(dialog_adr,DIAG,$7fff,x,y,w,h); 
        graf_mouse(ARROW, NIL); 
    until i=OK;
    form_dial(fmd_shrink,0,0,0,0,x,y,w,h);
    form_dial(fmd_finish,0,0,0,0,x,y,w,h)
end;

begin
    if (init_gem) then 
    begin
        graf_mouse(ARROW, NIL);
        if (init_resource('UPN.RSC'#0)) then
        begin
            rsrc_gaddr(r_tree,DIAG,dialog_adr); 
            if((x_res<dialog_adr^[DIAG].ob_w) or (y_res<dialog_adr^[DIAG].ob_h)) then 
            begin
                err:='Die Auflösung|ist für '; 
                err:=err+'dieses|Programm zu '; 
                err:=err+'gering'; 
                fatal_error(err) 
            end;
            if (init_clipbrd=false) then
                dialog_adr^[CLIP].ob_flags:=HIDETREE
            else
            begin
                dialog_adr^[CLIP].ob_flags:= NONE;
                if (check_clipbrd) then
                    dialog_adr^[CLIP].ob_state:= SELECTED
                else
                    dialog_adr^[CLIP].ob_state:= NORMAL
            end;
            upn:='';
            if (appflag) then 
            begin
                dialog; 
                rsrc_free; 
                end_gem
            end
            else
            begin
                acc_name:='  INFIX->UPN'#0; 
                menu_id:=menu_register(aes_handle,acc_name[1]); 
                while true do 
                begin
                    evnt_mesag(msgbuf); 
                    if ((msgbuf[0]=ac_open) and (msgbuf[4]=menu_id))then dialog
                end
            end
        end
        else
        begin
            if (appflag) then 
                tos_eingabe
            else
            begin
                end_gem;
                err:='|Kein Resourcefile '; 
                err:=err+'gefunden'; 
                fatal_error(err)
            end
        end
    end
    else
    begin
        err:='Ich konnte GEM nicht | '; 
        err:=err+'ordnungsgemäß '; 
        err:=err+'initialisieren'; 
        fatal_error(err)
    end
end.

Listing 1: Hauptprogramm

{***********************************}
{   INFIX ---> UPN-Notation V 1.0   }
{                                   }
{   Peter Hilbring                  }
{   Dietrich-Ottmarstraße 16        }
{   W-4782 Erwitte                  }
{                                   }
{ Programmiert in MAXON-PASCAL v1.5 } 
{ (c) 1992 MAXON-Computer           }
{***********************************}
{                                   }
{ Listing #2 : INIT_GEM.I           }
{                                   }
{ Initialisierung des GEM           }
{                                   }
{***********************************}


procedure fatal_error(msg : string); 
var
    s : integer; 
begin
    msg:='[3]['+msg+'][ ENDE ]'#0; 
    s:=form_alert(1,msg[1]); 
    if (appflag) then 
        halt(0)
    else
        while true do
            evnt_mesag(msgbuf)
end;

function init_gem : boolean; 
var
    workin  : intin_array; 
    workout : workout_array; 
    dummy   : integer; 
begin
    aes_handle:=appl_init; 
    if (aes_handle>=0) then 
    begin
        vdi_handle:=graf_handle(dummy, dummy, charboxheight, dummy); 
        for dummy:=0 to 9 do 
            workin[dummy]:=1; 
        workin[10]:=2;
        v_opnvwk(workin, vdi_handle, workout); 
        x_res:=workout[0]+1; 
        y_res:=workout[1]+1
    end;
    init_gem:=aes_handle>=0
end;

procedure end_gem; 
begin
    v_clsvwk(vdi_handle); 
    appl_exit
end;

function init_resource(resourcename : string): boolean;
begin
    shel_find(resourcename); 
    rsrc_load(resourcename[1]); 
    if (gemerror=0) then
        init_resource:=false
    else
        init_resource:=true
end;

Listing 2: GEM Initialisierung

{***********************************}
{   INFIX ---> UPN-Notation V 1.0   }
{                                   }
{   Peter Hilbring                  }
{   Dietrich-Ottmarstraße 16        }
{   W-4782 Erwitte                  }
{                                   }
{ Programmiert in MAXON-PASCAL v1.5 } 
{ (c) 1992 MAXON-Computer           }
{***********************************}
{                                   }
{ Listing #3 : UPN_HDL.I            }
{                                   }
{ Konvertierung von Infix nach UPN  }
{                                   }
{***********************************}


function upper(s : string) : string; 
var
    p : shortint; 
    o : string[85]; 
begin
    for p:=1 to length(s) do 
        o[p]:=upcase(s[p]); 
    o[0]:=s[0]; 
    upper:=o
end;

function is_operator(c : string) ; boolean; 
var
    flag : boolean; 
    p    : shortint; 
begin
    flag:=false;
    p:=0;
    repeat
        if (upper(c)=operator[p]) then flag:=true; 
        inc(p);
    until (flag=true) or (operator[p-1]='###'); 
    is_operator:=flag
end;

function get_sep(s : char) : shortint; 
begin
    case s of
        'O'..'9',
        '.'      : get_sep:=1;
        '_',
        'A'..'Z',
        'a'..'z' : get_sep:=2;
        '+', '-',
        '*', '/',
        '^'      : get_sep:=3;
        ')'      : get_sep:=4;
        '('      : get_sep:=5
    else
        get_sep:=0
    end;
end;

function check_bracket : boolean; 
var
    count : shortint; 
    p     : shortint; 
begin
    count:=0;
    p:=1;
    repeat
        if (eingabe[p]='(') then inc(count); 
        if (eingabe[p]=')') then dec(count); 
        inc(p);
    until (count<0) or (p>=length(eingabe)); 
    if (count=0) then
        check_bracket:=true
    else
    begin
        syntax.p:=p-1; 
        syntax.art:=count; 
        check_bracket:=false
    end
end;

procedure check_syntax(p, new_sep : shortint); 
begin
    case old_sep of
      -1 :  old_sep:=new_sep;
       1 :  begin                    { Zahlen }
                if (new_sep<>0) then 
                begin
                    old_sep:=new_sep; 
                    if ((new_sep<>3) and (new_sep<>4)) then syntax.flag:=false
                end
            end;
       2 :  begin                   { Variablen }
                if (new_sep<>0) then 
                begin
                    old_sep:=new_sep; 
                    if ((new_sep<>3) and (new_sep<>4)) then syntax.flag:=false
                end
            end;
       3 :  begin                   { + - * / ^ }
                if (new_sep<>0) then begin
                    old_sep:=new_sep; 
                    if ( (new_sep<>1) and (new_sep<>2) and (new_sep<>5) and (new_sep<>6)) then syntax.flag:=false
                end
            end;
       4 :  begin                   { Klammer zu }
                if (new_sep<>0) then 
                begin
                    old_sep:=new_sep; 
                    if ((new_sep<>3) and (new_sep<>4)) then syntax.flag:=false
                end
            end;
       5 :  begin                   { Klammer auf }
                if (new_sep<>0) then old_sep:=new_sep
            end;
       6 : begin                    { Funktionen }
                if (new_sep<>0) then 
                begin
                    old_sep:=new_sep; 
                    if (new_sep<>5) then 
                        syntax.flag:=false
                end
            end
    end;
    if ((syntax.flag=false) and (syntax.p=length(eingabe)-1)) then 
    begin
        syntax.p:=p; 
        syntax.art:=0
    end;
end;

procedure clear_upn; 
var
    p : integer; 
begin
    if (stack>0) then 
    begin
        for p:=stack downto 1 do 
        begin
            if (upn_stack.cmd[p]<>'###') then 
                upn:=upn+upn_stack.cmd[p]+' '
        end
    end;
    upn:=upn+upn_stack.cmd[0]; 
    for p:=0 to 160 do 
    begin
        upn_stack.cmd[p]:=''; 
        upn_stack.val[p]:=0
    end
end;

procedure fill_upn(sep, von, bis : shortint); 
var
    c   : string[85]; 
    cmd : string[85]; 
    wert: shortint; 
begin
    cmd:=copy(eingabe, von, bis-von+1); 
    if (sep=2) and (is_operator(cmd)) then 
        sep:=6;
    check_syntax(von, sep); 
    case sep of
        1 : upn:=upn+cmd+' ';   { Zahlen     }
        2 : upn:=upn+cmd+' ';   { Variablen  }
        3,                      { + - * / ^  }
        6 : begin               { Funktionen }
                case cmd[1] of
                    '+': wert:=3;
                    '-': wert:=3;
                    '*': wert:=2;
                    '/': wert:=2;
                    '^': wert: =2
                else
                    wert:=0
                end;
                if (stack=0) then 
                begin
                    upn_stack.cmd[stack]:=cmd; 
                    upn_stack.val[stack]:=wert; 
                    inc(stack)
                end
                else
                    if (wert>=upn_stack.val[stack-1]) then 
                    begin
                        upn:=upn+upn_stack.cmd[stack-1]+' ';
                        upn_stack.cmd[stack-1]:=cmd;
                        upn_stack.val[stack-1]:=wert
                    end
                    else
                    begin
                        upn_stack.cmd[stack]:=cmd; 
                        upn_stack.val[stack]:=wert;
                        inc(stack)
                    end
            end;
        4 : repeat          { Klammer zu }
                dec(stack);
                c:=upn_stack.cmd[stack]; 
                if (c<>'###') then 
                    upn:=upn+c+' ';
            until (c='###');
        5 : begin           { Klammer auf }
                upn_stack.cmd[stack]:='###'; 
                upn_stack.val[stack]:=5; 
                inc(stack)
            end
    end
end;

procedure make_upn; 
var
    c : char;
    p, old_sep, new_sep : shortint; 
begin
    if length(eingabe)>1 then 
    begin
        for p:=1 to length(eingabe)-1 do 
        begin
            c:=eingabe[p];
            old_sep:=get_sep(c); 
            c:=eingabe[p+1]; 
            new_sep:=get_sep(c); 
            if(((old_sep=4) and (new_sep=4)) or 
               ((old_sep=5) and (new_sep=5)) or 
               ((old_sep=3) and (new_sep=3)) or 
                (old_sep<>new _sep)) then 
            begin
                fill_upn(old_sep,start_pos,p); 
                start_pos:=p+1
            end
        end
    end
    else
    begin
        p:=1;
        c:=eingabe[p]; 
        new_sep:=get_sep(c)
    end;
    fill_upn(new_sep,start_pos,p); 
    clear_upn
end;

procedure tos_eingabe; 
var
    p   : integer; 
    ask : char; 
begin
    graf_mouse(M_OFF, NIL); 
    repeat
        write(chr(27),'E Infix nach UPN '); 
        writeln('Konverter');
        writeln('==========================');
        writeln('(p) 1992 von Peter Hilbring');
        write('             Dietrich-Ottmar ');
        writeln('Straße 16'); 
        writeln('             4782 Erwitte');
        write(' Geschrieben in MAXON-PASCAL '); 
        writeln('V 1.5');
        writeln(' für ST-COMPUTER-ESCHBORN'); 
        writeln;
        write('Infix: '); 
        read(eingabe); 
        eingabe:=eingabe+#0; 
        writeln;
        if check_bracket then 
        begin
            upn:='';
            start_pos:=1;
            stack:=0;
            old_sep:=-1;
            syntax.flag:=true;
            syntax.p:=length(eingabe)-1;
            make_upn;
            if((syntax.flagland(old_sep<>3)and (old sep<>6)) then 
            begin
                writeln(' UPN: '); 
                p:=0;
                for p:=1 to length(upn) div 40 do
                    writeln('       ',copy(upn,p*40-39, 40)); 
                writeln('      ',copy(upn,p*40+1, length(upn) mod 40))
            end
            else
                writeln('syntax_error')
        end
        else
            writeln('syntax_error'); 
        writeln;
        write('Noch einmal (J/N) ? '); 
        ask:=readkey; 
    until ((ask='n') or (ask='N')); 
    graf_mouse(M_ON, NIL)
end;

Listing 3: Konvertierungsunterprogramme


{***********************************}
{   INFIX ---> UPN-Notation V 1.0   }
{                                   }
{   Peter Hilbring                  }
{   Dietrich-Ottmarstraße 16        }
{   W-4782 Erwitte                  }
{                                   }
{ Programmiert in MAXON-PASCAL v1.5 } 
{ (c) 1992 MAXON-Computer           }
{***********************************}
{                                   }
{ Listing #4 : SCRAP.I              }
{                                   }
{ Routinen zur Clipboard-Verwaltung }
{                                   }
{***********************************}

function init_clipbrd : boolean; 
var
    p           : integer;
    akt_drive   : integer;
    path        : string;
    envdir      : string;
    drvbits     : longint absolute $04c2;
    new_drive   : integer;
    userstack   : pointer;
begin
    scrp_read(sc_rpscrap[1]);
    sc_rpscrap[0]:=#255;
    sc_rpscrap[0]:=chr(pos(#0,sc_rpscrap));
    if length(sc_rpscrap) = 1 then
    begin
        akt_drive := getdrive; 
        envdir:=getenv('CLIPBRD'); 
        if (length(envdir)>0) then 
            sc_rpscrap:=envdir
        else
        begin
            userstack:=super(nil); 
            if (bittest(2,_drvbits)) then 
                new_drive:=2
            else
                new_drive:=0; 
            userstack:=super(userstack); 
            sc_rpscrap := chr(new_drive+65)+':\CLIPBRD\'
        end;
        if(sc_rpscrap[length(sc_rpscrap)]<>'\') then 
            sc_rpscrap:=sc_rpscrap+'\'; 
        sc_rpscrap:=sc_rpscrap+#0; 
        scrp_write(sc_rpscrap[1]); 
        new_drive:=ord(sc_rpscrap[1])-65; 
        path:='';
        for p:=3 to length(sc_rpscrap)-2 do 
            path:=path+sc_rpscrap[p]; 
        setdrive(new_drive); 
        mkdir(path); 
        if ((doserror<E_OK) and (doserror<>EACCDN) ) then 
        begin
            sc_rpscrap:=#0; 
            scrp_write(sc_rpscrap[1])
        end
        else
        begin
            findfirst(path,Directory,dosdata);
            if (doserror<E_OK) then
            begin
                sc_rpscrap:=#0; 
                scrp_write(sc_rpscrap[1])
            end
        end;
        setdrive(akt_drive);
    end;
    scrp_read(sc_rpscrap[1]); 
    if (length(sc_rpscrap)>1) then 
        init_clipbrd:=true
    else
        init_clipbrd:=false
end;

function check_clipbrd : boolean; 
var
    akt_drive : integer; 
    new_drive : integer; 
begin
    scrp_read(sc_rpscrap[1]); 
    akt_drive:= getdrive; 
    new_drive:=ord(sc_rpscrap[1]); 
    if (new_drive>=97) then
        new_drive:=new_drive-32; 
    new_drive:=new_drive-65; 
    setdrive(new_drive); 
    chdir(sc_rpscrap);
    findfirst('SCRAP.TXT',AnyFile,dosdata); 
    if (doserror=E_OK) then 
        check_clipbrd:=true
    else
        check_clipbrd:=false
end;

procedure clip_2_infix; 
var
    textf     : text; 
    dir       : dirstr;
    akt_drive : integer; 
    new_drive : integer; 
    data      : string;
    dummy     : integer;
begin
    scrp_read(sc_rpscrap[1]); 
    akt_drive := getdrive; 
    new_drive:=ord(sc_rpscrap[1]); 
    if (new_drive>=97) then
        new_drive:=new_drive-32; 
    new_drive:=new_drive-65;
    setdrive(new_drive); 
    chdir(sc_rpscrap);
    findfirst('SCRAP.*',AnyFile,dosdata);
    if (doserror=E_OK) then
    begin
        reset(textf,dosdata.name); 
        if (ioresult=0) then 
        begin
            if not(eof(textf)) then
                readln(textf,data); 
            close(textf);
            eingabe:=copy(data,1,80)+#0; 
            if (length(eingabe) div 42=0) then 
                move (eingabe[1], dialog_adr^[INF_1].ob_spec.tedinfo^.te_ptext^, length (eingabe)-1)
            else
            begin
                data:=copy(eingabe, 1, 40)+#0; 
                move(data[1], dialog_adr^[INF_1].ob_spec.tedinfo^.te_ptext^, 40); 
                move(eingabe[41], dialog_adr^[INF_2].ob_spec.tedinfo^.te_ptext^, length (eingabe)-41)
            end;
            objc_draw(dialog_adr, INF_1, $7fff, 0, 0, 0, 0); 
            objc_draw(dialog_adr, INF_2, $7fff, 0, 0, 0, 0)
        end
        else
        begin
            err:='[Ärger mit dem Clipboard!'; 
            err:='[3]['+err+'][ ENDE ]'#0; 
            dummy:=form_alert(1, err[1])
        end
    end;
    chdir(dir); 
    setdrive(akt_drive)
end;

procedure upn_2_clip; 
var
    textf     : text; 
    dir       : dirstr;
    akt_drive : integer; 
    new_drive : integer; 
    dummy     : integer;
begin
    scrp_read(sc_rpscrap[1]); 
    akt_drive := getdrive; 
    new_drive:=ozd(sc_rpscrap[1]); 
    if (new_drive>= 97) then
        new_drive:=new_drive-32; 
    new_drive:=new_drive-65; 
    setdrive(new_drive); 
    chdir(sc_rpscrap); 
    mkdir('$$$');
    if ((doserror=E_OK)or(doserror=EACCDN))then 
    begin
        findfirst('SCRAP.*',AnyFile,dosdata);
        while (doserror=E_OK) do
        begin
            erase(dosdata.name); 
            findnext(dosdata)
        end;
        rewrite(textf,'SCRAP.TXT'); 
        if (ioresult=0) then 
        begin
            writeln(textf, upn); 
            close(textf);
        end
        else
        begin
            err:='Ärger mit dem Clipboard'; 
            err:='[3]['+err+'][ ENDE ]'#0; 
            dummy:=form_alert(1, err[1])
        end; 
        rmdir('$$$') 
        end;
        chdir(dir); 
        setdrive(akt_drive)
end;

Listing 4: Routinen zur Clipboardbehandlung


' Peter Hilbring 
' Dietrich-Ottmarstraße 16 
' W-4782 Erwitte
'
' Programmiert in GFA-BASIC V3.x 
' (c) 1992 MAXON-Computer
'
' Listing #5 : MAKE_RSC.LST
'
' Erzeugung von UPN.RSC aus den Data-Zeilen
'
DIM buffer|(1440) ! Buffer fur UPN.RSC
adr%=V:buffer|(0) ! Startadresse Buffer
FOR loop1=0 TO 89 ! Anzahl der Datazeilen
    chk=0
    FOR loop2=0 TO 7 ! Anzahl Daten/Zeile
        READ wert$ 
        wert=VAL(wert$)
        DPOKE (adr%+loop2*2+loop1*16),wert 
        chk=chk+wert 
    NEXT loop2
    READ chk$ ! Checksumme
    IF VAL(chk$)<>chk THEN
        PRINT "Fehler in der ";loop1+1;". DataZeile" 
        ~INP(2)
        END 
    ENDIF 
NEXT loop1
BSAVE "\UPN.RSC",adr%,1440 
END
'
' * Hexdump von UPN.RSC mit Pruefsumme
'
DATA $0,$28,$1F0,$298,$298,$2A6,$2A6,$4D4,$1168
DATA $4D4,$24,$13,$1,$6,$0,$1, $0,$513
DATA $0,$594,$0,$28,$FFFF,$1,$12,$ 14,$105E2
DATA $0,$10,$2,$1100,$0,$0,$35,$10,$1157
DATA $2,$FFFF,$FFFF,$15,$0,$0,$0,$1F0,$20205
DATA $C,$1,$1C,$1,$3,$FFFF,$FFFF,$15,$20040
DATA $0,$0,$0,$20C,$E,$2,$217,$1,$434
DATA $4,$FFFF,$FFFF,$15,$0,$0, $0,$228,$2023F
DATA $10,$3,$612,$1,$5,$FFFF,$FFFF,$15,$2063E
DATA $0,$0,$0,$244,$15,$4,$40A,$1,$668
DATA $6,$FFFF,$FFFF,$1A,$7,$20,$0,$2A6,$202EB
DATA $A,$E,$8,$1,$7,$FFFF,$FFFF,$17,$2003D
DATA $0,$0,$0,$298,$3,$80D,$6,$2,$AB0
DATA $8,$FFFF,$FFFF,$1A,$5,$20,$0,$2AB,$202F0
DATA $16,$E,$8,$1,$9,$FFFF,$FFFF,$1A,$2004E
DATA $5,$20,$0,$2B1,$29,$E,$8,$1,$316
DATA $10,$A,$F,$14,$0,$20,$FF,$1100,$125C
DATA $3,$9,$2F,$4,$B,$FFFF,$FFFF,$1C,$20064
DATA $0,$0,$0,$2B6,$0,$0,$7,$1,$2BE
DATA $C,$FFFF,$FFFF,$1C,$0,$0,$0,$2BE,$202E4
DATA $7,$0,$28,$i,$D,$FFFF,$FFFF,$1C,$20057
DATA $0,$0,$0,$2E7,$7,$1,$28,$1,$318
DATA $E,$FFFP,$FFFF,$1C,$0, $0,$0,$310,$20338
DATA $7,$2,$28,$1,$F,$FFFF,$FFFF,$1C,$2005B
DATA $0,$0,$0,$339,$7,$3,$28,$1,$36C
DATA $9,$FFFF,$FFFF,$19,$5, $0, $0, $1100,$21125
DATA $0,$0,$2F,$4,$11,$FFFF,$FFFF,$1D,$2005F
DATA $8,$0,$0,$260,$3,$6,$2F,$1,$2Al
DATA $12,$FFFF,$FFFF,$1D,$8, $0 , $0, $27C,$202B1
DATA $3,$7,$2F,$1,$0,$FFFF,$FFFF,$19,$20051
DATA $25,$0,$0,$1100,$3,$6,$2F,$2,$115F
DATA $0,$362,$0,$37F,$0,$380,$3,$6,$A6A
DATA $2,$1180,$0,$FFFF,$1D,$1,$0,$381,$11520
DATA $0,$3A1,$0,$3A2,$5,$6,$2,$1180,$18D0
DATA $0,$FFFF,$20,$1,$0,$3A3,$0,$3BD,$10780
DATA $0,$3BE,$5,$6,$2,$1180,$0,$FFFF,$1154A
DATA $1A,$1,$0,$3BF,$0,$3CE,$0,$3CF,$B77
DATA $5,$6,$2,$1180,$0,$FFFF,$F,$1,$1119C
DATA $0,$3D0,$0,$3F9,$0,$429, $3, $6,$BFB
DATA $0,$1180,$0,$FFFF,$29,$30, $0,$452,$1162A
DATA $0,$47B,$0,$4AB,$3,$6, $0,$1180,$1AAF
DATA $0,$FFFF,$29,$30,$0,$4D4,$6,$20,$10552
DATA $0,$0,$1,$4361,$6C63,$43,$6C65,$6172,$17DDF
DATA $45,$6E64,$6500,$2020,$5550,$4E3A,$2000,2020,$1D773
DATA $2020,$2020,$2020,$2020,$2020,$2020,$2020,$2020,$10100
DATA $2020,$2020,$2020,$2020,$2020,$2020,$2020,$2020,$10100
DATA $2020,$2020,$2020,$20,$2020,$2020,$2020,$2020,$E100
DATA $2020,$2020,$2020,$2020,$2020,$2020,$2020,$2020,$10100
DATA $2020, $2020,$202 0,$2020,$2020,$2020,$2020, $2000,$100E0
DATA $2020, $202 0,$2020,$2020,$2020,$2020,$2020, $2020,$10100
DATA $2020,$2020,$2020,$2020,$2020,$2020,$2020, $2020,$10100
DATA $2020,$2020,$2020,$2020,$20,$2020,$2020, $2020,$E100
DATA $2020,$2020,$2020,$2020,$2020,$2020,$2020, $2020,$10100
DATA $2020, $2020,$2020, $2020,$2020, $2020, $2020, $2020,$10100
DATA $2000,$496E,$6669,$7820,$2D3E,$2055,$504E, $2043,$2061B
DATA $6F6E,$7665,$7274,$6572,$2056,$2031,$2E30, $0,$22C70
DATA $50,$726F,$6772,$616D,$6D69,$6572,$7420, $766F,$2F908
DATA $6E20,$5065,$7465,$7220,$4869,$6C62,$7269, $6E67,$33AA5
DATA $0, $69, $6E20,$4D41,$584F,$4E2D, $5041, $5343, $205CA
DATA $414C,$2056,$2031,$2E35,$2066,$8172,$0,$4D, $1522D
DATA $4158,$4F4E,$2043,$6F6D,$7075,$7465,$7200, $0,$27730
DATA $4020,$2020,$2020,$2020,$2020,$2020,$2020,$2020,$12100
DATA $2020,$2020,$2020,$2020,$2020,$2020,$2020, $2020,$10100
DATA $2020,$2020,$2020,$2020,$49,$4E46,$4958, $3A20,$15287
DATA $5F5F,$5F5F,$5F5F,$5F5F,$5F5F,$5F5F,$5F5F, $5?5F,$2FAF8
DATA $5F5F,$5F5F,$5F5F,$5F5F,$5F5F,$5F5F,$5F5F, $5F5F,$2FAF8
DATA $5F5F,$5F5F,$5F5F,$5F5F,$58,$5858,$5858, $5858,$286DC
DATA $5858,$5858,$5858,$5858,$5858,$5858,$5858, $5858,$2C2C0
DATA $5858,$5858,$5858,$5858,$5858,$5858,$5858, $5858,$2C2C0
DATA $5800,$4020,$2020,$2020,$2020,$2020,$2020, $2020,$158E0
DATA $2020,$2020,$2020,$2020,$2020,$2020,$2020, $2020,$10100
DATA $2020,$2020,$2020,$2020,$2020,$20,$2020, $2020,$E100
DATA $2020,$5F5F,$5F5F,$5F5F,$5F5F,$5F5F,$5F5F, $5F5F,$2BBB9
DATA $5F5F,$5F5F,$5F5F,$5F5F,$5F5F,$5F5F,$5F5F, $5F5F,$2FAF8
DATA $5F5F,$5F5F,$5F5F,$5F5F, $5F5F, $58, $5858, $5858,$28DE3
DATA $5858,$5858,$5858,$5858,$5858,$5858,$5858, $5858,$2C2C0
DATA $5858,$5858,$5858,$5858,$5858,$5858,$5858, $5858,$2C2C0
DATA $5858,$5800,$0,$0,$0,$3F,$FF00,$0,$1AF97 
DATA $FFE0,$1FF,$C000,$8010,$200,$6000,$8010, $200,$325FF
DATA $6000,$87F8,$7FC,$6000,$8407,$F804,$6000, $8400,$3AFFF
DATA $4,$6000,$84AE,$9004,$6000,$84AA,$D004, $6000,$38964
DATA $84AE,$B004,$6000,$84E8,$9004,$6000,$8400, $4,$38DA2
DATA $6000,$8400,$84,$6000,$8400,$44,$6000,$84FF, $2ADC7
DATA $FFE4,$6000,$8400,$44,$6000,$8400,$84,$6000, $328AC
DATA $8400,$4,$6000, $84E8,$B804,$6000,$8488,$A804,$3AD7C
DATA $6000,$8488,$B804,$6000,$84EE,$A004,$6000, $8400,$4057E
DATA $4,$6000,$8400, $4,$6000,$87FF,$FFFC,$6000, $32C03
DATA $8000,$0,$6000, $8000,$0,$6000,$8000,$0, $24000
DATA $6000,$FFFF,$FFFF,$E000,$FFFF,$FFFF,$C000, $0,$5FFFC
DATA $0,$0,$0,$0,$0,$0,$0,$0,$0

Listing 5: GFA-BASIC Listing für RSC-File