MODULE Traps;
IMPORT S := SYSTEM, Trace, Glue, Unix, Objects, Machine, Heaps, Streams, Modules, Reflection, KernelLog;
TYPE
Address = S.ADDRESS;
WriterFactory = PROCEDURE (): Streams.Writer;
TrapWriter = OBJECT (Streams.StringWriter)
VAR
trapped: BOOLEAN;
factory: WriterFactory;
PROCEDURE Trapped;
BEGIN trapped := TRUE;
END Trapped;
PROCEDURE &InitTrapWriter*;
BEGIN InitStringWriter (Streams.DefaultWriterSize); trapped := FALSE
END InitTrapWriter;
PROCEDURE SetFactory (factory: WriterFactory);
BEGIN SELF.factory := factory;
END SetFactory;
PROCEDURE Write;
VAR contents: ARRAY Streams.DefaultWriterSize OF CHAR;
len: LONGINT; writer: Streams.Writer;
BEGIN
GetRaw (contents, len);
Reset; writer := factory (); writer.Bytes (contents, 0, len);
writer.Update;
END Write;
BEGIN {ACTIVE}
LOOP
Objects.Sleep(100);
IF trapped THEN Write; trapped := FALSE
ELSIF factory = NIL THEN RETURN
END;
END;
END TrapWriter;
TrapWriter2 = OBJECT (TrapWriter)
PROCEDURE Char( c: CHAR);
BEGIN Trace.Char( c ) END Char;
PROCEDURE String( CONST s: ARRAY OF CHAR);
BEGIN Trace.String( s ) END String;
PROCEDURE Ln;
BEGIN Trace.Ln END Ln;
PROCEDURE Update;
END Update;
PROCEDURE Trapped;
END Trapped;
END TrapWriter2;
SigHandler = PROCEDURE ( sig: LONGINT; scp, ucp, dum: Address );
VAR
InstallSignalHandler: PROCEDURE ( h: SigHandler );
TrapHandlingLevel: INTEGER;
hexDigit: ARRAY 17 OF CHAR;
debug: SET;
trapWriter: TrapWriter;
defaultWriter: Streams.Writer;
w2: TrapWriter2;
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;
trthr: 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;
IF trapWriter # NIL THEN trapWriter.Trapped; trapWriter.Update END;
IF exitAos THEN Unix.exit( 1 ) END;
S.GET( S.VAL( Address, trthr.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;
trthr := Objects.CurrentProcess( );
IF Heaps.collecting THEN trapWriter := w2 END;
IF trapWriter = NIL THEN w := defaultWriter ELSE w := trapWriter END;
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( w, trthr, bp, sp, pc, handled );
IF ~handled THEN
Reflection.StackTraceBack( w, pc, bp, TRUE, FALSE )
END;
FinishTrapText( FALSE );
IF Heaps.collecting THEN Machine.Shutdown( FALSE ); Objects.Terminate END;
IF 3 IN debug THEN
Trace.String( "Teminating trapped thread " ); Trace.Int( trthr.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( w: Streams.Writer; obj: Objects.Process; fp, sp, pc: Address; VAR handled: BOOLEAN );
VAR handler: Address;
BEGIN
handler := Modules.GetExceptionHandler( pc );
IF handler # -1 THEN
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
handled := TRUE
END
END;
IF handled THEN
w.String( "(exception handler found but exception handling not yet implemented)" );
w.Ln; w.Ln;
handled := FALSE
END
END HandleException;
PROCEDURE InstallTrapWriterFactory*( factory: WriterFactory );
BEGIN
IF factory = NIL THEN
trapWriter.SetFactory (NIL);
trapWriter := NIL
ELSE
IF trapWriter = NIL THEN NEW (trapWriter) END;
trapWriter.SetFactory (factory)
END
END InstallTrapWriterFactory;
PROCEDURE SignalHandler( signal: LONGINT; scp, ucp, dum: Address );
CONST SIGALRM = 14;
VAR ures, i: 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
FOR i := 0 TO Machine.MaxLocks -1 DO
Trace.Char( Machine.lock[i] )
END;
Trace.Ln;
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 );
Streams.OpenWriter( defaultWriter, KernelLog.Send ); trapWriter := NIL;
NEW( w2 );
END Traps.