paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-17 17:38:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Moved existing exception-related definitions into separate include file seh64.inc, and added some more WinAPI definitions needed for SEH.

Browse Source 
git-svn-id: trunk@19869 -
This commit is contained in:
sergei 2011-12-18 01:15:31 +00:00
parent ebb2205c63
commit cd347e40b2
3 changed files with 215 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8218,6 +8218,7 @@ rtl/win64/Makefile svneol=native#text/plain
rtl/win64/Makefile.fpc svneol=native#text/plain rtl/win64/Makefile.fpc svneol=native#text/plain
rtl/win64/buildrtl.pp svneol=native#text/plain rtl/win64/buildrtl.pp svneol=native#text/plain
rtl/win64/classes.pp svneol=native#text/plain rtl/win64/classes.pp svneol=native#text/plain
rtl/win64/seh64.inc svneol=native#text/plain
rtl/win64/signals.pp svneol=native#text/plain rtl/win64/signals.pp svneol=native#text/plain
rtl/win64/system.pp svneol=native#text/plain rtl/win64/system.pp svneol=native#text/plain
rtl/win64/windows.pp svneol=native#text/plain rtl/win64/windows.pp svneol=native#text/plain

213
rtl/win64/seh64.inc Normal file
View File

@ -0,0 +1,213 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2011 by Free Pascal development team
Support for 64-bit Windows exception handling
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ exception flags }
const
EXCEPTION_NONCONTINUABLE = $01;
EXCEPTION_UNWINDING = $02;
EXCEPTION_EXIT_UNWIND = $04;
EXCEPTION_STACK_INVALID = $08;
EXCEPTION_NESTED_CALL = $10;
EXCEPTION_TARGET_UNWIND = $20;
EXCEPTION_COLLIDED_UNWIND = $40;
EXCEPTION_UNWIND = $66;
UNWIND_HISTORY_TABLE_SIZE = 12;
UNW_FLAG_NHANDLER = 0;
type
PM128A=^M128A;
M128A = record
Low : QWord;
High : Int64;
end;
PContext = ^TContext;
TContext = record
P1Home : QWord;
P2Home : QWord;
P3Home : QWord;
P4Home : QWord;
P5Home : QWord;
P6Home : QWord;
ContextFlags : DWord;
MxCsr : DWord;
SegCs : word;
SegDs : word;
SegEs : word;
SegFs : word;
SegGs : word;
SegSs : word;
EFlags : DWord;
Dr0 : QWord;
Dr1 : QWord;
Dr2 : QWord;
Dr3 : QWord;
Dr6 : QWord;
Dr7 : QWord;
Rax : QWord;
Rcx : QWord;
Rdx : QWord;
Rbx : QWord;
Rsp : QWord;
Rbp : QWord;
Rsi : QWord;
Rdi : QWord;
R8 : QWord;
R9 : QWord;
R10 : QWord;
R11 : QWord;
R12 : QWord;
R13 : QWord;
R14 : QWord;
R15 : QWord;
Rip : QWord;
Header : array[0..1] of M128A;
Legacy : array[0..7] of M128A;
Xmm0 : M128A;
Xmm1 : M128A;
Xmm2 : M128A;
Xmm3 : M128A;
Xmm4 : M128A;
Xmm5 : M128A;
Xmm6 : M128A;
Xmm7 : M128A;
Xmm8 : M128A;
Xmm9 : M128A;
Xmm10 : M128A;
Xmm11 : M128A;
Xmm12 : M128A;
Xmm13 : M128A;
Xmm14 : M128A;
Xmm15 : M128A;
VectorRegister : array[0..25] of M128A;
VectorControl : QWord;
DebugControl : QWord;
LastBranchToRip : QWord;
LastBranchFromRip : QWord;
LastExceptionToRip : QWord;
LastExceptionFromRip : QWord;
end;
{ This is a simplified definition, only array part of unions }
PKNONVOLATILE_CONTEXT_POINTERS=^KNONVOLATILE_CONTEXT_POINTERS;
KNONVOLATILE_CONTEXT_POINTERS=record
FloatingContext: array[0..15] of PM128A;
IntegerContext: array[0..15] of PQWord;
end;
EXCEPTION_DISPOSITION=(
ExceptionContinueExecution,
ExceptionContinueSearch,
ExceptionNestedException,
ExceptionCollidedUnwind
);
PExceptionPointers = ^TExceptionPointers;
TExceptionPointers = record
ExceptionRecord : PExceptionRecord;
ContextRecord : PContext;
end;
EXCEPTION_ROUTINE = function(
var ExceptionRecord: TExceptionRecord;
EstablisherFrame: Pointer;
var ContextRecord: TContext;
DispatcherContext: Pointer ): EXCEPTION_DISPOSITION;
PRUNTIME_FUNCTION=^RUNTIME_FUNCTION;
RUNTIME_FUNCTION=record
BeginAddress: DWORD;
EndAddress: DWORD;
UnwindData: DWORD;
end;
UNWIND_HISTORY_TABLE_ENTRY=record
ImageBase: QWord;
FunctionEntry: PRUNTIME_FUNCTION;
end;
PUNWIND_HISTORY_TABLE=^UNWIND_HISTORY_TABLE;
UNWIND_HISTORY_TABLE=record
Count: DWORD;
Search: Byte;
RaiseStatusIndex: Byte;
Unwind: Byte;
Exception: Byte;
LowAddress: QWord;
HighAddress: QWord;
Entry: array[0..UNWIND_HISTORY_TABLE_SIZE-1] of UNWIND_HISTORY_TABLE_ENTRY;
end;
PDispatcherContext = ^TDispatcherContext;
TDispatcherContext = record
ControlPc: QWord;
ImageBase: QWord;
FunctionEntry: PRUNTIME_FUNCTION;
EstablisherFrame: QWord;
TargetIp: QWord;
ContextRecord: PContext;
LanguageHandler: EXCEPTION_ROUTINE;
HandlerData: Pointer;
HistoryTable: PUNWIND_HISTORY_TABLE;
ScopeIndex: DWord;
Fill0: DWord;
end;
procedure RtlCaptureContext(var ctx: TContext); stdcall;
external 'kernel32.dll' name 'RtlCaptureContext';
function RtlCaptureStackBackTrace(
FramesToSkip: DWORD;
FramesToCapture: DWORD;
var BackTrace: Pointer;
BackTraceHash: PDWORD): Word; stdcall;
external 'kernel32.dll' name 'RtlCaptureStackBackTrace';
function RtlLookupFunctionEntry(
ControlPC: QWord;
out ImageBase: QWord;
HistoryTable: PUNWIND_HISTORY_TABLE): PRUNTIME_FUNCTION;
external 'kernel32.dll' name 'RtlLookupFunctionEntry';
function RtlVirtualUnwind(
HandlerType: DWORD;
ImageBase: QWord;
ControlPc: QWord;
FunctionEntry: PRUNTIME_FUNCTION;
var ContextRecord: TContext;
HandlerData: PPointer;
EstablisherFrame: PQWord;
ContextPointers: PKNONVOLATILE_CONTEXT_POINTERS): EXCEPTION_ROUTINE;
external 'kernel32.dll' name 'RtlVirtualUnwind';
procedure RtlUnwindEx(
TargetFrame: Pointer;
TargetIp: Pointer;
ExceptionRecord: PExceptionRecord;
ReturnValue: Pointer;
OriginalContext: PContext; { scratch space, initial contents ignored }
HistoryTable: PUNWIND_HISTORY_TABLE);
external 'kernel32.dll' name 'RtlUnwindEx';
procedure RaiseException(
dwExceptionCode: DWORD;
dwExceptionFlags: DWORD;
dwArgCount: DWORD;
lpArguments: Pointer); // msdn: *ULONG_PTR
external 'kernel32.dll' name 'RaiseException';

80
rtl/win64/system.pp
View File

@ -262,88 +262,10 @@ function is_prefetch(p : pointer) : boolean;
// //
// Hardware exception handling // Hardware exception handling
// //
{$I seh64.inc}
type type
M128A = record
Low : QWord;
High : Int64;
end;
PContext = ^TContext;
TContext = record
P1Home : QWord;
P2Home : QWord;
P3Home : QWord;
P4Home : QWord;
P5Home : QWord;
P6Home : QWord;
ContextFlags : DWord;
MxCsr : DWord;
SegCs : word;
SegDs : word;
SegEs : word;
SegFs : word;
SegGs : word;
SegSs : word;
EFlags : DWord;
Dr0 : QWord;
Dr1 : QWord;
Dr2 : QWord;
Dr3 : QWord;
Dr6 : QWord;
Dr7 : QWord;
Rax : QWord;
Rcx : QWord;
Rdx : QWord;
Rbx : QWord;
Rsp : QWord;
Rbp : QWord;
Rsi : QWord;
Rdi : QWord;
R8 : QWord;
R9 : QWord;
R10 : QWord;
R11 : QWord;
R12 : QWord;
R13 : QWord;
R14 : QWord;
R15 : QWord;
Rip : QWord;
Header : array[0..1] of M128A;
Legacy : array[0..7] of M128A;
Xmm0 : M128A;
Xmm1 : M128A;
Xmm2 : M128A;
Xmm3 : M128A;
Xmm4 : M128A;
Xmm5 : M128A;
Xmm6 : M128A;
Xmm7 : M128A;
Xmm8 : M128A;
Xmm9 : M128A;
Xmm10 : M128A;
Xmm11 : M128A;
Xmm12 : M128A;
Xmm13 : M128A;
Xmm14 : M128A;
Xmm15 : M128A;
VectorRegister : array[0..25] of M128A;
VectorControl : QWord;
DebugControl : QWord;
LastBranchToRip : QWord;
LastBranchFromRip : QWord;
LastExceptionToRip : QWord;
LastExceptionFromRip : QWord;
end;
type
PExceptionPointers = ^TExceptionPointers;
TExceptionPointers = packed record
ExceptionRecord : PExceptionRecord;
ContextRecord : PContext;
end;
TVectoredExceptionHandler = function (excep : PExceptionPointers) : Longint; TVectoredExceptionHandler = function (excep : PExceptionPointers) : Longint;
function AddVectoredExceptionHandler(FirstHandler : DWORD;VectoredHandler : TVectoredExceptionHandler) : longint; function AddVectoredExceptionHandler(FirstHandler : DWORD;VectoredHandler : TVectoredExceptionHandler) : longint;