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:

  1. Lege Wert A auf den Stack.
  2. Lege Wert B auf den Stack.
  3. Addiere die Werte und lege das Ergebnis auf den Stack
  4. Ziehe hiervon die Quadratwurzel und lege das Ergebnis wiederum auf den Stack.
  5. Lege Wert C auf den Stack.
  6. Multipliziere die Werte und lege das Ergebnis auf den Stack.
  7. 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:

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


Peter Hilbring
Links

Copyright-Bestimmungen: siehe Über diese Seite