Initial revision

diff --git a/lang/m2/test/.distr b/lang/m2/test/.distr
new file mode 100644 (file)
index 0000000..35e4dd2
--- /dev/null
+++ b/lang/m2/test/.distr
@@ -0,0 +1,5 @@
+Thalmann
+Wirth
+getenv.mod
+m2p.mod
+queens.mod

diff --git a/lang/m2/test/Thalmann/.distr b/lang/m2/test/Thalmann/.distr
new file mode 100644 (file)
index 0000000..f763682
--- /dev/null
+++ b/lang/m2/test/Thalmann/.distr
@@ -0,0 +1,5 @@
+LifeGame.mod
+Shoes.mod
+StoreFetch.mod
+bold.mod
+characters.mod

diff --git a/lang/m2/test/Thalmann/LifeGame.mod b/lang/m2/test/Thalmann/LifeGame.mod
new file mode 100644 (file)
index 0000000..f0216ce
--- /dev/null
+++ b/lang/m2/test/Thalmann/LifeGame.mod
@@ -0,0 +1,151 @@
+MODULE LifeGame;
+
+(* From: MODULA-2, An Introduction, by Daniel Thalmann, Springer-Verlag,
+        New York, 1985
+   Figure 10.18
+*)
+
+(* John Horton Conway's game "life" *)
+
+  FROM InOut IMPORT    Write, WriteString, WriteLn, WriteCard,
+                       ReadCard, Done;
+
+  CONST
+       MaxInd = 20;
+       MaxInd1 = MaxInd+1;
+
+  TYPE
+       IndRange = [1..MaxInd];
+       IndRange1 = [0..MaxInd1];
+       State = [0..1];
+       Cells = ARRAY IndRange1, IndRange1 OF State;
+       IndStat = [0..17];
+
+  VAR
+       Generation, NbOfGen: CARDINAL;
+       PreviousNext: BOOLEAN;
+       CellsState: ARRAY BOOLEAN OF Cells;
+       Status: ARRAY IndStat OF State;
+
+  PROCEDURE InitGame;
+
+    PROCEDURE InitAndReadPos;
+      VAR
+       Line, Column: CARDINAL;
+
+    BEGIN
+       FOR Line := 0 TO MaxInd1 DO
+         FOR Column := 0 TO MaxInd1 DO
+               CellsState[FALSE][Line, Column] := 0;
+         END;
+       END;
+       CellsState[TRUE] := CellsState[FALSE];
+
+       (* Read positions *)
+       ReadCard(Line);
+       WHILE Done DO
+               ReadCard(Column);
+               CellsState[FALSE][Line, Column] := 1;
+               ReadCard(Line);
+       END;
+
+       PreviousNext := FALSE;
+       Generation := 0;
+    END InitAndReadPos;
+
+    PROCEDURE InitStatus;
+    (* Ezra Gottheil method *)
+      VAR
+       Ind: IndStat;
+    BEGIN
+       FOR Ind := 0 TO 17 DO
+               Status[Ind] := 0;
+       END;
+       Status[3] := 1;
+       Status[11] := 1;
+       Status[12] := 1;
+    END InitStatus;
+
+  BEGIN        (* InitGame *)
+       WriteString("Please, enter the number of generations: ");
+       ReadCard(NbOfGen);
+       WriteLn;
+       WriteString("              line and column positions: ");
+       InitAndReadPos;
+       InitStatus;
+  END InitGame;
+
+  PROCEDURE NextGeneration;
+    VAR
+       Line, Column: IndRange;
+       nbN: CARDINAL;
+
+    PROCEDURE Neighbourhood(L, C: IndRange1; VAR nbn: CARDINAL);
+      VAR
+       Line1, Column1: IndRange1;
+    BEGIN
+       nbn := 0;
+       FOR Line1 := L - 1 TO L + 1 DO
+         FOR Column1 := C - 1 TO C + 1 DO
+               INC(nbn, CellsState[PreviousNext][Line1, Column1]);
+         END;
+       END;
+       DEC(nbn, CellsState[PreviousNext][L, C]);
+    END Neighbourhood;
+
+  BEGIN        (* NextGeneration *)
+       FOR Line := 1 TO MaxInd DO
+         FOR Column := 1 TO MaxInd DO
+               Neighbourhood(Line, Column, nbN);
+               CellsState[NOT PreviousNext][Line, Column] := 
+                 Status[CellsState[PreviousNext][Line, Column]*9 + nbN];
+         END;
+       END;
+       PreviousNext := NOT PreviousNext;
+  END NextGeneration;
+
+  PROCEDURE Impression;
+  VAR
+       N: CARDINAL;
+       Line, Column: IndRange;
+  BEGIN
+       WriteLn ;
+       WriteString("           GENERATION : ");
+       WriteCard(Generation, 3);
+       WriteLn;
+       WriteLn;
+       WriteString("          ");
+       FOR N := 1 TO 2 * MaxInd + 3 DO
+               Write("-");
+       END;
+       WriteLn;
+       FOR Line := 1 TO MaxInd DO
+               WriteString("          |");
+               FOR Column := 1 TO MaxInd DO
+                 IF CellsState[PreviousNext][Line, Column] = 1 THEN
+                       WriteString(" @");
+                 ELSE
+                       WriteString(" .");
+                 END;
+               END;
+               WriteString(" |");
+               WriteLn;
+       END;
+       WriteString("          ");
+       FOR N := 1 TO 2*MaxInd + 3 DO
+               Write("-");
+       END;
+       WriteLn;
+       WriteLn;
+  END Impression;
+
+BEGIN
+       InitGame;
+       Impression;
+       LOOP
+               INC(Generation);
+               NextGeneration;
+               Impression;
+               IF Generation = NbOfGen THEN EXIT; END;
+       END;
+END LifeGame.

diff --git a/lang/m2/test/Thalmann/Shoes.mod b/lang/m2/test/Thalmann/Shoes.mod
new file mode 100644 (file)
index 0000000..bf759c5
--- /dev/null
+++ b/lang/m2/test/Thalmann/Shoes.mod
@@ -0,0 +1,54 @@
+MODULE Shoes;
+
+(* From: MODULA-2, An Introduction, by Daniel Thalmann, Springer-Verlag,
+        New York, 1985
+   Figure 21.3
+*)
+
+  FROM SYSTEM IMPORT WORD, ADR, ADDRESS, NEWPROCESS, TRANSFER;
+  FROM InOut IMPORT Write, WriteLn;
+
+  CONST
+       WorkLength = 200;
+       MaxShoes = 50;
+       MaxDif = 6;
+
+  TYPE
+       WorkSpace = ARRAY [0..WorkLength-1] OF WORD;
+
+  VAR
+       NbLeft, NbRight : INTEGER;
+       WSLeft, WSRight : WorkSpace;
+       Left, Right, Main : ADDRESS;
+
+  PROCEDURE Leftp;
+  BEGIN
+       WHILE NbLeft < MaxShoes DO
+               INC(NbLeft);
+               Write("L");
+               IF (NbLeft-NbRight>=MaxDif) OR (NbLeft>=MaxShoes) THEN
+                       TRANSFER(Left,Right);
+               END;
+       END;
+       WriteLn;
+  END Leftp;
+
+  PROCEDURE Rightp;
+  BEGIN
+       WHILE NbRight < MaxShoes DO
+               INC(NbRight);
+               Write("R");
+               IF (NbRight-NbLeft>=MaxDif) OR (NbRight>=MaxShoes) THEN
+                       TRANSFER(Right,Left);
+               END;
+       END;
+       WriteLn;
+  END Rightp;
+
+BEGIN
+       NbLeft := 0;
+       NbRight := 0;
+       NEWPROCESS(Leftp,ADR(WSLeft),SIZE(WSLeft),Left);
+       NEWPROCESS(Rightp,ADR(WSRight),SIZE(WSRight),Right);
+       TRANSFER(Main,Left);
+END Shoes.

diff --git a/lang/m2/test/Thalmann/StoreFetch.mod b/lang/m2/test/Thalmann/StoreFetch.mod
new file mode 100644 (file)
index 0000000..c3863eb
--- /dev/null
+++ b/lang/m2/test/Thalmann/StoreFetch.mod
@@ -0,0 +1,91 @@
+MODULE StoreFetch;
+
+(* From: MODULA-2, An Introduction, by Daniel Thalmann, Springer-Verlag,
+        New York, 1985
+   Figure 20.3
+*)
+
+  FROM InOut IMPORT    ReadString, WriteString, WriteLn;
+  FROM Processes IMPORT        SIGNAL, StartProcess, SEND, WAIT, Awaited, Init;
+
+  MODULE SharedBuffer;
+
+    IMPORT     SIGNAL, SEND, WAIT, Awaited, Init;
+
+    EXPORT     Deposit, Remove;
+
+    CONST      N = 16;
+
+    VAR                n, in, out: CARDINAL;
+               NonFull, NonEmpty: SIGNAL;
+               Buffer: ARRAY [0..N-1] OF INTEGER;
+
+    PROCEDURE Deposit(integer: INTEGER);
+    BEGIN
+       IF n=N THEN WAIT(NonFull) END;
+       INC(n);
+       Buffer[in] := integer;
+       in := (in+1) MOD N;
+       IF Awaited(NonEmpty) THEN SEND(NonEmpty) END;
+    END Deposit;
+
+    PROCEDURE Remove(VAR integer: INTEGER);
+    BEGIN
+       IF n=0 THEN WAIT(NonEmpty) END;
+       DEC(n);
+       integer := Buffer[out];
+       out := (out+1) MOD N;
+       IF Awaited(NonFull) THEN SEND(NonFull) END;
+    END Remove;
+
+  BEGIN
+       n := 0;
+       in := 0;
+       out := 0;
+       Init(NonFull);
+       Init(NonEmpty);
+  END SharedBuffer;
+
+  CONST        Max = 80;
+       eos = 0C;
+
+  TYPE StringType = ARRAY[0..Max-1] OF CHAR;
+
+  VAR  EndOfTransfer: SIGNAL;
+
+  PROCEDURE Store;
+    VAR i: INTEGER;
+       String: StringType;
+  BEGIN
+       WriteString("Enter a string: ");
+       i := -1;
+       ReadString(String);
+       REPEAT
+               INC(i);
+               Deposit(ORD(String[i]));
+       UNTIL String[i] = eos;
+       WAIT(EndOfTransfer);
+  END Store;
+
+  PROCEDURE Fetch;
+    VAR        i, OrdOfChar: INTEGER;
+       String: StringType;
+  BEGIN
+       i := -1;
+       REPEAT
+               INC(i);
+               Remove(OrdOfChar);
+               String[i] := CHR(OrdOfChar);
+       UNTIL String[i] = eos;
+       WriteLn;
+       WriteString("After transfer: ");
+       WriteString(String);
+       WriteLn;
+  END Fetch;
+
+BEGIN
+       Init(EndOfTransfer);
+       StartProcess(Store, 500);
+       StartProcess(Fetch, 500);
+       WAIT(EndOfTransfer);
+END StoreFetch.

diff --git a/lang/m2/test/Thalmann/bold.mod b/lang/m2/test/Thalmann/bold.mod
new file mode 100644 (file)
index 0000000..d375e2e
--- /dev/null
+++ b/lang/m2/test/Thalmann/bold.mod
@@ -0,0 +1,133 @@
+MODULE BoldFormatter;
+
+(* From: MODULA-2, An Introduction, by Daniel Thalmann, Springer-Verlag,
+        New York, 1985
+   Figure 18.2
+*)
+
+  FROM InOut IMPORT Done, EOL, Read, Write, OpenInput, OpenOutput, CloseInput, CloseOutput;
+
+  CONST
+    N = 40;
+    WordLength = 32;
+
+  TYPE
+    alpha = ARRAY [0..14] OF CHAR;
+
+  VAR
+    ch : CHAR;
+    i, j, k, l, m, r : CARDINAL;
+    id : ARRAY [0..WordLength] OF CHAR;
+    key : ARRAY [1..N] OF alpha;
+
+  PROCEDURE copy;
+  BEGIN
+    Write(ch); Read(ch);
+  END copy;
+
+  PROCEDURE InitTable;
+  BEGIN
+    key[ 1] := "AND            ";
+    key[ 2] := "ARRAY          ";
+    key[ 3] := "BEGIN          ";
+    key[ 4] := "BY             ";
+    key[ 5] := "CASE           ";
+    key[ 6] := "CONST          ";
+    key[ 7] := "DEFINITION     ";
+    key[ 8] := "DIV            ";
+    key[ 9] := "DO             ";
+    key[10] := "ELSE           ";
+    key[11] := "ELSIF          ";
+    key[12] := "END            ";
+    key[13] := "EXIT           ";
+    key[14] := "EXPORT         ";
+    key[15] := "FOR            ";
+    key[16] := "FROM           ";
+    key[17] := "IF             ";
+    key[18] := "IMPLEMENTATION ";
+    key[19] := "IMPORT         ";
+    key[20] := "IN             ";
+    key[21] := "LOOP           ";
+    key[22] := "MOD            ";
+    key[23] := "MODULE         ";
+    key[24] := "NOT            ";
+    key[25] := "OF             ";
+    key[26] := "OR             ";
+    key[27] := "POINTER        ";
+    key[28] := "PROCEDURE      ";
+    key[29] := "QUALIFIED      ";
+    key[30] := "RECORD         ";
+    key[31] := "REPEAT         ";
+    key[32] := "RETURN         ";
+    key[33] := "SET            ";
+    key[34] := "THEN           ";
+    key[35] := "TO             ";
+    key[36] := "TYPE           ";
+    key[37] := "UNTIL          ";
+    key[38] := "VAR            ";
+    key[39] := "WHILE          ";
+    key[40] := "WITH           ";
+  END InitTable;
+
+  PROCEDURE Identifier() : BOOLEAN;
+
+  BEGIN
+    l := 1; r := N; id[k] := " ";
+    REPEAT
+      m := (l + r) DIV 2;
+      i := 0;
+      WHILE (id[i]=key[m,i]) AND (id[i]#" ") DO i := i+1; END;
+
+      IF id[i] <= key[m,i] THEN r := m-1; END;
+      IF id[i] >= key[m,i] THEN l := m+1; END;
+    UNTIL l > r;
+    RETURN l = r+1;
+  END Identifier;
+
+BEGIN
+    InitTable;
+    OpenInput("mod");
+    OpenOutput("text");
+    IF NOT Done THEN HALT; END;
+    Read(ch);
+    REPEAT
+      IF (CAP(ch) >= "A") AND (CAP(ch) <= "Z") THEN
+       k := 0;
+       REPEAT
+         id[k] := ch; k := k+1;
+         Read(ch);
+       UNTIL (ch<"0") OR (ch>"9") AND (CAP(ch)<"A") OR (CAP(ch)>"Z");
+       IF Identifier() THEN
+         FOR i:= 0 TO k-1 DO
+           Write(id[i]);
+         END;
+       ELSE
+         FOR i := 0 TO k-1 DO
+           Write(id[i]); Write(10C); Write(id[i]); Write(10C); Write(id[i]);
+         END;
+       END
+      ELSIF (ch >= "0") AND (ch <= "9") THEN
+       REPEAT copy;
+       UNTIL ((ch<"0") OR (ch>"9")) AND ((ch < "A") OR (ch > "Z"))
+      ELSIF ch="(" THEN
+       copy;
+       IF ch = "*" THEN
+         REPEAT
+           REPEAT
+             copy;
+           UNTIL ch = "*";
+           copy;
+         UNTIL ch = ")";
+       END
+      ELSIF ch = "'" THEN
+       REPEAT copy; UNTIL ch = "'";
+       copy;
+      ELSIF ch='"' THEN
+       REPEAT copy; UNTIL ch = '"';
+       copy
+      ELSE copy;
+      END;
+    UNTIL NOT Done;
+    CloseInput;
+    CloseOutput;
+END BoldFormatter.

diff --git a/lang/m2/test/Thalmann/characters.mod b/lang/m2/test/Thalmann/characters.mod
new file mode 100644 (file)
index 0000000..bd33470
--- /dev/null
+++ b/lang/m2/test/Thalmann/characters.mod
@@ -0,0 +1,29 @@
+MODULE Characters;
+
+(* From: MODULA-2, An Introduction, by Daniel Thalmann, Springer-Verlag,
+        New York, 1985
+   Figure 8.8
+   Changed a little, to have an ELSE part in the CASE statement
+*)
+
+       FROM InOut IMPORT WriteLn, WriteString, Write;
+
+       CONST
+               StrByLine = 4;
+
+       VAR
+               c : CHAR;
+       
+       BEGIN
+               FOR c := 0C TO 177C DO
+                       IF ORD(c) MOD StrByLine = 0 THEN WriteLn; END;
+                       CASE c OF
+                       0C..37C, 177C : WriteString("Control character   ") |
+                       "0".."9":       WriteString("Digit               ") |
+                       "a".."z":       WriteString("Lower case letter   ") |
+                       "A"..'Z':       WriteString("Upper case LETTER   ")
+                       ELSE            WriteString("Special character   ")
+                       END;
+               END;
+       END Characters.
+

diff --git a/lang/m2/test/Wirth/.distr b/lang/m2/test/Wirth/.distr
new file mode 100644 (file)
index 0000000..eb6417b
--- /dev/null
+++ b/lang/m2/test/Wirth/.distr
@@ -0,0 +1,5 @@
+PowersOf2.mod
+TableHandl.def
+TableHandl.mod
+XREF.mod
+makefile

diff --git a/lang/m2/test/Wirth/PowersOf2.mod b/lang/m2/test/Wirth/PowersOf2.mod
new file mode 100644 (file)
index 0000000..962dd97
--- /dev/null
+++ b/lang/m2/test/Wirth/PowersOf2.mod
@@ -0,0 +1,57 @@
+MODULE PowersOf2;
+  FROM InOut IMPORT Write, WriteLn, WriteString, WriteCard;
+
+  CONST
+       M = 11;         (* M ~ N*log(2) *)
+       N = 32;
+  VAR
+       i,j,k,exp: CARDINAL;
+       c,r,t:  CARDINAL;
+       d: ARRAY [0..M] OF CARDINAL;
+       f: ARRAY[0..N] OF CARDINAL;
+  BEGIN
+       d[0] := 1;
+       k := 1;
+       FOR exp := 1 TO N DO
+               (* compute d = 2 ^ exp by d = 2*d *)
+               c := 0;         (* carry *)
+               FOR i := 0 TO k-1 DO
+                       t := 2 * d[i] + c;
+                       IF t >= 10 THEN
+                               d[i] := t - 10;
+                               c := 1;
+                       ELSE
+                               d[i] := t;
+                               c := 0;
+                       END
+               END;
+               IF c > 0 THEN
+                       d[k] := 1;
+                       k := k + 1
+               END;
+               (* output d[k-1] .. d[0] *)
+               i := M;
+               REPEAT
+                       i := i - 1; 
+                       Write(" ")
+               UNTIL i = k;
+               REPEAT
+                       i := i - 1;
+                       Write(CHR(d[i]+ORD("0")))
+               UNTIL i = 0;
+               WriteCard(exp, 4);
+               (* compute and output f = 2^(-exp) by f := f DIV 2 *)
+               WriteString(" 0.");
+               r := 0;         (* remainder *)
+               FOR j := 1 TO exp-1 DO
+                       r := 10 * r + f[j];
+                       f[j] := r DIV 2;
+                       r := r MOD 2;
+                       Write(CHR(f[j]+ORD("0")))
+               END;
+               f[exp] := 5;
+               Write("5");
+               WriteLn
+       END
+  END PowersOf2.
+

diff --git a/lang/m2/test/Wirth/TableHandl.mod b/lang/m2/test/Wirth/TableHandl.mod
new file mode 100644 (file)
index 0000000..ff39f23
--- /dev/null
+++ b/lang/m2/test/Wirth/TableHandl.mod
@@ -0,0 +1,183 @@
+IMPLEMENTATION MODULE TableHandler;
+
+  FROM InOut   IMPORT  Write, WriteLn, WriteInt;
+  FROM Storage IMPORT  Allocate;
+
+  CONST        TableLength = 3000;
+
+  TYPE
+       TreePtr = POINTER TO Word;
+       ListPtr = POINTER TO Item;
+       Item = RECORD
+               num: INTEGER;
+               next: ListPtr
+              END;
+       Word = RECORD
+               key: CARDINAL;  (* table index *)
+               first: ListPtr; (* list head *)
+               left, right: TreePtr
+              END;
+       Table = TreePtr;
+
+  VAR
+       id: ARRAY [0..WordLength] OF CHAR;
+       ascinx: CARDINAL;
+       asc: ARRAY [0..TableLength-1] OF CHAR;
+
+  PROCEDURE InitTable(VAR t: Table);
+  BEGIN
+       Allocate(t, SIZE(Word));
+       t^.right := NIL
+  END InitTable;
+
+  PROCEDURE Search(p: TreePtr): TreePtr;
+  (* search node with name equal to id
+  *)
+    TYPE       Relation = (less, equal, greater);
+    VAR                q: TreePtr;
+               r: Relation;
+               i: CARDINAL;
+    
+    PROCEDURE rel(k: CARDINAL): Relation;
+    (* compare id with asc[k]
+    *)
+      VAR      i: CARDINAL;
+               R: Relation;
+               x,y: CHAR;
+    BEGIN
+       i := 0;
+       R := equal;
+       LOOP
+           x := id[i];
+           y := asc[k];
+           IF CAP(x) # CAP(y) THEN EXIT END;
+           IF x <= " " THEN RETURN R END;
+           IF x < y THEN R := less ELSIF x > y THEN R := greater END;
+           i := i+1;
+           k := k+1;
+       END;
+       IF CAP(x) > CAP(y) THEN RETURN greater ELSE RETURN less END
+    END rel;
+
+  BEGIN        (* Search *)
+       q := p^.right;
+       r := greater;
+       WHILE q # NIL DO
+           p := q;
+           r := rel(p^.key);
+           IF r = equal THEN RETURN p
+           ELSIF r = less THEN q := p^.left
+           ELSE q := p^.right
+           END
+       END;
+       Allocate(q, SIZE(Word));        (* not found, hence insert *)
+       IF q # NIL THEN
+           WITH q^ DO
+               key := ascinx;
+               first := NIL;
+               left := NIL;
+               right := NIL
+           END;
+           IF r = less THEN p^.left := q ELSE p^.right := q END;
+           i := 0;     (* copy identifier into asc table *)
+           WHILE id[i] > " " DO
+               IF ascinx = TableLength THEN
+                   asc[ascinx] := " ";
+                   id[i] := " ";
+                   overflow := 1
+               ELSE
+                   asc[ascinx] := id[i];
+                   ascinx := ascinx + 1;
+                   i := i + 1
+               END
+           END;
+           asc[ascinx] := " ";
+           ascinx := ascinx + 1;
+       END;
+       RETURN q;
+  END Search;
+
+  PROCEDURE Record(t: Table; VAR x: ARRAY OF CHAR; n: INTEGER);
+    VAR        p: TreePtr;
+       q: ListPtr;
+       i: CARDINAL;
+  BEGIN
+       i := 0;
+       REPEAT
+           id[i] := x[i];
+           i := i + 1
+       UNTIL (id[i-1] = " ") OR (i = WordLength);
+       p := Search(t);
+       IF p = NIL THEN
+           overflow := 2
+       ELSE
+           Allocate(q, SIZE(Item));
+           IF q = NIL THEN
+               overflow := 3;
+           ELSE
+               q^.num := n;
+               q^.next := p^.first;
+               p^.first := q
+           END
+       END
+  END Record;
+
+  PROCEDURE Tabulate(t: Table);
+
+    PROCEDURE PrintItem(p: TreePtr);
+      CONST    L = 6;
+               N = (LineWidth - WordLength) DIV L;
+      VAR      ch: CHAR;
+               i, k: CARDINAL;
+               q: ListPtr;
+    BEGIN
+       i := WordLength + 1;
+       k := p^.key;
+       REPEAT
+           ch := asc[k];
+           i := i - 1;
+           k := k + 1;
+           Write(ch)
+       UNTIL ch <= " ";
+       WHILE i > 0 DO
+           Write(" ");
+           i := i-1
+       END;
+       q := p^.first;
+       i := N;
+       WHILE q # NIL DO
+           IF i = 0 THEN
+               WriteLn;
+               i := WordLength+1;
+               REPEAT
+                   Write(" ");
+                   i := i-1
+               UNTIL i = 0;
+               i := N
+           END;
+           WriteInt(q^.num, L);
+           q := q^.next;
+           i := i - 1
+       END;
+       WriteLn
+    END PrintItem;
+
+    PROCEDURE TraverseTree(p: TreePtr);
+    BEGIN
+       IF p # NIL THEN
+           TraverseTree(p^.left);
+           PrintItem(p);
+           TraverseTree(p^.right)
+       END
+    END TraverseTree;
+
+  BEGIN (* Tabulate *)
+       WriteLn;
+       TraverseTree(t^.right)
+  END Tabulate;
+
+BEGIN
+       ascinx := 0;
+       id[WordLength] := " ";
+       overflow := 0
+END TableHandler.

diff --git a/lang/m2/test/Wirth/XREF.mod b/lang/m2/test/Wirth/XREF.mod
new file mode 100644 (file)
index 0000000..5577416
--- /dev/null
+++ b/lang/m2/test/Wirth/XREF.mod
@@ -0,0 +1,153 @@
+MODULE XREF;
+  FROM InOut   IMPORT  Done, EOL, OpenInput, OpenOutput, Read, Write,
+                       WriteCard, WriteString, CloseInput, CloseOutput;
+  
+  FROM TableHandler IMPORT
+                       WordLength, Table, overflow, InitTable, Record,
+                       Tabulate;
+
+  TYPE Alfa = ARRAY [0..9] OF CHAR;
+
+  CONST        N = 45;         (* number of keywords *)
+
+  VAR  ch: CHAR;
+       i,k,l,m,r,lno: CARDINAL;
+       T: Table;
+       id: ARRAY [0..WordLength-1] OF CHAR;
+       key: ARRAY [1..N] OF Alfa;
+
+  PROCEDURE copy;
+  BEGIN
+       Write(ch);
+       Read(ch)
+  END copy;
+
+  PROCEDURE heading;
+  BEGIN
+       lno := lno + 1;
+       WriteCard(lno, 5);
+       WriteString("   ")
+  END heading;
+
+BEGIN
+       InitTable(T);
+       key[1] := "AND ";
+       key[2] := "ARRAY ";
+       key[3] := "BEGIN ";
+       key[4] := "BITSET ";
+       key[5] := "BOOLEAN ";
+       key[6] := "BY ";
+       key[7] := "CASE ";
+       key[8] := "CARDINAL ";
+       key[9] := "CHAR ";
+       key[10] := "CONST ";
+       key[11] := "DIV ";
+       key[12] := "DO ";
+       key[13] := "ELSE ";
+       key[14] := "ELSIF ";
+       key[15] := "END ";
+       key[16] := "EXIT ";
+       key[17] := "EXPORT ";
+       key[18] := "FALSE ";
+       key[19] := "FOR ";
+       key[20] := "FROM ";
+       key[21] := "IF ";
+       key[22] := "IMPORT ";
+       key[23] := "IN ";
+       key[24] := "INTEGER ";
+       key[25] := "LOOP ";
+       key[26] := "MOD ";
+       key[27] := "MODULE ";
+       key[28] := "NOT ";
+       key[29] := "OF ";
+       key[30] := "OR ";
+       key[31] := "POINTER ";
+       key[32] := "PROCEDURE ";
+       key[33] := "QUALIFIED ";
+       key[34] := "RECORD ";
+       key[35] := "REPEAT ";
+       key[36] := "RETURN ";
+       key[37] := "SET ";
+       key[38] := "THEN ";
+       key[39] := "TO ";
+       key[40] := "TRUE ";
+       key[41] := "TYPE ";
+       key[42] := "UNTIL ";
+       key[43] := "VAR ";
+       key[44] := "WHILE ";
+       key[45] := "WITH ";
+
+       OpenInput("mod");
+       IF NOT Done THEN HALT END;
+       OpenOutput("xref");
+       lno := 0;
+       Read(ch);
+       IF Done THEN
+           heading;
+           REPEAT
+               IF (CAP(ch) >= "A") & (CAP(ch) <= "Z") THEN
+                   k := 0;
+                   REPEAT
+                       id[k] := ch;
+                       k := k + 1;
+                       copy
+                   UNTIL (ch < "0") OR
+                         (ch > "9") & (CAP(ch) < "A") OR
+                         (CAP(ch) > "Z");
+                   l := 1;
+                   r := N;
+                   id[k] := " ";
+                   REPEAT      (* binary search *)
+                       m := (l + r) DIV 2;
+                       i := 0;
+                       WHILE (id[i] = key[m,i]) & (id[i] > " ") DO
+                               i := i+1;
+                       END;
+                       IF id[i] <= key[m,i] THEN r := m-1 END;
+                       IF id[i] >= key[m,i] THEN l := m+1 END;
+                   UNTIL l > r;
+                   IF l = r+1 THEN Record(T, id, lno) END
+               ELSIF (ch >= "0") & (ch <= "9") THEN
+                   REPEAT
+                       copy
+                   UNTIL ((ch<"0") OR (ch>"9"))&((ch<"A") OR (ch>"Z"))
+               ELSIF ch = "(" THEN
+                   copy;
+                   IF ch = "*" THEN    (* comment *)
+                       REPEAT
+                           REPEAT
+                               IF ch = EOL THEN
+                                   copy;
+                                   heading
+                               ELSE
+                                   copy
+                               END
+                           UNTIL ch = "*";
+                           copy
+                       UNTIL ch = ")";
+                       copy
+                   END
+               ELSIF ch = "'" THEN
+                   REPEAT copy UNTIL ch = "'";
+                   copy
+               ELSIF ch = '"' THEN
+                   REPEAT copy UNTIL ch = '"';
+                   copy
+               ELSIF ch = EOL THEN
+                   copy;
+                   IF Done THEN heading END
+               ELSE
+                   copy
+               END
+           UNTIL NOT Done OR (overflow # 0)
+       END;
+       IF overflow > 0 THEN
+           WriteString("Table overflow");
+           WriteCard(overflow, 6);
+           Write(EOL)
+       END;
+       Write(14C);
+       Tabulate(T);
+       CloseInput;
+       CloseOutput
+END XREF.

diff --git a/lang/m2/test/Wirth/makefile b/lang/m2/test/Wirth/makefile
new file mode 100644 (file)
index 0000000..4b28e09
--- /dev/null
+++ b/lang/m2/test/Wirth/makefile
@@ -0,0 +1,26 @@
+IFLAGS =
+M2FLAGS = 
+MOD = ack
+SUFFIX = o
+
+all:   PowersOf2 XREF 
+
+PowersOf2.$(SUFFIX):   PowersOf2.mod /proj/em/Work/lib/m2/InOut.def
+       $(MOD) -c $(M2FLAGS) $(IFLAGS) PowersOf2.mod
+TableHandl.$(SUFFIX):  TableHandl.mod TableHandl.def /proj/em/Work/lib/m2/InOut.def /proj/em/Work/lib/m2/Storage.def
+       $(MOD) -c $(M2FLAGS) $(IFLAGS) TableHandl.mod
+XREF.$(SUFFIX):        XREF.mod /proj/em/Work/lib/m2/InOut.def TableHandl.def
+       $(MOD) -c $(M2FLAGS) $(IFLAGS) XREF.mod
+
+OBS_PowersOf2 = \
+       PowersOf2.$(SUFFIX)
+
+PowersOf2:     $(OBS_PowersOf2)
+       $(MOD) -.mod -o PowersOf2 $(M2FLAGS) $(OBS_PowersOf2)
+
+OBS_XREF = \
+       XREF.$(SUFFIX)\
+       TableHandl.$(SUFFIX)
+
+XREF:  $(OBS_XREF)
+       $(MOD) -.mod -o XREF $(M2FLAGS) $(OBS_XREF)

diff --git a/lang/m2/test/getenv.mod b/lang/m2/test/getenv.mod
new file mode 100644 (file)
index 0000000..b9c4b18
--- /dev/null
+++ b/lang/m2/test/getenv.mod
@@ -0,0 +1,29 @@
+MODULE PrEnv;
+FROM InOut IMPORT WriteString, WriteLn, ReadString, Done;
+FROM Arguments IMPORT GetEnv, Argv, Argc;
+VAR  Buf: ARRAY[1..256] OF CHAR;
+     i: INTEGER;
+BEGIN
+       FOR i := 0 TO INTEGER(Argc) - 1 DO
+               IF Argv(i, Buf) > SIZE(Buf) THEN
+                       WriteString("Argument too long");
+                       WriteLn;
+                       HALT;
+               END;
+               WriteString(Buf);
+               WriteString(" ");
+       END;
+       WriteLn;
+       LOOP
+               WriteString("Environment name: ");
+               ReadString(Buf);
+               IF NOT Done THEN EXIT; END;
+               IF GetEnv(Buf, Buf) = 0 THEN
+                       WriteString("No environment variable");
+               ELSE
+                       WriteString(Buf);
+               END;
+               WriteLn;
+       END;
+       WriteLn;
+END PrEnv.

diff --git a/lang/m2/test/m2p.mod b/lang/m2/test/m2p.mod
new file mode 100644 (file)
index 0000000..c4e88ed
--- /dev/null
+++ b/lang/m2/test/m2p.mod
@@ -0,0 +1,1305 @@
+MODULE Modula2PrettyPrinter;
+
+FROM InOut IMPORT
+       Done, Read, Write, WriteLn, WriteString, OpenInput, OpenOutput,
+       CloseInput, CloseOutput;
+
+(*
+**      Modula-2 Prettyprinter, November 1985.
+**
+**      by Ken Yap, U of Rochester, CS Dept.
+**
+**      Permission to copy, modify, and distribute, but not for profit,
+**      is hereby granted, provided that this note is included.
+**
+**      adapted from a Pascal Program Formatter
+**      by J. E. Crider, Shell Oil Company,
+**      Houston, Texas 77025
+**
+**      This program formats Modula-2 programs according
+**      to structured formatting principles
+**
+**      A valid Modula-2 program is read from the input and
+**      a formatted program is written to the output.
+**      It is basically a recursive descent parser with actions
+**      intermixed with syntax scanning.
+**
+**      The actions of the program are as follows:
+**
+**      FORMATTING:  Each structured statement is formatted
+**      in the following pattern (with indentation "indent"):
+**
+**                XXXXXX header XXXXXXXX
+**                        XXXXXXXXXXXXXXXXXX
+**                        XXXXX body XXXXXX
+**                        XXXXXXXXXXXXXXXXXX
+**                END
+**
+**      where the header is one of:
+**
+**                IF <expression> THEN
+**                ELSIF <expression> THEN
+**                ELSE
+**                WHILE <expression> DO
+**                FOR <control variable> := <FOR list> DO
+**                WITH <RECORD variable> DO
+**                REPEAT
+**                LOOP
+**                CASE <expression> OF
+**                <CASE label list>:
+**
+**      and the last line begins with UNTIL or is END.
+**      Other program parts are formatted similarly.  The headers are:
+**
+**                <MODULE/PROCEDURE heading>;
+**                CONST
+**                TYPE
+**                VAR
+**                BEGIN
+**                (various FOR records AND RECORD variants)
+**
+**      COMMENTS:  Each comment that starts before or on a specified
+**      column on an input line (program constant "commthresh") is
+**      copied without shifting or reformatting.  Each comment that
+**      starts after "commthresh" is reformatted and left-justified
+**      following the aligned comment base column ("alcommbase").
+**
+**      SPACES AND BLANK LINES:  Spaces not at line breaks are copied from
+**      the input.  Blank lines are copied from the input if they appear
+**      between statements (or appropriate declaration units).  A blank
+**      line is inserted above each significant part of each program/
+**      procedure if one is not already there.
+**
+**      CONTINUATION:  Lines that are too long for an output line are
+**      continued with additional indentation ("contindent").
+*)
+
+CONST
+       TAB = 11C;
+       NEWLINE = 12C;                  (* for Unix *)
+       FF = 14C;
+       maxrwlen = 15;                  (* size of reserved word strings *)
+       ordminchar = 0;                 (* ord of lowest char in char set *)
+       ordmaxchar = 127;               (* ord of highest char in char set *)
+(* The following parameters may be adjusted for the installation: *)
+       maxinlen = 255;                 (* maximum width of input line + 1 *)
+       maxoutlen = 80;                 (* maximum width of output line *)
+       tabinterval = 8;                (* interval between tab columns *)
+       initmargin = 0;                 (* initial value of output margin *)
+       commthresh = tabinterval;       (* column threshhold in input for
+                                               comments to be aligned *)
+       alcommbase = 40;                (* aligned comments in output start
+                                               after this column *)
+       indent = tabinterval;           (* RECOMMENDED indentation increment *)
+       contindent = tabinterval;       (* continuation indentation, >indent *)
+       commindent = tabinterval;       (* comment continuation indentation *)
+
+TYPE
+       natural = INTEGER[0..32767];
+       inrange = INTEGER[0..maxinlen];
+       outrange = INTEGER[0..maxoutlen];
+
+       errortype = (longline, noendcomm, notquote, longword, notdo, notof,
+       notend, notthen, notbegin, notuntil, notident, notsemicolon, notcolon,
+       notperiod, notparen, noeof);
+
+       chartype = (illegal, special, chapostrophe, chleftparen, chrightparen,
+       chperiod, digit, chcolon, chsemicolon, chlessthan, chgreaterthan,
+       letter, chleftbrace, chbar);
+
+       chartypeset = SET OF chartype;  (* for reserved word recognition *)
+
+       resword = (                     (* reserved words ordered by length *)
+       rwif, rwdo, rwof, rwto, rwin, rwor,
+                                       (* length: 2 *)
+       rwend, rwfor, rwvar, rwdiv, rwmod, rwset, rwand, rwnot, rwnil,
+                                       (* length: 3 *)
+       rwthen, rwelse, rwwith, rwcase, rwtype, rwloop, rwfrom,
+                                       (* length: 4 *)
+       rwbegin, rwelsif, rwuntil, rwwhile, rwarray, rwconst,
+                                       (* length: 5 *)
+       rwrepeat, rwrecord, rwmodule, rwimport, rwexport,
+                                       (* length: 6 *)
+       rwpointer,                      (* length: 7 *)
+       rwprocedure, rwqualified,       (* length: 9 *)
+       rwdefinition,                   (* length: 10 *)
+       rwimplementation,               (* length: 14 *)
+       rwx);                           (* length: 15 for table sentinel *)
+       rwstring =  ARRAY [1..maxrwlen] OF CHAR;
+
+       firstclass = (                  (* class of word if on new line *)
+       newclause,                      (* start of new clause *)
+       continue,                       (* continuation of clause *)
+       alcomm,                         (* start of aligned comment *)
+       contalcomm,                     (* continuation of aligned comment *)
+       uncomm,                         (* start of unaligned comment *)
+       contuncomm);                    (* continuation of unaligned comment *)
+
+       wordtype = RECORD               (* data record for word *)
+               whenfirst : firstclass; (* class of word if on new line *)
+               puncfollows : BOOLEAN;  (* to reduce dangling punctuation *)
+               blanklncount : natural; (* number of preceding blank lines *)
+               spaces : INTEGER;       (* number of spaces preceding word *)
+               base : [-1..maxinlen];  (* inline.buf[base] precedes word *)
+               size : inrange;
+       END;                            (* length of word in inline.buf *)
+
+       symboltype = (                  (* symbols for syntax analysis *)
+       symodule, sydefinition, syimplementation, syfrom, syimport, syexport,
+       syqual, syproc, declarator, sybegin, syend, syif, sythen, syelsif,
+       syelse, syloop, sycase, syof, syuntil, syrepeat, forwhilewith, sydo,
+       syrecord, ident, intconst, semicolon, leftparen, rightparen, period,
+       colon, bar, othersym, otherword, comment, syeof);
+       symbolset = SET OF symboltype;
+
+VAR
+       inline : RECORD                 (* input line data *)
+               endoffile : BOOLEAN;    (* end of file on input? *)
+               ch : CHAR;              (* current char, buf[index] *)
+               index : inrange;        (* subscript of current char *)
+               len : natural;          (* length of input line in buf *)
+               buf : ARRAY [1..maxinlen] OF CHAR;
+       END;
+       outline : RECORD                (* output line data *)
+               blanklns : natural;     (* number of preceding blank lines *)
+               len : outrange;         (* number of chars in buf *)
+               buf : ARRAY [1..maxoutlen] OF CHAR;
+       END;
+       curword : wordtype;             (* current word *)
+       margin : outrange;              (* left margin *)
+       lnpending : BOOLEAN;            (* new line before next symbol? *)
+       inheader : BOOLEAN;             (* are we scanning a proc header? *)
+       symbol : symboltype;            (* current symbol *)
+
+  (* Structured Constants *)
+       headersyms : symbolset;         (* headers for program parts *)
+       strucsyms : symbolset;          (* symbols that begin structured
+                                               statements *)
+       stmtendsyms : symbolset;        (* symbols that follow statements *)
+       stopsyms : symbolset;           (* symbols that stop expression scan *)
+       recendsyms : symbolset;         (* symbols that stop record scan *)
+       datawords : symbolset;          (* to reduce dangling punctuation *)
+       firstrw : ARRAY [1..maxrwlen] OF resword;
+       rwword : ARRAY [rwif..rwimplementation] OF rwstring;
+       rwsy : ARRAY [rwif..rwimplementation] OF symboltype;
+       charclass : ARRAY CHAR OF chartype;
+       symbolclass : ARRAY chartype OF symboltype;
+
+PROCEDURE StrCmp(a, b : rwstring) : BOOLEAN;
+VAR
+       i : INTEGER;
+BEGIN
+       FOR i := 1 TO maxrwlen DO
+               IF a[i] # b[i] THEN
+                       RETURN FALSE;
+               END;
+       END;
+       RETURN TRUE;
+END StrCmp;
+
+PROCEDURE StructConsts;
+(* establish values of structured constants *)
+VAR
+       i : [ordminchar..ordmaxchar];   (* loop index *)
+       ch : CHAR;                      (* loop index *)
+
+PROCEDURE BuildResWord(rw : resword; symword : rwstring; symbol : symboltype);
+BEGIN
+       rwword[rw] := symword;          (* reserved word string *)
+       rwsy[rw] := symbol;             (* map to symbol *)
+END BuildResWord;
+
+BEGIN                                   (* StructConsts *)
+(* symbol sets for syntax analysis *)
+       headersyms := symbolset{symodule, syproc, declarator, sybegin, syend,
+       syeof};
+       strucsyms := symbolset{sycase, syrepeat, syif, forwhilewith, syloop};
+       stmtendsyms := symbolset{semicolon, bar, syend, syuntil, syelsif,
+       syelse, syeof};
+       stopsyms := headersyms + strucsyms + stmtendsyms;
+       recendsyms := symbolset{rightparen, syend, syeof};
+       datawords := symbolset{otherword, intconst, ident, syend};
+
+(* constants for recognizing reserved words *)
+       firstrw[1] := rwif;             (* length: 1 *)
+       firstrw[2] := rwif;             (* length: 2 *)
+       BuildResWord(rwif, 'IF             ', syif);
+       BuildResWord(rwdo, 'DO             ', sydo);
+       BuildResWord(rwof, 'OF             ', syof);
+       BuildResWord(rwto, 'TO             ', othersym);
+       BuildResWord(rwin, 'IN             ', othersym);
+       BuildResWord(rwor, 'OR             ', othersym);
+       firstrw[3] := rwend;            (* length: 3 *)
+       BuildResWord(rwend, 'END            ', syend);
+       BuildResWord(rwfor, 'FOR            ', forwhilewith);
+       BuildResWord(rwvar, 'VAR            ', declarator);
+       BuildResWord(rwdiv, 'DIV            ', othersym);
+       BuildResWord(rwmod, 'MOD            ', othersym);
+       BuildResWord(rwset, 'SET            ', othersym);
+       BuildResWord(rwand, 'AND            ', othersym);
+       BuildResWord(rwnot, 'NOT            ', othersym);
+       BuildResWord(rwnil, 'NIL            ', otherword);
+       firstrw[4] := rwthen;           (* length: 4 *)
+       BuildResWord(rwthen, 'THEN           ', sythen);
+       BuildResWord(rwelse, 'ELSE           ', syelse);
+       BuildResWord(rwwith, 'WITH           ', forwhilewith);
+       BuildResWord(rwloop, 'LOOP           ', syloop);
+       BuildResWord(rwfrom, 'FROM           ', syfrom);
+       BuildResWord(rwcase, 'CASE           ', sycase);
+       BuildResWord(rwtype, 'TYPE           ', declarator);
+       firstrw[5] := rwbegin;          (* length: 5 *)
+       BuildResWord(rwbegin, 'BEGIN          ', sybegin);
+       BuildResWord(rwelsif, 'ELSIF          ', syelsif);
+       BuildResWord(rwuntil, 'UNTIL          ', syuntil);
+       BuildResWord(rwwhile, 'WHILE          ', forwhilewith);
+       BuildResWord(rwarray, 'ARRAY          ', othersym);
+       BuildResWord(rwconst, 'CONST          ', declarator);
+       firstrw[6] := rwrepeat;         (* length: 6 *)
+       BuildResWord(rwrepeat, 'REPEAT         ', syrepeat);
+       BuildResWord(rwrecord, 'RECORD         ', syrecord);
+       BuildResWord(rwmodule, 'MODULE         ', symodule);
+       BuildResWord(rwimport, 'IMPORT         ', syimport);
+       BuildResWord(rwexport, 'EXPORT         ', syexport);
+       firstrw[7] := rwpointer;        (* length: 7 *)
+       BuildResWord(rwpointer, 'POINTER        ', othersym);
+       firstrw[8] := rwprocedure;      (* length: 8 *)
+       firstrw[9] := rwprocedure;      (* length: 9 *)
+       BuildResWord(rwprocedure, 'PROCEDURE      ', syproc);
+       BuildResWord(rwqualified, 'QUALIFIED      ', syqual);
+       firstrw[10] := rwdefinition;    (* length: 10 *)
+       BuildResWord(rwdefinition, 'DEFINITION     ', sydefinition);
+       firstrw[11] := rwimplementation;(* length: 11 *)
+       firstrw[12] := rwimplementation;(* length: 12 *)
+       firstrw[13] := rwimplementation;(* length: 13 *)
+       firstrw[14] := rwimplementation;(* length: 14 *)
+       BuildResWord(rwimplementation, 'IMPLEMENTATION ', syimplementation);
+       firstrw[15] := rwx;             (* length: 15 FOR table sentinel *)
+
+(* constants for lexical scan *)
+       FOR i := ordminchar TO ordmaxchar DO
+               charclass[CHR(i)] := illegal;
+       END;
+       FOR ch := 'a' TO 'z' DO
+               charclass[ch] := letter;
+               charclass[CAP(ch)] := letter;
+       END;
+       FOR ch := '0' TO '9' DO
+               charclass[ch] := digit;
+       END;
+       charclass[' '] := special;
+       charclass['"'] := chapostrophe;
+       charclass['#'] := special;
+       charclass['&'] := special;
+       charclass["'"] := chapostrophe;
+       charclass['('] := chleftparen;
+       charclass[')'] := chrightparen;
+       charclass['*'] := special;
+       charclass['+'] := special;
+       charclass[','] := special;
+       charclass['-'] := special;
+       charclass['.'] := chperiod;
+       charclass['/'] := special;
+       charclass[':'] := chcolon;
+       charclass[';'] := chsemicolon;
+       charclass['<'] := chlessthan;
+       charclass['='] := special;
+       charclass['>'] := chgreaterthan;
+       charclass['@'] := special;
+       charclass['['] := special;
+       charclass[']'] := special;
+       charclass['^'] := special;
+       charclass['{'] := special;
+       charclass['|'] := chbar;
+       charclass['}'] := special;
+       symbolclass[illegal] := othersym;
+       symbolclass[special] := othersym;
+       symbolclass[chapostrophe] := otherword;
+       symbolclass[chleftparen] := leftparen;
+       symbolclass[chrightparen] := rightparen;
+       symbolclass[chperiod] := period;
+       symbolclass[digit] := intconst;
+       symbolclass[chcolon] := colon;
+       symbolclass[chsemicolon] := semicolon;
+       symbolclass[chlessthan] := othersym;
+       symbolclass[chgreaterthan] := othersym;
+       symbolclass[chbar] := bar;
+       symbolclass[letter] := ident;
+END StructConsts;
+
+(* FlushLine/WriteError/ReadLine convert between files and lines. *)
+
+PROCEDURE FlushLine;
+(* Write buffer into output file *)
+VAR
+       i, j, vircol : outrange;        (* loop index *)
+       nonblankseen : BOOLEAN;
+BEGIN
+       WITH outline DO
+               WHILE blanklns > 0 DO
+                       WriteLn;
+                       blanklns := blanklns - 1;
+               END;
+               IF len > 0 THEN
+                       vircol := 0;
+                       nonblankseen := FALSE;
+                                       (* set this to TRUE if you don't want
+                                               blanks to tab conversion *)
+                       FOR i := 0 TO len - 1 DO
+                               IF buf[i+1] <> ' ' THEN
+                                       IF NOT nonblankseen THEN
+                                               LOOP
+                                                       j := (vircol DIV
+                                                       tabinterval + 1) *
+                                                       tabinterval;
+                                                       IF j > i THEN
+                                                               EXIT;
+                                                       END;
+                                                       Write(TAB);
+                                                       vircol := j;
+                                               END;
+                                       END;
+                                       nonblankseen := TRUE;
+                                       WHILE vircol < i DO
+                                               Write(' ');
+                                               vircol := vircol + 1;
+                                       END;
+                                       Write(buf[i+1]);
+                                       vircol := i + 1;
+                               END;
+                       END;
+                       WriteLn;
+                       len := 0;
+               END;
+       END;
+END FlushLine;
+
+PROCEDURE WriteError(error : errortype; nm : ARRAY OF CHAR);
+(* report error to output *)
+VAR
+       i, ix : inrange;                (* loop index, limit *)
+BEGIN
+       FlushLine;
+       WriteString('(* !!! error, ');
+       WriteString(nm);
+       CASE error OF
+       longline:
+               WriteString('shorter line');
+       | noendcomm:
+               WriteString('END OF comment');
+       | notquote:
+               WriteString("final ' on line");
+       | longword:
+               WriteString('shorter word');
+       | notdo:
+               WriteString('"DO"');
+       | notof:
+               WriteString('"OF"');
+       | notend:
+               WriteString('"END"');
+       | notthen:
+               WriteString('"THEN"');
+       | notbegin:
+               WriteString('"BEGIN"');
+       | notuntil:
+               WriteString('"UNTIL"');
+       | notident:
+               WriteString('"identifier"');
+       | notsemicolon:
+               WriteString('";"');
+       | notperiod:
+               WriteString('"."');
+       | notcolon:
+               WriteString('":"');
+       | notparen:
+               WriteString('")"');
+       | noeof:
+               WriteString('END OF file');
+       END;
+       WriteString(' expected');
+       IF error >= longword THEN
+               WriteString(', NOT "');
+               WITH inline DO
+                       WITH curword DO
+                               IF size > maxrwlen THEN
+                                       ix := maxrwlen
+                               ELSE
+                                       ix := size;
+                               END;
+                               FOR i := 1 TO ix DO
+                                       Write(buf[base + i]);
+                               END;
+                       END;
+               END;
+               Write('"');
+       END;
+       IF error = noeof THEN
+               WriteString(', FORMATTING STOPS');
+       END;
+       WriteString(' !!! *)');
+       WriteLn;
+END WriteError;
+
+PROCEDURE ReadLine;
+(* Read line into input buffer *)
+VAR
+       c : CHAR;                       (* input character *)
+BEGIN
+       WITH inline DO
+               len := 0;
+               LOOP
+                       Read(c);
+                       IF NOT Done THEN
+                               endoffile := TRUE;
+                               EXIT;
+                       END;
+                       IF c = NEWLINE THEN
+                               EXIT;
+                       END;
+                       IF c < ' ' THEN (* convert ISO control chars (except
+                                               leading form feed) to spaces *)
+                               IF c = TAB THEN
+                                       (* ISO TAB char *)
+                                       c := ' ';
+                                       (* add last space at end *)
+                                       WHILE len MOD 8 <> 7 DO
+                                               len := len + 1;
+                                               IF len < maxinlen THEN
+                                                       buf[len] := c;
+                                               END;
+                                       END;
+                                       (* END tab handling *)
+                               ELSIF (c <> FF) OR (len > 0) THEN
+                                       c := ' ';
+                               END;
+                       END;            (* END ISO control char conversion *)
+                       len := len + 1;
+                       IF len < maxinlen THEN
+                               buf[len] := c;
+                       END;
+               END;
+               IF NOT endoffile THEN
+                       IF len >= maxinlen THEN
+                                       (* input line too long *)
+                               WriteError(longline, "(ReadLine), ");
+                               len := maxinlen - 1;
+                       END;
+                       WHILE (len > 0) AND (buf[len] = ' ') DO
+                               len := len - 1;
+                       END;
+               END;
+               len := len + 1;         (* add exactly ONE trailing blank *)
+               buf[len] := ' ';
+               index := 0;
+       END;
+END ReadLine;
+
+PROCEDURE GetChar;
+(* get next char from input buffer *)
+BEGIN
+       WITH inline DO
+               index := index + 1;
+               ch := buf[index];
+       END;
+END GetChar;
+
+PROCEDURE NextChar() : CHAR;
+(* look at next char in input buffer *)
+BEGIN
+       RETURN inline.buf[inline.index + 1];
+END NextChar;
+
+PROCEDURE StartWord(startclass : firstclass);
+(* note beginning of word, and count preceding lines and spaces *)
+VAR
+       first : BOOLEAN;                (* is word the first on input line? *)
+BEGIN
+       first := FALSE;
+       WITH inline DO
+               WITH curword DO
+                       whenfirst := startclass;
+                       blanklncount := 0;
+                       WHILE (index >= len) AND NOT endoffile DO
+                               IF len = 1 THEN
+                                       blanklncount := blanklncount + 1;
+                               END;
+                               IF startclass = contuncomm THEN
+                                       FlushLine
+                               ELSE
+                                       first := TRUE;
+                               END;
+                               ReadLine;
+                                       (* with exactly ONE trailing blank *)
+                               GetChar;
+                               IF ch = FF THEN
+                                       FlushLine;
+                                       Write(FF);
+                                       blanklncount := 0;
+                                       GetChar;
+                               END;
+                       END;
+                       spaces := 0;    (* count leading spaces *)
+                       IF NOT endoffile THEN
+                               WHILE ch = ' ' DO
+                                       spaces := spaces + 1;
+                                       GetChar;
+                               END;
+                       END;
+                       IF first THEN
+                               spaces := 1;
+                       END;
+                       base := index - 1;
+               END;
+       END;
+END StartWord;
+
+PROCEDURE FinishWord;
+(* note end of word *)
+BEGIN
+       WITH inline DO
+               WITH curword DO
+                       puncfollows := (symbol IN datawords) AND (ch <> ' ');
+                       size := index - base - 1;
+               END;
+       END;
+END FinishWord;
+
+PROCEDURE CopyWord(newline : BOOLEAN; pword : wordtype);
+(* copy word from input buffer into output buffer *)
+VAR
+       i : INTEGER;                    (* outline.len excess, loop index *)
+BEGIN
+       WITH pword DO
+               WITH outline DO
+                       i := maxoutlen - len - spaces - size;
+                       IF newline OR (i < 0) OR ((i = 0) AND puncfollows) THEN
+                               FlushLine;
+                       END;
+                       IF len = 0 THEN (* first word on output line *)
+                               blanklns := blanklncount;
+                               CASE whenfirst OF
+                                       (* update LOCAL word.spaces *)
+                               newclause:
+                                       spaces := margin;
+                               | continue:
+                                       spaces := margin;
+                               | alcomm:
+                                       spaces := alcommbase;
+                               | contalcomm:
+                                       spaces := alcommbase + commindent;
+                               | uncomm:
+                                       spaces := base;
+                               | contuncomm:
+                                       (* spaces := spaces *);
+                               END;
+                               IF spaces + size > maxoutlen THEN
+                                       spaces := maxoutlen - size;
+                                       (* reduce spaces *)
+                                       IF spaces < 0 THEN
+                                               WriteError(longword,
+                                               "(CopyWord), ");
+                                               size := maxoutlen;
+                                               spaces := 0;
+                                       END;
+                               END;
+                       END;
+                       FOR i := 1 TO spaces DO
+                                       (* put out spaces *)
+                               len := len + 1;
+                               buf[len] := ' ';
+                       END;
+                       FOR i := 1 TO size DO
+                                       (* copy actual word *)
+                               len := len + 1;
+                               buf[len] := inline.buf[base + i];
+                       END;
+               END;
+       END;
+END CopyWord;
+
+PROCEDURE DoComment;                    (* copy aligned or unaligned comment *)
+
+PROCEDURE CopyComment(commclass : firstclass; commbase : inrange);
+(* copy words of comment *)
+VAR
+       endcomment : BOOLEAN;           (* end of comment? *)
+BEGIN
+       WITH curword DO                 (* copy comment begin symbol *)
+               whenfirst := commclass;
+               spaces := commbase - outline.len;
+               CopyWord((spaces < 0) OR (blanklncount > 0), curword);
+       END;
+       commclass := VAL(firstclass, ORD(commclass)+1);
+       WITH inline DO
+               REPEAT                  (* loop for successive words *)
+                       StartWord(commclass);
+                       endcomment := endoffile;
+                                       (* premature end? *)
+                       IF endcomment THEN
+                               WriteError(noendcomm, "(CopyComment), ")
+                       ELSE
+                               REPEAT
+                                       IF ch = '*' THEN
+                                               GetChar;
+                                               IF ch = ')' THEN
+                                                       endcomment := TRUE;
+                                                       GetChar;
+                                               END;
+                                       ELSE
+                                               GetChar;
+                                       END;
+                               UNTIL (ch = ' ') OR endcomment;
+                       END;
+                       FinishWord;
+                       CopyWord(FALSE, curword)
+               UNTIL endcomment;
+       END;
+END CopyComment;
+
+BEGIN                                   (* DoComment *)
+       IF curword.base < commthresh THEN
+                                       (* copy comment without alignment *)
+               CopyComment(uncomm, curword.base)
+       ELSE                            (* align AND format comment *)
+               CopyComment(alcomm, alcommbase);
+       END;
+END DoComment;
+
+PROCEDURE GetSymbol;
+(* get next non-comment symbol *)
+
+PROCEDURE CopySymbol(symbol : symboltype; pword : wordtype);
+(* copy word(s) of symbol *)
+BEGIN
+       IF symbol = comment THEN
+               DoComment;              (* NOTE: DoComment uses global word! *)
+               lnpending := TRUE;
+       ELSIF symbol = semicolon THEN
+               CopyWord(FALSE, pword);
+               lnpending := NOT inheader;
+       ELSE
+               CopyWord(lnpending, pword);
+               lnpending := FALSE;
+       END;
+END CopySymbol;
+
+PROCEDURE FindSymbol;
+(* find next symbol in input buffer *)
+
+VAR
+       termch : CHAR;                  (* string terminator *)
+       chclass : chartype;             (* classification of leading char *)
+
+PROCEDURE CheckResWord;
+(* check if current identifier is reserved word/symbol *)
+VAR
+       rw, rwbeyond : resword;         (* loop index, limit *)
+       symword : rwstring;             (* copy of symbol word *)
+       i : [-1..maxrwlen];             (* loop index *)
+BEGIN
+       WITH curword DO
+               WITH inline DO
+                       size := index - base - 1;
+                       IF size < maxrwlen THEN
+                               symword := '               ';
+                               FOR i := 1 TO size DO
+                                       symword[i] := CAP(buf[ base + i]);
+                               END;
+                               rw := firstrw[size];
+                               rwbeyond := firstrw[size + 1];
+                               symbol := semicolon;
+                               REPEAT
+                                       IF rw >= rwbeyond THEN
+                                               symbol := ident
+                                       ELSIF StrCmp(symword, rwword[rw]) THEN
+                                               symbol := rwsy[rw]
+                                       ELSE
+                                               rw := VAL(resword,ORD(rw)+1);
+                                       END;
+                               UNTIL symbol <> semicolon;
+                       END;
+                       whenfirst := newclause;
+               END;
+       END;
+END CheckResWord;
+
+PROCEDURE GetName;
+BEGIN
+       WHILE charclass[inline.ch] IN chartypeset{letter, digit} DO
+               GetChar;
+       END;
+       CheckResWord;
+END GetName;
+
+PROCEDURE GetNumber;
+BEGIN
+       WITH inline DO
+               WHILE charclass[ch] = digit DO
+                       GetChar;
+               END;
+               IF ch = '.' THEN
+                       IF charclass[NextChar()] = digit THEN
+                                       (* NOTE: NextChar is a function! *)
+                               symbol := otherword;
+                               GetChar;
+                               WHILE charclass[ch] = digit DO
+                                       GetChar;
+                               END;
+                       END;
+               END;
+               IF CAP(ch) = 'E' THEN
+                       symbol := otherword;
+                       GetChar;
+                       IF (ch = '+') OR (ch = '-') THEN
+                               GetChar;
+                       END;
+                       WHILE charclass[ch] = digit DO
+                               GetChar;
+                       END;
+               END;
+       END;
+END GetNumber;
+
+PROCEDURE GetStringLiteral;
+VAR
+       endstring : BOOLEAN;            (* end of string literal? *)
+BEGIN
+       WITH inline DO
+               endstring := FALSE;
+               REPEAT
+                       GetChar;
+                       IF ch = termch THEN
+                               endstring := TRUE;
+                       ELSIF index >= len THEN
+                                       (* error, final "'" not on line *)
+                               WriteError(notquote, "(GetStringLiteral), ");
+                               symbol := syeof;
+                               endstring := TRUE;
+                       END;
+               UNTIL endstring;
+               GetChar;
+       END;
+END GetStringLiteral;
+
+BEGIN                                   (* FindSymbol *)
+       StartWord(continue);
+       WITH inline DO
+               IF endoffile THEN
+                       symbol := syeof
+               ELSE
+                       termch := ch;   (* save for string literal routine *)
+                       chclass := charclass[ch];
+                       symbol := symbolclass[chclass];
+                       GetChar;        (* second CHAR *)
+                       CASE chclass OF
+                       chsemicolon, chrightparen, chleftbrace, special,
+                       illegal: ;
+                       | letter:
+                               GetName;
+                       | digit:
+                               GetNumber;
+                       | chapostrophe:
+                               GetStringLiteral;
+                       | chcolon:
+                               IF ch = '=' THEN
+                                       symbol := othersym;
+                                       GetChar;
+                               END;
+                       | chlessthan:
+                               IF (ch = '=') OR (ch = '>') THEN
+                                       GetChar;
+                               END;
+                       | chgreaterthan:
+                               IF ch = '=' THEN
+                                       GetChar;
+                               END;
+                       | chleftparen:
+                               IF ch = '*' THEN
+                                       symbol := comment;
+                                       GetChar;
+                               END;
+                       | chperiod:
+                               IF ch = '.' THEN
+                                       symbol := colon;
+                                       GetChar;
+                               END;    (* Added by me (CJ):  *)
+                       ELSE
+                       END;
+                       FinishWord;
+               END;
+       END;                            (* FindSymbol *)
+END FindSymbol;
+
+BEGIN                                   (* GetSymbol *)
+       REPEAT
+               CopySymbol(symbol, curword);
+                                       (* copy word for symbol to output *)
+               FindSymbol              (* get next symbol *)
+       UNTIL symbol <> comment;
+END GetSymbol;
+
+PROCEDURE StartClause;
+(* (this may be a simple clause, or the start of a header) *)
+BEGIN
+       curword.whenfirst := newclause;
+       lnpending := TRUE;
+END StartClause;
+
+PROCEDURE PassSemicolons;
+(* pass consecutive semicolons *)
+BEGIN
+       WHILE symbol = semicolon DO
+               GetSymbol;
+               StartClause;
+       END;
+END PassSemicolons;
+
+PROCEDURE StartBody;
+(* finish header, start body of structure *)
+BEGIN
+       StartClause;
+       margin := margin + indent;
+END StartBody;
+
+PROCEDURE FinishBody;
+(* retract margin *)
+BEGIN
+       margin := margin - indent;
+END FinishBody;
+
+PROCEDURE PassPhrase(finalsymbol : symboltype);
+(* process symbols until significant symbol encountered *)
+VAR
+       endsyms : symbolset;            (* complete set of stopping symbols *)
+BEGIN
+       IF symbol <> syeof THEN
+               endsyms := stopsyms;
+               INCL(endsyms, finalsymbol);
+               REPEAT
+                       GetSymbol
+               UNTIL symbol IN endsyms;
+       END;
+END PassPhrase;
+
+PROCEDURE Expect(expectedsym : symboltype; error : errortype; syms : symbolset;
+nm : ARRAY OF CHAR);
+(* fail if current symbol is not the expected one, then recover *)
+BEGIN
+       IF symbol = expectedsym THEN
+               GetSymbol
+       ELSE
+               WriteError(error, nm);
+               INCL(syms, expectedsym);
+               WHILE NOT (symbol IN syms) DO
+                       GetSymbol;
+               END;
+               IF symbol = expectedsym THEN
+                       GetSymbol;
+               END;
+       END;
+END Expect;
+
+PROCEDURE Heading;
+(* process heading for program or procedure *)
+
+PROCEDURE MatchParens;                  (* process parentheses in heading *)
+VAR
+       endsyms : symbolset;
+BEGIN
+       GetSymbol;
+       WHILE NOT (symbol IN recendsyms) DO
+               IF symbol = leftparen THEN
+                       MatchParens
+               ELSE
+                       GetSymbol;
+               END;
+       END;
+       endsyms := stopsyms + recendsyms;
+       Expect(rightparen, notparen, endsyms, "(MatchParens), ");
+END MatchParens;
+
+BEGIN                                   (* heading *)
+       GetSymbol;
+       PassPhrase(leftparen);
+       IF symbol = leftparen THEN
+               inheader := TRUE;
+               MatchParens;
+               inheader := FALSE;
+       END;
+       IF symbol = colon THEN
+               PassPhrase(semicolon);
+       END;
+       Expect(semicolon, notsemicolon, stopsyms, "(Heading), ");
+
+END Heading;
+
+PROCEDURE DoRecord;
+(* process record declaration *)
+BEGIN
+       GetSymbol;
+       StartBody;
+       PassFields(FALSE);
+       FinishBody;
+       Expect(syend, notend, recendsyms, "(DoRecord), ");
+END DoRecord;
+
+PROCEDURE DoVariant;
+(* process (case) variant part *)
+BEGIN
+       PassPhrase(syof);
+       Expect(syof, notof, stopsyms, "(Dovariant), ");
+       StartBody;
+       PassFields(TRUE);
+       FinishBody;
+END DoVariant;
+
+PROCEDURE DoParens(forvariant : BOOLEAN);
+(* process parentheses in record *)
+BEGIN
+       GetSymbol;
+       IF forvariant THEN
+               StartBody;
+       END;
+       PassFields(FALSE);
+       lnpending := FALSE;             (* for empty field list *)
+       Expect(rightparen, notparen, recendsyms, "(DoParens), ");
+       IF forvariant THEN
+               FinishBody;
+       END;
+END DoParens;
+
+PROCEDURE PassFields(forvariant : BOOLEAN);
+(* process declarations *)
+BEGIN
+       WHILE NOT (symbol IN recendsyms) DO
+               IF symbol = semicolon THEN
+                       PassSemicolons
+               ELSIF symbol = syrecord THEN
+                       DoRecord
+               ELSIF symbol = sycase THEN
+                       DoVariant
+               ELSIF symbol = leftparen THEN
+                       DoParens(forvariant)
+               ELSE
+                       GetSymbol;
+               END;
+       END;
+END PassFields;
+
+PROCEDURE Statement;
+(* process statement *)
+BEGIN
+       CASE symbol OF
+       sycase:
+               CaseStatement;
+               Expect(syend, notend, stmtendsyms, "(Case), ");
+       | syif:
+               IfStatement;
+               Expect(syend, notend, stmtendsyms, "(If), ");
+       | syloop:
+               LoopStatement;
+               Expect(syend, notend, stmtendsyms, "(Loop), ");
+       | syrepeat:
+               RepeatStatement;
+       | forwhilewith:
+               ForWhileWithStatement;
+               Expect(syend, notend, stmtendsyms, "(ForWhileWith), ");
+       | ident:
+               AssignmentProccall;
+       | semicolon: ;                  (*!!! Added by me (CJ) *)
+       ELSE ;
+       END;
+END Statement;
+
+PROCEDURE AssignmentProccall;
+(* pass an assignment statement or procedure call *)
+BEGIN
+       WHILE NOT (symbol IN stmtendsyms) DO
+               GetSymbol;
+       END;
+END AssignmentProccall;
+
+PROCEDURE StatementSequence;
+(* process sequence of statements *)
+BEGIN
+       Statement;
+       LOOP
+               IF symbol <> semicolon THEN
+                       EXIT;
+               END;
+               GetSymbol;
+               Statement;
+       END;
+END StatementSequence;
+
+PROCEDURE IfStatement;
+(* process if statement *)
+BEGIN
+       PassPhrase(sythen);
+       Expect(sythen, notthen, stopsyms, "(Ifstatement), ");
+       StartBody;
+       StatementSequence;
+       FinishBody;
+       WHILE symbol = syelsif DO
+               StartClause;
+               PassPhrase(sythen);
+               Expect(sythen, notthen, stopsyms, "(Elseif), ");
+               StartBody;              (* new line after 'THEN' *)
+               StatementSequence;
+               FinishBody;
+       END;
+       IF symbol = syelse THEN
+               StartClause;
+               GetSymbol;
+               StartBody;              (* new line after 'ELSE' *)
+               StatementSequence;
+               FinishBody;
+       END;
+END IfStatement;
+
+PROCEDURE CaseStatement;
+(* process case statement *)
+BEGIN
+       PassPhrase(syof);
+       Expect(syof, notof, stopsyms, "(caseStatement), ");
+       StartClause;
+       OneCase;
+       WHILE symbol = bar DO
+               GetSymbol;
+               OneCase;
+       END;
+       IF symbol = syelse THEN
+               GetSymbol;
+               StartBody;
+               StatementSequence;
+               FinishBody;
+       END;
+END CaseStatement;
+
+PROCEDURE OneCase;
+(* process one case clause *)
+BEGIN
+       IF NOT (symbol IN symbolset{bar, syelse}) THEN
+               PassPhrase(colon);
+               Expect(colon, notcolon, stopsyms, "(OneCase), ");
+               StartBody;              (* new line, indent after colon *)
+               StatementSequence;
+               FinishBody;             (* left-indent after case *)
+       END;
+END OneCase;
+
+PROCEDURE RepeatStatement;
+(* process repeat statement *)
+BEGIN
+       GetSymbol;
+       StartBody;                      (* new line, indent after 'REPEAT' *)
+       StatementSequence;
+       FinishBody;                     (* left-ident after UNTIL *)
+       StartClause;                    (* new line before UNTIL *)
+       Expect(syuntil, notuntil, stmtendsyms, "(repeatstatement), ");
+       PassPhrase(semicolon);
+END RepeatStatement;
+
+PROCEDURE LoopStatement;
+(* process loop statement *)
+BEGIN
+       GetSymbol;
+       StartBody;                      (* new line, indent after LOOP *)
+       StatementSequence;
+       FinishBody;                     (* left-ident before END *)
+END LoopStatement;
+
+PROCEDURE ForWhileWithStatement;
+(* process for, while, or with statement *)
+BEGIN
+       PassPhrase(sydo);
+       Expect(sydo, notdo, stopsyms, "(ForWhileWithstatement), ");
+       StartBody;
+       StatementSequence;
+       FinishBody;
+END ForWhileWithStatement;
+
+PROCEDURE ProcedureDeclaration;
+(* pass a procedure declaration *)
+BEGIN
+       ProcedureHeading;
+       Block;
+       Expect(ident, notident, stmtendsyms, "(Proceduredeclaration)1, ");
+       Expect(semicolon, notsemicolon, stmtendsyms,
+       "(Proceduredeclaration)2, ");
+END ProcedureDeclaration;
+
+PROCEDURE ProcedureHeading;
+BEGIN
+       StartClause;
+       Heading;
+END ProcedureHeading;
+
+PROCEDURE Block;
+BEGIN
+       WHILE symbol IN symbolset{declarator, symodule, syproc} DO
+               Declaration;
+       END;
+       IF symbol = sybegin THEN
+               GetSymbol;
+               StartBody;
+               StatementSequence;
+               FinishBody;
+       END;
+       Expect(syend, notend, stmtendsyms, "(Block), ");
+END Block;
+
+PROCEDURE Declaration;
+BEGIN
+       IF symbol = declarator THEN
+               StartClause;            (* CONST, TYPE, VAR *)
+               GetSymbol;
+               StartBody;
+               REPEAT
+                       PassPhrase(syrecord);
+                       IF symbol = syrecord THEN
+                               DoRecord;
+                       END;
+                       IF symbol = semicolon THEN
+                               PassSemicolons;
+                       END;
+               UNTIL symbol IN headersyms;
+               FinishBody;
+       ELSIF symbol = symodule THEN
+               ModuleDeclaration;
+       ELSIF symbol = syproc THEN
+               ProcedureDeclaration;
+       END;
+END Declaration;
+
+PROCEDURE ModuleDeclaration;
+BEGIN
+       PassPhrase(semicolon);
+       PassSemicolons;
+       WHILE symbol IN symbolset{syimport, syexport, syfrom} DO
+               ImportExport;
+       END;
+       Block;
+       Expect(ident, notident, stmtendsyms, "(ModuleDeclaration), ");
+END ModuleDeclaration;
+
+PROCEDURE ImportExport;
+BEGIN
+       IF symbol = syfrom THEN
+               PassPhrase(syimport);
+       END;
+       IF symbol = syimport THEN
+               GetSymbol;
+       ELSIF symbol = syexport THEN
+               GetSymbol;
+               IF symbol = syqual THEN
+                       GetSymbol;
+               END;
+       END;
+       StartBody;
+       PassPhrase(semicolon);
+       FinishBody;
+       GetSymbol;
+END ImportExport;
+
+PROCEDURE OneDefinition;
+BEGIN
+       IF symbol = declarator THEN
+               Declaration;
+       ELSIF symbol = syproc THEN
+               ProcedureHeading;
+       END;
+END OneDefinition;
+
+PROCEDURE DefinitionModule;
+BEGIN
+       GetSymbol;
+       PassPhrase(semicolon);
+       GetSymbol;
+       WHILE symbol IN symbolset{syimport, syexport, syfrom} DO
+               ImportExport;
+       END;
+       WHILE symbol IN symbolset{declarator, syproc} DO
+               OneDefinition;
+       END;
+       Expect(syend, notend, stmtendsyms, "DefinitionModule1, " );
+       GetSymbol;
+       Expect(period, notperiod, stmtendsyms, 'DefintionModule2, ');
+END DefinitionModule;
+
+PROCEDURE ProgramModule;
+BEGIN
+       ModuleDeclaration;
+       Expect(period, notperiod, stmtendsyms, "ProgramModule, ");
+END ProgramModule;
+
+PROCEDURE CompilationUnit;
+BEGIN
+       IF symbol = syimplementation THEN
+               GetSymbol;
+               ProgramModule;
+       ELSIF symbol = sydefinition THEN
+               DefinitionModule;
+       ELSE
+               ProgramModule;
+       END;
+END CompilationUnit;
+
+PROCEDURE CopyRemainder;
+(* copy remainder of input *)
+BEGIN
+       WriteError(noeof, "(Copyremainder), ");
+       WITH inline DO
+               REPEAT
+                       CopyWord(FALSE, curword);
+                       StartWord(contuncomm);
+                       IF NOT endoffile THEN
+                               REPEAT
+                                       GetChar
+                               UNTIL ch = ' ';
+                       END;
+                       FinishWord;
+               UNTIL endoffile;
+       END;
+END CopyRemainder;
+
+PROCEDURE Initialize;
+(* initialize global variables *)
+BEGIN
+       WITH inline DO
+               endoffile := FALSE;
+               ch := ' ';
+               index := 0;
+               len := 0;
+       END;
+       WITH outline DO
+               blanklns := 0;
+               len := 0;
+       END;
+       WITH curword DO
+               whenfirst := contuncomm;
+               puncfollows := FALSE;
+               blanklncount := 0;
+               spaces := 0;
+               base := 0;
+               size := 0;
+       END;
+       margin := initmargin;
+       lnpending := FALSE;
+       symbol := othersym;
+END Initialize;
+
+BEGIN
+       StructConsts;
+       Initialize;
+(* Files may be opened here. *)
+       OpenInput("mod");
+       OpenOutput("mod");
+       GetSymbol;
+       CompilationUnit;
+       IF NOT inline.endoffile THEN
+               CopyRemainder;
+       END;
+       FlushLine;
+       CloseInput;
+       CloseOutput;
+END Modula2PrettyPrinter.

diff --git a/lang/m2/test/queens.mod b/lang/m2/test/queens.mod
new file mode 100644 (file)
index 0000000..5279761
--- /dev/null
+++ b/lang/m2/test/queens.mod
@@ -0,0 +1,55 @@
+MODULE queen;
+FROM InOut IMPORT WriteString, WriteLn;
+       TYPE row = ARRAY[1..8] OF INTEGER;
+       VAR  maxpos: INTEGER;
+            d: row;
+       PROCEDURE free(i,j: INTEGER): BOOLEAN;
+               VAR k: INTEGER;
+       BEGIN
+               FOR k := 1 TO i-1 DO
+                       IF (d[k]=j) OR (j-d[k]=i-k) OR (d[k]-j=i-k) THEN
+                               RETURN FALSE;
+                       END;
+               END;
+               RETURN TRUE;
+       END free;
+
+       PROCEDURE print;
+               VAR i,j: INTEGER;
+       BEGIN
+               FOR j := maxpos TO 1 BY -1 DO
+                       FOR i := 1 TO maxpos DO
+                               IF d[i] = j THEN
+                                       WriteString("D ");
+                               ELSE
+                                       WriteString(". ");
+                               END;
+                       END;
+                       WriteLn;
+               END;
+               WriteLn;
+       END print;
+
+       PROCEDURE queen(k: INTEGER);
+               VAR i: INTEGER;
+       BEGIN
+               IF k = maxpos THEN
+                       FOR i := 1 TO maxpos DO
+                               IF free(k,i) THEN
+                                       d[k] := i;
+                                       print();
+                               END;
+                       END;
+               ELSE
+                       FOR i := 1 TO maxpos DO
+                               IF free(k,i) THEN
+                                       d[k] := i;
+                                       queen(k+1);
+                               END;
+                       END;
+               END;
+       END queen;
+BEGIN
+       maxpos := 8;
+       queen(1);
+END queen.