Plov007 : Nested IF loops

After having stabilized the LOOP and REPEAT functions it was time to tackle the IF loop. The IF already was working reasonably well, but only in the simplest form: IF cond THEN act END. Which wasn't enough since I EBNFt that the IF is of the form

	IF  condition  THEN
	   action
	ELSIF condition  THEN
	   action
	ELSIF condition  THEN
	   IF  condition  THEN
	      action
	   ELSIF  condition  THEN
	      action
	   ELSE
	      action
	   END
	ELSE
	   action
	END
   
which, as you can imagine, is a whole other cup of cake. In a graph, (on the right) this is what needs to be done: plus some more details but this is the big picture. The trouble lies in the labels. A generic InsertLabel routine will go false when something inside the IF changes the labelcount. So we need purely local label counters, so that, if the IF loop is entered before the previous IF is completed, the old values of the label counts remains valid. It was solved by making the label counter twofold:
  1. A global 'IFcounter', which is incremented when the IFloop is entered
  2. A local copy of the 'IFcounter' is made in 'IFc'
  3. A local subcounter 'lbnr' is started each time the IFloop is entered
The label is formed by glueing a number to the 'IF-' string. The number is constructed by the 'IFc' number and the 'lbnr'.

Plov007 : the source

Read and shiver....

MODULE Plov007;

(*  Plov is the PL/0 compiler as modified by Verhoeven				*)
(*  Ver	  Comment						:     Date  	*)
(*  ----- -----------------------------------------------------   ------------ 	*)
(*  0.01  First version: read symbols and store them in a list	  01 Oct 2007	*)
(*  0.02  Introduce a limited symbol processor; aborted		  02 Oct 2007	*)
(*  0.03  Introduce a recursive descent parser			  06 Oct 2007	*)
(*  0.04  Fine tune the parser					  18 Oct 2007	*)
(*  0.05  Adapt it for file IO and command line			  26 Nov 2007	*)
(*  0.06  Try some code generation				  31 Aug 2008	*)
(*  0.07  Streamline the IF/ELSIF construct			   1 Sep 2008	*)

IMPORT	ASCII, InOut, MemPools, NumConv, Strings, SYSTEM, TextIO, Arguments;


TYPE	Identifier	= ARRAY [0..31] OF CHAR;
	SymbolType	= (Progtype, Proctype, Constype, Vartype, Keytype);
	SymbolPtr	= POINTER TO SymbolNode;
	SymbolNode	= RECORD
			    Name	: Identifier;
			    next	: SymbolPtr;
			    type	: SymbolType;
			    value	: CARDINAL
			  END;

VAR	token, op			: Identifier;
	InProcedure, LineEnd,
	Exhausted			: BOOLEAN;
	Locals, Symbols			: MemPools.MemPool;
	firstLocal,
	firstSymbol, thisSymbol		: SymbolPtr;
	currentType			: SymbolType;
	LOOPcount, IFcount,
	LabelCount, WHILEcount,
	LOOPdepth, PROCdepth		: CARDINAL;
	inFile, outFile			: TextIO.File;
	buffer				: Arguments.ArgTable;
	EXITcount			: ARRAY [0..25] OF CARDINAL;


PROCEDURE ErrorMessage (n  : CARDINAL);

BEGIN
   CASE  n  OF
      0 : InOut.WriteString ("Error filling Symbol table")		|
      1 : InOut.WriteString ("Invalid digit in : ");
      	  InOut.WriteString (token)					|
      2 : InOut.WriteString ("Invalid letter in : ");
      	  InOut.WriteString (token)					|
      3 : InOut.WriteString ("Program names do not match.")		|
      4 : InOut.WriteString ("BEGIN expected") 				|
      5 : InOut.WriteString ("Illegal identifier name : ");
      	  InOut.WriteString (token)					|
      6 : InOut.WriteString ("Duplicate identifier : ");
      	  InOut.WriteString (token)					|
      7 : InOut.WriteString ("'=' expected")				|
      8 : InOut.WriteString ("END expected")				|
      9 : InOut.WriteString ("Undefined symbol : ");
      	  InOut.WriteString (token)					|
     10 : InOut.WriteString ("Error in StatementSequence")		|
     11 : InOut.WriteString ("EXIT without LOOP")			|
     12 : InOut.WriteString ("THEN expected")				|
     13 : InOut.WriteString ("Illegal comparator : ");
     	  InOut.WriteString (token)					|
     14 : InOut.WriteString ("Illegal operator in factor : ");
     	  InOut.WriteString (token)					|
     15 : InOut.WriteString ("Error in factor : ");
     	  InOut.WriteString (token)					|
     16 : InOut.WriteString ("Missing right parenthesis")		|
     17 : InOut.WriteString ("Missing assigment operator")		|
     18 : InOut.WriteString ("PROGRAM expected")			|
     19 : InOut.WriteString ("Procedure names do not match.")		|
     20 : InOut.WriteString ("Error converting numer.")			|
     21 : InOut.WriteString ("UNTIL expected.")				|
     22 : InOut.WriteString ("LOCAL expected.")				|
     23 : InOut.WriteString ("DO expected.")				|
     33 : InOut.WriteString ("Syntax : Plov infile")			|
     34 : InOut.WriteString ("Cannot open file '");
     	  InOut.WriteString (buffer^[1]^);	InOut.Write ("'")
   ELSE
      InOut.WriteString ("Unknown error detected.")
   END;
   InOut.WriteLn;
   InOut.WriteBf
END ErrorMessage;


PROCEDURE StoreSymbol (str   : Identifier) : BOOLEAN;

VAR	thisOne, nextOne	: SymbolPtr;

BEGIN
   thisOne := firstSymbol;
   LOOP
      IF  Strings.StrEq (thisOne^.Name, str)  THEN  RETURN FALSE  END;
      IF  thisOne^.next = NIL  THEN  EXIT  END;
      thisOne := thisOne^.next
   END;
   MemPools.PoolAllocate (Symbols, nextOne, SYSTEM.TSIZE (SymbolNode));
   thisOne^.next := nextOne;
   WITH  nextOne^  DO
      Name := str;
      type := currentType;
      next := NIL
   END;
   thisSymbol := nextOne;
   RETURN TRUE
END StoreSymbol;


PROCEDURE FindSymbol (str  : Identifier) : BOOLEAN;

VAR	thisOne, nextOne	: SymbolPtr;

BEGIN
   thisOne := firstSymbol;
   LOOP
      IF  Strings.StrEq (thisOne^.Name, str)  THEN
	    thisSymbol := thisOne;
	    RETURN TRUE
      END;
      IF  thisOne^.next = NIL  THEN  EXIT  END;
      thisOne := thisOne^.next
   END;
   RETURN  FALSE
END FindSymbol;


PROCEDURE CG (string	: ARRAY OF CHAR);

BEGIN
   IF  Strings.Length (string) = 0  THEN
      TextIO.PutLn (outFile)
   ELSE
      TextIO.PutString (outFile, string)
   END
END CG;


PROCEDURE CGn (number	: CARDINAL);

BEGIN
   TextIO.PutCard (outFile, number, 1)
END CGn;


PROCEDURE InsertLabel;

VAR	ok	: BOOLEAN;
	string	: Identifier;

BEGIN
   CG ("LABEL-");
   CGn (LabelCount);		CG ("");
   INC (LabelCount)
END InsertLabel;


PROCEDURE PrintNames;

VAR	  thisOne    		: SymbolPtr;

BEGIN
   thisOne := firstSymbol;
   InOut.WriteLn;
   LOOP
      InOut.WriteString (thisOne^.Name);
      InOut.Write (11C);		InOut.Write (11C);
      CASE  thisOne^.type  OF
        Progtype : InOut.WriteString ("Program type")	|
	Proctype : InOut.WriteString ("Procedure type")	|
	Constype : InOut.WriteString ("Constant type = ");
		   InOut.WriteCard (thisOne^.value, 5)	|
	Vartype	 : InOut.WriteString ("Variable type")	|
	Keytype	 : InOut.WriteString ("Keyword type")
      END;
      InOut.WriteLn;
      IF  thisOne^.next = NIL  THEN
         EXIT
      ELSE
         thisOne := thisOne^.next
      END
   END
END PrintNames;


PROCEDURE ReadString (str : Identifier);

VAR	n, m		: CARDINAL;

BEGIN
   TextIO.GetString (inFile, str)
END ReadString;


PROCEDURE isComment;

BEGIN
   REPEAT  GetSymbol  UNTIL  Strings.StrEq (token, '*)');
   GetSymbol
END isComment;


PROCEDURE GetSymbol;

BEGIN
   IF  TextIO.EOF (inFile) = FALSE  THEN
      TextIO.GetString (inFile, token);
      IF  Strings.StrEq (token, '(*')  THEN  isComment  END
   ELSE
      InOut.WriteString ("EOF!!!   ")
   END;
   InOut.WriteString (token);		InOut.Write (11C);		InOut.WriteBf
END GetSymbol;


PROCEDURE isDigit (chr : CHAR) : BOOLEAN;

BEGIN
   IF  (chr >= '0') AND (chr <= '9')  THEN
      RETURN TRUE
   END;
   RETURN FALSE
END isDigit;


PROCEDURE isAlpha (chr  : CHAR) : BOOLEAN;

BEGIN
   chr := CAP (chr);
   IF  (chr >= 'A') AND (chr <= 'Z')  THEN
      RETURN TRUE
   END;
   RETURN FALSE
END isAlpha;


PROCEDURE isAlphaNum (chr  : CHAR) : BOOLEAN;

BEGIN
   RETURN  isAlpha (chr) OR isDigit (chr)
END isAlphaNum;


PROCEDURE isNumber (str  : Identifier) : BOOLEAN;

VAR	i	: CARDINAL;

BEGIN
   i := 0;
   REPEAT
      IF  isDigit (str [i]) = FALSE  THEN  RETURN FALSE  END;
      INC (i)
   UNTIL  (str [i] = 0C) OR (i > HIGH (str));
   RETURN TRUE
END isNumber;


PROCEDURE isIdentifier (str  : Identifier) : BOOLEAN;

VAR	i	: CARDINAL;

BEGIN
   IF  NOT isAlpha (str [0])  THEN  RETURN FALSE  END;
   IF  Strings.Length (str) = 1  THEN  RETURN TRUE  END;
   i := 1;
   REPEAT
      IF  NOT isAlphaNum (str [i])  THEN  RETURN FALSE  END;
      INC (i)
   UNTIL  (str [i] = 0C) OR (i > HIGH (str));
   RETURN TRUE
END isIdentifier;


PROCEDURE Program;

BEGIN
   GetSymbol;
   IF  Strings.StrEq (token, "PROGRAM")  THEN
      GetSymbol;
      IF  isIdentifier (token)  THEN
         WITH  firstSymbol^  DO
	    Name := token;
	    type := Progtype
	 END;
	 CG ("# PROGRAM ");	CG (token);	CG ("");	CG ("");
	 Block;
	 IF  Strings.StrEq (token, firstSymbol^.Name) = FALSE  THEN
	    ErrorMessage (3)
	 END;
	 CG ("# Done #");	CG ("");
      ELSE
         ErrorMessage (5)	(* Illegal identifier		*)
      END
   ELSE
      ErrorMessage (18)		(* 'PROGRAM' expected		*)
   END
END Program;


PROCEDURE Block;

BEGIN
   GetSymbol;
   IF	  Strings.StrEq (token, "CONSTANTS")  THEN  ConstantDeclaration	 END;
   IF	  Strings.StrEq (token, "VARIABLES")  THEN
      VariableDeclaration;
      CG ("")
   END;
   WHILE  Strings.StrEq (token, "PROCEDURE")  DO
      ProcedureDeclaration;
      CG ("")
   END;
   BlockBody;
END Block;


PROCEDURE BlockBody;

BEGIN
   IF  Strings.StrEq (token, "BEGIN")  THEN
      IF  PROCdepth = 0  THEN
	 CG ("LABEL MAINLOOP");		CG ("")
      END
   ELSE
      ErrorMessage (4)			(* BEGIN expected	*)
   END;
   StatementSequence;
   IF  Strings.StrEq (token, "END")  THEN
      IF  PROCdepth = 0  THEN
	 CG ("LABEL EXITMAINLOOP");	CG ("")
      END;
      GetSymbol;
      RETURN
   ELSE
      ErrorMessage (8);			(* END expected		*)
      GetSymbol
   END
END BlockBody;


PROCEDURE StatementSequence;

BEGIN
   GetSymbol;
   LOOP
      CG ("");
      IF  FindSymbol (token) = TRUE  THEN
         IF	(thisSymbol^.type = Vartype)	THEN  Assignment
	 ELSIF	thisSymbol^.type = Proctype 	THEN  Procedurecall
	 ELSIF	Strings.StrEq (token, "IF")  	THEN  isIF
	 ELSIF  Strings.StrEq (token, "LOOP")	THEN  isLOOP
	 ELSIF  Strings.StrEq (token, "RETURN")	THEN  isRETURN
	 ELSIF  Strings.StrEq (token, "REPEAT")	THEN  isREPEAT
	 ELSIF  Strings.StrEq (token, "EXIT")	THEN  isEXIT
	 ELSIF  Strings.StrEq (token, "END")	THEN  RETURN
	 ELSIF  Strings.StrEq (token, "UNTIL")	THEN  RETURN
	 ELSIF  Strings.StrEq (token, "ELSIF")	THEN  RETURN
	 ELSIF  Strings.StrEq (token, "ELSE")	THEN  RETURN
	 ELSE
	    ErrorMessage (10)		(* Error in StatementSequence	*)
	 END
      ELSE
	 ErrorMessage (9)		(* Undefined symbol	*)
      END
   END
END StatementSequence;


PROCEDURE ConstantDeclaration;

VAR	Val	: CARDINAL;
	ok	: BOOLEAN;

BEGIN
   GetSymbol;
   REPEAT
      currentType := Constype;
      IF  isIdentifier (token)  THEN
         IF  StoreSymbol (token) = TRUE  THEN
	    GetSymbol;
	    IF  token [0] = '='  THEN
	       GetSymbol;
	       NumConv.Str2Num (Val, 10, token, ok);
	       IF  ok  THEN
		  WITH  thisSymbol^  DO
		     value := Val;
		     type := Constype
		  END;
	       ELSE
	          ErrorMessage (1)	(* Invalid digit	*)
	       END
	    ELSE
	       ErrorMessage (7);	(* '=' expected		*)
	    END
	 ELSE
	    ErrorMessage (6);		(* Duplicate identifier	*)
	 END
      ELSE
         ErrorMessage (5);		(* Illegal Identifier	*)
      END;
      GetSymbol
   UNTIL  Strings.StrEq (token, "END");
   GetSymbol
END ConstantDeclaration;


PROCEDURE VariableDeclaration;

BEGIN
   GetSymbol;
   REPEAT
      currentType := Vartype;
      IF  isIdentifier (token)  THEN
         IF  StoreSymbol (token) = FALSE  THEN
	    ErrorMessage (6)		(* Duplicate identifier *)
	 END
      ELSE
         ErrorMessage (5);		(* Illegal Identifier	*)
      END;
      CG ("VARIABLE	");		CG (token);		CG ("");
      GetSymbol
   UNTIL Strings.StrEq (token, "END");
   GetSymbol
END VariableDeclaration;


PROCEDURE getLocals (VAR count	  : CARDINAL);

VAR	thisLocal	: SymbolPtr;

BEGIN	(*
   MemPools.NewPool (Locals);
   MemPools.PoolAllocate (Locals, firstLocal, SYSTEM.TSIZE (SymbolNode));
   thisLocal := firstLocal;	*)
   LOOP
      GetSymbol;
      IF  Strings.StrEq (token, "END")  THEN  EXIT  END;
(*      IF  isIdentifier (token)  THEN

      ELSE
	 ErrorMessage (5)		(* Illegal Identifier	*)
      END;								*)
      CG ("LOCAL");		CG (11C);
      CG (token);		CG ("");
      INC (count)
   END;
(*   MemPools.KillPool (Locals);	*)
   GetSymbol
END getLocals;


PROCEDURE ProcedureDeclaration;

VAR	thisP	: SymbolPtr;
	name	: Identifier;
	LoCo	: CARDINAL;

BEGIN
   LoCo := 0;
   GetSymbol;
   currentType := Proctype;
   IF  isIdentifier (token)  THEN
      name := token;
      CG ("# PROCEDURE DECLARATION OF ");	CG (name);	CG ("");
      CG ("LABEL ");
      CG (name);		CG ("");
      IF  StoreSymbol (token) = TRUE  THEN
	 thisP := thisSymbol;
	 INC (PROCdepth);
	 GetSymbol;
	 IF  Strings.StrEq (token, "LOCAL")  THEN  getLocals (LoCo) END;
	 BlockBody;
	 DEC (PROCdepth);
	 IF  Strings.StrEq (thisP^.Name, token) = FALSE  THEN
	    ErrorMessage (19)		(* Names do not match	*)
	 END;
	 GetSymbol
      ELSE
	 ErrorMessage (6)		(* Duplicate identifier	*)
      END
   ELSE
      ErrorMessage (5)			(* Illegal identifier 	*)
   END;
   IF  LoCo > 0  THEN
      CG ("RELEASE ");
      CGn (LoCo);
      CG ("")
   END;
   CG ("# END OF PROCEDURE ");
   CG (name);			CG ("");	CG ("");
END ProcedureDeclaration;


PROCEDURE Procedurecall;

BEGIN
   CG ("CALL ");		CG (token);		CG ("");
   GetSymbol
END Procedurecall;


PROCEDURE isLOOP;

VAR	LC	: CARDINAL;

BEGIN
   INC (LOOPcount);
   LC := LOOPcount;
   CG ("LABEL LOOP-");		CGn (LC);	CG ("");
   INC (LOOPdepth);
   EXITcount [LOOPdepth] := LOOPcount;
   StatementSequence;
   IF  Strings.StrEq (token, "END")  THEN
      DEC (LOOPdepth);
      CG ("JUMP TO LOOP-");	CGn (LC);	CG ("")
   ELSE
      ErrorMessage (8)		(* END expected		*)
   END;
   CG ("LABEL XLOOP-");		CGn (LC);	CG ("");
   GetSymbol
END isLOOP;


PROCEDURE isEXIT;

BEGIN
   IF  LOOPdepth = 0  THEN
      ErrorMessage (11)			(* EXIT without LOOP	*)
   ELSE
      CG ("JUMP TO XLOOP-");		CGn (EXITcount [LOOPdepth]);
      CG ("")
   END;
   GetSymbol
END isEXIT;


PROCEDURE isRETURN;

BEGIN
   IF  PROCdepth = 0  THEN
      ErrorMessage (19)			(* RETURN without PROCEDURE	*)
   END;
   CG ("RETURN");	CG ("");
   GetSymbol
END isRETURN;


PROCEDURE isWHILE;

VAR	count	: CARDINAL;

BEGIN
   count := WHILEcount;
   CG ("WHILE-");		CGn (count);		CG ("");
   INC (WHILEcount);
   GetSymbol;		Expression;
   Comparison;
   GetSymbol;           Expression;
   TextIO.PutString (outFile, "IF ");
   TextIO.PutString (outFile, op);
   TextIO.PutString (outFile, " JUMP TO XWHILE-");
   StatementSequence;
   IF  Strings.StrEq (token, "END") = FALSE  THEN  ErrorMessage (21)  END;
   
END isWHILE;


PROCEDURE isREPEAT;

VAR	count	: CARDINAL;

BEGIN
   count := LabelCount;
   CG ("LABEL-");		CGn (count);		CG ("");
   INC (LabelCount);
   StatementSequence;
   IF  Strings.StrEq (token, "UNTIL") = FALSE  THEN  ErrorMessage (21)  END;
   GetSymbol;		Expression;
   Comparison;
   GetSymbol;		Expression;
   CG ("IF ");		CG (op);		CG (" JUMP TO LABEL-");
   CGn (count);		CG ("");		CG ("")
END isREPEAT;


PROCEDURE isIF;

VAR	IFc, lbnr	: CARDINAL;

BEGIN
   IFc := IFcount;				INC (IFcount);
   lbnr := 0;
   IF  Strings.StrEq (token, "ODD")  THEN
      GetSymbol;
      Expression
   ELSE
      Condition
   END;
   CG ("IF ");		CG (op);	CG (" JUMP TO LABEL IF-");
   CGn (IFc);		CGn (lbnr);	CG ("");
   IF  Strings.StrEq (token, "THEN")  THEN
      StatementSequence;
      CG ("JUMP TO LABEL XIF-");	CGn (IFc);
      CG ("");
   ELSE
      ErrorMessage (12)			(* THEN expected	*)
   END;
   WHILE  Strings.StrEq (token, "ELSIF")  DO
      CG ("LABEL IF-");
      CGn (IFc);	CGn (lbnr);	CG ("");	INC (lbnr);
      Condition;
      CG ("IF ");		CG (op);		CG (" JUMP TO LABEL IF-");
      CGn (IFc);		CGn (lbnr);		CG ("");
      IF  Strings.StrEq (token, "THEN")  THEN
	 StatementSequence;
	 CG ("JUMP TO LABEL XIF-");		CGn (IFc);	CG ("");
      ELSE
	 ErrorMessage (12)		(* THEN expected	*)
      END
   END;
   IF  Strings.StrEq (token, "ELSE")  THEN
      CG ("LABEL IF-");
      CGn (IFc);		CGn (lbnr);		CG ("");
      INC (lbnr);
      StatementSequence
   END;
   IF  Strings.StrEq (token, "END") = FALSE  THEN
      ErrorMessage (8)		(* END expected		*)
   END;
   CG ("LABEL XIF-");	CGn (IFc);		CG ("");
   GetSymbol
END isIF;


PROCEDURE Comparison;

BEGIN
   CASE  token [0]  OF
    '=' :  op := 'NOT EQUAL'			|
    '<' :  CASE  token [1]  OF
 	     0C  : op := 'GREATER OR EQUAL'	|
	     '>' : op := 'EQUAL'		|
	     '=' : op := 'GREATER'
	   ELSE
	     ErrorMessage (13)			(* Illegal comparator   *)
	   END					|
    '>' :  CASE  token [1]  OF
	     0C  : op := 'LESS OR EQUAL'	|
	     '=' : op := 'LESS'
	   ELSE
	     ErrorMessage (13)			(* Illegal comparator   *)
	   END					|
    '#' :  op := 'EQUAL'
   ELSE
      ErrorMessage (13)				(* Illegal comparator	*)
   END;
END Comparison;


PROCEDURE Condition;

BEGIN
   GetSymbol;		Expression;
   Comparison;
   GetSymbol;		Expression;
END Condition;


PROCEDURE Assignment;

BEGIN
   CG ("STORE ADDRESS OF ");		CG (token);		CG ("");
   GetSymbol;
   IF  Strings.StrEq (token, ':=')  THEN
      GetSymbol;
      Expression
   ELSE
      ErrorMessage (17);		(* Missing ':=' 	*)
   END;
   CG ("SAVE RESULT");		CG ("")
END Assignment;


PROCEDURE Expression;

VAR	op	: CHAR;

BEGIN
   Term;
   op := token [0];
   WHILE  (token [0] = '+') OR (token [0] = '-')  DO
      GetSymbol;
      Term;
      IF  op = '+'  THEN
	 CG ("ADD");
	 CG ("")
      ELSE
	 CG ("SUBTRACT");
	 CG ("")
      END;
   END
END Expression;


PROCEDURE TermOperator () : BOOLEAN;

VAR	oper	: CHAR;

BEGIN
   oper := token [0];
   IF	  (oper = 'x') OR (oper = '*') OR (oper = '.')  THEN  RETURN TRUE
(*   ELSIF  (oper = '<') OR (oper = '>')			THEN  RETURN TRUE	*)
   ELSIF  (oper = ':') OR (oper = '/')  		THEN  RETURN TRUE
   ELSIF  (oper = '%') OR Strings.StrEq (token, 'MOD')  THEN  RETURN TRUE
   ELSE
      RETURN FALSE
   END
END TermOperator;


PROCEDURE Term;

VAR	Operator	: CHAR;
	op		: Identifier;

BEGIN
   Factor;
   GetSymbol;
   WHILE  TermOperator () = TRUE  DO
      CASE  token [0]  OF
	'.', 'x', '*'	: op := 'MULTIPLY'		|
	':', '/'	: op := 'DIVIDE'		|
(*	'<'		: op := 'SHIFT LEFT'		|
	'>'		: op := 'SHIFT RIGHT'	*)
      ELSE
	op := 'MODULO'
      END;
      GetSymbol;
      Factor;
      CG (op);		CG ("");
      GetSymbol
   END
END Term;


PROCEDURE Factor;

BEGIN
   IF  FindSymbol (token) = TRUE  THEN			(* token is CONST or VAR	*)
      IF  (thisSymbol^.type = Constype)  THEN
         CG ("STORE	");				(* push value of CONST 		*)
	 CGn (thisSymbol^.value);		CG ("")
      END;
      IF  (thisSymbol^.type = Vartype)  THEN
         CG ("FETCH VALUE OF	");
	 CG (thisSymbol^.Name);		CG ("");	(* fetch value at addr of VAR 	*)
      END
   ELSIF  isNumber (token)  THEN
      CG ("STORE	");		CG (token);	(* Literal value		*)
      CG ("")
   ELSIF  token [0] = '(' THEN
      GetSymbol;
      Expression;
      IF  token [0] # ')'  THEN  ErrorMessage (16)  END
   ELSE
      ErrorMessage (15)					(* Error in Factor	*)
   END
END Factor;


PROCEDURE OpenOutputs (name	: Identifier);

VAR	i		: CARDINAL;
	Fname 		: Identifier;

BEGIN
   i := Strings.pos ('.', name);
   IF  i <= HIGH (name)  THEN  name [i] := 0C  END;
   Fname := name;
   Strings.Append (Fname, '.palo');
   TextIO.OpenOutput (outFile, Fname);
END OpenOutputs;


PROCEDURE Init;

VAR	count		: SHORTCARD;
	FileName	: Identifier;

BEGIN
   Arguments.GetArgs (count, buffer);
   IF  count = 1  THEN
      ErrorMessage (33);
      HALT
   END;
   Strings.Assign (FileName, buffer^[1]^);
   TextIO.OpenInput (inFile, FileName);
   IF  NOT TextIO.Done ()  THEN
      ErrorMessage (34);
      HALT
   END;
   OpenOutputs (FileName);

   MemPools.NewPool (Symbols);
   MemPools.PoolAllocate (Symbols, firstSymbol, SYSTEM.TSIZE (SymbolNode));
   WITH  firstSymbol^  DO
      Name := "|";
      next := NIL
   END;

   currentType := Keytype;
   IF  StoreSymbol ("PROGRAM")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("REPEAT")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("UNTIL")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("WHILE")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("DO")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("LOCAL")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("LOOP")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("EXIT") 	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("BEGIN")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("END")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("IF")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("THEN")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("ELSIF")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("ELSE")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("ODD") 	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("OR") 	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("AND") 	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("NOT") 	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("MOD") 	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("IRQ") 	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("STATIC")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("RETURN")	 = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("PROCEDURE") = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("CONSTANTS") = FALSE  THEN  ErrorMessage (0)  END;
   IF  StoreSymbol ("VARIABLES") = FALSE  THEN  ErrorMessage (0)  END;
   currentType := Constype;
   IF  StoreSymbol ("TRUE")	 = FALSE  THEN  ErrorMessage (0)  ELSE  thisSymbol^.value := 1  END;
   IF  StoreSymbol ("FALSE")	 = FALSE  THEN  ErrorMessage (0)  ELSE  thisSymbol^.value := 0  END;

   currentType	:= Progtype;
   LOOPdepth	:= 0;
   PROCdepth	:= 0;
   Exhausted	:= FALSE;
   LOOPcount	:= 0;
   WHILEcount	:= 0;
   IFcount 	:= 0;
   LabelCount	:= 0
END Init;


PROCEDURE ShutDown;

BEGIN
   TextIO.Close (inFile);
   TextIO.Close (outFile);
   InOut.WriteLn;		InOut.WriteLn;		(*	PrintNames;	*)
   MemPools.KillPool (Symbols)
END ShutDown;


BEGIN
   Init;
   Program;
   ShutDown
END Plov007.
   

Plov007 : the IFloop

      
PROCEDURE isIF;

VAR	IFc, lbnr	: CARDINAL;

BEGIN
   IFc := IFcount;				INC (IFcount);
   lbnr := 0;
   IF  Strings.StrEq (token, "ODD")  THEN
      GetSymbol;
      Expression
   ELSE
      Condition
   END;
   CG ("IF ");		CG (op);	CG (" JUMP TO LABEL IF-");
   CGn (IFc);		CGn (lbnr);	CG ("");
   IF  Strings.StrEq (token, "THEN")  THEN
      StatementSequence;
      CG ("JUMP TO LABEL XIF-");	CGn (IFc);
      CG ("");
   ELSE
      ErrorMessage (12)			(* THEN expected	*)
   END;
   WHILE  Strings.StrEq (token, "ELSIF")  DO
      CG ("LABEL IF-");
      CGn (IFc);	CGn (lbnr);	CG ("");	INC (lbnr);
      Condition;
      CG ("IF ");		CG (op);		CG (" JUMP TO LABEL IF-");
      CGn (IFc);		CGn (lbnr);		CG ("");
      IF  Strings.StrEq (token, "THEN")  THEN
	 StatementSequence;
	 CG ("JUMP TO LABEL XIF-");		CGn (IFc);	CG ("");
      ELSE
	 ErrorMessage (12)		(* THEN expected	*)
      END
   END;
   IF  Strings.StrEq (token, "ELSE")  THEN
      CG ("LABEL IF-");
      CGn (IFc);		CGn (lbnr);		CG ("");
      INC (lbnr);
      StatementSequence
   END;
   IF  Strings.StrEq (token, "END") = FALSE  THEN
      ErrorMessage (8)		(* END expected		*)
   END;
   CG ("LABEL XIF-");	CGn (IFc);		CG ("");
   GetSymbol
END isIF;
   
The trouble with this addition was the processing of the branch keywords in the IF loop: ELSIF and ELSE. Initially I had these in the IF loop. But that was an error of the kind I made before: mixing runtime and compiletime actions. The problem was solved by adding ELSE and ELSIF to the StatementSequence routine.

Plov007 : code generated

Below is the source of test19:

PROGRAM test19

VARIABLES	a b c d END

BEGIN
  IF  a < 10  THEN
     b := 12
  ELSIF  a < 20  THEN
     IF  a < c  THEN
        a := b - c
     ELSIF  a > b  THEN
        a := a : 2
     ELSIF  d = 12  THEN
        d := d x 1
     ELSE
        a := c
     END
  ELSIF  a > 40  THEN
     d := 0
  ELSE
     a := b + c x d
  END
END test19
   
The source is a no-brainer. It's just there to tease the parser and the code generator. Here is the PALO code generated:
# PROGRAM test19

VARIABLE	a
VARIABLE	b
VARIABLE	c
VARIABLE	d

LABEL MAINLOOP

FETCH VALUE OF	a
STORE	10
IF GREATER OR EQUAL JUMP TO LABEL IF-00

STORE ADDRESS OF b
STORE	12
SAVE RESULT

JUMP TO LABEL XIF-0

LABEL IF-00
FETCH VALUE OF	a
STORE	20
IF GREATER OR EQUAL JUMP TO LABEL IF-01

FETCH VALUE OF	a
FETCH VALUE OF	c
IF GREATER OR EQUAL JUMP TO LABEL IF-10

STORE ADDRESS OF a
FETCH VALUE OF	b
FETCH VALUE OF	c
SUBTRACT
SAVE RESULT

JUMP TO LABEL XIF-1

LABEL IF-10
FETCH VALUE OF	a
FETCH VALUE OF	b
IF LESS OR EQUAL JUMP TO LABEL IF-11

STORE ADDRESS OF a
FETCH VALUE OF	a
STORE	2
DIVIDE
SAVE RESULT

JUMP TO LABEL XIF-1

LABEL IF-11
FETCH VALUE OF	d
STORE	12
IF NOT EQUAL JUMP TO LABEL IF-12

STORE ADDRESS OF d
FETCH VALUE OF	d
STORE	1
MULTIPLY
SAVE RESULT

JUMP TO LABEL XIF-1

LABEL IF-12

STORE ADDRESS OF a
FETCH VALUE OF	c
SAVE RESULT

LABEL XIF-1

JUMP TO LABEL XIF-0

LABEL IF-01
FETCH VALUE OF	a
STORE	40
IF LESS OR EQUAL JUMP TO LABEL IF-02

STORE ADDRESS OF d
STORE	0
SAVE RESULT

JUMP TO LABEL XIF-0
LABEL IF-02

STORE ADDRESS OF a
FETCH VALUE OF	b
FETCH VALUE OF	c
FETCH VALUE OF	d
MULTIPLY
ADD
SAVE RESULT

LABEL XIF-0

LABEL EXITMAINLOOP
# Done #
   

Page created on 2 September 2008 and

Page equipped with GoogleBuster technology