x.txt

pl0

Program Pascals;     (*1.6.75*)
(*        N. Wirth,  E.T.H.      Clausiusstr.55   CH-8006 Zurich    *)
(* Omskrevet til TurboPascal v.4.0.      B. Nielsen                  *)
Label  99;
Const
  nkw  =        27;     (* no. of key words                         *)
  alng =        10;     (* no. of significant chars in identifiers  *)
  llng =       120;     (* input line length                        *)
  emax =       322;     (* max exponent of real numbers             *)
  emin =      -292;     (* min exponent                             *)
  kmax =        15;     (* max no. of significant digits            *) 
  tmax =       100;     (* size of table                            *)
  bmax =        20;     (* size of block-table                      *)
  amax =        30;     (* size of array-table                      *)
  c2max =       20;     (* size of real constant table              *)
  csmax =       30;     (* max no. of cases                         *)
  cmax =       850;     (* size of code                             *)
  lmax =         7;     (* maximum level                            *)
  smax =       600;     (* size of string-table                     *)
  ermax =       58;     (* max error no.                            *)
  omax =        63;     (* highest order code                       *)
  xmax =      1000;     (* 131071 2**17 - 1                         *)
  nmax =     32767;     (* 281474976710655 2**48-1                  *)
  lineleng   = 136;     (* output line length                       *) 
  linelimit  = 200;
  stacksize = 1500;
Type 
  xstring = string(.255.);
  symbol = (intcon,realcon,charcon,stringsy,
            notsy,plus,minus,times,idiv,rdiv,imod,andsy,orsy,
            eql,neq,gtr,geq,lss,leq,
            lparent,rparent,lbrack,rbrack,comma,semicolon,period,
            colon,becomes,constsy,typesy,varsy,functionsy,
            proceduresy,arraysy,recordsy,programsy,ident,
            beginsy,ifsy,casesy,repeatsy,whilesy,forsy,
            endsy,elsesy,untilsy,ofsy,dosy,tosy,downtosy,thensy);
  index  = -xmax .. +xmax;
  alfa   = Packed Array (.1..alng.) of char;
  object = (konstant,variable,type1,prozedure,funktion);
  types  = (notyp,ints,reals,bools,chars,arrays,records);
  symset = set of symbol;
  typset = set of types;
  item   = Record
             typ: types; ref: index;
           End;
  order  = Packed Record
             f: -omax..+omax;
             x: -lmax..+lmax;
             y: -nmax..+nmax;
           End;
Var
  InputFile: Text;
  sy: symbol;          (*last symbol read by insymbol*)
  id: alfa;            (*identifier from insymbol*)
  inum: integer;       (*integer from insymbol*)   
  rnum: real;          (*real number from insymbol*)
  sleng: integer;      (*string length*)
  ch: char;            (*last character read from source program*)
  line: Array (.1..llng.) of char;
  cc: integer;         (*character count*)
  lc: integer;         (*program location counter*)
  ll: integer;         (*length of current line*)
  errs: set of 0..ermax;
  errpos: integer;
  progname: alfa;
  iflag, oflag: boolean;
  constbegsys,typebegsys,blockbegsys,facbegsys,statbegsys: symset;
  key: Array (.1..nkw.) of alfa;
  ksy: Array (.1..nkw.) of symbol;
  sps: Array (.char.) of symbol;  (*special symbols*)
  xname: xstring;
  t,a,b,sx,c1,c2: integer;  (*indices to tables*)
  stantyps: typset;
  display: Array (.0 .. lmax.) of integer;
  tab:     Array  (.0..tmax.) of      (*identifier table*)
             Packed Record
               name: alfa;  link: index;
               obj: object; typ: types;
               ref: index;  normal: boolean;
               lev: 0 .. lmax; adr: integer;
             End;
  atab:    Array  (.1..amax.) of      (*array-table*)
             Packed Record
               inxtyp, eltyp: types;
               elref, low, high, elsize, size: index;
             End;
  btab:    Array  (.1..bmax.) of      (*block-table*)
             Packed Record
               last, lastpar, psize, vsize: index;
             End;
  stab:    Packed Array (.0..smax.) of char;  (*string table*)
  rconst:  Array (.1 .. c2max.) of real;
  kode:    Array (.0 .. cmax.) of order;  
(*Function sin(r: real): real; Begin sin:=0 End;                *)
(*Function cos(r: real): real; Begin End;                       *)
(*Function ln(r: real): real; Begin ln:=0 End;                  *)
(*Function sqrt(r: real): real; Begin sqrt:=0 End;              *)
(*Function exp(r: real): real; Begin exp:=0 End;                *)
(*Function eos(Var t: text): boolean; Begin eos:=eof(t) End;    *)
(*Function arctan(r: real): real; Begin arctan:=0 End;          *)
  Procedure errormsg;
  Var
    k:   integer;
    msg: Array (.0..ermax.) of alfa;
  Begin
    msg(. 0.) := 'undef id  '; msg(. 1.) := 'multi def ';
    msg(. 2.) := 'identifier'; msg(. 3.) := 'program   ';
    msg(. 4.) := ')         '; msg(. 5.) := ':         ';
    msg(. 6.) := 'syntax    '; msg(. 7.) := 'ident, var';
    msg(. 8.) := 'of        '; msg(. 9.) := '(         ';
    msg(.10.) := 'id, array '; msg(.11.) := '[         ';
    msg(.12.) := ']         '; msg(.13.) := '..        ';
    msg(.14.) := ';         '; msg(.15.) := 'func. type';
    msg(.16.) := '=         '; msg(.17.) := 'boolean   ';
    msg(.18.) := 'convar typ'; msg(.19.) := 'type      ';
    msg(.20.) := 'prog.param'; msg(.21.) := 'too big   ';
    msg(.22.) := '.         '; msg(.23.) := 'typ (case)';
    msg(.24.) := 'character '; msg(.25.) := 'const id  ';
    msg(.26.) := 'index type'; msg(.27.) := 'indexbound';
    msg(.28.) := 'no array  '; msg(.29.) := 'type id   ';
    msg(.30.) := 'undef type'; msg(.31.) := 'no record ';
    msg(.32.) := 'boole type'; msg(.33.) := 'arith type';
    msg(.34.) := 'integer   '; msg(.35.) := 'types     ';
    msg(.36.) := 'param type'; msg(.37.) := 'variab id ';
    msg(.38.) := 'string    '; msg(.39.) := 'no.of pars';
    msg(.40.) := 'type      '; msg(.41.) := 'type      ';
    msg(.42.) := 'real type '; msg(.43.) := 'integer   ';
    msg(.44.) := 'var, const'; msg(.45.) := 'var, proc ';
    msg(.46.) := 'types (:=)'; msg(.47.) := 'typ (case)';
    msg(.48.) := 'type      '; msg(.49.) := 'store ovfl';
    msg(.50.) := 'constant  '; msg(.51.) := ':=        ';
    msg(.52.) := 'then      '; msg(.53.) := 'until     ';
    msg(.54.) := 'do        '; msg(.55.) := 'to downto ';
    msg(.56.) := 'begin     '; msg(.57.) := 'end       ';
    msg(.58.) := 'factor    ';
    k := 0;
    WriteLn;
    WriteLn(' key words');
    While errs <> (..) do
    Begin
      While not (k in errs) do
        k := k+1;
      WriteLn(k,'  ',msg(.k.));
      errs := errs - (.k.)
    End
  End (* errormsg*) ;
  Procedure nextch;   (*read next character; process line end*)
  Begin
    If cc = ll Then
    Begin
      If eof(InputFile) Then
      Begin
        WriteLn;
        WriteLn(' program incomplete');
        errormsg; (* goto 99;*)
        Halt
      End;
      If errpos <> 0 Then
      Begin 
        WriteLn;
        errpos := 0
      End;
      Write(lc:5, '  ');
      ll := 0; 
      cc := 0;
      While not eoln(InputFile) do
      Begin
        ll := ll+1; 
        read(InputFile,ch); 
        Write(ch); 
        line(.ll.) := ch
      End;
      WriteLn;
      readln(InputFile); 
      ll:=ll+1; 
      line(.ll.):=' ';
    End;
    cc := cc+1;
    ch := line(.cc.);
  End (*nextch*) ;
  Procedure Error(n: integer);
  Begin
    If errpos = 0 Then
      Write(' ****');
    If cc > errpos Then
    Begin
      Write(' ': cc-errpos, '^', n:2);
      errpos := cc+3;
      errs := errs + (.n.)
    End
  End (*Error*) ;
  Procedure fatal(n: integer);
  Var
    msg: Array (.1..7.) of alfa;
  Begin
    WriteLn;
    errormsg;
    msg(. 1.) := 'identifier'; msg(. 2.) := 'procedures';
    msg(. 3.) := 'reals     '; msg(. 4.) := 'arrays    ';
    msg(. 5.) := 'levels    '; msg(. 6.) := 'code      ';
    msg(. 7.) := 'strings   ';
    WriteLn(' compiler table for ', msg(.n.), ' is too small');
    (* goto 99 *) halt    (* terminate compilation*)
  End (*fatal*);
  Procedure insymbol;           (*reads next symbol*)
  label
    1,2,3;
  Var
    i,j,k,e: integer;  
    Procedure readscale;
    Var
      s, sign: integer;
    Begin
      nextch;
      sign := 1;
      s := 0;
      If ch = '+' Then
        nextch
      Else
        If ch = '-' Then
        Begin
          nextch;
          sign := -1
        End;
      While ch in (.'0'..'9'.) do
      Begin
        s := 10*s + ord(ch) - ord('0');
        nextch
      End ;
      e := s*sign + e
    End (*readscale*) ;  
    Procedure adjustscale;
    Var
      s: integer;
      d,t: real;
    Begin
      If k+e > emax Then
        Error(21)
      Else
        If k+e < emin Then
          rnum := 0
        Else
        Begin
          s := abs(e);
          t := 1.0;
          d := 10.0;
          Repeat
            While not odd(s) do
            Begin
              s := s div 2;
              d := sqr(d)
            End ;
            s := s-1;
            t := d*t
          Until s = 0;
          If e >= 0 Then
            rnum := rnum*t
          Else
            rnum := rnum/t
        End
    End (*adjustscale*) ;  
  Begin (*insymbol*) 
  1:While ch = ' ' do
      nextch;
    If ch in (.'a'..'z'.) Then
    Begin (*word*)  
      k := 0;
      id := '          ';
      Repeat
        If k < alng Then
        Begin
          k := k+1;
          id(.k.) := ch
        End;
        nextch
      Until not (ch in (.'a'..'z','0'..'9'.));
      i := 1;         (*binary search*)
      j := nkw;
      Repeat
        k := (i+j) div 2;
        If id <= key(.k.) Then
          j := k-1;
           If id >= key(.k.) Then i := k+1;
      Until i > j;
        If i-1 > j Then sy := ksy(.k.) Else sy := ident
    End
    Else
    If ch in (.'0'..'9'.) Then
    Begin (*number*)
      k := 0;
      inum := 0;
      sy := intcon;
      Repeat inum := inum*10 + ord(ch) - ord('0');
           k := k+1; nextch
      Until not (ch in (.'0'..'9'.));
      If (k > kmax) or (inum > nmax) Then
      Begin
        Error(21);
        inum := 0;
        k := 0
      End ;     
      If ch = '.' Then
      Begin
        nextch;
        If ch = '.' Then
          ch := ':' 
        Else
        Begin
          sy := realcon;
          rnum := inum;
          e := 0;
          While ch in (.'0'..'9'.) do
          Begin
            e := e-1;
            rnum := 10.0*rnum + (ord(ch) - ord('0'));
            nextch
          End ;
          If ch = 'e' Then
            readscale;
          If e <> 0 Then
            adjustscale
        End
      End
      Else
        If ch = 'e' Then
        Begin
          sy := realcon;
          rnum := inum;
          e := 0;
          readscale;
          If e <> 0 Then
            adjustscale
        End 
    End
    Else
    Case ch of
     ':' : Begin
             nextch;
             If ch = '=' Then
             Begin
               sy := becomes;
               nextch
             End
             Else
               sy := colon
           End;
     '<' : Begin
             nextch;
             If ch = '=' Then
             Begin
               sy := leq;
               nextch
             End
             Else
               If ch = '>' Then
               Begin
                 sy := neq;
                 nextch
               End
               Else
                 sy := lss
           End;
     '>' : Begin
             nextch;
             If ch = '=' Then Begin sy := geq; nextch End Else sy := gtr
           End;
     '.' : Begin
             nextch;
             If ch = '.' Then
             Begin
               sy := colon;
               nextch
             End
             Else
               sy := period
           End;
     '''': Begin
             k := 0;
         2:  nextch;
             If ch = '''' Then
             Begin
               nextch;
               If ch <> '''' Then
                 goto 3
             End ;
             If sx+k = smax Then
               fatal(7);
             stab(.sx+k.) := ch;
             k := k+1;
             If cc = 1 Then (*end of line*) 
               k := 0
             Else
               goto 2;
         3:  If k = 1 Then
             Begin
               sy := charcon; 
               inum := ord(stab(.sx.))
             End
             Else
               If k = 0 Then
               Begin
                 Error(38);
                 sy := charcon;
                 inum := 0
               End
               Else
               Begin
                 sy := stringsy;
                 inum := sx;
                 sleng := k;