vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 04:02:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Simplify runtime error reporting and move to platform common source.

Browse source
This commit is contained in:
David Brown 2016-11-12 10:20:50 +00:00
parent ed7043324d
commit 716240bdd6
205 changed files with 986 additions and 1063 deletions
Download patch file Download diff file Expand all files Collapse all files

5
src/compiler/Compiler.Mod
View file

@ -135,9 +135,8 @@ MODULE Compiler; (* J. Templ 3.2.95 *)
IF sig = 3 THEN
Platform.Exit(0)
ELSE
IF (sig = 4) & (Platform.HaltCode = -15) THEN
OPM.LogWStr(" --- Oberon compiler internal error");
OPM.LogWLn
IF sig = 4 THEN
OPM.LogWStr(" --- Oberon compiler internal error"); OPM.LogWLn
END ;
Platform.Exit(2)
END

4
src/compiler/extTools.Mod
View file

@ -1,6 +1,6 @@
MODULE extTools;
IMPORT Strings, Out, Configuration, Platform, OPM;
IMPORT Strings, Out, Configuration, Platform, Modules, OPM;
VAR CFLAGS: ARRAY 1023 OF CHAR;
@ -24,7 +24,7 @@ BEGIN
IF (status = 0) & (exitcode = 127) THEN
Out.String("Is the C compiler in the current command path?"); Out.Ln
END;
IF status # 0 THEN Platform.Halt(status) ELSE Platform.Halt(exitcode) END
IF status # 0 THEN Modules.Halt(status) ELSE Modules.Halt(exitcode) END
END;
END execute;

16
src/library/s3/ethReals.Mod
View file

@ -10,7 +10,7 @@ Implemented by Bernd Moesli, Seminar for Applied Mathematics,
Swiss Federal Institute of Technology Z…rich.
*)
IMPORT SYSTEM, Platform;
IMPORT SYSTEM, Modules;
(* Bernd Moesli
Seminar for Applied Mathematics
@ -50,7 +50,7 @@ BEGIN
RETURN SHORT(ASH(SYSTEM.VAL(INTEGER, x), -23)) MOD 256
ELSIF SIZE(LONGINT) = 4 THEN
RETURN SHORT(ASH(SYSTEM.VAL(LONGINT, x), -23)) MOD 256
ELSE Platform.Halt(-15);
ELSE Modules.Halt(-15);
END
END Expo;
@ -77,7 +77,7 @@ BEGIN
SYSTEM.GET(SYSTEM.ADR(x), i);
i := SHORT(ASH(ASH(ASH(i, -31), 8) + e MOD 256, 23) + i MOD ASH(1, 23));
SYSTEM.PUT(SYSTEM.ADR(x), i)
ELSE Platform.Halt(-15)
ELSE Modules.Halt(-15)
END
END SetExpo;
@ -93,7 +93,7 @@ BEGIN
SYSTEM.GET(SYSTEM.ADR(x) + H, i);
i := SHORT(ASH(ASH(ASH(i, -31), 11) + e MOD 2048, 20) + i MOD ASH(1, 20));
SYSTEM.PUT(SYSTEM.ADR(x) + H, i)
ELSE Platform.Halt(-15)
ELSE Modules.Halt(-15)
END
END SetExpoL;
@ -105,7 +105,7 @@ BEGIN
SYSTEM.PUT(SYSTEM.ADR(x), h)
ELSIF SIZE(INTEGER) = 4 THEN
SYSTEM.PUT(SYSTEM.ADR(x), SYSTEM.VAL(INTEGER, h))
ELSE Platform.Halt(-15)
ELSE Modules.Halt(-15)
END;
RETURN x
END Real;
@ -120,7 +120,7 @@ BEGIN
ELSIF SIZE(INTEGER) = 4 THEN
SYSTEM.PUT(SYSTEM.ADR(x) + H, SYSTEM.VAL(INTEGER, h));
SYSTEM.PUT(SYSTEM.ADR(x) + L, SYSTEM.VAL(INTEGER, l))
ELSE Platform.Halt(-15)
ELSE Modules.Halt(-15)
END;
RETURN x
END RealL;
@ -133,7 +133,7 @@ BEGIN
SYSTEM.PUT(SYSTEM.ADR(l), x); RETURN l
ELSIF SIZE(INTEGER) = 4 THEN
SYSTEM.PUT(SYSTEM.ADR(i), x); RETURN i
ELSE Platform.Halt(-15)
ELSE Modules.Halt(-15)
END
END Int;
@ -147,7 +147,7 @@ BEGIN
ELSIF SIZE(INTEGER) = 4 THEN
SYSTEM.GET(SYSTEM.ADR(x) + H, i); h := i;
SYSTEM.GET(SYSTEM.ADR(x) + L, i); l := i
ELSE Platform.Halt(-15)
ELSE Modules.Halt(-15)
END
END IntL;

4
src/runtime/Heap.Mod
View file

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

67
src/runtime/Modules.Mod
View file

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

65
src/runtime/Platformunix.Mod
View file

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

61
src/runtime/Platformwindows.Mod
View file

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

8
src/runtime/SYSTEM.h
View file

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

1
src/tools/make/oberon.mk
View file

@ -122,6 +122,7 @@ translate:
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/OPP.Mod
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -Ssfm -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/compiler/Compiler.Mod
cp src/runtime/*.[ch] $(BUILDDIR)
@printf "$(BUILDDIR) filled with compiler C source.\n"