IMPLEMENTATION MODULE M2RTS ;
FROM libc IMPORT abort, exit, write ;
FROM NumberIO IMPORT CardToStr ;
FROM StrLib IMPORT StrCopy, StrLen ;
FROM SYSTEM IMPORT ADDRESS, ADR ;
FROM ASCII IMPORT nl, nul ;
CONST
Max = 10 ;
Foobar = 20 ;
Min = Max+Foobar ;
MaxLength = 4096 ;
TYPE
mytype = ARRAY [0..Max] OF CARDINAL ;
VAR
Ptr : CARDINAL ;
List : ARRAY [0..Max] OF PROC ;
ExitValue: INTEGER ;
CallExit : BOOLEAN ;
Testing : mytype ;
Works : ARRAY [0..Max+Min] OF PROC ;
PROCEDURE Terminate ;
CONST
FooBa = 12 ;
VAR
i: CARDINAL ;
t: ARRAY [0..FooBa] OF CARDINAL ;
BEGIN
i := 0 ;
WHILE i<Ptr DO
List[i] ;
INC(i)
END
END Terminate ;
PROCEDURE HALT ;
CONST
FooBa = 3+3 ;
BEGIN
Terminate ;
IF CallExit
THEN
exit(ExitValue)
ELSE
abort
END
END HALT ;
PROCEDURE ErrorString (a: ARRAY OF CHAR) ;
VAR
buf: ARRAY [0..MaxLength] OF CHAR ;
n : INTEGER ;
BEGIN
StrCopy(a, buf) ;
n := write(2, ADR(buf), StrLen(buf))
END ErrorString ;
PROCEDURE ErrorMessage (message: ARRAY OF CHAR; file: ARRAY OF CHAR; line: CARDINAL) ;
VAR
LineNo: ARRAY [0..10] OF CHAR ;
BEGIN
ErrorString(file) ; ErrorString(':') ;
CardToStr(line, 0, LineNo) ;
ErrorString(LineNo) ; ErrorString(':') ;
ErrorString(message) ;
LineNo[0] := nl ; LineNo[1] := nul ;
ErrorString(LineNo) ;
exit(1)
END ErrorMessage ;
PROCEDURE SubrangeAssignmentError (file: ARRAY OF CHAR; line: CARDINAL) ;
BEGIN
ErrorMessage('variable exceeds subrange', file, line)
END SubrangeAssignmentError ;
PROCEDURE ArraySubscriptError (file: ARRAY OF CHAR; line: CARDINAL) ;
BEGIN
ErrorMessage('array index out of bounds', file, line)
END ArraySubscriptError ;
PROCEDURE FunctionReturnError (file: ARRAY OF CHAR; line: CARDINAL) ;
BEGIN
ErrorMessage('function is attempting to exit without a formal RETURN statement', file, line)
END FunctionReturnError ;
PROCEDURE ExitOnHalt (e: INTEGER) ;
BEGIN
ExitValue := e ;
CallExit := TRUE
END ExitOnHalt ;
PROCEDURE InstallTerminationProcedure (p: PROC) ;
BEGIN
List[Ptr] := p ;
INC(Ptr)
END InstallTerminationProcedure ;
BEGIN
Ptr := 0 ;
ExitValue := 0 ;
CallExit := FALSE
END M2RTS.