home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / modula2 / plo.mod < prev    next >
Text File  |  1987-01-08  |  8KB  |  326 lines
  1. (* Skeleton compiler which checks the syntax of its input text
  2.    according to the following grammar.  Principle is top-down,
  3.    recursive descent with one symbol lookahead.  (see also N.
  4.    Wirth, Algorithms + Data Structures = Programs, Ch. 5,
  5.    Prentice-Hall, Inc. 1975)
  6.  
  7.    program =   block ".".
  8.    block =     ["CONST" ident "=" number {"," ident "=" number} ";"]
  9.               ["VAR" ident {"," ident} ";"]
  10.            ["PROCEDURE" ident ";" block ";"} statement.
  11.    statement = ident ":=" expression| "CALL" ident |
  12.                "BEGIN" statement {";" statement} "END" |
  13.                "IF" condition "THEN" statement |
  14.                "WHILE" condition "DO" statement].
  15.    condition = "ODD" expression |
  16.                expression ("="|"#"|">"|"<"|"<="|">=") expression.
  17.    expression= ["+"|"-"] term {("+"|"-") term}.
  18.    term      = factor {("*"|"/") factor}.
  19.    factor    = ident | number | "(" expression ")". *)
  20.  
  21. MODULE plo;
  22.  
  23. FROM InOut    IMPORT OpenInput,Done,CloseInput,Read,in,WriteInt;
  24. FROM Terminal IMPORT WriteString,Write,WriteLn;
  25.  
  26. CONST
  27.   norw = 11;
  28.   tmax = 100;
  29.   nmax = 14;
  30.   al = 10;
  31.   chsetsize = 128;
  32.  
  33. TYPE
  34.   symbol = (nul,ident,number,plus,minus,times,slash,oddsym,
  35.             eql,neq,lss,leq,gtr,geq,lparen,rparen,comma,semicolon,
  36.             period,becomes,beginsym,endsym,ifsym,thensym,
  37.             whilesym,dosym,callsym,constsym,varsym,procsym);
  38.  
  39.   alfa = ARRAY [0..al] OF CHAR;
  40.   object = (constant,variable,prozedure);
  41.  
  42. VAR
  43.   tch,ch:   CHAR;
  44.   sym:  symbol;
  45.   id:   alfa;
  46.   num:  INTEGER;
  47.   cc:   INTEGER;
  48.   ll:   INTEGER;
  49.   kk:   INTEGER;
  50.   line: ARRAY [1..81] OF CHAR;
  51.   a:    alfa;
  52.   word: ARRAY [1..norw] OF alfa;
  53.   wsym: ARRAY [1..norw] OF symbol;
  54.   ssym: ARRAY [0C..'}'] OF symbol;
  55.   table:ARRAY [0..tmax] OF
  56.         RECORD
  57.           name: alfa;
  58.           kind: object
  59.         END;
  60.  
  61. PROCEDURE error(n: INTEGER);
  62.   VAR i: INTEGER;
  63.  
  64. BEGIN
  65.   FOR i := 1 TO cc DO Write(' ') END;
  66.   Write('>'); WriteInt(n,2);
  67.   HALT
  68. END error;
  69.  
  70. PROCEDURE compalfa(a,b:alfa):symbol;
  71. VAR res: symbol; i: INTEGER;
  72.  
  73. BEGIN
  74.   i := 1;
  75.   res := eql;
  76.   LOOP
  77.     IF CAP(a[i]) < CAP(b[i]) THEN res := lss; EXIT
  78.     ELSIF CAP(a[i]) > CAP(b[i]) THEN res := gtr; EXIT
  79.     ELSE INC(i)
  80.     END;
  81.     IF i >= al THEN EXIT END;
  82.   END;
  83.   RETURN(res);
  84. END compalfa;
  85.  
  86. PROCEDURE getsym;
  87.   VAR i,j,k: INTEGER;
  88.  
  89.   PROCEDURE getch;
  90.   BEGIN
  91.     IF cc = ll THEN
  92.       IF in.eof THEN WriteString(' program incomplete'); HALT END;
  93.       Read(ch);
  94.       ll := 0; cc := 0; Write(' ');
  95.       WHILE (ch <> 36C) AND NOT in.eof DO
  96.         INC(ll); Write(ch); line[ll] := ch; Read(ch)
  97.       END;
  98.       WriteLn;
  99.     END;
  100.     INC(cc); ch := line[cc]
  101.   END getch;
  102.  
  103. BEGIN
  104.   WHILE ch = ' ' DO getch END;
  105.   IF (ch >= 'a') AND (ch <= 'z') THEN
  106.     k := 0;
  107.     REPEAT
  108.       IF k < al THEN INC(k); a[k] := ch END;
  109.       getch;
  110.     UNTIL ((ch < 'a') OR (ch > 'z')) AND ((ch < '0') OR (ch > '9'));
  111.     IF k >= kk THEN kk := k
  112.     ELSE REPEAT a[kk] := ' '; DEC(kk); UNTIL kk = k
  113.     END;
  114.     id := a; i := 1; j := norw;
  115.     REPEAT
  116.       k := (i+j) DIV 2;
  117.       IF compalfa(id,word[k]) # gtr THEN j := k-1 END;
  118.       IF compalfa(id,word[k]) # lss THEN i := k+1 END;
  119.     UNTIL i > j;
  120.     IF i-1 > j THEN sym := wsym[k] ELSE sym := ident END;
  121.   ELSIF (ch >= '0') AND (ch <= '9') THEN
  122.     k := 0; num := 0;
  123.     sym := number;
  124.     REPEAT
  125.       num := 10 * num + INTEGER((ORD(ch)-ORD('0')));
  126.       INC(k); getch;
  127.     UNTIL (ch < '0') OR (ch > '9');
  128.     IF k > nmax THEN error(30) END;
  129.   ELSIF ch = ':' THEN
  130.     getch;
  131.     IF ch = '=' THEN sym := becomes; getch
  132.     ELSE sym := nul;
  133.     END;
  134.   ELSIF ch = '<' THEN
  135.     getch;
  136.     IF ch = '=' THEN sym := leq; getch
  137.     ELSE sym := lss;
  138.     END;
  139.   ELSIF ch = '>' THEN
  140.     getch;
  141.     IF ch = '=' THEN sym := geq; getch
  142.     ELSE sym := gtr;
  143.     END;
  144.   ELSE sym := ssym[ch]; getch
  145.   END;
  146. END getsym;
  147.  
  148. PROCEDURE block(tx: INTEGER);
  149.  
  150.   PROCEDURE enter(k: object);
  151.   BEGIN
  152.     INC(tx);
  153.     WITH table[tx] DO
  154.       name := id; kind := k;
  155.     END;
  156.   END enter;
  157.  
  158.   PROCEDURE position(id: alfa): INTEGER;
  159.   VAR i: INTEGER;
  160.   BEGIN
  161.     table[0].name := id; i := tx;
  162.     WHILE compalfa(table[i].name,id) # eql DO i := i-1 END;
  163.     RETURN(i);
  164.   END position;
  165.  
  166.   PROCEDURE constdeclaration;
  167.   BEGIN
  168.     IF sym = ident THEN
  169.       getsym;
  170.       IF sym = eql THEN
  171.         getsym;
  172.         IF sym = number THEN
  173.           enter(constant); getsym
  174.         ELSE error(2); END
  175.       ELSE error(3) END
  176.     ELSE error(4) END
  177.   END constdeclaration;
  178.  
  179.   PROCEDURE vardeclaration;
  180.   BEGIN
  181.     IF sym = ident THEN
  182.       enter(variable); getsym
  183.     ELSE error(4) END;
  184.   END vardeclaration;
  185.  
  186.   PROCEDURE statement;
  187.   VAR i: INTEGER;
  188.   
  189.     PROCEDURE expression;
  190.  
  191.       PROCEDURE term;
  192.  
  193.         PROCEDURE factor;
  194.         VAR i: INTEGER;
  195.         BEGIN
  196.           IF sym = ident THEN
  197.             i := position(id);
  198.             IF i = 0 THEN error(0)
  199.             ELSIF table[i].kind = prozedure THEN error(21)
  200.             END; getsym;
  201.           ELSIF sym = number THEN
  202.             getsym;
  203.           ELSIF sym = lparen THEN
  204.             getsym; expression;
  205.             IF sym = rparen THEN getsym;
  206.             ELSE error(22)
  207.             END
  208.           ELSE error(23)
  209.           END;
  210.         END factor;
  211.  
  212.       BEGIN (* term *)
  213.         factor;
  214.         WHILE (sym = times) OR (sym = slash) DO
  215.           getsym; factor;
  216.         END;
  217.       END term;
  218.  
  219.     BEGIN (* expression *)
  220.       IF (sym = plus) OR (sym = minus) THEN
  221.         getsym; term
  222.       ELSE term
  223.       END;
  224.       WHILE (sym = plus) OR (sym = minus) DO
  225.         getsym; term
  226.       END;
  227.     END expression;
  228.  
  229.     PROCEDURE condition;
  230.     BEGIN
  231.       IF sym = oddsym THEN
  232.         getsym; expression
  233.       ELSE
  234.         expression;
  235.         IF (ORD(sym) < ORD(eql)) OR (ORD(sym) > ORD(geq)) THEN error(20)
  236.         ELSE getsym; expression
  237.         END
  238.       END;
  239.     END condition;
  240.  
  241.   BEGIN (* statement *)
  242.     IF sym = ident THEN
  243.       i := position(id);
  244.       IF i = 0 THEN error (11)
  245.       ELSIF table[i].kind # variable THEN error(12)
  246.       END; getsym;
  247.       IF sym = becomes THEN getsym ELSE error(13) END;
  248.       expression
  249.     ELSIF sym = callsym THEN getsym;
  250.       IF sym # ident THEN error(14)
  251.       ELSE i := position(id);
  252.         IF i = 0 THEN error(11)
  253.         ELSIF table[i].kind # prozedure THEN error(15)
  254.         END; getsym
  255.       END;
  256.     ELSIF sym = ifsym THEN
  257.       getsym; condition;
  258.       IF sym = thensym THEN getsym ELSE error(16) END;
  259.       statement;
  260.     ELSIF sym = beginsym THEN
  261.       getsym; statement;
  262.       WHILE sym = semicolon DO
  263.         getsym; statement
  264.       END;
  265.       IF sym = endsym THEN getsym ELSE error(17) END;
  266.     ELSIF sym = whilesym THEN
  267.       getsym; condition;
  268.       IF sym = dosym THEN getsym ELSE error(18) END;
  269.       statement
  270.     END;
  271.   END statement;
  272.  
  273. BEGIN (* block *)
  274.   IF sym = constsym THEN
  275.     getsym; constdeclaration;
  276.     WHILE sym = comma DO
  277.      getsym;  constdeclaration
  278.     END;
  279.     IF sym = semicolon THEN getsym ELSE error(5) END;
  280.   END;
  281.   IF sym = varsym THEN
  282.     getsym; vardeclaration;
  283.     WHILE sym = comma DO
  284.       getsym; vardeclaration
  285.     END;
  286.     IF sym = semicolon THEN getsym ELSE error(5) END;
  287.   END;
  288.   WHILE sym = procsym DO
  289.     getsym;
  290.     IF sym = ident THEN enter(prozedure); getsym ELSE error(4); END;
  291.     IF sym = semicolon THEN getsym ELSE error(5) END;
  292.     block(tx);
  293.     IF sym = semicolon THEN getsym ELSE error(5) END
  294.   END;
  295.   statement;
  296. END block;
  297.  
  298. BEGIN (* main program *)
  299.   FOR ch := 0C TO '}' DO ssym[ch] := nul END;
  300.   word[ 1] := " BEGIN    "; word[ 2] := " CALL     ";
  301.   word[ 3] := " CONST    "; word[ 4] := " DO       ";
  302.   word[ 5] := " END      "; word[ 6] := " IF       ";
  303.   word[ 7] := " ODD      "; word[ 8] := " PROCEDURE";
  304.   word[ 9] := " THEN     "; word[10] := " VAR      ";
  305.   word[11] := " WHILE    ";
  306.   wsym[ 1] := beginsym;    wsym[ 2] := callsym;
  307.   wsym[ 3] := constsym;    wsym[ 4] := dosym;
  308.   wsym[ 5] := endsym;      wsym[ 6] := ifsym;
  309.   wsym[ 7] := oddsym;      wsym[ 8] := procsym;
  310.   wsym[ 9] := thensym;     wsym[10] := varsym;
  311.   wsym[11] := whilesym;
  312.   ssym['+'] := plus;       ssym['-'] := minus;
  313.   ssym['*'] := times;      ssym['/'] := slash;
  314.   ssym['('] := lparen;     ssym[')'] := rparen;
  315.   ssym['='] := eql;        ssym[','] := comma;
  316.   ssym['.'] := period;     ssym['#'] := neq;
  317.   ssym['<'] := lss;        ssym['>'] := gtr;
  318.   ssym[';'] := semicolon;
  319.   Write(14C);
  320.   OpenInput("PLO"); a[0] := ' ';
  321.   in.eof := FALSE;
  322.   cc := 0; ll := 0; ch := ' '; kk := al; getsym;
  323.   block(0);
  324.   IF sym # period THEN error(9) END;
  325. END plo.
  326.