diff --git a/rtl/win/sysutils.pp b/rtl/win/sysutils.pp
index 57ada70a62..eff9815fa3 100644
--- a/rtl/win/sysutils.pp
+++ b/rtl/win/sysutils.pp
@@ -1393,11 +1393,10 @@ end;
Initialization
InitWin32Widestrings;
InitExceptions; { Initialize exceptions. OS independent }
-{$ifdef win64} { Nothing win64-specific here, just keeping exe size down
- as these procedures aren't used in generic exception handling }
+{$ifdef mswindows} { Keeps exe size down for systems that do not use SEH }
ExceptObjProc:=@WinExceptionObject;
ExceptClsProc:=@WinExceptionClass;
-{$endif win64}
+{$endif mswindows}
InitInternational; { Initialize internationalization settings }
LoadVersionInfo;
InitSysConfigDir;
diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc
index a09da621cd..396d11dd88 100644
--- a/rtl/win/syswin.inc
+++ b/rtl/win/syswin.inc
@@ -120,6 +120,16 @@ type
TUnwindProc=procedure(frame: PtrUInt);
+ PFilterRec=^TFilterRec;
+ TFilterRec=record
+ RvaClass: DWord;
+ RvaHandler: DWord;
+ end;
+
+ TExceptObjProc=function(code: Longint; const rec: TExceptionRecord): Pointer; { Exception }
+ TExceptClsProc=function(code: Longint): Pointer; { ExceptClass }
+
+
procedure RaiseException(
dwExceptionCode: DWORD;
dwExceptionFlags: DWORD;
@@ -128,6 +138,59 @@ procedure RaiseException(
stdcall; external 'kernel32.dll' name 'RaiseException';
+function RunErrorCode(const rec: TExceptionRecord): longint;
+begin
+ { negative result means 'FPU reset required' }
+ case rec.ExceptionCode of
+ STATUS_INTEGER_DIVIDE_BY_ZERO: result := 200; { reDivByZero }
+ STATUS_FLOAT_DIVIDE_BY_ZERO: result := -208; { !!reZeroDivide }
+ STATUS_ARRAY_BOUNDS_EXCEEDED: result := 201; { reRangeError }
+ STATUS_STACK_OVERFLOW: result := 202; { reStackOverflow }
+ STATUS_FLOAT_OVERFLOW: result := -205; { reOverflow }
+ STATUS_FLOAT_DENORMAL_OPERAND,
+ STATUS_FLOAT_UNDERFLOW: result := -206; { reUnderflow }
+ STATUS_FLOAT_INEXACT_RESULT,
+ STATUS_FLOAT_INVALID_OPERATION,
+ STATUS_FLOAT_STACK_CHECK: result := -207; { reInvalidOp }
+ STATUS_INTEGER_OVERFLOW: result := 215; { reIntOverflow }
+ STATUS_ILLEGAL_INSTRUCTION: result := -216;
+ STATUS_ACCESS_VIOLATION: result := 216; { reAccessViolation }
+ STATUS_CONTROL_C_EXIT: result := 217; { reControlBreak }
+ STATUS_PRIVILEGED_INSTRUCTION: result := 218; { rePrivilegedInstruction }
+ else
+ result := 255; { reExternalException }
+ end;
+end;
+
+
+function FilterException(var rec:TExceptionRecord; imagebase: PtrUInt; filterRva: DWord): Pointer;
+var
+ ExClass: TClass;
+ i: Longint;
+ Filter: Pointer;
+ curFilt: PFilterRec;
+begin
+ result:=nil;
+ if rec.ExceptionCode=FPC_EXCEPTION_CODE then
+ ExClass:=TObject(rec.ExceptionInformation[1]).ClassType
+ else if Assigned(ExceptClsProc) then
+ ExClass:=TClass(TExceptClsProc(ExceptClsProc)(abs(RunErrorCode(rec))))
+ else
+ Exit; { if we cannot determine type of exception, don't handle it }
+ Filter:=Pointer(imagebase+filterRva);
+ for i:=0 to PLongint(Filter)^-1 do
+ begin
+ CurFilt:=@PFilterRec(Filter+sizeof(Longint))[i];
+ if (CurFilt^.RvaClass=$FFFFFFFF) or
+ { TODO: exception might be coming from another module, need more advanced comparing }
+ (ExClass.InheritsFrom(TClass(imagebase+CurFilt^.RvaClass))) then
+ begin
+ result:=Pointer(imagebase+CurFilt^.RvaHandler);
+ exit;
+ end;
+ end;
+end;
+
{*****************************************************************************
Parameter Handling
*****************************************************************************}
diff --git a/rtl/win64/seh64.inc b/rtl/win64/seh64.inc
index 33e0d55969..4c569f54e9 100644
--- a/rtl/win64/seh64.inc
+++ b/rtl/win64/seh64.inc
@@ -212,15 +212,6 @@ type
RvaHandler: DWord;
end;
- PFilterRec=^TFilterRec;
- TFilterRec=record
- RvaClass: DWord;
- RvaHandler: DWord;
- end;
-
-
- TExceptObjProc=function(code: Longint; const rec: TExceptionRecord): Pointer; { Exception }
- TExceptClsProc=function(code: Longint): Pointer; { ExceptClass }
{ note: context must be passed by value, so modifications are made to a local copy }
function GetBacktrace(Context: TContext; StartingFrame: Pointer; out Frames: PPointer): Longint;
@@ -336,58 +327,6 @@ begin
RaiseException(FPC_EXCEPTION_CODE,EXCEPTION_NONCONTINUABLE,4,@args[0]);
end;
-function RunErrorCode(const rec: TExceptionRecord): longint;
-begin
- { negative result means 'FPU reset required' }
- case rec.ExceptionCode of
- STATUS_INTEGER_DIVIDE_BY_ZERO: result := 200; { reDivByZero }
- STATUS_FLOAT_DIVIDE_BY_ZERO: result := -208; { !!reZeroDivide }
- STATUS_ARRAY_BOUNDS_EXCEEDED: result := 201; { reRangeError }
- STATUS_STACK_OVERFLOW: result := 202; { reStackOverflow }
- STATUS_FLOAT_OVERFLOW: result := -205; { reOverflow }
- STATUS_FLOAT_DENORMAL_OPERAND,
- STATUS_FLOAT_UNDERFLOW: result := -206; { reUnderflow }
- STATUS_FLOAT_INEXACT_RESULT,
- STATUS_FLOAT_INVALID_OPERATION,
- STATUS_FLOAT_STACK_CHECK: result := -207; { reInvalidOp }
- STATUS_INTEGER_OVERFLOW: result := 215; { reIntOverflow }
- STATUS_ILLEGAL_INSTRUCTION: result := -216;
- STATUS_ACCESS_VIOLATION: result := 216; { reAccessViolation }
- STATUS_CONTROL_C_EXIT: result := 217; { reControlBreak }
- STATUS_PRIVILEGED_INSTRUCTION: result := 218; { rePrivilegedInstruction }
- else
- result := 255; { reExternalException }
- end;
-end;
-
-
-function FilterException(var rec:TExceptionRecord; imagebase: QWord; scope: PScopeRec): Pointer;
-var
- ExClass: TClass;
- i: Longint;
- Filter: Pointer;
- curFilt: PFilterRec;
-begin
- result:=nil;
- if rec.ExceptionCode=FPC_EXCEPTION_CODE then
- ExClass:=TObject(rec.ExceptionInformation[1]).ClassType
- else if Assigned(ExceptClsProc) then
- ExClass:=TClass(TExceptClsProc(ExceptClsProc)(abs(RunErrorCode(rec))))
- else
- Exit; { if we cannot determine type of exception, don't handle it }
- Filter:=Pointer(imagebase+scope^.Typ);
- for i:=0 to PLongint(Filter)^-1 do
- begin
- CurFilt:=@PFilterRec(Filter+sizeof(Longint))[i];
- if (CurFilt^.RvaClass=$FFFFFFFF) or
- { TODO: exception might be coming from another module, need more advanced comparing }
- (ExClass.InheritsFrom(TClass(imagebase+CurFilt^.RvaClass))) then
- begin
- result:=Pointer(imagebase+CurFilt^.RvaHandler);
- exit;
- end;
- end;
-end;
{$ifdef DEBUG_SEH}
procedure PrintScope(idx: integer; scope: PScopeRec);
@@ -531,7 +470,7 @@ begin
if scope^.Typ>SCOPE_IMPLICIT then // filtering needed
begin
- TargetAddr:=FilterException(rec,dispatch.ImageBase,scope);
+ TargetAddr:=FilterException(rec,dispatch.ImageBase,scope^.Typ);
if TargetAddr=nil then
begin
Inc(ScopeIdx);