From: ceriel Date: Fri, 26 Jun 1987 15:59:52 +0000 (+0000) Subject: fixes, different traps, new files X-Git-Tag: release-5-5~4064 X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=ea69982a26f8a555e2963966cb325e5b8bcc3d49;p=ack.git fixes, different traps, new files --- diff --git a/lang/m2/libm2/.distr b/lang/m2/libm2/.distr index 580c61a6a..1efb87e8d 100644 --- a/lang/m2/libm2/.distr +++ b/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 diff --git a/lang/m2/libm2/EM.def b/lang/m2/libm2/EM.def index 89691d37f..755d6b4a4 100644 --- a/lang/m2/libm2/EM.def +++ b/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. diff --git a/lang/m2/libm2/EM.e b/lang/m2/libm2/EM.e index 81687c59c..174c82fc8 100644 --- a/lang/m2/libm2/EM.e +++ b/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 ? diff --git a/lang/m2/libm2/InOut.mod b/lang/m2/libm2/InOut.mod index d91d02c98..1826e2de5 100644 --- a/lang/m2/libm2/InOut.mod +++ b/lang/m2/libm2/InOut.mod @@ -1,9 +1,8 @@ -#include 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); diff --git a/lang/m2/libm2/LIST b/lang/m2/libm2/LIST index b1300c650..30ba3cf83 100644 --- a/lang/m2/libm2/LIST +++ b/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 diff --git a/lang/m2/libm2/Makefile b/lang/m2/libm2/Makefile index 17518acfb..286d4d8bc 100644 --- a/lang/m2/libm2/Makefile +++ b/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: diff --git a/lang/m2/libm2/PascalIO.def b/lang/m2/libm2/PascalIO.def new file mode 100644 index 000000000..9664d6b74 --- /dev/null +++ b/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. diff --git a/lang/m2/libm2/PascalIO.mod b/lang/m2/libm2/PascalIO.mod new file mode 100644 index 000000000..72abf1dd6 --- /dev/null +++ b/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. diff --git a/lang/m2/libm2/Processes.mod b/lang/m2/libm2/Processes.mod index 8d144a36e..23ebc8f8b 100644 --- a/lang/m2/libm2/Processes.mod +++ b/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; diff --git a/lang/m2/libm2/RealConver.def b/lang/m2/libm2/RealConver.def index 12241e9da..680856495 100644 --- a/lang/m2/libm2/RealConver.def +++ b/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; diff --git a/lang/m2/libm2/RealConver.mod b/lang/m2/libm2/RealConver.mod index c6679888e..063c52aeb 100644 --- a/lang/m2/libm2/RealConver.mod +++ b/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; diff --git a/lang/m2/libm2/RealInOut.mod b/lang/m2/libm2/RealInOut.mod index 2004d9336..d45ad6f9b 100644 --- a/lang/m2/libm2/RealInOut.mod +++ b/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; diff --git a/lang/m2/libm2/Semaphores.mod b/lang/m2/libm2/Semaphores.mod index c04362027..8f3bf8005 100644 --- a/lang/m2/libm2/Semaphores.mod +++ b/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; diff --git a/lang/m2/libm2/Storage.mod b/lang/m2/libm2/Storage.mod index 42e45b0a2..b352fc2ee 100644 --- a/lang/m2/libm2/Storage.mod +++ b/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; diff --git a/lang/m2/libm2/Traps.def b/lang/m2/libm2/Traps.def new file mode 100644 index 000000000..ca38b1193 --- /dev/null +++ b/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. diff --git a/lang/m2/libm2/Traps.mod b/lang/m2/libm2/Traps.mod new file mode 100644 index 000000000..028db858b --- /dev/null +++ b/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. diff --git a/lang/m2/libm2/catch.c b/lang/m2/libm2/catch.c index a24eb4e43..42d061b5d 100644 --- a/lang/m2/libm2/catch.c +++ b/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); }