pl0.pas

pl0的几个小程序 老师给的 很简单 共享下

                           getsym
                         end
                       else error(4)
                   end;(* vardeclaration*)

             procedure listcode;
               var i:  integer;
                 begin
                   if listswitch
                     then
                       begin
                         for i:=cx0 to cx-1 do
                           with code[i] do
                           begin
                             writeln (i:4,'  ',mnemonic[f]:5,l:3,a:5);
                             writeln(fa1,i:4,'  ',mnemonic[f]:5,l:3,a:5);
                             writeln(fa,i:4,'  ',mnemonic[f]:5,l:3,a:5)
                           end
                       end
                 end;(* listcode*)

    procedure statement(fsys:symset);
       var i,cx1,cx2: integer;
      procedure expression(fsys:symset);
        var addop:symbol;
       procedure term(fsys:symset);
         var mulop:symbol;
         procedure factor(fsys:symset);
           var i:integer;
           begin
            test(facbegsys,fsys, 24);
            while sym in facbegsys do
              begin
                if sym=ident
                  then
                    begin
                      i:=position(id);
                      if i=0
                        then error(11)
                        else
                          with table[i] do
                          case kind of
                            constant: gen(lit,0,val);
                            variable: gen(lod,lev-level,adr);
                            procedur: error(21)
                          end;
                        getsym
                      end
                    else
                       if sym =number
                         then
                           begin
                             if num>amax
                              then
                               begin
                                 error(31);
                                 num:=0
                               end;
                              gen(lit,0,num);
                              getsym
                             end
                           else
                             if sym=lparen
                               then
                                 begin
                                   getsym;
                                   expression([rparen]+fsys);
                                   if sym=rparen
                                     then getsym
                                     else error(22)
                                   end;
                               test(fsys,facbegsys,23)
                             end
                         end; (*factor*)
               begin  (*term*)
                 factor([times,slash]+fsys);
                 while sym in [times, slash] do
                   begin
                     mulop:=sym;
                     getsym;
                     factor(fsys+[times,slash]);
                     if mulop=times
                       then gen(opr,0,4)
                       else gen(opr,0,5)
                   end
               end; (*term*)

               begin (*expression*)
                 if sym in [plus, minus]
                   then
                     begin
                       addop:=sym;
                       getsym;
                       term(fsys+[plus,minus]);
                       if addop=minus
                         then gen(opr,0,1)
                     end
                   else term(fsys+[plus,minus]);
                 while sym in [plus, minus] do
                   begin
                    addop:=sym;
                    getsym;
                    term(fsys+[plus,minus]);
                    if addop=plus
                      then gen(opr,0,2)
                      else  gen(opr,0,3)
                  end
              end(*expression*);

              procedure condition(fsys:symset);
               var relop:symbol;
               begin
                if sym=oddsym
                 then
                  begin
                  getsym;
                  expression(fsys);
                  gen(opr,0,6)
                 end
                else
                 begin
                   expression ([eql,neq,lss,leq,gtr,geq]+fsys);
                   if not (sym in [eql,neq,lss,leq,gtr,geq])
                     then error(20)
                     else
                       begin
                        relop:=sym;
                        getsym;
                        expression(fsys);
                        case relop of
                          eql:gen(opr,0,8);
                          neq:gen(opr,0,9);
                          lss:gen(opr,0,10);
                          geq:gen(opr,0,11);
                          gtr:gen(opr,0,12);
                          leq:gen(opr,0,13);
                        end
                       end
                     end
                   end(*condition*);

         begin(*statement*)
           if sym=ident
            then
             begin
              i:=position(id);
               if i=0
                then error(11)
                else
                 if table[i].kind<>variable
                   then
                     begin
                       error(12);
                       i:=0
                     end;
                 getsym;
                 if sym=becomes
                   then getsym
                   else error(13);
                expression(fsys);
                if i<>0
                 then
                  with table[i] do gen(sto,lev-level,adr)
                 end
                else
                  if sym=readsym
                    then
                      begin
                       getsym;
                       if sym<>lparen
                         then error(34)
                         else
                          repeat
                           getsym;
                           if sym=ident
                             then i:=position(id)
                             else i:=0;
                           if i=0
                            then error(35)
                            else
                              with table[i] do
                               begin
                                gen(opr,0,16);
                                gen(sto,lev-level,adr)
                               end;
                              getsym
                            until sym<> comma;
                          if sym<> rparen
                            then
                             begin
                              error(33);
                              while not (sym in fsys ) do getsym
                             end
                            else getsym
                       end
                      else
                       if sym=writesym
                         then
                          begin
                           getsym;
                           if sym=lparen
                            then
                             begin
                              repeat
                               getsym;
                               expression([rparen,comma]+fsys);
                               gen(opr,0,14)
                              until sym<>comma;
                              if sym<> rparen
                                then error(33)
                                else getsym
                              end;
                             gen(opr,0,15)
                            end
                           else
                            if sym=callsym
                             then
                              begin
                               getsym;
                               if sym<> ident
                                then error(14)
                                else
                                 begin
                                   i:=position(id);
                                   if i=0
                                    then error(11)
                                    else
                                      with table[i] do
                                       if kind=procedur
                                        then gen(cal,lev-level,adr)
                                        else error(15);
                                   getsym
                                 end
                                end
                               else
                                if sym=ifsym
                                 then
                                  begin
                                    getsym;
                                    condition([thensym,dosym]+fsys);
                                    if sym=thensym
                                      then getsym
                                      else error(16);
                                    cx1:=cx;
                                    gen(jpc,0,0);
                                    statement(fsys);
                                    code[cx1].a:=cx
                                  end
                                 else
                                   if sym=beginsym
                                     then
                                      begin
                                       getsym;
                                       statement([semicolon,endsym]+fsys);
                                       while sym in [semicolon]+statbegsys do
                                        begin
                                         if sym=semicolon
                                          then getsym
                                          else error(10);
                                         statement([semicolon,endsym]+fsys)
                                        end;
                                       if sym=endsym
                                        then getsym
                                        else error(17)
                                       end
                                      else
                                       if  sym=whilesym
                                        then
                                         begin
                                          cx1:=cx;
                                          getsym;
                                          condition([dosym]+fsys);
                                          cx2:=cx;
                                          gen(jpc,0,0);
                                          if sym=dosym
                                           then getsym
                                           else error(18);
                                          statement(fsys);
                                          gen(jmp,0,cx1);
                                          code[cx2].a:=cx
                                         end;
                                test(fsys,[],19)
                              end(*statement*);

               begin(*block*)
                 dx:=3;
                 tx0:=tx;
                 table[tx].adr:=cx;
                 gen(jmp,0,0);
                 if lev>levmax
                   then error(32);