fixes, made more consistent

lang/m2/libm2/.distr

@@ -3,7 +3,7 @@ tail_m2.a
 ASCII.def
 Arguments.def
 Conversion.def
-FIFFEF.def
+EM.def
 InOut.def
 Makefile
 Mathlib.def

lang/m2/libm2/EM.def

@@ -0,0 +1,17 @@
+(*$Foreign *)
+DEFINITION MODULE EM;
+(* An interface to EM instructions *)
+
+	PROCEDURE FIF(arg1, arg2: LONGREAL; VAR intres: LONGREAL) : LONGREAL;
+	(* multiplies arg1 and arg2, and returns the integer part of the
+	   result in "intres" and the fraction part as the function result.
+	*)
+
+	PROCEDURE FEF(arg: LONGREAL; VAR exp: INTEGER) : LONGREAL;
+	(* splits "arg" in mantissa and a base-2 exponent.
+	   The mantissa is returned, and the exponent is left in "exp".
+	*)
+
+	PROCEDURE TRP(trapno: INTEGER);
+	(* Generate EM trap number "trapno" *)
+END EM.

lang/m2/libm2/EM.e

@@ -0,0 +1,60 @@
+#
+ mes 2,EM_WSIZE,EM_PSIZE
+
+#define ARG1    0
+#define ARG2    EM_DSIZE
+#define IRES    2*EM_DSIZE
+
+; FIF is called with three parameters:
+;       - address of integer part result (IRES)
+;       - float two (ARG2)
+;       - float one (ARG1)
+; and returns an EM_DSIZE-byte floating point number
+; Definition:
+;	PROCEDURE FIF(ARG1, ARG2: LONGREAL; VAR IRES: LONGREAL) : LONGREAL;
+
+ exp $FIF
+ pro $FIF,0
+ lal 0
+ loi 2*EM_DSIZE
+ fif EM_DSIZE
+ lal IRES
+ loi EM_PSIZE
+ sti EM_DSIZE
+ ret EM_DSIZE
+ end ?
+
+#define FARG    0
+#define ERES    EM_DSIZE
+
+; FEF is called with two parameters:
+;       - address of base 2 exponent result (ERES)
+;       - floating point number to be split (FARG)
+; and returns an EM_DSIZE-byte floating point number (the mantissa)
+; Definition:
+;	PROCEDURE FEF(FARG: LONGREAL; VAR ERES: integer): LONGREAL;
+
+ exp $FEF
+ pro $FEF,0
+ lal FARG
+ loi EM_DSIZE
+ fef EM_DSIZE
+ lal ERES
+ loi EM_PSIZE
+ sti EM_WSIZE
+ ret EM_DSIZE
+ end ?
+
+#define TRAP    0
+
+; TRP is called with one parameter:
+;       - trap number (TRAP)
+; Definition:
+; PROCEDURE TRP(trapno: INTEGER);
+
+ exp $TRP
+ pro $TRP, 0
+ lol TRAP
+ trp
+ ret 0
+ end ?

lang/m2/libm2/InOut.mod

@@ -1,7 +1,9 @@
+#include <em_abs.h>
 IMPLEMENTATION MODULE InOut ;
 
   IMPORT Unix;
   IMPORT Conversions;
+  IMPORT EM;
   FROM TTY IMPORT isatty;
   FROM SYSTEM IMPORT ADR;
 
@@ -89,6 +91,7 @@ IMPLEMENTATION MODULE InOut ;
 		CloseInput;
 	END;
 	MakeFileName("Name of input file: ", defext, namebuf);
+	IF NOT Done THEN RETURN; END;
 	IF (namebuf[1] = '-') AND (namebuf[2] = 0C) THEN
 	ELSE
 		WITH ibuf DO
@@ -135,6 +138,7 @@ IMPLEMENTATION MODULE InOut ;
 		CloseOutput;
 	END;
 	MakeFileName("Name of output file: ", defext, namebuf);
+	IF NOT Done THEN RETURN; END;
 	IF (namebuf[1] = '-') AND (namebuf[2] = 0C) THEN
 	ELSE	
 		WITH obuf DO
@@ -177,63 +181,57 @@ IMPLEMENTATION MODULE InOut ;
 
   PROCEDURE MakeFileName(prompt, defext : ARRAY OF CHAR;
 		       VAR buf : ARRAY OF CHAR);
-  VAR	i, k : INTEGER;
+  VAR	i : INTEGER;
 	j : CARDINAL;
 	ch: CHAR;
   BEGIN
-	FOR k := 1 TO 3 DO
+	Done := TRUE;
-		IF isatty(0) THEN
+	IF isatty(0) THEN
-			XWriteString(prompt);
+		XWriteString(prompt);
-		END;
-		XReadString(buf);
-		i := 0;
-		WHILE buf[i] # 0C DO i := i + 1 END;
-		IF i # 0 THEN
-			i := i - 1;
-			IF buf[i] = '.' THEN
-	    			FOR j := 0 TO HIGH(defext) DO
-					i := i + 1;
-					buf[i] := defext[j];
-	    			END;
-	    			buf[i+1] := 0C;
-			END;
-			RETURN;
-		END;
 	END;
-	Error("no proper file name in three attempts. Giving up.");
+	XReadString(buf);
+	i := 0;
+	WHILE buf[i] # 0C DO i := i + 1 END;
+	IF i # 0 THEN
+		i := i - 1;
+		IF buf[i] = '.' THEN
+	    		FOR j := 0 TO HIGH(defext) DO
+				i := i + 1;
+				buf[i] := defext[j];
+	    		END;
+	    		buf[i+1] := 0C;
+		END;
+		RETURN;
+	END;
+	Done := FALSE;
   END MakeFileName;
 
-  PROCEDURE Error(s: ARRAY OF CHAR);
-  VAR Xch: ARRAY[1..1] OF CHAR;
-  BEGIN
-	XWriteString("Error: ");
-	XWriteString(s);
-	Xch[1] := 12C;
-	XWriteString(Xch);
-	Unix.exit(1);
-  END Error;
-
   PROCEDURE ReadInt(VAR integ : INTEGER);
   CONST
     	SAFELIMITDIV10 = MAX(INTEGER) DIV 10;
     	SAFELIMITREM10 = MAX(INTEGER) MOD 10;
+  TYPE
+	itype = [0..31];
+	ibuf =  ARRAY itype OF CHAR;
   VAR
     	int : INTEGER;
-    	ch  : CHAR;
     	neg : BOOLEAN;
     	safedigit: [0 .. 9];
     	chvalue: CARDINAL;
+	buf : ibuf;
+	index : itype;
   BEGIN
-    	Read(ch);
+    	ReadString(buf);
-    	WHILE (ch = ' ') OR (ch = TAB) OR (ch = 12C) DO
+	IF NOT Done THEN
-		Read(ch)
+		RETURN
-    	END;
+	END;
-    	IF ch = '-' THEN
+	index := 0;
+    	IF buf[index] = '-' THEN
 		neg := TRUE;
-		Read(ch)
+		INC(index);
-    	ELSIF ch = '+' THEN
+    	ELSIF buf[index] = '+' THEN
 		neg := FALSE;
-		Read(ch)
+		INC(index);
     	ELSE
 		neg := FALSE
     	END;
@@ -241,69 +239,69 @@ IMPLEMENTATION MODULE InOut ;
     	safedigit := SAFELIMITREM10;
     	IF neg THEN safedigit := safedigit + 1 END;
     	int := 0;
-    	IF (ch >= '0') & (ch <= '9') THEN
+	WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
-		WHILE (ch >= '0') & (ch <= '9') DO
+  		chvalue := ORD(buf[index]) - ORD('0');
-  	    		chvalue := ORD(ch) - ORD('0');
+	   	IF (int > SAFELIMITDIV10) OR 
-	    		IF (int > SAFELIMITDIV10) OR 
+		   ( (int = SAFELIMITDIV10) AND
-			   ( (int = SAFELIMITDIV10) AND
+		     (chvalue > safedigit)) THEN
-			     (chvalue > safedigit)) THEN
+			EM.TRP(EIOVFL);
-				Error("integer overflow");
+	    	ELSE
-	    		ELSE
+			int := 10*int + VAL(INTEGER, chvalue);
-				int := 10*int + VAL(INTEGER, chvalue);
+			INC(index)
-				Read(ch)
+	    	END;
-	    		END;
+	END;
-		END;
+	IF neg THEN
-		IF neg THEN
+   		integ := -int
-   	    		integ := -int
+	ELSE
-		ELSE
+		integ := int
-	    		integ := int
+	END;
-		END;
+	IF buf[index] > " " THEN
-		Done := TRUE;
+		EM.TRP(66);
-    	ELSE
+	END;
-		Done := FALSE
+	Done := TRUE;
-    	END;
-    	UnRead(ch)
   END ReadInt;
 
   PROCEDURE ReadCard(VAR card : CARDINAL);
   CONST
     	SAFELIMITDIV10 = MAX(CARDINAL) DIV 10;
     	SAFELIMITREM10 = MAX(CARDINAL) MOD 10;
+
+  TYPE
+	itype = [0..31];
+	ibuf =  ARRAY itype OF CHAR;
     
   VAR
     	int : CARDINAL;
-    	ch  : CHAR;
+    	index  : itype;
+	buf : ibuf;
     	safedigit: [0 .. 9];
     	chvalue: CARDINAL;
   BEGIN
-    	Read(ch);
+    	ReadString(buf);
-    	WHILE (ch = ' ') OR (ch = TAB) OR (ch = 12C) DO
+	IF NOT Done THEN RETURN; END;
-		Read(ch)
+	index := 0;
-    	END;
-
     	safedigit := SAFELIMITREM10;
     	int := 0;
-    	IF (ch >= '0') & (ch <= '9') THEN
+	WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
-		WHILE (ch >= '0') & (ch <= '9') DO
+  		chvalue := ORD(buf[index]) - ORD('0');
-  	    		chvalue := ORD(ch) - ORD('0');
+	    	IF (int > SAFELIMITDIV10) OR 
-	    		IF (int > SAFELIMITDIV10) OR 
+		   ( (int = SAFELIMITDIV10) AND
-			   ( (int = SAFELIMITDIV10) AND
+		     (chvalue > safedigit)) THEN
-			     (chvalue > safedigit)) THEN
+			EM.TRP(EIOVFL);
-				Error("cardinal overflow");
+	    	ELSE
-	    		ELSE
+			int := 10*int + chvalue;
-				int := 10*int + chvalue;
+			INC(index);
-				Read(ch)
+	    	END;
-	    		END;
+	END;
-		END;
+	IF buf[index] > " " THEN
-		card := int;
+		EM.TRP(67);
-		Done := TRUE;
+	END;
-    	ELSE
+	card := int;
-		Done := FALSE
+	Done := TRUE;
-    	END;
-    	UnRead(ch)
   END ReadCard;
 
   PROCEDURE ReadString(VAR s : ARRAY OF CHAR);
+  TYPE charset = SET OF CHAR;
   VAR	i : CARDINAL;
     	ch : CHAR;
 
@@ -311,7 +309,7 @@ IMPLEMENTATION MODULE InOut ;
     	i := 0;
 	REPEAT
 		Read(ch);
-	UNTIL (ch # ' ') AND (ch # TAB);
+	UNTIL NOT (ch IN charset{' ', TAB, 12C, 15C});
 	UnRead(ch);
     	REPEAT
 		Read(ch);
@@ -324,6 +322,7 @@ IMPLEMENTATION MODULE InOut ;
 		END;
 		INC(i);
     	UNTIL (NOT Done) OR (ch <= " ");
+	UnRead(ch);
   END ReadString;
 
   PROCEDURE XReadString(VAR s : ARRAY OF CHAR);
@@ -336,7 +335,7 @@ IMPLEMENTATION MODULE InOut ;
 	LOOP
 		i := Unix.read(0, ADR(ch), 1);
 		IF i < 0 THEN
-			Error("failed read");
+			EXIT;
 		END;
 		IF ch <= " " THEN
 			s[j] := 0C;

lang/m2/libm2/LIST

@@ -13,7 +13,6 @@ Conversion.mod
 Semaphores.mod
 random.mod
 Strings.mod
-FIFFEF.e
 Arguments.c
 catch.c
 hol0.e
@@ -26,5 +25,7 @@ absl.c
 halt.c
 transfer.e
 store.c
+confarray.c
 load.c
 stackprio.c
+EM.e

lang/m2/libm2/Makefile

@@ -1,7 +1,7 @@
 HOME = ../../..
 DEFDIR = $(HOME)/lib/m2
 
-SOURCES =	ASCII.def FIFFEF.def MathLib0.def Processes.def \
+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 \

lang/m2/libm2/Mathlib.mod

@@ -1,6 +1,6 @@
 IMPLEMENTATION MODULE Mathlib;
 
-  FROM FIFFEF IMPORT FIF, FEF;
+  FROM EM IMPORT FIF, FEF;
 
 	(* From:	Handbook of Mathematical Functions
 			Edited by M. Abramowitz and I.A. Stegun

lang/m2/libm2/RealConver.mod

@@ -1,6 +1,6 @@
 IMPLEMENTATION MODULE RealConversions;
 
-  FROM FIFFEF IMPORT FIF, FEF;
+  FROM EM IMPORT FIF, FEF;
 
   PROCEDURE RealToString(arg: REAL;
 		width, digits: INTEGER;
@@ -226,11 +226,6 @@ IMPLEMENTATION MODULE RealConversions;
 		signedexp: BOOLEAN;
 		iB: CARDINAL;
 
-    PROCEDURE dig(ch: CARDINAL);
-    BEGIN
-	IF r>BIG THEN INC(pow10) ELSE r:= 10.0D*r + FLOATD(ch) END;
-    END dig;
-
   BEGIN
 	r := 0.0D;
 	pow10 := 0;

lang/m2/libm2/RealInOut.mod

@@ -2,6 +2,7 @@ IMPLEMENTATION MODULE RealInOut;
 
   IMPORT InOut;
   IMPORT RealConversions;
+  IMPORT EM;
   FROM SYSTEM IMPORT WORD;
 
   CONST	MAXNDIG = 32;
@@ -26,7 +27,10 @@ IMPLEMENTATION MODULE RealInOut;
   BEGIN
 	InOut.ReadString(Buf);
 	RealConversions.StringToReal(Buf, x, ok);
-	Done := ok;
+	IF NOT ok THEN
+		EM.TRP(68);
+	END;
+	Done := TRUE;
   END ReadReal;
 
   PROCEDURE wroct(x: ARRAY OF WORD);

lang/m2/libm2/catch.c

@@ -28,7 +28,12 @@ static struct errm {
 	{ EBADMON,	"bad monitor call"},
 	{ EBADLIN,	"argument if LIN too high"},
 	{ EBADGTO,	"GTO descriptor error"},
+
 	{ 64,		"stack size of process too large"},
+	{ 65,		"too many nested traps + handlers"},
+	{ 66,		"illegal integer"},
+	{ 67,		"illegal cardinal"},
+	{ 68,		"illegal real"},
 	{ -1,		0}
 };
 

lang/m2/libm2/confarray.c

@@ -0,0 +1,47 @@
+struct descr {
+	char *addr;
+	int low;
+	unsigned int highminlow;
+	unsigned int size;
+};
+
+static struct descr *descrs[10];
+static struct descr **ppdescr = descrs;
+
+char *
+_new_stackptr(pdescr, a)
+	register struct descr *pdescr;
+{
+	unsigned int size = (((pdescr->highminlow + 1) * pdescr->size +
+				(EM_WSIZE - 1)) & ~(EM_WSIZE - 1));
+
+	if (ppdescr >= &descrs[10]) {
+		/* to many nested traps + handlers ! */
+		TRP(65);
+	}
+	*ppdescr++ = pdescr;
+	if ((char *) &a - (char *) &size > 0) {
+		/* stack grows downwards */
+		return (char *) &a - size;
+	}
+	else	return (char *) &a + size;
+}
+
+_copy_array(p, a)
+	register char *p;
+{
+	register char *q;
+	register unsigned int sz;
+	char dummy;
+
+	ppdescr--;
+	sz = (((*ppdescr)->highminlow + 1) * (*ppdescr)->size +
+		(EM_WSIZE -1)) & ~ (EM_WSIZE - 1);
+	
+	if ((char *) &a - (char *) &dummy > 0) {
+		(*ppdescr)->addr = q = (char *) &a;
+	}
+	else	(*ppdescr)->addr = q = (char *) &a - sz;
+
+	while (sz--) *q++ = *p++;
+}