home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / CRX-EC12.LHA / ExCalcV1.2 / Source / Calculator.mod < prev    next >
Encoding:
Text File  |  1995-10-07  |  20.7 KB  |  688 lines
  1. MODULE Calculator;
  2.  
  3. IMPORT arg: Arguments, Cnv: Conversions, XI: ExIntegers, X: ExNumbers,
  4.        XM: ExMathLib0, io, iox: InOutExt, f: FileSystem, s: Strings,
  5.        Break;
  6.  
  7. TYPE
  8.   Tokens  = INTEGER;
  9.  
  10. CONST
  11.   (* Tokens definitions *)
  12.   Empty = 0;
  13.  
  14.  
  15.   (* expression tokens *)
  16.   Plus        = 1;
  17.   Minus       = 2;
  18.   Or          = 3;
  19.   Xor         = 4;
  20.   StoreMem    = 5;
  21.  
  22.  
  23.   (* term tokens *)
  24.   Times       = 6;
  25.   Divide      = 7;
  26.   ShiftLeft   = 8;
  27.   And         = 9;
  28.   Mod         = 10;
  29.   Div         = 11;
  30.   ClearBit    = 12;
  31.   SetBit      = 13;
  32.   ToggleBit   = 14;
  33.   AShiftRight = 15;
  34.   RotateRight = 16;
  35.   RotateLeft  = 17;
  36.   ShiftRight  = 18;
  37.  
  38.   (* power tokens *)
  39.   Power       = 19;
  40.   PercentOf   = 20;
  41.   Root        = 21;
  42.   Squared     = 22;
  43.   Cubed       = 23;
  44.   Inverse     = 24;
  45.   Factorial   = 25;
  46.  
  47.   (* miscellaneous tokens *)
  48.   LeftBrace   = 26;
  49.   RightBrace  = 27;
  50.   PowerOfe    = 28;
  51.   Sin         = 29;
  52.   Cos         = 30;
  53.   Tan         = 31;
  54.   ArcSin      = 32;
  55.   ArcCos      = 33;
  56.   ArcTan      = 34;
  57.   Sinh        = 35;
  58.   Cosh        = 36;
  59.   Tanh        = 37;
  60.   ArcSinh     = 38;
  61.   ArcCosh     = 39;
  62.   ArcTanh     = 40;
  63.   Not         = 41;
  64.   Base        = 42;
  65.   Digits      = 43;
  66.   Pi          = 44;
  67.   NaturalLog  = 45;
  68.   SquareRoot  = 46;
  69.   CubeRoot    = 47;
  70.   Decimals    = 48;
  71.   Notation    = 49;
  72.   Complement  = 50;
  73.   Log         = 51;
  74.   Number      = 52;
  75.   DegRadGrad  = 53;
  76.   MemoryCell  = 54;
  77.  
  78. CONST
  79.   MaxMemory        = 15;
  80.   StrSize          = 250;
  81.   Space            = ' ';
  82.   PunctuationChars = ",'_";
  83.   StateFile        = "RAM:CalculatorState.bin";
  84.  
  85.   (* DegRadType definitions *)
  86.   Degrees  = 0;
  87.   Radians  = 1;
  88.   Gradians = 2;
  89.  
  90. TYPE
  91.   String      = ARRAY StrSize OF CHAR;
  92.   SymbolArray = ARRAY MaxMemory+1 OF X.ExNumType;
  93.   DegRadType  = SHORTINT;
  94.   StateType   = RECORD
  95.                   LocalBase   : XI.BaseType;
  96.                   DecPoint    : INTEGER;
  97.                   SciNotation : BOOLEAN;
  98.                   NumbDigits  : INTEGER;
  99.                   LastAnswer  : X.ExNumType;
  100.                   DegRadFlag  : DegRadType;
  101.                   SymbolTable : SymbolArray;
  102.                 END;
  103.  
  104. VAR
  105.   Token       : Tokens;
  106.   NumberValue : X.ExNumType;
  107.   Answer      : X.ExNumType;
  108.   ToGradians  : X.ExNumType;
  109.   FromGradians: X.ExNumType;
  110.   State       : StateType;  (* Calculator state *)
  111.   ResultStr,
  112.   CommandLine : String;
  113.  
  114.  
  115. PROCEDURE SaveState;
  116. VAR
  117.   RFile : f.File;
  118. BEGIN
  119.   (* save calculator state *)
  120.   IF f.Open(RFile, StateFile, TRUE) &
  121.      f.Write(RFile, State)          &
  122.      f.Close(RFile) THEN END;
  123. END SaveState;
  124.  
  125.  
  126. PROCEDURE GetState;
  127. VAR
  128.   Loc   : INTEGER;
  129.   RFile : f.File;
  130. BEGIN
  131.   (* default calculator state *)
  132.   State.LocalBase   := 10;
  133.   State.DecPoint    :=  0;
  134.   State.SciNotation := FALSE;
  135.   State.NumbDigits  := 52;
  136.   State.DegRadFlag  := Degrees;
  137.   FOR Loc := 0 TO MaxMemory DO
  138.     State.SymbolTable[Loc] := X.Ex0;
  139.   END;
  140.  
  141.   (* get new state -- if available *)
  142.   IF f.Open(RFile, StateFile, FALSE) THEN
  143.     IF f.Read(RFile, State) & f.Close(RFile) THEN
  144.       X.SetMaxDigits(State.NumbDigits);
  145.     END;
  146.   END;
  147. END GetState;
  148.  
  149.  
  150. PROCEDURE UnsignInt (Number     : ARRAY OF CHAR;
  151.                      VAR Result : X.ExNumType);
  152. (* $CopyArrays- *)
  153. VAR
  154.   numb  : X.ExNumType;
  155.   done  : BOOLEAN;
  156. BEGIN
  157.   (* perform the actual conversion from string to number *)
  158.   IF State.LocalBase = 10 THEN
  159.     X.StrToExNum(Number, numb);
  160.     done := X.ExStatus = X.Okay;
  161.   ELSIF (State.LocalBase > 1) & (State.LocalBase <= 16) THEN
  162.     XI.StrToExInt(Number, State.LocalBase, numb);
  163.     done := X.ExStatus = X.Okay;
  164.   ELSE
  165.     done := FALSE;
  166.   END;
  167.   IF done THEN  (* all went OK *)
  168.     Result := numb;
  169.   ELSE
  170.     X.ExStatus := X.IllegalNumber;
  171.     Result := X.Ex0;
  172.   END;
  173. END UnsignInt;
  174.  
  175.  
  176. PROCEDURE LocateChar(Str : ARRAY OF CHAR; ch : CHAR;
  177.                      start : LONGINT) : LONGINT;
  178. (* $CopyArrays- *)
  179. VAR Find : ARRAY 2 OF CHAR;
  180. BEGIN
  181.   Find[0] := ch; Find[1] := 0X;
  182.   RETURN s.OccursPos(Str, Find, start);
  183. END LocateChar;
  184.  
  185.  
  186. PROCEDURE ExtractNumber(VAR arg         : ARRAY OF CHAR;
  187.                         VAR NumberValue : X.ExNumType);
  188. CONST
  189.   ExpChar = 0C6X;
  190. VAR
  191.   Constant    : String;
  192.   NumChars    : ARRAY 20 OF CHAR;
  193.   NumberChars : ARRAY 20 OF CHAR;
  194.   ConIndex    : INTEGER;
  195.  
  196.   PROCEDURE GetNumber();
  197.   BEGIN
  198.     LOOP
  199.       (* gather number characters *)
  200.       IF LocateChar(NumChars, arg[0], 0) # -1 THEN
  201.         (* not punctuation character *)
  202.         Constant[ConIndex] := arg[0];
  203.         INC(ConIndex);
  204.         IF ((arg[0] = 'E') OR (arg[0] = ExpChar)) & (State.LocalBase = 10) THEN
  205.           Constant[ConIndex-1] := 'E';    (* replace ExpChar with 'E' *)
  206.           IF (arg[1] = '+') OR (arg[1] = '-') THEN
  207.             Constant[ConIndex] := arg[1];
  208.             INC(ConIndex);
  209.             s.Delete(arg, 0, 1);
  210.           END;
  211.           s.Delete(NumChars, 0, 1); (* remove `.' *)
  212.         END;
  213.         s.Delete(arg, 0, 1);
  214.       ELSIF LocateChar(PunctuationChars, arg[0], 0) # -1 THEN
  215.         s.Delete(arg, 0, 1);
  216.       ELSE
  217.         EXIT;
  218.       END;
  219.       IF arg[0] = 0X THEN EXIT END;
  220.     END;
  221.   END GetNumber;
  222.  
  223. BEGIN
  224.   Constant := "";
  225.   ConIndex := 0;
  226.   NumberChars := ". E0123456789ABCDEF";
  227.   NumberChars[1] := ExpChar;
  228.  
  229.   (* valid number characters *)
  230.   IF State.LocalBase = 10 THEN
  231.     s.Cut(NumberChars, 0, 13, NumChars);
  232.   ELSE
  233.     s.Cut(NumberChars, 3, State.LocalBase+3, NumChars);
  234.   END;
  235.  
  236.   (* get a number string from the input *)
  237.   GetNumber();
  238.   Constant[ConIndex] := 0X;  (* terminate the new string *)
  239.  
  240.   (* convert to an ExNumber *)
  241.   IF ConIndex > 0 THEN
  242.     UnsignInt(Constant, NumberValue);
  243.   ELSE
  244.     NumberValue := X.Ex0;
  245.     X.ExStatus := X.IllegalNumber;  (* illegal number or constant *)
  246.   END;
  247. END ExtractNumber;
  248.  
  249.  
  250. PROCEDURE StoreMemory(Location, Value : X.ExNumType);
  251. (* Store the `Value' argument in the `Location' memory cell. *)
  252. VAR
  253.   Loc : LONGINT;
  254. BEGIN
  255.   Loc := X.ExToLongInt(Location);
  256.   IF Loc <= MaxMemory THEN
  257.     State.SymbolTable[Loc] := Value;
  258.   ELSE
  259.     X.ExStatus := X.UndefinedStorage;  (* unknown memory cell *)
  260.   END;
  261. END StoreMemory;
  262.  
  263.  
  264. PROCEDURE RecallMemory(Location : X.ExNumType; VAR Value : X.ExNumType);
  265. (* Recall the contents of the `Location' memory cell and return *)
  266. VAR
  267.   Loc : LONGINT;
  268. BEGIN
  269.   Loc := X.ExToLongInt(Location);
  270.   IF Loc <= MaxMemory THEN
  271.     Value := State.SymbolTable[Loc];
  272.   ELSE
  273.     X.ExStatus := X.UndefinedStorage;  (* unknown memory cell *)
  274.     Value := X.Ex0;
  275.   END;
  276. END RecallMemory;
  277.  
  278.  
  279. PROCEDURE ToRadians (InAngle : X.ExNumType; VAR Result : X.ExNumType);
  280. (* Convert from another angular representation to radians -- depending on
  281.    the state of the `DegRadFlag' *)
  282. BEGIN
  283.   IF State.DegRadFlag = Degrees THEN
  284.     Result := InAngle;
  285.     XM.DegToRadX(Result);
  286.   ELSIF State.DegRadFlag = Gradians THEN
  287.     X.ExMult(Result, FromGradians, InAngle);
  288.   ELSE
  289.     Result := InAngle
  290.   END;
  291. END ToRadians;
  292.  
  293.  
  294. PROCEDURE FromRadians (InAngle    : X.ExNumType;
  295.                        VAR Result : X.ExNumType);
  296. (* Convert to another angular representation from radians --
  297.    depending on the state of the `DegRadFlag' *)
  298. BEGIN
  299.   IF State.DegRadFlag = Degrees THEN
  300.     Result := InAngle;
  301.     XM.RadToDegX(Result)
  302.   ELSIF State.DegRadFlag = Gradians THEN
  303.     X.ExMult(Result, ToGradians, InAngle);
  304.   ELSE
  305.     Result := InAngle;
  306.   END;
  307. END FromRadians;
  308.  
  309.  
  310. PROCEDURE GetToken(VAR arg : ARRAY OF CHAR);
  311.  
  312. CONST
  313.   Sqrd = "\xB2";
  314.   Cubd = "\xB3";
  315.   Andd = "\xB7";
  316.   Tims = "\xD7";
  317.   Divd = "\xF7";
  318.   Min1 = "\xAD\xB9";   (* reciprocal *)
  319.   Min2 = "-\xB9";      (* alias for reciprocal *)
  320.   Anrt = "*\xC7";      (* alias for ROOT *)
  321.   Sqrt = "\xC7";       (* alias for SQRT *)
  322.   Cbrt = "\xB3\xC7";   (* alias for CBRT *)
  323.  
  324.   PROCEDURE IsToken(Str : ARRAY OF CHAR;
  325.                     T   : Tokens) : BOOLEAN;
  326.   BEGIN
  327.     IF s.OccursPos(arg, Str, 0) = 0 THEN
  328.       s.Delete(arg, 0, s.Length(Str));
  329.       Token := T;
  330.       RETURN TRUE;
  331.     END;
  332.     RETURN FALSE;
  333.   END IsToken;
  334.  
  335. BEGIN
  336.   (* delete any blank spaces *)
  337.   WHILE arg[0] = Space DO s.Delete(arg, 0, 1); END;
  338.  
  339.   (* form a token *)
  340.   IF ((arg[0] >= '0') & (arg[0] <= '9')) OR (arg[0] = '.') THEN
  341.     (* token is some sort of number *)
  342.     Token := Number;
  343.     ExtractNumber(arg, NumberValue);
  344.   ELSIF arg[0] = 0X THEN
  345.     (* empty string *)
  346.     Token := Empty;
  347.   ELSE
  348.     (* token is a symbol *)
  349.     IF    IsToken("+",     Plus)        THEN (* Return token *)
  350.     ELSIF IsToken("-",     Minus)       THEN (* Return token *)
  351.     ELSIF IsToken(Min2,    Inverse)     THEN (* Return token *)
  352.     ELSIF IsToken(Sqrt,    SquareRoot)  THEN (* Return token *)
  353.     ELSIF IsToken(Sqrd,    Squared)     THEN (* Return token *)
  354.     ELSIF IsToken(Cbrt,    CubeRoot)    THEN (* Return token *)
  355.     ELSIF IsToken(Cubd,    Cubed)       THEN (* Return token *)
  356.     ELSIF IsToken("x",     Times)       THEN (* Return token *)
  357.     ELSIF IsToken(Tims,    Times)       THEN (* Return token *)
  358.     ELSIF IsToken("/",     Divide)      THEN (* Return token *)
  359.     ELSIF IsToken(Divd,    Divide)      THEN (* Return token *)
  360.     ELSIF IsToken("(",     LeftBrace)   THEN (* Return token *)
  361.     ELSIF IsToken(")",     RightBrace)  THEN (* Return token *)
  362.     ELSIF IsToken("^",     Power)       THEN (* Return token *)
  363.     ELSIF IsToken("%",     PercentOf)   THEN (* Return token *)
  364.     ELSIF IsToken("!",     Factorial)   THEN (* Return token *)
  365.     ELSIF IsToken("&",     And)         THEN (* Return token *)
  366.     ELSIF IsToken(Andd,    And)         THEN (* Return token *)
  367.     ELSIF IsToken("|",     Or)          THEN (* Return token *)
  368.     ELSIF IsToken("e^",    PowerOfe)    THEN (* Return token *)
  369.     ELSIF IsToken("e",     Number)      THEN NumberValue := X.e
  370.     ELSIF IsToken(Min1,    Inverse)     THEN (* Return token *)
  371.     ELSIF IsToken("**",    Power)       THEN (* Return token *)
  372.     ELSIF IsToken(Anrt,    Root)        THEN (* Return token *)
  373.     ELSIF IsToken("*",     Times)       THEN (* Return token *)
  374.     ELSIF IsToken("BAS",   Base)        THEN (* Return token *)
  375.     ELSIF IsToken("OR",    Or)          THEN (* Return token *)
  376.     ELSIF IsToken("Pi",    Number)      THEN NumberValue := X.pi
  377.     ELSIF IsToken("SBIT",  SetBit)      THEN (* Return token *)
  378.     ELSIF IsToken("SHR",   ShiftRight)  THEN (* Return token *)
  379.     ELSIF IsToken("SHL",   ShiftLeft)   THEN (* Return token *)
  380.     ELSIF IsToken("SINH",  Sinh)        THEN (* Return token *)
  381.     ELSIF IsToken("SIN",   Sin)         THEN (* Return token *)
  382.     ELSIF IsToken("SQRT",  SquareRoot)  THEN (* Return token *)
  383.     ELSIF IsToken("STM",   StoreMem)    THEN (* Return token *)
  384.     ELSIF IsToken("SCI",   Notation)    THEN (* Return token *)
  385.     ELSIF IsToken("AND",   And)         THEN (* Return token *)
  386.     ELSIF IsToken("ASINH", ArcSinh)     THEN (* Return token *)
  387.     ELSIF IsToken("ASIN",  ArcSin)      THEN (* Return token *)
  388.     ELSIF IsToken("ASR",   AShiftRight) THEN (* Return token *)
  389.     ELSIF IsToken("ACOSH", ArcCosh)     THEN (* Return token *)
  390.     ELSIF IsToken("ACOS",  ArcCos)      THEN (* Return token *)
  391.     ELSIF IsToken("ATANH", ArcTanh)     THEN (* Return token *)
  392.     ELSIF IsToken("ATAN",  ArcTan)      THEN (* Return token *)
  393.     ELSIF IsToken("XOR",   Xor)         THEN (* Return token *)
  394.     ELSIF IsToken("MOD",   Mod)         THEN (* Return token *)
  395.     ELSIF IsToken("M",     MemoryCell)  THEN ExtractNumber(arg, NumberValue)
  396.     ELSIF IsToken("LOG",   Log)         THEN (* Return token *)
  397.     ELSIF IsToken("LN",    NaturalLog)  THEN (* Return token *)
  398.     ELSIF IsToken("DIV",   Div)         THEN (* Return token *)
  399.     ELSIF IsToken("DP",    Decimals)    THEN (* Return token *)
  400.     ELSIF IsToken("DRG",   DegRadGrad)  THEN (* Return token *)
  401.     ELSIF IsToken("CBIT",  ClearBit)    THEN (* Return token *)
  402.     ELSIF IsToken("CBRT",  CubeRoot)    THEN (* Return token *)
  403.     ELSIF IsToken("COSH",  Cosh)        THEN (* Return token *)
  404.     ELSIF IsToken("COS",   Cos)         THEN (* Return token *)
  405.     ELSIF IsToken("NOT",   Complement)  THEN (* Return token *)
  406.     ELSIF IsToken("ROOT",  Root)        THEN (* Return token *)
  407.     ELSIF IsToken("ROL",   RotateLeft)  THEN (* Return token *)
  408.     ELSIF IsToken("ROR",   RotateRight) THEN (* Return token *)
  409.     ELSIF IsToken("TANH",  Tanh)        THEN (* Return token *)
  410.     ELSIF IsToken("TAN",   Tan)         THEN (* Return token *)
  411.     ELSIF IsToken("TBIT",  ToggleBit)   THEN (* Return token *)
  412.     ELSIF IsToken("DIG",   Digits)      THEN (* Return token *)
  413.     ELSE
  414.       (* Illegal token if we reach here *)
  415.       X.ExStatus := X.IllegalOperator;
  416.       s.Delete(arg, 0, 1);
  417.     END
  418.   END
  419. END GetToken;
  420.  
  421.  
  422. PROCEDURE^ Expression (VAR arg : ARRAY OF CHAR; VAR Result : X.ExNumType);
  423.  
  424.  
  425. PROCEDURE Factor (VAR arg : ARRAY OF CHAR; VAR Result : X.ExNumType);
  426. VAR
  427.   SaveBase : XI.BaseType;
  428.   temp     : X.ExNumType;
  429.  
  430.   PROCEDURE Next;
  431.   BEGIN
  432.     GetToken(arg); Factor(arg, Result);
  433.   END Next;
  434.  
  435. BEGIN
  436.   CASE Token OF
  437.       LeftBrace  : GetToken(arg); Expression(arg, Result);
  438.                    IF Token = RightBrace THEN GetToken(arg);
  439.                    ELSE X.ExStatus := X.MismatchBraces END;
  440.     | Number     : GetToken(arg); Result := NumberValue;
  441.                    IF Token = Number THEN
  442.                      X.ExStatus := X.IllegalNumber;
  443.                    END;
  444.     | Complement : Next(); XI.ExOnesComp(Result, Result);
  445.     | Sin        : Next(); ToRadians(Result, Result);
  446.                    XM.sinX(Result, Result);
  447.     | Cos        : Next(); ToRadians(Result, Result);
  448.                    XM.cosX(Result, Result);
  449.     | Tan        : Next(); ToRadians(Result, Result);
  450.                    XM.tanX(Result, Result);
  451.     | ArcSin     : Next(); XM.arcsinX(Result, Result);
  452.                    FromRadians(Result, Result);
  453.     | ArcCos     : Next(); XM.arccosX(Result, Result);
  454.                    FromRadians(Result, Result);
  455.     | ArcTan     : Next(); XM.arctanX(Result, Result);
  456.                    FromRadians(Result, Result);
  457.     | Sinh       : Next(); XM.sinhX(Result, Result);
  458.     | Cosh       : Next(); XM.coshX(Result, Result);
  459.     | Tanh       : Next(); XM.tanhX(Result, Result);
  460.     | ArcSinh    : Next(); XM.arcsinhX(Result, Result);
  461.     | ArcCosh    : Next(); XM.arccoshX(Result, Result);
  462.     | ArcTanh    : Next(); XM.arctanhX(Result, Result);
  463.     | SquareRoot : Next(); XM.sqrtX(Result, Result);
  464.     | CubeRoot   : Next(); X.ExNumb(3, 0, 0, temp);
  465.                    XM.rootX(Result, Result, temp);
  466.     | NaturalLog : Next(); XM.lnX(Result, Result);
  467.     | Log        : Next(); XM.logX(Result, Result);
  468.     | PowerOfe   : Next(); XM.expX(Result, Result);
  469.     | MemoryCell : GetToken(arg); RecallMemory(NumberValue, Result);
  470.     | Base       : SaveBase := State.LocalBase;
  471.                    State.LocalBase := 10;
  472.                    Next();
  473.                    State.LocalBase := SHORT(SHORT(X.ExToLongInt(Result)));
  474.                    IF (State.LocalBase < 2) OR
  475.                       (State.LocalBase > 16) THEN
  476.                      State.LocalBase := SaveBase;
  477.                    END;
  478.                    Result := State.LastAnswer;
  479.     | Digits     : Next();
  480.                    IF X.ExStatus = X.Okay THEN
  481.                      State.NumbDigits := SHORT(X.ExToLongInt(Result));
  482.                      X.SetMaxDigits(State.NumbDigits);
  483.                      State.NumbDigits := X.GetMaxDigits();
  484.                      Result := State.LastAnswer;
  485.                    END;
  486.     | Decimals   : Next();
  487.                    IF X.ExStatus = X.Okay THEN
  488.                      State.DecPoint := SHORT(X.ExToLongInt(Result));
  489.                      Result := State.LastAnswer;
  490.                    END;
  491.     | Notation   : GetToken(arg);
  492.                    State.SciNotation := NOT State.SciNotation;
  493.                    Result := State.LastAnswer;
  494.     | DegRadGrad : GetToken(arg);
  495.                    IF State.DegRadFlag = Gradians THEN
  496.                      State.DegRadFlag := Degrees;
  497.                    ELSE INC(State.DegRadFlag) END;
  498.                    Result := State.LastAnswer;
  499.     ELSE           X.ExStatus := X.IllegalOperator;
  500.                    Result := X.Ex0;
  501.   END;
  502. END Factor;
  503.  
  504.  
  505. PROCEDURE Powers (VAR arg : ARRAY OF CHAR; VAR Result : X.ExNumType);
  506. VAR
  507.   temp : X.ExNumType;
  508.  
  509.   PROCEDURE Next;
  510.   BEGIN
  511.     GetToken(arg); Factor(arg, Result);
  512.   END Next;
  513.  
  514. BEGIN
  515.   Factor(arg, temp);
  516.   WHILE (Token >= Power) & (Token <= Factorial) DO
  517.     CASE Token OF
  518.         Power     : Next(); XM.powerX(temp, temp, Result);
  519.       | Root      : Next(); XM.rootX(temp, Result, temp);
  520.       | Squared   : GetToken(arg); X.ExMult(temp, temp, temp);
  521.       | Cubed     : GetToken(arg); XM.xtoi(temp, temp, 3);
  522.       | Inverse   : GetToken(arg); X.ExDiv(temp, X.Ex1, temp);
  523.       | Factorial : GetToken(arg);
  524.                     XM.factorialX(temp, X.ExToLongInt(temp));
  525.       | PercentOf : GetToken(arg);
  526.                     X.ExNumb(0, 1, -1, Result);        (* 0.01 *)
  527.                     X.ExMult(Result, temp, Result);
  528.                     Factor(arg, temp);
  529.                     X.ExMult(temp, temp, Result);
  530.       ELSE (* skip token *)
  531.                     X.ExStatus := X.IllegalOperator;
  532.                     GetToken(arg);
  533.     END;
  534.   END;
  535.   Result := temp;
  536. END Powers;
  537.  
  538.  
  539. PROCEDURE Term (VAR arg : ARRAY OF CHAR; VAR Result : X.ExNumType);
  540. VAR
  541.   temp, temp2 : X.ExNumType;
  542.  
  543.   PROCEDURE Next;
  544.   BEGIN
  545.     GetToken(arg); Powers(arg, Result);
  546.   END Next;
  547.  
  548.   PROCEDURE ToCard(Ex : X.ExNumType) : INTEGER;
  549.   BEGIN
  550.     RETURN SHORT(X.ExToLongInt(Ex));
  551.   END ToCard;
  552.  
  553. BEGIN
  554.   Powers(arg, temp);
  555.   WHILE (Token >= Times) & (Token <= ShiftRight) DO
  556.     CASE Token OF
  557.         Times       : Next(); X.ExMult(temp, Result, temp);
  558.       | Divide      : Next(); X.ExDiv(temp, temp, Result);
  559.       | Div         : Next(); XI.ExIntDiv(temp, temp, Result);
  560.       | Mod         : Next(); XI.ExMod(temp, temp, Result);
  561.       | And         : Next(); XI.ExAnd(temp, temp, Result);
  562.       | ShiftRight  : Next(); XI.ExShr(temp, temp, ToCard(Result));
  563.       | AShiftRight : Next(); XI.ExAshr(temp, temp, ToCard(Result));
  564.       | RotateRight : Next(); XI.ExRor(temp, temp, ToCard(Result));
  565.       | ShiftLeft   : Next(); XI.ExShl(temp, temp, ToCard(Result));
  566.       | RotateLeft  : Next(); XI.ExRol(temp, temp, ToCard(Result));
  567.       | ClearBit    : Next(); XI.ExClearBit(temp, temp, ToCard(Result));
  568.       | SetBit      : Next(); XI.ExSetBit(temp, temp, ToCard(Result));
  569.       | ToggleBit   : Next(); XI.ExToggleBit(temp, temp, ToCard(Result));
  570.       ELSE (* skip token *)
  571.                       GetToken(arg); X.ExStatus := X.IllegalOperator;
  572.     END;
  573.   END;
  574.   Result := temp;
  575. END Term;
  576.  
  577.  
  578. PROCEDURE Expression (VAR arg : ARRAY OF CHAR;
  579.                       VAR Result : X.ExNumType);
  580. VAR
  581.   temp : X.ExNumType;
  582.   Str  : String;
  583.  
  584.   PROCEDURE Next(VAR Result : X.ExNumType);
  585.   BEGIN
  586.     GetToken(arg); Term(arg, Result);
  587.   END Next;
  588.  
  589. BEGIN
  590.   CASE Token OF
  591.       Plus  : Next(temp);
  592.     | Minus : Next(temp); X.ExChgSign(temp);
  593.       ELSE    Term(arg, temp)
  594.   END;
  595.   WHILE (Token >= Plus) & (Token <= StoreMem) DO
  596.     CASE Token OF
  597.         Plus     : Next(Result); X.ExAdd(temp, temp, Result);
  598.       | Minus    : Next(Result); X.ExSub(temp, temp, Result);
  599.       | Or       : Next(Result); XI.ExOr(temp, Result, temp);
  600.       | Xor      : Next(Result); XI.ExXor(temp, Result, temp);
  601.       | StoreMem : Next(Result); StoreMemory(Result, temp);
  602.       ELSE         Term(arg, temp);
  603.     END;
  604.   END;
  605.   Result := temp;
  606. END Expression;
  607.  
  608.  
  609. PROCEDURE SimpleExpression (VAR arg : ARRAY OF CHAR;
  610.                             VAR Result : X.ExNumType);
  611. BEGIN
  612.   X.ExStatus := X.Okay;(* clear out any previous errors         *)
  613.   GetToken(arg);   (* start things off with the first token *)
  614.   Expression(arg, Result);
  615.   State.LastAnswer := Result;
  616. END SimpleExpression;
  617.  
  618.  
  619. PROCEDURE GetCLI(VAR Str : ARRAY OF CHAR) : BOOLEAN;
  620. BEGIN
  621.   IF arg.NumArgs() < 1 THEN
  622.     Str := "";
  623.     RETURN FALSE;
  624.   ELSE
  625.     arg.GetArg(1, Str);
  626.     RETURN TRUE;
  627.   END;
  628. END GetCLI;
  629.  
  630.  
  631. PROCEDURE WriteAsString(x : X.ExNumType);
  632. BEGIN
  633.   IF State.LocalBase = 10 THEN
  634.     IF State.SciNotation THEN
  635.       X.ExNumToStr(x, State.DecPoint, 1, ResultStr);
  636.     ELSE
  637.       X.ExNumToStr(x, State.DecPoint, 0, ResultStr);
  638.     END;
  639.   ELSE
  640.     XI.ExIntToStr(x, State.LocalBase, ResultStr);
  641.   END;
  642.   IF X.ExStatus = X.Okay THEN
  643.     io.WriteString(ResultStr);
  644.   ELSE
  645.     io.WriteString("Illegal input string!");
  646.   END;
  647.   io.WriteLn;
  648. END WriteAsString;
  649.  
  650.  
  651. BEGIN
  652.   (* Local gradian conversion constants *)
  653.   X.StrToExNum(
  654.   "1.570796326794896619231321691639751442098584699687555E-2",
  655.   FromGradians);
  656.   X.StrToExNum(
  657.   "6.366197723675813430755350534900574481378385829618240E+1",
  658.   ToGradians);
  659.  
  660.   Token := Empty;
  661.   GetState();
  662.   LOOP
  663.     IF GetCLI(CommandLine) THEN
  664.       SimpleExpression(CommandLine, Answer);
  665.       WriteAsString(Answer);
  666.       EXIT;
  667.     END;
  668.     io.WriteString("Calc");
  669.     CASE State.DegRadFlag OF
  670.       | Degrees  : io.Write("D")
  671.       | Radians  : io.Write("R")
  672.       | Gradians : io.Write("G")
  673.     END;
  674.     IF State.LocalBase # 10 THEN
  675.       io.WriteString("Bas");
  676.       io.WriteInt(State.LocalBase, 1);
  677.     END;
  678.     io.WriteString("> ");
  679.     iox.ReadLine(CommandLine);
  680.     IF s.Length(CommandLine) = 0 THEN
  681.       EXIT;
  682.     END;
  683.     SimpleExpression(CommandLine, Answer);
  684.     WriteAsString(Answer);
  685.   END;
  686.   SaveState();
  687. END Calculator.
  688.