unit signals; interface {$PACKRECORDS C} { Signals } const SIGABRT = 288; SIGFPE = 289; SIGILL = 290; SIGSEGV = 291; SIGTERM = 292; SIGALRM = 293; SIGHUP = 294; SIGINT = 295; SIGKILL = 296; SIGPIPE = 297; SIGQUIT = 298; SIGUSR1 = 299; SIGUSR2 = 300; SIGNOFP = 301; SIGTRAP = 302; SIGTIMR = 303; { Internal for setitimer (SIGALRM, SIGPROF) } SIGPROF = 304; SIGMAX = 320; SIG_BLOCK = 1; SIG_SETMASK = 2; SIG_UNBLOCK = 3; function SIG_DFL( x: longint) : longint; function SIG_ERR( x: longint) : longint; function SIG_IGN( x: longint) : longint; type SignalHandler = function (v : longint) : longint; PSignalHandler = ^SignalHandler; { to be compatible with linux.pp } function signal(sig : longint;func : SignalHandler) : SignalHandler; const EXCEPTION_MAXIMUM_PARAMETERS = 15; type FLOATING_SAVE_AREA = record ControlWord : DWORD; StatusWord : DWORD; TagWord : DWORD; ErrorOffset : DWORD; ErrorSelector : DWORD; DataOffset : DWORD; DataSelector : DWORD; RegisterArea : array[0..79] of BYTE; Cr0NpxState : DWORD; end; _FLOATING_SAVE_AREA = FLOATING_SAVE_AREA; TFLOATINGSAVEAREA = FLOATING_SAVE_AREA; PFLOATINGSAVEAREA = ^FLOATING_SAVE_AREA; CONTEXT = record ContextFlags : DWORD; Dr0 : DWORD; Dr1 : DWORD; Dr2 : DWORD; Dr3 : DWORD; Dr6 : DWORD; Dr7 : DWORD; FloatSave : FLOATING_SAVE_AREA; SegGs : DWORD; SegFs : DWORD; SegEs : DWORD; SegDs : DWORD; Edi : DWORD; Esi : DWORD; Ebx : DWORD; Edx : DWORD; Ecx : DWORD; Eax : DWORD; Ebp : DWORD; Eip : DWORD; SegCs : DWORD; EFlags : DWORD; Esp : DWORD; SegSs : DWORD; end; LPCONTEXT = ^CONTEXT; _CONTEXT = CONTEXT; TCONTEXT = CONTEXT; PCONTEXT = ^CONTEXT; type pexception_record = ^exception_record; EXCEPTION_RECORD = record ExceptionCode : cardinal; ExceptionFlags : longint; ExceptionRecord : pexception_record; ExceptionAddress : pointer; NumberParameters : longint; ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of pointer; end; PEXCEPTION_POINTERS = ^EXCEPTION_POINTERS; EXCEPTION_POINTERS = record ExceptionRecord : PEXCEPTION_RECORD ; ContextRecord : PCONTEXT ; end; implementation const EXCEPTION_ACCESS_VIOLATION = $c0000005; EXCEPTION_BREAKPOINT = $80000003; EXCEPTION_DATATYPE_MISALIGNMENT = $80000002; EXCEPTION_SINGLE_STEP = $80000004; EXCEPTION_ARRAY_BOUNDS_EXCEEDED = $c000008c; EXCEPTION_FLT_DENORMAL_OPERAND = $c000008d; EXCEPTION_FLT_DIVIDE_BY_ZERO = $c000008e; EXCEPTION_FLT_INEXACT_RESULT = $c000008f; EXCEPTION_FLT_INVALID_OPERATION = $c0000090; EXCEPTION_FLT_OVERFLOW = $c0000091; EXCEPTION_FLT_STACK_CHECK = $c0000092; EXCEPTION_FLT_UNDERFLOW = $c0000093; EXCEPTION_INT_DIVIDE_BY_ZERO = $c0000094; EXCEPTION_INT_OVERFLOW = $c0000095; EXCEPTION_INVALID_HANDLE = $c0000008; EXCEPTION_PRIV_INSTRUCTION = $c0000096; EXCEPTION_NONCONTINUABLE_EXCEPTION = $c0000025; EXCEPTION_NONCONTINUABLE = $1; EXCEPTION_STACK_OVERFLOW = $c00000fd; EXCEPTION_INVALID_DISPOSITION = $c0000026; EXCEPTION_ILLEGAL_INSTRUCTION = $C000001D; EXCEPTION_IN_PAGE_ERROR = $C0000006; EXCEPTION_EXECUTE_HANDLER = 1; EXCEPTION_CONTINUE_EXECUTION = -(1); EXCEPTION_CONTINUE_SEARCH = 0; type { type of functions that should be used for exception handling } LPTOP_LEVEL_EXCEPTION_FILTER = function(excep :PEXCEPTION_POINTERS) : longint;stdcall; function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : LPTOP_LEVEL_EXCEPTION_FILTER) : LPTOP_LEVEL_EXCEPTION_FILTER; external 'kernel32' name 'SetUnhandledExceptionFilter'; var signal_list : Array[SIGABRT..SIGMAX] of SignalHandler; var { value of the stack segment to check if the call stack can be written on exceptions } _SS : longint; const fpucw : word = $1332; Exception_handler_installed : boolean = false; MAX_Level = 16; except_level : byte = 0; var except_eip : array[0..Max_level-1] of longint; except_signal : array[0..Max_level-1] of longint; reset_fpu : array[0..max_level-1] of boolean; procedure JumpToHandleSignal; var res, eip, _ebp, sigtype : longint; begin asm movl (%ebp),%eax movl %eax,_ebp end; Writeln('In start of JumpToHandleSignal'); if except_level>0 then dec(except_level) else RunError(216); eip:=except_eip[except_level]; sigtype:=except_signal[except_level]; if reset_fpu[except_level] then asm fninit fldcw fpucw end; if assigned(System_exception_frame) then { get the handler in front again } asm movl System_exception_frame,%eax movl %eax,%fs:(0) end; if (sigtype>=SIGABRT) and (sigtype<=SIGMAX) and (signal_list[sigtype]<>@SIG_DFL) then begin res:=signal_list[sigtype](sigtype); end else res:=0; if res=0 then Begin Writeln('In JumpToHandleSignal'); RunError(sigtype); end else { jump back to old code } asm movl eip,%eax push %eax movl _ebp,%eax push %eax leave ret end; end; function Signals_exception_handler (excep_exceptionrecord :PEXCEPTION_RECORD; excep_frame : PEXCEPTION_FRAME; excep_contextrecord : PCONTEXT; dispatch : pointer) : longint;stdcall; var frame,res : longint; function CallSignal(sigtype,frame : longint;must_reset_fpu : boolean) : longint; begin writeln(stderr,'CallSignal called'); {if frame=0 then begin CallSignal:=1; writeln(stderr,'CallSignal frame is zero'); end else } begin if except_level >= Max_level then exit; except_eip[except_level]:=excep_ContextRecord^.Eip; except_signal[except_level]:=sigtype; reset_fpu[except_level]:=must_reset_fpu; inc(except_level); {dec(excep^.ContextRecord^.Esp,4); plongint (excep^.ContextRecord^.Esp)^ := longint(excep^.ContextRecord^.Eip);} excep_ContextRecord^.Eip:=longint(@JumpToHandleSignal); excep_ExceptionRecord^.ExceptionCode:=0; CallSignal:=0; writeln(stderr,'Exception_Continue_Execution set'); end; end; begin if excep_ContextRecord^.SegSs=_SS then frame:=excep_ContextRecord^.Ebp else frame:=0; { default : unhandled !} res:=1; {$ifdef SYSTEMEXCEPTIONDEBUG} if IsConsole then writeln(stderr,'Signals exception ', hexstr(excep_ExceptionRecord^.ExceptionCode,8)); {$endif SYSTEMEXCEPTIONDEBUG} case excep_ExceptionRecord^.ExceptionCode of EXCEPTION_ACCESS_VIOLATION : res:=CallSignal(SIGSEGV,frame,false); { EXCEPTION_BREAKPOINT = $80000003; EXCEPTION_DATATYPE_MISALIGNMENT = $80000002; EXCEPTION_SINGLE_STEP = $80000004; } EXCEPTION_ARRAY_BOUNDS_EXCEEDED : res:=CallSignal(SIGSEGV,frame,false); EXCEPTION_FLT_DENORMAL_OPERAND : begin res:=CallSignal(SIGFPE,frame,true); end; EXCEPTION_FLT_DIVIDE_BY_ZERO : begin res:=CallSignal(SIGFPE,frame,true); {excep^.ContextRecord^.FloatSave.StatusWord:=excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;} end; {EXCEPTION_FLT_INEXACT_RESULT = $c000008f; } EXCEPTION_FLT_INVALID_OPERATION : begin res:=CallSignal(SIGFPE,frame,true); end; EXCEPTION_FLT_OVERFLOW : begin res:=CallSignal(SIGFPE,frame,true); end; EXCEPTION_FLT_STACK_CHECK : begin res:=CallSignal(SIGFPE,frame,true); end; EXCEPTION_FLT_UNDERFLOW : begin res:=CallSignal(SIGFPE,frame,true); { should be accepted as zero !! } end; EXCEPTION_INT_DIVIDE_BY_ZERO : res:=CallSignal(SIGFPE,frame,false); EXCEPTION_INT_OVERFLOW : res:=CallSignal(SIGFPE,frame,false); {EXCEPTION_INVALID_HANDLE = $c0000008; EXCEPTION_PRIV_INSTRUCTION = $c0000096; EXCEPTION_NONCONTINUABLE_EXCEPTION = $c0000025; EXCEPTION_NONCONTINUABLE = $1;} EXCEPTION_STACK_OVERFLOW : res:=CallSignal(SIGSEGV,frame,false); {EXCEPTION_INVALID_DISPOSITION = $c0000026;} EXCEPTION_ILLEGAL_INSTRUCTION, EXCEPTION_PRIV_INSTRUCTION, EXCEPTION_IN_PAGE_ERROR, EXCEPTION_SINGLE_STEP : res:=CallSignal(SIGSEGV,frame,false); { Ignore EXCEPTION_INVALID_HANDLE exceptions } EXCEPTION_INVALID_HANDLE : res:=0; end; Signals_exception_handler:=res; end; function API_signals_exception_handler(except : PEXCEPTION_POINTERS) : longint; begin API_signals_exception_handler:=Signals_exception_handler( @except^.ExceptionRecord, nil, @except^.ContextRecord, nil); end; const PreviousHandler : LPTOP_LEVEL_EXCEPTION_FILTER = nil; Prev_Handler : pointer = nil; Prev_fpc_handler : pointer = nil; procedure install_exception_handler; {$ifdef SYSTEMEXCEPTIONDEBUG} var oldexceptaddr,newexceptaddr : longint; {$endif SYSTEMEXCEPTIONDEBUG} begin if Exception_handler_installed then exit; if assigned(System_exception_frame) then begin prev_fpc_handler:=System_exception_frame^.handler; System_exception_frame^.handler:=@Signals_exception_handler; { get the handler in front again } asm movl %fs:(0),%eax movl %eax,prev_handler movl System_exception_frame,%eax movl %eax,%fs:(0) end; Exception_handler_installed:=true; exit; end; {$ifdef SYSTEMEXCEPTIONDEBUG} asm movl $0,%eax movl %fs:(%eax),%eax movl %eax,oldexceptaddr end; {$endif SYSTEMEXCEPTIONDEBUG} PreviousHandler:=SetUnhandledExceptionFilter(@API_signals_exception_handler); {$ifdef SYSTEMEXCEPTIONDEBUG} asm movl $0,%eax movl %fs:(%eax),%eax movl %eax,newexceptaddr end; if IsConsole then begin writeln(stderr,'Old exception ',hexstr(oldexceptaddr,8), ' new exception ',hexstr(newexceptaddr,8)); writeln('SetUnhandledExceptionFilter returned ',hexstr(longint(PreviousHandler),8)); end; {$endif SYSTEMEXCEPTIONDEBUG} Exception_handler_installed := true; end; procedure remove_exception_handler; begin if not Exception_handler_installed then exit; if assigned(System_exception_frame) then begin if assigned(prev_fpc_handler) then System_exception_frame^.handler:=prev_fpc_handler; prev_fpc_handler:=nil; { restore old handler order again } if assigned(prev_handler) then asm movl prev_handler,%eax movl %eax,%fs:(0) end; prev_handler:=nil; Exception_handler_installed:=false; exit; end; SetUnhandledExceptionFilter(PreviousHandler); PreviousHandler:=nil; Exception_handler_installed:=false; end; function SIG_ERR(x:longint):longint; begin SIG_ERR:=-1; end; function SIG_IGN(x:longint):longint; begin SIG_IGN:=-1; end; function SIG_DFL(x:longint):longint; begin SIG_DFL:=0; end; function signal(sig : longint;func : SignalHandler) : SignalHandler; var temp : SignalHandler; begin if ((sig < SIGABRT) or (sig > SIGMAX) or (sig = SIGKILL)) then begin signal:=@SIG_ERR; runerror(201); end; if not Exception_handler_installed then install_exception_handler; temp := signal_list[sig]; signal_list[sig] := func; signal:=temp; end; var i : longint; initialization asm xorl %eax,%eax movw %ss,%ax movl %eax,_SS end; for i:=SIGABRT to SIGMAX do signal_list[i]:=@SIG_DFL; {install_exception_handler; delay this to first use as other units also might install their handlers PM } finalization remove_exception_handler; end.