mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 09:52:24 +00:00
Simplify runtime error reporting and move to platform common source.
This commit is contained in:
David Brown
parent
ed7043324d
commit
716240bdd6
205 changed files with 986 additions and 1063 deletions
|
|
@ -99,13 +99,13 @@ MODULE Heap;
|
|||
INC(lockdepth);
|
||||
END Lock;
|
||||
|
||||
PROCEDURE -PlatformHalt(code: LONGINT) "Platform_Halt(code)";
|
||||
PROCEDURE -ModulesHalt(code: LONGINT) "Modules_Halt(code)";
|
||||
|
||||
PROCEDURE Unlock*;
|
||||
BEGIN
|
||||
DEC(lockdepth);
|
||||
IF interrupted & (lockdepth = 0) THEN
|
||||
PlatformHalt(-9);
|
||||
ModulesHalt(-9);
|
||||
END
|
||||
END Unlock;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ MODULE Modules; (* jt 6.1.96 *)
|
|||
(* access to list of modules and commands, based on ETH Oberon *)
|
||||
|
||||
|
||||
IMPORT SYSTEM, Heap;
|
||||
IMPORT SYSTEM, Heap, Platform;
|
||||
|
||||
CONST
|
||||
ModNameLen* = 20;
|
||||
|
|
@ -93,4 +93,69 @@ MODULE Modules; (* jt 6.1.96 *)
|
|||
END
|
||||
END Free;
|
||||
|
||||
|
||||
(* Run time error reporting. *)
|
||||
|
||||
PROCEDURE errch(c: CHAR); (* Here we favour simplicity over efficiency, so no buffering. *)
|
||||
VAR e: Platform.ErrorCode;
|
||||
BEGIN e := Platform.Write(1, SYSTEM.ADR(c), 1)
|
||||
END errch;
|
||||
|
||||
PROCEDURE errstring*(s: ARRAY OF CHAR);
|
||||
VAR i: LONGINT;
|
||||
BEGIN i := 0;
|
||||
WHILE (i<LEN(s)) & (s[i] # 0X) DO errch(s[i]); INC(i) END
|
||||
END errstring;
|
||||
|
||||
PROCEDURE errposint(l: SYSTEM.INT32);
|
||||
BEGIN IF l>10 THEN errposint(l DIV 10) END; errch(CHR(ORD('0') + (l MOD 10))) END errposint;
|
||||
|
||||
PROCEDURE errint*(l: SYSTEM.INT32);
|
||||
BEGIN IF l<0 THEN errch('-'); l := -l END; errposint(l) END errint;
|
||||
|
||||
PROCEDURE DisplayHaltCode(code: SYSTEM.INT32);
|
||||
BEGIN
|
||||
CASE code OF
|
||||
| -1: errstring("Assertion failure.")
|
||||
| -2: errstring("Index out of range.")
|
||||
| -3: errstring("Reached end of function without reaching RETURN.")
|
||||
| -4: errstring("CASE statement: no matching label and no ELSE.")
|
||||
| -5: errstring("Type guard failed.")
|
||||
| -6: errstring("Implicit type guard in record assignment failed.")
|
||||
| -7: errstring("Invalid case in WITH statement.")
|
||||
| -8: errstring("Value out of range.")
|
||||
| -9: errstring("Heap interrupted while locked, but lockdepth = 0 at unlock.")
|
||||
|-10: errstring("NIL access.");
|
||||
|-11: errstring("Alignment error.");
|
||||
|-12: errstring("Divide by zero.");
|
||||
|-13: errstring("Arithmetic overflow/underflow.");
|
||||
|-14: errstring("Invalid function argument.");
|
||||
|-15: errstring("Internal error, e.g. Type descriptor size mismatch.")
|
||||
|-20: errstring("Too many, or negative number of, elements in dynamic array.")
|
||||
ELSE
|
||||
END
|
||||
END DisplayHaltCode;
|
||||
|
||||
PROCEDURE Halt*(code: SYSTEM.INT32);
|
||||
BEGIN
|
||||
(*IF HaltHandler # NIL THEN HaltHandler(code) END;*)
|
||||
errstring("Terminated by Halt("); errint(code); errstring("). ");
|
||||
IF code < 0 THEN DisplayHaltCode(code) END;
|
||||
errstring(Platform.NL);
|
||||
Platform.Exit(code);
|
||||
END Halt;
|
||||
|
||||
PROCEDURE AssertFail*(code: SYSTEM.INT32);
|
||||
BEGIN
|
||||
errstring("Assertion failure.");
|
||||
IF code # 0 THEN errstring(" ASSERT code "); errint(code); errstring("."); END;
|
||||
errstring(Platform.NL);
|
||||
Platform.Exit(code);
|
||||
END AssertFail;
|
||||
|
||||
(*
|
||||
PROCEDURE SetHalt*(p: HaltProcedure);
|
||||
BEGIN HaltHandler := p; END SetHalt;
|
||||
*)
|
||||
|
||||
END Modules.
|
||||
|
|
|
|||
|
|
@ -28,7 +28,6 @@ TYPE
|
|||
VAR
|
||||
LittleEndian-: BOOLEAN;
|
||||
MainStackFrame-: SYSTEM.ADDRESS;
|
||||
HaltCode-: LONGINT;
|
||||
PID-: INTEGER; (* Note: Must be updated by Fork implementation *)
|
||||
CWD-: ARRAY 256 OF CHAR;
|
||||
ArgCount-: INTEGER;
|
||||
|
|
@ -131,7 +130,6 @@ BEGIN
|
|||
ArgCount := SYSTEM.VAL(INTEGER, argc);
|
||||
av := SYSTEM.VAL(ArgVecPtr, argvadr);
|
||||
ArgVector := av[0];
|
||||
HaltCode := -128;
|
||||
|
||||
(* This function (Platform.Init) is called at program startup BEFORE any
|
||||
modules have been initalised. In turn we must initialise the heap
|
||||
|
|
@ -464,66 +462,8 @@ END Rename;
|
|||
|
||||
(* Process termination *)
|
||||
|
||||
PROCEDURE -exit(code: INTEGER) "exit(code)";
|
||||
PROCEDURE Exit*(code: INTEGER);
|
||||
BEGIN exit(code) END Exit;
|
||||
|
||||
PROCEDURE -errstring(s: ARRAY OF CHAR) 'write(1, s, s__len-1)';
|
||||
PROCEDURE -errc (c: CHAR) 'write(1, &c, 1)';
|
||||
PROCEDURE errch(c: CHAR); BEGIN errc(c) END errch;
|
||||
PROCEDURE errln; BEGIN errch(0AX) END errln;
|
||||
|
||||
PROCEDURE errposint(l: LONGINT);
|
||||
BEGIN IF l>10 THEN errposint(l DIV 10) END; errch(CHR(ORD('0') + (l MOD 10))) END errposint;
|
||||
|
||||
PROCEDURE errint(l: LONGINT);
|
||||
BEGIN IF l<0 THEN errch('-'); l := -l END; errposint(l) END errint;
|
||||
|
||||
PROCEDURE DisplayHaltCode(code: LONGINT);
|
||||
BEGIN
|
||||
CASE code OF
|
||||
| -1: errstring("Assertion failure.")
|
||||
| -2: errstring("Index out of range.")
|
||||
| -3: errstring("Reached end of function without reaching RETURN.")
|
||||
| -4: errstring("CASE statement: no matching label and no ELSE.")
|
||||
| -5: errstring("Type guard failed.")
|
||||
| -6: errstring("Implicit type guard in record assignment failed.")
|
||||
| -7: errstring("Invalid case in WITH statement.")
|
||||
| -8: errstring("Value out of range.")
|
||||
| -9: errstring("Heap interrupted while locked, but lockdepth = 0 at unlock.")
|
||||
|-10: errstring("NIL access.");
|
||||
|-11: errstring("Alignment error.");
|
||||
|-12: errstring("Divide by zero.");
|
||||
|-13: errstring("Arithmetic overflow/underflow.");
|
||||
|-14: errstring("Invalid function argument.");
|
||||
|-15: errstring("Internal error, e.g. Type descriptor size mismatch.")
|
||||
|-20: errstring("Too many, or negative number of, elements in dynamic array.")
|
||||
ELSE
|
||||
END
|
||||
END DisplayHaltCode;
|
||||
|
||||
PROCEDURE Halt*(code: SYSTEM.INT32);
|
||||
BEGIN
|
||||
HaltCode := code;
|
||||
IF HaltHandler # NIL THEN HaltHandler(code) END;
|
||||
errstring("Terminated by Halt("); errint(code); errstring("). ");
|
||||
IF code < 0 THEN DisplayHaltCode(code) END;
|
||||
errln;
|
||||
exit(SYSTEM.VAL(INTEGER,code));
|
||||
END Halt;
|
||||
|
||||
PROCEDURE AssertFail*(code: SYSTEM.INT32);
|
||||
BEGIN
|
||||
errstring("Assertion failure.");
|
||||
IF code # 0 THEN errstring(" ASSERT code "); errint(code); errstring("."); END;
|
||||
errln;
|
||||
exit(SYSTEM.VAL(INTEGER,code));
|
||||
END AssertFail;
|
||||
|
||||
PROCEDURE SetHalt*(p: HaltProcedure);
|
||||
BEGIN HaltHandler := p; END SetHalt;
|
||||
|
||||
|
||||
PROCEDURE -exit(code: LONGINT) "exit((int)code)";
|
||||
PROCEDURE Exit*(code: LONGINT); BEGIN exit(code) END Exit;
|
||||
|
||||
|
||||
|
||||
|
|
@ -537,7 +477,6 @@ PROCEDURE -getpid(): INTEGER "(INTEGER)getpid()";
|
|||
BEGIN
|
||||
TestLittleEndian;
|
||||
|
||||
HaltCode := -128;
|
||||
HaltHandler := NIL;
|
||||
TimeStart := 0; TimeStart := Time();
|
||||
PID := getpid();
|
||||
|
|
|
|||
|
|
@ -526,65 +526,8 @@ END Rename;
|
|||
|
||||
(* Process termination *)
|
||||
|
||||
PROCEDURE -exit(code: INTEGER) "ExitProcess((UINT)code)";
|
||||
PROCEDURE Exit*(code: INTEGER);
|
||||
BEGIN exit(code) END Exit;
|
||||
|
||||
|
||||
PROCEDURE -errstring(s: ARRAY OF CHAR) 'WriteFile((HANDLE)Platform_StdOut, s, s__len-1, 0,0)';
|
||||
PROCEDURE -errc (c: CHAR) 'WriteFile((HANDLE)Platform_StdOut, &c, 1, 0,0)';
|
||||
PROCEDURE errch(c: CHAR); BEGIN errc(c) END errch;
|
||||
PROCEDURE errln; BEGIN errch(0DX); errch(0AX) END errln;
|
||||
|
||||
PROCEDURE errposint(l: LONGINT);
|
||||
BEGIN IF l>10 THEN errposint(l DIV 10) END; errch(CHR(ORD('0') + (l MOD 10))) END errposint;
|
||||
|
||||
PROCEDURE errint(l: LONGINT);
|
||||
BEGIN IF l<0 THEN errch('-'); l := -l END; errposint(l) END errint;
|
||||
|
||||
PROCEDURE DisplayHaltCode(code: LONGINT);
|
||||
BEGIN
|
||||
CASE code OF
|
||||
| -1: errstring("Assertion failure.")
|
||||
| -2: errstring("Index out of range.")
|
||||
| -3: errstring("Reached end of function without reaching RETURN.")
|
||||
| -4: errstring("CASE statement: no matching label and no ELSE.")
|
||||
| -5: errstring("Type guard failed.")
|
||||
| -6: errstring("Type equality failed.")
|
||||
| -7: errstring("WITH statement type guard failed.")
|
||||
| -8: errstring("SHORT: Value too large for shorter type.")
|
||||
| -9: errstring("Heap interrupted while locked, but lockdepth = 0 at unlock.")
|
||||
|-10: errstring("NIL access.");
|
||||
|-11: errstring("Alignment error.");
|
||||
|-12: errstring("Divide by zero.");
|
||||
|-13: errstring("Arithmetic overflow/underflow.");
|
||||
|-14: errstring("Invalid function argument.");
|
||||
|-15: errstring("Internal error, e.g. Type descriptor size mismatch.")
|
||||
|-20: errstring("Too many, or negative number of, elements in dynamic array.")
|
||||
ELSE
|
||||
END
|
||||
END DisplayHaltCode;
|
||||
|
||||
PROCEDURE Halt*(code: SYSTEM.INT32);
|
||||
BEGIN
|
||||
HaltCode := code;
|
||||
IF HaltHandler # NIL THEN HaltHandler(code) END;
|
||||
errstring("Terminated by Halt("); errint(code); errstring("). ");
|
||||
IF code < 0 THEN DisplayHaltCode(code) END;
|
||||
errln;
|
||||
exit(SYSTEM.VAL(INTEGER,code));
|
||||
END Halt;
|
||||
|
||||
PROCEDURE AssertFail*(code: SYSTEM.INT32);
|
||||
BEGIN
|
||||
errstring("Assertion failure.");
|
||||
IF code # 0 THEN errstring(" ASSERT code "); errint(code); errstring("."); END;
|
||||
errln;
|
||||
exit(SYSTEM.VAL(INTEGER,code));
|
||||
END AssertFail;
|
||||
|
||||
PROCEDURE SetHalt*(p: HaltProcedure);
|
||||
BEGIN HaltHandler := p; END SetHalt;
|
||||
PROCEDURE -exit(code: LONGINT) "ExitProcess((UINT)code)";
|
||||
PROCEDURE Exit*(code: LONGINT); BEGIN exit(code) END Exit;
|
||||
|
||||
|
||||
PROCEDURE -GetConsoleMode(h: FileHandle; VAR m: SYSTEM.INT32): BOOLEAN "GetConsoleMode((HANDLE)h, (DWORD*)m)";
|
||||
|
|
|
|||
|
|
@ -103,11 +103,11 @@ extern void Platform_OSFree (ADDRESS addr);
|
|||
|
||||
// Assertions and Halts
|
||||
|
||||
extern void Platform_Halt(INT32 x);
|
||||
extern void Platform_AssertFail(INT32 x);
|
||||
extern void Modules_Halt(INT32 x);
|
||||
extern void Modules_AssertFail(INT32 x);
|
||||
|
||||
#define __HALT(x) Platform_Halt(x)
|
||||
#define __ASSERT(cond, x) if (!(cond)) Platform_AssertFail((INT32)(x))
|
||||
#define __HALT(x) Modules_Halt((INT32)(x))
|
||||
#define __ASSERT(cond, x) if (!(cond)) Modules_AssertFail((INT32)(x))
|
||||
|
||||
|
||||
// Index checking
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue