A2OS/source/Generic.Unix.Traps.Mod

(* ETH Oberon, Copyright 2000 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)

MODULE Traps;  (** AUTHOR "G.F."; PURPOSE "Exception Trap and symbolic debugging"; *)

(* 2000.02.06	g.f.	UnixOberon release 2.3.6d	*)
(* 2006.07.09	g.f.	UnixAos version	*)

IMPORT S := SYSTEM, Trace, Glue, Unix, Objects, Machine, Heaps, Streams, Modules, Reflection, 
		TrapWriters, Commands, StdIO;  

CONST
	AddrSize = SIZEOF( ADDRESS );
	
TYPE 		
	
	ExceptionHandler = RECORD  pc, fp, sp: ADDRESS  END;
	
VAR 
	
	TrapHandlingLevel: INTEGER;  
	
	trace: BOOLEAN;  
	
	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 TimeTag( w: Streams.Writer );
	VAR 
		tv: Unix.Timeval;  tz: Unix.Timezone;  t: Unix.TmPtr;  ret: LONGINT;
			
		PROCEDURE Int( i: LONGINT );
		BEGIN
			IF i < 10 THEN  w.Char( '0' )  END;
			w.Int( i, 0 )
		END Int;
			
	BEGIN
		ret := Unix.gettimeofday( tv, tz );
		t := Unix.localtime( tv );
		w.Int( 1900 + t.year, 4 );  w.Char( '/' );  Int( t.mon + 1 );  w.Char( '/' );  Int( t.mday );  
		w.String( "  " );  Int( t.hour );  w.Char( ':' );  Int( t.min );  w.Ln;
	END TimeTag;
	
	
		
	PROCEDURE FinishTrap( w: Streams.Writer;  p: Objects.Process );
	VAR tag: ADDRESS;  td: Modules.TypeDesc;  name: ARRAY 72 OF CHAR;
	BEGIN
		w.Char( 2X );   (* end of trap text *) 
		w.Update;
		TrapWriters.Trapped;
			
		IF p.obj = NIL THEN	(* the main thread is not associated with any object *)
			Unix.exit( -1 )
		ELSE
			S.GET( S.VAL( ADDRESS, p.obj ) - AddrSize, tag );
			S.GET( tag - AddrSize, td );  
			IF td.mod # NIL THEN  
				COPY( td.mod.name, name );  Append( name,  "." );  Append( name, td.name );
				IF name = "Oberon.System.OberonRunner" THEN  UnlockOberon  END
			END
		END;
		TrapHandlingLevel := 0;
		Machine.Release( Machine.Trap )
	END FinishTrap;
	
	

	PROCEDURE Trap( sig: LONGINT;  ucp: Unix.Ucontext;  fatalerror: BOOLEAN );  
	VAR 
		pc, sp, bp: ADDRESS;  
		trapno: LONGINT;  
		process: Objects.Process;  
		handler: ExceptionHandler;  
		w: Streams.Writer;
	BEGIN 
		INC( TrapHandlingLevel ); 
		IF trace THEN  
			Trace.String( "Aos Trap:  signal = " );  Trace.Int( sig, 0 );  
			Trace.String( ",  ucp = " );  Trace.Address( S.VAL( ADDRESS, ucp ) );  
			Trace.String( ", traphandling  level = " ); Trace.Int( TrapHandlingLevel, 1 );  
			Trace.Ln;  
		END;  
		
		IF fatalerror THEN 
			w := unix.error  
		ELSE  
			w := TrapWriters.GetWriter();
			w.Char( 1X );   (* begin of trap text *) 
		END;

		w.Ln;  
		w.String( Machine.version ); w.String( "   " );  TimeTag( w );  w.Ln; 
		IF TrapHandlingLevel = 1 THEN  
			IF ~fatalerror THEN  Machine.Acquire( Machine.Trap )  END;
			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.r_sp;
				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)" ) 
				|12:	w.String( "  (division error)" )
				ELSE 
					IF trapno >= 30 THEN  w.String( "  (programmed HALT)" )  
					ELSE  w.String( "  (unknown exception)" )   
					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.Char( ')' );  
		END;  
		w.Ln;
		IF TrapHandlingLevel = 1 THEN
			process := Objects.CurrentProcess( ); 
			pc := ucp.mc.r_pc;  bp := ucp.mc.r_bp;
			IF pc = 0 THEN  
				(* assume call of procedure variable with value NIL *)
				S.GET( sp, pc );   (* get return address on top of stack *)
			END;  	
			w.Ln;
			w.String( "    sp = " );  w.Address( sp );  w.String( ", fp = " );  w.Address( bp ); 
			w.String( ", pc = " );  w.Address( pc );  w.Ln;  
			w.Ln;  
			Reflection.StackTraceBack( w, pc, bp, sp, Objects.GetStackBottom( process ), TRUE, FALSE );
			SearchExceptionHandler( process, ucp, handler ); 
		END;
		w.Ln; w.Ln; 
		w.String("----------------------------------------------------"); w.Ln; 
		
		IF fatalerror OR (TrapHandlingLevel > 2) THEN  Machine.Shutdown( FALSE )  END;
		
		FinishTrap( w, process );
		
		IF handler.pc # 0 THEN  
			IF Unix.Version # "Darwin" THEN
				(* in the Darwin port Unix.ModifyContext fails with bus error. Stack alignment problem? *)
				w.Ln;  
				w.String( "### program continues with exception handler ###" );   w.Ln;
				
				Unix.ModifyContext( ucp, handler.pc, handler.fp, handler.sp );
				RETURN  (*! to exception handler !! *)  
			END
		END;
			
		IF Machine.standaloneAppl THEN	
			unix.error.Ln;  unix.error.Ln;
			unix.error.String( "### Program aborted. Stack traceback in logfile" );  unix.error.Ln;
			unix.error.Update;
			Machine.Shutdown( FALSE )
		ELSIF TrapHandlingLevel > 1 THEN 
			Objects.Terminate
		ELSE
			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 SearchExceptionHandler( process: Objects.Process;  cont: Unix.Ucontext;  VAR handler: ExceptionHandler );  
	VAR entry, fp, sp, pc: ADDRESS;
	BEGIN 
		handler.pc := 0;  (* no handler *)
		pc := cont.mc.r_pc;  fp := cont.mc.r_bp;  sp := cont.mc.r_sp;
		IF pc = 0 THEN  
			(* assume call of procedure variable with value NIL *)
			S.GET( sp, pc );   (* get return address on top of stack *)
		END;  
		entry := Modules.GetExceptionHandler( pc );   
		WHILE (entry = -1) & (fp <= process.stackBottom) DO  
			S.GET( fp + AddrSize, pc );  
			pc := pc - 1;   (*  CALL instruction, machine dependent!!! *)
			entry := Modules.GetExceptionHandler( pc );  
			sp := fp;   (* Save the old framepointer into the stack pointer *)
			S.GET( fp, fp ) (* Unwind PAF *)
		END;  
		IF entry # -1 THEN 
			handler.pc := entry;  handler.fp := fp;  handler.sp := sp
		END  
	END SearchExceptionHandler;  
	
	
	PROCEDURE SignalHandler( signal: LONGINT;  scp, ucp, dummy: ADDRESS );   
		(* 'dummy' for 16 byte stack alignment, MacOS! *)
	BEGIN 
		IF ~(signal IN  {1, 2, 14, 15}) (* SIGHUP, SIGINT, SIGALRM, SIGTERM *) THEN  
			IF trace THEN  
				Trace.String( "Traps.SignalHander: received signal " );  
				Trace.Int( signal, 1 );  Trace.Ln  
			END;
			(*IF Heaps.collecting THEN  
				Trace.Ln;  Trace.String( "PANIC: Trap " );  Trace.Int( signal, 0 );  
				Trace.String( " in garbage collector" );  Trace.Ln;  Trace.Ln;
				Machine.Release( Machine.Heaps );
			
				Trap( signal, S.VAL( Unix.Ucontext, ucp ), TRUE )  
			ELSE  
			*)
				Trap( signal, S.VAL( Unix.Ucontext, ucp ), FALSE )  
	(*		END  *)
		END
	END SignalHandler;  
	


BEGIN 
	trace := 3 IN Glue.debug; 
	(*Unix.Dlsym( 0, "InstallTrap", ADDRESSOF( InstallSignalHandler ) );*)
	Unix.InstallSignalHandler( SignalHandler );
	unix := StdIO.env
END Traps.