From 43a6aed45cdcca127b385275d80ffbfac52060f4 Mon Sep 17 00:00:00 2001 From: ceriel Date: Tue, 23 Jun 1987 17:12:42 +0000 Subject: [PATCH] fixes, made more consistent --- lang/m2/libm2/.distr | 2 +- lang/m2/libm2/EM.def | 17 ++++ lang/m2/libm2/EM.e | 60 ++++++++++++ lang/m2/libm2/InOut.mod | 171 +++++++++++++++++------------------ lang/m2/libm2/LIST | 3 +- lang/m2/libm2/Makefile | 2 +- lang/m2/libm2/Mathlib.mod | 2 +- lang/m2/libm2/RealConver.mod | 7 +- lang/m2/libm2/RealInOut.mod | 6 +- lang/m2/libm2/catch.c | 5 + lang/m2/libm2/confarray.c | 47 ++++++++++ 11 files changed, 225 insertions(+), 97 deletions(-) create mode 100644 lang/m2/libm2/EM.def create mode 100644 lang/m2/libm2/EM.e create mode 100644 lang/m2/libm2/confarray.c diff --git a/lang/m2/libm2/.distr b/lang/m2/libm2/.distr index 5c9d5afa5..580c61a6a 100644 --- a/lang/m2/libm2/.distr +++ b/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 diff --git a/lang/m2/libm2/EM.def b/lang/m2/libm2/EM.def new file mode 100644 index 000000000..89691d37f --- /dev/null +++ b/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. diff --git a/lang/m2/libm2/EM.e b/lang/m2/libm2/EM.e new file mode 100644 index 000000000..81687c59c --- /dev/null +++ b/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 ? diff --git a/lang/m2/libm2/InOut.mod b/lang/m2/libm2/InOut.mod index beaa0372c..d91d02c98 100644 --- a/lang/m2/libm2/InOut.mod +++ b/lang/m2/libm2/InOut.mod @@ -1,7 +1,9 @@ +#include 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 - IF isatty(0) THEN - 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; + Done := TRUE; + IF isatty(0) THEN + 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; - Error("no proper file name in three attempts. Giving up."); + 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); - WHILE (ch = ' ') OR (ch = TAB) OR (ch = 12C) DO - Read(ch) - END; - IF ch = '-' THEN + ReadString(buf); + IF NOT Done THEN + RETURN + END; + index := 0; + IF buf[index] = '-' THEN neg := TRUE; - Read(ch) - ELSIF ch = '+' THEN + INC(index); + 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 (ch >= '0') & (ch <= '9') DO - chvalue := ORD(ch) - ORD('0'); - IF (int > SAFELIMITDIV10) OR - ( (int = SAFELIMITDIV10) AND - (chvalue > safedigit)) THEN - Error("integer overflow"); - ELSE - int := 10*int + VAL(INTEGER, chvalue); - Read(ch) - END; - END; - IF neg THEN - integ := -int - ELSE - integ := int - END; - Done := TRUE; - ELSE - Done := FALSE - END; - UnRead(ch) + WHILE (buf[index] >= '0') & (buf[index] <= '9') DO + chvalue := ORD(buf[index]) - ORD('0'); + IF (int > SAFELIMITDIV10) OR + ( (int = SAFELIMITDIV10) AND + (chvalue > safedigit)) THEN + EM.TRP(EIOVFL); + ELSE + int := 10*int + VAL(INTEGER, chvalue); + INC(index) + END; + END; + IF neg THEN + integ := -int + ELSE + integ := int + END; + IF buf[index] > " " THEN + EM.TRP(66); + END; + Done := TRUE; 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); - WHILE (ch = ' ') OR (ch = TAB) OR (ch = 12C) DO - Read(ch) - END; - + ReadString(buf); + IF NOT Done THEN RETURN; END; + index := 0; safedigit := SAFELIMITREM10; int := 0; - IF (ch >= '0') & (ch <= '9') THEN - WHILE (ch >= '0') & (ch <= '9') DO - chvalue := ORD(ch) - ORD('0'); - IF (int > SAFELIMITDIV10) OR - ( (int = SAFELIMITDIV10) AND - (chvalue > safedigit)) THEN - Error("cardinal overflow"); - ELSE - int := 10*int + chvalue; - Read(ch) - END; - END; - card := int; - Done := TRUE; - ELSE - Done := FALSE - END; - UnRead(ch) + WHILE (buf[index] >= '0') & (buf[index] <= '9') DO + chvalue := ORD(buf[index]) - ORD('0'); + IF (int > SAFELIMITDIV10) OR + ( (int = SAFELIMITDIV10) AND + (chvalue > safedigit)) THEN + EM.TRP(EIOVFL); + ELSE + int := 10*int + chvalue; + INC(index); + END; + END; + IF buf[index] > " " THEN + EM.TRP(67); + END; + card := int; + Done := TRUE; 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; diff --git a/lang/m2/libm2/LIST b/lang/m2/libm2/LIST index 9e2d8a06c..b1300c650 100644 --- a/lang/m2/libm2/LIST +++ b/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 diff --git a/lang/m2/libm2/Makefile b/lang/m2/libm2/Makefile index 77b7bc94b..17518acfb 100644 --- a/lang/m2/libm2/Makefile +++ b/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 \ diff --git a/lang/m2/libm2/Mathlib.mod b/lang/m2/libm2/Mathlib.mod index e1268bb32..49261bbae 100644 --- a/lang/m2/libm2/Mathlib.mod +++ b/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 diff --git a/lang/m2/libm2/RealConver.mod b/lang/m2/libm2/RealConver.mod index 8c0bf2c58..c6679888e 100644 --- a/lang/m2/libm2/RealConver.mod +++ b/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; diff --git a/lang/m2/libm2/RealInOut.mod b/lang/m2/libm2/RealInOut.mod index d74c8a7d2..2004d9336 100644 --- a/lang/m2/libm2/RealInOut.mod +++ b/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); diff --git a/lang/m2/libm2/catch.c b/lang/m2/libm2/catch.c index 003d0f058..a24eb4e43 100644 --- a/lang/m2/libm2/catch.c +++ b/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} }; diff --git a/lang/m2/libm2/confarray.c b/lang/m2/libm2/confarray.c new file mode 100644 index 000000000..c0eee3e35 --- /dev/null +++ b/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++; +} -- 2.34.1