diff --git a/rtl/win32/syswin32.pp b/rtl/win32/syswin32.pp index 3d9d949ddb..1cd2a33cd5 100644 --- a/rtl/win32/syswin32.pp +++ b/rtl/win32/syswin32.pp @@ -884,306 +884,364 @@ begin LongJmp(DLLBuf,1); end; +// +// Hardware exception handling +// + {$ifdef Set_i386_Exception_handler} +(* + Error code definitions for the Win32 API functions + + + Values are 32 bit values layed out as follows: + 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 + 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 + +---+-+-+-----------------------+-------------------------------+ + |Sev|C|R| Facility | Code | + +---+-+-+-----------------------+-------------------------------+ + + where + Sev - is the severity code + 00 - Success + 01 - Informational + 10 - Warning + 11 - Error + + C - is the Customer code flag + R - is a reserved bit + Facility - is the facility code + Code - is the facility's status code +*) + const - EXCEPTION_MAXIMUM_PARAMETERS = 15; - 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; + SEVERITY_SUCCESS = $00000000; + SEVERITY_INFORMATIONAL = $40000000; + SEVERITY_WARNING = $80000000; + SEVERITY_ERROR = $C0000000; - EXCEPTION_EXECUTE_HANDLER = 1; - EXCEPTION_CONTINUE_EXECUTION = -(1); - EXCEPTION_CONTINUE_SEARCH = 0; - type +const + STATUS_SEGMENT_NOTIFICATION = $40000005; + DBG_TERMINATE_THREAD = $40010003; + DBG_TERMINATE_PROCESS = $40010004; + DBG_CONTROL_C = $40010005; + DBG_CONTROL_BREAK = $40010008; - 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; + STATUS_GUARD_PAGE_VIOLATION = $80000001; + STATUS_DATATYPE_MISALIGNMENT = $80000002; + STATUS_BREAKPOINT = $80000003; + STATUS_SINGLE_STEP = $80000004; + DBG_EXCEPTION_NOT_HANDLED = $80010001; - 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; + STATUS_ACCESS_VIOLATION = $C0000005; + STATUS_IN_PAGE_ERROR = $C0000006; + STATUS_INVALID_HANDLE = $C0000008; + STATUS_NO_MEMORY = $C0000017; + STATUS_ILLEGAL_INSTRUCTION = $C000001D; + STATUS_NONCONTINUABLE_EXCEPTION = $C0000025; + STATUS_INVALID_DISPOSITION = $C0000026; + STATUS_ARRAY_BOUNDS_EXCEEDED = $C000008C; + STATUS_FLOAT_DENORMAL_OPERAND = $C000008D; + STATUS_FLOAT_DIVIDE_BY_ZERO = $C000008E; + STATUS_FLOAT_INEXACT_RESULT = $C000008F; + STATUS_FLOAT_INVALID_OPERATION = $C0000090; + STATUS_FLOAT_OVERFLOW = $C0000091; + STATUS_FLOAT_STACK_CHECK = $C0000092; + STATUS_FLOAT_UNDERFLOW = $C0000093; + STATUS_INTEGER_DIVIDE_BY_ZERO = $C0000094; + STATUS_INTEGER_OVERFLOW = $C0000095; + STATUS_PRIVILEGED_INSTRUCTION = $C0000096; + STATUS_STACK_OVERFLOW = $C00000FD; + STATUS_CONTROL_C_EXIT = $C000013A; + STATUS_FLOAT_MULTIPLE_FAULTS = $C00002B4; + STATUS_FLOAT_MULTIPLE_TRAPS = $C00002B5; + STATUS_REG_NAT_CONSUMPTION = $C00002C9; + EXCEPTION_EXECUTE_HANDLER = 1; + EXCEPTION_CONTINUE_EXECUTION = -1; + EXCEPTION_CONTINUE_SEARCH = 0; -type pexception_record = ^exception_record; - EXCEPTION_RECORD = record - ExceptionCode : longint; - ExceptionFlags : longint; - ExceptionRecord : pexception_record; - ExceptionAddress : pointer; - NumberParameters : longint; - ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of pointer; - end; + EXCEPTION_MAXIMUM_PARAMETERS = 15; - PEXCEPTION_POINTERS = ^EXCEPTION_POINTERS; - EXCEPTION_POINTERS = record - ExceptionRecord : PEXCEPTION_RECORD ; - ContextRecord : PCONTEXT ; - end; + CONTEXT_X86 = $00010000; + CONTEXT_CONTROL = CONTEXT_X86 or $00000001; + CONTEXT_INTEGER = CONTEXT_X86 or $00000002; + CONTEXT_SEGMENTS = CONTEXT_X86 or $00000004; + CONTEXT_FLOATING_POINT = CONTEXT_X86 or $00000008; + CONTEXT_DEBUG_REGISTERS = CONTEXT_X86 or $00000010; + CONTEXT_EXTENDED_REGISTERS = CONTEXT_X86 or $00000020; + + CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS; + + MAXIMUM_SUPPORTED_EXTENSION = 512; + +type + PFloatingSaveArea = ^TFloatingSaveArea; + TFloatingSaveArea = packed record + ControlWord : Cardinal; + StatusWord : Cardinal; + TagWord : Cardinal; + ErrorOffset : Cardinal; + ErrorSelector : Cardinal; + DataOffset : Cardinal; + DataSelector : Cardinal; + RegisterArea : array[0..79] of Byte; + Cr0NpxState : Cardinal; + end; + + PContext = ^TContext; + TContext = packed record + // + // The flags values within this flag control the contents of + // a CONTEXT record. + // + ContextFlags : Cardinal; + + // + // This section is specified/returned if CONTEXT_DEBUG_REGISTERS is + // set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT + // included in CONTEXT_FULL. + // + Dr0, Dr1, Dr2, + Dr3, Dr6, Dr7 : Cardinal; + + // + // This section is specified/returned if the + // ContextFlags word contains the flag CONTEXT_FLOATING_POINT. + // + FloatSave : TFloatingSaveArea; + + // + // This section is specified/returned if the + // ContextFlags word contains the flag CONTEXT_SEGMENTS. + // + SegGs, SegFs, + SegEs, SegDs : Cardinal; + + // + // This section is specified/returned if the + // ContextFlags word contains the flag CONTEXT_INTEGER. + // + Edi, Esi, Ebx, + Edx, Ecx, Eax : Cardinal; + + // + // This section is specified/returned if the + // ContextFlags word contains the flag CONTEXT_CONTROL. + // + Ebp : Cardinal; + Eip : Cardinal; + SegCs : Cardinal; + EFlags, Esp, SegSs : Cardinal; + + // + // This section is specified/returned if the ContextFlags word + // contains the flag CONTEXT_EXTENDED_REGISTERS. + // The format and contexts are processor specific + // + ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte; + end; + +type + PExceptionRecord = ^TExceptionRecord; + TExceptionRecord = packed record + ExceptionCode : Longint; + ExceptionFlags : Longint; + ExceptionRecord : PExceptionRecord; + ExceptionAddress : Pointer; + NumberParameters : Longint; + ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer; + end; + + PExceptionPointers = ^TExceptionPointers; + TExceptionPointers = packed record + ExceptionRecord : PExceptionRecord; + ContextRecord : PContext; + end; { type of functions that should be used for exception handling } - LPTOP_LEVEL_EXCEPTION_FILTER = function(excep :PEXCEPTION_POINTERS) : longint; + TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint; - function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : LPTOP_LEVEL_EXCEPTION_FILTER) - : LPTOP_LEVEL_EXCEPTION_FILTER; - external 'kernel32' name 'SetUnhandledExceptionFilter'; +function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter; + external 'kernel32' name 'SetUnhandledExceptionFilter'; const - MAX_Level = 16; - except_level : byte = 0; + MaxExceptionLevel = 16; + exceptLevel : Byte = 0; + var - except_eip : array[0..Max_level-1] of longint; - except_error : array[0..Max_level-1] of byte; - reset_fpu : array[0..max_level-1] of boolean; + exceptEip : array[0..MaxExceptionLevel-1] of Longint; + exceptError : array[0..MaxExceptionLevel-1] of Byte; + resetFPU : array[0..MaxExceptionLevel-1] of Boolean; {$ifdef SYSTEMEXCEPTIONDEBUG} - procedure DebugHandleErrorAddrFrame(error, addr, frame : longint); - begin - if IsConsole then - begin - write(stderr,'call to HandleErrorAddrFrame(error=',error); - write(stderr,',addr=',hexstr(addr,8)); - writeln(stderr,',frame=',hexstr(frame,8),')'); - end; - HandleErrorAddrFrame(error,addr,frame); - end; +procedure DebugHandleErrorAddrFrame(error, addr, frame : longint); +begin + if IsConsole then begin + write(stderr,'HandleErrorAddrFrame(error=',error); + write(stderr,',addr=',hexstr(addr,8)); + writeln(stderr,',frame=',hexstr(frame,8),')'); + end; + HandleErrorAddrFrame(error,addr,frame); +end; {$endif SYSTEMEXCEPTIONDEBUG} - procedure JumpToHandleErrorFrame; - var - eip,ebp,error : longint; - begin - asm - movl (%ebp),%eax - movl %eax,ebp - end; - if except_level>0 then - dec(except_level); - eip:=except_eip[except_level]; - error:=except_error[except_level]; +procedure JumpToHandleErrorFrame; +var + eip, ebp, error : Longint; +begin + // save ebp + asm + movl (%ebp),%eax + movl %eax,ebp + end; + if (exceptLevel > 0) then + dec(exceptLevel); + + eip:=exceptEip[exceptLevel]; + error:=exceptError[exceptLevel]; {$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then - begin - writeln(stderr,'In JumpToHandleErrorFrame error=',error); - end; + if IsConsole then + writeln(stderr,'In JumpToHandleErrorFrame error=',error); + end; {$endif SYSTEMEXCEPTIONDEBUG} - if reset_fpu[except_level] then - asm - fninit - fldcw fpucw - end; - { build a fake stack } - asm - movl ebp,%eax - pushl %eax - movl eip,%eax - pushl %eax - movl error,%eax - pushl %eax - movl eip,%eax - pushl %eax - movl ebp,%ebp // Change frame pointer + if resetFPU[exceptLevel] then asm + fninit + fldcw fpucw + end; + { build a fake stack } + asm + movl ebp,%eax + pushl %eax + movl eip,%eax + pushl %eax + movl error,%eax + pushl %eax + movl eip,%eax + pushl %eax + movl ebp,%ebp // Change frame pointer + {$ifdef SYSTEMEXCEPTIONDEBUG} - jmpl DebugHandleErrorAddrFrame + jmpl DebugHandleErrorAddrFrame {$else not SYSTEMEXCEPTIONDEBUG} - jmpl HandleErrorAddrFrame + jmpl HandleErrorAddrFrame {$endif SYSTEMEXCEPTIONDEBUG} - end; + end; +end; - end; +function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint; +var + frame, + res : longint; - function syswin32_i386_exception_handler(excep :PEXCEPTION_POINTERS) : longint; - var frame,res : longint; - function SysHandleErrorFrame(error,frame : longint;must_reset_fpu : boolean) : longint; - begin - if frame=0 then - SysHandleErrorFrame:=Exception_Continue_Search - else - begin - if except_level >= Max_level then - exit; - except_eip[except_level]:=excep^.ContextRecord^.Eip; - except_error[except_level]:=error; - reset_fpu[except_level]:=must_reset_fpu; - inc(except_level); - excep^.ContextRecord^.Eip:=longint(@JumpToHandleErrorFrame); - excep^.ExceptionRecord^.ExceptionCode:=0; - SysHandleErrorFrame:=Exception_Continue_Execution; +function SysHandleErrorFrame(error, frame : Longint; must_reset_fpu : Boolean) : Longint; +begin + if (frame = 0) then + SysHandleErrorFrame:=EXCEPTION_CONTINUE_SEARCH + else begin + if (exceptLevel >= MaxExceptionLevel) then exit; + + exceptEip[exceptLevel] := excep^.ContextRecord^.Eip; + exceptError[exceptLevel] := error; + resetFPU[exceptLevel] := must_reset_fpu; + inc(exceptLevel); + + excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame); + excep^.ExceptionRecord^.ExceptionCode := 0; + + SysHandleErrorFrame := EXCEPTION_CONTINUE_EXECUTION; {$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then - begin - writeln(stderr,'Exception Continue Exception set at ', - hexstr(except_eip[except_level],8)); - writeln(stderr,'Eip changed to ', - hexstr(longint(@JumpToHandleErrorFrame),8), ' error=',error); - end; + if IsConsole then begin + writeln(stderr,'Exception Continue Exception set at ', + hexstr(exceptEip[exceptLevel],8)); + writeln(stderr,'Eip changed to ', + hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error); + end; {$endif SYSTEMEXCEPTIONDEBUG} - end; - end; + end; +end; - begin - if excep^.ContextRecord^.SegSs=_SS then - frame:=excep^.ContextRecord^.Ebp - else - frame:=0; - { default : unhandled !} - res:=Exception_Continue_Search; +begin + if excep^.ContextRecord^.SegSs=_SS then + frame := excep^.ContextRecord^.Ebp + else + frame := 0; + res := EXCEPTION_CONTINUE_SEARCH; {$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then - writeln(stderr,'Exception ', - hexstr(excep^.ExceptionRecord^.ExceptionCode,8)); + if IsConsole then Writeln(stderr,'Exception ', + hexstr(excep^.ExceptionRecord^.ExceptionCode, 8)); {$endif SYSTEMEXCEPTIONDEBUG} - case excep^.ExceptionRecord^.ExceptionCode of - EXCEPTION_ACCESS_VIOLATION : - res:=SysHandleErrorFrame(216,frame,false); - { EXCEPTION_BREAKPOINT = $80000003; - EXCEPTION_DATATYPE_MISALIGNMENT = $80000002; - EXCEPTION_SINGLE_STEP = $80000004; } - EXCEPTION_ARRAY_BOUNDS_EXCEEDED : - res:=SysHandleErrorFrame(201,frame,false); - EXCEPTION_FLT_DENORMAL_OPERAND : - begin - res:=SysHandleErrorFrame(216,frame,true); - end; - EXCEPTION_FLT_DIVIDE_BY_ZERO : - begin - res:=SysHandleErrorFrame(200,frame,true); - {excep^.ContextRecord^.FloatSave.StatusWord:=excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;} - end; - {EXCEPTION_FLT_INEXACT_RESULT = $c000008f; } - EXCEPTION_FLT_INVALID_OPERATION : - begin - res:=SysHandleErrorFrame(207,frame,true); - end; - EXCEPTION_FLT_OVERFLOW : - begin - res:=SysHandleErrorFrame(205,frame,true); - end; - EXCEPTION_FLT_STACK_CHECK : - begin - res:=SysHandleErrorFrame(207,frame,true); - end; - EXCEPTION_FLT_UNDERFLOW : - begin - res:=SysHandleErrorFrame(206,frame,true); { should be accepted as zero !! } - end; - EXCEPTION_INT_DIVIDE_BY_ZERO : - res:=SysHandleErrorFrame(200,frame,false); - EXCEPTION_INT_OVERFLOW : - res:=SysHandleErrorFrame(215,frame,false); - {EXCEPTION_INVALID_HANDLE = $c0000008; - EXCEPTION_PRIV_INSTRUCTION = $c0000096; - EXCEPTION_NONCONTINUABLE_EXCEPTION = $c0000025; - EXCEPTION_NONCONTINUABLE = $1;} - EXCEPTION_STACK_OVERFLOW : - res:=SysHandleErrorFrame(202,frame,false); - {EXCEPTION_INVALID_DISPOSITION = $c0000026;} - EXCEPTION_ILLEGAL_INSTRUCTION, - EXCEPTION_PRIV_INSTRUCTION, - EXCEPTION_IN_PAGE_ERROR, - EXCEPTION_SINGLE_STEP : res:=SysHandleErrorFrame(217,frame,false); - end; - syswin32_i386_exception_handler:=res; - end; + case excep^.ExceptionRecord^.ExceptionCode of + STATUS_INTEGER_DIVIDE_BY_ZERO, + STATUS_FLOAT_DIVIDE_BY_ZERO : + res := SysHandleErrorFrame(200, frame, true); + STATUS_ARRAY_BOUNDS_EXCEEDED : + res := SysHandleErrorFrame(201, frame, false); + STATUS_STACK_OVERFLOW : + res := SysHandleErrorFrame(202, frame, false); + STATUS_FLOAT_OVERFLOW : + res := SysHandleErrorFrame(205, frame, true); + STATUS_FLOAT_UNDERFLOW : + res := SysHandleErrorFrame(206, frame, true); +{excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;} + STATUS_FLOAT_INVALID_OPERATION, + STATUS_FLOAT_STACK_CHECK : + res := SysHandleErrorFrame(207, frame, true); + STATUS_INTEGER_OVERFLOW : + res := SysHandleErrorFrame(215, frame, false); + STATUS_ACCESS_VIOLATION, + STATUS_FLOAT_DENORMAL_OPERAND : + res := SysHandleErrorFrame(216, frame, true); + else begin + if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then + res := SysHandleErrorFrame(217, frame, true); + end; + end; + syswin32_i386_exception_handler := res; +end; - procedure install_exception_handlers; +procedure install_exception_handlers; {$ifdef SYSTEMEXCEPTIONDEBUG} - var - oldexceptaddr,newexceptaddr : longint; +var + oldexceptaddr, + newexceptaddr : Longint; {$endif SYSTEMEXCEPTIONDEBUG} - begin -{$ifdef SYSTEMEXCEPTIONDEBUG} - asm - movl $0,%eax - movl %fs:(%eax),%eax - movl %eax,oldexceptaddr - end; -{$endif SYSTEMEXCEPTIONDEBUG} - SetUnhandledExceptionFilter(@syswin32_i386_exception_handler); -{$ifdef SYSTEMEXCEPTIONDEBUG} - asm - movl $0,%eax - movl %fs:(%eax),%eax - movl %eax,newexceptaddr - end; - if IsConsole then - writeln(stderr,'Old exception ',hexstr(oldexceptaddr,8), - ' new exception ',hexstr(newexceptaddr,8)); -{$endif SYSTEMEXCEPTIONDEBUG} - end; - procedure remove_exception_handlers; - begin - SetUnhandledExceptionFilter(nil); - end; +begin +{$ifdef SYSTEMEXCEPTIONDEBUG} + asm + movl $0,%eax + movl %fs:(%eax),%eax + movl %eax,oldexceptaddr + end; +{$endif SYSTEMEXCEPTIONDEBUG} + SetUnhandledExceptionFilter(@syswin32_i386_exception_handler); +{$ifdef SYSTEMEXCEPTIONDEBUG} + asm + movl $0,%eax + movl %fs:(%eax),%eax + movl %eax,newexceptaddr + end; + if IsConsole then + writeln(stderr,'Old exception ',hexstr(oldexceptaddr,8), + ' new exception ',hexstr(newexceptaddr,8)); +{$endif SYSTEMEXCEPTIONDEBUG} +end; + +procedure remove_exception_handlers; +begin + SetUnhandledExceptionFilter(nil); +end; {$else not i386 (Processor specific !!)} - procedure install_exception_handlers; - begin - end; +procedure install_exception_handlers; +begin +end; - procedure remove_exception_handlers; - begin - end; +procedure remove_exception_handlers; +begin +end; {$endif Set_i386_Exception_handler} @@ -1322,7 +1380,10 @@ end. { $Log$ - Revision 1.3 2000-09-04 19:36:59 peter + Revision 1.4 2000-09-11 20:19:28 florian + * complete exception handling provided by Thomas Schatzl + + Revision 1.3 2000/09/04 19:36:59 peter * new heapalloc calls, patch from Thomas Schatzl Revision 1.2 2000/07/13 11:33:58 michael