BSD 2 development

[unix-history] / .ref-BSD-1 / pcs / pascals.p

program pascals(input,output);     (*1.7.75*)
(*$t-,p-  n.wirth,  e.t.h.
          clausiusstr.55   ch-8006 zurich    *)
#include "globals.i"
#include "error.i"
#include "scanner.i"
#include "tables.i"
#include "block.i"
#include "interpret.i"
 
begin writeln;
  key[ 1] := 'and       '; key[ 2] := 'array     ';
  key[ 3] := 'begin     '; key[ 4] := 'case      ';
  key[ 5] := 'const     '; key[ 6] := 'div       ';
  key[ 8] := 'downto    '; key[ 7] := 'do        ';
  key[ 9] := 'else      '; key[10] := 'end       ';
  key[11] := 'for       '; key[12] := 'function  ';
  key[13] := 'if        '; key[14] := 'mod       ';
  key[15] := 'not       '; key[16] := 'of        ';
  key[17] := 'or        '; key[18] := 'procedure ';
  key[19] := 'program   '; key[20] := 'record    ';
  key[21] := 'repeat    '; key[22] := 'then      ';
  key[23] := 'to        '; key[24] := 'type      ';
  key[25] := 'until     '; key[26] := 'var       ';
  key[27] := 'while     ';
  ksy[ 1] := andsy;        ksy[ 2] := arraysy;
  ksy[ 3] := beginsy;      ksy[ 4] := casesy;
  ksy[ 5] := constsy;      ksy[ 6] := idiv;
  ksy[ 8] := downtosy;     ksy[ 7] := dosy;
  ksy[ 9] := elsesy;       ksy[10] := endsy; 
  ksy[11] := forsy;        ksy[12] := functionsy;
  ksy[13] := ifsy;         ksy[14] := imod;
  ksy[15] := notsy;        ksy[16] := ofsy;
  ksy[17] := orsy;         ksy[18] := proceduresy; 
  ksy[19] := programsy;    ksy[20] := recordsy; 
  ksy[21] := repeatsy;     ksy[22] := thensy;
  ksy[23] := tosy;         ksy[24] := typesy;
  ksy[25] := untilsy;      ksy[26] := varsy; 
  ksy[27] := whilesy;
  sps['+'] := plus;        sps['-'] := minus;
  sps['*'] := times;       sps['/'] := rdiv; 
  sps['('] := lparent;     sps[')'] := rparent; 
  sps['='] := eql;         sps[','] := comma;
  sps['['] := lbrack;      sps[']'] := rbrack;
  sps['#'] := neq;         sps['&'] := andsy;
  sps[';'] := semicolon; 
 constbegsys := [plus,minus,intcon,realcon,charcon,ident]; 
 typebegsys := [ident,arraysy,recordsy]; 
 blockbegsys := [constsy,typesy,varsy,proceduresy,functionsy,beginsy]; 
 facbegsys := [intcon,realcon,charcon,ident,lparent,notsy];
 statbegsys := [beginsy,ifsy,whilesy,repeatsy,forsy,casesy]; 
 stantyps := [notyp,ints,reals,bools,chars]; 
 lc := 0; ll := 0; cc := 0; ch := ' '; 
 errpos := 0; errs := []; insymbol;
 t := -1; a := 0; b := 1; sx := 0; c2 := 0;
 display[0] := 1; 
 iflag := false; oflag := false; 
 if sy <> programsy then error(3) else 
 begin insymbol;
   if sy <> ident then error(2) else
   begin progname := id; insymbol; 
     if sy <> lparent then error(9) else
     repeat insymbol;
       if sy <> ident then error(2) else
       begin if id = 'input     ' then iflag := true else 
             if id = 'output    ' then oflag := true else error(0); 
          insymbol 
       end 
     until sy <> comma; 
     if sy = rparent then insymbol else error(4);
     if not oflag then error(20)
   end
 end ;
 enter('          ', variable, notyp, 0);  (*sentinel*)
 enter('false     ', konstant, bools, 0);
 enter('true      ', konstant, bools, 1);
 enter('real      ', type1, reals, 1); 
 enter('char      ', type1, chars, 1); 
 enter('boolean   ', type1, bools, 1); 
 enter('integer   ', type1, ints , 1); 
 enter('abs       ', funktion, reals,0); 
 enter('sqr       ', funktion, reals,2); 
 enter('odd       ', funktion, bools,4); 
 enter('chr       ', funktion, chars,5); 
 enter('ord       ', funktion, ints, 6); 
 enter('succ      ', funktion, chars,7); 
 enter('pred      ', funktion, chars,8); 
 enter('round     ', funktion, ints, 9); 
 enter('trunc     ', funktion, ints, 10);
 enter('sin       ', funktion, reals, 11); 
 enter('cos       ', funktion, reals, 12); 
 enter('exp       ', funktion, reals, 13); 
 enter('ln        ', funktion, reals, 14); 
 enter('sqrt      ', funktion, reals, 15); 
 enter('arctan    ', funktion, reals, 16); 
 enter('eof       ', funktion, bools, 17); 
 enter('eoln      ', funktion, bools, 18); 
 enter('read      ', prozedure, notyp, 1); 
 enter('readln    ', prozedure, notyp, 2); 
 enter('write     ', prozedure, notyp, 3); 
 enter('writeln   ', prozedure, notyp, 4); 
 enter('          ', prozedure, notyp, 0); 
 with btab[1] do
   begin last := t; lastpar := 1; psize := 0; vsize := 0
   end ; 
 
 block(blockbegsys+statbegsys, false, 1);
 if sy <> period then error(22);
 emit(31);  (*halt*) 
 if btab[2].vsize > stacksize then error(49);
 if progname = 'test0     ' then printtables;
 
 if errs = [] then 
 begin
{ must block all of this out for now.
   if iflag then
   begin  getseg(input); 
     if eof(input) then writeln(' input data missing') else
     begin writeln(' (eor)'); (*copy input data*)
       while not eof(input) do
       begin write(' '); 
         while not eoln(input) do 
           begin read(ch); write(ch)
           end ;
         writeln; read(ch)
       end ; 
       getseg(input,0) 
     end 
   end ; 
all this because of segmented file repositioning!! }
   writeln(' (eof)');
   interpret 
 end 
 else errormsg;
99: 
end .