Plov004 : tune the recursive descent compiler
After the bigger errors have been removed from Plov003, I decided to issue version 0.04 of Plov. This one is running reasonably stable. It still needs lots of testing since there MUST be amny errors left in it. And I haven't figured out yet how to achieve the assignment operations...
MODULE Plov004;
(* 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 12 Oct 2007 *)
IMPORT ASCII, InOut, MemPools, NumConv, Strings, SYSTEM;
TYPE Identifier = ARRAY [0..31] OF CHAR;
Opcode = ARRAY [0..7] OF CHAR;
SymbolType = (Progtype, Proctype, Constype, Vartype, Keytype);
SymbolPtr = POINTER TO SymbolNode;
SymbolNode = RECORD
Name : Identifier;
previous,
next : SymbolPtr;
type : SymbolType;
value,
address : CARDINAL
END;
VAR token : Identifier;
op : Opcode;
SyntaxError,
LineEnd,
Exhausted : BOOLEAN;
Symbols : MemPools.MemPool;
firstSymbol,
lastSymbol,
thisSymbol : SymbolPtr;
currentType : SymbolType;
LOOPdepth,
PROCdepth,
currentValue : 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.")
ELSE
InOut.WriteString ("Unknown error detected.")
END;
(* SyntaxError := TRUE; *)
InOut.WriteBf;
InOut.WriteLn
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;
previous := thisOne
END;
lastSymbol := nextOne;
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 PrintNames;
VAR thisOne : SymbolPtr;
BEGIN
thisOne := firstSymbol;
InOut.WriteLn;
LOOP
InOut.WriteString (thisOne^.Name); 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 GetSymbol;
BEGIN
IF InOut.EOF () = FALSE THEN
InOut.ReadString (token)
ELSE
InOut.WriteString ("EOF!!! ");
END;
InOut.WriteString (token); InOut.Write (11C); InOut.WriteBf
END GetSymbol;
PROCEDURE Synchronize;
VAR chr : CHAR;
BEGIN
REPEAT InOut.Read (chr) UNTIL chr = ASCII.LF;
SyntaxError := FALSE
END Synchronize;
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;
Block;
IF Strings.StrEq (token, firstSymbol^.Name) = FALSE THEN
ErrorMessage (3)
END
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 END;
WHILE Strings.StrEq (token, "PROCEDURE") DO ProcedureDeclaration END;
BlockBody;
END Block;
PROCEDURE BlockBody;
BEGIN
IF Strings.StrEq (token, "BEGIN") THEN
GetSymbol;
StatementSequence
ELSE
ErrorMessage (4) (* BEGIN expected *)
END;
IF Strings.StrEq (token, "END") THEN
GetSymbol;
RETURN
ELSE
ErrorMessage (8); (* END expected *)
GetSymbol
END
END BlockBody;
PROCEDURE StatementSequence;
BEGIN
InOut.WriteString ("In StatementSequence "); InOut.WriteBf;
LOOP
InOut.WriteString ("In StaSeq LOOP with token = "); InOut.WriteString (token);
InOut.WriteString (" "); InOut.WriteBf;
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, "EXIT") THEN isEXIT
ELSIF Strings.StrEq (token, "END") THEN
RETURN
ELSE
ErrorMessage (10); (* Error in StatementSequence *)
Synchronize
END
ELSE
ErrorMessage (9); (* Undefined symbol *)
Synchronize
END;
(* GetSymbol *)
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 *)
Synchronize
END
ELSE
ErrorMessage (6); (* Duplicate identifier *)
Synchronize
END
ELSE
ErrorMessage (5); (* Illegal Identifier *)
Synchronize
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;
GetSymbol
UNTIL Strings.StrEq (token, "END");
IF SyntaxError THEN Synchronize END;
GetSymbol
END VariableDeclaration;
PROCEDURE ProcedureDeclaration;
VAR thisP : SymbolPtr;
BEGIN
GetSymbol;
currentType := Proctype;
IF isIdentifier (token) THEN
IF StoreSymbol (token) = TRUE THEN
thisP := thisSymbol;
INC (PROCdepth);
GetSymbol;
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
END ProcedureDeclaration;
PROCEDURE Procedurecall;
BEGIN
(* InOut.WriteString ("In ProcCall "); InOut.WriteBf *)
GetSymbol
END Procedurecall;
PROCEDURE isLOOP;
BEGIN
InOut.WriteString ("In isLOOP "); InOut.WriteBf;
INC (LOOPdepth);
GetSymbol; StatementSequence;
IF Strings.StrEq (token, "END") THEN
DEC (LOOPdepth)
ELSE
ErrorMessage (8) (* END expected *)
END;
GetSymbol
END isLOOP;
PROCEDURE isEXIT;
BEGIN
IF LOOPdepth = 0 THEN
ErrorMessage (11) (* EXIT without LOOP *)
ELSE
DEC (LOOPdepth)
END;
GetSymbol
END isEXIT;
PROCEDURE isRETURN;
BEGIN
IF PROCdepth = 0 THEN
ErrorMessage (19) (* RETURN without PROCEDURE *)
END;
GetSymbol
END isRETURN;
PROCEDURE isIF;
BEGIN
InOut.WriteString ("In isIF "); InOut.WriteBf;
Condition;
IF Strings.StrEq (token, "THEN") THEN
GetSymbol;
StatementSequence;
WHILE Strings.StrEq (token, "ELSIF") DO
Condition;
IF Strings.StrEq (token, "THEN") THEN
GetSymbol;
StatementSequence
ELSE
ErrorMessage (12) (* THEN expected *)
END
END;
IF Strings.StrEq (token, "ELSE") THEN
GetSymbol;
StatementSequence
END;
IF Strings.StrEq (token, "END") = FALSE THEN
ErrorMessage (8) (* END expected *)
END;
GetSymbol
ELSE
ErrorMessage (12) (* THEN expected *)
END
END isIF;
PROCEDURE Condition;
BEGIN
InOut.WriteString ("In Condition "); InOut.WriteBf;
IF Strings.StrEq (token, "ODD") THEN
Expression
ELSE
GetSymbol; Expression;
Comparison;
GetSymbol; Expression
END
END Condition;
PROCEDURE Comparison;
BEGIN
CASE token [0] OF
'=' : op := 'EQL' |
'<' : CASE token [1] OF
0C : op := 'LESS' |
'>' : op := 'NEQL' |
'=' : op := 'LEQL'
ELSE
ErrorMessage (13) (* Illegal comparator *)
END |
'>' : CASE token [1] OF
0C : op := 'GRTR' |
'=' : op := 'GEQL'
ELSE
ErrorMessage (13) (* Illegal comparator *)
END |
'#' : op := 'NEQL'
ELSE
ErrorMessage (13) (* Illegal comparator *)
END;
END Comparison;
PROCEDURE Assignment;
BEGIN
GetSymbol;
IF Strings.StrEq (token, ':=') THEN
GetSymbol;
Expression
ELSE
ErrorMessage (17); (* Missing ':=' *)
END
END Assignment;
PROCEDURE Expression;
BEGIN
Term;
WHILE (token [0] = '+') OR (token [0] = '-') DO
GetSymbol;
Term
END
END Expression;
PROCEDURE TermOperator () : BOOLEAN;
BEGIN
IF Strings.StrEq (token, 'x') OR (token [0] = '*') THEN RETURN TRUE
ELSIF (token [0] = ':') OR (token [0] = '/') THEN RETURN TRUE
ELSIF (token [0] = '%') OR Strings.StrEq (token, 'MOD') THEN RETURN TRUE
ELSE
RETURN FALSE
END
END TermOperator;
PROCEDURE Term;
VAR Operator : CHAR;
BEGIN
Factor;
GetSymbol;
WHILE TermOperator () DO
CASE Operator OF
'x', '*' : op := 'MUL' |
':', '/' : op := 'DIV'
ELSE
op := 'MOD'
END;
GetSymbol;
Factor;
GetSymbol
END
END Term;
PROCEDURE Factor;
BEGIN
InOut.WriteString ("In Factor"); InOut.Write (11C); InOut.WriteBf;
IF FindSymbol (token) = TRUE THEN
IF (thisSymbol^.type = Constype) OR (thisSymbol^.type = Vartype) THEN op := 'PUSH' END
ELSIF isNumber (token) THEN op := 'PUSH'
ELSIF token [0] = '(' THEN
Expression;
GetSymbol;
IF token [0] # ')' THEN ErrorMessage (16) END
ELSE
ErrorMessage (15) (* Error in Factor *)
END
END Factor;
PROCEDURE Init;
BEGIN
MemPools.NewPool (Symbols);
MemPools.PoolAllocate (Symbols, firstSymbol, SYSTEM.TSIZE (SymbolNode));
WITH firstSymbol^ DO
Name := "|";
next := NIL;
previous := NIL
END;
currentType := Keytype;
IF StoreSymbol ("RETURN") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("EXIT") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("LOOP") = 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 ("ODD") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("PROCEDURE") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("PROGRAM") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("CONSTANTS") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("VARIABLES") = FALSE THEN ErrorMessage (0) END;
currentType := Progtype;
LOOPdepth := 0;
PROCdepth := 0;
Exhausted := FALSE;
END Init;
BEGIN
Init;
Program;
InOut.WriteLn;
InOut.WriteLn;
PrintNames;
MemPools.KillPool (Symbols)
END Plov004.
The compiler runs all the test programs that were published earlier.
Page created on 6 October 2007 and
Page equipped with GoogleBuster technology