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