first commit

Ancien/Makefile

@@ -0,0 +1,110 @@
+
+compile	=
+
+objects =       PL0.o InternalTree.o Synthesis.o \
+        SyntaxAnalysis.o StringTable.o Scanner.o ObjectTable.o \
+        Interpreter.o Generator.o ErrorHandling.o \
+        CharacterInput.o
+
+
+programs:	symbols objects	 PL0
+		@echo programs up to date
+
+symbols:	InternalTree.sym Synthesis.sym SyntaxAnalysis.sym \
+	StringTable.sym Scanner.sym ObjectTable.sym Interpreter.sym \
+	Generator.sym ErrorHandling.sym CharacterInput.sym 
+		@echo symbols up to date
+
+objects:	PL0.o InternalTree.o Synthesis.o \
+	SyntaxAnalysis.o StringTable.o Scanner.o ObjectTable.o \
+	Interpreter.o Generator.o ErrorHandling.o \
+	CharacterInput.o 
+		@echo objects up to date
+
+PL0:	PL0.o \
+	Scanner.o CharacterInput.o \
+	StringTable.o ObjectTable.o \
+	Synthesis.o InternalTree.o \
+	ErrorHandling.o Generator.o \
+	Interpreter.o SyntaxAnalysis.o 
+		m2c  -e PL0 -o PL0  -lmodula2 -ltermlib
+
+PL0.o:	PL0.mod	 \
+	Scanner.sym SyntaxAnalysis.sym Synthesis.sym Generator.sym \
+	Interpreter.sym InternalTree.sym 
+		m2c $(compile)	PL0.mod
+
+InternalTree.o: InternalTree.mod InternalTree.sym Scanner.sym
+		m2c $(compile)	InternalTree.mod
+
+Synthesis.o:	Synthesis.mod Synthesis.sym \
+	StringTable.sym Scanner.sym \
+ 	InternalTree.sym ErrorHandling.sym Generator.sym ObjectTable.sym 
+		m2c $(compile)	Synthesis.mod
+
+SyntaxAnalysis.o: SyntaxAnalysis.mod	SyntaxAnalysis.sym \
+	Scanner.sym InternalTree.sym \
+	ErrorHandling.sym 
+		m2c $(compile)	SyntaxAnalysis.mod
+
+StringTable.o: StringTable.mod StringTable.sym \
+	Scanner.sym	\
+	ObjectTable.sym
+		m2c $(compile)	StringTable.mod
+
+Scanner.o:	Scanner.mod Scanner.sym ErrorHandling.sym \
+	CharacterInput.sym \
+	StringTable.sym 
+		m2c $(compile)	Scanner.mod
+
+ObjectTable.o: ObjectTable.mod ObjectTable.sym \
+	Synthesis.sym \
+	StringTable.sym Scanner.sym ErrorHandling.sym 
+		m2c $(compile)	ObjectTable.mod
+
+Interpreter.o: Interpreter.mod Interpreter.sym
+		m2c $(compile)	Interpreter.mod
+
+Generator.o:	Generator.mod Generator.sym \
+	Interpreter.sym	
+		m2c $(compile)	Generator.mod
+
+ErrorHandling.o: ErrorHandling.mod ErrorHandling.sym Scanner.sym
+		m2c $(compile)	ErrorHandling.mod
+
+CharacterInput.o: CharacterInput.mod CharacterInput.sym \
+	Scanner.sym
+		m2c $(compile)	CharacterInput.mod
+
+InternalTree.sym: InternalTree.def Scanner.sym 
+		m2c $(compile) InternalTree.def
+
+Synthesis.sym:	Synthesis.def InternalTree.sym
+		m2c $(compile) Synthesis.def
+
+SyntaxAnalysis.sym: SyntaxAnalysis.def InternalTree.sym 
+		m2c $(compile) SyntaxAnalysis.def
+
+StringTable.sym: StringTable.def Scanner.sym ObjectTable.sym
+		m2c $(compile) StringTable.def
+
+Scanner.sym:	Scanner.def  
+		m2c $(compile) Scanner.def
+
+ObjectTable.sym: ObjectTable.def \
+	Scanner.sym Generator.sym 
+		m2c $(compile) ObjectTable.def
+
+Interpreter.sym: Interpreter.def 
+		m2c $(compile) Interpreter.def
+
+Generator.sym:	Generator.def Interpreter.sym 
+		m2c $(compile) Generator.def
+
+ErrorHandling.sym: ErrorHandling.def Scanner.sym 
+		m2c $(compile) ErrorHandling.def
+
+CharacterInput.sym: CharacterInput.def	
+		m2c $(compile) CharacterInput.def
+
+

CharacterInput.def

@@ -0,0 +1,21 @@
+DEFINITION MODULE CharacterInput;
+
+(* EXPORT QUALIFIED ch, GetCh, EOF,
+		 currLine, currCol,endOfInput, InitInput;
+*)
+
+
+CONST EOF = 0C;
+
+VAR  ch 	 : CHAR;
+     currLine	 : CARDINAL;
+     currCol	 : CARDINAL;
+     endOfInput  : BOOLEAN;
+
+
+
+PROCEDURE GetCh;
+
+PROCEDURE InitInput;
+
+END CharacterInput.

CharacterInput.mod

@@ -0,0 +1,65 @@
+IMPLEMENTATION MODULE CharacterInput;
+
+FROM	InOut		IMPORT	Read,
+				Write, WriteCard, WriteString, WriteLn,
+				Done, EOL;
+FROM	Scanner 	IMPORT	traceParser, printCode, printListing;
+
+
+CONST maxLine = 120;
+      HT  = 11C;		(* tab char *)
+
+
+
+VAR inLine   : ARRAY[1..maxLine-1] OF CHAR;
+    xL	     : [0..maxLine];
+
+
+
+
+PROCEDURE GetCh;
+   VAR c: CHAR;
+BEGIN
+   IF currCol >= xL THEN
+      IF endOfInput THEN ch := EOF; RETURN END;
+
+      (* read a new line *)
+      xL := 0; currCol := 0; INC(currLine);
+      REPEAT
+	 Read(c);
+	 IF Done THEN
+	    IF c = HT THEN
+	       REPEAT
+		   INC(xL); inLine[xL] := ' '
+	       UNTIL xL MOD 8 = 0;
+	    ELSE
+	       INC(xL); inLine[xL] := c
+	    END
+	 ELSE
+	    INC(xL); endOfInput := TRUE;
+	 END
+      UNTIL NOT Done OR (inLine[xL] = EOL);
+      IF printListing THEN
+	 inLine[xL] := 0C;
+	 WriteCard(currLine, 6); WriteString(': ');
+	 WriteString(inLine); WriteLn;
+      END;
+      inLine[xL] := ' ';	(* newline returns ' ' *)
+   END;
+
+   (* return next character *)
+   INC(currCol);
+   ch := inLine[currCol];
+   Write(ch); (*___________________*)
+END GetCh;
+
+
+PROCEDURE InitInput;
+BEGIN
+   xL := 0; currCol := 0;
+   currLine := 0; endOfInput := FALSE;
+END InitInput;
+
+
+BEGIN
+END CharacterInput.

ErrorHandling.def

@@ -0,0 +1,11 @@
+DEFINITION MODULE ErrorHandling;
+
+FROM	Scanner IMPORT	POSITION;
+
+(* EXPORT	QUALIFIED PrintError1, PrintError2; *)
+
+PROCEDURE PrintError1(n : CARDINAL; p: POSITION);
+PROCEDURE PrintError2(n : CARDINAL; p: POSITION);
+
+END ErrorHandling.
+

ErrorHandling.mod

@@ -0,0 +1,117 @@
+IMPLEMENTATION MODULE ErrorHandling;
+
+FROM InOut	IMPORT Write, WriteString, WriteCard, WriteLn;
+FROM Scanner	IMPORT POSITION, printListing;
+
+
+VAR error : ARRAY[0..79] OF CHAR;
+    lastErrorPos : POSITION;
+
+
+PROCEDURE PrintText (n : CARDINAL);
+BEGIN
+   CASE n OF
+      1: error := "Verwende '=' anstatt ':=' !"
+   |  2: error := "Nach '=' muss eine Zahl folgen."
+   |  3: error := "Nach dem Bezeichner muss '=' folgen."
+   |  4: error := "Nach CONST, VAR, oder PROCEDURE muss ein Bezeichner folgen."
+   |  5: error := "';' (oder ',') fehlt."
+   |  6: error := "Ein Ausdruck kann nicht mit diesem Symbol beginnen."
+   |  7: error := "Schliessende Klammer fehlt."
+   |  8: error := "So kann kein Faktor beginnen."
+   |  9: error := "Hier wird '.' erwartet."
+   | 10: error := "Inkorrektes Symbol in einer Anweisung."
+   | 11: error := "Dieser Bezeichner ist nicht vereinbart."
+   | 12: error := "Zuweisung an Konstante oder Prozedur ist nicht erlaubt."
+   | 13: error := "Zuweisungsoperator ist ':='."
+   | 14: error := "Hier wird ';' erwartet."
+   | 15: error := "Hier wird ein Prozedurbezeichner erwartet."
+   | 16: error := "Hier wird 'THEN' erwartet."
+   | 17: error := "Hier wird ';' oder 'END' erwartet."
+   | 18: error := "Hier wird 'DO' erwartet."
+   | 19: error := "Auf diese Anweisung folgt ein inkorrekt verwendetes Symbol."
+   | 20: error := "Hier wird eine Relation erwartet."
+   | 21: error := "Ein Ausdruck darf keinen Prozedurbezeichner enthalten."
+   | 25: error := "Ein Bezeichner darf nur einmal vereinbart werden."
+   | 26: error := "Hier wird 'OF' erwartet."
+   | 27: error := "Hier wird eine Konstante erwartet."
+   | 28: error := "Hier wird '=', '#', '<', '<=', '>' oder '>=' erwartet."
+   | 29: error := "Hier wird ein Bezeicner erwartet."
+   | 30: error := "Zahl ist zu gross."
+   | 31: error := "Unerwartetes Datenende."
+   | 32: error := "Hier wird ein Statement erwartet."
+   | 33: error := "Hier wird BEGIN, CONST, VAR oder PROCEDURE erwartet."
+   | 34: error := "Hier wird IF erwartet."
+   | 35: error := "Hier wird END oder ELSE erwartet."
+   | 36: error := "Fehler in Variablenvereinbarung."
+   | 37: error := "Hier wird ein Typ (Bezeichner) erwartet."
+   | 38: error := "Es wird ein Operand vom Typ INTEGER erwartet."
+   | 39: error := "Es wird ein Operand vom Typ BOOLEAN erwartet."
+   | 40: error := "Linker und rechter Operand nicht vom selben Typ."
+   | 41: error := "Nicht definierter Typ."
+   | 42: error := "Zyklische Typdefinition nicht erlaubt."
+   | 43: error := "Fehlerhafte Typvereinbarung."
+   | 44: error := "Schliessende Indexklammer fehlt."
+   | 45: error := "Hier wird ':=' erwartet."
+   | 46: error := "Index ist nicht vom Typ INTEGER."
+   | 47: error := "Unzulaessige Indizierung."
+   | 48: error := "Konstanten koennen nicht indiziert werden"
+   | 49: error := "Hier wird ':' oder ',' erwartet."
+   | 50: error := "Schliessende Parameterklammer fehlt."
+   | 51: error := "Hier wird ein Bezeicher erwartet."
+   | 52: error := "Hier wird eine Variable erwartet."
+   | 53: error := "Falscher Parametertyp."
+   | 54: error := "Falsche Anzahl von Parametern."
+   | 55: error := "Unzulaessiger Indexwert."
+   | 56: error := "Zeilenende in einer Zeichenkette nicht erlaubt."
+   | 57: error := "Unzulaessiges 'escape char'."
+   | 58: error := "Zahl ist zu gross."
+   | 59: error := "Fehlerhafter Elementtyp."
+   | 98: error := "Beginn Skip."
+   | 99: error := "Ende Skip."
+   ELSE
+	 IF n >= 100 THEN
+	    WriteString("Compilerfehler Nr.: ")
+	 ELSE
+	    WriteString("Fehler Nr.: ");
+	 END;
+	 WriteCard(n, 2); WriteLn; RETURN
+   END;
+   WriteString(error); WriteLn;
+END PrintText;
+
+
+PROCEDURE PrintError1 (n : CARDINAL; p : POSITION);
+VAR i : CARDINAL;
+BEGIN
+   IF (p.line = lastErrorPos.line) AND
+      (p.column = lastErrorPos.column) THEN
+      RETURN
+   END;
+   lastErrorPos := p;
+   IF printListing THEN
+      WriteString('### ___');
+      FOR i := 1 TO p.column DO Write('_') END;
+      WriteString('^ ');
+   END;
+   PrintText(n)
+END PrintError1;
+
+
+PROCEDURE PrintError2 (n : CARDINAL; p : POSITION);
+BEGIN
+   IF (p.line = lastErrorPos.line) AND
+      (p.column = lastErrorPos.column) THEN
+      RETURN
+   END;
+   lastErrorPos := p;
+   WriteString("### Zeile "); WriteCard(p.line, 2);
+   WriteString(", Spalte ");  WriteCard(p.column, 2);
+   WriteString(': ');
+   PrintText(n);
+END PrintError2;
+
+
+
+END ErrorHandling.
+

Generator.def

@@ -0,0 +1,61 @@
+DEFINITION MODULE Generator;			(* gf	05.01.89 *)
+
+FROM	Scanner 	IMPORT STRING;
+FROM	Interpreter	IMPORT INSTR, Command;
+
+(* EXPORT	QUALIFIED Label,
+		  Gen, GenL, GenS, Gens,
+		  GetNewLabel, SetLabel,
+		  CodeStore,
+		  InitGenerator;
+*)
+
+
+CONST maxadr = 1023;
+TYPE  Label;
+VAR   CodeStore : ARRAY[0..maxadr] OF INSTR;
+
+
+PROCEDURE GetNewLabel() : Label;
+
+	  (* get a new label to be used by GenL and SetLabel.	*)
+
+
+PROCEDURE SetLabel(lab: Label);
+
+	  (* inserts label 'lab' at current code position.	*)
+	  (* fixes all instuctions which contain this label	*)
+	  (* in their 'val' field, i.e. all instructions	*)
+	  (* which are genereated by GenL(.., .., lab). 	*)
+
+
+PROCEDURE Gen(fct: Command; lev, val: CARDINAL);
+
+	  (* emmit instruction					*)
+
+
+PROCEDURE GenL(fct: Command; lev: CARDINAL; lab: Label);
+
+	  (* emmit instruction. the 'val' field contains the	*)
+	  (* address of label 'lab'. if the address of 'lab'	*)
+	  (* is unknown, the 'val' field will be fixed by	*)
+	  (* SetLabel.						*)
+
+
+PROCEDURE GenS(fct: Command; len: CARDINAL; str: STRING);
+
+	  (* emmit instruction. to be used to generate		*)
+	  (* instructions which are followed by a string	*)
+	  (* literal. the length of the string is stored in	*)
+	  (* the 'val' field.					*)
+
+
+PROCEDURE Gens(fct: Command);
+
+	  (* short form of Gen,  == Gen(fct, 0, 0)		*)
+
+
+PROCEDURE InitGenerator;
+
+END Generator.
+

Generator.mod

@@ -0,0 +1,202 @@
+IMPLEMENTATION MODULE Generator;
+
+FROM	InOut		IMPORT	Write, WriteString,
+				WriteOct, WriteCard, WriteHex,
+				WriteInt, WriteLn;
+FROM	Interpreter	IMPORT	INSTR, Command;
+FROM	Storage 	IMPORT	ALLOCATE;
+FROM	Scanner 	IMPORT	STRING, printCode;
+
+TYPE refPointer = POINTER TO instr;
+TYPE instr	= RECORD
+		     addr : CARDINAL;
+		     next : refPointer;
+		  END;
+
+TYPE label = RECORD
+		num  : CARDINAL;
+		addr : CARDINAL;
+		refs : refPointer
+	     END;
+
+TYPE Label = POINTER TO label;
+
+VAR LNum     : CARDINAL;		(* number of next label     *)
+VAR currAddr : CARDINAL;		(* current code store index *)
+
+VAR mnem     : ARRAY [ MSP .. OUTc], [0..3] OF CHAR;
+
+
+
+
+PROCEDURE GetNewLabel() : Label;
+VAR tmp : Label;
+BEGIN
+   NEW(tmp);
+   tmp^.num  := LNum; INC(LNum);
+   tmp^.addr :=  0;
+   tmp^.refs := NIL;
+   RETURN tmp
+END GetNewLabel;
+
+
+PROCEDURE Gen(fct: Command; lev, val: CARDINAL);
+BEGIN
+   IF currAddr >= maxadr THEN
+      WriteString("*** code store overflow ***"); WriteLn;
+      HALT
+   END;
+   CodeStore[currAddr].cmd := fct;
+   CodeStore[currAddr].lev := lev;
+   CodeStore[currAddr].val := val;
+   IF printCode THEN
+      WriteHex(currAddr, 4);WriteString(":       ");
+      WriteString(mnem[fct]);
+      IF fct < RET THEN
+	 Write(" ");
+	 IF (fct = LDA) OR (fct = CALL) THEN
+	    WriteCard(lev, 1); Write(",");
+	 END;
+	 IF (fct = JMP) OR (fct = JMPC) OR (fct = CALL) THEN
+	    Write('$'); WriteHex(val, 4)
+	 ELSE
+	    WriteInt(INTEGER(val), 1)
+	 END
+      END;
+      WriteLn;
+   END;
+   INC(currAddr)
+END Gen;
+
+
+PROCEDURE GenL(fct : Command; lev : CARDINAL; lab : Label);
+VAR refPtr : refPointer;
+BEGIN
+   IF currAddr >= maxadr THEN
+      WriteString("*** code store overflow ***"); WriteLn;
+      HALT
+   END;
+   CodeStore[currAddr].cmd := fct;
+   CodeStore[currAddr].lev := lev;
+   CodeStore[currAddr].val := lab^.addr;
+   IF printCode THEN
+      WriteHex(currAddr, 4); WriteString(":       ");
+      WriteString(mnem[fct]);
+      IF fct < RET THEN
+	 Write(" ");
+	 IF (fct = LDA) OR (fct = CALL) THEN
+	    WriteCard(lev, 1); Write(",");
+	 END;
+	 Write('L'); WriteHex(lab^.num, 4);
+      END;
+      WriteLn;
+   END;
+   IF lab^.refs = NIL THEN
+      NEW(lab^.refs);
+      refPtr := lab^.refs
+   ELSE
+      refPtr := lab^.refs;
+      WHILE refPtr^.next # NIL DO refPtr := refPtr^.next END;
+      NEW(refPtr^.next);
+      refPtr := refPtr^.next
+   END;
+   refPtr^.addr := currAddr;
+   refPtr^.next := NIL;
+   INC(currAddr)
+END GenL;
+
+
+PROCEDURE GenS(fct : Command; len : CARDINAL; str : STRING);
+VAR i, j : CARDINAL;
+    c	 : CHAR;
+BEGIN
+   IF currAddr >= maxadr THEN
+      WriteString("*** code store overflow ***"); WriteLn;
+      HALT
+   END;
+   CodeStore[currAddr].cmd := fct;
+   CodeStore[currAddr].lev :=  0;
+   CodeStore[currAddr].val := len;
+   IF printCode THEN
+      WriteHex(currAddr, 4); WriteString(":       ");
+      WriteString(mnem[fct]);
+      WriteString(" '");
+   END;
+   INC(currAddr); j := 0; DEC(len);
+   FOR i := len TO 0 BY -1 DO
+       CodeStore[currAddr].sval[j] := str^[i];
+       INC(j);
+       IF j = 6 THEN
+	  INC(currAddr); j := 0
+       END
+   END;
+   IF printCode THEN
+      FOR i := 0 TO len DO
+	  c := str^[i];
+	  IF (c >= ' ') AND (c <= "~") THEN
+	     Write(c);
+	  ELSE
+	     Write("\"); WriteOct(ORD(c), 3)
+	  END
+      END;
+      Write("'"); WriteLn;
+   END;
+   IF j # 0 THEN
+      INC(currAddr)
+   END
+END GenS;
+
+
+PROCEDURE Gens(fct: Command);
+BEGIN
+   Gen(fct, 0, 0)
+END Gens;
+
+
+PROCEDURE fixup(x: CARDINAL);
+BEGIN
+   CodeStore[x].val := currAddr;
+END fixup;
+
+
+PROCEDURE SetLabel(lab : Label);
+VAR nref : refPointer;
+BEGIN
+   IF printCode THEN
+      WriteHex(currAddr, 4);
+      WriteString(": L"); WriteHex(lab^.num, 4); Write(":"); WriteLn
+   END;
+   nref := lab^.refs;
+   WHILE nref # NIL DO
+	 fixup(nref^.addr);
+	 nref := nref^.next
+   END;
+   lab^.addr := currAddr
+END SetLabel;
+
+
+PROCEDURE InitGenerator;
+BEGIN
+   currAddr := 0;
+   LNum     := 1;
+END InitGenerator;
+
+
+PROCEDURE Initmnem;
+BEGIN
+   mnem[MSP ] := "MSP "; mnem[LDA ] := "LDA "; mnem[LD	] := "LD  ";
+   mnem[ST  ] := "ST  "; mnem[LDI ] := "LDI "; mnem[LDIs] := "LDIs";
+   mnem[JMP ] := "JMP "; mnem[JMPC] := "JMPC"; mnem[CALL] := "CALL";
+   mnem[RET ] := "RET "; mnem[MV  ] := "MV  "; mnem[NEGi] := "NEGi";
+   mnem[ODDi] := "ODDi"; mnem[ADDi] := "ADDi"; mnem[SUBi] := "SUBi";
+   mnem[MULi] := "MULi"; mnem[DIVi] := "DIVi"; mnem[EQ	] := "EQ  ";
+   mnem[NE  ] := "NE  "; mnem[LT  ] := "LT  "; mnem[GE	] := "GE  ";
+   mnem[GT  ] := "GT  "; mnem[LE  ] := "LE  "; mnem[ANDb] := "ANDb";
+   mnem[ORb ] := "ORb "; mnem[NOTb] := "NOTb"; mnem[INi ] := "INi ";
+   mnem[OUTi] := "OUTi"; mnem[OUTc] := "OUTc";
+END Initmnem;
+
+
+BEGIN
+  Initmnem;
+END Generator.

InternalTree.def

@@ -0,0 +1,137 @@
+DEFINITION MODULE InternalTree; 		(* gf	3.8.88 *)
+
+FROM	Scanner IMPORT IDENT, STRING, POSITION;
+
+(*EXPORT QUALIFIED BLCK,	  DECL,     STMT,     EXPR,
+		 blckPtr, declPtr,  stmtPtr,  exprPtr,
+			  declKind, stmtKind, exprKind,
+		 monOperator, dyOperator, conType,
+		 NewDeclSequence, NewStmtSequence, NewExprSequence,
+		 NoDeclaration,   NoStatement,	   NoExpression;
+*)
+
+
+TYPE declKind = (nodeclaration, declsequence,
+		 typeident,
+		 constdecl, vardecl,
+		 procdecl);
+
+     stmtKind = (nostatement, stmtsequence,
+		 assign, call, read, write, if, while);
+
+     exprKind = (noexpression, exprsequence,
+		 identifier, immediatevalue, string,
+		 monadic, dyadic);
+
+     monOperator = (odd, neg, not);
+
+     dyOperator  = ( greaterequal, plus, minus, times, divides,
+		     equal, notequal, less, greater, lessequal,
+		     and, or);
+
+     conType	 = (int, bool);
+
+     blckPtr	= POINTER TO BLCK;
+     declPtr	= POINTER TO DECL;
+     stmtPtr	= POINTER TO STMT;
+     exprPtr	= POINTER TO EXPR;
+
+
+     BLCK = RECORD
+	       position 	: POSITION;
+	       declarations	: declPtr;
+	       statements	: stmtPtr;
+	    END;
+
+
+     DECL = RECORD
+	       position : POSITION;
+	       CASE kind : declKind OF
+		 nodeclaration:
+	       | declsequence:
+		   first	: declPtr;
+		   rest 	: declPtr
+	       | typeident:
+		   typeId	: IDENT
+	       | constdecl:
+		   constId	: IDENT;
+		   constVal	: CARDINAL
+	       | vardecl:
+		   varId	: IDENT;
+		   varType	: declPtr
+	       | procdecl:
+		   procId	: IDENT;
+		   body 	: blckPtr
+	       END
+	    END;
+
+     STMT = RECORD
+	       position : POSITION;
+	       CASE kind : stmtKind OF
+		 nostatement:
+	       | stmtsequence:
+		   first	: stmtPtr;
+		   rest 	: stmtPtr
+	       | assign:
+		   target	: exprPtr;
+		   source	: exprPtr
+	       | call:
+		   callId	: IDENT;
+		   callParams	: exprPtr
+	       | read:
+		   inVar	: exprPtr
+	       | write:
+		   outVal	: exprPtr
+	       | if:
+		   choice	: exprPtr;
+		   thenPart	: stmtPtr;
+		   elsePart	: stmtPtr
+	       | while:
+		   stop 	: exprPtr;
+		   doPart	: stmtPtr
+	       END
+	    END;
+
+
+     EXPR = RECORD
+	       position : POSITION;
+	       CASE kind: exprKind OF
+		 noexpression:
+	       | exprsequence:
+		   first	: exprPtr;
+		   rest 	: exprPtr
+	       | identifier:
+		   usedId	: IDENT;
+		   usedInd	: exprPtr;
+	       | string:
+		   stringPtr	: STRING;
+	       | immediatevalue:
+		   immVal	: CARDINAL;
+		   immType	: conType
+	       | monadic:
+		   monOpr	: monOperator;
+		   arg		: exprPtr
+	       | dyadic:
+		   dyOpr	: dyOperator;
+		   leftArg	: exprPtr;
+		   rightArg	: exprPtr
+	       END
+	    END;
+
+
+
+PROCEDURE NewDeclSequence (p: POSITION): declPtr;
+
+PROCEDURE NewStmtSequence (p: POSITION): stmtPtr;
+
+PROCEDURE NewExprSequence (p: POSITION): exprPtr;
+
+PROCEDURE NoDeclaration   (): declPtr;
+
+PROCEDURE NoStatement	  (): stmtPtr;
+
+PROCEDURE NoExpression	  (): exprPtr;
+
+
+END InternalTree.
+

InternalTree.mod

@@ -0,0 +1,63 @@
+IMPLEMENTATION MODULE InternalTree;
+
+FROM	Storage IMPORT	ALLOCATE;
+FROM	Scanner IMPORT	POSITION;
+
+VAR	nodecl	: declPtr;
+	nostat	: stmtPtr;
+	noexpr	: exprPtr;
+
+PROCEDURE NewDeclSequence(p : POSITION): declPtr;
+VAR t : declPtr;
+BEGIN
+   NEW(t); t^.kind     := declsequence;
+	   t^.first    := NIL;
+	   t^.rest     := NIL;
+	   t^.position := p;
+   RETURN t
+END NewDeclSequence;
+
+PROCEDURE NewStmtSequence(p: POSITION): stmtPtr;
+VAR t : stmtPtr;
+BEGIN
+   NEW(t); t^.kind     := stmtsequence;
+	   t^.first    := NIL;
+	   t^.rest     := NIL;
+	   t^.position := p;
+   RETURN t
+END NewStmtSequence;
+
+PROCEDURE NewExprSequence(p: POSITION): exprPtr;
+VAR t: exprPtr;
+BEGIN
+   NEW(t); t^.kind     := exprsequence;
+	   t^.first    := NIL;
+	   t^.rest     := NIL;
+	   t^.position := p;
+   RETURN t
+END NewExprSequence;
+
+
+
+PROCEDURE NoDeclaration(): declPtr;
+BEGIN
+   RETURN nodecl
+END NoDeclaration;
+
+PROCEDURE NoStatement(): stmtPtr;
+BEGIN
+   RETURN nostat
+END NoStatement;
+
+PROCEDURE NoExpression(): exprPtr;
+BEGIN
+   RETURN noexpr
+END NoExpression;
+
+
+BEGIN
+    NEW(nodecl);	nodecl^.kind := nodeclaration;
+    NEW(nostat);	nostat^.kind := nostatement;
+    NEW(noexpr);	noexpr^.kind := noexpression;
+END InternalTree.
+

Interpreter.def

@@ -0,0 +1,39 @@
+DEFINITION MODULE Interpreter;			(* gf	06.01.89 *)
+
+(*EXPORT QUALIFIED	INSTR,
+			Command, maxlev,
+			Interpret;
+*)
+
+CONST	maxlev = 15;
+
+TYPE	Command = ( MSP,  LDA,	LDI,  LDIs,
+		    JMP,  JMPC, CALL, RET,
+		    LD,   ST,	MV,   NEGi, ODDi,
+		    ADDi, SUBi, MULi, DIVi,
+		    EQ,   NE,	LT,   GE,   GT,   LE,
+		    ANDb, ORb,	NOTb,
+		    INi,  OUTi, OUTc);
+
+	level	 = [0..maxlev];
+
+	instrKind = (instr, val);
+
+	INSTR = RECORD
+		   CASE  :instrKind OF
+		     instr:
+			  cmd : Command;
+			  lev : level;
+			  val : CARDINAL (* address | offset | lit. value *)
+		   | val:
+			  sval: ARRAY[0..5] OF CHAR;  (* string literal *)
+		   END
+		END;
+
+
+
+PROCEDURE Interpret(VAR code : ARRAY OF INSTR);
+
+
+END Interpreter.
+

Interpreter.mod

@@ -0,0 +1,189 @@
+IMPLEMENTATION MODULE Interpreter;		(* gf	05.01.89 *)
+
+FROM	SYSTEM	   	IMPORT WORD;
+FROM	InOut	   	IMPORT 	Read, ReadInt,
+			  				Write, WriteLn, WriteInt, WriteString,
+			  				Done, termCH, EOL;
+IMPORT STextIO, NumberIO;
+
+CONST 
+	stackSize = 1000;
+
+VAR   
+	stack : ARRAY [0..stackSize-1] OF CARDINAL; (* Program Stack *)
+	zeroc : CHAR;
+
+	PROCEDURE ReadLn;
+		VAR c : CHAR;
+	BEGIN
+		c := termCH;
+		WHILE c # EOL DO Read(c) END;
+	END ReadLn;
+
+
+
+	PROCEDURE Interpret(VAR code : ARRAY OF INSTR);
+
+	VAR   PC, BR, SP: CARDINAL;	(* Program-, Base-, Stack-Registers *)
+		IR	: INSTR;	(* Instruction Register *)
+		tmpint	: INTEGER;	(* internal Register	*)
+		i 	: CARDINAL;
+		SR, DR, CR: CARDINAL;	(* internal Registers	*)
+
+
+	PROCEDURE base(l : CARDINAL) : CARDINAL;
+	VAR b1: CARDINAL;
+	BEGIN
+		b1 := BR;
+		WHILE l > 0 DO
+		b1 := stack[b1]; DEC(l)
+		END;
+		RETURN b1
+	END base;
+
+
+	PROCEDURE INTArith(c: Command; op1, op2: INTEGER) : CARDINAL;
+	VAR res : INTEGER;
+	BEGIN
+		CASE c OF
+		ADDi: res :=	 op1  +  op2;
+		| SUBi: res :=	 op1  -  op2;
+		| MULi: res :=	 op1  *  op2;
+		| DIVi: res :=	 op1 DIV op2;
+		| EQ  : res := ORD(op1  =  op2);
+		| NE  : res := ORD(op1  #  op2);
+		| LT  : res := ORD(op1  <  op2);
+		| GE  : res := ORD(op1  >= op2);
+		| GT  : res := ORD(op1  >  op2);
+		| LE  : res := ORD(op1  <= op2);
+		END;
+		RETURN CARDINAL(res)
+	END INTArith;
+
+	BEGIN (* Interpret *)
+		SP := 0; 
+		BR := 1; 
+		PC := 0;
+		stack[1] := 0; 
+		stack[2] := 0; 
+		stack[3] := 0;
+		REPEAT
+			IR := code[PC]; 
+			INC(PC);
+			CASE IR.cmd OF
+				MSP :(* modifiy SP by IR.val *)
+					SP := CARDINAL(INTEGER(SP) + INTEGER(IR.val))
+
+				| LDA :(* load address *)
+					INC(SP);
+					stack[SP] := base(IR.lev) + IR.val
+
+				| LDI :(* load immediate value *)
+					INC(SP); stack[SP] := IR.val;
+
+				| LDIs:(* load immediate string of length 'IR.val' onto stack *)
+					FOR CR := 0 TO IR.val - 1 DO
+						i := CR MOD 6;
+						IF i = 0 THEN
+						IR := code[PC]; INC(PC)
+						END;
+						INC(SP); stack[SP] := ORD(IR.sval[i])
+					END
+
+				| MV  :(* move 'IR.val' words *)
+					SR := stack[SP - 1];
+					DR := stack[SP];
+					CR := IR.val;
+					WHILE CR > 0 DO
+					stack[DR] := stack[SR];
+					INC(DR); INC(SR);
+					DEC(CR)
+					END;
+					DEC(SP, 2)
+
+				| JMP :(* unconditional jump *)
+					PC := IR.val
+
+				| JMPC:(* jump if condition was false *)
+					IF stack[SP] = 0 THEN PC := IR.val END;
+					DEC(SP)
+
+				| CALL:(* generate new block mark and jump to procedure *)
+					stack[SP+1] := base(IR.lev);
+					stack[SP+2] := BR;
+					stack[SP+3] := PC;
+					BR := SP+1;
+					PC := IR.val
+
+				| RET :(* return from procedure *)
+					SP := BR-1;
+					PC := stack[SP+3];
+					BR := stack[SP+2]
+
+				| LD  :(* load value *)
+					stack[SP] := stack[ stack[SP] ]
+
+				| ST  :(* store value *)
+					stack[ stack[SP] ] := stack[SP-1];
+					DEC(SP, 2)
+
+				| NEGi:(* negate top of stack value *)
+					stack[SP] := CARDINAL(-INTEGER(stack[SP]))
+
+				| ODDi:(* yields true if top of stack values was odd, else false *)
+					stack[SP] := ORD(ODD(INTEGER(stack[SP])))
+
+				(*=== integer arithmetic ===*)
+				| ADDi,SUBi,MULi,DIVi,
+				EQ,	NE,
+				LT,	GE,  GT,  LE:
+					DEC(SP);
+					stack[SP] := INTArith(IR.cmd,
+								INTEGER(stack[SP]),
+								INTEGER(stack[SP+1]))
+
+				(*=== boolean operations ===*)
+				| ANDb:DEC(SP);
+					stack[SP] := ORD((stack[SP] > 0) AND (stack[SP+1] > 0))
+
+				| ORb :DEC(SP);
+					stack[SP] := ORD((stack[SP] > 0) OR  (stack[SP+1] > 0))
+
+				| NOTb:stack[SP] := ORD( NOT(stack[SP] > 0))
+
+				(*=== input/output ===*)
+				| INi : (* read integer value onto stack *)
+					INC(SP);
+					STextIO.WriteString('Integer Input >');
+					REPEAT 
+						NumberIO.ReadInt(tmpint);
+					UNTIL tmpint <> 0;
+					IF SP < stackSize THEN
+						stack[SP] := CARDINAL(tmpint);
+					ELSE
+						STextIO.WriteString("Stack overload !"); 
+						STextIO.WriteLn;
+						PC := 0  (* terminate program *)
+					END; 
+					(* ReadLn; *)
+
+				| OUTi: (* write top of stack integer value *)
+					NumberIO.WriteInt(INTEGER(stack[SP]), 7);
+					DEC(SP)
+
+				| OUTc: (* Write top of stack characters *)
+					CR := stack[SP]; DEC(SP);
+					WHILE CR > 0 DO
+						STextIO.WriteChar(CHR(stack[SP]));
+						DEC(SP);
+						DEC(CR)
+					END;
+			END;
+			(* flushing the input buffer*)
+		UNTIL PC = 0;
+	END Interpret;
+
+
+BEGIN
+END Interpreter.
+

Interpreter.newdef

@@ -0,0 +1,46 @@
+DEFINITION MODULE Interpreter;			(* gf	29.7.88 *)
+
+EXPORT QUALIFIED	INSTR,
+		 	Command, maxlev,
+		 	Interpret;
+
+CONST	maxlev = 15;
+
+TYPE	Command  = (LI,  LIS, LAD, CAL, INT, JMP, JPC, MVB, 
+	            RET, NEG, LOD, STO, 
+		    ADD, SUB, MUL, DIv,
+		    EQ,  NE,  LT,  GE,  GT,  LE,
+		    ODd, 
+		    ANd, Or,  NOt,
+		    INP, WRI, WRC);
+
+TYPE	Command  = (MSP,  LDA,  LD,   ST,   LDI   LDIs,
+		    JMP,  JMPC, CALL, RET,  MV,
+	            NEGi, ODDi,
+		    ADDi, SUBi, MULi, DIVi,
+		    EQ,   NE,   LT,   GE,   GT,   LE,
+		    ANDb, ORb,  NOTb,
+		    INi,  OUTi, OUTc);
+
+	level    = [0..maxlev];
+	
+	instrKind = (instr, strval);
+
+	INSTR = RECORD
+		   CASE  instrKind OF
+		     instr:
+			  fct : Command;
+			  lev : level;
+			  val : CARDINAL (* address | offset | lit. value *)
+		   | strval:
+			  par : ARRAY[0..5] OF CHAR;  (* string literal *)
+		   END
+		END;
+
+
+
+PROCEDURE Interpret(VAR code : ARRAY OF INSTR);
+
+
+END Interpreter.
+

Makefile

@@ -0,0 +1,110 @@
+
+compile	=
+
+objects =       PL0.o InternalTree.o Synthesis.o \
+        SyntaxAnalysis.o StringTable.o Scanner.o ObjectTable.o \
+        Interpreter.o Generator.o ErrorHandling.o \
+        CharacterInput.o
+
+
+programs:	symbols objects	 PL0
+		@echo programs up to date
+
+symbols:	InternalTree.sym Synthesis.sym SyntaxAnalysis.sym \
+	StringTable.sym Scanner.sym ObjectTable.sym Interpreter.sym \
+	Generator.sym ErrorHandling.sym CharacterInput.sym 
+		@echo symbols up to date
+
+objects:	PL0.o InternalTree.o Synthesis.o \
+	SyntaxAnalysis.o StringTable.o Scanner.o ObjectTable.o \
+	Interpreter.o Generator.o ErrorHandling.o \
+	CharacterInput.o 
+		@echo objects up to date
+
+PL0:	PL0.o \
+	Scanner.o CharacterInput.o \
+	StringTable.o ObjectTable.o \
+	Synthesis.o InternalTree.o \
+	ErrorHandling.o Generator.o \
+	Interpreter.o SyntaxAnalysis.o 
+		m2c  -e PL0 -o PL0  -lmodula2 -ltermlib
+
+PL0.o:	PL0.mod	 \
+	Scanner.sym SyntaxAnalysis.sym Synthesis.sym Generator.sym \
+	Interpreter.sym InternalTree.sym 
+		m2c $(compile)	PL0.mod
+
+InternalTree.o: InternalTree.mod InternalTree.sym Scanner.sym
+		m2c $(compile)	InternalTree.mod
+
+Synthesis.o:	Synthesis.mod Synthesis.sym \
+	StringTable.sym Scanner.sym \
+ 	InternalTree.sym ErrorHandling.sym Generator.sym ObjectTable.sym 
+		m2c $(compile)	Synthesis.mod
+
+SyntaxAnalysis.o: SyntaxAnalysis.mod	SyntaxAnalysis.sym \
+	Scanner.sym InternalTree.sym \
+	ErrorHandling.sym 
+		m2c $(compile)	SyntaxAnalysis.mod
+
+StringTable.o: StringTable.mod StringTable.sym \
+	Scanner.sym	\
+	ObjectTable.sym
+		m2c $(compile)	StringTable.mod
+
+Scanner.o:	Scanner.mod Scanner.sym ErrorHandling.sym \
+	CharacterInput.sym \
+	StringTable.sym 
+		m2c $(compile)	Scanner.mod
+
+ObjectTable.o: ObjectTable.mod ObjectTable.sym \
+	Synthesis.sym \
+	StringTable.sym Scanner.sym ErrorHandling.sym 
+		m2c $(compile)	ObjectTable.mod
+
+Interpreter.o: Interpreter.mod Interpreter.sym
+		m2c $(compile)	Interpreter.mod
+
+Generator.o:	Generator.mod Generator.sym \
+	Interpreter.sym	
+		m2c $(compile)	Generator.mod
+
+ErrorHandling.o: ErrorHandling.mod ErrorHandling.sym Scanner.sym
+		m2c $(compile)	ErrorHandling.mod
+
+CharacterInput.o: CharacterInput.mod CharacterInput.sym \
+	Scanner.sym
+		m2c $(compile)	CharacterInput.mod
+
+InternalTree.sym: InternalTree.def Scanner.sym 
+		m2c $(compile) InternalTree.def
+
+Synthesis.sym:	Synthesis.def InternalTree.sym
+		m2c $(compile) Synthesis.def
+
+SyntaxAnalysis.sym: SyntaxAnalysis.def InternalTree.sym 
+		m2c $(compile) SyntaxAnalysis.def
+
+StringTable.sym: StringTable.def Scanner.sym ObjectTable.sym
+		m2c $(compile) StringTable.def
+
+Scanner.sym:	Scanner.def  
+		m2c $(compile) Scanner.def
+
+ObjectTable.sym: ObjectTable.def \
+	Scanner.sym Generator.sym 
+		m2c $(compile) ObjectTable.def
+
+Interpreter.sym: Interpreter.def 
+		m2c $(compile) Interpreter.def
+
+Generator.sym:	Generator.def Interpreter.sym 
+		m2c $(compile) Generator.def
+
+ErrorHandling.sym: ErrorHandling.def Scanner.sym 
+		m2c $(compile) ErrorHandling.def
+
+CharacterInput.sym: CharacterInput.def	
+		m2c $(compile) CharacterInput.def
+
+

New-PL0/PL0.mod

@@ -0,0 +1,14 @@
+MODULE PLO;
+(************************************************************)
+(* PL0 interpreter in GNU Modula-2                          *)
+(*    using only ISO Libraries to void mixing               *)
+(* interprets the code generated by PLOc                    *)
+(* Eric Streit <eric@yojik.eu>  May 2026                    *)
+(************************************************************)
+
+
+
+
+BEGIN
+
+END PLO.

New-PL0/PL0c1.mod

@@ -0,0 +1,69 @@
+MODULE PL0c1;
+(************************************************************)
+(* PL0 compiler in GNU Modula-2                             *)
+(*    using only ISO Libraries to void mixing               *)
+(* generates an asm file to be interpreted by PLO executable*)
+(* Eric Streit <eric@yojik.eu>  May 2026                    *)
+(************************************************************)
+
+(* program structure                             *)
+(* read a file with the text program             *)
+(* syntax analysis followed by semantic analysis *)
+(* and code generation                           *)
+
+FROM IOResult   IMPORT ReadResults, ReadResult; 
+FROM TextIO     IMPORT ReadRestLine, SkipLine, ReadToken, WriteLn, WriteString, ReadChar;
+FROM SeqFile IMPORT OpenRead, OpenWrite, OpenResults, Close, ChanId, read, write;
+IMPORT STextIO, SWholeIO;
+
+VAR 
+    theChanId       : ChanId;
+    theResult       : OpenResults; 
+    theChar         : CHAR;
+    theLineNumber   : CARDINAL;
+
+
+BEGIN
+    STextIO.WriteString("PL0 compiler from Wirth book 'Algorithms and Data Structures'");
+    STextIO.WriteLn;
+    STextIO.WriteString("Eric Streit <eric@yojik.eu>");
+    STextIO.WriteLn;
+    STextIO.WriteLn;
+
+    theLineNumber := 1;
+    OpenRead(theChanId, "test1.pl0", read, theResult);
+    IF theResult = noSuchFile THEN
+        STextIO.WriteString("Sorry, this file doesn't exist ; halting");
+        STextIO.WriteLn;
+    ELSE
+        IF theResult=opened THEN 
+            (* file is open*)
+            STextIO.WriteString("file opened!");
+            STextIO.WriteLn;
+            STextIO.WriteLn;
+            (* reading a char*)
+            ReadChar(theChanId, theChar);
+            (* testing the result *)
+            (* if OK we continue *)
+            WHILE ReadResult(theChanId) <> endOfInput DO 
+                (* testing end of line *)
+                IF ReadResult(theChanId) = endOfLine THEN
+                    INC(theLineNumber);
+                    (* we have to 'skip' the endOfLine ... so strange *)
+                    SkipLine(theChanId);
+                END;
+                (* printing the char*)
+                STextIO.WriteChar(theChar);
+                (* reading next char *)
+                ReadChar(theChanId, theChar);
+            END;
+            Close(theChanId);
+        ELSE
+            STextIO.WriteString("Error");
+            STextIO.WriteLn;
+        END;
+    END;
+    
+
+END PL0c1.
+

New-PL0/PL0c2.mod

@@ -0,0 +1,81 @@
+MODULE PL0c2;
+(************************************************************)
+(* PL0 compiler in GNU Modula-2                             *)
+(*    using only ISO Libraries to void mixing               *)
+(* generates an asm file to be interpreted by PLO executable*)
+(* Eric Streit <eric@yojik.eu>  May 2026                    *)
+(************************************************************)
+
+(* program structure                             *)
+(* read a file with the text program             *)
+(* syntax analysis followed by semantic analysis *)
+(* and code generation                           *)
+
+FROM IOResult   IMPORT ReadResults, ReadResult; 
+FROM TextIO     IMPORT ReadRestLine, SkipLine, ReadToken, WriteLn, WriteString, ReadChar;
+FROM SeqFile IMPORT OpenRead, OpenWrite, OpenResults, Close, ChanId, read, write;
+IMPORT STextIO, SWholeIO, Strings;
+
+VAR 
+    theChanId       : ChanId;
+    theResult       : OpenResults; 
+    theChar         : CHAR;
+    theLineNumber   : CARDINAL;
+    theFileName     : ARRAY[0..128] OF CHAR;
+
+
+BEGIN
+    STextIO.WriteString("PL0 compiler from Wirth book 'Algorithms and Data Structures'");
+    STextIO.WriteLn;
+    STextIO.WriteString("Eric Streit <eric@yojik.eu>");
+    STextIO.WriteLn;
+    STextIO.WriteLn;
+
+    (* adding the file name input *)
+    theFileName := "";
+    STextIO.WriteString("Enter the file name (ENTER to leave): ");
+    STextIO.ReadString(theFileName);
+    STextIO.WriteString(theFileName);
+    IF Strings.Length(theFileName) = 0 THEN
+        STextIO.WriteString("Leaving .... bye ! ");
+        STextIO.WriteLn;
+        HALT
+    END; 
+
+    theLineNumber := 1;
+    OpenRead(theChanId, "test1.pl0", read, theResult);
+    IF theResult = noSuchFile THEN
+        STextIO.WriteString("Sorry, this file doesn't exist ; halting");
+        STextIO.WriteLn;
+    ELSE
+        IF theResult=opened THEN 
+            (* file is open*)
+            STextIO.WriteString("file opened!");
+            STextIO.WriteLn;
+            STextIO.WriteLn;
+            (* reading a char*)
+            ReadChar(theChanId, theChar);
+            (* testing the result *)
+            (* if OK we continue *)
+            WHILE ReadResult(theChanId) <> endOfInput DO 
+                (* testing end of line *)
+                IF ReadResult(theChanId) = endOfLine THEN
+                    INC(theLineNumber);
+                    (* we have to 'skip' the endOfLine ... so strange *)
+                    SkipLine(theChanId);
+                END;
+                (* printing the char*)
+                STextIO.WriteChar(theChar);
+                (* reading next char *)
+                ReadChar(theChanId, theChar);
+            END;
+            Close(theChanId);
+        ELSE
+            STextIO.WriteString("Error");
+            STextIO.WriteLn;
+        END;
+    END;
+    
+
+END PL0c2.
+

New-PL0/PL0c3.mod

@@ -0,0 +1,98 @@
+MODULE PL0c3;
+(************************************************************)
+(* PL0 compiler in GNU Modula-2                             *)
+(*    using only ISO Libraries to void mixing               *)
+(* generates an asm file to be interpreted by PLO executable*)
+(* Eric Streit <eric@yojik.eu>  May 2026                    *)
+(************************************************************)
+
+(* program structure                             *)
+(* read a file with the text program             *)
+(* syntax analysis followed by semantic analysis *)
+(* and code generation                           *)
+
+FROM IOResult   IMPORT ReadResults, ReadResult; 
+FROM TextIO     IMPORT ReadRestLine, SkipLine, ReadToken, WriteLn, WriteString, ReadChar;
+FROM SeqFile IMPORT OpenRead, OpenWrite, OpenResults, Close, ChanId, read, write;
+IMPORT STextIO, SWholeIO, Strings;
+
+VAR 
+    theChanId       : ChanId;
+    theResult       : OpenResults; 
+    theChar         : CHAR;
+    theLineNumber   : CARDINAL;
+    theFileName     : ARRAY[0..128] OF CHAR;
+    thelength       : CARDINAL;
+
+
+BEGIN
+    STextIO.WriteString("PL0 compiler from Wirth book 'Algorithms and Data Structures'");
+    STextIO.WriteLn;
+    STextIO.WriteString("Eric Streit <eric@yojik.eu>");
+    STextIO.WriteLn;
+    STextIO.WriteLn;
+
+    (* adding the file name input *)
+    theFileName := "";
+    STextIO.WriteString("Enter the file name (ENTER to leave)(with an ending '.' to add automatcally the extension) : ");
+    STextIO.ReadString(theFileName);
+    (* STextIO.WriteString(theFileName); *)
+    thelength := Strings.Length(theFileName);
+    IF thelength = 0 THEN
+        STextIO.WriteString("Leaving .... bye ! ");
+        STextIO.WriteLn;
+        HALT
+    ELSE 
+        (* adding extension if the name ends by . )*)
+        IF theFileName[thelength-1] = "." THEN
+            (* adding extension if enough space*)
+            IF thelength < 125 THEN
+                Strings.Concat(theFileName, "pl0", theFileName);
+            ELSE
+                STextIO.WriteString("File name too long");
+                STextIO.WriteLn;
+                STextIO.WriteString("Halting");
+                HALT;
+            END;
+        END;
+    END; 
+    STextIO.WriteString(theFileName);
+    STextIO.WriteLn;
+
+    theLineNumber := 1;
+    OpenRead(theChanId, "test1.pl0", read, theResult);
+    IF theResult = noSuchFile THEN
+        STextIO.WriteString("Sorry, this file doesn't exist ; halting");
+        STextIO.WriteLn;
+    ELSE
+        IF theResult=opened THEN 
+            (* file is open*)
+            STextIO.WriteString("file opened!");
+            STextIO.WriteLn;
+            STextIO.WriteLn;
+            (* reading a char*)
+            ReadChar(theChanId, theChar);
+            (* testing the result *)
+            (* if OK we continue *)
+            WHILE ReadResult(theChanId) <> endOfInput DO 
+                (* testing end of line *)
+                IF ReadResult(theChanId) = endOfLine THEN
+                    INC(theLineNumber);
+                    (* we have to 'skip' the endOfLine ... so strange *)
+                    SkipLine(theChanId);
+                END;
+                (* printing the char*)
+                STextIO.WriteChar(theChar);
+                (* reading next char *)
+                ReadChar(theChanId, theChar);
+            END;
+            Close(theChanId);
+        ELSE
+            STextIO.WriteString("Error");
+            STextIO.WriteLn;
+        END;
+    END;
+    
+
+END PL0c3.
+

New-PL0/PL0c4.mod

@@ -0,0 +1,111 @@
+MODULE PL0c4;
+(************************************************************)
+(* PL0 compiler in GNU Modula-2                             *)
+(*    using only ISO Libraries to void mixing               *)
+(* generates an asm file to be interpreted by PLO executable*)
+(* Eric Streit <eric@yojik.eu>  May 2026                    *)
+(************************************************************)
+
+(* program structure                             *)
+(* read a file with the text program             *)
+(* syntax analysis followed by semantic analysis *)
+(* and code generation                           *)
+
+FROM IOResult   IMPORT ReadResults, ReadResult; 
+FROM TextIO     IMPORT ReadRestLine, SkipLine, ReadToken, WriteLn, WriteString, ReadChar;
+FROM SeqFile IMPORT OpenRead, OpenWrite, OpenResults, Close, ChanId, read, write;
+IMPORT STextIO, SWholeIO, Strings, ProgramArgs, TextIO;
+
+VAR 
+    theChanId       : ChanId;
+    theResult       : OpenResults; 
+    theChar         : CHAR;
+    theLineNumber   : CARDINAL;
+    theFileName     : ARRAY[0..128] OF CHAR;
+    thelength       : CARDINAL;
+    theArgChanId    : ChanId;  
+    theArgument     : ARRAY [0..20] OF CHAR;
+
+
+BEGIN
+    STextIO.WriteString("PL0 compiler from Wirth book 'Algorithms and Data Structures'");
+    STextIO.WriteLn;
+    STextIO.WriteString("Eric Streit <eric@yojik.eu>");
+    STextIO.WriteLn;
+    STextIO.WriteLn;
+
+    (* testing command line arguments*)
+    (* are there any arguments?*)
+    theArgChanId := ProgramArgs.ArgChan ();
+    WHILE ProgramArgs.IsArgPresent() DO
+        TextIO.ReadToken(ProgramArgs.ArgChan(), theArgument);
+        STextIO.WriteString(theArgument);
+        STextIO.WriteLn;
+        ProgramArgs.NextArg ();
+    END;
+
+
+    (* adding the file name input *)
+    theFileName := "";
+    STextIO.WriteString("Enter the file name (ENTER to leave)(with an ending '.' to add automatcally the extension) : ");
+    STextIO.ReadString(theFileName);
+    (* STextIO.WriteString(theFileName); *)
+    thelength := Strings.Length(theFileName);
+    IF thelength = 0 THEN
+        STextIO.WriteString("Leaving .... bye ! ");
+        STextIO.WriteLn;
+        HALT
+    ELSE 
+        (* adding extension if the name ends by . )*)
+        IF theFileName[thelength-1] = "." THEN
+            (* adding extension if enough space*)
+            IF thelength < 125 THEN
+                Strings.Concat(theFileName, "pl0", theFileName);
+            ELSE
+                STextIO.WriteString("File name too long");
+                STextIO.WriteLn;
+                STextIO.WriteString("Halting");
+                HALT;
+            END;
+        END;
+    END; 
+    STextIO.WriteString(theFileName);
+    STextIO.WriteLn;
+
+    theLineNumber := 1;
+    OpenRead(theChanId, "test1.pl0", read, theResult);
+    IF theResult = noSuchFile THEN
+        STextIO.WriteString("Sorry, this file doesn't exist ; halting");
+        STextIO.WriteLn;
+    ELSE
+        IF theResult=opened THEN 
+            (* file is open*)
+            STextIO.WriteString("file opened!");
+            STextIO.WriteLn;
+            STextIO.WriteLn;
+            (* reading a char*)
+            ReadChar(theChanId, theChar);
+            (* testing the result *)
+            (* if OK we continue *)
+            WHILE ReadResult(theChanId) <> endOfInput DO 
+                (* testing end of line *)
+                IF ReadResult(theChanId) = endOfLine THEN
+                    INC(theLineNumber);
+                    (* we have to 'skip' the endOfLine ... so strange *)
+                    SkipLine(theChanId);
+                END;
+                (* printing the char*)
+                STextIO.WriteChar(theChar);
+                (* reading next char *)
+                ReadChar(theChanId, theChar);
+            END;
+            Close(theChanId);
+        ELSE
+            STextIO.WriteString("Error");
+            STextIO.WriteLn;
+        END;
+    END;
+    
+
+END PL0c4.
+

ObjectTable.def

@@ -0,0 +1,62 @@
+DEFINITION MODULE ObjectTable;		(* gf  03.08.88 (pl0) *)
+
+FROM Scanner   IMPORT IDENT, STRING, POSITION;
+FROM Generator IMPORT Label;
+
+(*EXPORT QUALIFIED Object, ObjKind, ObjType,
+		 Undefined, Integer,
+		 EnterBlock, LeaveBlock,
+		 EnterDecl, FindDecl, GetObjType,
+		 InitObjectTable;
+*)
+
+
+TYPE Object   = POINTER TO Objectvalue;
+
+TYPE ObjType  = Object;
+
+TYPE ObjKind  = (newObject, undefined,
+		 simpleType,
+		 constant, stringConst,
+		 variable,
+		 procedure,
+		 block);
+
+TYPE Objectvalue =
+	     RECORD
+		id	: IDENT;
+		nextObj : Object;
+		level	: CARDINAL;
+		CASE kind : ObjKind OF
+		  newObject:
+		| undefined:
+		| simpleType:
+		| constant:
+			cType	: Object;
+			cVal	: CARDINAL
+		| stringConst:
+			strVal	: STRING;
+		| variable:
+			vType	: Object;
+			vAdr	: CARDINAL
+		| procedure:
+			procAdr : Label;
+		| block:
+			lastObj,
+			down	: Object;
+		END
+	     END;
+
+VAR Undefined : ObjType;
+    Integer   : ObjType;
+
+
+PROCEDURE EnterDecl  (id: IDENT; pos: POSITION) : Object;
+PROCEDURE FindDecl   (id: IDENT; pos: POSITION) : Object;
+PROCEDURE GetObjType (obj : Object)		: ObjType;
+
+PROCEDURE EnterBlock(): CARDINAL;	(* retuns nesting level *)
+PROCEDURE LeaveBlock(): CARDINAL;	(*	    "           *)
+PROCEDURE InitObjectTable(): CARDINAL;	(*	    "           *)
+
+END ObjectTable.

ObjectTable.mod

@@ -0,0 +1,149 @@
+IMPLEMENTATION MODULE ObjectTable;		(* gf  27.04.89 (pl0) *)
+
+FROM Storage		IMPORT ALLOCATE;
+
+FROM Synthesis		IMPORT SemanticError;
+FROM StringTable	IMPORT InsertIdent, SameId;
+FROM Scanner		IMPORT IDENT, POSITION, dummyPosition;
+FROM ErrorHandling	IMPORT PrintError2;
+
+
+
+
+CONST maxlev = 15;
+
+VAR  curlev    : CARDINAL;
+     undef     : Object;
+     topScope  : Object;
+
+
+PROCEDURE Error(n : CARDINAL; p : POSITION);
+BEGIN
+   SemanticError := TRUE;  PrintError2(n, p)
+END Error;
+
+
+PROCEDURE EnterDecl(id: IDENT; pos: POSITION): Object;
+VAR obj : Object;
+BEGIN
+   (* check for multiple definition *)
+   obj := topScope^.nextObj;
+   WHILE obj # NIL DO
+	IF SameId(id, obj^.id) THEN
+	   Error(25, pos);
+	   RETURN undef
+	END;
+	obj := obj^.nextObj
+   END;
+
+   (* now enter new object into list *)
+   NEW(obj);
+   obj^.id := id;
+   WITH obj^ DO
+	level	:= curlev;
+	kind	:= newObject;
+	nextObj := NIL
+   END;
+   topScope^.lastObj^.nextObj := obj;
+   topScope^.lastObj := obj;
+   RETURN obj
+END EnterDecl;
+
+
+
+PROCEDURE FindDecl(id : IDENT; pos : POSITION) : Object;
+VAR hd, obj : Object;
+BEGIN
+   hd := topScope;
+   WHILE hd # NIL DO
+	obj := hd^.nextObj;
+	WHILE obj # NIL DO
+	   IF SameId(id, obj^.id) THEN
+	      RETURN obj
+	   ELSE
+	      obj := obj^.nextObj;
+	   END
+	END;
+	hd := hd^.down;
+   END;
+   Error(11, pos);
+   RETURN undef
+END FindDecl;
+
+
+PROCEDURE GetObjType(obj : Object) : ObjType;
+BEGIN
+   CASE obj^.kind OF
+     undefined	   : RETURN Undefined
+   | simpleType    : RETURN ObjType(obj)
+   | constant	   : RETURN ObjType(obj^.cType)
+   | variable	   : RETURN ObjType(obj^.vType)
+   ELSE
+      RETURN Undefined
+   END
+END GetObjType;
+
+
+PROCEDURE EnterBlock(): CARDINAL;
+VAR hd : Object;
+BEGIN
+   INC(curlev);
+   NEW(hd);
+   WITH hd^ DO
+	kind	:= block;
+	nextObj := NIL;
+	lastObj := hd;
+	id	:= IDENT(0);
+	down	:= topScope
+   END;
+   topScope := hd;
+   RETURN curlev
+END EnterBlock;
+
+
+PROCEDURE LeaveBlock(): CARDINAL;
+VAR Obj : Object;
+BEGIN
+   topScope := topScope^.down;
+   DEC(curlev);
+   RETURN curlev
+END LeaveBlock;
+
+
+PROCEDURE InitObjectTable(): CARDINAL;
+VAR i	: CARDINAL;
+VAR obj : Object;
+VAR hd	: Object;
+BEGIN
+   curlev := 0;
+
+   NEW(hd);
+   WITH hd^ DO
+	kind	:= block;
+	nextObj := NIL;
+	lastObj := hd;
+	(* id	:= IDENT(0); *)
+   id	:= 0;
+	down	:= NIL
+   END;
+   topScope := hd;
+
+   obj := EnterDecl(InsertIdent("INTEGER"), dummyPosition);
+	  obj^.kind  := simpleType;
+
+   Integer := obj;
+
+   RETURN curlev
+END InitObjectTable;
+
+
+BEGIN
+    NEW(undef);
+    WITH undef^ DO
+	 id	 := -1;
+	 nextObj := NIL;
+	 level	 := 0;
+	 kind	 := undefined;
+    END;
+    Undefined := ObjType(undef);
+END ObjectTable.

PL0.mod

@@ -0,0 +1,111 @@
+MODULE PL0;
+
+FROM	InOut	IMPORT	Read, ReadString,
+						Write, WriteString, WriteLn,
+						OpenInput, CloseInput,
+						Done;
+
+FROM	SyntaxAnalysis	IMPORT	parse, SyntaxError;
+FROM	Synthesis		IMPORT	traverse, SemanticError;
+FROM	Generator		IMPORT	CodeStore;
+FROM	Interpreter		IMPORT	Interpret;
+FROM	InternalTree	IMPORT	blckPtr;
+
+IMPORT STextIO,FIO;
+FROM Strings IMPORT Length;
+
+VAR 
+	InputFileName 	: ARRAY[0..40] OF CHAR;
+    TREE 			: blckPtr;
+    c 				: CHAR;
+	DEBUG 			: BOOLEAN;
+	jamais			: CARDINAL;
+
+	PROCEDURE ReadLn(VAR c: CHAR);
+		VAR lc : CHAR;
+	BEGIN
+		REPEAT
+			Read(c)
+		UNTIL c > ' ';
+		REPEAT
+			Read(lc)
+		UNTIL (lc = 12C) OR (lc = 15C)
+	END ReadLn;
+
+	PROCEDURE ApendExtension;
+		VAR i : CARDINAL;
+	BEGIN
+		i := 0;
+		LOOP
+			IF InputFileName[i] = 0C THEN
+			InputFileName[i] := '.'; 
+			INC(i);
+			InputFileName[i] := 'p'; 
+			INC(i);
+			InputFileName[i] := 'l'; 
+			INC(i);
+			InputFileName[i] := '0'; 
+			INC(i);
+			InputFileName[i] := 0C;
+			EXIT
+			END;
+			IF (InputFileName[i] = '.') OR (i = 40) THEN EXIT END;
+			INC(i)
+		END
+	END ApendExtension;
+
+BEGIN
+	DEBUG := TRUE;
+	STextIO.WriteString("PL0 Compiler/Interpreter"); 
+	WriteLn;
+	STextIO.WriteString("First implementation by : "); 
+	WriteLn;
+	STextIO.WriteString("First Working Version : Eric Streit <eric@yojik.eu> 18/05/2026"); 
+	WriteLn;
+	LOOP
+		InputFileName := "";
+		Done := FALSE;
+		STextIO.WriteLn;
+		STextIO.WriteString("Entrez le nom de fichier PL0 > ");
+		OpenInput("pl0");
+		IF DEBUG THEN
+			STextIO.WriteString("***");
+			IF Done THEN 
+				WriteString("TRUE");
+			END;
+			STextIO.WriteString("***");
+			STextIO.WriteLn;
+		END;
+		IF Done THEN
+			STextIO.WriteLn;
+			STextIO.WriteString("Syntactic Analyser"); 
+			STextIO.WriteLn;
+			TREE := parse();
+			CloseInput;		(* read again from standard input *)
+			IF NOT SyntaxError THEN
+				STextIO.WriteLn;
+				STextIO.WriteString("Semantic Analysis und Code Generation"); 
+				STextIO.WriteLn;
+				traverse(TREE);
+				IF NOT SemanticError THEN
+					REPEAT
+						STextIO.WriteLn;
+						STextIO.WriteString("Programm translation and run (y/n) ?");
+						STextIO.ReadChar(c);
+						IF c = "y" THEN
+							STextIO.WriteLn;
+							Interpret(CodeStore)
+						ELSE
+							HALT
+						END
+					UNTIL c = 'n'
+				END
+			END
+		ELSE
+			Write("'");
+			WriteString(InputFileName); WriteString("' not found");
+			WriteLn
+		END;
+	END; (* loop *)
+	
+END PL0.

Scanner.def

@@ -0,0 +1,68 @@
+DEFINITION MODULE Scanner;		(* gf  05.01.89 (pl0) *)
+
+
+(* EXPORT QUALIFIED SYMBOL, IDENT, STRING, POSITION,
+		 dummyPosition,
+		 sym, id, num, pos, strp,
+		 GetSymbol,
+		 printCode, traceParser, printListing, optimize,
+		 InitScanner;
+*)
+
+
+TYPE SYMBOL =	(sNull, sPeriod,
+		 sRBracket, sLBracket,
+		 sTimes, sDiv,
+		 sPlus, sMinus,
+		 sEQ, sNE, sLT, sLE, sGT, sGE,
+		 sAnd, sOr,
+		 sComma, sRParen, sThen, sDo, sBecomes,
+		 (* start formula --------------------------------*)
+		 sLParen, sOdd, sNot, sNumber, sString,
+		 (* start Statement ------------------------------*)
+		 sIdent, sCall, sIf, sWhile, sRead, sWrite,
+		 (* end   Statement ------------------------------*)
+		 sEnd, sElsif, sElse, sSemicolon,
+		 (* sArray, sOf, *) sColon,
+		 (* start declarations or statementpart ----------*)
+		 sBegin, sType, sConst, sVar, sProcedure,
+		 sEof);
+
+TYPE IDENT  = INTEGER;
+
+TYPE STRING = POINTER TO ARRAY[0..99] OF CHAR;
+
+TYPE POSITION = RECORD		(* position in source text *)
+		  line, column : CARDINAL
+		END;
+
+
+VAR sym : SYMBOL;	(* last symbol read			*)
+    id	: IDENT;	(* identifier number			*)
+    num : CARDINAL;	(* last number read			*)
+    strp: STRING;	(* pointer to string read		*)
+    pos : POSITION;	(* current position in source text	*)
+
+    dummyPosition    : POSITION;
+
+
+
+VAR printCode,
+    traceParser,
+    optimize,
+    printListing  : BOOLEAN;
+
+    noPosition	  : POSITION;
+
+
+
+
+
+
+PROCEDURE GetSymbol;	(* get next symbol;
+			 * results: sym, id, num, strp, pos
+			 *)
+
+PROCEDURE InitScanner;
+
+END Scanner.

Scanner.mod

@@ -0,0 +1,201 @@
+IMPLEMENTATION MODULE Scanner;		(* gf  01.06.89 (pl0) *)
+
+FROM	CharacterInput	IMPORT	ch, GetCh, EOF,
+				endOfInput, currLine, currCol,
+				InitInput;
+FROM	StringTable	IMPORT	InitStringTable, EnterKeyWord,
+				InsertIdent, IdKind;
+FROM	ErrorHandling	IMPORT	PrintError1;
+FROM InOut IMPORT Write, WriteInt, WriteLn;
+
+IMPORT	SYSTEM;
+
+
+CONST maxCard = 177777B;
+      maxLine = 120;
+      LF      = 12C;
+      HT      = 11C;
+
+
+VAR string    : ARRAY[0..200] OF CHAR;
+
+
+
+
+PROCEDURE Identifier;
+   VAR k : CARDINAL;
+BEGIN
+   k := 0;
+   REPEAT
+	string[k] := ch; INC(k);
+	GetCh
+   UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch));
+   string[k] :=  0C;
+   id  := InsertIdent(string);
+   sym := IdKind(id);
+END Identifier;
+
+
+PROCEDURE Number;
+   VAR i, j, k, d : CARDINAL;
+       dig	  : ARRAY[0..31] OF CHAR;
+BEGIN
+   sym := sNumber; i := 0;
+   REPEAT
+      dig[i] := ch; i := i + 1; GetCh;
+   UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch));
+   j := 0; k := 0;
+   REPEAT
+	d := ORD(dig[j]) - 60B;
+	IF (d < 10) & ((maxCard - d) DIV 10 >= k) THEN
+	   k := 10 * k + d
+	ELSE
+	   pos.line    := currLine;
+	   pos.column  := currCol;
+	   PrintError1(58, pos);
+	   k := 0
+	END;
+	INC(j)
+   UNTIL j = i;
+   num := k
+END Number;
+
+
+PROCEDURE GetSymbol;
+
+   PROCEDURE Comment;
+   BEGIN
+      GetCh;
+      IF ch = '$' THEN
+	 GetCh;
+	 IF ch = 'C' THEN
+	    GetCh; printCode	:=  ch = '+'
+	 ELSIF ch = 'T' THEN
+	    GetCh; traceParser	:=  ch = '+'
+	 ELSIF ch = 'L' THEN
+	    GetCh; printListing :=  ch = '+'
+	 ELSIF ch = 'O' THEN
+	    GetCh; optimize	:=  ch = '+'
+	 END
+      END;
+      REPEAT
+	 WHILE (ch # "*") AND NOT endOfInput DO GetCh END;
+	 GetCh
+      UNTIL (ch = ")") OR endOfInput;
+      GetCh
+   END Comment;
+
+BEGIN
+   LOOP
+	(* ignore control characters *)
+	IF ch = EOF THEN
+	   EXIT
+	ELSIF ch <= " " THEN
+	   GetCh
+	ELSIF ch >= 177C THEN
+	   GetCh
+	ELSE EXIT
+	END
+   END;
+
+   pos.line := currLine; pos.column  := currCol;
+
+   CASE ch OF (* " " <= ch < 177C *)
+      EOF : sym := sEof;
+    | "!" : sym := sWrite; GetCh
+    | '"' : sym := sNull;  GetCh
+    | "#" : sym := sNE;    GetCh
+    | "$" : sym := sNull;  GetCh
+    | "%" : sym := sNull;  GetCh
+    | "&" : sym := sNull;  GetCh
+    | "(" : GetCh;
+	    IF ch = "*" THEN
+	       Comment; GetSymbol
+	    ELSE
+	      sym := sLParen
+	    END
+    | ")" : sym := sRParen; GetCh
+    | "*" : sym := sTimes;  GetCh
+    | "+" : sym := sPlus;   GetCh
+    | "," : sym := sComma;  GetCh
+    | "-" : sym := sMinus;  GetCh
+    | "." : sym := sPeriod; GetCh
+    | "/" : sym := sDiv;    GetCh
+    | "0".."9" :
+	    Number
+    | ":" : GetCh;
+	    IF ch = "=" THEN
+	       GetCh; sym := sBecomes
+	    ELSE
+	       sym := sColon
+	    END
+    | ";" : sym := sSemicolon; GetCh
+    | "<" : GetCh;
+	    IF ch = "=" THEN
+	       GetCh; sym := sLE
+	    ELSE
+	       sym := sLT
+	    END
+    | "=" : sym := sEQ; GetCh
+    | ">" : GetCh;
+	    IF ch = "=" THEN
+	       GetCh; sym := sGE
+	    ELSE
+	       sym := sGT
+	    END
+    | "?" : sym := sRead; GetCh
+    | "@" : sym := sNull; GetCh
+    | "A".."Z": Identifier
+    | "a".."z": Identifier
+    | "[" : sym := sLBracket; GetCh
+    | "]" : sym := sRBracket; GetCh
+   ELSE
+	    sym := sNull; GetCh
+   END;
+ Write("<"); WriteInt(ORD(sym), 1); Write('>'); WriteLn;
+END GetSymbol;
+
+
+PROCEDURE ResetOptions;
+BEGIN
+   printCode	:= FALSE;
+   traceParser	:= FALSE;
+   optimize	:= FALSE;
+   printListing := TRUE
+END ResetOptions;
+
+
+PROCEDURE InitScanner;
+BEGIN
+   InitInput;
+   ch := " ";
+   ResetOptions;
+   InitStringTable;
+
+   EnterKeyWord (sDo,	     "DO");
+   EnterKeyWord (sIf,	     "IF");
+(* EnterKeyWord (sOf,	     "OF");	*)
+   EnterKeyWord (sOr,	     "OR");
+   EnterKeyWord (sAnd,	     "AND");
+   EnterKeyWord (sEnd,	     "END");
+   EnterKeyWord (sNot,	     "NOT");
+   EnterKeyWord (sOdd,	     "ODD");
+   EnterKeyWord (sVar,	     "VAR");
+   EnterKeyWord (sCall,      "CALL");
+   EnterKeyWord (sElse,      "ELSE");
+   EnterKeyWord (sThen,      "THEN");
+(* EnterKeyWord (sType,      "TYPE");	*)
+(* EnterKeyWord (sArray,     "ARRAY");	*)
+   EnterKeyWord (sBegin,     "BEGIN");
+   EnterKeyWord (sConst,     "CONST");
+   EnterKeyWord (sElsif,     "ELSIF");
+   EnterKeyWord (sWhile,     "WHILE");
+   EnterKeyWord (sProcedure, "PROCEDURE");
+END InitScanner;
+
+
+BEGIN
+   dummyPosition.line	:= 0;
+   dummyPosition.column := 0;
+END Scanner.
+

StringTable.def

@@ -0,0 +1,24 @@
+DEFINITION MODULE StringTable;		(* gf 01.12.88 (pl0) *)
+
+FROM Scanner IMPORT SYMBOL, IDENT, STRING;
+FROM ObjectTable IMPORT Object;
+
+(* EXPORT QUALIFIED InsertIdent, IdKind, SameId,
+		 EnterKeyWord, InitStringTable;
+*)
+
+
+PROCEDURE InsertIdent(s: ARRAY OF CHAR) : IDENT;
+
+PROCEDURE IdKind(id: IDENT): SYMBOL;
+
+PROCEDURE IdString(id: IDENT; VAR s: ARRAY OF CHAR);
+
+PROCEDURE SameId(id1, id2: IDENT): BOOLEAN;
+
+PROCEDURE EnterKeyWord(s: SYMBOL; name: ARRAY OF CHAR);
+
+PROCEDURE InitStringTable;
+
+END StringTable.
+

StringTable.mod

@@ -0,0 +1,127 @@
+IMPLEMENTATION MODULE StringTable;		(* gf  01.11.88 (pl0) *)
+
+FROM Scanner IMPORT SYMBOL, IDENT;
+
+CONST bufLen = 1000;
+      maxId  = 200;
+
+VAR id, id1 : CARDINAL; 	(* indices to identifier buffer *)
+
+
+    buf      : ARRAY[0..bufLen-1] OF CHAR;
+			(* character buffer; identifiers are stored with
+			   leading length *)
+
+    idKinds  : ARRAY [0..maxId] OF
+			RECORD
+			  ind: CARDINAL; (* index into buf *)
+			  sym: SYMBOL
+			END;
+
+    K	     : CARDINAL;	(* no of key words *)
+    nIds     : CARDINAL;	(* no of identifiers (incl. key words) *)
+
+
+
+
+
+PROCEDURE Diff(u, v : CARDINAL): INTEGER;
+VAR w : CARDINAL;
+BEGIN
+   w := ORD(buf[u]);
+   LOOP
+	IF w = 0 THEN RETURN 0 END;
+	IF buf[u] # buf[v] THEN
+	   RETURN INTEGER(ORD(buf[u])) - INTEGER(ORD(buf[v]))
+	ELSE
+	   INC(u); INC(v); DEC(w)
+	END
+   END
+END Diff;
+
+
+
+PROCEDURE InsertIdent(s: ARRAY OF CHAR): IDENT;
+   VAR i, k, l, m : CARDINAL;
+       d : INTEGER;
+BEGIN
+   id1 := id + 1; l := 0;
+   REPEAT
+      buf[id1] := s[l]; INC(id1); INC(l);
+   UNTIL (l > HIGH(s)) OR (s[l] = 0C);
+   buf[id] :=  CHR(id1 - id );
+   buf[id1] := 0C; INC(id1);
+
+   k := 1; l := K;
+   REPEAT
+	m := (k + l) DIV 2;
+	d := Diff(id, idKinds[m].ind);
+	IF d <= 0 THEN l := m - 1 END;
+	IF d >= 0 THEN k := m + 1 END;
+   UNTIL k > l;
+   IF k > l + 1 THEN
+	RETURN IDENT(m) 	(* is a key word *)
+   ELSE
+	(* don't store it twice if it already exists *)
+	FOR i := K+1 TO nIds DO
+	    IF Diff(id, idKinds[i].ind) = 0 THEN RETURN IDENT(i) END
+	END;
+	INC(nIds);
+	WITH idKinds[nIds] DO
+	     ind := id;
+	     sym := sIdent
+	END;
+	id := id1;
+	RETURN IDENT(nIds)
+   END
+END InsertIdent;
+
+
+PROCEDURE IdKind(idno: IDENT): SYMBOL;
+BEGIN
+    IF CARDINAL(idno) > nIds THEN
+       RETURN sNull
+    ELSE
+       RETURN idKinds[CARDINAL(idno)].sym
+    END;
+END IdKind;
+
+
+PROCEDURE SameId(id1, id2: IDENT): BOOLEAN;
+BEGIN
+   RETURN CARDINAL(id1) = CARDINAL(id2)
+END SameId;
+
+
+PROCEDURE IdString(idno: IDENT; VAR s: ARRAY OF CHAR);
+BEGIN
+    (* not implemented *)
+END IdString;
+
+
+PROCEDURE EnterKeyWord(sym: SYMBOL; name : ARRAY OF CHAR);
+VAR l, L : CARDINAL;
+BEGIN
+   INC(K); INC(nIds);
+   idKinds[K].sym := sym;
+   idKinds[K].ind := id;
+   l := 0; L := HIGH(name);
+   buf[id] := CHR(L + 1); INC(id);
+   LOOP
+      IF l > L THEN EXIT END;
+      buf[id] := name[l]; INC(id); INC(l)
+   END;
+   buf[id] := 0C; INC(id)
+END EnterKeyWord;
+
+
+PROCEDURE InitStringTable;
+BEGIN
+   id := 0;
+   K := 0; nIds := 0
+END InitStringTable;
+
+
+BEGIN
+END StringTable.
+

SyntaxAnalysis.def

@@ -0,0 +1,16 @@
+DEFINITION MODULE SyntaxAnalysis;		(* gf	3.8.88 *)
+
+FROM	InternalTree	IMPORT	blckPtr;
+
+
+(* EXPORT QUALIFIED SyntaxError, parse;
+*)
+
+
+VAR SyntaxError : BOOLEAN;
+
+PROCEDURE parse() : blckPtr;
+
+
+END SyntaxAnalysis.
+

SyntaxAnalysis.mod

@@ -0,0 +1,629 @@
+IMPLEMENTATION MODULE SyntaxAnalysis;		(* gf  27.04.89 (pl0) *)
+
+FROM SYSTEM	IMPORT TSIZE;
+FROM Storage	IMPORT ALLOCATE;
+FROM InOut	IMPORT Write, WriteLn, WriteCard, WriteString;
+
+FROM Scanner	IMPORT	SYMBOL, IDENT, STRING, POSITION,
+			sym, id, num, strp, pos,
+			traceParser,
+			InitScanner, GetSymbol;
+
+FROM InternalTree IMPORT BLCK,	  DECL,     STMT,     EXPR,
+			blckPtr, declPtr,  stmtPtr,  exprPtr,
+				 declKind, stmtKind, exprKind,
+			monOperator, dyOperator, conType,
+			NewDeclSequence, NewStmtSequence, NewExprSequence,
+			NoDeclaration,	 NoStatement,	  NoExpression;
+
+FROM ErrorHandling IMPORT PrintError1;
+
+
+
+
+
+PROCEDURE Trace (s : ARRAY OF CHAR);
+BEGIN
+   IF traceParser THEN
+      WriteString('    ');
+      WriteString(s); WriteLn
+   END
+END Trace;
+
+
+PROCEDURE Error(n : CARDINAL);
+VAR i : CARDINAL;
+BEGIN
+   SyntaxError := TRUE;
+   PrintError1(n , pos)
+END Error;
+
+
+
+PROCEDURE test(s : SYMBOL; n: CARDINAL);
+BEGIN
+   IF sym = sEof THEN Error(31) END;
+   IF sym < s THEN
+	Error(n);
+	Error(98);
+	REPEAT
+	   GetSymbol;
+	   IF sym = sEof THEN Error(31) END;
+	UNTIL sym >= s;
+	Error(99)
+   END;
+END test;
+
+
+PROCEDURE ErrorSkip(n: CARDINAL; s: SYMBOL);
+
+  PROCEDURE Skip(s : SYMBOL);
+  BEGIN
+     IF sym = sEof THEN Error(31) END;
+     IF sym < s THEN
+	Error(98);
+	REPEAT
+	   GetSymbol;
+	   IF sym = sEof THEN Error(31) END;
+	UNTIL sym >= s;
+	Error(99)
+     END;
+  END Skip;
+
+BEGIN
+   Error(n);
+   Skip(s)
+END ErrorSkip;
+
+
+
+PROCEDURE ApendDeclaration(VAR lastnode: declPtr; decl: declPtr);
+BEGIN
+    IF lastnode^.first # NIL THEN
+       lastnode^.rest := NewDeclSequence(pos);
+       lastnode := lastnode^.rest;
+    END;
+    lastnode^.first := decl;
+END ApendDeclaration;
+
+
+
+(* the following forward declarations are needed for OSI M2 compiler
+( *$nonstandard * )
+
+PROCEDURE Block      () 	 : blckPtr;		 FORWARD;
+PROCEDURE Expression () 	 : exprPtr;		 FORWARD;
+PROCEDURE Variable   (id: IDENT) : exprPtr;		 FORWARD;
+
+( *$standard *)
+
+
+PROCEDURE Factor(): exprPtr;
+VAR f	: exprPtr;
+    lId : IDENT;
+BEGIN
+   Trace( "Factor");
+   test(sLParen, 6);
+   NEW(f);
+   WITH f^ DO
+      CASE sym OF
+	sIdent:
+	   Trace("   sIdent");
+	   lId := id;
+	   GetSymbol;
+	   f := Variable(lId)
+      | sNumber:
+	   Trace("   sNumber");
+	   position := pos;
+	   kind     := immediatevalue;
+	   immVal   := num;
+	   immType  := int;
+	   GetSymbol
+      | sLParen:
+	   Trace("   sLParen");
+	   GetSymbol;
+	   f := Expression();
+	   IF sym = sRParen THEN
+	      GetSymbol
+	   ELSE
+	      ErrorSkip(7, sTimes)
+	   END
+      | sEof:
+      ELSE
+	   ErrorSkip(8, sTimes)
+      END;
+   END;
+   RETURN f
+END Factor;
+
+
+PROCEDURE Term() : exprPtr;
+VAR  t, t1 : exprPtr;
+BEGIN
+   Trace( "Term");
+   t := Factor();
+   WHILE (sym = sTimes) OR (sym = sDiv) DO
+      NEW(t1);
+      WITH t1^ DO
+	 position := pos;
+	 kind	  := dyadic;
+	 IF sym = sTimes THEN
+	    dyOpr := times
+	 ELSE
+	    dyOpr := divides
+	 END;
+	 leftArg  := t;
+	 GetSymbol;
+	 rightArg := Factor();
+      END;
+      t := t1;
+   END;
+   RETURN t
+END Term;
+
+
+PROCEDURE Expression(): exprPtr;
+VAR t, t1: exprPtr;
+BEGIN
+   Trace( "Expression");
+   IF sym = sMinus THEN
+      NEW(t);
+      WITH t^ DO
+	 position := pos;
+	 kind	  := monadic;
+	 monOpr   := neg;
+	 GetSymbol;
+	 arg	  := Term();
+      END
+   ELSIF sym = sPlus THEN
+      GetSymbol;
+      t := Term();
+   ELSE
+      t := Term();
+   END;
+   WHILE (sym = sPlus) OR (sym = sMinus) DO
+      NEW(t1);
+      WITH t1^ DO
+	 position := pos;
+	 kind	  := dyadic;
+	 IF sym = sPlus THEN
+	    dyOpr := plus
+	 ELSE
+	    dyOpr := minus
+	 END;
+	 leftArg  := t;
+	 GetSymbol;
+	 rightArg := Term();
+      END;
+      t := t1
+   END;
+   RETURN t
+END Expression;
+
+
+PROCEDURE Condition(): exprPtr;
+VAR c : exprPtr;
+BEGIN
+   Trace( "Condition");
+   NEW(c);
+   WITH c^ DO
+      position := pos;
+      IF sym = sOdd THEN
+	 kind	  := monadic;
+	 monOpr   := odd;
+	 GetSymbol;
+	 arg	  := Expression();
+      ELSE
+	 kind	  := dyadic;
+	 leftArg  := Expression();
+	 CASE sym OF
+	   sEQ : dyOpr	  := equal;
+	 | sNE : dyOpr	  := notequal;
+	 | sLT : dyOpr	  := less;
+	 | sGE : dyOpr	  := greaterequal;
+	 | sGT : dyOpr	  := greater;
+	 | sLE : dyOpr	  := lessequal;
+	 ELSE
+	   Error(28);
+	   RETURN c
+	 END;
+	 GetSymbol;
+	 rightArg := Expression();
+      END
+   END;
+   RETURN c
+END Condition;
+
+
+PROCEDURE Variable(id: IDENT): exprPtr;
+VAR p	    : exprPtr;
+BEGIN
+   Trace("Variable");
+   NEW(p);
+   WITH p^ DO
+      position := pos;
+      kind     := identifier;
+      usedId   := id;
+      usedInd  := NoExpression();
+   END;
+   RETURN p
+END Variable;
+
+
+PROCEDURE String() : exprPtr;
+VAR p1 : exprPtr;
+BEGIN
+   NEW(p1); p1^.position  := pos;
+	    p1^.kind	  := string;
+	    p1^.stringPtr := strp;
+   GetSymbol;
+   RETURN p1
+END String;
+
+
+PROCEDURE Assign(id: IDENT; pos: POSITION): stmtPtr;
+VAR p : stmtPtr;
+BEGIN
+   Trace("Assign");
+   NEW(p);
+   WITH p^ DO
+      position := pos;
+      kind     := assign;
+      target   := Variable(id);
+      IF (sym = sBecomes) OR (sym = sEQ) THEN
+	 position := pos;
+	 IF sym = sEQ THEN Error(13) END;
+	 GetSymbol;
+	 source   := Expression()
+      ELSE
+	 ErrorSkip(45, sEnd)
+      END
+   END;
+   RETURN p
+END Assign;
+
+
+PROCEDURE Call(id: IDENT; pos: POSITION): stmtPtr;
+VAR callStmt : stmtPtr;
+    parExpr  : exprPtr;
+BEGIN
+   Trace("Call");
+   NEW(callStmt);
+   WITH callStmt^ DO
+      position	 := pos;
+      kind	 := call;
+      callId	 := id;
+   END;
+   RETURN callStmt
+END Call;
+
+
+
+PROCEDURE Statements(): stmtPtr;
+VAR stmts    : stmtPtr;
+    currStmt : stmtPtr;
+
+
+    PROCEDURE Statement(): stmtPtr;
+    VAR stmt	 : stmtPtr;
+	currStmt : stmtPtr;
+	lId	 : IDENT;
+	lpos	 : POSITION;
+    BEGIN
+       Trace( "Statement");
+       test(sIdent, 10);
+
+       CASE sym OF
+	 sIdent:
+	    Trace("   sIdent");
+	    lId := id; lpos := pos;
+	    GetSymbol;
+	    stmt := Assign(lId, lpos);
+       | sCall:
+	    Trace("   sCall");
+	    GetSymbol;
+	    IF sym = sIdent THEN
+	       lId := id; lpos := pos;
+	       GetSymbol;
+	       stmt := Call(lId, lpos);
+	    ELSE
+	       stmt := NoStatement();
+	       Error(29)
+	    END
+       | sBegin:
+	    Trace("   sBegin");
+	    GetSymbol;
+	    stmt := NewStmtSequence(pos);
+	    currStmt := stmt;
+	    LOOP
+	       currStmt^.first	  := Statement();
+	       IF sym = sSemicolon THEN
+		  GetSymbol;
+		  IF currStmt^.first^.kind # nostatement THEN
+		     currStmt^.rest := NewStmtSequence(pos);
+		     currStmt := currStmt^.rest
+		  END
+	       ELSE
+		  IF sym = sEnd THEN
+		     GetSymbol
+		  ELSE
+		     Error(17)
+		  END;
+		  EXIT
+	       END
+	    END;
+	    currStmt^.rest := NoStatement();
+       | sIf:
+	    Trace("   sIf");
+	    NEW(stmt);
+		stmt^.position := pos;
+		stmt^.kind     := if;
+	    GetSymbol;
+		stmt^.choice   := Condition();
+	    IF sym = sThen THEN
+	       GetSymbol;
+	       stmt^.thenPart := Statement();
+	       stmt^.elsePart := NoStatement()
+	    ELSE
+	       ErrorSkip(16, sEnd)
+	    END
+       | sWhile:
+	    Trace("   sWhile");
+	    NEW(stmt);
+	    stmt^.position := pos;
+	    stmt^.kind	   := while;
+	    GetSymbol;
+	    stmt^.stop	   := Condition();
+	    IF sym = sDo THEN
+	       GetSymbol
+	    ELSE
+	       Error(18)
+	    END;
+	    stmt^.doPart   := Statement();
+       | sRead:
+	    Trace("   sRead");
+	    GetSymbol;
+	    IF sym = sIdent THEN
+	       NEW(stmt);
+	       stmt^.position := pos;
+	       stmt^.kind     := read;
+	       lId := id;
+	       GetSymbol;
+	       stmt^.inVar    := Variable(lId);
+	    ELSE
+	       ErrorSkip(14, sEnd)
+	    END
+       | sWrite:
+	    Trace("   sWrite");
+	    GetSymbol;
+	    NEW(stmt);
+	    stmt^.position := pos;
+	    stmt^.kind	   := write;
+	    IF sym = sString THEN
+	       stmt^.outVal   := String()
+	    ELSE
+	       stmt^.outVal   := Expression()
+	    END
+       | sEof:
+       | sEnd,
+	 sElse,
+	 sSemicolon:
+	    NEW(stmt);
+	    stmt^.position := pos;
+	    stmt^.kind	   := nostatement;
+       ELSE
+	   ErrorSkip(32, sEnd)
+       END;
+
+       test(sEnd, 19);
+       RETURN stmt
+    END Statement;
+
+
+BEGIN (* Statements *)
+   Trace('Statements');
+   stmts := NewStmtSequence(pos);
+   currStmt := stmts;
+   LOOP
+       currStmt^.first	  := Statement();
+       IF sym = sSemicolon THEN
+	  GetSymbol;
+	  IF currStmt^.first^.kind # nostatement THEN
+	     currStmt^.rest := NewStmtSequence(pos);
+	     currStmt := currStmt^.rest
+	  END
+       ELSE
+	  EXIT
+       END
+   END;
+   currStmt^.rest := NoStatement();
+   RETURN stmts
+END Statements;
+
+
+PROCEDURE ConstDeclaration(): declPtr;
+VAR Ident : IDENT;
+    p	  : declPtr;
+BEGIN
+     Trace( "ConstDeclaration");
+     IF sym = sIdent THEN
+	Ident := id;
+	GetSymbol;
+	IF (sym = sEQ) OR (sym = sBecomes) THEN
+	   IF sym = sBecomes THEN Error(1) END;
+	   GetSymbol;
+	   IF sym = sNumber THEN
+	      NEW(p); p^.position := pos;
+		      p^.kind	  := constdecl;
+		      p^.constVal := num;
+		      p^.constId  := Ident;
+	      GetSymbol;
+	      RETURN p
+	   ELSE ErrorSkip(2, sSemicolon)
+	   END
+	ELSE ErrorSkip(3, sSemicolon)
+	END
+     ELSE ErrorSkip(4, sSemicolon)
+     END;
+     RETURN NoDeclaration();
+END ConstDeclaration;
+
+
+PROCEDURE VarDeclaration(type: declPtr) : declPtr;
+VAR p : declPtr;
+BEGIN
+     Trace( "VarDeclaration");
+     IF sym = sIdent THEN
+	NEW(p); p^.position := pos;
+		p^.kind     := vardecl;
+		p^.varId    := id;
+		p^.varType  := type;
+	GetSymbol;
+	RETURN p
+     ELSE
+	ErrorSkip(4, sSemicolon)
+     END;
+     RETURN NoDeclaration();
+END VarDeclaration;
+
+
+PROCEDURE ProcDeclaration(): declPtr;
+VAR proc : declPtr;
+BEGIN
+   NEW(proc); proc^.position   := pos;
+	      proc^.kind       := procdecl;
+	      proc^.procId     := id;
+   GetSymbol;
+   IF sym = sSemicolon THEN
+      GetSymbol
+   ELSE
+      ErrorSkip(5, sBegin)
+   END;
+   proc^.body := Block();
+   RETURN proc;
+END ProcDeclaration;
+
+
+PROCEDURE Block() : blckPtr;
+VAR root	: blckPtr;
+    decl	: declPtr;
+    lastdecl	: declPtr;
+    type	: declPtr;
+
+
+
+   PROCEDURE Declarations;
+   BEGIN
+      LOOP
+	CASE sym OF
+	 sConst:
+	   GetSymbol;
+	   LOOP
+	       ApendDeclaration(lastdecl, ConstDeclaration());
+	       IF sym = sComma THEN
+		  GetSymbol
+	       ELSIF sym = sSemicolon THEN
+		  GetSymbol; EXIT
+	       ELSE
+		  ErrorSkip(5, sBegin); EXIT
+	       END;
+	   END
+	|sVar:
+	   GetSymbol;
+	   NEW(type);
+	   LOOP
+		ApendDeclaration(lastdecl, VarDeclaration(type));
+		IF sym = sComma THEN
+		   GetSymbol
+		ELSIF sym = sColon THEN
+		   GetSymbol;
+		   IF sym = sIdent THEN
+		      type^.position := pos;
+		      type^.kind     := typeident;
+		      type^.typeId   := id;
+		      GetSymbol
+		   ELSE
+		      ErrorSkip(37, sBegin)
+		   END;
+		   IF sym = sSemicolon THEN
+		      GetSymbol
+		   ELSE
+		      Error(36)
+		   END;
+		   EXIT
+		ELSE
+		   ErrorSkip(36, sBegin); EXIT
+		END;
+	   END;
+	|sProcedure:
+	   GetSymbol;
+	   IF sym = sIdent THEN
+	      ApendDeclaration(lastdecl, ProcDeclaration());
+	   ELSE
+	      ErrorSkip(4, sSemicolon)
+	   END;
+	   IF sym = sSemicolon THEN
+	      GetSymbol
+	   ELSE
+	      ErrorSkip(5, sBegin)
+	   END
+	ELSE
+	   EXIT (* loop *)
+	END;
+
+      END; (* loop *)
+   END Declarations;
+
+
+BEGIN  (* Block *)
+   Trace( "Block");
+
+   decl := NewDeclSequence(pos); lastdecl :=  decl;
+
+   Declarations;
+
+   test(sBegin, 33);
+   WHILE (sym # sBegin) AND (sym # sEof) DO
+	 Declarations;
+	 test(sBegin, 33)
+   END;
+
+
+   IF lastdecl^.first = NIL THEN
+      lastdecl^.first := NoDeclaration()
+   END;
+   lastdecl^.rest := NoDeclaration();
+
+   NEW(root); root^.position	 := pos;
+	      root^.declarations := decl;
+
+   IF sym = sBegin THEN
+      GetSymbol;
+      root^.statements := Statements();
+      IF sym = sEnd THEN
+	 GetSymbol
+      ELSE
+	 ErrorSkip(17, sBegin)
+      END
+   ELSE
+      ErrorSkip(33, sBegin)
+   END;
+
+   RETURN root
+END Block;
+
+
+PROCEDURE parse(): blckPtr;
+VAR root : blckPtr;
+BEGIN
+   SyntaxError := FALSE;
+   InitScanner;
+   GetSymbol;
+   root := Block();
+   IF sym # sPeriod THEN ErrorSkip(9, sEof) END;
+   RETURN root
+END parse;
+
+
+BEGIN
+END SyntaxAnalysis.

Synthesis.def

@@ -0,0 +1,18 @@
+DEFINITION MODULE Synthesis;		(* gf		1.8.88 *)
+
+
+FROM	InternalTree	IMPORT	blckPtr;
+
+
+(* EXPORT QUALIFIED SemanticError, traverse;
+*)
+
+
+
+VAR SemanticError : BOOLEAN;
+
+PROCEDURE traverse(head: blckPtr);
+
+
+END Synthesis.
+

Synthesis.mod

@@ -0,0 +1,322 @@
+IMPLEMENTATION MODULE Synthesis;		(* gf  30.12.88 (pl0) *)
+
+FROM Storage	IMPORT ALLOCATE;
+FROM InOut	IMPORT WriteLn, WriteString;
+
+FROM Scanner		IMPORT IDENT, STRING, POSITION,
+			       traceParser;
+FROM InternalTree	IMPORT BLCK,	DECL,	  STMT,     EXPR,
+			       blckPtr, declPtr,  stmtPtr,  exprPtr,
+					declKind, stmtKind, exprKind,
+			       monOperator, dyOperator, conType,
+			       NewDeclSequence,NewStmtSequence,NewExprSequence,
+			       NoDeclaration,  NoStatement,    NoExpression;
+FROM ErrorHandling	IMPORT PrintError2;
+FROM Interpreter	IMPORT Command;
+FROM Generator		IMPORT InitGenerator,
+			       Gen, GenL, GenS, Gens,
+			       Label, GetNewLabel, SetLabel;
+FROM ObjectTable	IMPORT Object, ObjKind, ObjType,
+			       Undefined, Integer,
+			       EnterDecl, FindDecl, GetObjType,
+			       EnterBlock, LeaveBlock,
+			       InitObjectTable;
+
+
+
+
+
+VAR currLevel	: CARDINAL;
+
+
+
+PROCEDURE Trace (s : ARRAY OF CHAR);
+VAR i: CARDINAL;
+BEGIN
+   IF traceParser THEN
+      FOR i := 1 TO currLevel DO
+	  WriteString('   |');
+      END;
+      WriteString(s); WriteLn
+   END
+END Trace;
+
+
+
+PROCEDURE Error(n : CARDINAL; p : POSITION);
+BEGIN
+   SemanticError := TRUE;
+   PrintError2(n, p)
+END Error;
+
+
+(* the following forward declaration is needed for the OSI M2 compiler
+( *$nonstandard * )
+
+PROCEDURE expression(node: exprPtr);			FORWARD;
+
+( *$standard	*)
+
+
+
+PROCEDURE LoadAddr(obj: Object);
+(* load addr of variable or parameter, return it's type *)
+BEGIN
+    Trace("LoadAddr");
+    Gen(LDA, currLevel - obj^.level, obj^.vAdr);
+END LoadAddr;
+
+
+
+PROCEDURE expression(node: exprPtr);
+VAR obj       : Object;
+
+BEGIN (* expression *)
+   Trace( "expression");
+   CASE node^.kind OF
+     identifier:
+	Trace("   identifier");
+	obj := FindDecl(node^.usedId, node^.position);
+	WITH obj^ DO
+	    CASE obj^.kind OF
+		constant :
+		    Trace("   constant");
+		    Gen(LDI, 0, CARDINAL(cVal));
+		    IF node^.usedInd^.kind # noexpression THEN
+		       Error(48, node^.usedInd^.position)
+		    END;
+	    |	variable:
+		    Trace("   variable");
+		    LoadAddr(obj);
+		    Gens(LD);
+	    |	procedure :
+		    Trace("   procedure");
+		    Error(21, node^.position)
+	    ELSE
+	       Error(202, node^.position)
+	    END
+	END;
+   | immediatevalue:
+	Trace("   immediatevalue");
+	Gen(LDI, 0, node^.immVal);
+   | monadic:
+       Trace("   monadic");
+       CASE node^.monOpr OF
+	 odd:
+	   expression(node^.arg);
+	   Gens(ODDi)
+       | neg:
+	   expression(node^.arg);
+	   Gens(NEGi)
+       END
+   | dyadic:
+	Trace("   dyadic");
+	expression(node^.leftArg);
+	expression(node^.rightArg);
+	CASE node^.dyOpr OF
+	  plus: 	Gens(ADDi)
+	| minus:	Gens(SUBi)
+	| times:	Gens(MULi)
+	| divides:	Gens(DIVi)
+	| equal :	Gens(EQ)
+	| notequal:	Gens(NE)
+	| less: 	Gens(LT)
+	| greaterequal: Gens(GE)
+	| greater:	Gens(GT)
+	| lessequal:	Gens(LE)
+	| and:		Gens(ANDb)
+	| or:		Gens(ORb)
+	END;
+   END;
+END expression;
+
+
+PROCEDURE statement(node: stmtPtr);
+   VAR obj    : Object;
+       L0, L1 : Label;
+       targ   : exprPtr;
+       strL   : CARDINAL;
+       str    : STRING;
+BEGIN
+   Trace("statement");
+   CASE node^.kind OF
+     nostatement: ;
+   | assign:
+	targ := node^.target;
+	IF targ^.kind = identifier THEN
+	   obj := FindDecl(targ^.usedId, targ^.position);
+	   IF obj^.kind = variable THEN
+	      expression(node^.source);
+	      LoadAddr(obj);
+	      Gens(ST)
+	   ELSE
+	      Error(12, node^.position)
+	   END
+	ELSE
+	   Error(110, targ^.position)
+	END
+   | call:
+	obj := FindDecl(node^.callId, node^.position);
+	IF obj^.kind = procedure THEN
+	   GenL(CALL, currLevel - obj^.level, obj^.procAdr)
+	ELSE
+	   Error(15, node^.position)
+	END;
+   | stmtsequence:
+	statement(node^.first);
+	statement(node^.rest);
+   | if:
+	expression(node^.choice);
+	L0 := GetNewLabel(); GenL(JMPC, 0, L0);
+	statement(node^.thenPart);
+	SetLabel(L0);
+   | while:
+	L0 := GetNewLabel(); SetLabel(L0);
+	expression(node^.stop);
+	L1 := GetNewLabel(); GenL(JMPC, 0, L1);
+	statement(node^.doPart);
+	GenL(JMP, 0, L0);
+	SetLabel(L1)
+   | read:
+	IF node^.inVar^.kind = identifier THEN
+	   targ := node^.inVar;
+	   obj := FindDecl(targ^.usedId, targ^.position);
+	   IF obj^.kind = variable THEN
+	      Gens(INi);
+	      LoadAddr(obj);
+	      Gens(ST)
+	   ELSE
+	      Error(12, targ^.position)
+	   END
+	ELSE
+	   Error(121, node^.position)
+	END
+   | write:
+	IF node^.outVal^.kind = string THEN
+	   str := node^.outVal^.stringPtr;
+	   strL := 0;
+	   WHILE str^[strL] # 0C DO INC(strL) END;
+	   GenS(LDIs,strL, str);
+	   Gen (LDI, 0, strL);
+	   Gens(OUTc)
+	ELSE
+	   expression(node^.outVal);
+	   Gens(OUTi)
+	END
+   ELSE
+      Error(103, node^.position);
+   END;
+END statement;
+
+
+
+PROCEDURE getTypeObject(tp: declPtr) : ObjType;
+VAR obj : Object;
+BEGIN
+   Trace("getTypeObject");
+   IF tp^.kind = typeident THEN
+	obj := FindDecl(tp^.typeId, tp^.position);
+	CASE obj^.kind OF
+	  simpleType:
+	     RETURN ObjType(obj)
+	| undefined:
+	     Error(11, tp^.position);
+	     RETURN Undefined
+	ELSE
+	     Error(37, tp^.position);
+	     RETURN Undefined
+	END
+   ELSE
+      Error(104, tp^.position);
+      RETURN Undefined
+   END;
+END getTypeObject;
+
+
+PROCEDURE Block(root: blckPtr; L0: Label; currAddr: CARDINAL);
+(* L0	    : label of first instruction of procedure body	 *)
+(* currAddr : data address (offset in current stack frame),
+	      the initial value contains the space for
+	      the block mark,
+	      that means: it is the address (offset) for the
+	      first local variable.				 *)
+
+
+   PROCEDURE Declarations(node: declPtr);
+   VAR obj : Object;
+   BEGIN
+     WITH node^ DO
+	CASE kind OF
+	  nodeclaration: ;
+	| declsequence:
+	     Trace('declsequence');
+	     Declarations(first);
+	     Declarations(rest);
+	| constdecl:
+	     Trace('constdecl');
+	     obj := EnterDecl(constId, position);
+	     IF obj^.kind = newObject THEN
+		obj^.kind  := constant;
+		obj^.cType := Integer;
+		obj^.cVal  := constVal
+	     END
+	| vardecl:
+	     Trace('vardecl');
+	     obj := EnterDecl(varId, position);
+	     IF obj^.kind = newObject THEN
+		obj^.kind  := variable;
+		obj^.vType := getTypeObject(varType);
+		obj^.vAdr  := currAddr;
+		INC(currAddr)
+	     END
+	| procdecl:
+	     Trace('procdecl');
+	     obj := EnterDecl(procId, position);
+	     IF obj^.kind = newObject THEN
+		obj^.kind    := procedure;
+		obj^.procAdr := GetNewLabel();
+		Block(node^.body, obj^.procAdr, 3)
+	     END
+	END
+     END
+   END Declarations;
+
+
+
+BEGIN  (* Block *)
+   Trace( "Block");
+
+   currLevel := EnterBlock();
+
+   Trace('Declarations');
+   Declarations (root^.declarations);
+
+   SetLabel(L0);
+   Gen(MSP, 0, currAddr);	(* increment SP,
+				   skip space for block mark
+				   and local variables *)
+
+   statement(root^.statements);
+
+   Gens(RET);
+   currLevel := LeaveBlock();
+END Block;
+
+
+PROCEDURE traverse(head: blckPtr);
+VAR L0 : Label;
+    obj: Object;
+BEGIN
+   SemanticError := FALSE;
+   InitGenerator;
+
+   currLevel := InitObjectTable();
+
+   L0 := GetNewLabel(); GenL(JMP, 0, L0);
+   Block(head, L0, 3);
+
+END traverse;
+
+
+BEGIN
+END Synthesis.

Tests/TestCopy.mod

@@ -0,0 +1,86 @@
+MODULE TestCopy;
+(* Copy a textfile with ISO-Modula-2 I/O-Library
+   reading the in- and out-file specification
+   as parameter from the command line.
+
+Example: The OpenVMS command
+
+$ run testcopy
+$_ x.lis y.lis
+
+copies file x.lis to file y.lis.
+When installed as a foreign command, the arguments
+can be specified in the command line:
+
+$ testcopy :== $dev:[dir]testcopy.exe
+$ testcopy x.lis y.lis
+
+Copyright (1993-1996) by Guenter Dotzel
+http://www.modulaware.com/
+
+GD/1993
+*)
+FROM ProgramArgs IMPORT IsArgPresent, ArgChan;
+FROM IOResult IMPORT ReadResults, ReadResult;  
+FROM SeqFile IMPORT OpenRead, OpenWrite, OpenResults,
+  Close, ChanId, read, write;
+FROM TextIO IMPORT ReadRestLine, SkipLine, ReadToken,
+  WriteLn, WriteString;
+IMPORT STextIO, SWholeIO;
+
+TYPE fnam= ARRAY [0..254] OF CHAR;
+VAR in,out: fnam;
+  ores: OpenResults;
+  input, output: ChanId;
+  line: ARRAY[0..8191] OF CHAR;
+  lines: INTEGER;
+
+PROCEDURE usage;
+BEGIN
+  STextIO.WriteString("TestCopy usage: 'testcopy IN.EXT OUT.EXT'");
+  STextIO.WriteLn;
+END usage;
+
+BEGIN
+  lines:=0;
+  IF IsArgPresent() THEN
+    ReadToken(ArgChan(), in);
+    IF IsArgPresent() THEN
+      ReadToken(ArgChan(), out);
+      OpenRead(input, in, read, ores); 
+      IF ores=opened THEN
+        OpenWrite(output, out, write, ores);
+        IF ores=opened THEN
+          ReadRestLine(input, line);
+          WHILE ReadResult(input) <> endOfInput DO
+            IF ReadResult(input) = allRight THEN 
+              WriteString(output, line); WriteLn(output);
+              INC(lines);
+            ELSIF ReadResult(input) = endOfLine THEN
+              WriteLn(output);
+              INC(lines);
+            ELSE
+              STextIO.WriteString("TestCopy error reading infile");
+              STextIO.WriteLn;
+              HALT;
+            END;
+            SkipLine(input); ReadRestLine(input, line);
+          END;
+          Close(input);
+        ELSE
+          STextIO.WriteString("TestCopy can't create outfile");
+          STextIO.WriteLn;
+        END;
+        Close(output);
+        STextIO.WriteString("TestCopy: endOfInput reached, lines copied=");
+        SWholeIO.WriteInt(lines,0);
+        STextIO.WriteLn;
+      ELSE
+        STextIO.WriteString("TestCopy can't open infile");
+        STextIO.WriteLn;
+      END;
+    ELSE usage;
+    END;
+  ELSE usage;
+  END;
+END TestCopy.

Tests/essai3.mod

@@ -0,0 +1,11 @@
+MODULE essai3;
+
+IMPORT NumberIO;
+
+VAR
+    x: INTEGER;
+
+BEGIN
+    NumberIO.ReadInt(x);
+    NumberIO.WriteInt(x,5);
+END essai3.

Tests/essai4.mod

@@ -0,0 +1,52 @@
+MODULE essai4;
+
+(* trying to use only the iso libraries *)
+(* for file and input handling          *)
+
+(* Importing the necessary libs *)
+
+FROM IOResult IMPORT ReadResults, ReadResult;  
+FROM SeqFile IMPORT OpenRead, OpenWrite, OpenResults,
+  Close, ChanId, read, write;
+FROM TextIO IMPORT ReadRestLine, SkipLine, ReadToken,
+  WriteLn, WriteString, ReadChar;
+IMPORT STextIO, SWholeIO;
+
+VAR 
+    leChanId    : ChanId;
+    leResultat  : OpenResults; 
+    line        : ARRAY[0..8191] OF CHAR;
+    aChar       : CHAR;
+    lines       : INTEGER;
+
+    PROCEDURE BeginLine(l : INTEGER);
+
+    BEGIN
+        STextIO.WriteString("line N°");
+        SWholeIO.WriteCard(lines, 5);
+        STextIO.WriteString("  ");
+    END BeginLine;
+
+BEGIN
+
+    STextIO.WriteString("Hello you all ! ... be ready for the ISO libs tests !");
+    STextIO.WriteLn;
+    STextIO.WriteString("trying to open a file and display the content");
+    STextIO.WriteLn;
+    STextIO.WriteLn;
+    OpenRead(leChanId, "essai3.mod", read, leResultat);
+    lines := 0;
+    IF leResultat=opened THEN
+        ReadRestLine(leChanId, line);
+        WHILE ReadResult(leChanId) <> endOfInput DO  
+            STextIO.WriteString(line); 
+            STextIO.WriteLn;
+            SkipLine(leChanId);
+            ReadRestLine(leChanId, line);
+        END;
+        Close(leChanId);
+    ELSE
+        STextIO.WriteString("Error");
+        STextIO.WriteLn;
+    END;   
+END essai4.

Tests/essai6.mod

@@ -0,0 +1,67 @@
+MODULE essai6;
+
+(* test minimal de lecture de fichier char par char*)
+
+FROM IOResult   IMPORT ReadResults, ReadResult; 
+FROM TextIO     IMPORT ReadRestLine, SkipLine, ReadToken, WriteLn, WriteString, ReadChar;
+FROM SeqFile IMPORT OpenRead, OpenWrite, OpenResults, Close, ChanId, read, write;
+IMPORT STextIO, SWholeIO;
+
+VAR 
+    leChanId    : ChanId;
+    leResultat  : OpenResults; 
+    unChar       : CHAR;
+    numeroLigne : CARDINAL;
+
+
+BEGIN
+    (* principe : on ouvre, on lit les chars les uns après les autres et on les affiche*)
+    (* une fois arrivé au bout du fichier, on le ferme                                 *)
+
+    STextIO.WriteString("Hello you all ! ... be ready for the ISO libs tests !");
+    STextIO.WriteLn;
+    STextIO.WriteString("trying to open a file and display the content,char by char");
+    STextIO.WriteLn;
+    STextIO.WriteLn;
+
+    (* initialisation des variables*)
+    numeroLigne := 1;
+
+    (* ouverture du fichier*)
+    OpenRead(leChanId, "essai3.mod", read, leResultat);
+
+    (* test du résultat*)
+    IF leResultat=opened THEN 
+        (*le fichier est ouvert*)
+        STextIO.WriteString("fichier ouvert!");
+        STextIO.WriteLn;
+        STextIO.WriteLn;
+        (* on lit un char*)
+        ReadChar(leChanId, unChar);
+        (* on teste le résulat de lecture du char*)
+        (* si c'est bon, on continue *)
+        WHILE ReadResult(leChanId) <> endOfInput DO 
+            (* on teste si on est en fin de ligne*)
+            IF ReadResult(leChanId) = endOfLine THEN
+                INC(numeroLigne);
+                (* on est obligé d'utiliser cette fonction poue "passer" la fin de ligne*)
+                (* sinon, boucle infinie .... car on n'arrive jamais à enOfInput*)
+                SkipLine(leChanId);
+            END;
+            (* on affiche le char*)
+            STextIO.WriteChar(unChar);
+            (* on lit le char suivant*)
+            ReadChar(leChanId, unChar);
+        END;
+        
+    ELSE
+        STextIO.WriteString("Error");
+        STextIO.WriteLn;
+    END;
+    Close(leChanId);
+    STextIO.WriteLn;
+    STextIO.WriteLn;
+    STextIO.WriteString(" nombre de lignes : ");
+    SWholeIO.WriteCard(numeroLigne, 6);
+    STextIO.WriteLn;
+END essai6.

Tests/essai7.mod

@@ -0,0 +1,42 @@
+MODULE essai7;
+
+(* test minimal de lecture de fichier char par char*)
+
+FROM IOResult   IMPORT ReadResults, ReadResult; 
+FROM TextIO     IMPORT ReadRestLine, SkipLine, ReadToken, WriteLn, WriteString, ReadChar;
+FROM SeqFile IMPORT OpenRead, OpenWrite, OpenResults, Close, ChanId, read, write;
+IMPORT STextIO, SWholeIO;
+
+VAR 
+    theChanId  : ChanId;
+    theResult  : OpenResults; 
+
+BEGIN
+    (* principe : on ouvre, on lit les chars les uns après les autres et on les affiche*)
+    (* une fois arrivé au bout du fichier, on le ferme                                 *)
+
+    STextIO.WriteString("Hello you all ! ... be ready for the ISO libs tests !");
+    STextIO.WriteLn;
+    STextIO.WriteString("trying to open a file and display the content,char by char");
+    STextIO.WriteLn;
+    STextIO.WriteString("trying exeptions ...");
+    STextIO.WriteLn;
+
+    (* ouverture du fichier*)
+    OpenRead(theChanId, "test126.mod", read, theResult);
+    IF theResult = noSuchFile THEN
+            STextIO.WriteString("The file doesn't exist ; halting");
+            STextIO.WriteLn;
+            HALT;
+    ELSE
+        (* test du résultat*)
+        IF theResult=opened THEN 
+            (*le fichier est ouvert*)
+            STextIO.WriteString("file opened!");
+        ELSE
+            STextIO.WriteString("Error opening the file");
+            STextIO.WriteLn;
+        END;
+        Close(theChanId);
+    END;
+END essai7.

Tests/semerr1.pl0

@@ -0,0 +1,17 @@
+
+
+VAR i   : INTEGER;
+VAR a,b : BOOLEAN;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;
+   ?b;
+   WHILE  a#b DO CALL reduce;
+   !a
+END.

Tests/semerr1.pl5

@@ -0,0 +1,11 @@
+
+TYPE a = ARRAY 4 OF b;
+TYPE b = ARRAY 2 OF INTEGER;
+
+VAR x : a;
+
+BEGIN
+   ?x[2];		(* Typfehler *)
+   !x[2]		(* Typfehler *)
+END.
+

Tests/semerr2.pl5

@@ -0,0 +1,11 @@
+(*$C- *)
+TYPE a = ARRAY 4 OF b;
+TYPE b = ARRAY 2 OF BOOLEAN;
+
+VAR x : a;
+
+BEGIN
+   ?x[2][1];		(* fehlerhafter Typ *)
+   !x[2][1][3]		(* fehlerhafte Indizierung *)
+END.
+

Tests/semerr3.pl5

@@ -0,0 +1,27 @@
+
+PROCEDURE p1(x, y: t1);
+BEGIN
+   p2;					(* zu wenig Parameter *)
+   p2(y);
+   p2(x, y)				(* zu viel Parameter  *)
+END;
+
+PROCEDURE p2(x: t1);
+BEGIN
+   p1(x, x);
+   p1(x, x[2]); 			(* falscher Parameter *)
+   p1(x);				(* zu wenig Parameter *)
+   p1(x, x, x); 			(* zu viel Parameter  *)
+   p3;
+   p3(x);				(* zu viel Parameter  *)
+   p4(x)				(* p4 ist keine Prozedur *)
+END;
+
+TYPE t1 = ARRAY 4 OF BOOLEAN;
+
+PROCEDURE p3; BEGIN END;
+
+VAR p4 : BOOLEAN;
+
+BEGIN
+END.

Tests/semerr4.pl5

@@ -0,0 +1,49 @@
+
+VAR m : array1;
+VAR n : arrayx;				(* arrayx ist nicht definiert*)
+
+CONST CALL = 33;
+
+PROCEDURE read;
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       ?x[i];
+       i := i + 1
+    END DO;
+    m[2] := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+
+PROCEDURE writeReverse;
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      ;;		
+   ;; i := 7;	      ;;
+   ;; WHILE i >= 1 DO ;;
+   ;;    !x[i];       ;;
+   ;;    i := i - 1   ;;
+   ;; END DO          ;;
+   ll;;;;;;;;;;;;;;;;;kk		(* undeklarierte Prozeduren *)
+END;
+
+TYPE array0 = ARRAY 7 OF INTEGER;
+TYPE arrayO = ARRAY 7 OF BOOLEAN;
+
+VAR x : arrayO;
+
+BEGIN
+   !CALL[3];				(* indizierte Konstante *)
+   read;
+   IF NOT ODD m[2][1] THEN
+      writeReverse
+   ELSE
+      !m[TRUE][x[3]]		        (* beide Indices BOOLEAN *)
+   END IF
+END.
+

Tests/semerr5.pl5

@@ -0,0 +1,47 @@
+
+VAR m : array1;
+VAR n : arrayx;				(* arrayx ist nicht definiert*)
+
+CONST CALL = 33;
+
+PROCEDURE read;
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       ?x[i];
+       i := i + 1
+    END DO;
+    m[2] := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+
+PROCEDURE writeReverse;
+VAR x : arrayO;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      ;;		(* verschiedene Typen  *)
+   ;; i := 7;	      ;;
+   ;; WHILE i >= 1 DO ;;
+   ;;    !x[i];       ;;
+   ;;    i := i - 1   ;;
+   ;; END DO          ;;
+   ;;;;;;;;;;;;;;;;;;;;;
+END;
+
+TYPE array0 = ARRAY 7 OF INTEGER;
+TYPE arrayO = ARRAY 7 OF INTEGER;
+
+BEGIN
+   !CALL[3];				(* indizierte Konstante *)
+   read;
+   IF NOT ODD m[2][1] THEN
+      writeReverse
+   ELSE
+      !m[2][1]
+   END IF
+END.
+

Tests/semerr6.pl5

@@ -0,0 +1,60 @@
+(*
+ * Das Programm enthaelt fehlerhafte Typdefinitionen
+ * mit vielen Folgefehlern.
+ * Gut ist es, wenn nur fuer die gekennzeichneten Zeilen
+ * Fehlermeldungen ausgegeben werden.
+ *)
+
+VAR m : array1;
+
+TYPE t0 = ARRAY 3 OF ARRAY 2 OF t2;	(* Fehler im Elementtyp *)
+
+PROCEDURE read(VAR k: array0);
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       input(x[i]);
+       i := i + 1
+    END DO;
+    k := x;
+    writeReverse(m);
+END;
+
+TYPE array1 = ARRAY 3 OF array0;	(* zykl. Typdefinition *)
+TYPE t2 = ARRAY 2 OF input;		(* unzul. Elementtyp   *)
+
+PROCEDURE writeReverse(m: array1);
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      		;;
+   IF m[1][1] > 0 THEN		;;
+   ;; i := 7;	      		;;
+   ;; WHILE i >= 1 DO 		;;
+   ;;    !x[i];       		;;
+   ;;    m[2][i] := 0 		;; 
+   ;;    i := i - 1   		;;
+   ;; END DO          		;;
+   ;; m[1][1] := m[1][1] - 1	;;
+   ;; writeReverse(m) 		;;
+   END IF;;;;;;;;;;;;;;;;;;;;;;;;;
+END;
+
+TYPE array0 = ARRAY 7 OF array;		(* zykl. Typdefinition *)
+
+PROCEDURE input(VAR i: INTEGER);
+BEGIN
+   ?i
+END;
+
+TYPE array = ARRAY 7 OF array0;		(* zykl. Typdefinition *)
+
+BEGIN
+   m[1][1] := 2;
+   read(m[2]);
+   m[1][1] := 1;
+   writeReverse(m)
+END.

Tests/synerr1.pl0

@@ -0,0 +1,18 @@
+
+
+
+VAR i   : INTEGER;
+var a,b : BOOLEAN;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;
+   ?b;
+   WHILE  a#b DO CALL reduce;
+   !a
+END.

Tests/synerr2.pl0

@@ -0,0 +1,20 @@
+
+(* groesster gemeinsamer Teiler zweier Zahlen *)
+(*$C+ *)
+
+VAR i   : INTEGER;
+VAR a,b : INTEGER;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   !'werte fuer a un b eingeben\n';
+   ?a;
+   ?b;
+   WHILE  a#b DO CALL reduce;
+   !a
+END.

Tests/synterr1.pl5

@@ -0,0 +1,44 @@
+VAR m : array1;
+    n : array1;			(* VAR fehlt *)
+
+PROCEDURE read(VAR m: array0);
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       input(x[i]);
+       i := i + 1
+    END OD;			(* OD statt DO *) 
+    m := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+PROCEDURE writeReverse;
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   x .= m[2];			(* .= statt := *)
+   i := 7;
+   WHILE i >= 1 DO
+      !x[i];
+      i := i - 1
+   END OD    			(* OD statt DO *)
+END;
+
+TYPE array0 = ARRAY 7 OF BOOLEAN;
+
+PROCEDURE input(VAR i: INTEGER);
+bEGIN				(* bEGIN statt BEGIN    *)
+   ?i
+END;
+
+BEGIN
+   read(m[2]);
+   IF NOT ODD m[2][1] THEN
+      writeReverse
+   ELSE
+      output(m[2 [1])		(* fehlende Indexklammer *)
+   END FI			(* FI statt IF		 *)
+END.
+

Tests/synterr2.pl5

@@ -0,0 +1,47 @@
+(*$C+ *)
+VAR m : array1;
+    n : array0;			(* VAR fehlt 			*)
+VAR o = array1;			(* '=' anstelle von ':' 	*)
+
+CONST CALL = 33;
+
+PROCEDURE read			(* ';' fehlt			*)
+VAR i : INTEGER;
+VAR x = array0; 		(* '=' anstelle von ':'		*)
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       ?x[i];
+       i := i + 1
+    END WHILE;			(* WHILE anstelle von DO	*)
+    m[2] := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+
+PROCEDURE writeReverse;
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      ;;
+   ;; i := 7;	      ;;
+   ;; WHILE i >= 1 DO ;;
+   ;;    !x[i];       ;;
+   ;;    i := i - 1   ;;
+   ;; END             ;;	(* DO fehlt			*)
+   ;;;;;;;;;;;;;;;;;;;;;
+END;
+
+TYPE array0 = ARRAY 7 OF INTEGER;
+
+BEGIN
+   !CALL;
+   read;
+   IF NOT ODD m[2 [1] THEN	(* ']' fehlt			*)
+      writeReverse
+   ELSE
+      !m[2][ ]			(* Indexausdruck fehlt		*)
+   END FI			(* FI anstelle von IF		*)
+END.
+

Tests/synterr3.pl5

@@ -0,0 +1,22 @@
+
+PROCEDURE p1( VAR a,b,c, : INTEGER);	(* ein Komma zu viel	*)
+BEGIN
+END;
+
+PROCEDURE p2( VAR : INTEGER); 		(* Bezeichner fehlt	*)
+BEGIN
+END;
+
+PROCEDURE p3( VAR a: INTEGER; ); 	(* ';' zuviel		*)
+BEGIN
+END;
+
+PROCEDURE p4( VAR a: ; b: c ); 		(* Typbezeichner fehlt  *)
+BEGIN
+END;
+
+PROCEDURE p4( a,b,: ; b: c ); 		(* 2 Bezeichner fehlen	*)
+BEGIN
+END;
+
+BEGIN END;				(* ';' statt '.'	*)

Tests/test1.pl0

@@ -0,0 +1,19 @@
+(* groesster gemeinsamer Teiler zweier Zahlen *)
+(*$T+ *)
+(*$C+ *)
+
+VAR i   : INTEGER;
+VAR a,b : INTEGER;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;
+   ?b;
+   WHILE  a#b DO CALL reduce;
+   !a
+END.

Tests/test1.pl5

@@ -0,0 +1,28 @@
+(* $ C+ *)
+(*$O+ *)
+
+
+PROCEDURE eingabe;
+BEGIN
+   ?x; ?y;
+   tt(x,y)
+END;
+
+VAR x, y, z: INTEGER;
+
+PROCEDURE tt(x, y: INTEGER);
+BEGIN
+   !y; !x;
+   y := 0; x := 0
+END;
+
+BEGIN
+   eingabe;
+   IF  NOT NOT (x > 0 AND y > 0) THEN
+      !x; !y
+   ELSE
+      z := -x - y;
+      !z
+   END IF
+END.
+

Tests/test2.pl0

@@ -0,0 +1,24 @@
+(* groesster gemeinsamer Teiler zweier Zahlen *)
+(*$C+ *)
+
+VAR i   : INTEGER;
+VAR a,b : INTEGER;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;
+   ?b;
+   WHILE  a#b DO BEGIN 
+       CALL reduce;
+       IF ODD a THEN
+       BEGIN
+          !a; !b
+       END
+   END;
+   !a
+END.

Tests/test2.pl5

@@ -0,0 +1,37 @@
+(* $ C+ *)
+(* $ O+ *)
+
+TYPE z = ARRAY 4 OF INTEGER;
+
+VAR  a,b : z;
+VAR  x   : INTEGER;
+
+PROCEDURE P (VAR x: z; y: z ;  y1: INTEGER) ;
+BEGIN
+   y[1] := y1 + 100;
+   x[3] := y[1];
+   input(x[4])
+END;
+
+PROCEDURE input(VAR i: INTEGER);
+BEGIN
+   ?i
+END;
+
+PROCEDURE output(i: INTEGER);
+BEGIN
+   !i
+END;
+
+
+BEGIN
+   input(x);
+   a[1] := 1;
+   a[2] := x;
+   P(a, b, a[a[1]+1]+10);
+   output(a[1]);
+   output(a[2]);
+   output(a[3]);
+   output(a[4])
+(*$T+ *)
+END.

Tests/test3.pl0

@@ -0,0 +1,25 @@
+
+(* groesster gemeinsamer Teiler zweier Zahlen *)
+(*$C+ *)
+
+VAR i   : INTEGER;
+VAR a,b : INTEGER;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;;;;;;;;;;;;;;;;;;;
+   ?b;
+   WHILE  a#b DO BEGIN 
+       CALL reduce;
+       IF ODD a THEN
+       BEGIN
+          !a; !b
+       END
+   END;
+   !a;;;;;;;;;;;;;;;;;;;;
+END.

Tests/test3.pl5

@@ -0,0 +1,56 @@
+
+(*$C+ *)
+(* $O+ *)
+
+VAR m : array1;
+
+CONST CALL = 33;
+
+PROCEDURE read(VAR m: array0);
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       input(x[i]);
+       i := i + 1
+    END DO;
+    m := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+
+PROCEDURE writeReverse;
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      ;;
+   ;; i := 7;	      ;;
+   ;; WHILE i >= 1 DO ;;
+   ;;    !x[i];       ;;
+   ;;    i := i - 1   ;;
+   ;; END DO          ;;
+   ;; !'\n'	      ;;
+   ;;;;;;;;;;;;;;;;;;;;;
+END;
+
+TYPE array0 = ARRAY 7 OF INTEGER;
+
+PROCEDURE input(VAR i: INTEGER);
+BEGIN
+   ?i
+END;
+
+BEGIN
+   !'Testprogramm 3\n';
+   !CALL; !'\n';
+   !'\n7 Zahlenwerte eingeben:\n';
+   read(m[2]);
+   IF NOT (NOT NOT ODD m[2][1]) THEN
+      writeReverse
+   ELSE
+      !m[2][1]
+   END IF
+END.
+

Tests/test4.pl5

@@ -0,0 +1,55 @@
+(* $T+ *)
+(*$C+ *)
+(*$O+ *)
+
+VAR m : array1;
+
+PROCEDURE read(VAR k: array0);
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    !'\n7 Zahlen eingeben:\n';
+    i := 1;
+    WHILE i <= 7 DO
+       input(x[i]);
+       i := i + 1
+    END DO;
+    k := x;
+    writeReverse(m);
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+
+PROCEDURE writeReverse(m: array1);
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      		;;
+   IF m[1][1] > 0 THEN		;;
+   ;; !'\n'			;;
+   ;; i := 7;	      		;;
+   ;; WHILE i >= 1 DO 		;;
+   ;;    !x[i];       		;;
+   ;;    m[2][i] := 0 		;; 
+   ;;    i := i - 1   		;;
+   ;; END DO          		;;
+   ;; m[1][1] := m[1][1] - 1	;;
+   ;; writeReverse(m) 		;;
+   END IF;;;;;;;;;;;;;;;;;;;;;;;;;
+END;
+
+TYPE array0 = ARRAY 7 OF INTEGER;
+
+PROCEDURE input(VAR i: INTEGER);
+BEGIN
+   ?i
+END;
+
+BEGIN
+   !'Testprogramm 4\n';
+   m[1][1] := 2;
+   read(m[2]);
+   m[1][1] := 1;
+   writeReverse(m)
+END.

Tests/ttt.pl0

@@ -0,0 +1,8 @@
+(*$C+ *)
+VAR a,b,c: IMTEGER;
+
+BEGIN
+  ?a;
+  ?b;
+  !a*b
+END.

Tests/y

@@ -0,0 +1,13 @@
+
+
+
+
+
+
+
+
+
+
+
+
+

build_gm2.sh

@@ -0,0 +1,32 @@
+#
+############################################
+# This build file assumes the GNU Modula-2 compiler is installed.
+############################################
+
+#
+rm -f ./*.o 
+rm -f ./PL0
+#
+
+for x in   \
+  CharacterInput.mod \
+  Interpreter.mod    \
+  ErrorHandling.mod  \
+  Scanner.mod        \
+  StringTable.mod    \
+  Generator.mod     \
+  ObjectTable.mod    \
+  InternalTree.mod   \
+  SyntaxAnalysis.mod \
+  ErrorHandling.mod  \
+  Synthesis.mod      
+do
+  echo "+++++++++++++++++++++++++++++"
+  echo $x
+  gm2 -fiso -c  $x
+done
+
+  echo "+++++++++++++++++++++++++++++"
+  echo PL0.mod
+gm2 -fiso *.o PL0.mod -o PL0
+

build_gm2.sh.orig

@@ -0,0 +1,34 @@
+#
+############################################
+# This build file assumes the vishap oberon compiler is installed.
+############################################
+
+#
+rm -f ./*.o 
+rm -f ./*_m2.cpp ./*_m2.s
+rm -f a.out
+rm -f ./PL0
+#
+
+for x in   \
+  CharacterInput.mod \
+  Interpreter.mod    \
+  ErrorHandling.mod  \
+  Scanner.mod        \
+  StringTable.mod    \
+  Generator.mod     \
+  ObjectTable.mod    \
+  InternalTree.mod   \
+  SyntaxAnalysis.mod \
+  ErrorHandling.mod  \
+  Synthesis.mod      
+do
+  echo "+++++++++++++++++++++++++++++"
+  echo $x
+  gm2  -g -I. -flibs=log,pim $x
+done
+
+  echo "+++++++++++++++++++++++++++++"
+  echo PL0.mod
+gm2  -g -I.  -flibs=log,pim PL0.mod -o PL0
+

build_gm2.sh~

@@ -0,0 +1,32 @@
+#
+############################################
+# This build file assumes the vishap oberon compiler is installed.
+############################################
+
+#
+rm -f ./*.o 
+rm -f ./PL0
+#
+
+for x in   \
+  CharacterInput.mod \
+  Interpreter.mod    \
+  ErrorHandling.mod  \
+  Scanner.mod        \
+  StringTable.mod    \
+  Generator.mod     \
+  ObjectTable.mod    \
+  InternalTree.mod   \
+  SyntaxAnalysis.mod \
+  ErrorHandling.mod  \
+  Synthesis.mod      
+do
+  echo "+++++++++++++++++++++++++++++"
+  echo $x
+  gm2 -fiso -c  $x
+done
+
+  echo "+++++++++++++++++++++++++++++"
+  echo PL0.mod
+gm2 -fiso *.o PL0.mod -o PL0
+

git-pl0.txt

@@ -0,0 +1,15 @@
+
+Créer un nouveau dépôt en ligne de commande
+
+touch README.md
+git init
+git add README.md
+git commit -m "first commit"
+git remote add origin http://git.yojik.eu/eric/PL0-GNU-M2.git
+git push -u origin master
+
+Soumettre un dépôt existant par ligne de commande
+
+git remote add origin http://git.yojik.eu/eric/PL0-GNU-M2.git
+git push -u origin master
+

git.txt

@@ -0,0 +1,15 @@
+
+
+touch README.md
+git init
+git add README.md
+git commit -m "first commit"
+git remote add origin http://git.yojik.eu/eric/PL0-GNU-M2.git
+git push -u origin master
+
+Soumettre un dépôt existant par ligne de commande
+
+git remote add origin http://git.yojik.eu/eric/PL0-GNU-M2.git
+git push -u origin master
+
+

semerr1.pl0

@@ -0,0 +1,17 @@
+
+
+VAR i   : INTEGER;
+VAR a,b : BOOLEAN;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;
+   ?b;
+   WHILE  a#b DO CALL reduce;
+   !a
+END.

semerr1.pl5

@@ -0,0 +1,11 @@
+
+TYPE a = ARRAY 4 OF b;
+TYPE b = ARRAY 2 OF INTEGER;
+
+VAR x : a;
+
+BEGIN
+   ?x[2];		(* Typfehler *)
+   !x[2]		(* Typfehler *)
+END.
+

semerr2.pl5

@@ -0,0 +1,11 @@
+(*$C- *)
+TYPE a = ARRAY 4 OF b;
+TYPE b = ARRAY 2 OF BOOLEAN;
+
+VAR x : a;
+
+BEGIN
+   ?x[2][1];		(* fehlerhafter Typ *)
+   !x[2][1][3]		(* fehlerhafte Indizierung *)
+END.
+

semerr3.pl5

@@ -0,0 +1,27 @@
+
+PROCEDURE p1(x, y: t1);
+BEGIN
+   p2;					(* zu wenig Parameter *)
+   p2(y);
+   p2(x, y)				(* zu viel Parameter  *)
+END;
+
+PROCEDURE p2(x: t1);
+BEGIN
+   p1(x, x);
+   p1(x, x[2]); 			(* falscher Parameter *)
+   p1(x);				(* zu wenig Parameter *)
+   p1(x, x, x); 			(* zu viel Parameter  *)
+   p3;
+   p3(x);				(* zu viel Parameter  *)
+   p4(x)				(* p4 ist keine Prozedur *)
+END;
+
+TYPE t1 = ARRAY 4 OF BOOLEAN;
+
+PROCEDURE p3; BEGIN END;
+
+VAR p4 : BOOLEAN;
+
+BEGIN
+END.

semerr4.pl5

@@ -0,0 +1,49 @@
+
+VAR m : array1;
+VAR n : arrayx;				(* arrayx ist nicht definiert*)
+
+CONST CALL = 33;
+
+PROCEDURE read;
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       ?x[i];
+       i := i + 1
+    END DO;
+    m[2] := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+
+PROCEDURE writeReverse;
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      ;;		
+   ;; i := 7;	      ;;
+   ;; WHILE i >= 1 DO ;;
+   ;;    !x[i];       ;;
+   ;;    i := i - 1   ;;
+   ;; END DO          ;;
+   ll;;;;;;;;;;;;;;;;;kk		(* undeklarierte Prozeduren *)
+END;
+
+TYPE array0 = ARRAY 7 OF INTEGER;
+TYPE arrayO = ARRAY 7 OF BOOLEAN;
+
+VAR x : arrayO;
+
+BEGIN
+   !CALL[3];				(* indizierte Konstante *)
+   read;
+   IF NOT ODD m[2][1] THEN
+      writeReverse
+   ELSE
+      !m[TRUE][x[3]]		        (* beide Indices BOOLEAN *)
+   END IF
+END.
+

semerr5.pl5

@@ -0,0 +1,47 @@
+
+VAR m : array1;
+VAR n : arrayx;				(* arrayx ist nicht definiert*)
+
+CONST CALL = 33;
+
+PROCEDURE read;
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       ?x[i];
+       i := i + 1
+    END DO;
+    m[2] := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+
+PROCEDURE writeReverse;
+VAR x : arrayO;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      ;;		(* verschiedene Typen  *)
+   ;; i := 7;	      ;;
+   ;; WHILE i >= 1 DO ;;
+   ;;    !x[i];       ;;
+   ;;    i := i - 1   ;;
+   ;; END DO          ;;
+   ;;;;;;;;;;;;;;;;;;;;;
+END;
+
+TYPE array0 = ARRAY 7 OF INTEGER;
+TYPE arrayO = ARRAY 7 OF INTEGER;
+
+BEGIN
+   !CALL[3];				(* indizierte Konstante *)
+   read;
+   IF NOT ODD m[2][1] THEN
+      writeReverse
+   ELSE
+      !m[2][1]
+   END IF
+END.
+

semerr6.pl5

@@ -0,0 +1,60 @@
+(*
+ * Das Programm enthaelt fehlerhafte Typdefinitionen
+ * mit vielen Folgefehlern.
+ * Gut ist es, wenn nur fuer die gekennzeichneten Zeilen
+ * Fehlermeldungen ausgegeben werden.
+ *)
+
+VAR m : array1;
+
+TYPE t0 = ARRAY 3 OF ARRAY 2 OF t2;	(* Fehler im Elementtyp *)
+
+PROCEDURE read(VAR k: array0);
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       input(x[i]);
+       i := i + 1
+    END DO;
+    k := x;
+    writeReverse(m);
+END;
+
+TYPE array1 = ARRAY 3 OF array0;	(* zykl. Typdefinition *)
+TYPE t2 = ARRAY 2 OF input;		(* unzul. Elementtyp   *)
+
+PROCEDURE writeReverse(m: array1);
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      		;;
+   IF m[1][1] > 0 THEN		;;
+   ;; i := 7;	      		;;
+   ;; WHILE i >= 1 DO 		;;
+   ;;    !x[i];       		;;
+   ;;    m[2][i] := 0 		;; 
+   ;;    i := i - 1   		;;
+   ;; END DO          		;;
+   ;; m[1][1] := m[1][1] - 1	;;
+   ;; writeReverse(m) 		;;
+   END IF;;;;;;;;;;;;;;;;;;;;;;;;;
+END;
+
+TYPE array0 = ARRAY 7 OF array;		(* zykl. Typdefinition *)
+
+PROCEDURE input(VAR i: INTEGER);
+BEGIN
+   ?i
+END;
+
+TYPE array = ARRAY 7 OF array0;		(* zykl. Typdefinition *)
+
+BEGIN
+   m[1][1] := 2;
+   read(m[2]);
+   m[1][1] := 1;
+   writeReverse(m)
+END.

synerr1.pl0

@@ -0,0 +1,18 @@
+
+
+
+VAR i   : INTEGER;
+var a,b : BOOLEAN;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;
+   ?b;
+   WHILE  a#b DO CALL reduce;
+   !a
+END.

synerr2.pl0

@@ -0,0 +1,20 @@
+
+(* groesster gemeinsamer Teiler zweier Zahlen *)
+(*$C+ *)
+
+VAR i   : INTEGER;
+VAR a,b : INTEGER;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   !'werte fuer a un b eingeben\n';
+   ?a;
+   ?b;
+   WHILE  a#b DO CALL reduce;
+   !a
+END.

synterr1.pl5

@@ -0,0 +1,44 @@
+VAR m : array1;
+    n : array1;			(* VAR fehlt *)
+
+PROCEDURE read(VAR m: array0);
+VAR i : INTEGER;
+VAR x : array0;
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       input(x[i]);
+       i := i + 1
+    END OD;			(* OD statt DO *) 
+    m := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+PROCEDURE writeReverse;
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   x .= m[2];			(* .= statt := *)
+   i := 7;
+   WHILE i >= 1 DO
+      !x[i];
+      i := i - 1
+   END OD    			(* OD statt DO *)
+END;
+
+TYPE array0 = ARRAY 7 OF BOOLEAN;
+
+PROCEDURE input(VAR i: INTEGER);
+bEGIN				(* bEGIN statt BEGIN    *)
+   ?i
+END;
+
+BEGIN
+   read(m[2]);
+   IF NOT ODD m[2][1] THEN
+      writeReverse
+   ELSE
+      output(m[2 [1])		(* fehlende Indexklammer *)
+   END FI			(* FI statt IF		 *)
+END.
+

synterr2.pl5

@@ -0,0 +1,47 @@
+(*$C+ *)
+VAR m : array1;
+    n : array0;			(* VAR fehlt 			*)
+VAR o = array1;			(* '=' anstelle von ':' 	*)
+
+CONST CALL = 33;
+
+PROCEDURE read			(* ';' fehlt			*)
+VAR i : INTEGER;
+VAR x = array0; 		(* '=' anstelle von ':'		*)
+BEGIN
+    i := 1;
+    WHILE i <= 7 DO
+       ?x[i];
+       i := i + 1
+    END WHILE;			(* WHILE anstelle von DO	*)
+    m[2] := x
+END;
+
+TYPE array1 = ARRAY 3 OF array0;
+
+PROCEDURE writeReverse;
+VAR x : array0;
+VAR i : INTEGER;
+BEGIN
+   ;;;;;;;;;;;;;;;;;;;;;
+   ;; x := m[2];      ;;
+   ;; i := 7;	      ;;
+   ;; WHILE i >= 1 DO ;;
+   ;;    !x[i];       ;;
+   ;;    i := i - 1   ;;
+   ;; END             ;;	(* DO fehlt			*)
+   ;;;;;;;;;;;;;;;;;;;;;
+END;
+
+TYPE array0 = ARRAY 7 OF INTEGER;
+
+BEGIN
+   !CALL;
+   read;
+   IF NOT ODD m[2 [1] THEN	(* ']' fehlt			*)
+      writeReverse
+   ELSE
+      !m[2][ ]			(* Indexausdruck fehlt		*)
+   END FI			(* FI anstelle von IF		*)
+END.
+

synterr3.pl5

@@ -0,0 +1,22 @@
+
+PROCEDURE p1( VAR a,b,c, : INTEGER);	(* ein Komma zu viel	*)
+BEGIN
+END;
+
+PROCEDURE p2( VAR : INTEGER); 		(* Bezeichner fehlt	*)
+BEGIN
+END;
+
+PROCEDURE p3( VAR a: INTEGER; ); 	(* ';' zuviel		*)
+BEGIN
+END;
+
+PROCEDURE p4( VAR a: ; b: c ); 		(* Typbezeichner fehlt  *)
+BEGIN
+END;
+
+PROCEDURE p4( a,b,: ; b: c ); 		(* 2 Bezeichner fehlen	*)
+BEGIN
+END;
+
+BEGIN END;				(* ';' statt '.'	*)

test1.pl0

@@ -0,0 +1,19 @@
+(* bigger common denominator *)
+
+(*$C+ *)
+
+VAR i   : INTEGER;
+VAR a,b : INTEGER;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;
+   ?b;
+   WHILE  a#b DO CALL reduce;
+   !a
+END.

test1.pl5

@@ -0,0 +1,28 @@
+(* $ C+ *)
+(*$O+ *)
+
+
+PROCEDURE eingabe;
+BEGIN
+   ?x; ?y;
+   tt(x,y)
+END;
+
+VAR x, y, z: INTEGER;
+
+PROCEDURE tt(x, y: INTEGER);
+BEGIN
+   !y; !x;
+   y := 0; x := 0
+END;
+
+BEGIN
+   eingabe;
+   IF  NOT NOT (x > 0 AND y > 0) THEN
+      !x; !y
+   ELSE
+      z := -x - y;
+      !z
+   END IF
+END.
+

test2.pl0

@@ -0,0 +1,24 @@
+(* groesster gemeinsamer Teiler zweier Zahlen *)
+(*$C+ *)
+
+VAR i   : INTEGER;
+VAR a,b : INTEGER;
+
+PROCEDURE reduce;
+BEGIN
+   IF a > b THEN a := a - b;
+   IF b > a THEN b := b - a;
+END;
+
+BEGIN
+   ?a;
+   ?b;
+   WHILE  a#b DO BEGIN 
+       CALL reduce;
+       IF ODD a THEN
+       BEGIN
+          !a; !b
+       END
+   END;
+   !a
+END.

test2.pl5

@@ -0,0 +1,37 @@
+(* $ C+ *)
+(* $ O+ *)
+
+TYPE z = ARRAY 4 OF INTEGER;
+
+VAR  a,b : z;
+VAR  x   : INTEGER;
+
+PROCEDURE P (VAR x: z; y: z ;  y1: INTEGER) ;
+BEGIN
+   y[1] := y1 + 100;
+   x[3] := y[1];
+   input(x[4])
+END;
+
+PROCEDURE input(VAR i: INTEGER);
+BEGIN
+   ?i
+END;
+
+PROCEDURE output(i: INTEGER);
+BEGIN
+   !i
+END;
+
+
+BEGIN
+   input(x);
+   a[1] := 1;
+   a[2] := x;
+   P(a, b, a[a[1]+1]+10);
+   output(a[1]);
+   output(a[2]);
+   output(a[3]);
+   output(a[4])
+(*$T+ *)
+END.