gen-test.pas

编译原理实验 完整的

program EL(input,output);



label
   99;

const
   norw=13;
   txmax=100;
   nmax=14;
   al=10;
   amax=2047;
   levmax=3;
   cxmax=200;

type
   symbol=(NUL,IDENT,NUMBER,PLUS,MINUS,TIMES,SLASH,ODDSYM,
           EQL,NEQ,LSS,LEQ,GTR,GEQ,LPAREN,RPAREN,COMMA,
           SEMICOLON,PERIOD,BECOMES,BEGINSYM,ENDSYM,IFSYM,
           THENSYM,WHILESYM,WRITESYM,READSYM,DOSYM,CALLSYM,
           CONSTSYM,VARSYM,PROCSYM);
   alfa=packed array [1..al] of char;
   object0=(constant,variable,prosedure);
   symset=set of symbol;
   fct=(lit,opr,lod,sto,cal,int,jmp,jpc,red,wrt);
   instruction=packed record
                        f:fct;
                        l:0..levmax;
                        a:0..amax;
                      end;
var
   listswitch:boolean;
   ch:char;
   sym:symbol;
   id:alfa;
   num:integer;
   ii:integer;
   cc:integer;
   ll:integer;
   kk:integer;
   cx:integer;
   err:integer;
   line:array [0..cxmax] of char;
   a:alfa;
   fname:alfa;
   code:array [0..cxmax] of instruction;
   word:array [1..norw] of alfa;
   wsym:array [1..norw] of symbol;
   ssym:array [char] of symbol;
   mnemonic:array [fct] of
             packed array[1..5] of char;
   declbegsys,statbegsys,facbegsys:symset;
   table:array [0..txmax] of
      record name:alfa;
             case kind:object0 of
             constant:(val:integer);
             variable,prosedure:(level,adr:integer)
      end;
   fin:text;
   sfile:string;

procedure error(n: integer);
begin  writeln('****',' ': cc-1,'^',n:2);  err:=err+1
end;{error}

procedure getsym;
   var i,j,k:integer;

   procedure getch;
   begin if cc=ll then
     begin if eof(fin) then
              begin writeln('program incomplete');
                 close(fin);
                 exit;
              end;
           ll:=0;cc:=0;write(cx:4,' ');
           while not eoln(fin) do
              begin ll:=ll+1;  read(fin,ch); write(ch);
                line[ll]:=ch
              end;
           writeln;readln(fin);
           ll:=ll+1;line[ll]:=' '
     end;
     cc:=cc+1;ch:=line[cc]
   end;{getch}

begin
   while ch=' ' do getch;
   if ch in ['a'..'z'] then
   begin
      k:=0;
      repeat if k<al then
         begin k:=k+1;  a[k]:=ch
         end;
         getch
      until not (ch in ['a'..'z','0'..'9']);
      if k>=kk then kk:=k else
          repeat a[kk]:=' ';kk:=kk-1
          until kk=k;
      id:=a;i:=1;j:=norw;
      repeat k:=(i+j) div 2;
         if id<=word[k] then j:=k-1;
         if id>=word[k] then i:=k+1
      until i>j;
      if i-1>j then sym:=wsym[k] else sym:=ident
   end else
   if ch in['0'..'9'] then
   begin
      k:=0;num:=0;sym:=number;
      repeat num:=10*num +(ord(ch)-ord('0'));
         k:=k+1;getch
      until not(ch in['0'..'9']);
      if k>nmax then error(30)
   end else
   if ch=':' then
   begin getch;
      if ch='=' then
      begin sym:=becomes; getch
      end else   sym:=nul
   end else
   if ch='<' then
   begin getch;
      if ch='=' then
      begin sym:=leq; getch
      end else if ch='>' then
      begin sym:=neq; getch
      end else   sym:=lss
   end else
   if ch='>' then
   begin getch;
      if ch='=' then
      begin sym:=geq; getch
      end else   sym:=gtr
   end else
   begin sym:=ssym[ch];  getch
   end
end;{getsym}

procedure gen(x: fct;y,z: integer);
begin if cx>cxmax then
         begin writeln('program too long');
             close(fin);
             exit;
         end;
      with code[cx] do
        begin f:=x;  l:=y;  a:=z
        end;
      cx:=cx+1
end;{gen}

procedure test(s1,s2:symset; n:integer);
begin if not (sym in s1) then
         begin error(n);  s1:=s1+s2;
             while not  (sym in s1)  do getsym
         end
end;{test}

begin{main}
     writeln('please input source program file name:');
     readln(sfile);
     assign(fin,sfile);
     reset(fin);
     for ch:='A' to ';' do ssym[ch]:=nul;
     word [1]:='begin     ';  word [2]:='call      ';
     word [3]:='const     ';  word [4]:='do        ';
     word [5]:='end       ';  word [6]:='if        ';
     word [7]:='odd       ';  word [8]:='procefure ';
     word [9]:='read      ';  word[10]:='then      ';
     word[11]:='var       ';  word[12]:='while     ';
     word[13]:='write     ';

     wsym [1]:= beginsym; wsym [2]:= callsym;
     wsym [3]:= constsym; wsym [4]:= dosym;
     wsym [5]:= endsym;   wsym [6]:= ifsym;
     wsym [7]:= oddsym;   wsym [8]:= procsym;
     wsym [9]:= readsym;  wsym[10]:= thensym;
     wsym[11]:= varsym;   wsym[12]:= whilesym;
     wsym[13]:= writesym;
     ssym ['+']:=plus;    ssym['-']:=minus;
     ssym ['*']:=times;   ssym['/']:=slash;
     ssym ['(']:=lparen;  ssym[')']:=rparen;
     ssym ['=']:=eql;     ssym[',']:=comma;
     ssym ['.']:=period;  ssym['<']:=lss;
     ssym ['>']:=gtr;     ssym[';']:=semicolon;

     mnemonic[lit]:='LIT  '; mnemonic[opr]:='OPR  ';
     mnemonic[lod]:='LOD  '; mnemonic[sto]:='STO  ';
     mnemonic[cal]:='CAL  '; mnemonic[int]:='INT  ';
     mnemonic[jmp]:='JMP  '; mnemonic[jpc]:='JPC  ';
     mnemonic[red]:='RED  '; mnemonic[wrt]:='WRT  ';

     declbegsys :=[constsym,  varsym,  procsym];
     statbegsys :=[beginsym, callsym,    ifsym,   whilesym];
     facbegsys  :=[   ident,  number,   lparen];
     err:=0;

     cc:=0;  cx:=0;  ll:=0;  ch:=' ';  kk:=al;  getsym;
     {block(0,0,[period] +declbegsys+statbegsys); }
     if sym <> period then error(9);
     if err=0 then {interpret}
              else write('ERRORS IN EL PROGRAM');
     writeln;
     close(fin)
end.