[关闭]
@ydleenudt 2015-06-10T02:11:23.000000Z 字数 26647 阅读 1158

PL语言分析程序（in pascal）

增加部分

case语句

第一步：记录表达式的标记，处理表达式，标记常量的入口位置。
第二步：每次将表达式的值与常量进行比较，形成跳转指令，执行完一条语句之后产生无条件跳转指令。

  1. procedure casestatement;   {case}
  2.          var x:item;
  3.              coni,conj:integer;  
  4.          begin
  5.                 getsym;cx1:=cx;
  6.                 expression([ofsym]+fsys,x);cx2:=cx;
  7.               if (x.typ = ints) or (x.typ = chars)then 
  8.                begin
  9.                 if sym=ofsym then
  10.                 begin
  11.                  getsym;conj:=0;
  12.                  while sym<>elsesym do 
  13.                  begin
  14.                      if (sym = intcon) or (sym = charcon) then
  15.                      begin
  16.                     coni:=cx1;
  17.                       if conj<>0 then
  18.                       begin
  19.                       while coni<cx2 do
  20.                       begin
  21.                         code[cx]:=code[coni];
  22.                          cx:=cx+
  23.                          coni:=coni+1;
  24.                       end
  25.                       end;
  26.                       conj:=1;
  27.                       gen(lit,0,num);
  28.                       coni:=cx1;
  29.                       end
  30.                       else error(12);
  31.                       getsym;
  32.                        if sym=colon then
  33.                        begin
  34.                           getsym;
  35.                           gen(eq,0,0);
  36.                           cx2:=cx;
  37.                             gen(jpc,0,0);
  38.                             statement([semicolon]+fsys);
  39.                        if sym=semicolon then
  40.                        begin
  41.                         getsym;
  42.                         labtab[lx]:=cx;lx:=lx+1;
  43.                         gen(jmp,0,0);
  44.                         code[cx2].a:=cx
  45.                          end
  46.                        else error(23)
  47.                       end
  48.                       else  error(24){colon}
  49.                      end;
  50.                    if sym=elsesym then
  51.                      begin
  52.                         getsym;
  53.                     statement([endsym]+fsys);
  54.                         lx:=lx-1;
  55.                          while lx>=0 do
  56.                          begin code[labtab[lx]].a:=cx;
  57.                         lx:=lx-1
  58.                          end
  59.                   end;
  60.                   if sym=endsym then getsym
  61.                   else error(36)
  62.               end
  63.               else error(17)
  64.              end
  65.           end;
repeat语句

在第一条语句前记录标记，处理完语句之后，判断布尔表达式的值，并产生跳转指令。

  1.       procedure repeatstatement;{repeat}
  2.       var x:item;
  3.       begin
  4.         getsym;cx1:=cx; labtab[lx]:=cx;lx:=lx+1;
  5.         statement([untilsym]+fsys);
  6.         if sym<>semicolon then error(23);
  7.         getsym;
  8.         while (not (sym in ([untilsym]))) do
  9.           begin
  10.            statement([untilsym]+fsys);
  11.            if sym<>semicolon then error(23);
  12.            getsym
  13.           end;
  15.         if sym=untilsym then 
  16.           begin
  17.             getsym;
  18.             expression([endsym]+fsys,x);
  19.             if x.typ <> bool then error(34); 
  20.             gen(jpc,0,cx1);labtab[lx]:=cx;lx:=lx+1
  21.           end
  22.       end;
for语句

第一步：通过词法扫描，先处理控制变量，将其装入符号表，读入初值之后存入控制变量对应的地址中。
第二步：读入终止值，每次判断是否满足条件，记录语句的标号，之后进入语句，处理完之后，将控制变量加一，并判断是否跳转。

  1. procedure forstatement;{for}
  2. begin
  3.      getsym;
  4.      if sym=ident then
  5.      begin 
  6.              i:=position(id);getsym;
  7.              if i=0 then error(10)
  8.              else
  9.                   if nametab[i].kind<>variable then
  10.                      begin
  11.                      error(30);i:=0
  12.                      end 
  13.                   else
  14.                      begin
  15.                         x.typ:=nametab[i].typ;
  16.             x.ref:=nametab[i].ref; 
  17.             if nametab[i].normal  
  18.             then gen(loda,nametab[i].lev,nametab[i].adr)
  19.             else gen(lod,nametab[i].lev,nametab[i].adr)
  20.            end;
  21.        if sym=becomes then 
  22.        begin
  23.            getsym;
  24.            expression([tosym]+fsys,ini);
  25.              if  ini.typ<>ints then error(12)
  26.              else begin
  27.                      gen(sto,0,0);
  28.                      if sym=tosym then
  29.                          begin
  30.                             getsym;cx1:=cx;labtab[lx]:=cx;lx:=lx+1;
  31.                             gen(loda,nametab[i].lev,nametab[i].adr);
  32.                             gen(lodt,0,0);
  33.                             expression([dosym]+fsys,fin);
  34.                           if sym=dosym then
  35.                                begin
  36.                                  gen(le,0,0);
  37.                                  cx2:=cx;labtab[lx]:=cx;lx:=lx+1;
  38.                                  gen(jpc,0,0);
  39.                                      getsym;
  40.                                    statement(fsys);
  41.                                      if nametab[i].normal then
  42.                                      begin
  43.                                          gen(loda,nametab[i].lev,nametab[i].adr);
  44.                                          gen(loda,nametab[i].lev,nametab[i].adr);
  45.                                    gen(lodt,0,0)
  46.                                      end
  47.                                      else gen(lod,nametab[i].lev,nametab[i].adr);
  48.                                      gen(lit,0,1);
  49.                                      gen(add,0,0);
  50.                          gen(sto,0,0);
  51.                          gen(jmp,0,cx1);
  52.                          code[cx2].a:=cx
  53.                                  end
  54.                          end
  55.                       end
  56.        end
  57.    end
  58.    else error(33)
  59. end;

完整程序

  1. program plcopiler;
  2. uses dos;
  3. const norw=25;       { no. of reserved words }
  4.       txmax=100;     { length of identifier table }
  5.       bmax=25;       { length of block inormation table }
  6.       arrmax=30;     { length of array information table }
  7.       nmax=6;        { max. no. of digits in numbers }
  8.       al=10;         { length of identifiers }
  9.       amax=2047;     { maxinum address }
  10.       levmax=7;      { maxinum depth of block nesting }
  11.       cxmax=1000;    { size of code array }
  13. type symbol=
  14.      (nul,ident,intcon,charcon,plus,minus,times,divsym,
  15.       eql,neq,lss,leq,gtr,geq, ofsym,arraysym,programsym,modsym,
  16.       andsym,orsym,notsym,lbrack,rbrack,lparen,rparen,comma,
  17.       semicolon,period,becomes,colon,beginsym,endsym,ifsym,casesym,thensym,
  18.       elsesym,whilesym,repeatsym,dosym,callsym,constsym,typesym,
  19.       varsym,procsym,forsym,untilsym,functionsym,tosym);
  20.      alfa = string[al];
  21.      index=-32767..+32767;
  22.      oobject = (konstant,typel,variable,prosedure);
  23.      types=(notyp,ints,chars,bool,arrays);
  24.      symset = set of symbol;
  26.      opcod = (lit,lod,ilod,loda,lodt,sto,lodb,cpyb,jmp,jpc,red,wrt,
  27.             cal,retp,endp,udis,opac,entp,ands,ors,nots,imod,mus,add,
  28.             sub,mult,idiv,eq,ne,ls,le,gt,ge);  { opration code }
  29.      instruction = packed record
  30.                      f:opcod;
  31.                      l:0..levmax;
  32.                      a:0..amax;
  33.                    end;
  34.      item=record
  35.              typ:types;
  36.              ref:integer
  37.            end;
  39. var ch:char;           { last character read }
  40.     sym:symbol;        { last symbol read}
  41.     id:alfa;           { last identifier read  10} 
  42.     num:integer;       { last number read }
  43.     cc:integer;        { character count }
  44.     ll:integer;        { line length }
  45.     kk,err:integer;
  46.     line:string[81];
  47.     a:alfa;
  48.     i:integer;
  49.     word:array[1..norw] of alfa;
  50.     wsym:array[1..norw] of symbol;
  51.     ssym:array[char] of symbol;
  52.     mnemonic:array[opcod] of string[5];
  53.     declbegsys,statbegsys,facbegsys,constbegsys,typebegsys:symset;
  55.     nametab:array[0..txmax] of          { name table }
  56.                record
  57.                  name:alfa;
  58.                  kind:
  59.                  oobject ;
  60.                  typ: types;
  61.                  lev: 0..levmax;
  62.                  normal:boolean;
  63.                  ref:index;
  64.                  link:index;
  65.                  case oobject of
  66.                    variable,prosedure:(adr:integer);
  67.                    konstant         :(val:integer);
  68.                    typel            :(size:integer);
  70.                end;
  71.     tx:  integer;           { index of nametab}
  74.     atab:array[1..amax] of             { array information table }
  75.               record
  76.                 inxtyp,eltyp:types;
  77.                 elref,low,high,elsize,size:index;
  78.               end;
  79.     ax:integer;             {index of atab }
  81.     btab:array[0..bmax] of            { block information table }
  82.               record
  83.                 last,lastpar,psize,vsize:index;
  84.               end;
  85.     bx:integer;                 { index of btab }
  86.     display:array[0..levmax] of integer;
  89.     code:array[0..cxmax] of instruction;
  90.     cx:integer;          { code allocation index }
  92.     labtab:array[0..100] of integer;
  93.     lx:integer;
  94. {********************************************************}
  97.     sfile:text;         { source program file }
  98.     sfilename:string; { source program file name }
  99.     fcode:file of instruction;
  100.     labfile:file of integer;
  102.     listfile :text;
  103.     listfilename:string;
  104.     dir:dirstr;
  105.     name:namestr;
  106.     ext:extstr;
  107. {*********************************************************}
  109. procedure initial;
  110.  begin
  111. word[ 1]:='and       '; 
  112.   word[ 2]:='array     ';
  113.   word[ 3]:='begin     '; 
  114.   word[ 4]:='call      ';
  115.   word[ 5]:='case      ';
  116.   word[ 6]:='const     '; 
  117.   word[ 7]:='do        ';
  118.   word[ 8]:='else      '; 
  119.   word[ 9]:='end       ';
  120.   word[10]:='for       '; 
  121.   word[11]:='function  '; 
  122.   word[12]:='if        '; 
  123.   word[13]:='mod       ';
  124.   word[14]:='not       '; 
  125.   word[15]:='of        ';
  126.   word[16]:='or        '; 
  127.   word[17]:='procedure ';
  128.   word[18]:='program   '; 
  129.   word[19]:='repeat    ';
  130.   word[20]:='then      ';
  131.   word[21]:='to        ';
  132.   word[22]:='type      ';
  133.   word[23]:='until     ';
  134.   word[24]:='var       '; 
  135.   word[25]:='while     ';
  136.   wsym[ 1]:=andsym;       
  137.   wsym[ 2]:=arraysym;
  138.   wsym[ 3]:=beginsym;     
  139.   wsym[ 4]:=callsym;
  140.   wsym[ 5]:=casesym;     
  141.   wsym[ 6]:=constsym;
  142.   wsym[ 7]:=dosym;      
  143.   wsym[ 8]:=elsesym;
  144.   wsym[ 9]:=endsym;        
  145.   wsym[10]:=forsym;
  146.   wsym[11]:=functionsym;     
  147.   wsym[12]:=ifsym;
  148.   wsym[13]:=modsym;        
  149.   wsym[14]:=notsym;
  150.   wsym[15]:=ofsym;   
  151.   wsym[16]:=orsym;
  152.   wsym[17]:=procsym;      
  153.   wsym[18]:=programsym;
  154.   wsym[19]:=repeatsym;       
  155.   wsym[20]:=thensym;
  156.   wsym[21]:=tosym;
  157.   wsym[22]:=typesym;       
  158.   wsym[23]:=untilsym;  
  159.   wsym[24]:=varsym;       
  160.   wsym[25]:=whilesym;      
  162.   ssym['+']:=plus;        ssym['-']:=minus;
  163.   ssym['*']:=times;       ssym['/']:=divsym;
  164.   ssym['[']:=lbrack;      ssym[']']:=rbrack;
  165.   ssym['(']:=lparen;      ssym[')']:=rparen;
  166.   ssym['=']:=eql;         ssym[',']:=comma;
  167.   ssym['.']:=period;
  168.   ssym['<']:=lss;         ssym['>']:=gtr;
  169.   ssym[';']:=semicolon;
  171.   mnemonic[lit]:='LIT  ';   mnemonic[lod]:='LOD  ';
  172.   mnemonic[sto]:='STO  ';   mnemonic[cal]:='CAL  ';
  173.   mnemonic[jmp]:='JMP  ';   mnemonic[jpc]:='JPC  ';
  174.   mnemonic[red]:='RED  ';   mnemonic[wrt]:='WRT  ';
  175.   mnemonic[ilod]:='ILOD  '; mnemonic[loda]:='LODA ';
  176.   mnemonic[lodt]:='LODt  '; mnemonic[lodb]:='LODB ';
  177.   mnemonic[cpyb]:='COPYB '; mnemonic[endp]:='ENDP ';
  178.   mnemonic[retp]:='RETP  '; mnemonic[udis]:='ADIS ';
  179.   mnemonic[mus]:='MUS  ';   mnemonic[add]:='ADD ';
  180.   mnemonic[sub]:='SUB  ';   mnemonic[mult]:='MULT ';
  181.   mnemonic[idiv]:='DDIV  '; mnemonic[eq]:='EQ  ';
  182.   mnemonic[ne]:='NE ';      mnemonic[ls]:='LS  ';
  183.   mnemonic[le]:='LE ';      mnemonic[gt]:='GT  ';
  184.   mnemonic[ge]:='GE ';      mnemonic[opac]:='OPAC ';
  185.   mnemonic[entp]:='ENTP';   mnemonic[imod]:='IMOD ';
  186.   mnemonic[ands]:='ANDS';   mnemonic[ors]:='ORS ';
  187.   mnemonic[nots]:='NOTS';
  189.   declbegsys:=[constsym,varsym,typesym,procsym];   
  190.   statbegsys:=[beginsym,callsym,ifsym,whilesym,casesym,repeatsym,untilsym,forsym];      
  191.   facbegsys :=[ident,intcon,lparen,notsym,charcon];
  192.   typebegsys:=[ident,arraysym];
  193.   constbegsys:=[plus,minus,intcon,charcon,ident];
  194.   err:=0; a[0]:=#10;
  195.   display[0]:=0;   
  196.   cc:=0; cx:=0; ll:=0; ch:=' '; kk:=al; bx:=1;  tx:=-1;
  197.   lx:=0
  198.  end;   {init}
  200.  procedure enterpreid;                              
  201.    procedure enter(x0:alfa;x1:oobject;
  202.                   x2:types;x3:integer);
  203.    begin
  204.     tx:=tx+1;
  205.     with nametab[tx] do
  206.     begin
  207.       name:=x0;link:=tx-1;kind:=x1;
  208.       typ:=x2;ref:=0;normal:=true;
  209.       lev:=0;
  210.       case kind of
  211.         variable,prosedure: adr:=x3;       
  212.         konstant:           val:=x3;                
  213.         typel:              size:=x3                    
  214.       end
  215.     end
  216.    end;
  217.   begin
  218.    enter('          ',variable,notyp,0);       { sentinel }
  219.    enter('char      ',typel, chars,1);    
  220.    enter('integer   ',typel,ints,  1);
  221.    enter('boolean   ',typel,bool,  1);
  222.    enter('false     ',konstant,bool,  0);
  223.    enter('true      ',konstant,bool,  1);
  224.    enter('read      ',prosedure,notyp,1);
  225.    enter('write     ',prosedure,notyp,2);
  226.    btab[0].last:=tx; btab[0].lastpar:=1;
  227.    btab[0].psize:=0; btab[0].vsize:=0
  228.   end;       {enterprid}
  230.  procedure error(n:integer);
  231.    begin writeln(listfile,'****',' ':cc-1,'^',n:2);
  232.         err:=err+1
  233.    end; { error }
  236.  procedure getsym;
  237.     label 1;
  238.     var i,k,j:integer;
  239.     procedure getch;
  240.     begin
  241.       if cc=ll then   { get character to end of line }
  242.       { read next line }
  243.       begin
  244.         if eof(sfile) then  
  245.           begin
  246.             writeln('program incomplete');
  247.             close(sfile);
  248.             exit;
  249.           end;
  250.         ll:=0; cc:=0; write(listfile,cx:4,' ');    {print code address }
  251.         while not eoln(sfile) do
  252.           begin
  253.             ll:=ll+1; read(sfile,ch); write(listfile,ch);
  254.             line[ll]:=ch
  255.           end;
  256.         writeln(listfile); readln(sfile);
  257.         ll:=ll+1; line[ll]:=' '  {process end-line}           
  258.       end;
  259.       cc:=cc+1; ch:=line[cc]           
  260.     end;  { getch }
  261.   begin  {getsym}
  262.  1:   while ch=' ' do getch;
  263.     case ch of
  264.     'a','b','c','d','e','f','g','h','i','j','k','l','m','n',
  265.     'o','p','q','r','s','t','u','v','w','x','y','z':
  266.     begin   { identifier or reserved（关键字） word }
  267.       k:=0;
  268.       repeat
  269.         if k<al then
  270.           begin k:=k+1; a[k]:=ch  end;
  271.         getch
  272.       until not (ch in ['a'..'z','0'..'9']);
  273.       if k>=kk then kk:=k      { kk: last identifier length }
  274.       else
  275.         repeat
  276.           a[kk]:=' '; kk:=kk-1
  277.         until kk=k;
  278.       id:=a; i:=1; j:=norw; { binary search reserved word table }
  279.       repeat
  280.         k:=(i+j) div 2;
  281.         if id<=word[k] then j:=k-1;
  282.         if id>=word[k] then i:=k+1;
  283.       until i>j;
  284.       if i-1>j then sym:=wsym[k]
  285.       else sym:=ident
  286.     end;
  288.     '{' :
  289.     begin
  290.       repeat
  291.          getch
  292.       until ch = '}';
  293.        getch;
  294.       goto 1
  295.     end;
  299.     '0','1','2','3','4','5','6','7','8','9':
  300.       begin { number }
  301.         k:=0; num:=0; sym:=intcon;
  302.         repeat
  303.           num:=10*num+(ord(ch)-ord('0'));
  304.           k:=k+1; getch
  305.         until not (ch in ['0'..'9']);
  306.         if k>nmax then error(47)
  307.       end;
  309.    ':':
  310.         begin
  311.           getch;
  312.           if ch='=' then
  313.             begin sym:=becomes; getch end
  314.           else sym:=colon
  315.         end ;
  316.    '<' :
  317.         begin
  318.             getch;
  319.             if ch='=' then
  320.               begin sym:=leq; getch end
  321.             else
  322.               if ch='>' then
  323.                 begin sym:=neq; getch end
  324.               else sym:=lss
  325.           end ;
  326.    '>' :
  327.         begin
  328.               getch;
  329.               if ch='=' then
  330.                 begin sym:=geq; getch end
  331.               else sym:=gtr
  332.         end  ;
  333.    '.' :
  334.         begin
  335.           getch;
  336.           if ch='.'
  337.             then  begin
  338.                    sym:=colon;getch
  339.                   end
  340.             else   sym:=period
  341.          end;
  342.    ''''  :
  343.         begin
  344.           getch;
  345.           sym:=charcon;num:=ord(ch);
  346.           getch;
  347.           if ch='''' then getch
  348.                      else error(48)
  349.         end;
  350.    '+','-','*','/','(',')','=','[',']',';',',':
  351.         begin
  352.           sym:=ssym[ch];getch
  353.         end;
  354.    else
  355.        begin
  356.          error(0); getch;
  357.          goto 1
  358.        end
  359.     end  { case }
  360.   end;  { getsym }    
  362.   procedure enterarray (tp:types ; l,h:integer); 
  363.   begin
  364.     if l>h then error(14);
  365.     if ax=amax then
  366.       begin
  367.         error(2);
  368.         writeln('too many arrays in program ');
  369.         close(sfile);
  370.         close(listfile);
  371.         exit
  372.       end
  373.       else begin
  374.         ax:=ax+1;
  375.         with atab[ax] do
  376.         begin
  377.           inxtyp:=tp; low:=l; high:=h
  378.         end
  379.       end
  380.   end;  { enterarray }
  382.   procedure enterblock;   
  383.   begin
  384.     if bx=bmax  then
  385.       begin
  386.         error(3);
  387.         writeln('too many procedure in program ');
  388.         close(sfile);
  389.         close(listfile);
  390.         exit
  391.       end
  392.     else begin
  393.       bx:=bx+1; btab[bx].last:=0; btab[bx].lastpar:=0
  394.     end
  395.   end;   { enterblock }
  397.   procedure gen(x:opcod; y,z:integer);  {产生代码程序gen}
  398.   begin
  399.     if cx>cxmax then
  400.       begin
  401.         error(49);
  402.         writeln('program too long');
  403.         close(sfile);
  404.         close(listfile);
  405.         exit
  406.       end;
  407.     with code[cx] do
  408.       begin
  409.         f:=x; l:=y; a:=z    
  410.       end;
  411.      cx:=cx+1
  412.   end;  { gen }
  414.   procedure test(s1,s2:symset;n:integer);
  415.   begin
  416.     if not (sym in s1) then
  417.       begin
  418.         error(n); s1:=s1+s2;
  419.         while not (sym in s1) do getsym
  420.       end
  421.   end;  { test }
  423.   procedure block( fsys:symset;level:integer);
  424.   type
  425.     constrec=record   
  426.             tp:types;
  427.             i:integer
  428.            end;
  429.   var dx:integer;  { data allocation index }
  430.       tx0:integer; { initial table index }
  431.       cx0:integer; { initial code  index }
  432.       prt,prb:integer;
  433.   procedure enter( k:oobject);         
  434.    var j,l:integer;
  435.    begin
  436.      if tx=txmax
  437.       then  begin
  438.               error(1);
  439.               writeln('program too long');
  440.               close(sfile);
  441.               close(listfile);
  442.               exit
  443.             end
  444.       else  begin
  445.         nametab[0].name:=id;
  446.         j:=btab[display[level]].last; l:=j;
  447.         while nametab[j].name<>id do j:=nametab[j].link; 
  448.         if j<>0     
  449.         then error(l)
  450.         else begin     
  451.           tx:=tx+1;
  452.           with nametab[tx] do
  453.           begin             
  454.             name:=id; link:=l;
  455.             kind:=k;   typ:=notyp;    ref:=0;  
  456.             lev:=level;  normal:=false;
  457.             case kind of                                            
  458.               variable,prosedure: adr:=0;
  459.               konstant:           val:=0;
  460.               typel:              size:=0
  461.             end  { initial value }
  462.           end;
  463.           btab[display[level]].last:=tx 
  464.         end
  465.       end
  466.    end;   { enter }
  468.     function position(id:alfa):integer;    
  469.     var i,j:integer;
  470.     begin
  471.       nametab[0].name:=id; j:=level;
  472.       repeat
  473.         i:=btab[display[j]].last;
  474.         while nametab[i].name<>id do
  475.           i:=nametab[i].link;
  476.         j:=j-1
  477.       until (j<0) or (i<>0);
  478.       if (i=0) then error(10);
  479.       position:=i
  480.     end;  { position }
  482.     procedure constant(fsys:symset; var c:constrec);   
  483.       var x,sign:integer;
  484.       begin
  485.       c.tp:=notyp; c.i:=0;
  486.       test(constbegsys,fsys,50);
  487.       if sym in constbegsys
  488.       then begin
  489.         if   sym=charcon
  490.          then begin
  491.            c.tp:=chars; c.i:=num;
  492.            getsym
  493.          end else
  494.            begin
  495.              sign:=1;
  496.             if sym in [plus,minus]
  497.             then begin
  498.               if sym=minus then sign:=-1;
  499.               getsym
  500.             end;
  501.             if sym=ident
  502.             then begin
  503.               x:=position(id);
  504.               if x<>0
  505.               then if nametab[x].kind<>konstant
  506.                   then error(12)
  507.                   else begin
  508.                           c.tp:=nametab[x].typ;
  509.                           c.i:=sign*nametab[x].val
  510.                   end;
  511.               getsym
  512.             end else if sym=intcon
  513.                then begin
  514.                       c.tp:=ints; c.i:=sign*num;
  515.                       getsym
  516.                end
  517.        end;
  518.        test(fsys,[],6)
  519.      end
  520. end;    { constant }
  522. procedure typ(fsys:symset;var tp:types; var rf,sz:integer);
  523. var  eltp:types;
  524.      elrf,x:integer;
  525.      elsz,offset,t0,t1:integer;
  527. procedure arraytyp(var aref,arsz:integer); 
  528. var  eltp:types;
  529.      low,high:constrec;
  530.      elrf,elsz:integer;
  531. begin
  532.   constant([colon,rbrack,rparen,ofsym]+fsys,low);
  533.   if (low.tp<>ints)  and (low.tp<>chars)
  534.   then  error(50);
  535.   if sym=colon then getsym else error(38);
  536.   constant([rbrack,comma,rparen,ofsym]+fsys,high);
  537.   if high.tp<>low.tp
  538.   then begin
  539.     error(40); high.i:=low.i;
  540.   end;
  541.   enterarray(low.tp,low.i,high.i);
  542.   aref:=ax;
  543.   if sym=comma
  544.   then begin
  545.     getsym;
  546.     eltp:=arrays;
  547.     arraytyp(elrf,elsz)
  548.   end else begin
  549.     if sym=rbrack
  550.     then getsym
  551.     else begin
  552.       error(28);
  553.       if sym=rparen then getsym
  554.     end;
  555.     if sym=ofsym then getsym else error(17);
  556.     typ(fsys,eltp,elrf,elsz)
  557.   end;
  558.   with atab[aref] do
  559.   begin
  560.     arsz:=(high-low+1)*elsz; size:=arsz;
  561.     eltyp:=eltp; elref:=elrf; elsize:=elsz
  562.   end;
  563. end;   { arraytyp }
  564. begin  { typ }
  565.   tp:=notyp; rf:=0; sz:=0;
  566.   test(typebegsys,fsys,10);
  567.   if sym in typebegsys
  568.   then begin
  569.     if sym=ident
  570.     then begin
  571.        x:=position(id);
  572.        if x<>0
  573.        then with nametab[x] do
  574.               if kind<>typel
  575.               then error(19)
  576.               else begin
  577.                 tp:=typ;rf:=ref;sz:=size;
  578.                 if tp=notyp then error(18);
  579.               end;
  580.          getsym;
  581.     end else if sym=arraysym
  582.                 then  begin
  583.                   getsym;
  584.                   if sym=lbrack
  585.                   then getsym
  586.                   else begin
  587.                     error(16);
  588.                     if sym=lparen
  589.                     then getsym
  590.                   end;
  591.                   tp:=arrays;
  592.                   arraytyp(rf,sz)
  593.                 end ;
  594.          test(fsys,[],13)
  595.     end
  596.   end;       {typ}
  598.     procedure paramenterlist;   {formal parameter list}
  599.     var
  600.       tp:types;
  601.       valpar:boolean;
  602.       rf,sz,x,t0:integer;
  603.     begin
  604.       getsym;
  605.       tp:=notyp;rf:=0;sz:=0;
  606.       test([ident,varsym],fsys+[rparen],7);
  607.       while sym in [ident,varsym] do
  608.       begin
  609.         if sym <> varsym
  610.           then valpar:=true
  611.           else begin
  612.             getsym;
  613.             valpar:=false
  614.           end;
  615.           t0:=tx;
  616.           if sym=ident
  617.           then begin
  618.             enter(variable);
  619.             getsym
  620.           end  else error(22);
  621.           while sym=comma do
  622.           begin
  623.             getsym;
  624.             if sym=ident
  625.             then begin
  626.               enter(variable);
  627.               getsym
  628.             end  else error(22);
  629.           end;
  630.           if sym=colon
  631.           then begin
  632.             getsym;
  633.             if sym <> ident
  634.             then error(22)
  635.             else begin
  636.               x :=position(id); getsym;
  637.               if x<>0
  638.               then with nametab[x] do
  639.                 if kind <> typel
  640.                 then error(19)
  641.                 else begin
  642.                   tp:= typ; rf:=ref;
  643.                   if valpar then sz:=size else sz:=1
  644.                 end;
  645.             end;
  646.             test ([semicolon,rparen],[comma,ident]+fsys,14)
  647.           end else error(24);
  648.           while t0 < tx do
  649.           begin
  650.             t0 :=t0+1;
  651.             with nametab[t0] do
  652.             begin
  653.               typ :=tp;ref :=rf;
  654.               adr :=dx;lev :=level;
  655.               normal :=valpar;
  656.               dx :=dx+sz
  657.             end
  658.           end;
  659.           if sym <> rparen
  660.           then begin
  661.             if sym=semicolon
  662.             then getsym
  663.             else begin
  664.               error(23);
  665.             if sym=comma then getsym
  666.           end;
  667.           test([ident,varsym],[rparen]+fsys,13)
  668.         end
  669.       end {while};
  670.       if sym=rparen
  671.        then begin
  672.          getsym;
  673.          test([semicolon],fsys,13)
  674.        end else error(25)
  675.     end {parameterlist};
  678.     procedure constdeclaration;  
  679.     var c:constrec;
  680.     begin
  681.       if sym=ident then
  682.         begin
  683.           enter(konstant);
  684.           getsym;
  685.           if sym = eql
  686.             then getsym
  687.             else
  688.               begin
  689.                 error(26);
  690.                 if sym=becomes then getsym
  691.               end;
  692.           constant([semicolon,comma,ident]+fsys,c);
  693.           nametab[tx].typ:=c.tp;
  694.           nametab[tx].ref:=0;
  695.           nametab[tx].val:=c.i;
  696.           if sym=semicolon then getsym else error(23)
  697.         end
  698.         else error(22);
  699.       test(fsys+[ident],[],13)
  700.     end;   { constdeclaration }
  702.     procedure typedeclaration;  
  703.     var
  704.       tp:types;
  705.       rf,sz,t1:integer;
  706.     begin
  707.       if sym=ident then
  708.         begin
  709.           enter(typel);
  710.           t1:=tx;
  711.           getsym;
  712.           if sym = eql then  getsym
  713.           else begin
  714.               error(26);
  715.               if sym=becomes then   getsym;
  716.           end;
  717.          typ ([semicolon,comma,ident]+fsys,tp,rf,sz);
  718.          nametab[tx].typ:=tp;
  719.          nametab[tx].ref:=rf;
  720.          nametab[tx].size:=sz;
  721.          if sym=semicolon then getsym else error(23)
  722.         end
  723.         else error(22);
  724.       test(fsys+[ident],[],13)
  725.     end;   { typedeclaration }
  728.     procedure vardeclaration;  
  729.     var tp:types;
  730.         t0,t1,rf,sz:integer;
  731.     begin
  732.       if sym=ident then
  733.         begin
  734.           t0:=tx;
  735.           enter(variable); getsym;
  736.           while sym = comma do
  737.           begin
  738.             getsym;
  739.             if sym =ident
  740.             then begin
  741.               enter(variable);getsym;
  742.             end else error(22);
  743.           end;
  744.           if sym = colon then getsym else error(24);
  745.           t1:=tx;
  746.           typ ([semicolon,comma,ident]+fsys,tp,rf,sz);
  747.           while t0 < t1 do
  748.           begin
  749.             t0:=t0+1;
  750.             with nametab[t0] do
  751.             begin
  752.               typ:=tp;  ref:=rf;
  753.               lev:=level; adr:=dx;
  754.               normal:=true;
  755.               dx:=dx+sz
  756.             end
  757.           end;
  758.           if sym=semicolon then getsym else error(23)
  759.         end
  760.         else error(22);
  761.       test(fsys+[ident],[],13)
  762.     end;  { vardeclaration }
  764.     procedure procdeclaration;  
  765.     begin
  766.       getsym;
  767.       if sym <> ident
  768.       then  begin
  769.         error(22); id:=' '
  770.       end;
  771.       enter(prosedure);  
  772.       nametab[tx].normal:=true;
  773.       getsym;
  774.       block([semicolon]+fsys,level+1);
  775.       if sym = semicolon then getsym else error(23);
  776.     end;    {procdeclaration}
  778.     procedure listcode;
  779.     var i:integer;
  780.     begin
  781.       for i:=cx0 to cx-1 do
  782.         with code[i] do
  783.           writeln(listfile,i:4,mnemonic[f]:7,l:3,a:5)
  784.     end;  { listcode }
  786.     procedure statement(fsys:symset);
  787.     var i,cx1,cx2,cx3:integer;
  788.         x:item;
  789.       procedure arrayelement(fsys:symset;var x:item); forward;
  790.       procedure expression(fsys:symset;var x: item);
  791.       var relop:symbol;
  792.           y:item;
  793.         procedure simpleexpression(fsys:symset;var x:item);
  794.           var addop:symbol;
  795.               y:item;
  796.           procedure term(fsys:symset;var x: item);
  797.           var mulop:symbol;
  798.               y:item;
  799.             procedure factor(fsys:symset;var x:item);
  800.             var i:integer;
  801.             begin
  802.             x.typ:=notyp;
  803.             x.ref:=0;
  804.             test(facbegsys,fsys,13);
  805.             if sym in facbegsys then    { facbegsys :=[ident,intcon,lparen,notsym,charcon];}
  806.             begin
  807.               case sym of
  808.               ident :
  809.               begin
  810.                 i:=position(id);
  811.                 getsym;
  812.                 if i=0 then error(10)
  813.                 else
  814.                   with nametab[i] do
  815.                     case kind of
  816.                       konstant: begin
  817.                                   x.typ:=typ;
  818.                                   x.ref:=0;
  819.                                   gen(lit,0,val);
  820.                                 end;
  821.                       variable:
  822.                         begin
  823.                           x.typ:=typ;
  824.                           x.ref:=ref;
  825.                           if (typ = ints) or (typ = bool) or(typ=chars)
  827.                           then  if normal  then gen(lod,lev,adr)
  828.                                            else gen(ilod,lev,adr)
  829.                           else  if typ=arrays then
  830.                                begin
  831.                                  if normal then gen(loda,lev,adr)
  832.                                            else gen(lod,lev,adr);
  833.                                  if sym = lbrack
  834.                                    then arrayelement(fsys,x);
  835.                                  if x.typ <> arrays
  836.                                    then gen(lodt,0,0)
  837.                                end
  838.                         end;
  839.                       prosedure,typel:error(41)
  840.                     end;
  841.                   end ;
  842.               intcon,charcon :
  843.                 begin
  844.                   if sym = intcon then x.typ:=ints
  845.                                 else x.typ:=chars;
  846.                   x.ref:=0;
  847.                   gen(lit,0,num);
  848.                   getsym
  849.                 end;
  850.               lparen :
  851.                   begin
  852.                     getsym;
  853.                     expression([rparen]+fsys,x);
  854.                     if sym=rparen then getsym
  855.                     else error(25)
  856.                   end;
  857.               notsym :
  858.                   begin
  859.                     getsym;
  860.                     factor(fsys,x);
  861.                     if x.typ = bool
  862.                       then gen(nots ,0,0)
  863.                       else error(43)
  864.                   end;
  865.               end ;{ case }
  866.               test(fsys+[rbrack,rparen],facbegsys,23)
  867.             end  { of if }
  868.           end;  { factor }
  869.         begin   { term }
  870.           factor(fsys+[times,divsym,modsym,andsym],x);
  871.           while sym in [times,divsym,modsym,andsym] do
  872.             begin
  873.               mulop:=sym; getsym;
  874.               factor(fsys+[times,divsym,modsym,andsym],y);
  875.               if x.typ<>y.typ
  876.                 then begin
  877.                        error(40);
  878.                        x.typ:=notyp;
  879.                        x.ref:=0
  880.                      end
  881.                 else
  882.                   begin
  883.                     if mulop=times then
  884.                         if x.typ = ints
  885.                           then gen(mult,0,0)
  886.                           else error(43);
  887.                     if  mulop=divsym then
  888.                         if x.typ = ints
  889.                           then gen(idiv,0,0)
  890.                           else error(43);
  891.                     if  mulop=modsym then
  892.                         if x.typ = ints
  893.                           then gen(imod,0,0)
  894.                           else error(43);
  895.                     if  mulop=andsym then
  896.                       if x.typ = bool
  897.                           then gen(ands,0,0)
  898.                           else error(43)
  899.             end
  900.           end
  901.         end;  { term}
  902.       begin  { simpleexpression }
  903.         if sym in [plus,minus] then
  904.           begin
  905.             addop:=sym; getsym;
  906.             term(fsys+[plus,minus,orsym],x);
  907.             if addop=minus then gen(mus,0,0)
  908.           end  else term(fsys+[plus,minus,orsym],x);
  909.         while sym in [plus,minus,orsym] do
  910.           begin addop:=sym; getsym;
  911.                 term(fsys+[plus,minus,orsym],y);
  912.                 if x.typ<>y.typ
  913.                 then begin
  914.                        error(40);
  915.                        x.typ:=notyp;
  916.                        x.ref:=0
  917.                      end
  918.                 else
  919.                   begin
  920.                     if addop=plus then
  921.                         if x.typ = ints
  922.                           then gen(add,0,0)
  923.                           else error(43);
  924.                     if  addop=minus then
  925.                         if x.typ = ints
  926.                           then gen(sub,0,0)
  927.                           else error(43);
  928.                     if  addop=orsym then
  929.                       if x.typ = bool
  930.                           then gen(ors,0,0)
  931.                           else error(43)
  932.                  end
  933.             end
  934.       end;   { simpleexpression }
  935.     begin  {expression}
  936.        simpleexpression([eql,neq,lss,gtr,leq,geq]+fsys,x);
  937.        while (sym in [eql,neq,lss,leq,gtr,geq]) do
  938.          begin
  939.            relop:=sym; getsym; simpleexpression(fsys,y);
  940.            if x.typ<> y.typ
  941.              then error(40);
  942.            case relop of
  943.              eql:gen(eq,0,0);
  944.              neq:gen(ne,0,0);
  945.              lss:gen(ls,0,0);
  946.              geq:gen(ge,0,0);
  947.              gtr:gen(gt,0,0);
  948.              leq:gen(le,0,0)
  949.            end;
  950.            x.typ:=bool
  951.          end
  952.     end;       { expression }
  954.       procedure arrayelement(fsys:symset;var x:item);
  955.       var cc:integer;
  956.           addr,p:index;
  957.           y:item;
  958.       begin
  959.       p:=x.ref;
  960.       if sym=lbrack then
  961.         begin
  962.           repeat
  963.             getsym;
  964.             expression(fsys+[comma],y);
  965.             if x.typ <> arrays then error(40)
  966.             else
  967.               begin
  968.                 if y.typ <> atab[p].inxtyp then error(44);
  969.                 gen(lit,0,atab[p].low);
  970.                 gen(sub,0,0);
  971.                 gen(lit,1,atab[p].elsize);
  972.                 gen(mult,0,0);
  973.                 gen(add,0,0);
  974.                 x.typ:=atab[p].eltyp;
  975.                 x.ref:=atab[p].elref;
  976.                 p:=atab[p].elref;
  977.               end
  978.           until sym <> comma;
  980.           if sym=rbrack then getsym else error(28);
  981.         end else error(16);
  982.       test(fsys,[],13);
  983.     end;         {arrayelement}
  985.   procedure assignment;  
  986.     var x,y:item;
  987.       begin
  988.         i:=position(id);
  989.         if i=0 then error(10)
  990.         else
  991.           if nametab[i].kind<>variable then
  992.             begin  { giving value to non-variation }
  993.               error(30);  i:=0
  994.             end;
  995.         getsym;
  996.         x.typ:=nametab[i].typ;
  997.         x.ref:=nametab[i].ref;
  998.         with nametab[i] do
  999.           if normal
  1000.             then gen(loda,lev,adr)   
  1001.             else gen(lod,lev,adr);  
  1002.         if sym = lbrack  
  1003.             then arrayelement(fsys+[becomes],x);
  1004.         if sym = becomes then getsym
  1005.               else begin
  1006.                      error(33);
  1007.                      if sym=eql then getsym
  1008.                    end;
  1009.          expression(fsys,y);
  1010.          if x.typ <> y.typ then error(40)
  1011.          else
  1012.            if x.typ = arrays
  1013.              then if x.ref = y.ref
  1014.                      then gen(cpyb,0,atab[x.ref].size)  
  1015.                      else error(40)
  1016.              else gen(sto,0,0);   
  1017.       end;      
  1021.      procedure ifstatement;         
  1022.        var x:item;
  1023.        begin
  1024.          getsym; expression([thensym,dosym]+fsys,x);
  1025.          if x.typ <> bool then error(34);
  1026.          if sym=thensym then getsym else error(35);
  1027.          cx1:=cx; gen(jpc,0,0);  
  1028.          statement(fsys+[elsesym]);   
  1029.          if sym = elsesym
  1030.            then  begin
  1031.              getsym;
  1032.              cx2:=cx; gen(jmp,0,0);
  1033.              code[cx1].a:=cx;   
  1034.              labtab[lx]:=cx;lx:=lx+1;
  1035.              statement(fsys);
  1036.              code[cx2].a:=cx;   
  1037.              labtab[lx]:=cx;lx:=lx+1;
  1038.            end
  1039.          else
  1040.              begin     
  1041.                code[cx1].a:=cx;
  1042.                labtab[lx]:=cx;lx:=lx+1;
  1043.              end
  1044.        end;           {ifstatement}
  1046.      procedure casestatement;   {case}
  1047.          var x:item;
  1048.              coni,conj:integer; 
  1049.          begin
  1050.                 getsym;cx1:=cx;
  1051.                 expression([ofsym]+fsys,x);cx2:=cx;
  1052.               if (x.typ = ints) or (x.typ = chars)then 
  1053.                begin
  1054.                 if sym=ofsym then
  1055.                 begin
  1056.                  getsym;conj:=0;
  1057.                  while sym<>elsesym do 
  1058.                  begin
  1059.                      if (sym = intcon) or (sym = charcon) then
  1060.                      begin
  1061.                     coni:=cx1;
  1062.                       if conj<>0 then
  1063.                       begin
  1064.                       while coni<cx2 do
  1065.                       begin
  1066.                         code[cx]:=code[coni];
  1067.                          cx:=cx+1;
  1068.                          coni:=coni+1;
  1069.                       end
  1070.                       end;
  1071.                       conj:=1;
  1072.                       gen(lit,0,num);
  1073.                       coni:=cx1;
  1074.                       end
  1075.                       else error(12);
  1076.                       getsym;
  1077.                        if sym=colon then
  1078.                        begin
  1079.                           getsym;
  1080.                           gen(eq,0,0);
  1081.                           cx2:=cx;
  1082.                             gen(jpc,0,0);
  1083.                             statement([semicolon]+fsys);
  1084.                        if sym=semicolon then
  1085.                        begin
  1086.                         getsym;
  1087.                         labtab[lx]:=cx;lx:=lx+1;
  1088.                         gen(jmp,0,0);
  1089.                         code[cx2].a:=cx
  1090.                          end
  1091.                        else error(23)
  1092.                       end
  1093.                       else  error(24){colon}
  1094.                      end;
  1095.                    if sym=elsesym then
  1096.                      begin
  1097.                         getsym;
  1098.                     statement([endsym]+fsys);
  1099.                         lx:=lx-1;
  1100.                          while lx>=0 do
  1101.                          begin code[labtab[lx]].a:=cx;
  1102.                         lx:=lx-1
  1103.                          end
  1104.                   end;
  1105.                   if sym=endsym then getsym
  1106.                   else error(36)
  1107.               end
  1108.               else error(17)
  1109.              end
  1110.           end;
  1114.     procedure compound;   
  1115.       begin
  1116.         getsym; statement([semicolon,endsym]+fsys);
  1117.         while sym in ([semicolon]+statbegsys) do
  1118.         begin
  1119.           if sym=semicolon then getsym else error(23);
  1120.           statement([semicolon,endsym]+fsys) 
  1121.         end;
  1122.         if sym=endsym then getsym else error(36)
  1123.       end;         {compound}
  1125.     procedure whilestatement; 
  1126.       var x:item;
  1127.       begin
  1128.         getsym;
  1129.         labtab[lx]:=cx;lx:=lx+1;
  1130.         cx1:=cx; expression([dosym]+fsys,x);    
  1131.         if x.typ <> bool then error(34);
  1132.         cx2:=cx; gen(jpc,0,0);
  1133.         if sym=dosym then getsym else error(37);
  1134.         statement(fsys); gen(jmp,0,cx1); code[cx2].a:=cx;
  1135.         labtab[lx]:=cx;lx:=lx+1
  1136.       end;
  1138.       procedure repeatstatement;{repeat}
  1139.       var x:item;
  1140.       begin
  1141.         getsym;cx1:=cx; labtab[lx]:=cx;lx:=lx+1;
  1142.         statement([untilsym]+fsys);
  1143.         if sym<>semicolon then error(23);
  1144.         getsym;
  1145.         while (not (sym in ([untilsym]))) do
  1146.           begin
  1147.            statement([untilsym]+fsys);
  1148.            if sym<>semicolon then error(23);
  1149.            getsym
  1150.           end;
  1152.         if sym=untilsym then 
  1153.           begin
  1154.             getsym;
  1155.             expression([endsym]+fsys,x);
  1156.             if x.typ <> bool then error(34); 
  1157.             gen(jpc,0,cx1);labtab[lx]:=cx;lx:=lx+1
  1158.           end
  1159.       end;
  1162. procedure forstatement;{for}
  1163. var x,ini,fin:item;
  1164. begin
  1165.      getsym;
  1166.      if sym=ident then
  1167.      begin 
  1168.              i:=position(id);getsym;
  1169.              if i=0 then error(10)
  1170.              else
  1171.                   if nametab[i].kind<>variable then
  1172.                      begin
  1173.                      error(30);i:=0
  1174.                      end 
  1175.                   else
  1176.                      begin
  1177.                         x.typ:=nametab[i].typ;
  1178.             x.ref:=nametab[i].ref; 
  1179.             if nametab[i].normal  
  1180.             then gen(loda,nametab[i].lev,nametab[i].adr)
  1181.             else gen(lod,nametab[i].lev,nametab[i].adr)
  1182.            end;
  1183.        if sym=becomes then 
  1184.        begin
  1185.            getsym;
  1186.            expression([tosym]+fsys,ini);
  1187.              if  ini.typ<>ints then error(12)
  1188.              else begin
  1189.                      gen(sto,0,0);
  1190.                      if sym=tosym then
  1191.                          begin
  1192.                             getsym;cx1:=cx;labtab[lx]:=cx;lx:=lx+1;
  1193.                             gen(loda,nametab[i].lev,nametab[i].adr);
  1194.                             gen(lodt,0,0);
  1195.                             expression([dosym]+fsys,fin);
  1196.                           if sym=dosym then
  1197.                                begin
  1198.                                  gen(le,0,0);
  1199.                                  cx2:=cx;labtab[lx]:=cx;lx:=lx+1;
  1200.                                  gen(jpc,0,0);
  1201.                                      getsym;
  1202.                                    statement(fsys);
  1203.                                      if nametab[i].normal then
  1204.                                      begin
  1205.                                          gen(loda,nametab[i].lev,nametab[i].adr);
  1206.                                          gen(loda,nametab[i].lev,nametab[i].adr);
  1207.                            gen(lodt,0,0)
  1208.                                      end
  1209.                                      else gen(lod,nametab[i].lev,nametab[i].adr);
  1210.                                      gen(lit,0,1);
  1211.                                      gen(add,0,0);
  1212.                          gen(sto,0,0);
  1213.                          gen(jmp,0,cx1);
  1214.                          code[cx2].a:=cx
  1215.                                  end
  1216.                          end
  1217.                       end
  1218.        end
  1219.    end
  1220.    else error(33)
  1221. end;
  1230.     procedure call;       
  1231.     var      x:  item;
  1232.              lastp,cp,i,j,k:integer;
  1233.     procedure stanproc(i:integer);
  1234.     var n:integer;
  1235.     begin
  1236.       if i =6  then
  1237.         begin    { read }
  1238.           getsym;
  1239.           if sym=lparen then
  1240.           begin
  1241.             repeat
  1242.               getsym;
  1243.               if sym=ident then
  1244.                 begin
  1245.                   n:=position(id); getsym;
  1246.                   if n=0 then error(10)
  1247.                     else
  1248.                       if nametab[n].kind<>variable then
  1249.                          begin error(30); n:=0 end
  1250.                       else
  1251.                         begin
  1252.                           x.typ:=nametab[n].typ;
  1253.                           x.ref:=nametab[n].ref;
  1254.                           if nametab[n].normal
  1255.                             then gen(loda,nametab[n].lev,nametab[n].adr)
  1256.                             else gen(lod,nametab[n].lev,nametab[n].adr);
  1257.                           if sym = lbrack
  1258.                              then arrayelement(fsys+[comma],x);
  1259.                           if x.typ = ints
  1260.                             then gen(red,0,0)
  1261.                             else if x.typ = chars
  1262.                                    then gen(red,0,1)
  1263.                                    else error(43)
  1264.                         end
  1265.                 end
  1266.                 else error(22)
  1267.               until sym<>comma;
  1268.               if sym<>rparen then error(25)
  1269.                                else  getsym
  1270.             end
  1271.             else error(32)
  1272.           end
  1273.           else
  1274.             if i = 7 then
  1275.               begin        { write }
  1276.                 getsym;
  1277.                 if sym=lparen then
  1278.                   begin
  1279.                     repeat
  1280.                       getsym;
  1281.                       expression([rparen,comma]+fsys,x);
  1282.                       if x.typ = ints
  1283.                         then gen(wrt,0,0)
  1284.                         else if x.typ = chars
  1285.                                then gen(wrt,0,1)
  1286.                                else error(43)
  1287.                     until sym<>comma;
  1288.                     if sym<>rparen then error(25);
  1289.                     getsym
  1290.                   end
  1291.                 else error(32)
  1292.              end
  1293.     end;    { standproc }
  1294.     begin    { call }
  1295.       getsym;
  1296.       if sym = ident  then
  1297.       begin
  1298.         i:=position(id);
  1299.         if nametab[i].kind = prosedure then
  1300.         begin
  1301.           if nametab[i].lev = 0 then stanproc(i)
  1302.           else begin
  1303.             getsym;
  1304.             gen(opac,0,0);  {open active record}
  1305.             lastp :=btab[nametab[i].ref].lastpar;
  1306.             cp :=i;
  1307.             if sym=lparen
  1308.             then begin {actual parameter list}
  1309.             repeat
  1310.               getsym;
  1311.               if cp>=lastp
  1312.               then error(29)
  1313.               else begin
  1314.                 cp :=cp+1;
  1315.                 if nametab[cp].normal  then
  1316.                 begin {value parameter}
  1317.                   expression(fsys+[comma,colon,rparen],x);
  1318.                   if x.typ = nametab[cp].typ then
  1319.                     begin
  1320.                       if x.ref <> nametab[cp].ref
  1321.                         then error(31)
  1322.                         else if x.typ = arrays
  1323.                                then gen(lodb,0,atab[x.ref].size)
  1324.                     end
  1325.                   else error(31)
  1326.                 end else begin {variable parameter}
  1327.                   if sym <> ident
  1328.                   then error(22)
  1329.                   else begin
  1330.                     k:=position(id);
  1331.                     getsym;
  1332.                     if k<>0
  1333.                     then begin
  1334.                       if nametab[k].kind<>variable then error (30);
  1335.                       x.typ :=nametab[k].typ;
  1336.                       x.ref :=nametab[k].ref;
  1337.                       if nametab[k].normal
  1338.                       then gen(loda,nametab[k].lev,nametab[k].adr)
  1339.                       else gen(lod,nametab[k].lev,nametab[k].adr);
  1340.                       if sym = lbrack
  1341.                         then  arrayelement(fsys+[comma,rparen],x);
  1342.                       if    (nametab[cp].typ<>x.typ)
  1343.                         or (nametab[cp].ref<>x.ref)
  1344.                          then error(31);
  1345.                     end
  1346.                   end
  1347.                 end {variable parameter}
  1348.               end;
  1349.               test([comma,rparen],fsys,13)
  1350.             until sym <> comma;
  1351.             if sym=rparen then getsym  else error(25)
  1352.           end;
  1353.           if cp < lastp then error(39);{too few actual parameters}
  1354.           gen(cal,nametab[i].lev,nametab[i].adr);
  1355.           if nametab[i].lev<level then gen(udis,nametab[i].lev,level)
  1356.         end
  1357.       end else error(51)
  1358.     end else error(22);
  1359.     test(fsys+[ident],[],13)
  1360.   end {call};
  1361.     begin  { statement }
  1362.       test(statbegsys+[ident],fsys,13);
  1363.       if sym=ident then  assignment
  1364.       else if sym=callsym then call
  1365.       else   if sym=ifsym then  ifstatement
  1366.       else   if sym=casesym then  casestatement
  1367.       else   if sym=repeatsym then repeatstatement
  1368.         else   if sym=forsym then forstatement
  1369.       else   if sym=beginsym then compound
  1370.       else    if sym=whilesym then whilestatement;
  1371.       test(fsys+[elsesym],[],13)
  1372.     end;  { statement }
  1373.   begin   { block }
  1374.     prt:=tx;
  1375.     dx:=3; tx0:=tx; nametab[tx].adr:=cx;
  1376.     if level > levmax then error(4);
  1377.     enterblock ;
  1378.     prb:=bx;  display[level]:=bx;
  1379.     nametab[prt].typ:=notyp;  nametab[prt].ref:=prb;
  1381.     if(sym=lparen) and (level>1)
  1382.       then
  1383.         begin
  1384.           paramenterlist;
  1385.           if sym=semicolon then getsym
  1386.                            else error(23)
  1387.         end
  1388.       else  if level>1 then
  1389.               if sym=semicolon then getsym
  1390.                             else error(23);
  1391.     btab[prb].lastpar:=tx;
  1392.     btab[prb].psize:=dx;
  1394.     gen(jmp,0,0);  { jump from declaration part to statement part }
  1395.     repeat
  1396.       if sym=constsym then
  1397.         begin
  1398.           getsym;
  1399.           repeat
  1400.             constdeclaration;
  1401.           until sym<>ident
  1402.         end;
  1403.       if sym=typesym then
  1404.         begin
  1405.           getsym;
  1406.           repeat
  1407.             typedeclaration;
  1408.           until sym<>ident
  1409.         end;
  1410.       if sym=varsym then
  1411.         begin
  1412.           getsym;
  1413.           repeat
  1414.             vardeclaration;
  1415.           until sym<>ident;
  1416.         end;
  1417.       while sym=procsym do   procdeclaration;
  1418.       test(statbegsys+[ident],declbegsys,13)
  1419.     until not (sym in declbegsys);
  1420.     code[nametab[tx0].adr].a:=cx;  {back enter statement code's start adr. }
  1421.     labtab[lx]:=cx;lx:=lx+1;
  1422.     with nametab[tx0] do
  1423.       begin
  1424.         adr:=cx;  {code's start address }
  1425.       end;
  1426.     cx0:=cx;
  1427.     gen(entp,level,dx);  { block entry }
  1428.     statement([semicolon,endsym]+fsys);
  1429.     if level>1 then gen(retp,0,0)  {return}
  1430.                else gen(endp,0,0);  { end prograam }
  1431.     test(fsys,[],13);
  1432.     listcode;
  1433.   end;   { block }
  1435. {************************************************************************}
  1436. begin  { main }
  1437.   writeln('Please input source program file name:');
  1438.   readln(sfilename);
  1439.   assign(sfile,sfilename);
  1440.   reset(sfile);
  1442.   fsplit(sfilename,dir, name,ext);  
  1443.   listfilename:=dir +name+'.LST';
  1444.   assign(listfile,listfilename);
  1445.   rewrite(listfile);
  1447.   initial;
  1448.   enterpreid;
  1449.   getsym;
  1450.   if sym = programsym then
  1451.     begin
  1452.       getsym;
  1453.       if sym = ident then
  1454.         begin
  1455.           getsym;
  1456.           if sym = semicolon then getsym
  1457.           else error(23)
  1458.         end
  1459.         else error(22)
  1460.     end
  1461.     else error(15);
  1462.     test(declbegsys+[beginsym],[],13);
  1463.   block([period]+declbegsys+statbegsys,1);
  1464.   if sym<>period then error(38);
  1465.   if err=0 then
  1466.       begin
  1467.        write('SUCCESS');
  1468.        assign(fcode,dir+name+'.pld');
  1469.        rewrite(fcode);
  1470.        for i:=0 to cx do
  1471.          write(fcode,code[i]);
  1472.        close(fcode);
  1473.        assign(labfile,dir+name+'.lab');
  1474.        rewrite(labfile);
  1475.        for i:=0 to lx do
  1476.          write(labfile,labtab[i]);
  1477.        close(labfile)
  1478.       end
  1479.   else write(err,'ERRORS IN PROGRAM');
  1480.   writeln;
  1481.   close(sfile);
  1482.   close(listfile)
  1483.  end.  { of whole program  }

测试代码

case
  1. program fsj;
  2. var n:integer;
  3.     a:char;   
  4. begin
  5.     n:=2;
  6.     a:='f';
  7.     case a of
  8.      1: call write(1);
  9.      'f': call write(n);
  10.     else call write(2)
  11.    end
  12. end.
repeat
  1. program fsj;
  2. var n:integer;  
  3. begin
  4.    n:=1;
  5.    repeat 
  6.      n:=n+1;
  7.    until n=5;
  8. call write(n)
  9. end.
for
  1. program fsj;
  2. var i,sum:integer;  
  3. begin
  4.   sum:=0;
  5.   for i:=3 to 7 do
  6.      sum:=sum+i*2;
  7.   call write(sum)
  8. end.
添加新批注
在作者公开此批注前，只有你和作者可见。
回复批注