Plov021 : yet another other course
Blame FP. For some reason he brings out the animal in me. I was happily trotting along in the wrong direction when FP asked some silly questions. Which (hours later) triggered some new insights: I was going in the wrong direction with my direct code generation.
I dontw know WHAT FP told me. But suddenly I realized I was making a 2.5 stage rocket. Not a good idea. Either make a three stage one, or a two stage. My errors in a nutshell:
The changes for Plov021:
Plov021 : full source
It's time again for some full sourcecode. Below is how Plov021 is coded right now. It's 1400+ lines so take your time.
MODULE Plov021;
(* 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
0.15 Fix function parameter issue (in getLocals)
Jump optimisation in the IF statement 17 Sep 2008
0.16 Improve errorhandling, add operators 20 Sep 2008
0.17 Changed 'Condition' back to previous version
Implement 'IRQ', 'INC, 'DEC', 'PORT' 22 Sep 2008
0.18 Improve IO support 28 Sep 2008
0.20 Add PROCESSOR;
Change symbol table fields;
Abandon ALTO concept in favor of direct code generation;
Add TYPEs Bit, Byte;
VECTORS added to processor specific section;
From now on, a Variable is ALWAYS a signed 16 bit INTEGER;
Registers are unsigned 8 bit entities;
Bits are 1 bit entities; 11 Feb 2009
0.21 PALO/ALTO is back, direct code generation is too complex;
More type checking; better type names;
Added binary data format : b001,1101,1010 (',' is optional);
isBIT and isIOPORT have been removed (redundant now);
RamStart and SRAM now Constants included in symboltable;
PALO code must be FREE of ANY symbols;
Started implementing new parsing rules; 15 Feb 2009
*)
IMPORT InOut, MemPools, NumConv, Strings, SYSTEM, TextIO, Arguments;
CONST ErrorMax = 15;
TYPE Identifier = ARRAY [0..31] OF CHAR;
SymbolType = (ProgName, Procedure, Constant, Keyword, None, Variable, ioBit, ioPort);
SymbolPtr = POINTER TO SymbolNode;
SymbolNode = RECORD
Name : Identifier; (* name of symbol *)
next : SymbolPtr; (* next in linked list *)
type : SymbolType; (* TYPE *)
addr, (* address of symbol *)
value : CARDINAL (* value (CONSTANT) or *)
END; (* position (BIT) *)
VAR token, op, CPU : Identifier;
BigFlash,
getNextToken, DebugMode,
InProcedure, weHaveLocals,
pastEOL, Exhausted : BOOLEAN;
Locals, Symbols : MemPools.MemPool;
firstLocal, thisLocal,
firstSymbol, thisSymbol : SymbolPtr;
currentType : SymbolType;
RamStart, EEPROM, FLASH, SRAM,
VarPtr, VECTORS,
line, Xpos, ErrCount,
LOOPcount, IFcount,
REPEATcount, WHILEcount,
LOOPdepth, PROCdepth : CARDINAL;
lastCH : CHAR;
loxFile, proFile,
inFile, outFile, symFile : 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 ("Wrong operator in Factor") |
26 : InOut.WriteString ("IRQ target must be PROCEDURE") |
27 : InOut.WriteString ("IRQ handler should not have arguments") |
28 : InOut.WriteString ("Argument must VARIABLE") |
29 : InOut.WriteString ("Error in IOPORT statement") |
30 : InOut.WriteString ("TO expected") |
31 : InOut.WriteString ("FROM expected") |
32 : InOut.WriteString ("Only variable allowed") |
33 : InOut.WriteString ("Syntax : Plov infile") |
34 : InOut.WriteString ("Cannot open file '");
InOut.WriteString (buffer^[1]^); InOut.Write ("'") |
35 : InOut.WriteString ("SET, CLEAR or TOGGLE expected") |
36 : InOut.WriteString ("PROCESSOR expected; assuming ATmega128") |
37 : InOut.WriteString ("Invalid processor specified. Aborting.") |
38 : InOut.WriteString ("Hit premature end of PROCESSOR file.") |
39 : InOut.WriteString ("Error in PROCESSOR file.") |
40 : InOut.WriteString ("Duplicate identifier in PROCESSOR file.") |
41 : InOut.WriteString ("Only variable allowed.") |
42 : InOut.WriteString ("Cannot INC or DEC this type.")
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;
IF thisOne^.type = None THEN
WITH thisOne^ DO
Name := str;
type := currentType;
next := NIL
END;
thisLocal := thisOne
ELSE
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;
END;
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 DumpSymbols;
VAR thisOne : SymbolPtr;
n : CARDINAL;
BEGIN
thisOne := firstSymbol;
TextIO.PutString (symFile, "Symbol table.");
TextIO.PutLn (symFile);
TextIO.PutLn (symFile);
LOOP
TextIO.PutString (symFile, thisOne^.Name);
n := 4 - (Strings.Length (thisOne^.Name) DIV 8);
REPEAT
TextIO.PutChar (symFile, 11C);
DEC (n)
UNTIL n = 0;
CASE thisOne^.type OF
ProgName : TextIO.PutString (symFile, "Program name") |
Procedure : TextIO.PutString (symFile, "Procedure at address");
TextIO.PutChar (symFile, 11C);
TextIO.PutCard (symFile, thisOne^.addr, 6);
TextIO.PutString (symFile, " LoCo = ");
TextIO.PutCard (symFile, thisOne^.value, 2) |
Constant : TextIO.PutString (symFile, "Constant =");
TextIO.PutChar (symFile, 11C);
TextIO.PutCard (symFile, thisOne^.value, 5) |
Variable : TextIO.PutString (symFile, "INTEGER at address");
TextIO.PutChar (symFile, 11C);
TextIO.PutCard (symFile, thisOne^.addr, 5) |
Keyword : TextIO.PutString (symFile, "Keyword") |
ioBit : TextIO.PutString (symFile, "BIT in register ");
TextIO.PutChar (symFile, 11C);
TextIO.PutCard (symFile, thisOne^.addr, 5);
TextIO.PutString (symFile, " position");
TextIO.PutChar (symFile, 11C);
TextIO.PutCard (symFile, thisOne^.value, 5) |
ioPort : TextIO.PutString (symFile, "Register");
TextIO.PutChar (symFile, 11C);
TextIO.PutCard (symFile, thisOne^.addr, 5)
ELSE
TextIO.PutString (symFile, "Error in symbol table; ");
TextIO.PutString (symFile, thisOne^.Name);
TextIO.PutString (symFile, "is an unknown type. *****************************")
END;
TextIO.PutLn (symFile);
IF thisOne^.next = NIL THEN
EXIT
ELSE
thisOne := thisOne^.next
END
END;
TextIO.PutLn (symFile)
END DumpSymbols;
PROCEDURE DumpLocals (proc : SymbolPtr);
VAR thisOne : SymbolPtr;
BEGIN
thisOne := firstLocal;
TextIO.PutString (loxFile, "Procedure ");
TextIO.PutString (loxFile, proc^.Name);
TextIO.PutLn (loxFile);
LOOP
TextIO.PutString (loxFile, thisOne^.Name);
TextIO.PutChar (loxFile, 11C);
TextIO.PutString (loxFile, "Offset ");
TextIO.PutCard (loxFile, thisOne^.addr, 4);
TextIO.PutLn (loxFile);
IF thisOne^.next = NIL THEN
EXIT
ELSE
thisOne := thisOne^.next
END
END;
TextIO.PutLn (loxFile);
TextIO.PutLn (loxFile)
END DumpLocals;
PROCEDURE GetChar (VAR ch : CHAR);
BEGIN
TextIO.GetChar (inFile, ch);
IF ch = 11C THEN
Xpos := 8 * ((Xpos - 1) DIV 8);
INC (Xpos, 9)
ELSE
INC (Xpos)
END;
IF DebugMode THEN InOut.Write (ch) END;
IF ch = 12C THEN
INC (line);
Xpos := 0;
pastEOL := TRUE
END;
lastCH := ch
END GetChar;
PROCEDURE ReadString (VAR str : Identifier); (* Read a string from file *)
VAR n, max : CARDINAL;
ch : CHAR;
BEGIN
n := 0; max := HIGH (str); (* Do some inits *)
pastEOL := FALSE;
REPEAT GetChar (ch) UNTIL ch > ' '; (* Skip over whitespace *)
REPEAT
str [n] := ch;
INC (n);
GetChar (ch) (* Load string *)
UNTIL (ch < '!') OR (n > max); (* Until whitespace or full *)
IF n < max THEN str [n] := 0C END; (* Terminate string with 0C *)
END ReadString;
PROCEDURE Skip2LF; (* Skip to Linefeed *)
VAR ch : CHAR;
BEGIN
REPEAT GetChar (ch) UNTIL ch = 12C
END Skip2LF;
PROCEDURE GetSymbol; (* Read one token from file *)
BEGIN
IF getNextToken THEN
IF TextIO.EOF (inFile) = FALSE THEN
ReadString (token);
IF Strings.StrEq (token, '(*') THEN isComment END
ELSE
InOut.WriteString ("EOF!!! ")
END
ELSE
getNextToken := TRUE; (* Reuse last read token *)
RETURN
END
END GetSymbol;
PROCEDURE isComment;
BEGIN
REPEAT GetSymbol UNTIL Strings.StrEq (token, '*)');
GetSymbol
END isComment;
PROCEDURE ReadProcessor (name : Identifier) : BOOLEAN;
VAR fname, word, BitName : Identifier;
current : SymbolPtr;
nr : CARDINAL;
ok : BOOLEAN;
BEGIN
fname := name;
currentType := Constant;
TextIO.OpenInput (proFile, fname); (* Try to open local file *)
IF TextIO.Done () = FALSE THEN
fname := '../';
Strings.Append (fname, name);
TextIO.OpenInput (proFile, fname); (* One directory up then? *)
IF TextIO.Done () = FALSE THEN
fname := '/usr/local/AVR/';
Strings.Append (fname, name);
TextIO.OpenInput (proFile, fname); (* In /usr/local/AVR then? *)
IF TextIO.Done () = FALSE THEN
ErrorMessage (37);
RETURN FALSE
END
END
END; (* Processor data file is open *)
REPEAT
TextIO.GetString (proFile, word)
UNTIL Strings.StrEq (word, 'BEGIN'); (* Skip over initial garbage *)
LOOP
IF TextIO.EOF (proFile) = TRUE THEN ErrorMessage (38); RETURN FALSE END;
TextIO.GetString (proFile, word);
IF Strings.StrEq (word, 'END') = TRUE THEN EXIT
ELSIF Strings.StrEq (word, 'FLASH') = TRUE THEN TextIO.GetCard (proFile, FLASH)
ELSIF Strings.StrEq (word, 'EEPROM') = TRUE THEN TextIO.GetCard (proFile, EEPROM)
ELSIF Strings.StrEq (word, 'SRAM') = TRUE THEN
TextIO.GetCard (proFile, SRAM);
ok := StoreSymbol (word); (* Include in symbol table *)
thisSymbol^.value := SRAM
ELSIF Strings.StrEq (word, 'RAMSTART') = TRUE THEN
TextIO.GetCard (proFile, RamStart);
ok := StoreSymbol (word); (* Include in symbol table *)
thisSymbol^.value := RamStart
ELSIF Strings.StrEq (word, 'COMPILER') = TRUE THEN
REPEAT
TextIO.GetString (proFile, word);
IF Strings.StrEq (word, 'VECTORS') THEN TextIO.GetCard (proFile, VECTORS) END;
UNTIL Strings.StrEq (word, 'END')
ELSIF Strings.StrEq (word, 'PORTS') = TRUE THEN
currentType := ioPort;
LOOP
TextIO.GetString (proFile, word);
IF Strings.StrEq (word, 'END') = TRUE THEN EXIT END;
NumConv.Str2Num (nr, 16, word, ok);
TextIO.GetString (proFile, word);
IF NOT ok THEN
ErrorMessage (39)
ELSE
ok := StoreSymbol (word);
IF NOT ok THEN
ErrorMessage (40)
ELSE
thisSymbol^.addr := nr
END
END
END
ELSIF Strings.StrEq (word, 'BITS') = TRUE THEN
currentType := ioBit;
LOOP
TextIO.GetString (proFile, word);
IF Strings.StrEq (word, 'END') = TRUE THEN EXIT END;
ok := FindSymbol (word);
current := thisSymbol;
nr := 7;
LOOP
TextIO.GetString (proFile, BitName);
IF BitName [0] # '-' THEN
ok := StoreSymbol (BitName);
thisSymbol^.value := nr;
thisSymbol^.addr := current^.addr;
END;
IF nr = 0 THEN EXIT ELSE DEC (nr) END
END
END
END
END;
VarPtr := RamStart;
TextIO.Close (proFile);
IF FLASH > 4096 THEN BigFlash := TRUE ELSE BigFlash := FALSE END;
RETURN TRUE
END ReadProcessor;
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;
IF str [i] = 'b' THEN
INC (i);
REPEAT
IF (str [i] # '0') OR (str [i] # '1') OR (str [i] # ',') THEN RETURN FALSE END;
INC (i)
UNTIL (str [i] = 0C) OR (i > HIGH (str))
ELSE
REPEAT
IF isDigit (str [i]) = FALSE THEN RETURN FALSE END;
INC (i)
UNTIL (str [i] = 0C) OR (i > HIGH (str))
END;
RETURN TRUE
END isNumber;
PROCEDURE FormatBinary (VAR str : Identifier);
VAR i, j : CARDINAL;
NewStr : Identifier;
ch : CHAR;
BEGIN
i := 0;
j := 0;
REPEAT
ch := str [i];
IF (ch = '0') OR (ch = '1') THEN
NewStr [j] := ch;
INC (j)
END;
INC (i)
UNTIL (str [i] = 0C) OR (i > HIGH (str));
NewStr [j] := 0C;
str := NewStr
END FormatBinary;
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 getLocals (VAR count : CARDINAL; param : BOOLEAN);
BEGIN
REPEAT
currentType := Variable;
IF isIdentifier (token) THEN
IF StoreLocal (token) = FALSE THEN
ErrorMessage (6) (* Duplicate identifier *)
ELSE
thisLocal^.addr := 2 * count;
INC (count);
IF param THEN CG ("PARAMETER ") ELSE CG ("LOCAL ") END;
CG (token); CG ("");
END
ELSE
ErrorMessage (5) (* Illegal Identifier *)
END;
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^.type := None;
firstLocal^.next := NIL;
LoCo := 0;
GetSymbol; (* PROCEDURE name *)
IF isIdentifier (token) = FALSE THEN ErrorMessage (5) END; (* Illegal identifier *)
currentType := Procedure;
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, TRUE)
ELSE
ErrorMessage (22)
END
END;
thisProc^.value := LoCo; (* Store number of arguments *)
IF Strings.StrEq (token, "LOCAL") THEN
weHaveLocals := TRUE; GetSymbol;
getLocals (LoCo, FALSE); GetSymbol
END;
BlockBody;
DEC (PROCdepth);
IF Strings.StrEq (thisProc^.Name, token) = FALSE THEN
ErrorMessage (19) (* Names do not match *)
END;
IF LoCo > 0 THEN
CG ("RELEASE ");
CGn (LoCo);
CG ("");
weHaveLocals := FALSE
END;
GetSymbol;
DumpLocals (thisProc);
MemPools.KillPool (Locals);
CG ("# END OF PROCEDURE ");
CG (name); CG (""); CG ("");
END ProcedureDeclaration;
PROCEDURE VariableDeclaration;
BEGIN
GetSymbol;
REPEAT
currentType := Variable;
IF isIdentifier (token) THEN
IF StoreSymbol (token) = FALSE THEN
ErrorMessage (6) (* Duplicate identifier *)
ELSE
thisSymbol^.addr := VarPtr;
INC (VarPtr, 2);
CG ("# VARIABLE "); CG (token); CG ("");
END
ELSE
ErrorMessage (5) (* Illegal Identifier *)
END;
GetSymbol
UNTIL Strings.StrEq (token, "END");
GetSymbol
END VariableDeclaration;
PROCEDURE isIRQ;
VAR irq : CARDINAL;
irqN : Identifier;
BEGIN
GetSymbol;
irqN := token;
IF NOT isNumber (token) THEN ErrorMessage (1) END;
GetSymbol;
IF NOT Strings.StrEq (token, '=') THEN ErrorMessage (7) END;
GetSymbol;
IF findType (token) # Procedure THEN ErrorMessage (26) END;
IF thisSymbol^.value > 0 THEN ErrorMessage (27) END;
CG ("VECTOR "); CG (irqN); CG (" ");
CG (token); CG ("");
GetSymbol
END isIRQ;
PROCEDURE isINC;
VAR thisType : SymbolType;
ok : BOOLEAN;
BEGIN
GetSymbol;
thisType := findType (token);
IF (thisType = Variable) OR (thisType = ioPort) THEN
CG ("INCREMENT ");
IF weHaveLocals AND (FindLocal (token) = TRUE) THEN
CG ("(Z + ");
CGn (thisLocal^.addr);
CG (") ")
ELSE
ok := FindSymbol (token);
IF thisSymbol^.type = ioPort THEN CG ("PORT ") END;
CGn (thisSymbol^.addr)
END;
CG ("");
ELSE
ErrorMessage (42) (* Cannot INC or DEC this type *)
END;
GetSymbol
END isINC;
PROCEDURE isDEC;
VAR thisType : SymbolType;
ok : BOOLEAN;
BEGIN
GetSymbol;
thisType := findType (token);
IF (thisType = Variable) OR (thisType = ioPort) THEN
CG ("DECREMENT ");
IF weHaveLocals AND (FindLocal (token) = TRUE) THEN
CG ("(Z + ");
CGn (thisLocal^.addr);
CG (") ")
ELSE
ok := FindSymbol (token);
IF thisSymbol^.type = ioPort THEN CG ("PORT ") END;
CGn (thisSymbol^.addr)
END;
CG ("");
ELSE
ErrorMessage (42) (* Cannot INC or DEC this type *)
END;
GetSymbol
END isDEC;
PROCEDURE ConstantDeclaration;
VAR Val : CARDINAL;
ok : BOOLEAN;
BEGIN
GetSymbol;
REPEAT
currentType := Constant;
IF isIdentifier (token) THEN
IF StoreSymbol (token) = TRUE THEN
GetSymbol;
IF token [0] = '=' THEN
GetSymbol;
IF token [0] = 'b' THEN
FormatBinary (token);
NumConv.Str2Num (Val, 2, token, ok)
ELSE
NumConv.Str2Num (Val, 10, token, ok)
END;
IF ok THEN
WITH thisSymbol^ DO
value := Val;
type := Constant
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 Procedurecall;
VAR args, n : CARDINAL;
name : Identifier;
BEGIN
args := thisSymbol^.value; n := args;
name := token;
WHILE n > 0 DO
GetSymbol;
IF findType (token) = Constant THEN CG ("STORE "); CGn (thisSymbol^.value)
ELSIF isNumber (token) THEN CG ("STORE "); CG (token)
ELSIF findType (token) = Variable THEN
CG ("FETCH ");
IF weHaveLocals AND (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 Condition;
BEGIN
GetSymbol;
Expression;
CASE token [0] OF
'=' : op := 'DIFFERENT' |
'<' : CASE token [1] OF
0C : op := 'GREQ' |
'>' : op := 'EQUAL' |
'=' : op := 'GREATER'
ELSE
ErrorMessage (13); (* Illegal comparator *)
op := 'Error'
END |
'>' : CASE token [1] OF
0C : op := 'LEQ' |
'=' : op := 'LESS'
ELSE
ErrorMessage (13); (* Illegal comparator *)
op := 'Error'
END |
'#' : op := 'EQUAL'
ELSE
ErrorMessage (13); (* Illegal comparator *)
op := 'Error'
END;
GetSymbol;
Expression
END Condition;
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;
ELSE
ErrorMessage (12) (* THEN expected *)
END;
IF NOT Strings.StrEq (token, "END") THEN
CG ("GOTO XIF-"); CGn (IFc);
CG ("")
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 END;
IF NOT Strings.StrEq (token, "END") THEN
ErrorMessage (8) (* END expected *)
END;
CG ("LABEL XIF-"); CGn (IFc); CG ("");
GetSymbol
END isIF;
PROCEDURE TermOperator () : BOOLEAN;
VAR oper : CHAR;
BEGIN
oper := token [0];
IF (oper = '*') OR (oper = '.') THEN RETURN TRUE
ELSIF Strings.StrEq (token, "SHL") THEN RETURN TRUE
ELSIF Strings.StrEq (token, "SHR") THEN RETURN TRUE
ELSIF Strings.StrEq (token, "DIV") THEN RETURN TRUE
ELSIF Strings.StrEq (token, "MOD") 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 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 Factor;
BEGIN
IF weHaveLocals AND (FindLocal (token) = TRUE) THEN (* local variable found *)
CG ("FETCH (Z + ");
CGn (thisLocal^.addr);
CG ("")
ELSIF FindSymbol (token) = TRUE THEN (* token is CONST or VAR *)
IF (thisSymbol^.type = Constant) THEN
CG ("STORE "); (* push value of CONST *)
CGn (thisSymbol^.value); CG ("")
END;
IF thisSymbol^.type = Variable THEN
CG ("FETCH ");
CGn (thisSymbol^.addr); CG (""); (* fetch value at addr of VAR *)
ELSIF thisSymbol^.type = ioPort THEN
CG ("FETCH PORT ");
CGn (thisSymbol^.addr); CG ("")
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 Term;
VAR Operator : CHAR;
op : Identifier;
BEGIN
Factor;
GetSymbol;
WHILE TermOperator () = TRUE DO
IF Strings.StrEq (token, "SHL") THEN op := "LEFTSHIFT"
ELSIF Strings.StrEq (token, "SHR") THEN op := "RIGHTSHIFT"
ELSIF Strings.StrEq (token, "DIV") THEN op := "DIVIDE"
ELSIF Strings.StrEq (token, "MOD") THEN op := "MODULO"
ELSE
CASE token [0] OF
'.', '*' : op := 'MULTIPLY' |
':', '/' : op := 'DIVIDE'
ELSE
ErrorMessage (25);
op := "Error"
END
END;
GetSymbol;
Factor;
CG (op); CG ("");
GetSymbol;
END
END Term;
PROCEDURE Assignment;
VAR ok, bitOp : BOOLEAN;
BEGIN
IF weHaveLocals AND (FindLocal (token) = TRUE) THEN
CG ("ADDRESS (Z + ");
CGn (thisLocal^.addr);
CG (") ")
ELSE
ok := FindSymbol (token);
bitOp := FALSE;
IF thisSymbol^.type = Variable THEN
CG ("MEMORY ");
CGn (thisSymbol^.addr)
ELSIF thisSymbol^.type = ioPort THEN
CG ("PORT ");
CGn (thisSymbol^.addr)
ELSIF thisSymbol^.type = ioBit THEN
bitOp := TRUE;
CG ("PORT ");
CGn (thisSymbol^.addr);
CG (" BIT ");
CGn (thisSymbol^.value)
END
END;
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 isPORT;
VAR ok : BOOLEAN;
BEGIN
CG ("PORTPOINTER ");
GetSymbol;
ok := FindSymbol (token);
IF NOT ok THEN
ErrorMessage (9)
ELSE
IF thisSymbol^.type = Variable THEN
CGn (thisSymbol^.addr);
CG ("")
ELSE
ErrorMessage (41)
END
END;
pastEOL := FALSE;
GetSymbol;
IF Strings.StrEq (token, ':=') = FALSE THEN
ErrorMessage (17); (* Missing ':=' *)
Skip2LF;
GetSymbol;
RETURN
END;
GetSymbol;
Expression;
CG ("SAVE"); CG ("")
END isPORT;
*)
PROCEDURE StatementSequence;
BEGIN
GetSymbol;
LOOP
CG ("");
IF findType (token) >= Variable THEN Assignment
ELSIF findType (token) = Procedure THEN Procedurecall
ELSIF Strings.StrEq (token, "IF") THEN isIF
ELSIF Strings.StrEq (token, "LOOP") THEN isLOOP
ELSIF Strings.StrEq (token, "INC") THEN isINC
ELSIF Strings.StrEq (token, "DEC") THEN isDEC
(* ELSIF Strings.StrEq (token, "PORT") THEN isPORT *)
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 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 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
END;
BlockBody;
END Block;
PROCEDURE Program;
BEGIN
GetSymbol;
IF NOT Strings.StrEq (token, "PROGRAM") THEN
ErrorMessage (18) (* 'PROGRAM' expected *)
END;
GetSymbol;
IF NOT isIdentifier (token) THEN
ErrorMessage (5); (* Illegal identifier *)
Skip2LF
END;
WITH firstSymbol^ DO
Name := token;
type := ProgName
END;
CG ("# PROGRAM "); CG (token); CG (""); CG ("");
GetSymbol;
IF Strings.StrEq (token, "PROCESSOR") THEN
GetSymbol;
IF ReadProcessor (token) = FALSE THEN RETURN END;
CPU := token;
CG ("PROCESSOR "); CG (CPU); CG ("")
ELSE
ErrorMessage (36);
getNextToken := FALSE
END;
Block;
IF NOT Strings.StrEq (token, firstSymbol^.Name) THEN
ErrorMessage (3)
END;
CG ("STOP"); CG ("");
CG ("# Done #"); CG ("")
END Program;
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);
Fname := name;
Strings.Append (Fname, '.symbols');
TextIO.OpenOutput (symFile, Fname);
Fname := name;
Strings.Append (Fname, '.locals');
TextIO.OpenOutput (loxFile, 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 := Keyword;
IF StoreSymbol ("CONSTANTS") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("BEGIN") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("BIT") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("BYTE") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("DEC") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("DO") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("ELSE") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("ELSIF") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("END") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("EXIT") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("IF") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("INC") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("IOPORT") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("IRQ") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("LOCAL") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("LOOP") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("MOD") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("OR") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("PORTS") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("PROCEDURE") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("PROGRAM") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("REPEAT") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("RETURN") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("THEN") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("UNTIL") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("VARIABLES") = FALSE THEN ErrorMessage (0) END;
IF StoreSymbol ("WHILE") = FALSE THEN ErrorMessage (0) END;
currentType := Constant;
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 := ProgName;
LOOPdepth := 0;
PROCdepth := 0;
DebugMode := TRUE;
getNextToken := TRUE;
Exhausted := FALSE;
pastEOL := FALSE;
weHaveLocals := FALSE;
ErrCount := 0;
LOOPcount := 0;
WHILEcount := 0;
REPEATcount := 0;
IFcount := 0
END Init;
PROCEDURE ShutDown;
BEGIN
DumpSymbols;
TextIO.Close (inFile);
TextIO.Close (outFile);
TextIO.Close (symFile);
TextIO.Close (loxFile);
InOut.WriteLn; (* PrintNames; *)
MemPools.KillPool (Symbols);
IF ErrCount = 0 THEN
InOut.WriteString ("No")
ELSE
InOut.WriteCard (ErrCount, 1)
END;
InOut.WriteString (" errors found.");
InOut.WriteLn;
InOut.WriteLn;
END ShutDown;
BEGIN
Init;
Program;
ShutDown
END Plov021.
Plov021 : see it run
Of course this source compiles and runs. Below are some test programs, accompanied by the results.
This first test shows that the processor specific special function registers are fully resolved by Plov. For example 'UCSRA', 'PORTD', 'PORTA', 'RXCIE'. It's all resolved.
I added whitespace to both sides of the listings to synchronize palo and plov sources for easier comparison of
the results.
PROGRAM test30
PROCESSOR ATmega8515
CONSTANTS Ser0 = 101
Ser1 = 105
DTR0 = 102
DTR1 = 118
END
VARIABLES a b cc ddd END
BEGIN
a := UCSRA
b := PORTD
cc := EEARL
INC PORTA
DEC PORTB
EEARL := DTR0
RXCIE := 1
END test30
|
# PROGRAM test30
PROCESSOR ATmega8515
# VARIABLE a
# VARIABLE b
# VARIABLE cc
# VARIABLE ddd
LABEL MAINLOOP
MEMORY 96
FETCH PORT 11
SAVE
MEMORY 98
FETCH PORT 18
SAVE
MEMORY 100
FETCH PORT 30
SAVE
INCREMENT PORT 27
DECREMENT PORT 24
PORT 30
STORE 102
SAVE
PORT 10 BIT 7
STORE 1
SAVE
LABEL EXITMAINLOOP
STOP
# Done #
|
PROGRAM test28
PROCESSOR ATmega8515
CONSTANTS aa = 12 END
VARIABLES a aaa b bab END
BEGIN
a := aaa SHL aa
bab := 1 SHR a
b := aa MOD 3
aaa := aaa + 1
a := aa DIV b
END test28
|
# PROGRAM test28
PROCESSOR ATmega8515
# VARIABLE a
# VARIABLE aaa
# VARIABLE b
# VARIABLE bab
LABEL MAINLOOP
MEMORY 96
FETCH 98
STORE 12
LEFTSHIFT
SAVE
MEMORY 102
STORE 1
FETCH 96
RIGHTSHIFT
SAVE
MEMORY 100
STORE 12
STORE 3
MODULO
SAVE
MEMORY 98
FETCH 98
STORE 1
ADD
SAVE
MEMORY 96
STORE 12
FETCH 100
DIVIDE
SAVE
LABEL EXITMAINLOOP
STOP
# Done #
|
PROGRAM test27
PROCESSOR ATmega8535
VARIABLES AAA a b c d e f g h i j k END
PROCEDURE gobble a b c
BEGIN
IF a < b THEN
c := d
b := a - 1
e := f . g
i := 1
ELSIF a = b THEN
d := c
g := f . i
k := j MOD d
ELSIF b > a THEN
h := 2
k := i - 1
ELSE
d := 0
END
END gobble
BEGIN
gobble 1 2 3
END test27
|
# PROGRAM test27
PROCESSOR ATmega8535
# VARIABLE AAA
# VARIABLE a
# VARIABLE b
# VARIABLE c
# VARIABLE d
# VARIABLE e
# VARIABLE f
# VARIABLE g
# VARIABLE h
# VARIABLE i
# VARIABLE j
# VARIABLE k
# PROCEDURE DECLARATION OF gobble
LABEL gobble
PARAMETER a
PARAMETER b
PARAMETER c
FETCH (Z + 0
FETCH (Z + 2
IF GREQ GOTO IF-00
ADDRESS (Z + 4)
FETCH 104
SAVE
ADDRESS (Z + 2)
FETCH (Z + 0
STORE 1
SUBTRACT
SAVE
MEMORY 106
FETCH 108
FETCH 110
MULTIPLY
SAVE
MEMORY 114
STORE 1
SAVE
GOTO XIF-0
LABEL IF-00
FETCH (Z + 0
FETCH (Z + 2
IF DIFFERENT GOTO IF-01
MEMORY 104
FETCH (Z + 4
SAVE
MEMORY 110
FETCH 108
FETCH 114
MULTIPLY
SAVE
MEMORY 118
FETCH 116
FETCH 104
MODULO
SAVE
GOTO XIF-0
LABEL IF-01
FETCH (Z + 2
FETCH (Z + 0
IF LEQ GOTO IF-02
MEMORY 112
STORE 2
SAVE
MEMORY 118
FETCH 114
STORE 1
SUBTRACT
SAVE
GOTO XIF-0
LABEL IF-02
MEMORY 104
STORE 0
SAVE
LABEL XIF-0
RELEASE 3
# END OF PROCEDURE gobble
LABEL MAINLOOP
STORE 1
STORE 2
STORE 3
CALL gobble
LABEL EXITMAINLOOP
STOP
# Done #
|
PROGRAM test26
PROCESSOR ATmega8515
CONSTANTS m = 7
n = b1001,0101
END
VARIABLES x
y
z
q
r
END
PROCEDURE MULTIPLY p q
BEGIN
z := 0
WHILE q MOD 2 = 1 DO
IF q = 1 THEN z := z + p END
p := p SHL 1
q := q SHR 1
END
END MULTIPLY
PROCEDURE DIVIDE t n
LOCAL w END
BEGIN
t := x
q := 0
n := y
WHILE n <= t DO n := n SHL 1 END
WHILE n > y DO
q := q SHL 1
n := n SHR 1
IF n <= t THEN
t := t - n
INC q
END
END
END DIVIDE
PROCEDURE Gcd
LOCAL f g END
BEGIN
f := x
g := y
WHILE f # g DO
IF f < g THEN
g := g - f
q := f + g
END
IF g < f THEN
f := f - g
r := m . x
END
END
z := f
END Gcd
IRQ 1 = Gcd
BEGIN
MULTIPLY m n
DIVIDE x y
x := 84
y := 36
Gcd
END test26
|
# PROGRAM test26
PROCESSOR ATmega8515
# VARIABLE x
# VARIABLE y
# VARIABLE z
# VARIABLE q
# VARIABLE r
# PROCEDURE DECLARATION OF MULTIPLY
LABEL MULTIPLY
PARAMETER p
PARAMETER q
MEMORY 100
STORE 0
SAVE
LABEL WHILE-0
FETCH (Z + 2
STORE 2
MODULO
STORE 1
IF DIFFERENT GOTO XWHILE-0
FETCH (Z + 2
STORE 1
IF DIFFERENT GOTO IF-00
MEMORY 100
FETCH 100
FETCH (Z + 0
ADD
SAVE
LABEL IF-00
LABEL XIF-0
ADDRESS (Z + 0)
FETCH (Z + 0
STORE 1
LEFTSHIFT
SAVE
ADDRESS (Z + 2)
FETCH (Z + 2
STORE 1
RIGHTSHIFT
SAVE
GOTO WHILE-0
LABEL XWHILE-0
RELEASE 2
# END OF PROCEDURE MULTIPLY
# PROCEDURE DECLARATION OF DIVIDE
LABEL DIVIDE
PARAMETER t
PARAMETER n
LOCAL w
ADDRESS (Z + 0)
FETCH 96
SAVE
MEMORY 102
STORE 0
SAVE
ADDRESS (Z + 2)
FETCH 98
SAVE
LABEL WHILE-1
FETCH (Z + 2
FETCH (Z + 0
IF GREATER GOTO XWHILE-1
ADDRESS (Z + 2)
FETCH (Z + 2
STORE 1
LEFTSHIFT
SAVE
GOTO WHILE-1
LABEL XWHILE-1
LABEL WHILE-2
FETCH (Z + 2
FETCH 98
IF LEQ GOTO XWHILE-2
MEMORY 102
FETCH 102
STORE 1
LEFTSHIFT
SAVE
ADDRESS (Z + 2)
FETCH (Z + 2
STORE 1
RIGHTSHIFT
SAVE
FETCH (Z + 2
FETCH (Z + 0
IF GREATER GOTO IF-10
ADDRESS (Z + 0)
FETCH (Z + 0
FETCH (Z + 2
SUBTRACT
SAVE
INCREMENT 102
LABEL IF-10
LABEL XIF-1
GOTO WHILE-2
LABEL XWHILE-2
RELEASE 3
# END OF PROCEDURE DIVIDE
# PROCEDURE DECLARATION OF Gcd
LABEL Gcd
LOCAL f
LOCAL g
ADDRESS (Z + 0)
FETCH 96
SAVE
ADDRESS (Z + 2)
FETCH 98
SAVE
LABEL WHILE-3
FETCH (Z + 0
FETCH (Z + 2
IF EQUAL GOTO XWHILE-3
FETCH (Z + 0
FETCH (Z + 2
IF GREQ GOTO IF-20
ADDRESS (Z + 2)
FETCH (Z + 2
FETCH (Z + 0
SUBTRACT
SAVE
MEMORY 102
FETCH (Z + 0
FETCH (Z + 2
ADD
SAVE
LABEL IF-20
LABEL XIF-2
FETCH (Z + 2
FETCH (Z + 0
IF GREQ GOTO IF-30
ADDRESS (Z + 0)
FETCH (Z + 0
FETCH (Z + 2
SUBTRACT
SAVE
MEMORY 104
STORE 7
FETCH 96
MULTIPLY
SAVE
LABEL IF-30
LABEL XIF-3
GOTO WHILE-3
LABEL XWHILE-3
MEMORY 100
FETCH (Z + 0
SAVE
RELEASE 2
# END OF PROCEDURE Gcd
VECTOR 1 Gcd
LABEL MAINLOOP
STORE 7
STORE 149
CALL MULTIPLY
FETCH x
FETCH y
CALL DIVIDE
MEMORY 96
STORE 84
SAVE
MEMORY 98
STORE 36
SAVE
CALL Gcd
LABEL EXITMAINLOOP
STOP
# Done #
|
FETCH LOCAL value is not yet working right. The closing bracket is still missing. I need to do a large set of tests to see how well it goes. The test programs until now compiled error free. Which does not mean they produced the correct PALO codes.
Page created on Sunday 15 February 2009 and
Page equipped with FroogleBuster technology