MODULE Traps;
IMPORT S := SYSTEM, Trace, Glue, Unix, Objects, Machine, Heaps, Streams, Modules, Reflection,
TrapWriters, Commands, StdIO;
TYPE
Address = S.ADDRESS;
SigHandler = PROCEDURE ( sig: LONGINT; scp, ucp, dum: Address );
VAR
InstallSignalHandler: PROCEDURE ( h: SigHandler );
TrapHandlingLevel: INTEGER;
hexDigit: ARRAY 17 OF CHAR;
debug: SET;
unix: Commands.Context;
PROCEDURE Append( VAR ar: ARRAY OF CHAR; CONST this: ARRAY OF CHAR );
VAR i, j: LONGINT;
BEGIN
i := 0; j := 0;
WHILE ar[i] # 0X DO INC( i ) END;
WHILE (i < LEN( ar ) - 1) & (this[j] # 0X) DO ar[i] := this[j]; INC( i ); INC( j ) END;
ar[i] := 0X
END Append;
PROCEDURE GetTypeName( tag: Address; VAR name: ARRAY OF CHAR );
VAR typ: Modules.TypeDesc;
BEGIN
S.GET( tag - 4, typ ); name[0] := 0X;
IF typ.mod # NIL THEN Append( name, typ.mod.name ); Append( name, "." ) END;
Append( name, typ.name )
END GetTypeName;
PROCEDURE Trap( sig: LONGINT; ucp: Unix.Ucontext );
VAR
pc, sp, bp: Address;
trapno: LONGINT;
trProcess: Objects.Process; handled: BOOLEAN;
w: Streams.Writer;
PROCEDURE FinishTrapText( exitAos: BOOLEAN );
VAR tag: Address; name: ARRAY 72 OF CHAR;
BEGIN
w.Ln; w.Ln;
w.String("----------------------------------------------------"); w.Ln;
w.Char( 2X );
w.Update;
TrapWriters.Trapped;
IF exitAos THEN Unix.exit( 1 ) END;
S.GET( S.VAL( Address, trProcess.obj ) - 4, tag );
GetTypeName( tag, name );
IF name = "Oberon.System.OberonRunner" THEN UnlockOberon END;
TrapHandlingLevel := 0;
Machine.Release( Machine.Trap );
END FinishTrapText;
BEGIN
INC( TrapHandlingLevel );
IF 3 IN debug THEN
Trace.String( "Aos Trap: signal = " ); Trace.Int( sig, 0 );
Trace.String( ", ucp = " ); Trace.Hex( S.VAL( Address, ucp ), -8 );
Trace.String( ", traphandling level = " ); Trace.Int( TrapHandlingLevel, 1 );
Trace.Ln;
END;
IF Machine.standaloneAppl THEN
unix.error.Ln; unix.error.Ln;
unix.error.String( "### Program aborted. Stack backtrace in logfile" ); unix.error.Ln;
unix.error.Update
END;
trProcess := Objects.CurrentProcess( );
w := TrapWriters.GetWriter();
w.Char( 1X );
w.Ln;
w.String( Machine.version ); w.Ln; w.Ln;
IF TrapHandlingLevel = 1 THEN
Machine.Acquire( Machine.Trap );
w.String( "Trap " )
ELSE
w.String( "==== recursive Trap" )
END;
CASE sig OF
| 1: w.String( " 1 (Hangup signal)" );
| 2: w.String( " 2 (User interrupt)" );
| 3: w.String( " 3 (Quit signal)" );
| 4: w.String( " 4 (Illegal instruction)" );
| 5: w.String( " 5." );
sp := ucp.mc.espatsig;
S.GET( sp, trapno ); w.Int( trapno, 0 );
CASE trapno OF
| 1: w.String( " (WITH guard failed)" )
| 2: w.String( " (CASE invalid)" )
| 3: w.String( " (RETURN missing)" )
| 5: w.String( " (Implicit type guard failed)" )
| 6: w.String( " (Type guard failed)" )
| 7: w.String( " (Index out of range)" )
| 8: w.String( " (ASSERT failed)" )
| 9: w.String( " (Array dimension error)" )
ELSE
IF trapno >= 30 THEN w.String( " (programmed HALT)" )
ELSE w.String( " (unknown trap, division error?)" )
END
END;
| 8: w.String( " 8 (Arithmetic exception)" );
| 10: w.String( " 10 (Bus Error)" )
| 11: w.String( " 11 (Segmentation violation)" )
| 13: w.String( " 13 (Broken pipe)" )
| 14: w.String( " 14 (Alarm signal)" )
ELSE
w.String( " (Signal " ); w.Int( sig, 0 ); w.String( ") " );
END;
w.Ln;
IF TrapHandlingLevel > 1 THEN
FinishTrapText( Heaps.collecting OR (TrapHandlingLevel > 2) );
Objects.Terminate
ELSE
pc := ucp.mc.eip; bp := ucp.mc.ebp;
IF pc = 0 THEN
S.GET( sp, pc );
END;
w.String( "SP = " ); w.Address( sp ); w.Char( 'H' );
w.String( ", FP = " ); w.Address( bp ); w.Char( 'H' );
w.String( ", PC = " ); w.Address( pc ); w.Char( 'H' ); w.Ln;
w.Ln;
HandleException( trProcess, ucp, handled );
IF handled THEN
w.String( "exception handler found" ); w.Ln
ELSE
Reflection.StackTraceBack( w, pc, bp, Objects.GetStackBottom(trProcess), TRUE, FALSE )
END;
FinishTrapText( FALSE );
IF handled THEN RETURN END;
IF Heaps.collecting OR Machine.standaloneAppl THEN
Machine.Shutdown( FALSE ); Objects.Terminate
END;
IF 3 IN debug THEN
Trace.String( "Teminating trapped thread " ); Trace.Int( trProcess.id , 0 ); Trace.Ln
END;
Objects.ExitTrap()
END
END Trap;
PROCEDURE UnlockOberon;
CONST OberonKernel = "Oberon.Kernel";
VAR c: PROCEDURE;
BEGIN
IF Modules.ModuleByName( OberonKernel ) # NIL THEN
GETPROCEDURE( OberonKernel, "UnlockOberon", c );
IF c # NIL THEN c END
END;
END UnlockOberon;
PROCEDURE HandleException( obj: Objects.Process; cont: Unix.Ucontext; VAR handled: BOOLEAN );
VAR handler, fp, sp, pc: LONGINT;
BEGIN
IF Unix.version = "Darwin" THEN handled := FALSE; RETURN END;
pc := cont.mc.eip; fp := cont.mc.ebp; sp := cont.mc.espatsig;
IF pc = 0 THEN
S.GET( sp, pc );
END;
handler := Modules.GetExceptionHandler( pc );
IF handler # -1 THEN
Unix.ModifyContext( cont, handler, fp, sp );
handled := TRUE;
ELSE
WHILE Machine.LessOrEqual( fp, obj.stackBottom) & (handler = -1) DO
S.GET( fp + 4, pc );
pc := pc - 1;
handler := Modules.GetExceptionHandler( pc );
sp := fp;
S.GET( fp, fp )
END;
IF handler = -1 THEN handled := FALSE
ELSE
Unix.ModifyContext( cont, handler, fp, sp );
handled := TRUE
END
END;
END HandleException;
PROCEDURE SignalHandler( signal: LONGINT; scp, ucp, dum: Address );
CONST SIGALRM = 14;
VAR ures: LONGINT;
BEGIN
IF 3 IN debug THEN
Trace.String( "Traps.SignalHander: received signal " );
Trace.Int( signal, 1 ); Trace.Ln
END;
IF signal IN {1, 2, 15} THEN RETURN END;
IF Heaps.collecting THEN
IF signal = SIGALRM THEN
ures := Unix.alarm( 1 ); RETURN
ELSE
Trace.Ln; Trace.String( "PANIC: Trap " ); Trace.Int( signal, 0 );
Trace.String( " in garbage collector" ); Trace.Ln;
Machine.Release( Machine.Heaps );
Machine.Release( Machine.X11 );
Trap( signal, S.VAL( Unix.Ucontext, ucp ) )
END;
ELSE
Trap( signal, S.VAL( Unix.Ucontext, ucp ) )
END
END SignalHandler;
BEGIN
debug := Glue.debug; hexDigit := "0123456789ABCDEF";
Unix.Dlsym( 0, "InstallTrap", S.VAL( Address, InstallSignalHandler ) );
InstallSignalHandler( SignalHandler );
unix := StdIO.env
END Traps.