home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Demos / Pute.mod < prev    next >
Encoding:
Text File  |  1992-11-02  |  3.6 KB  |  164 lines
  1. MODULE Pute;
  2.  
  3. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  4.  
  5. IMPORT io,
  6.        ol := OberonLib;
  7.  
  8. CONST
  9.   lparen = 0; rparen = 1; times  = 2; plus   = 3; minus  = 4;
  10.   div    = 5; mod    = 6; number = 7; eof    = -1;
  11.  
  12. TYPE String = ARRAY 80 OF CHAR;
  13.  
  14. VAR
  15.   Sym: SHORTINT;
  16.   Number: LONGINT;
  17.   Char: CHAR;
  18.   buffer: UNTRACED POINTER TO String;
  19.   index: INTEGER;
  20.   Identifier: String;
  21.   result: LONGINT;
  22.  
  23. (*-------------------------------------------------------------------------*)
  24.  
  25. PROCEDURE ReadChar;
  26.  
  27. BEGIN
  28.   IF index=ol.dosCmdLen THEN Char := 0X;
  29.                         ELSE Char := CAP(buffer^[index]); INC(index) END;
  30. END ReadChar;
  31.  
  32. (*-------------------------------------------------------------------------*)
  33.  
  34. PROCEDURE Error;
  35.  
  36. BEGIN
  37.   io.WriteString("Usage: PUTE <Expression>"); io.WriteLn; HALT(0)
  38. END Error;
  39.  
  40. (*-------------------------------------------------------------------------*)
  41.  
  42. PROCEDURE GetSym();
  43.  
  44. VAR
  45.   digit: String;    (* used to read constant numbers *)
  46.   cnt,i: INTEGER;
  47.   n: SHORTINT;
  48.  
  49. BEGIN
  50.   WHILE (Char<=" ") AND (Char>0X) DO ReadChar END;
  51.   CASE Char OF
  52.   "A".."Z":
  53.     cnt := 0;
  54.     WHILE (Char>="A") AND (Char<="Z") DO
  55.       Identifier[cnt] := Char;
  56.       ReadChar;
  57.       INC(cnt); IF cnt=80 THEN Error END;
  58.     END;
  59.     Identifier[cnt] := 0X;
  60.     IF    Identifier="DIV" THEN Sym := div
  61.     ELSIF Identifier="MOD" THEN Sym := mod
  62.     ELSE Error END |
  63.   "0".."9":
  64.     cnt := -1;
  65.     WHILE ((Char>="0") AND (Char<="9")) OR ((Char>="A") AND (Char<="Z")) DO
  66.       INC(cnt);
  67.       IF cnt=80 THEN Error END;
  68.       digit[cnt] := Char;
  69.       ReadChar;
  70.     END;
  71.     Number := 0; i := 0;
  72.     IF digit[cnt]#"H" THEN
  73.       WHILE i<=cnt DO
  74.         n := SHORT(ORD(digit[i])-ORD("0"));
  75.         CASE n OF 0..9: Number := 10 * Number + n ELSE Error END;
  76.         INC(i);
  77.       END;
  78.     ELSE
  79.       WHILE i<cnt DO
  80.         n := SHORT(ORD(digit[i])-ORD("0"));
  81.         IF n>9 THEN DEC(n,7) END;
  82.         CASE n OF 0..15: Number := 16 * Number + n ELSE Error END;
  83.         INC(i);
  84.       END;
  85.     END;
  86.     Sym := number;
  87.     RETURN |
  88.   "(": Sym := lparen |
  89.   ")": Sym := rparen |
  90.   "*": Sym := times  |
  91.   "+": Sym := plus   |
  92.   "-": Sym := minus  |
  93.   "/": Sym := div    |
  94.   0X : Sym := eof    |
  95.   ELSE Error END;
  96.   ReadChar;
  97. END GetSym;
  98.  
  99. (*-------------------------------------------------------------------------*)
  100.  
  101. PROCEDURE Expression(): LONGINT;
  102.  
  103. VAR
  104.   c: LONGINT;
  105.   addOperator: SHORTINT;
  106.  
  107.   PROCEDURE Term(): LONGINT;
  108.  
  109.   VAR
  110.     d,c: LONGINT;
  111.     s: SHORTINT;
  112.  
  113.     PROCEDURE Factor(): LONGINT;
  114.     VAR c: LONGINT;
  115.     BEGIN
  116.       CASE Sym OF number: c := Number; GetSym |
  117.                   lparen: GetSym; c:=Expression();
  118.                           IF Sym#rparen THEN Error END;
  119.                           GetSym |
  120.       ELSE Error END;
  121.       RETURN c
  122.     END Factor;
  123.  
  124.   BEGIN
  125.     c := Factor();
  126.     LOOP
  127.       CASE Sym OF
  128.       times,div,mod:
  129.         s := Sym;
  130.         GetSym; d := Factor();
  131.         IF s=times  THEN c := c * d;
  132.         ELSIF d=0   THEN HALT(0)
  133.         ELSIF s=div THEN c := c DIV d;
  134.                     ELSE c := c MOD d END |
  135.       ELSE EXIT END;
  136.     END;
  137.     RETURN c;
  138.   END Term;
  139.  
  140. BEGIN
  141.   addOperator := Sym;
  142.   IF (addOperator=plus) OR (addOperator=minus) THEN GetSym END;
  143.   c := Term();
  144.   IF addOperator=minus THEN c := -c END;
  145.   LOOP
  146.     CASE Sym OF
  147.     plus : GetSym; INC(c,Term()) |
  148.     minus: GetSym; DEC(c,Term()) |
  149.     ELSE EXIT END;
  150.   END;
  151.   RETURN c;
  152. END Expression;
  153.  
  154. BEGIN
  155.   IF ol.wbStarted THEN Error END;
  156.   buffer := ol.dosCmdBuf;
  157.   Char := " "; GetSym;
  158.   result := Expression(); IF Sym#eof THEN Error END;
  159.   io.WriteInt(result,11); io.WriteString(" = ");
  160.   io.WriteHex(result,8); io.Write("H"); io.WriteLn;
  161. END Pute.
  162.  
  163.  
  164.