fixes, different traps, new files

lang/m2/libm2/.distr

@@ -4,6 +4,7 @@ ASCII.def
 Arguments.def
 Conversion.def
 EM.def
+PascalIo.def
 InOut.def
 Makefile
 Mathlib.def
@@ -19,3 +20,4 @@ Terminal.def
 Unix.def
 head_m2.e
 random.def
+Traps.def

lang/m2/libm2/EM.def

@@ -1,6 +1,10 @@
 (*$Foreign *)
 DEFINITION MODULE EM;
-(* An interface to EM instructions *)
+(* An interface to EM instructions and data *)
+
+	FROM SYSTEM IMPORT ADDRESS;
+
+	TYPE TrapHandler = PROCEDURE(INTEGER);
 
 	PROCEDURE FIF(arg1, arg2: LONGREAL; VAR intres: LONGREAL) : LONGREAL;
 	(* multiplies arg1 and arg2, and returns the integer part of the
@@ -14,4 +18,10 @@ DEFINITION MODULE EM;
 
 	PROCEDURE TRP(trapno: INTEGER);
 	(* Generate EM trap number "trapno" *)
+
+	PROCEDURE SIG(t: TrapHandler): TrapHandler;
+
+	PROCEDURE FILN(): ADDRESS;
+
+	PROCEDURE LINO(): INTEGER;
 END EM.

lang/m2/libm2/EM.e

@@ -58,3 +58,31 @@
  trp
  ret 0
  end ?
+
+#define PROC    0
+
+; SIG is called with one parameter:
+;       - procedure instance identifier (PROC)
+; and returns the old traphandler.
+; only the procedure identifier inside the PROC is used.
+
+ exp $SIG
+ pro $SIG, 0
+ lal PROC
+ loi EM_PSIZE
+ sig
+ ret EM_PSIZE
+ end ?
+
+ exp $LINO
+ pro $LINO,0
+ loe 0
+ ret EM_WSIZE
+ end ?
+
+ exp $FILN
+ pro $FILN,0
+ lae 4
+ loi EM_PSIZE
+ ret EM_PSIZE
+ end ?

lang/m2/libm2/InOut.mod

@@ -1,9 +1,8 @@
-#include <em_abs.h>
 IMPLEMENTATION MODULE InOut ;
 
   IMPORT Unix;
   IMPORT Conversions;
-  IMPORT EM;
+  IMPORT Traps;
   FROM TTY IMPORT isatty;
   FROM SYSTEM IMPORT ADR;
 
@@ -244,7 +243,8 @@ IMPLEMENTATION MODULE InOut ;
 	   	IF (int > SAFELIMITDIV10) OR 
 		   ( (int = SAFELIMITDIV10) AND
 		     (chvalue > safedigit)) THEN
-			EM.TRP(EIOVFL);
+			Traps.Message("integer too large");
+			HALT;
 	    	ELSE
 			int := 10*int + VAL(INTEGER, chvalue);
 			INC(index)
@@ -256,7 +256,8 @@ IMPLEMENTATION MODULE InOut ;
 		integ := int
 	END;
 	IF buf[index] > " " THEN
-		EM.TRP(66);
+		Traps.Message("illegal integer");
+		HALT;
 	END;
 	Done := TRUE;
   END ReadInt;
@@ -287,14 +288,16 @@ IMPLEMENTATION MODULE InOut ;
 	    	IF (int > SAFELIMITDIV10) OR 
 		   ( (int = SAFELIMITDIV10) AND
 		     (chvalue > safedigit)) THEN
-			EM.TRP(EIOVFL);
+			Traps.Message("cardinal too large");
+			HALT;
 	    	ELSE
 			int := 10*int + chvalue;
 			INC(index);
 	    	END;
 	END;
 	IF buf[index] > " " THEN
-		EM.TRP(67);
+		Traps.Message("illegal cardinal");
+		HALT;
 	END;
 	card := int;
 	Done := TRUE;
@@ -310,7 +313,9 @@ IMPLEMENTATION MODULE InOut ;
 	REPEAT
 		Read(ch);
 	UNTIL NOT (ch IN charset{' ', TAB, 12C, 15C});
-	UnRead(ch);
+	IF NOT Done THEN
+		RETURN;
+	END;
     	REPEAT
 		Read(ch);
 		termCH := ch;
@@ -322,7 +327,7 @@ IMPLEMENTATION MODULE InOut ;
 		END;
 		INC(i);
     	UNTIL (NOT Done) OR (ch <= " ");
-	UnRead(ch);
+	IF Done THEN UnRead(ch); END;
   END ReadString;
 
   PROCEDURE XReadString(VAR s : ARRAY OF CHAR);

lang/m2/libm2/LIST

@@ -1,4 +1,5 @@
 tail_m2.a
+PascalIo.mod
 RealInOut.mod
 InOut.mod
 Terminal.mod
@@ -13,9 +14,9 @@ Conversion.mod
 Semaphores.mod
 random.mod
 Strings.mod
+Traps.mod
 Arguments.c
 catch.c
-hol0.e
 LtoUset.e
 StrAss.c
 absd.c

lang/m2/libm2/Makefile

@@ -5,7 +5,7 @@ SOURCES =	ASCII.def EM.def MathLib0.def Processes.def \
 		RealInOut.def Storage.def Arguments.def Conversion.def \
 		random.def Semaphores.def Unix.def RealConver.def \
 		Strings.def InOut.def Terminal.def TTY.def \
-		Mathlib.def
+		Mathlib.def PascalIo.def Traps.def
 
 all:
 

lang/m2/libm2/PascalIO.def

@@ -0,0 +1,138 @@
+DEFINITION MODULE PascalIo;
+(* This module provides for I/O that is essentially equivalent to the I/O
+   provided by Pascal with "text", or "file of char".
+   However, the user must call a cleanup routine at the end of his program
+   for the output buffers to be flushed.
+*)
+
+  CONST	EOS = 0C;		(* End of string character *)
+
+  TYPE	Text;
+
+  VAR	input, output: Text;	(* standard input and standard output available
+				   immediately.
+				   Standard output is not buffered when
+				   connected to a terminal.
+				*)
+  VAR	notext: Text;		(* Initialize your Text variables with this *)
+
+  PROCEDURE Reset(filename: ARRAY OF CHAR; VAR inputtext: Text);
+  (* When inputtext indicates an open textfile, it is first flushed
+     and closed. Then, the file indicated by "filename" is opened for reading.
+     If this fails, a runtime error results. Otherwise, inputtext is
+     associated with the new input file.
+  *)
+
+  PROCEDURE Rewrite(filename: ARRAY OF CHAR; VAR outputtext: Text);
+  (* When outputtext indicates an open textfile, it is first flushed
+     and closed. Then, the file indicated by "filename" is opened for writing.
+     If this fails, a runtime error results. Otherwise, outputtext is
+     associated with the new output file.
+  *)
+
+  PROCEDURE PascalIoCleanup();
+  (* To be called at the end of the program, to flush all output buffers *)
+
+  (***************************************************************************
+     Input routines;
+     All these routines result in a runtime error when not called with either
+     "input", or a "Text" value obtained by Reset.
+     Also, the routines that actually advance the "read pointer", result in a
+     runtime error when end of file is reached prematurely.
+  ****************************************************************************)
+
+  PROCEDURE NextCHAR(inputtext: Text): CHAR;
+  (* Returns the next character of the inputtext, 0C on end of file.
+     Does not advance the "read pointer", so behaves much like "input^"
+     in Pascal. However, unlike Pascal, if Eoln(inputtext) is true, it
+     returns the newline character, rather than a space.
+  *)
+
+  PROCEDURE Get(inputtext: Text);
+  (* Advances the "read pointer" by one character *)
+
+  PROCEDURE Eoln(inputtext: Text): BOOLEAN;
+  (* Returns TRUE if the next character of the inputtext is a linefeed *)
+
+  PROCEDURE Eof(inputtext: Text): BOOLEAN;
+  (* Returns TRUE if the end of the inputtext is reached *)
+
+  PROCEDURE ReadCHAR(inputtext: Text; VAR ch: CHAR);
+  (* Read a character from the inputtext, and leave result in "ch" *)
+
+  PROCEDURE ReadLn(inputtext: Text);
+  (* Skip the rest of the current line of the inputtext, including the linefeed *)
+
+  PROCEDURE ReadINTEGER(inputtext: Text; VAR int: INTEGER);
+  (* Skip leading blanks, read an optionally signed integer from the
+     inputtext, and leave the result in "int".
+     If no integer is read, or when overflow occurs, a runtime error results.
+     Input stops at the character following the integer.
+  *)
+
+  PROCEDURE ReadCARDINAL(inputtext: Text; VAR card: CARDINAL);
+  (* Skip leading blanks, read a cardinal from the inputtext, and leave the
+     result in "card".
+     If no cardinal is read, or when overflow occurs, a runtime error results.
+     Input stops at the character following the integer.
+  *)
+
+  PROCEDURE ReadREAL(inputtext: Text; VAR real: REAL);
+  (* Skip leading blanks, read a real from the inputtext, and leave the
+     result in "card".
+     Syntax:
+      real -->	[(+|-)] digit {digit} [. digit {digit}]
+		[ (e|E) [(+|-)] digit {digit} ]
+     If no real is read, or when overflow/underflow occurs, a runtime error
+     results.
+     Input stops at the character following the integer.
+  *)
+
+  (***************************************************************************
+     Output routines;
+     All these routines result in a runtime error when not called with either
+     "output", or a "Text" value obtained by Rewrite.
+  ****************************************************************************)
+
+  PROCEDURE WriteCHAR(outputtext: Text; ch: CHAR);
+  (* Writes the character "ch" to the outputtext *)
+
+  PROCEDURE WriteLn(outputtext: Text);
+  (* Writes a linefeed to the outputtext *)
+
+  PROCEDURE Page(outputtext: Text);
+  (* Writes a form-feed to the outputtext *)
+
+  PROCEDURE WriteINTEGER(outputtext: Text; int: INTEGER; width: CARDINAL);
+  (* Write integer "int" to the outputtext, using at least "width" places,
+     blank-padding to the left if needed.
+  *)
+
+  PROCEDURE WriteCARDINAL(outputtext: Text; card: CARDINAL; width: CARDINAL);
+  (* Write cardinal "card" to the outputtext, using at least "width" places,
+     blank-padding to the left if needed.
+  *)
+
+  PROCEDURE WriteBOOLEAN(outputtext: Text; bool: BOOLEAN; width: CARDINAL);
+  (* Write boolean "bool" to the outputtext, using at least "width" places,
+     blank-padding to the left if needed.
+     Equivalent to WriteSTRING(" TRUE", width), or
+		   WriteSTRING("FALSE", width)
+  *)
+
+  PROCEDURE WriteSTRING(outputtext: Text;
+			str: ARRAY OF CHAR; width: CARDINAL);
+  (* Write string "str" to the outputtext, using at least "width" places,
+     blank-padding to the left if needed.
+     The string is terminated either by the character EOS, or the upperbound of
+     the array "str".
+  *)
+
+  PROCEDURE WriteREAL(outputtext: Text; real: REAL; width, nfrac: CARDINAL);
+  (* Write real "real" to the outputtext. If "nfrac" = 0, use scientific
+     notation, otherwise use fixed-point notation with "nfrac" digits behind
+     the dot.
+     Always use at least "width" places, blank-padding to the left if needed.
+  *)
+
+END PascalIo.

lang/m2/libm2/PascalIO.mod

@@ -0,0 +1,471 @@
+IMPLEMENTATION MODULE PascalIo;
+
+  IMPORT Unix;
+  IMPORT Conversions;
+  IMPORT Traps;
+  IMPORT RealConversions;
+  FROM TTY IMPORT isatty;
+  FROM Storage IMPORT ALLOCATE;
+  FROM SYSTEM IMPORT ADR;
+
+  TYPE	charset = SET OF CHAR;
+	btype = (reading, writing, free);
+
+  CONST	BUFSIZ = 1024;		(* Tunable *)
+	spaces = charset{11C, 12C, 13C, 14C, 15C, ' '};
+
+  TYPE	IOBuf = RECORD
+			type: btype;
+			eof: BOOLEAN;
+			next: Text;
+			fildes: INTEGER;
+			cnt: INTEGER;
+			maxcnt: INTEGER;
+			bufferedcount: INTEGER;
+			buf: ARRAY [1..BUFSIZ] OF CHAR;
+		END;
+	Text =	POINTER TO IOBuf;
+	numbuf = ARRAY[0..255] OF CHAR;
+
+  VAR	ibuf, obuf: IOBuf;
+	head: Text;
+
+  PROCEDURE Reset(filename: ARRAY OF CHAR; VAR inputtext: Text);
+  BEGIN
+	doclose(inputtext);
+	getstruct(inputtext);
+	WITH inputtext^ DO
+		eof := FALSE;
+		fildes := Unix.open(ADR(filename), 0);
+		IF fildes < 0 THEN
+			Traps.Message("could not open input file");
+			HALT;
+		END;
+		type := reading;
+		cnt := 1;
+		maxcnt := 0;
+		bufferedcount := BUFSIZ;
+	END;
+  END Reset;
+
+  PROCEDURE Rewrite(filename: ARRAY OF CHAR; VAR outputtext: Text);
+  BEGIN
+	doclose(outputtext);
+	getstruct(outputtext);
+	WITH outputtext^ DO
+		eof := FALSE;
+		fildes := Unix.creat(ADR(filename), 666B);
+		IF fildes < 0 THEN
+			Traps.Message("could not open output file");
+			HALT;
+		END;
+		type := writing;
+		cnt := 0;
+		maxcnt := 0;
+		bufferedcount := BUFSIZ;
+	END;
+  END Rewrite;
+
+  PROCEDURE PascalIoCleanup();
+  VAR text: Text;
+  BEGIN
+	text := head;
+	WHILE text # NIL DO
+		doclose(text);
+		text := text^.next;
+	END;
+  END PascalIoCleanup;
+
+  PROCEDURE doclose(text: Text);
+  VAR dummy: INTEGER;
+  BEGIN
+	IF text # notext THEN
+		WITH text^ DO
+			IF type = writing THEN
+				Flush(text);
+			END;
+			IF type # free THEN
+				type := free;
+				dummy := Unix.close(fildes);
+			END;
+		END;
+	END;
+  END doclose;
+
+  PROCEDURE getstruct(VAR text: Text);
+  BEGIN
+	text := head;
+	WHILE (text # NIL) AND (text^.type # free) DO
+		text := text^.next;
+	END;
+	IF text = NIL THEN
+		NEW(text);
+		text^.next := head;
+		head := text;
+	END;
+  END getstruct;
+
+  PROCEDURE chk(text: Text; tp: btype);
+  BEGIN
+	IF text^.type # tp THEN
+		IF tp = reading THEN
+			Traps.Message("input text expected");
+		ELSE
+			Traps.Message("output text expected");
+		END;
+		HALT;
+	END;
+  END chk;
+
+  PROCEDURE ReadCHAR(inputtext: Text; VAR ch : CHAR);
+  BEGIN
+	ch := NextCHAR(inputtext);
+	Get(inputtext);
+  END ReadCHAR;
+
+  PROCEDURE NextCHAR(inputtext: Text): CHAR;
+  VAR c: CHAR;
+  BEGIN
+	chk(inputtext, reading);
+	WITH inputtext^ DO
+		IF cnt <= maxcnt THEN
+			c := buf[cnt];
+		ELSE
+			c := FillBuf(inputtext);
+		END;
+	END;
+	RETURN c;
+  END NextCHAR;
+
+  PROCEDURE Get(inputtext: Text);
+  VAR dummy: CHAR;
+  BEGIN
+	chk(inputtext, reading);
+	WITH inputtext^ DO
+		IF eof THEN
+			(* ??? trap here ??? *)
+		END;
+		IF cnt > maxcnt THEN
+			dummy := FillBuf(inputtext);
+		END;
+		INC(cnt);
+	END;
+  END Get;
+
+  PROCEDURE FillBuf(ib: Text) : CHAR;
+  VAR c : CHAR;
+  BEGIN
+	WITH ib^ DO
+		IF eof THEN RETURN 0C; END;
+		maxcnt := Unix.read(fildes, ADR(buf), bufferedcount);
+		cnt := 1;
+		IF maxcnt <= 0 THEN
+			c :=  0C;
+			eof := TRUE;
+		ELSE
+			c :=  buf[1];
+		END;
+	END;
+	RETURN c;
+  END FillBuf;
+
+  PROCEDURE Eoln(inputtext: Text): BOOLEAN;
+  BEGIN
+	RETURN NextCHAR(inputtext) = 12C;
+  END Eoln;
+
+  PROCEDURE Eof(inputtext: Text): BOOLEAN;
+  BEGIN
+	RETURN (NextCHAR(inputtext) = 0C) AND inputtext^.eof;
+  END Eof;
+
+  PROCEDURE ReadLn(inputtext: Text);
+  VAR ch: CHAR;
+  BEGIN
+	REPEAT
+		ReadCHAR(inputtext, ch)
+	UNTIL ch = 12C;
+  END ReadLn;
+
+  PROCEDURE Flush(ob: Text);
+  VAR dummy: INTEGER;
+  BEGIN
+	WITH ob^ DO
+		dummy := Unix.write(fildes, ADR(buf), cnt);
+		cnt := 0;
+	END;
+  END Flush;
+
+  PROCEDURE WriteCHAR(outputtext: Text; ch: CHAR);
+  BEGIN
+	chk(outputtext, writing);
+	WITH outputtext^ DO
+		INC(cnt);
+		buf[cnt] := ch;
+		IF cnt >= bufferedcount THEN
+			Flush(outputtext);
+		END;
+	END;
+  END WriteCHAR;
+
+  PROCEDURE WriteLn(outputtext: Text);
+  BEGIN
+	WriteCHAR(outputtext, 12C);
+  END WriteLn;
+
+  PROCEDURE Page(outputtext: Text);
+  BEGIN
+	WriteCHAR(outputtext, 14C);
+  END Page;
+
+  PROCEDURE ReadINTEGER(inputtext: Text; VAR int : INTEGER);
+  CONST
+    	SAFELIMITDIV10 = MAX(INTEGER) DIV 10;
+    	SAFELIMITREM10 = MAX(INTEGER) MOD 10;
+  VAR
+    	neg : BOOLEAN;
+    	safedigit: CARDINAL;
+	ch: CHAR;
+    	chvalue: CARDINAL;
+  BEGIN
+    	WHILE NextCHAR(inputtext) IN spaces DO
+		Get(inputtext);
+	END;
+	ch := NextCHAR(inputtext);
+    	IF ch = '-' THEN
+		Get(inputtext);
+		ch := NextCHAR(inputtext);
+		neg := TRUE;
+    	ELSIF ch = '+' THEN
+		Get(inputtext);
+		ch := NextCHAR(inputtext);
+		neg := FALSE;
+    	ELSE
+		neg := FALSE
+    	END;
+
+    	safedigit := SAFELIMITREM10;
+    	IF neg THEN safedigit := safedigit + 1 END;
+    	int := 0;
+	IF (ch >= '0') AND (ch <= '9') THEN
+		WHILE (ch >= '0') & (ch <= '9') DO
+  			chvalue := ORD(ch) - ORD('0');
+	   		IF (int < -SAFELIMITDIV10) OR 
+		   	   ( (int = -SAFELIMITDIV10) AND
+		     	     (chvalue > safedigit)) THEN
+				Traps.Message("integer too large");
+				HALT;
+	    		ELSE
+				int := 10*int - VAL(INTEGER, chvalue);
+				Get(inputtext);
+				ch := NextCHAR(inputtext);
+	    		END;
+		END;
+		IF NOT neg THEN
+   			int := -int
+		END;
+	ELSE
+		Traps.Message("integer expected");
+		HALT;
+	END;
+  END ReadINTEGER;
+
+  PROCEDURE ReadCARDINAL(inputtext: Text; VAR card : CARDINAL);
+  CONST
+    	SAFELIMITDIV10 = MAX(CARDINAL) DIV 10;
+    	SAFELIMITREM10 = MAX(CARDINAL) MOD 10;
+
+  VAR
+    	ch : CHAR;
+    	safedigit: CARDINAL;
+    	chvalue: CARDINAL;
+  BEGIN
+    	WHILE NextCHAR(inputtext) IN spaces DO
+		Get(inputtext);
+	END;
+	ch := NextCHAR(inputtext);
+    	safedigit := SAFELIMITREM10;
+    	card := 0;
+	IF (ch >= '0') AND (ch <= '9') THEN
+		WHILE (ch >= '0') & (ch <= '9') DO
+  			chvalue := ORD(ch) - ORD('0');
+	    		IF (card > SAFELIMITDIV10) OR 
+			   ( (card = SAFELIMITDIV10) AND
+			     (chvalue > safedigit)) THEN
+				Traps.Message("cardinal too large");
+				HALT;
+		    	ELSE
+				card := 10*card + chvalue;
+				Get(inputtext);
+				ch := NextCHAR(inputtext);
+		    	END;
+		END;
+	ELSE
+		Traps.Message("cardinal expected");
+		HALT;
+	END;
+  END ReadCARDINAL;
+
+  PROCEDURE ReadREAL(inputtext: Text; VAR real: REAL);
+  VAR
+	buf: numbuf;
+	ch: CHAR;
+	ok: BOOLEAN;
+	index: INTEGER;
+  BEGIN
+	index := 0;
+    	WHILE NextCHAR(inputtext) IN spaces DO
+		Get(inputtext);
+	END;
+	ch := NextCHAR(inputtext);
+	IF (ch ='+') OR (ch = '-') THEN
+		buf[index] := ch;
+		INC(index);
+		Get(inputtext);
+		ch := NextCHAR(inputtext);
+	END;
+	IF (ch >= '0') AND (ch <= '9') THEN
+		WHILE (ch >= '0') AND (ch <= '9') DO
+			buf[index] := ch;
+			INC(index);
+			Get(inputtext);
+			ch := NextCHAR(inputtext);
+		END;
+		IF (ch = '.') THEN
+			IF (ch >= '0') AND (ch <= '9') THEN
+				WHILE (ch >= '0') AND (ch <= '9') DO
+					buf[index] := ch;
+					INC(index);
+					Get(inputtext);
+					ch := NextCHAR(inputtext);
+				END;
+			ELSE
+				ok := FALSE;
+			END;
+		END;
+		IF ok AND (ch = 'E') THEN
+			Get(inputtext);
+			ch := NextCHAR(inputtext);
+			IF (ch ='+') OR (ch = '-') THEN
+				buf[index] := ch;
+				INC(index);
+				Get(inputtext);
+				ch := NextCHAR(inputtext);
+			END;
+			IF (ch >= '0') AND (ch <= '9') THEN
+				WHILE (ch >= '0') AND (ch <= '9') DO
+					buf[index] := ch;
+					INC(index);
+					Get(inputtext);
+					ch := NextCHAR(inputtext);
+				END;
+			ELSE
+				ok := FALSE;
+			END;
+		END;
+	ELSE
+		ok := FALSE;
+	END;
+	IF ok THEN
+		buf[index] := 0C;
+		RealConversions.StringToReal(buf, real, ok);
+	END;
+	IF NOT ok THEN
+		Traps.Message("Illegal real");
+		HALT;
+	END;
+  END ReadREAL;
+
+  PROCEDURE WriteCARDINAL(outputtext: Text; card: CARDINAL; width: CARDINAL);
+  VAR
+    	buf : numbuf;
+  BEGIN
+	Conversions.ConvertCardinal(card, 1, buf);
+	WriteSTRING(outputtext, buf, width);
+  END WriteCARDINAL;
+
+  PROCEDURE WriteINTEGER(outputtext: Text; int: INTEGER; width: CARDINAL);
+  VAR
+    	buf : numbuf;
+  BEGIN
+    	Conversions.ConvertInteger(int, 1, buf);
+	WriteSTRING(outputtext, buf, width);
+  END WriteINTEGER;
+
+  PROCEDURE WriteBOOLEAN(outputtext: Text; bool: BOOLEAN; width: CARDINAL);
+  BEGIN
+	IF bool THEN
+		WriteSTRING(outputtext, " TRUE", width);
+	ELSE
+		WriteSTRING(outputtext, "FALSE", width);
+	END;
+  END WriteBOOLEAN;
+
+  PROCEDURE WriteREAL(outputtext: Text; real: REAL; width, nfrac: CARDINAL);
+  VAR
+	buf: numbuf;
+	ok: BOOLEAN;
+	digits: INTEGER;
+  BEGIN
+	IF width > SIZE(buf) THEN
+		width := SIZE(buf);
+	END;
+	IF nfrac > 0 THEN
+		RealConversions.RealToString(real, nfrac, width, buf, ok);
+	ELSE
+		IF width < 9 THEN width := 9; END;
+		IF real < 0.0 THEN
+			digits := 7 - INTEGER(width);
+		ELSE
+			digits := 6 - INTEGER(width);
+		END;
+		RealConversions.RealToString(real, digits, width, buf, ok);
+	END;
+	WriteSTRING(outputtext, buf, 0);
+  END WriteREAL;
+
+  PROCEDURE WriteSTRING(outputtext: Text; str: ARRAY OF CHAR; width: CARDINAL);
+  VAR index: CARDINAL;
+  BEGIN
+	index := 0;
+	WHILE (index <= HIGH(str)) AND (str[index] # EOS) DO
+		INC(index);
+	END;
+	WHILE index < width DO
+		WriteCHAR(outputtext, " ");
+		INC(index);
+	END;
+	index := 0;
+	WHILE (index <= HIGH(str)) AND (str[index] # EOS) DO
+		WriteCHAR(outputtext, str[index]);
+		INC(index);
+	END;
+  END WriteSTRING;
+
+BEGIN	(* PascalIo initialization *)
+	WITH ibuf DO
+		eof := FALSE;
+		type := reading;
+		fildes := 0;
+		bufferedcount := BUFSIZ;
+		maxcnt := 0;
+		cnt := 1;
+	END;
+	WITH obuf DO
+		eof := FALSE;
+		type := writing;
+		fildes := 1;
+		IF isatty(1) THEN
+			bufferedcount := 1;
+		ELSE
+			bufferedcount := BUFSIZ;
+		END;
+		cnt := 0;
+	END;
+	notext := NIL;
+	input := ADR(ibuf);
+	output := ADR(obuf);
+	input^.next := output;
+	output^.next := NIL;
+	head := input;
+END PascalIo.

lang/m2/libm2/Processes.mod

@@ -8,6 +8,8 @@ IMPLEMENTATION MODULE Processes [1];
 
   FROM Storage IMPORT ALLOCATE;
 
+  FROM Traps IMPORT Message;
+
   TYPE	SIGNAL = POINTER TO ProcessDescriptor;
 
 	ProcessDescriptor =
@@ -72,6 +74,7 @@ IMPLEMENTATION MODULE Processes [1];
 	UNTIL cp^.ready;
 	IF cp = s0 THEN
 		(* deadlock *)
+		Message("deadlock");
 		HALT
 	END;
 	s0^.ready := FALSE;

lang/m2/libm2/RealConver.def

@@ -4,7 +4,7 @@ DEFINITION MODULE RealConversions;
   (* Convert string "str" to a real number "r" according to the syntax:
      
 	['+'|'-'] digit {digit} ['.' digit {digit}]
-	['E' ['+'|'-'] digit [digit]]
+	['E' ['+'|'-'] digit {digit}]
 
      ok := "conversion succeeded"
      Leading blanks are skipped;

lang/m2/libm2/RealConver.mod

@@ -187,7 +187,6 @@ IMPLEMENTATION MODULE RealConversions;
 	END;
 	IF ind1 > CARDINAL(width) THEN
 		ok := FALSE;
-		str[0] := 0C;
 		RETURN;
 	END;
 	IF ind1 < CARDINAL(width) THEN
@@ -263,7 +262,7 @@ IMPLEMENTATION MODULE RealConversions;
 			END;
 		UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
 	END;
-	IF (ch = 'E') OR (ch = 'e') THEN
+	IF (ch = 'E') THEN
 		IF iB > HIGH(str) THEN
 			ok := FALSE;
 			RETURN;

lang/m2/libm2/RealInOut.mod

@@ -2,7 +2,7 @@ IMPLEMENTATION MODULE RealInOut;
 
   IMPORT InOut;
   IMPORT RealConversions;
-  IMPORT EM;
+  IMPORT Traps;
   FROM SYSTEM IMPORT WORD;
 
   CONST	MAXNDIG = 32;
@@ -28,7 +28,8 @@ IMPLEMENTATION MODULE RealInOut;
 	InOut.ReadString(Buf);
 	RealConversions.StringToReal(Buf, x, ok);
 	IF NOT ok THEN
-		EM.TRP(68);
+		Traps.Message("real expected");
+		HALT;
 	END;
 	Done := TRUE;
   END ReadReal;

lang/m2/libm2/Semaphores.mod

@@ -3,6 +3,7 @@ IMPLEMENTATION MODULE Semaphores [1];
   FROM SYSTEM IMPORT ADDRESS, NEWPROCESS, TRANSFER;
   FROM Storage IMPORT ALLOCATE;
   FROM random IMPORT Uniform;
+  FROM Traps IMPORT Message;
 
   TYPE	Sema = POINTER TO Semaphore;
 	Processes = POINTER TO Process;
@@ -76,7 +77,11 @@ IMPLEMENTATION MODULE Semaphores [1];
 			DEC(i);
 			IF i = 0 THEN EXIT END;
 		END;
-		IF (cp = s0) AND (j = i) THEN (* deadlock *) HALT END;
+		IF (cp = s0) AND (j = i) THEN
+			(* deadlock *)
+			Message("deadlock");
+			HALT
+		END;
 	END;
 	IF cp # s0 THEN TRANSFER(s0^.proc, cp^.proc); END;
   END ReSchedule;

lang/m2/libm2/Storage.mod

@@ -3,8 +3,9 @@ IMPLEMENTATION MODULE Storage;
    same size. Commonly used sizes have their own bucket. The larger ones
    are put in a single list.
 *)
-  FROM Unix IMPORT sbrk, write, exit, ILLBREAK;
+  FROM Unix IMPORT sbrk, write, ILLBREAK;
   FROM SYSTEM IMPORT ADDRESS, ADR;
+  FROM Traps IMPORT Message;
 
   CONST
 	NLISTS = 20;
@@ -140,16 +141,11 @@ IMPLEMENTATION MODULE Storage;
   END Allocate;
 
   PROCEDURE ALLOCATE(VAR a: ADDRESS; size: CARDINAL);
-    VAR	err: ARRAY[0..20] OF CHAR;
   BEGIN
 	a := Allocate(size);
 	IF a = NIL THEN
-		err:= "Out of core";
-		err[11] := 12C;
-		IF write(2, ADR(err), 12) < 0 THEN
-			;
-		END;
-		exit(1);
+		Message("out of core");
+		HALT;
 	END;
   END ALLOCATE;
 

lang/m2/libm2/Traps.def

@@ -0,0 +1,20 @@
+DEFINITION MODULE Traps;
+
+  IMPORT EM;
+
+  TYPE	TrapHandler = EM.TrapHandler;
+
+  PROCEDURE InstallTrapHandler(t: TrapHandler): TrapHandler;
+  (* Install a new trap handler, and return the previous one.
+     Parameter of trap handler is the trap number.
+  *)
+
+  PROCEDURE Message(str: ARRAY OF CHAR);
+  (* Write message "str" on standard error, preceeded by filename and
+     linenumber if possible
+  *)
+
+  PROCEDURE Trap(n: INTEGER);
+  (* cause trap number "n" to occur *)
+
+END Traps.

lang/m2/libm2/Traps.mod

@@ -0,0 +1,77 @@
+IMPLEMENTATION MODULE Traps;
+  IMPORT EM;
+  IMPORT Unix;
+  FROM SYSTEM IMPORT ADDRESS, ADR;
+  FROM Arguments IMPORT Argv;
+
+  PROCEDURE InstallTrapHandler(t: TrapHandler): TrapHandler;
+  (* Install a new trap handler, and return the previous one.
+     Parameter of trap handler is the trap number.
+  *)
+  BEGIN
+	RETURN EM.SIG(t);
+  END InstallTrapHandler;
+
+  PROCEDURE Message(str: ARRAY OF CHAR);
+  (* Write message "str" on standard error, preceeded by filename and
+     linenumber if possible
+  *)
+  VAR 	p, q: POINTER TO CHAR;
+	l: CARDINAL;
+	dummy, lino: INTEGER;
+	buf, buf2: ARRAY [0..255] OF CHAR;
+	i, j: CARDINAL;
+  BEGIN
+	p := EM.FILN();
+	IF p # NIL THEN
+		q := p;
+		WHILE p^ # 0C DO
+			p := ADDRESS(p) + 1;
+		END;
+		dummy := Unix.write(2, q, ADDRESS(p) - ADDRESS(q));
+	ELSE
+		l := Argv(0, buf);
+		dummy := Unix.write(2, ADR(buf), l);
+	END;
+	lino := EM.LINO();
+	i := 0;
+	IF lino # 0 THEN
+		i := 2;
+		buf[0] := ',';
+		buf[1] := ' ';
+		IF lino < 0 THEN
+			buf[2] := '-';
+			i := 3;
+			lino := - lino;
+		END;
+		j := 0;
+		REPEAT
+			buf2[j] := CHR(CARDINAL(lino) MOD 10 + ORD('0'));
+			lino := lino DIV 10;
+			INC(j);
+		UNTIL lino = 0;
+		WHILE j > 0 DO
+			DEC(j);
+			buf[i] := buf2[j];
+			INC(i);
+		END;
+	END;
+	buf[i] := ':';
+	buf[i+1] := ' ';
+	dummy := Unix.write(2, ADR(buf), i+2);
+	i := 0;
+	WHILE (i <= HIGH(str)) AND (str[i] # 0C) DO
+		INC(i);
+	END;
+	dummy := Unix.write(2, ADR(str), i);
+	buf[0] := 12C;
+	dummy := Unix.write(2, ADR(buf), 1);
+  END Message;
+
+  PROCEDURE Trap(n: INTEGER);
+  (* cause trap number "n" to occur *)
+  BEGIN
+	EM.TRP(n);
+  END Trap;
+
+END Traps.

lang/m2/libm2/catch.c

@@ -31,14 +31,9 @@ static struct errm {
 
 	{ 64,		"stack size of process too large"},
 	{ 65,		"too many nested traps + handlers"},
-	{ 66,		"illegal integer"},
-	{ 67,		"illegal cardinal"},
-	{ 68,		"illegal real"},
 	{ -1,		0}
 };
 
-extern char		*_hol0();
-extern char		*_argv[];
 extern			exit();
 
 _catch(trapno)
@@ -46,56 +41,32 @@ _catch(trapno)
 {
 	register struct errm *ep = &errors[0];
 	char *errmessage;
-	char		*pp[8];
-	register char **qq = &pp[0];
-	register char *p;
+	char buf[20];
+	register char *p, *s;
 	char *q;
-	int i;
 
-	if (p = FILN)
-		*qq++ = p;
-	else
-		*qq++ = _argv[0];
-	p = &("xxxxxxxxxxx: "[11]);
-	if (i = LINO) {
-		if (i < 0) {
-			/* ??? */
-			*qq++ = ", -";
-			i = -i;
-		}
-		else
-			*qq++ = ", ";
-		do
-			*--p = i % 10 + '0';
-		while (i /= 10);
-	}
-	*qq++ = p;
 	while (ep->errno != trapno && ep->errmes != 0) ep++;
-	if (ep->errmes)
-		*qq++ = ep->errmes;
+	if (p = ep->errmes) {
+		while (*p) p++;
+		Traps_Message(ep->errmes, 0, (int) (p - ep->errmes), 1);
+	}
 	else {
-		*qq++ = "error number";
-		p = &("xxxxxxxxxxx: "[11]);
-		i = trapno;
+		int i = trapno;
+
+		q = "error number xxxxxxxxxxxxx";
+		p = &q[13];
+		s = buf;
 		if (i < 0) {
-			/* ??? */
-			*qq++ = "-";
 			i = -i;
+			*p++ = '-';
 		}
 		do
-			*--p = i % 10 + '0';
+			*s++ = i % 10 + '0';
 		while (i /= 10);
-		*qq++ = p;
-	}
-	*qq++ = "\n";
-	*qq = 0;
-	qq = pp;
-	while (q = *qq++) {
-		p = q;
-		while (*p)
-			p++;
-		if (write(2,q,p-q) < 0)
-			;
+		*s = 0;
+		s = buf;
+		while (*p++ = *s++) /* nothing */;
+		Traps_Message(q, 0, (int) (p - q), 1);
 	}
 	exit(trapno);
 }