Plov014 : the full source
In the other files I just gave the differences from the previous versions. But quite a lot has been changed overall. So I think it's time to give you a glimpse of the full source again. It's over a thousand lines of wide spaced source by now. But it's Modula-2 so you will be able to understand every single bit of it.
MODULE Plov014;
(* 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 *)
(* 0.08 Assignments need some more attention 2 Sep 2008 *)
(* 0.09 IF fixed, assignment fixed, LOCAL variables added 4 Sep 2008 *)
(* 0.10 Cleanup and make WHILE DO work 5 Sep 2008 *)
(* 0.11 Add 'findType' 11 Sep 2008 *)
(* 0.12 Change over to PALO-2 output codes 12 Sep 2008 *)
(* 0.13 Improve the syntax checker 14 Sep 2008 *)
(* 0.14 Enable function parameters 16 Sep 2008 *)
IMPORT ASCII, InOut, MemPools, NumConv, Strings, SYSTEM, TextIO, Arguments;
CONST ErrorMax = 5;
TYPE Identifier = ARRAY [0..31] OF CHAR;
SymbolType = (Progtype, Proctype, Constype, Vartype, Keytype, None);
SymbolPtr = POINTER TO SymbolNode;
SymbolNode = RECORD
Name : Identifier;
next : SymbolPtr;
type : SymbolType;
value : CARDINAL
END;
VAR token, op : Identifier;
InProcedure, weHaveLocals,
DebugMode,
pastEOL, Exhausted : BOOLEAN;
Locals, Symbols : MemPools.MemPool;
firstLocal, thisLocal,
firstSymbol, thisSymbol : SymbolPtr;
currentType : SymbolType;
line, Xpos, ErrCount,
LOOPcount, IFcount,
REPEATcount, WHILEcount,
LOOPdepth, PROCdepth : CARDINAL;
lastCH : CHAR;
inFile, outFile : TextIO.File;
buffer : Arguments.ArgTable;
EXITcount : ARRAY [0..25] OF CARDINAL;
PROCEDURE ErrorMessage (n : CARDINAL);
BEGIN
INC (ErrCount);
InOut.WriteLn; InOut.WriteString ("@@ -- ");
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 ("Undefined symbol or keyword") |
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 ("Wrongs symbol encountered") |
23 : InOut.WriteString ("DO expected.") |
24 : InOut.WriteString ("Invalid parameter in functioncall") |
25 : InOut.WriteString (" ") |
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.WriteString (" in line "); InOut.WriteCard (line, 5); InOut.WriteLn;
(*
InOut.WriteString (" column "); InOut.WriteCard (Xpos, 5);
*)
InOut.WriteBf;
IF ErrCount = ErrorMax THEN
ShutDown;
HALT
END
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 StoreLocal (str : Identifier) : BOOLEAN;
VAR thisOne, nextOne : SymbolPtr;
BEGIN
thisOne := firstLocal;
LOOP
IF Strings.StrEq (thisOne^.Name, str) THEN RETURN FALSE END;
IF thisOne^.next = NIL THEN EXIT END;
thisOne := thisOne^.next
END;
MemPools.PoolAllocate (Locals, nextOne, SYSTEM.TSIZE (SymbolNode));
thisOne^.next := nextOne;
WITH nextOne^ DO
Name := str;
type := currentType;
next := NIL
END;
thisLocal := nextOne;
RETURN TRUE
END StoreLocal;
PROCEDURE FindLocal (str : Identifier) : BOOLEAN;
VAR thisOne : SymbolPtr;
BEGIN
thisOne := firstLocal;
LOOP
IF Strings.StrEq (thisOne^.Name, str) THEN
thisLocal := thisOne;
RETURN TRUE
END;
IF thisOne^.next = NIL THEN EXIT END;
thisOne := thisOne^.next
END;
RETURN FALSE
END FindLocal;
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 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 PrintLocals;
VAR thisOne : SymbolPtr;
BEGIN
thisOne := firstLocal;
InOut.WriteLn;
LOOP
InOut.WriteString (thisOne^.Name);
InOut.WriteLn;
IF thisOne^.next = NIL THEN
EXIT
ELSE
thisOne := thisOne^.next
END
END;
InOut.WriteBf
END PrintLocals;
*)
PROCEDURE GetChar (VAR ch : CHAR);
BEGIN
TextIO.GetChar (inFile, ch);
IF ch = 11C THEN
INC (Xpos, 8)
ELSE
INC (Xpos)
END;
IF DebugMode THEN InOut.Write (ch) END;
IF ch = ASCII.LF THEN
INC (line);
Xpos := 0;
pastEOL := TRUE
END
END GetChar;
PROCEDURE ReadString (VAR str : Identifier);
VAR n, max : CARDINAL;
ch : CHAR;
BEGIN
n := 0; max := HIGH (str);
pastEOL := FALSE;
REPEAT GetChar (ch) UNTIL ch > ' ';
REPEAT
str [n] := ch;
INC (n);
GetChar (ch)
UNTIL (ch < '!') OR (n > max);
lastCH := ch;
IF n < max THEN str [n] := 0C END;
END ReadString;
PROCEDURE Skip2LF;
VAR ch : CHAR;
BEGIN
REPEAT GetChar (ch) UNTIL ch = ASCII.LF
END Skip2LF;
PROCEDURE isComment;
BEGIN
REPEAT GetSymbol UNTIL Strings.StrEq (token, '*)');
GetSymbol
END isComment;
PROCEDURE GetSymbol;
BEGIN
IF TextIO.EOF (inFile) = FALSE THEN
ReadString (token);
IF Strings.StrEq (token, '(*') THEN isComment END
ELSE
InOut.WriteString ("EOF!!! ")
END
END GetSymbol;
PROCEDURE findType (name : Identifier) : SymbolType;
VAR symPtr : SymbolPtr;
BEGIN
IF weHaveLocals AND (FindLocal (token) = TRUE) THEN
symPtr := thisLocal
ELSIF FindSymbol (token) = TRUE THEN
symPtr := thisSymbol
ELSE
RETURN None
END;
RETURN symPtr^.type
END findType;
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 *)
Skip2LF
END
ELSE
ErrorMessage (18) (* 'PROGRAM' expected *)
END
END Program;
PROCEDURE isIRQ;
BEGIN
END isIRQ;
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;
WHILE Strings.StrEq (token, "IRQ") DO
isIRQ;
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 findType (token) = Vartype THEN Assignment
ELSIF findType (token) = 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, "WHILE") THEN isWHILE
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
Skip2LF;
ErrorMessage (10); (* Error in StatementSequence *)
GetSymbol
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 *)
Skip2LF
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
thisLocal := firstLocal;
WHILE thisLocal^.next # NIL DO thisLocal := thisLocal^.next END;
REPEAT
currentType := Vartype;
IF isIdentifier (token) THEN
IF StoreLocal (token) = FALSE THEN
ErrorMessage (6) (* Duplicate identifier *)
END
ELSE
ErrorMessage (5) (* Illegal Identifier *)
END;
INC (count);
CG ("LOCAL "); CG (token); CG ("");
GetSymbol
UNTIL Strings.StrEq (token, "END") OR Strings.StrEq (token, "LOCAL") OR Strings.StrEq (token, "BEGIN")
END getLocals;
PROCEDURE ProcedureDeclaration;
VAR thisProc : SymbolPtr;
name : Identifier;
LoCo : CARDINAL;
BEGIN
MemPools.NewPool (Locals);
MemPools.PoolAllocate (Locals, firstLocal, SYSTEM.TSIZE (SymbolNode));
firstLocal^.next := NIL;
LoCo := 0;
GetSymbol;
IF isIdentifier (token) = FALSE THEN ErrorMessage (5) END; (* Illegal identifier *)
currentType := Proctype;
name := token;
CG ("# PROCEDURE DECLARATION OF "); CG (name); CG ("");
CG ("LABEL ");
CG (name); CG ("");
IF StoreSymbol (token) = FALSE THEN ErrorMessage (6) END; (* Duplicate identifier *)
thisProc := thisSymbol;
INC (PROCdepth);
GetSymbol;
IF (Strings.StrEq (token, "BEGIN") = FALSE) AND (Strings.StrEq (token, "LOCAL") = FALSE) THEN
IF isIdentifier (token) THEN
weHaveLocals := TRUE;
getLocals (LoCo)
ELSE
ErrorMessage (22)
END
END;
CG ("PARAMETERS "); CGn (LoCo); CG ("");
thisProc^.value := LoCo; (* Store number of arguments *)
IF Strings.StrEq (token, "LOCAL") THEN
weHaveLocals := TRUE;
GetSymbol;
getLocals (LoCo);
GetSymbol
END;
BlockBody;
DEC (PROCdepth);
IF Strings.StrEq (thisProc^.Name, token) = FALSE THEN
ErrorMessage (19) (* Names do not match *)
END;
GetSymbol;
IF LoCo > 0 THEN
CG ("RELEASE ");
CGn (LoCo);
CG ("");
weHaveLocals := FALSE
END;
MemPools.KillPool (Locals);
CG ("# END OF PROCEDURE ");
CG (name); CG (""); CG ("");
END ProcedureDeclaration;
PROCEDURE Procedurecall;
VAR args, n : CARDINAL;
name : Identifier;
BEGIN
args := thisSymbol^.value; n := args;
name := token;
WHILE n > 0 DO
GetSymbol;
IF findType (token) = Constype THEN CG ("STORE "); CGn (thisSymbol^.value)
ELSIF isNumber (token) THEN CG ("STORE "); CG (token)
ELSIF findType (token) = Vartype THEN
CG ("FETCH ");
IF FindLocal (token) = TRUE THEN CG ("LOCAL ") END;
CG (token)
ELSE
ErrorMessage (24)
END;
CG ("");
DEC (n)
END;
CG ("CALL "); CG (name); 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 ("GOTO 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 ("GOTO 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 ("LABEL WHILE-"); CGn (count); CG ("");
INC (WHILEcount);
Condition;
CG ("IF "); CG (op);
CG (" GOTO XWHILE-"); CGn (count); CG ("");
StatementSequence;
CG ("GOTO WHILE-");
CGn (count); CG ("");
IF Strings.StrEq (token, "END") THEN
CG ("LABEL XWHILE-"); CGn (count); CG ("")
ELSE
ErrorMessage (8) (* END expected *)
END;
GetSymbol
END isWHILE;
PROCEDURE isREPEAT;
VAR count : CARDINAL;
BEGIN
count := REPEATcount; INC (REPEATcount);
CG ("LABEL REPEAT-"); CGn (count); CG ("");
StatementSequence;
IF Strings.StrEq (token, "UNTIL") = FALSE THEN ErrorMessage (21) END;
Condition;
CG ("IF "); CG (op); CG (" GOTO REPEAT-");
CGn (count); CG ("")
END isREPEAT;
PROCEDURE isIF;
VAR IFc, lbnr : CARDINAL;
BEGIN
IFc := IFcount; INC (IFcount);
lbnr := 0;
Condition;
CG ("IF "); CG (op); CG (" GOTO IF-");
CGn (IFc); CGn (lbnr); CG ("");
IF Strings.StrEq (token, "THEN") THEN
StatementSequence;
CG ("GOTO XIF-"); CGn (IFc);
CG ("");
ELSE
ErrorMessage (12) (* THEN expected *)
END;
CG ("LABEL IF-");
CGn (IFc); CGn (lbnr);
CG (""); INC (lbnr);
WHILE Strings.StrEq (token, "ELSIF") DO
Condition;
CG ("IF "); CG (op); CG (" GOTO IF-");
CGn (IFc); CGn (lbnr); CG ("");
IF Strings.StrEq (token, "THEN") THEN
StatementSequence;
CG ("GOTO XIF-"); CGn (IFc); CG ("");
ELSE
ErrorMessage (12) (* THEN expected *)
END;
CG ("LABEL IF-");
CGn (IFc); CGn (lbnr);
CG (""); INC (lbnr);
END;
IF Strings.StrEq (token, "ELSE") THEN
StatementSequence;
CG ("LABEL IF-");
CGn (IFc); CGn (lbnr); CG ("");
INC (lbnr)
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 := 'DIFFERENT' |
'<' : CASE token [1] OF
0C : op := 'GREQ' |
'>' : op := 'EQUAL' |
'=' : op := 'GREATER'
ELSE
ErrorMessage (13) (* Illegal comparator *)
END |
'>' : CASE token [1] OF
0C : op := 'LEQ' |
'=' : 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 ("ADDRESS ");
IF weHaveLocals AND (FindLocal (token) = TRUE) THEN CG ("LOCAL ") END;
CG (token); CG ("");
pastEOL := FALSE;
GetSymbol;
IF Strings.StrEq (token, ':=') = FALSE THEN
ErrorMessage (17); (* Missing ':=' *)
Skip2LF;
GetSymbol;
RETURN
END;
GetSymbol;
Expression;
CG ("SAVE"); CG ("")
END Assignment;
PROCEDURE Expression;
VAR op : CHAR;
BEGIN
Term;
op := token [0];
WHILE (op = '+') OR (op = '-') DO
GetSymbol;
Term;
IF op = '+' THEN
CG ("ADD");
CG ("")
ELSE
CG ("SUBTRACT");
CG ("")
END;
op := token [0];
IF pastEOL THEN RETURN END
END
END Expression;
PROCEDURE TermOperator () : BOOLEAN;
VAR oper : CHAR;
BEGIN
oper := token [0];
IF (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
'.', '*' : op := 'MULTIPLY' |
':', '/' : op := 'DIVIDE' |
(* '<' : op := 'LEFTSHIFT' |
'>' : op := 'RIGHTSHIFT' *)
ELSE
op := 'MODULO'
END;
GetSymbol;
Factor;
CG (op); CG ("");
GetSymbol;
END
END Term;
PROCEDURE Factor;
BEGIN
IF weHaveLocals AND (FindLocal (token) = TRUE) THEN (* local variable found *)
CG ("FETCH LOCAL ");
CG (thisLocal^.Name); CG ("")
ELSIF 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 ");
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 ("OR") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("AND") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("MOD") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("IRQ") = 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;
line := 1;
Xpos := 1;
currentType := Progtype;
LOOPdepth := 0;
PROCdepth := 0;
DebugMode := TRUE;
Exhausted := FALSE;
pastEOL := FALSE;
weHaveLocals := FALSE;
ErrCount := 0;
LOOPcount := 0;
WHILEcount := 0;
REPEATcount := 0;
IFcount := 0
END Init;
PROCEDURE ShutDown;
BEGIN
TextIO.Close (inFile);
TextIO.Close (outFile);
InOut.WriteLn; (* PrintNames; *)
MemPools.KillPool (Symbols);
IF ErrCount = 0 THEN
InOut.WriteString ("No errors found.")
ELSE
InOut.WriteCard (ErrCount, 1);
InOut.WriteString (" errors found.")
END;
InOut.WriteLn;
InOut.WriteLn;
END ShutDown;
BEGIN
Init;
Program;
ShutDown
END Plov014.
Just read through it. Or download the gzipped tarball, print it with soup/emit and read it in the men's room.
Unless you're a woman of course. Get it here:
Plov014 source and executable.
Page created on 15 September 2008 and
Page equipped with FroogleBuster technology