paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 22:50:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* updated all the RTL helper functions related to exceptions and stack traces to use codepointer instead of pointer

Browse Source 
git-svn-id: trunk@25513 -
This commit is contained in:
nickysn 2013-09-17 21:25:26 +00:00
parent b688b79a0d
commit c1b0fb81f1
9 changed files with 74 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
rtl/i8086/i8086.inc
View File

@ -53,26 +53,32 @@ asm
end; end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;nostackframe;assembler; function get_caller_addr(framebp:pointer;addr:codepointer=nil):codepointer;nostackframe;assembler;
asm asm
push bp push bp
mov bp, sp mov bp, sp
mov ax, ss:[bp + 6 + extra_param_offset] // framebp {$ifdef FPC_X86_CODE_FAR}
xor dx, dx
{$endif FPC_X86_CODE_FAR}
mov ax, ss:[bp + 6 + extra_param_offset + extra_param_offset] // framebp
or ax, ax or ax, ax
jz @@Lg_a_null jz @@Lg_a_null
xchg ax, bx xchg ax, bx
mov bx, [bx+2] mov bx, [bx+2]
{$ifdef FPC_X86_CODE_FAR}
mov dx, [bx+4]
{$endif FPC_X86_CODE_FAR}
xchg ax, bx xchg ax, bx
@@Lg_a_null: @@Lg_a_null:
pop bp pop bp
end; end;
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;nostackframe;assembler; function get_caller_frame(framebp:pointer;addr:codepointer=nil):pointer;nostackframe;assembler;
asm asm
push bp push bp
mov bp, sp mov bp, sp
mov ax, ss:[bp + 6 + extra_param_offset] // framebp mov ax, ss:[bp + 6 + extra_param_offset + extra_param_offset] // framebp
or ax, ax or ax, ax
jz @@Lgnf_null jz @@Lgnf_null
xchg ax, bx xchg ax, bx

4
rtl/inc/compproc.inc
View File

@ -592,14 +592,14 @@ procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc:
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS} {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ; compilerproc; Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject; compilerproc; Function fpc_Raiseexception (Obj : TObject; AnAddr : CodePointer; AFrame : Pointer) : TObject; compilerproc;
Procedure fpc_PopAddrStack; compilerproc; Procedure fpc_PopAddrStack; compilerproc;
function fpc_PopObjectStack : TObject; compilerproc; function fpc_PopObjectStack : TObject; compilerproc;
function fpc_PopSecondObjectStack : TObject; compilerproc; function fpc_PopSecondObjectStack : TObject; compilerproc;
Procedure fpc_ReRaise; compilerproc; Procedure fpc_ReRaise; compilerproc;
Function fpc_Catches(Objtype : TClass) : TObject; compilerproc; Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
Procedure fpc_DestroyException(o : TObject); compilerproc; Procedure fpc_DestroyException(o : TObject); compilerproc;
function fpc_GetExceptionAddr : Pointer; compilerproc; function fpc_GetExceptionAddr : CodePointer; compilerproc;
function fpc_safecallhandler(obj: TObject): HResult; compilerproc; function fpc_safecallhandler(obj: TObject): HResult; compilerproc;
function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif} function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
procedure fpc_doneexception; compilerproc; procedure fpc_doneexception; compilerproc;

16
rtl/inc/except.inc
View File

@ -112,18 +112,18 @@ end;
{$define FPC_CHECK_GET_CALLER_EXCEPTIONS} {$define FPC_CHECK_GET_CALLER_EXCEPTIONS}
{$endif} {$endif}
Procedure PushExceptObject(Obj : TObject; AnAddr,AFrame : Pointer); Procedure PushExceptObject(Obj : TObject; AnAddr : CodePointer; AFrame : Pointer);
var var
Newobj : PExceptObject; Newobj : PExceptObject;
_ExceptObjectStack : ^PExceptObject; _ExceptObjectStack : ^PExceptObject;
framebufsize, framebufsize,
framecount : longint; framecount : longint;
frames : PPointer; frames : PCodePointer;
prev_frame, prev_frame,
curr_frame, curr_frame,
caller_frame : Pointer;
curr_addr, curr_addr,
caller_frame, caller_addr : CodePointer;
caller_addr : Pointer;
begin begin
{$ifdef excdebug} {$ifdef excdebug}
writeln ('In PushExceptObject'); writeln ('In PushExceptObject');
@ -179,7 +179,7 @@ begin
if (framecount>=framebufsize) then if (framecount>=framebufsize) then
begin begin
inc(framebufsize,16); inc(framebufsize,16);
reallocmem(frames,framebufsize*sizeof(pointer)); reallocmem(frames,framebufsize*sizeof(codepointer));
end; end;
frames[framecount]:=caller_addr; frames[framecount]:=caller_addr;
inc(framecount); inc(framecount);
@ -211,7 +211,7 @@ begin
end; end;
{$ifndef FPC_SYSTEM_HAS_RAISEEXCEPTION} {$ifndef FPC_SYSTEM_HAS_RAISEEXCEPTION}
Function fpc_RaiseException (Obj : TObject; AnAddr,AFrame : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION']; compilerproc; Function fpc_RaiseException (Obj : TObject; AnAddr : CodePointer; AFrame : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION']; compilerproc;
var var
_ExceptObjectStack : PExceptObject; _ExceptObjectStack : PExceptObject;
_ExceptAddrstack : PExceptAddr; _ExceptAddrstack : PExceptAddr;
@ -376,7 +376,7 @@ begin
end; end;
{ TODO: no longer used, clean up } { TODO: no longer used, clean up }
function fpc_GetExceptionAddr : Pointer;[Public, Alias : 'FPC_GETEXCEPTIONADDR']; compilerproc; function fpc_GetExceptionAddr : CodePointer;[Public, Alias : 'FPC_GETEXCEPTIONADDR']; compilerproc;
var var
_ExceptObjectStack : PExceptObject; _ExceptObjectStack : PExceptObject;
begin begin
@ -411,7 +411,7 @@ end;
function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc; function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc;
var var
raiselist: PExceptObject; raiselist: PExceptObject;
adr: Pointer; adr: CodePointer;
exc: TObject; exc: TObject;
begin begin
raiselist:=ExceptObjectStack; raiselist:=ExceptObjectStack;

24
rtl/inc/heaptrc.pp
View File

@ -132,7 +132,7 @@ type
release_sig : longword; release_sig : longword;
prev_valid : pheap_mem_info; prev_valid : pheap_mem_info;
{$endif EXTRA} {$endif EXTRA}
calls : array [1..tracesize] of pointer; calls : array [1..tracesize] of codepointer;
exact_info_size : word; exact_info_size : word;
extra_info_size : word; extra_info_size : word;
extra_info : pheap_extra_info; extra_info : pheap_extra_info;
@ -336,7 +336,8 @@ end;
procedure dump_already_free(p : pheap_mem_info;var ptext : text); procedure dump_already_free(p : pheap_mem_info;var ptext : text);
var var
bp, pcaddr : pointer; bp : pointer;
pcaddr : codepointer;
begin begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' released'); Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' released');
call_free_stack(p,ptext); call_free_stack(p,ptext);
@ -349,7 +350,8 @@ end;
procedure dump_error(p : pheap_mem_info;var ptext : text); procedure dump_error(p : pheap_mem_info;var ptext : text);
var var
bp, pcaddr : pointer; bp : pointer;
pcaddr : codepointer;
begin begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid'); Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8)); Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8));
@ -382,7 +384,8 @@ end;
procedure dump_wrong_size(p : pheap_mem_info;size : ptruint;var ptext : text); procedure dump_wrong_size(p : pheap_mem_info;size : ptruint;var ptext : text);
var var
bp, pcaddr : pointer; bp : pointer;
pcaddr : codepointer;
begin begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid'); Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed'); Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed');
@ -464,7 +467,8 @@ Function TraceGetMem(size:ptruint):pointer;
var var
allocsize,i : ptruint; allocsize,i : ptruint;
oldbp, oldbp,
bp,pcaddr : pointer; bp : pointer;
pcaddr : codepointer;
pl : pdword; pl : pdword;
p : pointer; p : pointer;
pp : pheap_mem_info; pp : pheap_mem_info;
@ -573,7 +577,8 @@ function CheckFreeMemSize(loc_info: pheap_info; pp: pheap_mem_info;
size, ppsize: ptruint): boolean; inline; size, ppsize: ptruint): boolean; inline;
var var
i: ptruint; i: ptruint;
bp,pcaddr : pointer; bp : pointer;
pcaddr : codepointer;
ptext : ^text; ptext : ^text;
{$ifdef EXTRA} {$ifdef EXTRA}
pp2 : pheap_mem_info; pp2 : pheap_mem_info;
@ -798,8 +803,8 @@ var
movesize, movesize,
i : ptruint; i : ptruint;
oldbp, oldbp,
bp, bp : pointer;
pcaddr : pointer; pcaddr : codepointer;
pl : pdword; pl : pdword;
pp : pheap_mem_info; pp : pheap_mem_info;
oldsize, oldsize,
@ -1005,7 +1010,8 @@ var
{$ifdef morphos} {$ifdef morphos}
stack_top: longword; stack_top: longword;
{$endif morphos} {$endif morphos}
bp,pcaddr : pointer; bp : pointer;
pcaddr : codepointer;
ptext : ^text; ptext : ^text;
label label
_exit; _exit;

2
rtl/inc/lineinfo.pp
View File

@ -258,7 +258,7 @@ begin
end; end;
function StabBackTraceStr(addr:Pointer):shortstring; function StabBackTraceStr(addr:CodePointer):shortstring;
var var
func, func,
source : string; source : string;

2
rtl/inc/objpas.inc
View File

@ -501,7 +501,7 @@
end; end;
function TObject.SafeCallException(exceptobject : tobject; function TObject.SafeCallException(exceptobject : tobject;
exceptaddr : pointer) : HResult; exceptaddr : codepointer) : HResult;
begin begin
safecallexception:=E_UNEXPECTED; safecallexception:=E_UNEXPECTED;

8
rtl/inc/objpash.inc
View File

@ -196,7 +196,7 @@
class function newinstance : tobject;virtual; class function newinstance : tobject;virtual;
procedure FreeInstance;virtual; procedure FreeInstance;virtual;
function SafeCallException(exceptobject : tobject; function SafeCallException(exceptobject : tobject;
exceptaddr : pointer) : HResult;virtual; exceptaddr : codepointer) : HResult;virtual;
procedure DefaultHandler(var message);virtual; procedure DefaultHandler(var message);virtual;
procedure Free; procedure Free;
@ -322,17 +322,17 @@
PInterface = PUnknown; PInterface = PUnknown;
TExceptProc = Procedure (Obj : TObject; Addr : Pointer; FrameCount:Longint; Frame: PPointer); TExceptProc = Procedure (Obj : TObject; Addr : CodePointer; FrameCount:Longint; Frame: PCodePointer);
{ Exception object stack } { Exception object stack }
PExceptObject = ^TExceptObject; PExceptObject = ^TExceptObject;
TExceptObject = record TExceptObject = record
FObject : TObject; FObject : TObject;
Addr : pointer; Addr : codepointer;
Next : PExceptObject; Next : PExceptObject;
refcount : Longint; refcount : Longint;
Framecount : Longint; Framecount : Longint;
Frames : PPointer; Frames : PCodePointer;
end; end;
Const Const

38
rtl/inc/system.inc
View File

@ -69,8 +69,8 @@ Const
Procedure HandleError (Errno : Longint); external name 'FPC_HANDLEERROR'; Procedure HandleError (Errno : Longint); external name 'FPC_HANDLEERROR';
Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward; Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer); forward; Procedure HandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer); forward;
Procedure HandleErrorAddrFrameInd (Errno : longint;addr,frame : Pointer); forward; Procedure HandleErrorAddrFrameInd (Errno : longint;addr : CodePointer; frame : Pointer); forward;
{$ifdef FPC_HAS_FEATURE_TEXTIO} {$ifdef FPC_HAS_FEATURE_TEXTIO}
type type
@ -686,7 +686,7 @@ End;
{ This provides a dummy implementation { This provides a dummy implementation
of get_pc_addr function, for CPU's that don't need of get_pc_addr function, for CPU's that don't need
the instruction address to walk the stack. } the instruction address to walk the stack. }
function get_pc_addr : pointer; function get_pc_addr : codepointer;
begin begin
get_pc_addr:=nil; get_pc_addr:=nil;
end; end;
@ -697,9 +697,10 @@ end;
of get_caller_stackinfo procedure, of get_caller_stackinfo procedure,
using get_caller_addr and get_caller_frame using get_caller_addr and get_caller_frame
functions. } functions. }
procedure get_caller_stackinfo(var framebp,addr : pointer); procedure get_caller_stackinfo(var framebp : pointer; addr : codepointer);
var var
nextbp,nextaddr : pointer; nextbp : pointer;
nextaddr : codepointer;
begin begin
nextbp:=get_caller_frame(framebp,addr); nextbp:=get_caller_frame(framebp,addr);
nextaddr:=get_caller_addr(framebp,addr); nextaddr:=get_caller_addr(framebp,addr);
@ -967,7 +968,11 @@ Begin
pstdout:=@stdout; pstdout:=@stdout;
If erroraddr<>nil Then If erroraddr<>nil Then
Begin Begin
{$if defined(CPUI8086) and defined(FPC_X86_CODE_FAR)}
Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(DWord(erroraddr) shr 16,4),':',hexstr(DWord(erroraddr) and $FFFF,4));
{$else}
Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(erroraddr)); Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(erroraddr));
{$endif}
{ to get a nice symify } { to get a nice symify }
Writeln(pstdout^,BackTraceStrFunc(Erroraddr)); Writeln(pstdout^,BackTraceStrFunc(Erroraddr));
dump_stack(pstdout^,ErrorBase,ErrorAddr); dump_stack(pstdout^,ErrorBase,ErrorAddr);
@ -1041,13 +1046,17 @@ Begin
end; end;
function SysBackTraceStr (Addr: Pointer): ShortString; function SysBackTraceStr (Addr: CodePointer): ShortString;
begin begin
{$if defined(CPUI8086) and defined(FPC_X86_CODE_FAR)}
SysBackTraceStr:=' $'+hexstr(DWord(addr) shr 16,4)+':'+hexstr(DWord(addr) and $FFFF,4);
{$else}
SysBackTraceStr:=' $'+hexstr(addr); SysBackTraceStr:=' $'+hexstr(addr);
{$endif}
end; end;
Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer);[public,alias:'FPC_BREAK_ERROR']; {$ifdef CPUI386} register; {$endif} Procedure HandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer);[public,alias:'FPC_BREAK_ERROR']; {$ifdef CPUI386} register; {$endif}
begin begin
If pointer(ErrorProc)<>Nil then If pointer(ErrorProc)<>Nil then
ErrorProc(Errno,addr,frame); ErrorProc(Errno,addr,frame);
@ -1064,7 +1073,7 @@ end;
{ This is used internally by system skip first level, { This is used internally by system skip first level,
and generated the same output as before, when and generated the same output as before, when
HandleErrorFrame function was used internally. } HandleErrorFrame function was used internally. }
Procedure HandleErrorAddrFrameInd (Errno : longint;addr,frame : Pointer); Procedure HandleErrorAddrFrameInd (Errno : longint;addr : CodePointer; frame : Pointer);
begin begin
get_caller_stackinfo (frame, addr); get_caller_stackinfo (frame, addr);
HandleErrorAddrFrame (Errno,addr,frame); HandleErrorAddrFrame (Errno,addr,frame);
@ -1093,7 +1102,8 @@ end;
procedure RunError(w : word);[alias: 'FPC_RUNERROR']; procedure RunError(w : word);[alias: 'FPC_RUNERROR'];
var var
bp,pcaddr : pointer; bp : pointer;
pcaddr : codepointer;
begin begin
errorcode:=w; errorcode:=w;
pcaddr:=get_pc_addr; pcaddr:=get_pc_addr;
@ -1123,14 +1133,14 @@ begin
end; end;
Procedure dump_stack(var f : text;fp,addr : Pointer); Procedure dump_stack(var f : text;fp : Pointer; addr : CodePointer);
var var
i : Longint; i : Longint;
prevfp : Pointer; prevfp : Pointer;
prevaddr : pointer; prevaddr : CodePointer;
is_dev : boolean; is_dev : boolean;
caller_frame, caller_frame : Pointer;
caller_addr : Pointer; caller_addr : CodePointer;
Begin Begin
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS} {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
try try
@ -1171,7 +1181,7 @@ procedure DumpExceptionBackTrace(var f:text);
var var
FrameNumber, FrameNumber,
FrameCount : longint; FrameCount : longint;
Frames : PPointer; Frames : PCodePointer;
begin begin
if RaiseList=nil then if RaiseList=nil then
exit; exit;

18
rtl/inc/systemh.inc
View File

@ -618,7 +618,7 @@ const
{ Exit Procedure handling consts and types } { Exit Procedure handling consts and types }
ExitProc : codepointer = nil; ExitProc : codepointer = nil;
Erroraddr: pointer = nil; Erroraddr: codepointer = nil;
Errorcode: Word = 0; Errorcode: Word = 0;
{ file input modes } { file input modes }
@ -1258,11 +1258,11 @@ function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;[INTERNPROC:
function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif} function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ENDIF} {$ENDIF}
Function Get_pc_addr : Pointer; Function Get_pc_addr : CodePointer;
function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer; function get_caller_addr(framebp:pointer;addr:codepointer=nil):codepointer;
function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer; function get_caller_frame(framebp:pointer;addr:codepointer=nil):pointer;
procedure get_caller_stackinfo(var framebp,addr : pointer); procedure get_caller_stackinfo(var framebp : pointer; addr : codepointer);
Function IOResult:Word; Function IOResult:Word;
Function Sptr:Pointer;[internconst:fpc_in_const_ptr]; Function Sptr:Pointer;[internconst:fpc_in_const_ptr];
@ -1344,7 +1344,7 @@ Function Paramcount:Longint;
Function ParamStr(l:Longint):string; Function ParamStr(l:Longint):string;
{$endif FPC_HAS_FEATURE_COMMANDARGS} {$endif FPC_HAS_FEATURE_COMMANDARGS}
Procedure Dump_Stack(var f : text;fp:pointer;addr : pointer = nil); Procedure Dump_Stack(var f : text;fp:pointer;addr : codepointer = nil);
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS} {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
procedure DumpExceptionBackTrace(var f:text); procedure DumpExceptionBackTrace(var f:text);
{$endif FPC_HAS_FEATURE_EXCEPTIONS} {$endif FPC_HAS_FEATURE_EXCEPTIONS}
@ -1387,7 +1387,7 @@ Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
procedure AbstractError;external name 'FPC_ABSTRACTERROR'; procedure AbstractError;external name 'FPC_ABSTRACTERROR';
procedure EmptyMethod;external name 'FPC_EMPTYMETHOD'; procedure EmptyMethod;external name 'FPC_EMPTYMETHOD';
Function SysBackTraceStr(Addr:Pointer): ShortString; Function SysBackTraceStr(Addr:CodePointer): ShortString;
Procedure SysAssert(const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer); Procedure SysAssert(const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer);
(* Supposed to return address of previous CtrlBreakHandler *) (* Supposed to return address of previous CtrlBreakHandler *)
(* (may be nil), returned value of pointer (-1) means that *) (* (may be nil), returned value of pointer (-1) means that *)
@ -1396,8 +1396,8 @@ function SysSetCtrlBreakHandler (Handler: TCtrlBreakHandler): TCtrlBreakHandler;
{ Error handlers } { Error handlers }
Type Type
TBackTraceStrFunc = Function (Addr: Pointer): ShortString; TBackTraceStrFunc = Function (Addr: CodePointer): ShortString;
TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer); TErrorProc = Procedure (ErrNo : Longint; Address : CodePointer; Frame : Pointer);
TAbstractErrorProc = Procedure; TAbstractErrorProc = Procedure;
TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer); TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer);
TSafeCallErrorProc = Procedure(error : HResult;addr : pointer); TSafeCallErrorProc = Procedure(error : HResult;addr : pointer);