Member Avatar for kippwinger
kippwinger 0 Newbie Poster

Hey all, I have been stuck on this problem for weeks now. Basically I took a variation on Wirth's compiler and adding some more functionality to it. I needed to add FOR loop and CASE statement functionality to it.
I have the bulk of both of them done but when I input a test input file (labeled as 'valid.pas' in the code) it either hangs up when I run it or doesn't output anything.

here is the code for both statements. I have also attached the full compiler which can be compiled using any free pascal compiler. (**Just change from .txt to .pas**)

CASE Statement

casesym:begin
                { Code for CASE }
             {counter declared as a global}
             counter:=0;
             getsym;
             expression;
             if sym <> ofsym then error(27);
              getsym;
              while sym <> cendsym do;
              begin
               getsym;
               if sym <> constsym then error(29);
               getsym;
               counter := counter + 1; {count # of cases}

               gen(CTS,0,0); {copy to top of stack}
               gen(LIT,0,table[i].adr); {get value of const}
               gen(OPR,0,8); {=}
               cx1:=codeinx; {save codeinx}
               gen(JPC,0,0);

               if sym <> colon then error(39);
               getsym;
               statement;
               if sym <> semicolon then error(17);
               getsym;
               if counter = 1 then
                 begin
                   cx2:=codeinx;
                   gen(JMP,0,0);
                 end
               else
                 gen(JMP,0,cx2);

              end;
              {cend has been found}
              code[cx2].ad:=codeinx;
              gen(INT,0,-1); {get rid of copied value on stk }
         end;

FOR Loop

forsym:begin
                { Code for FOR }
             getsym;
             if sym <> ident then error(11);
             i:=position(id);
             if i=0 then error(11);
              if table[i].kind <> variable then error(37);
              getsym;
             if sym <> becomes then error(38);
              getsym;
              expression;
              gen(STO,lev-table[i].level,table[i].adr);
             if not (sym in [tosym, downtosym]) then error(11);
              sym2:=sym; {store TO/DOWNTO}
              getsym;
              expression;
              cx1:=codeinx;
              {}
               gen(STO,0,0);
               gen(LOD,lev,table[i].adr);
               if sym2=tosym then gen(OPR,0,12){to}
               else
               gen(OPR,0,13); {downto}
               cx2:=codeinx;
               gen(JPC,0,0);
              {}
             if sym <> dosym then error(18);
              getsym;
              statement;
              gen(LOD,lev,table[i].adr);
              gen(LIT,0,1);

              if sym2=tosym then gen(OPR,0,2) {add}
              else
               gen(OPR,0,1);{subtract}

              gen(STO,0,0);
              gen(JMP,0,cx1); {jump back}
              code[cx2].ad:=codeinx;

        end;

Thanks for your help

Program Compiler(infile,outfile);
const
     norw = 22;         { no. of reserved words }
     txmax = 100;       { length of identifier table }
     nmax = 14;         { max. no of digits in numbers }
     al = 10;           { length of identifiers }
     amax= 2047;        { maximum address }
     levmax = 5;        { maximum depth of block nesting }
     cxmax = 500;       { size of code array }
     stacksize = 255;   { size of stack }
     p_max = 100;       { maximum no of parameters }
type
    symbol = (nul,ident,number,plus,minus,times,slash,oddsym,
     eql,neq,lss,leq,gtr,geq,lparen,rparen,comma,semicolon,colon,
     period,becomes,beginsym,elsesym,endsym,ifsym,thensym,
     whilesym,dosym,callsym,constsym,varsym,repeatsym,untilsym,procsym,
     forsym,tosym,downtosym,casesym,ofsym,cendsym,writelnsym,writesym,
     orsym,andsym);
    alfa = packed array[1..al] of char;
    objects = (constant,variable,procdure);
    fct=(LIT,OPR,LOD,STO,CAL,INT,JMP,JPC,CTS); (* Functions *)
    instruction= packed record
                        f:fct;         (* function code *)
                        lvl:0..levmax; (* level *)
                        ad:0..amax;    (* displacement address *)
                       end;
var
   infile,outfile:text;
   ch: char;            { last character read }
   sym:symbol;          { last symbol read }
   sym2:symbol;         { added to handle saved sym }
   savedsym:symbol;     { added to handle saved syms }
   id :alfa;            { last identifier read }
   num,i: integer;      { last number read }
   charcnt : integer;   { character count }
   linlen : integer;    { line length }
   kk : integer;
   counter : integer;   { counter for case stmnt }
   codeinx: integer;    { code allocation index }
   line: array [1..81] of char;
   a: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;
   table: array [0..txmax] of record
            name: alfa;
            case kind: objects of
            constant:(val : integer);
            variable,procdure:(level,adr:integer)
            end;

procedure error(I:integer);
begin
   case I of
     1:writeln(outfile,' Use =  instead of :=');
     2:writeln(outfile,' = must be followed by a number.');
     3:writeln(outfile,' Identifier must be followed by =.');
     4:writeln(outfile,' Const, Var, Procedure must be followed by an identifier.');
     5:writeln(outfile,' Semicolon or comma missing.');
     6:writeln(outfile,' Incorreet symbol after procedue declaration.');
     7:writeln(outfile,' Statement expected.');
     8:writeln(outfile,' Incorrect symbol after statement part in block.');
     9:writeln(outfile,' Period expected.');
     10:writeln(outfile,' Semicolon between statements is missing.');
     11:writeln(outfile,' Undeclared identifier.');
     12:writeln(outfile,' Assignment to constant  or  procedure is not allowed.');
     13:writeln(outfile,' Assignment operator := expected.');
     14:writeln(outfile,' call must be followed by an identifier.');
     15:writeln(outfile,' Call of a constant or a variable is meaningless.');
     16:writeln(outfile,' Then expected.');
     17:writeln(outfile,' Semicolon or end expected.');
     18:writeln(outfile,' DO expected.');
     19:writeln(outfile,' Incorrect symbol following statement.');
     20:writeln(outfile,' Relational operator expected.');
     21:writeln(outfile,' Expression must not contain a procedure identifier.');
     22:writeln(outfile,' Right parenthesis missing.');
     23:writeln(outfile,' The preceding factor cannot be followed by this symbol.');
     24:writeln(outfile,' An expression cannot begin with this symbol.');
     25:writeln(outfile,' UNTIL expected.');
     26:writeln(outfile,' TO or DOWNTO is expected.');
     27:writeln(outfile,' OF expected.');
     28:writeln(outfile,' : expected.');
     29:writeln(outfile,' Constant or Number is expected.');
     30:writeln(outfile,' This number is too large.');
     31:writeln(outfile,' CEND is expected.');
     32:writeln(outfile,' FOR must be followd by identifier. ');
     33:writeln(outfile,' Duplicate identifier.');
     34:writeln(outfile,' Procedures nested too deep.');
     35:writeln(outfile,' Program Too Long.');
     36:writeln(outfile,' Else expected.');
     37:writeln(outfile,' Variable expected.');
     38:writeln(outfile,' =: expected.');
     39:writeln(outfile,' colon expected.');
     40:writeln(outfile,' Left Parenthesis missing.');
   end;
   close(infile);
   close(outfile);
   HALT
end;

{             GEN(bla,0,0)            }
procedure gen(x:fct; y,z:integer);
begin
     if codeinx >cxmax then error(35);
     with code[codeinx] do
      begin
       f:=x;
       lvl:=y;
       ad:=z
      end;
     codeinx:=codeinx+1
end;

procedure getsym; {this procedure classifies each token as a particular symbol. }
 var i,j,k:integer;

 procedure getch;
  {this procedure reads in a line at a time from the input file and stores
   it in an array. A character at atime is read from the array }
  begin {getch}
   if charcnt=linlen then
    begin
      if eof(infile) then
       begin
        writeln(outfile,'PROGRAM INCOMPLETE');
        if (sym=endsym) then error(9);
       end;
      linlen:=0; charcnt:=0; write(outfile,' ');
      while not eoln(infile) do
       begin
         linlen:=linlen+1;
         read(infile,ch);
         write(outfile,ch);
         ch:=upcase(ch);
         line[linlen]:=ch {read in a line from input file }
       end;
      writeln(outfile);
      linlen:=linlen+1;
      readln(infile);
      line[linlen]:=' ' { initialize last character or string as a spaces }
    end;
   charcnt:=charcnt+1;
   ch:=line[charcnt]
  end; {getch}

begin { getsym}
 while ch=' ' do getch;
 if ch in ['A'..'Z'] then
  begin { identifier or keyword}
   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;               {binary search to determine if id is a reseved word}
   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] { reserved word or identifier }
   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:=colon
    end
    else
     if ch='>' then
      begin
       getch;
       if ch='=' then
        begin
         sym:=geq;
         getch
        end
       else sym:=gtr
      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
       begin
        sym:=ssym[ch];
        getch
       end
end; {getsym}

procedure block(lev,tx:integer);
var
   dx,                  (* Data allocation index *)
   tabinx0,             (* Initial table index   *)
   codeinx0:integer;    (* Initial code index   *)

function position(k:alfa):integer;
var
  i:integer;
begin
  table[0].name:=k;
  i:=tx;
  while table[i].name<>k do
   i:=i-1;
  position:=i;
end;

procedure enter(k:objects);
begin
         tx:=tx+1;
         with table[tx] do
          begin
            name:=id;
            kind:=k;
            case k of
                 constant: begin
                            if num>amax then error(30);
                            val:=num
                            end;
                 variable:begin
                           level:=lev;
	                   adr:=dx;
                           dx:=dx+1;
                          end;
                 procdure: level:=lev
            end
          end

end;

procedure listcode;
var i:integer;
begin (*list code generated for this block *)
      for i:=codeinx0 to codeinx - 1 do
       with code[i] do
        writeln(outfile,i:4,' ',mnemonic[f]:5,' ',lvl:3,' ',ad:5)
end;

procedure constdeclaration;
begin
 if sym=ident then
  begin
   getsym;
   if sym=eql then
    begin
     getsym;
     if sym=number then
      begin
       enter(constant);
       getsym;
      end
     else error(2)
    end
   else error(3)
  end
 else error(4)
end;

procedure vardeclaration;
begin
 if sym=ident then
  begin
       enter(variable);
       getsym;
  end
 else error(4)
end;


procedure statement;
var
    i,j,
    cx1,cx2:integer;

procedure expression;
    var plusop:symbol;

 procedure term;
    var multop:symbol;

  procedure factor;
   var i : integer;

  begin { factor }
    if sym = ident then
     begin
       i := position(id);
       if i = 0  then error(11)
       else
        with table[i] do
         case kind of
          variable:gen(LOD,lev-level,adr);
          constant:gen(LIT,0,val);
          procdure:error(12)
        end;
       getsym
     end
    else
     if sym = number then
      begin
       gen(LIT,0,num);
       getsym
	end
      else
      if sym = lparen then
       begin
        getsym;
        expression;
        if sym = rparen then
         getsym
        else error(22)
       end
      else error(24)
  end; { factor }

 begin { term }
  factor;
  while sym in [times,slash] do
   begin
    multop:=sym;
    getsym;
    factor;
    if multop=times then gen(OPR,0,4)
    else gen(OPR,0,5)
   en
  • 1 Contributor
  • 0 Replies
  • 64 Views
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.