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
Peter Hilbring