x.txt

pl0

              End;
         3,4: Begin (*write*)
                If sy = lparent Then 
                Begin
                  Repeat insymbol;
                    If sy = stringsy Then
                      Begin emit1(24,sleng); emit1(28,inum); insymbol
                      End Else
                    Begin expression(fsys+[comma,colon,rparent], x);
                      If not (x.typ in stantyps) Then Error(41);
                      If sy = colon Then
                      Begin insymbol;
                        expression(fsys+[comma,colon,rparent], y);
                        If y.typ <> ints Then Error(43);
                        If sy = colon Then
                        Begin If x.typ <> reals Then Error(42);
                          insymbol; expression(fsys+[comma,rparent], y);
                          If y.typ <> ints Then Error(43);
                          emit(37)
                        End
                        Else emit1(30, ord(x.typ))
                      End
                      Else emit1(29,ord(x.typ))
                    End
                   until sy <> comma;
                  If sy = rparent Then insymbol Else Error(4)
                End ;
                If n = 4 Then emit(63)
              End;
              End;
      End (*standproc*) ;            
    Begin (*statement*)
      If sy in statbegsys+[ident] Then 
        case sy of
                 ident:    Begin i := loc(id); insymbol;
                             If i <> 0 Then
                             case tab[i].obj of
                               konstant, type1: Error(45);
                               variable:
                                   assignment(tab[i].lev, tab[i].adr);
                               prozedure:
                                 If tab[i].lev <> 0 Then call(fsys, i)
                                         Else standproc(tab[i].adr);
                               funktion:
                                 If tab[i].ref = display[level]
                                   Then assignment(tab[i].lev+1,0)
                                   Else Error(45)
                             End
                           End ;
                 Beginsy:  compoundstatement;
                 ifsy:     ifstatement;
                 casesy:   casestatement;
                 whilesy:  whilestatement;
                 repeatsy: repeatstatement;
                 forsy:    forstatement;
               End;
             test(fsys, [], 14)  
    End (*statement*) ;                   
  Begin (*block*)
    dx := 5;
    prt := t;
    If level > lmax Then
      fatal(5);
    test([lparent,colon,semicolon], fsys, 7);
    enterblock;
    display[level] := b;
    prb := b;
    tab[prt].typ := notyp;
    tab[prt].ref := prb;
    If sy = lparent Then
      parameterlist;
    btab[prb].lastpar := t;
    btab[prb].psize := dx;
    If isfun Then
      If sy = colon Then
      Begin
        insymbol;    (*function type*)
        If sy = ident Then
        Begin
          x := loc(id);
          insymbol;
          If x <> 0 Then
            If tab[x].obj <> type1 Then
              Error(29)
            Else
              If tab[x].typ in stantyps Then
                tab[prt].typ := tab[x].typ
              Else
                Error(15)
        End
        Else
          skip([semicolon]+fsys, 2)
      End
      Else
        Error(5);
    If sy = semicolon Then
      insymbol
    Else
      Error(14);
    Repeat
      If sy = constsy Then
        constantdeclaration;
      If sy = typesy Then
        typedeclaration;
      If sy = varsy Then
        variabledeclaration;
      btab[prb].vsize := dx;
      While sy in [proceduresy,functionsy] do
        procdeclaration;
      test([beginsy], blockbegsys+statbegsys, 56)
    until sy in statbegsys;
    tab[prt].adr := lc;
    insymbol;
    statement([semicolon,endsy]+fsys);
    While sy in [semicolon]+statbegsys do
    Begin
      If sy = semicolon Then
        insymbol
      Else
        Error(14);
      statement([semicolon,endsy]+fsys)
    End;
    If sy = endsy Then
      insymbol
    Else
      Error(57);
    test(fsys+[period], [], 6)
  End (*block*) ;
  Procedure interpret;
  (*global code, tab, btab*)
  Var
    ir: order;      (*instruction buffer*)
    pc: integer;    (*program counter*)
    ps: (run,fin,caschk,divchk,inxchk,stkchk,linchk,
         lngchk,redchk);
    t:  integer;    (*top stack index*)
    b:  integer;    (*base index*)
    lncnt, ocnt, blkcnt, chrcnt: integer;     (*counters*)
    h1,h2,h3,h4: integer;
    fld: Array (.1..4.) of integer;     (*default field widths*)
    display: Array (.1..lmax.) of integer;
    s: Array (.1..stacksize.) of     (*blockmark:              *)
         Record Case types of        (*   s(.b+0.) = fct result  *)
           ints:  (i: integer);      (*   s(.b+1.) = return adr  *)
           reals: (r: real);         (*   s(.b+2.) = static link *)
           bools: (b: boolean);      (*   s(.b+3.) = dynamic link*)
           chars: (c: char)          (*   s(.b+4.) = table index *)
         End;
  Begin (*interpret*)
    s(.1.).i := 0;
    s(.2.).i := 0;
    s(.3.).i := -1;
    s(.4.).i := btab(.1.).last;
    b := 0;
    display(.1.) := 0;
    t := btab(.2.).vsize - 1;
    pc := tab(.s(.4.).i.).adr;
    ps:=run;
    lncnt := 0;
    ocnt := 0;
    chrcnt := 0;
    fld(.1.) := 10;
    fld(.2.) := 22;
    fld(.3.) := 10;
    fld(.4.) := 1;
    Repeat
      ir := kode(.pc.);
      pc := pc+1;
      ocnt := ocnt + 1;
      Case ir.f of
       0: Begin (*load address*) 
            t := t+1;
            If t > stacksize Then
              ps := stkchk
            Else
              s(.t.).i := display(.ir.x.) + ir.y
          End;
       1: Begin (*load value*) 
            t := t+1;
            If t > stacksize Then
              ps := stkchk
            Else
              s(.t.) := s(.display(.ir.x.) + ir.y.)
          End;
       2: Begin (*load indirect*)
            t := t+1;
            If t > stacksize Then
              ps := stkchk
            Else
              s(.t.) := s(.s(.display(.ir.x.) + ir.y.).i.)
          End;
       3: Begin (*update display*)
            h1 := ir.y; 
            h2 := ir.x;
            h3 := b;
            Repeat
              display(.h1.) := h3;
              h1 := h1-1;
              h3:= s(.h3+2.).i
            Until h1 = h2
          End;
       8: Case ir.y of
           0: s(.t.).i := abs(s(.t.).i);
           1: s(.t.).r := abs(s(.t.).r);
           2: s(.t.).i := sqr(s(.t.).i);
           3: s(.t.).r := sqr(s(.t.).r);
           4: s(.t.).b := odd(s(.t.).i);
           5: (* s(.t.).c := chr(s(.t.).i); *)
              If (s(.t.).i < 0) or (s(.t.).i > 63) Then
                ps := inxchk;
           6: (* s(.t.).i := ord(s(.t.).c) *);
           7: s(.t.).c := succ(s(.t.).c);
           8: s(.t.).c := pred(s(.t.).c);
           9: s(.t.).i := round(s(.t.).r);
          10: s(.t.).i := trunc(s(.t.).r);
          11: s(.t.).r := sin(s(.t.).r);
          12: s(.t.).r := cos(s(.t.).r);
          13: s(.t.).r := exp(s(.t.).r);
          14: s(.t.).r := ln(s(.t.).r);
          15: s(.t.).r := sqrt(s(.t.).r);
          16: s(.t.).r := arctan(s(.t.).r);
          17: Begin t:= t+1;
                If t > stacksize Then
                  ps := stkchk
                Else
                  s(.t.).b := eof(InputFile)
              End ;
          18: Begin
                t:= t+1;
                If t > stacksize Then
                  ps := stkchk
                Else
                  s(.t.).b := eoln(InputFile)
              End ;
          End ;
       9: s(.t.).i := s(.t.).i + ir.y;    (*offset*)
      10: pc := ir.y;   (*jump*)
      11: Begin (*conditional jump*)
            If not s(.t.).b Then
              pc := ir.y;
            t := t-1
          End;
      12: Begin (*switch*)
            h1 := s(.t.).i;
            t := t-1;
            h2 := ir.y;
            h3 := 0;
            Repeat
              If kode(.h2.).f <> 13 Then
              Begin
                h3 := 1;
                ps := caschk;
              End
              Else
                If kode(.h2.).y = h1 Then
                Begin
                  h3 := 1;
                  pc := kode(.h2+1.).y
                End
                Else
                  h2 := h2 + 2
            Until h3 <> 0
          End;
      14: Begin (*for1up*)
            h1 := s(.t-1.).i;
            If h1 <= s(.t.).i Then
              s(.s(.t-2.).i.).i := h1
            Else
            Begin
              t := t-3;
              pc := ir.y
            End
          End;
      15: Begin (*for2up*) 
            h2 := s(.t-2.).i;
            h1:= s(.h2.).i + 1;
            If h1 <= s(.t.).i Then
            Begin
              s(.h2.).i := h1;
              pc := ir.y
            End
            Else
              t := t-3;
          End;
      16: Begin (*for1down*)
            h1 := s(.t-1.).i;
            If h1 >= s(.t.).i Then
              s(.s(.t-2.).i.).i := h1
            Else
            Begin
              pc := ir.y;
              t := t-3
            End
          End;
      17: Begin (*for2down*)
            h2 := s(.t-2.).i;
            h1:= s(.h2.).i - 1;
            If h1 >= s(.t.).i Then
            Begin
              s(.h2.).i := h1;
              pc := ir.y
            End
            Else
              t := t-3;
          End;
      18: Begin (*mark stack*)
            h1 := btab(.tab(.ir.y.).ref.).vsize;
            If t+h1 > stacksize Then
              ps := stkchk 
            Else
            Begin
              t := t+5;
              s(.t-1.).i := h1-1;
              s(.t.).i := ir.y
            End
          End;
      19: Begin (*call*)
            h1 := t - ir.y;        (*h1 points to base*)
            h2 := s(.h1+4.).i;     (*h2 points to tab*)
            h3 := tab(.h2.).lev;
            display(.h3+1.) := h1;
            h4 := s(.h1+3.).i + h1;
            s(.h1+1.).i := pc;
            s(.h1+2.).i := display(.h3.);
            s(.h1+3.).i := b;
            for h3 := t+1 to h4 do
              s(.h3.).i := 0;
            b := h1;
            t := h4;
            pc := tab(.h2.).adr
          End;
      20: Begin (*index1*)
            h1 := ir.y;      (*h1 points to atab*)
            h2 := atab(.h1.).low;
            h3 := s(.t.).i;
            If h3 < h2 Then
              ps := inxchk
            Else
              If h3 > atab(.h1.).high Then
                ps := inxchk
              Else
              Begin
                t := t-1;
                s(.t.).i := s(.t.).i + (h3-h2)
              End
          End;
      21: Begin (*index*)
            h1 := ir.y;      (*h1 points to atab*)
            h2 := atab(.h1.).low;
            h3 := s(.t.).i;
            If h3 < h2 Then
              ps := inxchk
            Else
              If h3 > atab(.h1.).high Then
                ps := inxchk
              Else
              Begin
                t := t-1;
                s(.t.).i := s(.t.).i + (h3-h2)*atab(.h1.).elsize
              End
          End;
      22: Begin (*load block*)
            h1 := s(.t.).i;
            t := t-1;
            h2 := ir.y + t;
            If h2 > stacksize Then
              ps := stkchk
            Else
              While t < h2 do
              Begin
                t := t+1;
                s(.t.) := s(.h1.);
                h1 := h1+1
              End
          End ;
      23: Begin (*copy block*)
            h1 := s(.t-1.).i;
            h2 := s(.t.).i;
            h3 := h1 + ir.y;
            While h1 < h3 do
            Begin
              s(.h1.) := s(.h2.);
              h1 := h1+1;
              h2 := h2+1
            End;
            t := t-2
          End ;
      24: Begin (*literal*)
            t := t+1;
            If t > stacksize Then
              ps := stkchk
            Else
              s(.t.).i := ir.y
          End ;
      25: Begin (*load real*)
            t := t+1;
            If t > stacksize Then
              ps := stkchk
            Else
              s(.t.).r := rconst(.ir.y.)
          End ;
      26: Begin (*float*) 
            h1 := t - ir.y;
            s(.h1.).r := s(.h1.).i
          End ;
      27: Begin (*read*)
            If eof(InputFile) Then
              ps := redchk
            Else