x.txt

pl0

                 sx := sx+k
               End
           End ;
     '(' : Begin
             nextch;
             If ch <> '*' Then
               sy := lparent
             Else
             Begin (*comment*)
               nextch;
               Repeat
                 While ch <> '*' do
                   nextch;
                 nextch
               Until ch = ')';
               nextch;
               goto 1
             End
           End;
     '+', '-', '*', '/', ')', '=', ',', '[', ']', '#', '&', ';' :
           Begin
             sy := sps(.ch.);
             nextch
           End;
    Else (*otherwise*)
           Begin 
             Error(24);
             nextch;
             goto 1
           End;
    End;
  End (*insymbol*) ;
  Procedure enter(x0: alfa; x1: object;
                  x2: types; x3: integer);
  Begin
    t := t+1;   (*enter standard identifier*)
    With tab(.t.) do
    Begin
      name := x0;
      link := t-1;
      obj := x1;
      typ := x2;
      ref := 0;
      normal := true;
      lev := 0;
      adr := x3
    End
  End (*enter*) ;
  Procedure enterarray(tp: types; l,h: integer);
  Begin
    If l  > h Then
      Error(27);
    If (abs(l)>xmax) or (abs(h)>xmax) Then
    Begin
      Error(27);
      l := 0;
      h := 0;
    End;
    If a = amax Then fatal(4) Else
    Begin
      a := a+1;
      With atab(.a.) do
      Begin
        inxtyp := tp;
        low := l;
        high := h
      End
    End
  End (*enterarray*) ;
  Procedure enterblock;
  Begin
    If b = bmax Then
      fatal(2)
    Else
    Begin
      b := b+1;
      btab(.b.).last := 0;
      btab(.b.).lastpar := 0
    End
  End (*enterblock*) ;
  Procedure enterreal(x: real);
  Begin
    If c2 = c2max-1 Then
      fatal(3)
    Else
    Begin
      rconst(.c2+1.) := x;
      c1 := 1;
      While rconst(.c1.) <> x do
        c1 := c1+1;
      If c1>c2 Then
        c2 := c1
    End
  End (*enterreal*) ;
  Procedure emit(fct: integer);
  Begin
    If lc = cmax Then
      fatal(6);
    kode(.lc.).f := fct;
    lc := lc+1
  End (*emit*) ;
  Procedure emit1(fct,b: integer);
  Begin 
    If lc = cmax Then
      fatal(6);
    With kode(.lc.) do
    Begin
      f := fct;
      y := b
    End ;
    lc := lc+1
  End (*emit1*) ;
  Procedure emit2(fct,a,b: integer);
  Begin
    If lc = cmax Then
      fatal(6);
    With kode(.lc.) do
    Begin
      f := fct;
      x := a;
      y := b
    End ;
    lc := lc+1
  End (*emit2*) ;
  Procedure printtables;
  Var
    i: integer;
    o: order;
  Begin
    WriteLn;
    WriteLn('identifiers    link  obj  typ  ref  nrm  lev  adr');
    for i := btab(.1.).last +1 to t do
      With tab(.i.) do
        WriteLn(i:10,' ',name:10,link:5, ord(obj):5, ord(typ):5, ref:5,
                ord(normal):5, lev:5, adr:5);
    WriteLn;
    WriteLn('blocks     last lpar psze vsze');
    for i := 1 to b do
      With btab(.i.) do
        WriteLn(i:10, last:5, lastpar:5, psize:5, vsize:5);
    WriteLn;
    WriteLn('arrays     xtyp etyp eref  low high elsz size');
    for i := 1 to a do
      With atab(.i.) do
        WriteLn(i:10, ord(inxtyp):5, ord(eltyp):5,
                elref:5, low:5, high:5, elsize:5, size:5);
    WriteLn;
    WriteLn('code:');
    for i := 0 to lc-1 do
    Begin
      If i mod 5 = 0 Then
      Begin
        WriteLn;
        Write(i:5)
      End;
      o := kode(.i.); Write(o.f:5);
      If o.f < 31 Then
        If o.f < 4 Then
          Write(o.x:2, o.y:5)
        Else
          Write(o.y:7)
      Else Write('       ');
      Write(',')             
    End ;
    WriteLn
  End (*printtables*) ;
  Procedure block(fsys: symset; isfun: boolean; level: integer);
  Type
    conrec = Record case tp: types of
               ints,chars,bools: (i: integer);
               reals: (r: real)
             End ;     
  Var
    dx: integer;    (*data allocation index*)
    prt: integer;   (*t-index of this procedure*)
    prb: integer;   (*b-index of this procedure*)
    x: integer;   
    Procedure skip(fsys: symset; n:integer);
    Begin
      Error(n);
      While not (sy in fsys) do
        insymbol
    End (*skip*) ;        
    Procedure test(s1,s2: symset; n:integer);
    Begin
      If not (sy in s1) Then 
        skip(s1+s2,n) 
    End (*test*) ;     
    Procedure testsemicolon;
    Begin
      If sy = semicolon Then
        insymbol
      Else
      Begin
        Error(14);
        If sy in [comma,colon] Then
          insymbol
      End ;
      test([ident]+blockbegsys, fsys, 6)
    End (*testsemicolon*) ;     
    Procedure enter(id: alfa; k: object);
    var
      j,l: integer;
    Begin
      If t = tmax Then
        fatal(1)
      Else
      Begin
        tab[0].name := id;
        j := btab[display[level]].last;
        l := j;
        While tab[j].name <> id do
          j := tab[j].link;
        If j <> 0 Then
          Error(1)
        Else
        Begin
          t := t+1;
          with tab[t] do
          Begin
            name := id;
            link := l;
            obj := k;
            typ := notyp;
            ref := 0;
            lev := level;
            adr := 0
          End;
          btab[display[level]].last := t
        End
      End
    End (*enter*) ;     
    Function loc(id: alfa): integer;
    var
      i,j: integer;     (*locate id in table*)
    Begin
      i := level;
      tab[0].name := id;   (*sentinel*)
      Repeat
        j := btab[display[i]].last;
        While tab[j].name <> id do
          j := tab[j].link;
        i := i-1;
      until (i<0) or (j<>0);
      If j = 0 Then
        Error(0);
      loc := j
    End (*loc*) ;     
    Procedure entervariable;
    Begin
      If sy = ident Then
      Begin
        enter(id,variable);
        insymbol
      End
      Else
        Error(2)
    End (*entervariable*) ;     
    Procedure constant(fsys: symset; var c: conrec);
    var
      x, sign: integer;
    Begin 
      c.tp := notyp; 
      c.i := 0;
      test(constbegsys, fsys, 50);
      If sy in constbegsys Then
      Begin
        If sy = charcon Then
        Begin 
          c.tp := chars; 
          c.i := inum; 
          insymbol
        End
        Else
        Begin
          sign := 1;
          If sy in [plus,minus] Then
          Begin
            If sy = minus Then
              sign := -1;
            insymbol
          End;
          If sy = ident Then
          Begin
            x := loc(id);
            If x <> 0 Then
              If tab[x].obj <> konstant Then 
                Error(25) 
              Else
              Begin
                c.tp := tab[x].typ;
                If c.tp = reals Then 
                  c.r := sign*rconst[tab[x].adr]
                Else
                  c.i := sign*tab[x].adr
              End;
            insymbol
          End 
          Else
            If sy = intcon Then
            Begin
              c.tp := ints;
              c.i := sign*inum; 
              insymbol
            End
            Else
              If sy = realcon Then
              Begin
                c.tp := reals;
                c.r := sign*rnum;
                insymbol
               End
               Else
                 skip(fsys,50)                   
        End;
        test(fsys, [], 6)
      End
    End (*constant*) ;        
    Procedure typ(fsys: symset; var tp: types; var rf, sz: integer);
    var
      x: integer;
      eltp: types; elrf: integer;
      elsz, offset, t0,t1: integer;         
      Procedure arraytyp(var aref,arsz: integer);
      var
        eltp: types;
        low, high: conrec;
        elrf, elsz: integer;
      Begin
        constant([colon,rbrack,rparent,ofsy]+fsys, low);
        If low.tp = reals Then
        Begin
          Error(27);
          low.tp := ints;
          low.i := 0
        End;
        If sy = colon Then
          insymbol
        Else
          Error(13);
        constant([rbrack,comma,rparent,ofsy]+fsys, high);
        If high.tp <> low.tp Then
        Begin
          Error(27);
          high.i := low.i
        End;
        enterarray(low.tp, low.i, high.i); 
        aref := a;
        If sy = comma Then
        Begin
          insymbol; 
          eltp := arrays; 
          arraytyp(elrf,elsz)
        End
        Else
        Begin
          If sy = rbrack Then 
            insymbol 
          Else
          Begin
            Error(12);
            If sy = rparent Then
              insymbol
          End;
          If sy = ofsy Then
            insymbol 
          Else 
            Error(8);
          typ(fsys,eltp,elrf,elsz)
        End;
        with atab[aref] do
        Begin
          arsz := (high-low+1)*elsz; 
          size:=arsz;
          eltyp := eltp;
          elref := elrf;
          elsize := elsz
        End ;
      End (*arraytyp*) ;         
    Begin (*typ*)
      tp := notyp;
      rf := 0;
      sz := 0;
      test(typebegsys, fsys, 10);
      If sy in typebegsys Then
      Begin
        If sy = ident Then
        Begin
          x := loc(id);
          If x <> 0 Then
            with tab[x] do
              If obj <> type1 Then
                Error(29)
              Else
              Begin
                tp := typ; 
                rf := ref; 
                sz := adr;
                If tp = notyp Then Error(30)
              End ;
          insymbol
        End
        Else
          If sy = arraysy Then
          Begin
            insymbol;
            If sy = lbrack Then
              insymbol
            Else
            Begin