Initial revision

lang/m2/test/.distr

@@ -0,0 +1,5 @@
+Thalmann
+Wirth
+getenv.mod
+m2p.mod
+queens.mod

lang/m2/test/Thalmann/.distr

@@ -0,0 +1,5 @@
+LifeGame.mod
+Shoes.mod
+StoreFetch.mod
+bold.mod
+characters.mod

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.

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.

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.

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.

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.
+

lang/m2/test/Wirth/.distr

@@ -0,0 +1,5 @@
+PowersOf2.mod
+TableHandl.def
+TableHandl.mod
+XREF.mod
+makefile

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.
+

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.

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.

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)

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.

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.