x.txt

pl0

                              End ;
                            End ;
                            If x.typ in ts Then emit1(8,n) Else
                            If x.typ <> notyp Then Error(48);
                          End Else
       (*eof,eoln*)       Begin (*n in [17,18]*)
                            If sy <> ident Then Error(2) Else
                          If id <> 'input     ' Then Error(0) Else insymbol;                          
                            emit1(8,n);
                          End;
                        x.typ := tab[i].typ;
                        If sy = rparent Then insymbol Else Error(4)
              End (*standfct*) ;                     
            Begin (*factor*) x.typ := notyp; x.ref := 0;
                     test(facbegsys, fsys, 58);
                     While sy in facbegsys do
                       Begin
                         If sy = ident Then
                         Begin i := loc(id); insymbol;
                           with tab[i] do
                           case obj of
                     konstant: Begin x.typ := typ; x.ref := 0;
                                 If x.typ = reals Then
                                   emit1(25,adr) Else
                                   emit1(24,adr)
                               End ;
                      variable: Begin x.typ := typ; x.ref := ref;
                                 If sy in [lbrack,lparent,period] Then
                                   Begin If normal Then f := 0 Else f := 1;
                                     emit2(f, lev, adr);
                                     selector(fsys,x);
                                     If x.typ in stantyps Then emit(34)
                                   End Else
                                   Begin
                                     If x.typ in stantyps Then
                                       If normal Then f := 1 Else f := 2
                                     Else
                                       If normal Then f := 0 Else f := 1;
                                     emit2(f, lev, adr)
                                   End
                               End ;
                     type1, prozedure:    Error(44);
                     funktion: Begin x.typ := typ;
                                 If lev <> 0 Then call(fsys, i)
                                       Else standfct(adr)
                               End
                           End (*case,with*)
                         End Else
                         If sy in [charcon,intcon,realcon] Then
                          Begin
                            If sy = realcon Then
                            Begin x.typ := reals; enterreal(rnum);
                              emit1(25, c1)
                            End Else
                            Begin If sy = charcon Then x.typ := chars
                                                  Else x.typ := ints;
                              emit1(24, inum)
                            End ;
                            x.ref := 0; insymbol
                          End Else
                         If sy = lparent Then
                          Begin insymbol; expression(fsys+[rparent], x);
                            If sy = rparent Then insymbol Else Error(4)
                          End Else
                         If sy = notsy Then
                          Begin insymbol; factor(fsys,x);
                            If x.typ=bools Then emit(35) Else
                              If x.typ<>notyp Then Error(32)
                          End ;
                         test(fsys, facbegsys, 6)
                       End (*While*)
            End (*factor*) ;                   
          Begin (*term*)
                   factor(fsys+[times,rdiv,idiv,imod,andsy], x);
                   While sy in [times,rdiv,idiv,imod,andsy] do
                     Begin op := sy; insymbol;
                       factor(fsys+[times,rdiv,idiv,imod,andsy], y);
                       If op = times Then
                       Begin x.typ := resulttype(x.typ, y.typ);
                          case x.typ of
                           notyp: ;
                           ints : emit(57);
                           reals: emit(60);
                         End
                       End Else
                       If op = rdiv Then
                       Begin
                         If x.typ = ints Then
                           Begin emit1(26,1); x.typ := reals
                           End ;
                         If y.typ = ints Then
                           Begin emit1(26,0); y.typ := reals
                           End ;
                         If (x.typ = reals) and  (y.typ=reals) Then
                           emit(61) Else
                           Begin If (x.typ<>notyp) and (y.typ<>notyp) Then
                                   Error(33);
                                 x.typ := notyp
                           End
                       End Else
                       If op = andsy Then
                       Begin If (x.typ=bools) and (y.typ=bools) Then
                                emit(56) Else
                             Begin If (x.typ<>notyp) and (y.typ<>notyp)
                                 Then Error(32);
                                x.typ := notyp
                             End
                       End Else
                       Begin (*op in [idiv,imod]*)
                         If (x.typ=ints) and (y.typ=ints) Then
                           If op=idiv Then emit(58)
                                      Else emit(59) Else
                           Begin If (x.typ<>notyp) and (y.typ<>notyp) Then
                                    Error(34);
                                 x.typ := notyp
                           End
                       End
                     End
          End (*term*) ;                
        Begin (*simpleexpression*)
                 If sy in [plus,minus] Then
                   Begin op := sy; insymbol;
                     term(fsys+[plus,minus], x);
                     If x.typ > reals Then Error(33) Else
                       If op = minus Then emit(36)
                   End Else
                 term(fsys+[plus,minus,orsy], x);
                 While sy in [plus,minus,orsy] do
                   Begin op := sy; insymbol;
                      term(fsys+[plus,minus,orsy], y);
                      If op = orsy Then 
                      Begin
                       If (x.typ=bools) and (y.typ=bools) Then emit(51) Else
                          Begin If (x.typ<>notyp) and (y.typ<>notyp) Then
                                  Error(32);
                               x.typ := notyp
                          End
                      End Else
                      Begin x.typ := resulttype(x.typ, y.typ);
                        case x.typ of
                          notyp: ;
                          ints : If op = plus Then emit(52)
                                          Else emit(53);
                          reals: If op = plus Then emit(54)
                                          Else emit(55)
                        End
                      End
                   End
        End (*simpleexpression*) ;               
      Begin (*expression*)
              simpleexpression(fsys+[eql,neq,lss,leq,gtr,geq], x);
              If sy in [eql,neq,lss,leq,gtr,geq] Then
                Begin op := sy; insymbol;
                   simpleexpression(fsys, y);
                   If (x.typ in [ notyp,ints,bools,chars]) and
                      (x.typ = y.typ) Then
                     case op of
                       eql: emit(45);
                       neq: emit(46);
                       lss: emit(47);
                       leq: emit(48);
                       gtr: emit(49);
                       geq: emit(50);
                     End Else
                   Begin If x.typ = ints Then
                           Begin x.typ := reals; emit1(26,1)
                           End Else
                         If y.typ = ints Then
                           Begin y.typ := reals; emit1(26,0)
                           End ;
                     If (x.typ=reals) and (y.typ=reals) Then
                       case op of
                         eql: emit(39);
                         neq: emit(40);
                         lss: emit(41);
                         leq: emit(42);
                         gtr: emit(43);
                         geq: emit(44);
                       End
                     Else Error(35)
                   End ;
                   x.typ := bools
                End
      End (*expression*) ;            
      Procedure assignment(lv,ad: integer);
      var x,y: item; f: integer;
               (*tab[i].obj in [variable,prozedure]*)
      Begin x.typ := tab[i].typ; x.ref := tab[i].ref;
              If tab[i].normal Then f := 0 Else f := 1;
              emit2(f, lv, ad);
              If sy in [lbrack,lparent,period] Then
                 selector([becomes,eql]+fsys, x);
              If sy = becomes Then insymbol Else
                Begin Error(51); If sy = eql Then insymbol
                End;
              expression(fsys, y);
              If x.typ = y.typ Then
                If x.typ in stantyps Then emit(38) Else
                If x.ref <> y.ref Then Error(46) Else
                If x.typ = arrays Then emit1(23, atab[x.ref].size)
                                  Else emit1(23, btab[x.ref].vsize)
              Else
              If (x.typ=reals) and (y.typ=ints) Then
                Begin emit1(26,0); emit(38)
                End Else
                If (x.typ<>notyp) and (y.typ<>notyp) Then Error(46)
      End (*assignment*) ;            
      Procedure compoundstatement;
      Begin 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)
      End (*compoundstatement*) ;            
      Procedure ifstatement;
      var x: item; lc1,lc2: integer;
      Begin insymbol;
              expression(fsys+[thensy,dosy], x);
              If not (x.typ in [bools,notyp]) Then Error(17);
              lc1 := lc; emit(11);  (*jmpc*)
              If sy = thensy Then insymbol Else
                Begin Error(52); If sy = dosy Then insymbol
                End;
              statement(fsys+[elsesy]);
              If sy = elsesy Then
                Begin insymbol; lc2 := lc; emit(10);
                  kode[lc1].y := lc; statement(fsys); kode[lc2].y := lc
                End
              Else kode[lc1].y := lc
      End (*ifstatement*) ;            
      Procedure casestatement;
      var
        x: item;
        i,j,k,lc1: integer;
        casetab: array [1..csmax] of
                   packed record val, lc: index End;
        exittab: array [1..csmax] of integer;               
        Procedure caselabel;
        var lab: conrec; k: integer;
        Begin constant(fsys+[comma,colon], lab);
                If lab.tp <> x.typ Then Error(47) Else
                If i = csmax Then fatal(6) Else
                  Begin i := i+1; k := 0;
                    casetab[i].val := lab.i; casetab[i].lc := lc;
                    Repeat k := k+1 until casetab[k].val = lab.i;
                    If k < 1 Then Error(1);   (*multiple definition*)
                  End
        End (*caselabel*) ;              
        Procedure onecase;
        Begin If sy in constbegsys Then
                Begin caselabel;
                  While sy = comma do
                    Begin insymbol; caselabel
                    End ;
                  If sy = colon Then insymbol Else Error(5);
                  statement([semicolon,endsy]+fsys);
                  j := j+1; exittab[j] := lc; emit(10)
                End
        End (*onecase*) ;              
      Begin insymbol; i := 0; j := 0;
              expression(fsys+[ofsy,comma,colon], x);
              If not (x.typ in [ints,bools,chars,notyp]) Then Error(23);
              lc1 := lc; emit(12);  (*jmpx*)
              If sy = ofsy Then insymbol Else Error(8);
              onecase;
              While sy = semicolon do
                Begin insymbol; onecase
                End;
              kode[lc1].y := lc;
              for k := 1 to i do
                Begin emit1(13,casetab[k].val); emit1(13,casetab[k].lc)
                End ;
              emit1(10,0);
              for k := 1 to j do kode[exittab[k]].y := lc;
              If sy = endsy Then insymbol Else Error(57)
      End (*casestatement*) ;            
      Procedure repeatstatement;
      var
        x: item;
        lc1: integer;
      Begin
        lc1 := lc;
        insymbol;
        statement([semicolon,untilsy]+fsys);
        While sy in [semicolon]+statbegsys do
        Begin
          If sy = semicolon Then
            insymbol
          Else
            Error(14);
          statement([semicolon,untilsy]+fsys)
        End ;
        If sy = untilsy Then
        Begin
          insymbol;
          expression(fsys, x);
          If not (x.typ in [bools, notyp]) Then
            Error(17);
          emit1(11,lc1)
        End
        Else
          Error(53)
      End (*repeatstatement*) ;            
      Procedure whilestatement;
      var
        x: item;
        lc1,lc2: integer;
      Begin
        insymbol;
        lc1 := lc;
        expression(fsys+[dosy], x);
        If not (x.typ in [bools,notyp]) Then
          Error(17);
        lc2 := lc;
        emit(11);
        If sy = dosy Then
          insymbol
        Else
          Error(54);
        statement(fsys);
        emit1(10,lc1);
        kode[lc2].y := lc
      End (*whilestatement*) ;            
      Procedure forstatement;
      var
        cvt: types;
        x: item;
        i,f,lc1,lc2: integer;
      Begin
        insymbol;
        If sy = ident Then
        Begin
          i := loc(id);
          insymbol;
          If i = 0 Then
            cvt := ints
          Else
            If tab[i].obj = variable Then
            Begin
              cvt := tab[i].typ;
              emit2(0, tab[i].lev, tab[i].adr);
              If not (cvt in [notyp,ints,bools,chars]) Then
                Error(18)
            End
            Else
            Begin
              Error(37);
              cvt := ints
            End
        End
        Else
          skip([becomes,tosy,downtosy,dosy]+fsys, 2);
        If sy = becomes Then
        Begin
          insymbol;
          expression([tosy,downtosy,dosy]+fsys, x);
          If x.typ <> cvt Then
            Error(19)
        End
        Else
          skip([tosy,downtosy,dosy]+fsys, 51);
        f := 14;
        If sy in [tosy, downtosy] Then
        Begin
          If sy = downtosy Then
            f := 16;
          insymbol;
          expression([dosy]+fsys, x);
          If x.typ <> cvt Then
            Error(19)
        End
        Else
          skip([dosy]+fsys, 55);
        lc1 := lc; emit(f);
        If sy = dosy Then insymbol Else Error(54);
        lc2 := lc; statement(fsys);
        emit1(f+1,lc2); kode[lc1].y := lc
      End (*forstatement*) ;      
      Procedure standproc(n: integer);
      var i,f: integer;
        x,y: item;
      Begin
              case n of
         1,2: Begin (*read*)
                If not iflag Then
                  Begin Error(20); iflag := true
                  End;
                If sy = lparent Then 
                Begin
                  Repeat insymbol;
                    If sy <> ident Then Error(2) Else
                    Begin i := loc(id); insymbol;
                      If i <> 0  Then
                      If tab[i].obj <> variable Then Error(37) Else
                      Begin x. typ := tab[i].typ; x.ref := tab[i].ref;
                        If tab[i].normal Then f := 0 Else f := 1;
                        emit2(f, tab[i].lev, tab[i].adr);
                        If sy in [lbrack,lparent,period] Then
                          selector(fsys+[comma,rparent], x);
                        If x.typ in [ints,reals,chars,notyp] Then
                          emit1(27, ord(x.typ)) Else Error(40)
                      End
                    End ;
                    test([comma,rparent],fsys, 6);
                  until sy <> comma;
                  If sy = rparent Then insymbol Else Error(4)
                End ;
                If n = 2 Then emit(62)