(*--------------------------------------------------------------------------- :Program. UPN.mod :Author. Philippe Gressly and John Bysäth :Address. Näfenhaus, CH-8926 Kappel a/Albis :Phone. :Shortcut. [Philu] :Version. 2.6 :Date. (7.) 1989 :Copyright. PD or Shareware (I like Shareware better). :Language. Modula-II :Translator. M2Amiga :Imports. RealConversions, NewMathLib :UpDate. 26.09.89 by JWE : Potenzierung fuer Polynome verbessert :UpDate. Neue Funktionen aus MathIEEEDoubTrans :Contents. Convert Strings to executable formulas. :Remark. This was a task at Zürich University :Remark. We wrote the programm first for Apple Macintosh II :Remark. 26.09.89 by JWE : Aenderungen zur Anpassung an Kurve V3.2 ---------------------------------------------------------------------------*) IMPLEMENTATION MODULE UPN; (* Juni 1989: John Bysäth, Philippe Gressly *) (*********** --- IMPORTS --- ***********) FROM Storage IMPORT ALLOCATE, DEALLOCATE; FROM Strings IMPORT Compare, Copy; FROM InOut IMPORT WriteString; FROM NewMathLib IMPORT ArEr, ArErType, SQRT, EXP, LN, LOG, FACT, SIGN, COS, SIN, TAN, ARCTAN, COSh, SINh, TANh, ARCCOSh, ARCSINh, ARCTANh, DegToRad, RadToDeg, ROUND, LTRUNC, ARCCOS, ARCSIN, ABSOLUTE, COTAN, ARCCOTAN; FROM SYSTEM IMPORT TSIZE, ADDRESS; FROM LRealConvert IMPORT StrToLReal; (*********** --- CONST, TYPES, VARS --- ***********) CONST MaxVars = 100; MaxVarLen = 15; MaxOpLen = 10; DefKonstLen = 4; NumDefKonst = 2; (* Pi und e im Moment nur *) MaxAtomLen = 23; MAXLONG = 1.0E308; TYPE AtomType = (Operator, Variable, Konst, Ende, Error); OpType = (Start, Neg, OpenPar, ClosePar, Add, Sub, Mult, Div, Pot, Sqroot, Cosinus, Sinus, Tan, arctan, Cosh, Sinh, Tanh, ArCosh, ArSinh, ArTanh, Sign, Facult, Expo, Logn, Log10, degtorad, radtodeg, Round, Ltrunc, Arccos, Arcsin, Abs, Cotan, Arccotan, NoOp); VarName = ARRAY [0..MaxVarLen] OF CHAR; AtomPtr = POINTER TO Atom; Atom = RECORD Pos: CARDINAL; Next: AtomPtr; CASE Atyp: AtomType OF Variable: Var: CARDINAL; | Konst : Value: LONGREAL; | Operator: Op : OpType; ELSE END END; MOLEKUL = RECORD Start, wo: AtomPtr END; UPN = POINTER TO Formel; BelegPtr = POINTER TO ARRAY[1..MaxVars] OF RECORD Name: VarName; Wert: LONGREAL END; Formel = RECORD UPN: MOLEKUL; NumVar, HighStack: CARDINAL; Belegung: BelegPtr; Stack: ARRAY [1..32000] OF LONGREAL END; (* Formel *) VAR Operatoren : ARRAY[Start..NoOp] OF RECORD Wort: ARRAY [0..MaxOpLen] OF CHAR; Prio: CARDINAL END; Konstanten: ARRAY [1..NumDefKonst] OF RECORD Wort: ARRAY[0..DefKonstLen] OF CHAR; Value: LONGREAL END; x,y,erg : LONGREAL; i : CARDINAL; (*********** --- HilfsProceduren --- ***********) PROCEDURE IsOperator(str: ARRAY OF CHAR): OpType; VAR op: OpType; BEGIN FOR op := OpenPar TO NoOp DO IF 0 = Compare(str,0, 32000, Operatoren[op].Wort, FALSE) THEN RETURN op END END; RETURN NoOp END IsOperator; PROCEDURE IsDefKonst(str: ARRAY OF CHAR): CARDINAL; VAR i: CARDINAL; BEGIN FOR i := 1 TO NumDefKonst DO IF 0 = Compare(str, 0, 32000, Konstanten[i].Wort, FALSE) THEN RETURN i END END; RETURN 0 END IsDefKonst; PROCEDURE Letter(ch: CHAR): BOOLEAN; BEGIN RETURN ("A" <= CAP(ch)) AND (CAP(ch) <= "Z") END Letter; PROCEDURE Ziffer(ch: CHAR): BOOLEAN; BEGIN RETURN ("0" <= ch) AND (ch <= "9") END Ziffer; PROCEDURE GetWort( str: ARRAY OF CHAR; StartPos: CARDINAL; VAR NewPos: CARDINAL; VAR GotStr: ARRAY OF CHAR); BEGIN NewPos := StartPos; IF (StartPos <= CARDINAL(HIGH(str))) AND (Letter(str[StartPos])) THEN WHILE (NewPos <= CARDINAL(HIGH(str))) AND (Letter(str[NewPos]) OR Ziffer(str[NewPos])) DO IF NewPos - StartPos <= CARDINAL(HIGH(GotStr)) THEN GotStr[NewPos - StartPos] := str[NewPos] END; INC(NewPos); END END; IF NewPos - StartPos <= CARDINAL(HIGH(GotStr)) THEN GotStr[NewPos - StartPos] := 0C END END GetWort; PROCEDURE CreateUPNList(VAR H: MOLEKUL); BEGIN H.Start := NIL; H.wo := NIL END CreateUPNList; PROCEDURE DeleteUPNList(VAR H: MOLEKUL); BEGIN WHILE H.Start # NIL DO H.wo := H.Start; H.Start := H.Start^.Next; DEALLOCATE(H.wo, TSIZE(Atom)); H.wo := NIL END END DeleteUPNList; PROCEDURE GetNext (VAR H: MOLEKUL; VAR a: Atom): BOOLEAN; BEGIN IF H.wo = NIL THEN RETURN FALSE END; a := H.wo^; H.wo := a.Next; RETURN TRUE END GetNext; PROCEDURE PushAtom (VAR H: MOLEKUL; a: Atom): BOOLEAN; VAR new: AtomPtr; BEGIN ALLOCATE(new, TSIZE(Atom)); IF new = NIL THEN RETURN FALSE END; new^ := a; new^.Next := NIL; IF H.Start = NIL THEN H.Start := new; H.wo := new ELSE H.wo^.Next := new; H.wo := new END; RETURN TRUE END PushAtom; PROCEDURE PopAtom (VAR H: MOLEKUL; VAR a: Atom): BOOLEAN; BEGIN H.wo := H.Start; IF H.wo = NIL THEN RETURN FALSE END; IF H.wo^.Next = NIL THEN a := H.wo^; DEALLOCATE(H.wo, TSIZE(Atom)); H.wo := NIL; H.Start := NIL; RETURN TRUE END; WHILE H.wo^.Next^.Next # NIL DO H.wo := H.wo^.Next END; a := H.wo^.Next^; DEALLOCATE(H.wo^.Next, TSIZE(Atom)); H.wo^.Next := NIL; RETURN TRUE END PopAtom; PROCEDURE TopPrio (VAR H: MOLEKUL): CARDINAL; BEGIN IF H.wo # NIL THEN RETURN Operatoren[H.wo^.Op].Prio ELSE RETURN 0 END END TopPrio; PROCEDURE TopOpTyp (VAR H: MOLEKUL): OpType; BEGIN RETURN H.wo^.Op END TopOpTyp; PROCEDURE StackSize(Ct: CARDINAL): CARDINAL; (* gib die zahl der StackElemente, ich liefere die Grösse der Formel *) BEGIN RETURN CARDINAL(TSIZE(MOLEKUL)) + 2 * CARDINAL(TSIZE(CARDINAL)) + CARDINAL(TSIZE(ADDRESS)) + Ct * CARDINAL(TSIZE(LONGREAL)) END StackSize; (*********** --- PROCEDUREN für UPN.def --- ***********) PROCEDURE WriteError; BEGIN IF UPNError.ET = None THEN RETURN END; CASE UPNError.ET OF UnKnown: WriteString("Unbekannte Funkt, Var, Konst ") | Ilegal: WriteString("Unerlaubtes Zeichen ") | Reserved: WriteString("Name Reserviert für Konst, Funkt") | AllReady: WriteString("Bereits Alloziiert!") | ToManyVars: WriteString("Zu viele Variable deklariert") | NumPar: WriteString("Klammeranzahlfehler") | ParExpected: WriteString("Klammer erwartet") | TermExpected: WriteString("Term, (, VAR, Konst,... erwartet") | OpExpected: WriteString("Operator, *-+/^ erwartet") | ErrInNummer: WriteString("Fehler in Nummer") | ErrInExpr: WriteString("Fehler in Expression") | NoMemory: WriteString("nicht genug Speicher") | OverFlow: WriteString("Arithmetik überlauf") | DivZero: WriteString("Division Durch Null") | NotDefined: WriteString("Nicht definiert") | terrible: WriteString("Error terrible") ELSE WriteString("UPNError gefunden") END (* case *) END WriteError; PROCEDURE AllocUPN (VAR f: UPN): BOOLEAN; BEGIN ALLOCATE(f, StackSize(0)); IF f = NIL THEN RETURN FALSE END; CreateUPNList(f^.UPN); f^.NumVar := 0; f^.HighStack := 0; f^.Belegung := NIL; RETURN TRUE END AllocUPN; PROCEDURE AddVarsToUPN (VAR f: UPN; Vars: ARRAY OF CHAR): BOOLEAN; VAR tempvars: ARRAY [1..MaxVars] OF VarName; woinV, endV, i, j, k: CARDINAL; (* i is number of new Vars *) new: BelegPtr; BEGIN IF f = NIL THEN RETURN FALSE END; woinV := 0; i := 0; LOOP CASE CAP(Vars[woinV]) OF "A".."Z": GetWort(Vars, woinV, endV, tempvars[i+1]); INC(i); IF (IsDefKonst(tempvars[i]) > 0) OR (IsOperator(tempvars[i]) # NoOp) THEN UPNError.ET := Reserved; UPNError.Wo := woinV; RETURN FALSE ELSIF (GetVarNr(f, tempvars[i]) > 0)THEN UPNError.ET := AllReady; UPNError.Wo := woinV; RETURN FALSE END; IF endV <= CARDINAL(HIGH(Vars)) THEN woinV := endV ELSE EXIT END |" ",",",".",";","/","|": IF woinV < CARDINAL(HIGH(Vars)) THEN INC(woinV) ELSE EXIT END | 0C: EXIT; ELSE UPNError.ET := Ilegal; UPNError.Wo := woinV; RETURN FALSE END END;(* Loop *) IF i = 0 THEN RETURN TRUE END; (* Test if tempvars is konsistent, has no double vars ! *) IF i >= 2 THEN FOR j := 2 TO i DO FOR k := 1 TO j - 1 DO IF 0 = Compare(tempvars[j], 0, 32000, tempvars[k], FALSE) THEN UPNError.ET := AllReady; UPNError.Wo := woinV; RETURN FALSE END END END END; IF i+f^.NumVar > MaxVars THEN UPNError.ET := ToManyVars; RETURN FALSE END; ALLOCATE(new, (i+f^.NumVar) * (TSIZE(VarName) + TSIZE(LONGREAL))); IF new = NIL THEN UPNError.ET := NoMemory; RETURN FALSE END; IF f^.NumVar > 0 THEN FOR j := 1 TO f^.NumVar DO new^[j].Name := f^.Belegung^[j].Name; new^[j].Wert := f^.Belegung^[j].Wert END END; DEALLOCATE(f^.Belegung, f^.NumVar * (TSIZE(VarName) + TSIZE(LONGREAL))); FOR j := 1 TO i DO new^[j + f^.NumVar].Name := tempvars[j]; new^[j + f^.NumVar].Wert := 0.0 END; f^.NumVar := f^.NumVar + i; f^.Belegung := new; RETURN TRUE END AddVarsToUPN; PROCEDURE Compile (VAR f: UPN; str: ARRAY OF CHAR): BOOLEAN; TYPE Zustand = (NachConstVar, NachFctSymb, TermStart); VAR n: CARDINAL; (* Wo in str bin ich bereits mit parsen *) NoMem, dummy: BOOLEAN; a, (* das Zu parsende Atom *) ta: Atom; (* temporary Atom *) MaxStackSize, numPar: CARDINAL; Zus: Zustand; (* Zustand im Parser *) as: MOLEKUL; New: UPN; PROCEDURE ParseNext; VAR GotStr: ARRAY[0..MaxAtomLen] OF CHAR; Done : BOOLEAN; HelpStr: ARRAY[0..MaxOpLen] OF CHAR; m: CARDINAL; (* Hilfsvariable *) BEGIN IF (n >= CARDINAL(HIGH(str))) OR (str[n] = 0C) THEN a.Pos := n - 1; IF Zus = NachConstVar THEN a.Atyp := Ende ELSE a.Atyp := Error END; RETURN END; WHILE (n+1 < CARDINAL(HIGH(str))) AND (str[n] = " ") DO INC(n) END; (* Skip all spaces *) a.Next := NIL; a.Pos := n; UPNError.Wo := n; CASE Zus OF TermStart: CASE CAP(str[n]) OF |"-": IF (str[n+1] = ".") OR Ziffer(str[n+1]) THEN Done := StrToLReal(str, n, m, a.Value); IF Done THEN n := m; Zus := NachConstVar; a.Atyp := Konst; RETURN ELSE UPNError.ET := ErrInNummer END; ELSE (* Neg *) a.Atyp := Operator; a.Op := Neg; INC(n); RETURN END; |"+", ".", "0".."9": Done := StrToLReal(str, n, m, a.Value); IF Done THEN Zus := NachConstVar; n := m; a.Atyp := Konst; RETURN ELSE UPNError.ET := ErrInNummer END |"(": a.Atyp := Operator; a.Op := OpenPar; INC(n); RETURN |"A".."Z": GetWort(str, n, m, GotStr); n := m; IF IsOperator(GotStr) # NoOp THEN Zus := NachFctSymb; a.Atyp := Operator; a.Op := IsOperator(GotStr); RETURN ELSIF GetVarNr(f, GotStr) > 0 THEN Zus := NachConstVar; a.Atyp := Variable; a.Var := GetVarNr(f, GotStr); RETURN ELSIF IsDefKonst(GotStr) > 0 THEN Zus := NachConstVar; a.Atyp := Konst; m := IsDefKonst(GotStr); a.Value := Konstanten[m].Value; RETURN ELSE UPNError.ET := UnKnown END; ELSE (* Kein Konst VAR !!!*) UPNError.ET := TermExpected END; | NachFctSymb: IF CAP(str[n]) = "(" THEN Zus := TermStart; INC(n); a.Atyp := Operator; a.Op := OpenPar; RETURN ELSE UPNError.ET := ParExpected END; | NachConstVar: CASE str[n] OF "+","-","*","/","^": a.Atyp := Operator; HelpStr[0] := str[n]; HelpStr[1] := 0C; a.Op := IsOperator(HelpStr); INC(n); Zus := TermStart; RETURN | ")": a.Atyp := Operator; a.Op := ClosePar; INC(n); RETURN ELSE UPNError.ET := OpExpected END; ELSE END; a.Atyp := Error; Zus := TermStart; INC(n); RETURN END ParseNext; BEGIN (* Compile *) CreateUPNList(as); IF f^.UPN.Start # NIL THEN DeleteUPNList(f^.UPN); END; CreateUPNList(f^.UPN); IF f^.HighStack > 0 THEN ALLOCATE(New, StackSize(0)); CreateUPNList(New^.UPN); New^.NumVar := f^.NumVar; New^.HighStack := 0; New^.Belegung := f^.Belegung; DEALLOCATE(f, StackSize(f^.HighStack)); f := New; END; (* Init as: *) a.Atyp := Operator; a.Op := Start; IF NOT PushAtom(as, a) THEN UPNError.ET := NoMemory; DeleteUPNList(as); DeleteUPNList(f^.UPN); RETURN FALSE END; numPar := 0; NoMem := TRUE; Zus := TermStart; n := 0; (* for initialize Parser *) MaxStackSize := 1; LOOP (* THE MAIN LOOP FOR COMPILER *) ParseNext; IF a.Atyp = Error THEN NoMem := FALSE; EXIT END; IF a.Atyp = Ende THEN NoMem := FALSE; EXIT END; IF (a.Atyp = Variable) OR (a.Atyp = Konst) THEN INC(MaxStackSize); IF NOT PushAtom(f^.UPN, a) THEN EXIT END ELSE (* Atyp is now an Operator: *) CASE a.Op OF OpenPar: INC(numPar); IF NOT (PushAtom(as,a)) THEN EXIT END | ClosePar: IF numPar = 0 THEN numPar := 10; NoMem := FALSE; EXIT END; WHILE TopOpTyp(as) # OpenPar DO dummy := PopAtom(as, ta); IF NOT PushAtom(f^.UPN, ta) THEN EXIT END END; IF NOT PopAtom(as, ta) THEN EXIT END; (* Rem "(" *) DEC(numPar) ELSE (* Atyp is Any other operator then Parantheses *) IF (a.Op = Neg) AND (TopOpTyp(as) = Neg) THEN dummy := PopAtom(as, ta); ELSIF Operatoren[a.Op].Prio > TopPrio(as) THEN IF NOT PushAtom(as, a) THEN EXIT END ELSE WHILE TopPrio(as) >= Operatoren[a.Op].Prio DO dummy := PopAtom(as, ta); IF NOT(PushAtom(f^.UPN, ta)) THEN EXIT END END; IF NOT (PushAtom(as, a)) THEN EXIT END END END; (* Case *) END (* If VAR or CONST *) END; (* LOOP *) IF a.Atyp = Error THEN DeleteUPNList(f^.UPN); DeleteUPNList(as); RETURN FALSE END; IF NoMem THEN DeleteUPNList(f^.UPN); DeleteUPNList(as); UPNError.ET := NoMemory; RETURN FALSE END; IF numPar # 0 THEN UPNError.ET := NumPar; DeleteUPNList(f^.UPN); DeleteUPNList(as); RETURN FALSE END; WHILE TopOpTyp(as) # Start DO NoMem := PopAtom(as, a); IF NOT PushAtom(f^.UPN, a) THEN DeleteUPNList(f^.UPN); DeleteUPNList(as); UPNError.ET := NoMemory; RETURN FALSE END END; DeleteUPNList(as); ALLOCATE(New, StackSize(MaxStackSize)); IF New = NIL THEN UPNError.ET := NoMemory; DeleteUPNList(f^.UPN); RETURN FALSE END; New^.UPN := f^.UPN; New^.NumVar := f^.NumVar; New^.HighStack := MaxStackSize; New^.Belegung := f^.Belegung; DEALLOCATE(f, StackSize(f^.HighStack)); f := New; UPNError.ET := None; RETURN TRUE END Compile; PROCEDURE GetNumVars ( f: UPN): CARDINAL; BEGIN RETURN f^.NumVar END GetNumVars; PROCEDURE GetVarName ( f: UPN; n: CARDINAL; VAR varname: ARRAY OF CHAR); BEGIN IF (n = 0) OR (n > f^.NumVar) THEN UPNError.ET := NotDefined; RETURN END; Copy(varname, f^.Belegung^[n].Name, 0, 32000) END GetVarName; PROCEDURE IsVarInFormel( f: UPN; n: CARDINAL): BOOLEAN; VAR ga: Atom; BEGIN f^.UPN.wo := f^.UPN.Start; WHILE GetNext(f^.UPN, ga) DO IF (ga.Atyp = Variable) AND (ga.Var = n) THEN RETURN TRUE END; END; RETURN FALSE END IsVarInFormel; PROCEDURE GetVarNr ( f: UPN; str: ARRAY OF CHAR): CARDINAL; VAR i: CARDINAL; BEGIN IF f^.NumVar = 0 THEN RETURN 0 END; FOR i := 1 TO f^.NumVar DO IF 0 = Compare(str, 0, 32000, f^.Belegung^[i].Name, FALSE) THEN RETURN i END END; RETURN 0 END GetVarNr; PROCEDURE SetVar (VAR f: UPN; n: CARDINAL; Val: LONGREAL); BEGIN IF(n > 0) AND (n <= f^.NumVar) THEN f^.Belegung^[n].Wert := Val END END SetVar; PROCEDURE Execute ( f: UPN): LONGREAL; VAR x,y: LONGREAL; stptr: CARDINAL; a: Atom; emp: BOOLEAN; (* IF TRUE: RealStack was empty by poping Real *) PROCEDURE ErrSet(er: ErrorType); (* Bei Stack overflow *) BEGIN UPNError.ET := er; UPNError.Wo := a.Pos; ArEr := ArNoEr END ErrSet; BEGIN (* Execute *) f^.UPN.wo := f^.UPN.Start; stptr := 0; WHILE GetNext(f^.UPN, a) DO CASE a.Atyp OF Variable: INC(stptr); f^.Stack[stptr] := f^.Belegung^[a.Var].Wert | Konst : INC(stptr); f^.Stack[stptr] := a.Value | Operator: CASE a.Op OF Add: DEC(stptr); x := f^.Stack[stptr] + f^.Stack[stptr+1]; f^.Stack[stptr] := x (* musste diesen Umweg über x tun, da M2 Amiga sonst * zu wenig Register zur Verfügung hat um * Zwischenresultate abzuspeichern. ERROR 5006 *) | Sub: DEC(stptr); x := f^.Stack[stptr] - f^.Stack[stptr+1]; f^.Stack[stptr] := x | Mult: DEC(stptr); x := f^.Stack[stptr] * f^.Stack[stptr+1]; f^.Stack[stptr] := x | Div: IF f^.Stack[stptr] = 0.0 THEN ErrSet(DivZero); RETURN 0.0 END; DEC(stptr); x := f^.Stack[stptr] / f^.Stack[stptr+1]; f^.Stack[stptr] := x | Pot: DEC(stptr); x:= f^.Stack[stptr]; y:= f^.Stack[stptr+1]; IF (y=LTRUNC(y)) AND (y>0.0) THEN erg:= 1.0; FOR i:= TRUNC(y) TO 1 BY -1 DO erg:= erg * x; END; ELSE erg:= EXP(LN(x)*y); END; f^.Stack[stptr] := erg; | Neg: f^.Stack[stptr] := -f^.Stack[stptr] | Sqroot: f^.Stack[stptr] := SQRT (f^.Stack[stptr]) | Sinus: f^.Stack[stptr] := SIN (f^.Stack[stptr]) | Cosinus: f^.Stack[stptr] := COS (f^.Stack[stptr]) | Tan: f^.Stack[stptr] := TAN (f^.Stack[stptr]) | arctan: f^.Stack[stptr] := ARCTAN (f^.Stack[stptr]) | Cosh: f^.Stack[stptr] := COSh (f^.Stack[stptr]) | Sinh: f^.Stack[stptr] := SINh (f^.Stack[stptr]) | Tanh: f^.Stack[stptr] := TANh (f^.Stack[stptr]) | ArCosh: f^.Stack[stptr] := ARCCOSh(f^.Stack[stptr]) | ArSinh: f^.Stack[stptr] := ARCSINh(f^.Stack[stptr]) | ArTanh: f^.Stack[stptr] := ARCTANh(f^.Stack[stptr]) | Sign: f^.Stack[stptr] := SIGN (f^.Stack[stptr]) | Facult: f^.Stack[stptr] := FACT (f^.Stack[stptr]) | Expo: f^.Stack[stptr] := EXP (f^.Stack[stptr]) | Logn: f^.Stack[stptr] := LN (f^.Stack[stptr]) | Log10: f^.Stack[stptr] := LOG (f^.Stack[stptr]) |degtorad: f^.Stack[stptr] :=DegToRad(f^.Stack[stptr]) |radtodeg: f^.Stack[stptr] :=RadToDeg(f^.Stack[stptr]) | Round: f^.Stack[stptr] := ROUND (f^.Stack[stptr]) | Ltrunc: f^.Stack[stptr] := LTRUNC (f^.Stack[stptr]) | Arccos: f^.Stack[stptr] := ARCCOS (f^.Stack[stptr]) | Arcsin: f^.Stack[stptr] := ARCSIN (f^.Stack[stptr]) | Abs: f^.Stack[stptr] :=ABSOLUTE(f^.Stack[stptr]) | Cotan: f^.Stack[stptr] := COTAN (f^.Stack[stptr]) |Arccotan: f^.Stack[stptr] :=ARCCOTAN(f^.Stack[stptr]) ELSE (* Operator Type *) ErrSet(terrible); RETURN 0.0 END; (* Case Operator of *) ELSE (* Else Case Atyp of *) ErrSet(terrible); RETURN 0.0 END (* Case Atyp OF *) END; (* WHILE GetNext *) IF ArEr # ArNoEr THEN CASE ArEr OF ArNDef: ErrSet(NotDefined); RETURN 0.0 | ArOverFl: ErrSet(OverFlow); RETURN 0.0 ELSE END END; UPNError.ET := None; IF stptr = 1 THEN RETURN f^.Stack[1] ELSE ErrSet(terrible); RETURN MAXLONG END END Execute; PROCEDURE KillUPN (VAR f: UPN); BEGIN DeleteUPNList(f^.UPN); DEALLOCATE(f^.Belegung, f^.NumVar * (TSIZE(LONGREAL) + TSIZE(VarName))); DEALLOCATE(f, StackSize(f^.HighStack)) END KillUPN; (*********** --- Installation von UPN --- ***********) BEGIN (* UPN *) Operatoren[Start ].Wort := "___" ; Operatoren[Start ].Prio := 0; Operatoren[Neg ].Wort := "-" ; Operatoren[Neg ].Prio := 9; Operatoren[OpenPar].Wort := "(" ; Operatoren[OpenPar].Prio := 2; Operatoren[ClosePar].Wort:= ")" ; Operatoren[ClosePar].Prio:= 1000; Operatoren[Add ].Wort := "+" ; Operatoren[Add ].Prio := 4; Operatoren[Sub ].Wort := "-" ; Operatoren[Sub ].Prio := 4; Operatoren[Mult ].Wort := "*" ; Operatoren[Mult ].Prio := 6; Operatoren[Div ].Wort := "/" ; Operatoren[Div ].Prio := 6; Operatoren[Pot ].Wort := "^" ; Operatoren[Pot ].Prio := 8; Operatoren[Sqroot ].Wort := "SQRT"; Operatoren[Sqroot ].Prio := 10; Operatoren[Cosinus].Wort := "COS" ; Operatoren[Cosinus].Prio := 10; Operatoren[Sinus ].Wort := "SIN" ; Operatoren[Sinus ].Prio := 10; Operatoren[Tan ].Wort := "TAN" ; Operatoren[Tan ].Prio := 10; Operatoren[arctan ].Wort := "ATAN"; Operatoren[arctan ].Prio := 10; Operatoren[Cosh ].Wort := "COSH"; Operatoren[Cosh ].Prio := 10; Operatoren[Sinh ].Wort := "SINH"; Operatoren[Sinh ].Prio := 10; Operatoren[Tanh ].Wort := "TANH"; Operatoren[Tanh ].Prio := 10; Operatoren[ArCosh ].Wort := "ACOSH";Operatoren[ArCosh ].Prio := 10; Operatoren[ArSinh ].Wort := "ASINH";Operatoren[ArSinh ].Prio := 10; Operatoren[ArTanh ].Wort := "ATANH";Operatoren[ArTanh ].Prio := 10; Operatoren[radtodeg].Wort:="RTOD"; Operatoren[radtodeg].Prio:= 10; Operatoren[degtorad].Wort:="DTOR"; Operatoren[degtorad].Prio:= 10; Operatoren[Sign ].Wort := "SIGN"; Operatoren[Sign ].Prio := 10; Operatoren[Facult ].Wort := "FACT"; Operatoren[Facult ].Prio := 10; Operatoren[Expo ].Wort := "EXP" ; Operatoren[Expo ].Prio := 10; Operatoren[Logn ].Wort := "LN" ; Operatoren[Logn ].Prio := 10; Operatoren[Log10 ].Wort := "LOG" ; Operatoren[Log10 ].Prio := 10; Operatoren[Round ].Wort :="ROUND"; Operatoren[Round ].Prio := 10; Operatoren[Ltrunc ].Wort :="TRUNC"; Operatoren[Ltrunc ].Prio := 10; Operatoren[Arccos ].Wort := "ACOS"; Operatoren[Arccos ].Prio := 10; Operatoren[Arcsin ].Wort := "ASIN"; Operatoren[Arcsin ].Prio := 10; Operatoren[Abs ].Wort := "ABS" ; Operatoren[Abs ].Prio := 10; Operatoren[Cotan ].Wort :="COTAN"; Operatoren[Cotan ].Prio := 10; Operatoren[Arccotan].Wort:="ACOTAN";Operatoren[Arccotan].Prio := 10; Operatoren[NoOp ].Wort := "??" ; Operatoren[NoOp ].Prio := 2; Konstanten[1].Wort := "E"; Konstanten[1].Value := 2.718281828459045; Konstanten[2].Wort := "PI"; Konstanten[2].Value := 3.141592653589793; UPNError.ET := None; UPNError.Wo := 0 END UPN.