d0p1/ack
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

fixes, made more consistent

Browse source
This commit is contained in:
ceriel 1987-06-23 17:12:42 +00:00
parent 746f94368d
commit 43a6aed45c
11 changed files with 226 additions and 98 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lang/m2/libm2/.distr
View file

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

17
lang/m2/libm2/EM.def Normal file
View file

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

60
lang/m2/libm2/EM.e Normal file
View file

@ -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 ?

95
lang/m2/libm2/InOut.mod
View file

@ -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,11 +181,11 @@ 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
XWriteString(prompt);
END;
@ -199,41 +203,35 @@ IMPLEMENTATION MODULE InOut ;
END;
RETURN;
END;
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)
ReadString(buf);
IF NOT Done THEN
RETURN
END;
IF ch = '-' THEN
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,16 +239,15 @@ 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');
WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
chvalue := ORD(buf[index]) - ORD('0');
IF (int > SAFELIMITDIV10) OR
( (int = SAFELIMITDIV10) AND
(chvalue > safedigit)) THEN
Error("integer overflow");
EM.TRP(EIOVFL);
ELSE
int := 10*int + VAL(INTEGER, chvalue);
Read(ch)
INC(index)
END;
END;
IF neg THEN
@ -258,11 +255,10 @@ IMPLEMENTATION MODULE InOut ;
ELSE
integ := int
END;
Done := TRUE;
ELSE
Done := FALSE
IF buf[index] > " " THEN
EM.TRP(66);
END;
UnRead(ch)
Done := TRUE;
END ReadInt;
PROCEDURE ReadCard(VAR card : CARDINAL);
@ -270,40 +266,42 @@ IMPLEMENTATION MODULE InOut ;
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');
WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
chvalue := ORD(buf[index]) - ORD('0');
IF (int > SAFELIMITDIV10) OR
( (int = SAFELIMITDIV10) AND
(chvalue > safedigit)) THEN
Error("cardinal overflow");
EM.TRP(EIOVFL);
ELSE
int := 10*int + chvalue;
Read(ch)
INC(index);
END;
END;
IF buf[index] > " " THEN
EM.TRP(67);
END;
card := int;
Done := TRUE;
ELSE
Done := FALSE
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;

3
lang/m2/libm2/LIST
View file

@ -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

2
lang/m2/libm2/Makefile
View file

@ -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 \

2
lang/m2/libm2/Mathlib.mod
View file

@ -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

7
lang/m2/libm2/RealConver.mod
View file

@ -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;

6
lang/m2/libm2/RealInOut.mod
View file

@ -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);

5
lang/m2/libm2/catch.c
View file

@ -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}
};

47
lang/m2/libm2/confarray.c Normal file
View file

@ -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++;
}