Arguments.def
Conversion.def
EM.def
+PascalIo.def
InOut.def
Makefile
Mathlib.def
Unix.def
head_m2.e
random.def
+Traps.def
(*$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
PROCEDURE TRP(trapno: INTEGER);
(* Generate EM trap number "trapno" *)
+
+ PROCEDURE SIG(t: TrapHandler): TrapHandler;
+
+ PROCEDURE FILN(): ADDRESS;
+
+ PROCEDURE LINO(): INTEGER;
END EM.
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 ?
-#include <em_abs.h>
IMPLEMENTATION MODULE InOut ;
IMPORT Unix;
IMPORT Conversions;
- IMPORT EM;
+ IMPORT Traps;
FROM TTY IMPORT isatty;
FROM SYSTEM IMPORT ADR;
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)
integ := int
END;
IF buf[index] > " " THEN
- EM.TRP(66);
+ Traps.Message("illegal integer");
+ HALT;
END;
Done := TRUE;
END ReadInt;
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;
REPEAT
Read(ch);
UNTIL NOT (ch IN charset{' ', TAB, 12C, 15C});
- UnRead(ch);
+ IF NOT Done THEN
+ RETURN;
+ END;
REPEAT
Read(ch);
termCH := ch;
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);
tail_m2.a
+PascalIo.mod
RealInOut.mod
InOut.mod
Terminal.mod
Semaphores.mod
random.mod
Strings.mod
+Traps.mod
Arguments.c
catch.c
-hol0.e
LtoUset.e
StrAss.c
absd.c
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:
--- /dev/null
+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.
--- /dev/null
+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.
FROM Storage IMPORT ALLOCATE;
+ FROM Traps IMPORT Message;
+
TYPE SIGNAL = POINTER TO ProcessDescriptor;
ProcessDescriptor =
UNTIL cp^.ready;
IF cp = s0 THEN
(* deadlock *)
+ Message("deadlock");
HALT
END;
s0^.ready := FALSE;
(* 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;
END;
IF ind1 > CARDINAL(width) THEN
ok := FALSE;
- str[0] := 0C;
RETURN;
END;
IF ind1 < CARDINAL(width) THEN
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;
IMPORT InOut;
IMPORT RealConversions;
- IMPORT EM;
+ IMPORT Traps;
FROM SYSTEM IMPORT WORD;
CONST MAXNDIG = 32;
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;
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;
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;
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;
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;
--- /dev/null
+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.
--- /dev/null
+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.
{ 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)
{
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);
}
public / ack.git / commitdiff