From 9a23613b9d07032c08bdf6f959946a523f3509dd Mon Sep 17 00:00:00 2001 From: svenbarth Date: Sat, 29 Dec 2018 19:21:09 +0000 Subject: [PATCH] * rework low level callback API git-svn-id: trunk@40697 - --- packages/libffi/src/ffi.manager.pp | 1 - packages/rtl-objpas/src/inc/rtti.pp | 41 +++++++++++------------------ 2 files changed, 16 insertions(+), 26 deletions(-) diff --git a/packages/libffi/src/ffi.manager.pp b/packages/libffi/src/ffi.manager.pp index a86bea3b7a..89d9e27cae 100644 --- a/packages/libffi/src/ffi.manager.pp +++ b/packages/libffi/src/ffi.manager.pp @@ -500,7 +500,6 @@ const Invoke: @FFIInvoke; CreateCallbackProc: Nil; CreateCallbackMethod: Nil; - FreeCallback: Nil ); var diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp index 40544b9830..0c0207bdc4 100644 --- a/packages/rtl-objpas/src/inc/rtti.pp +++ b/packages/rtl-objpas/src/inc/rtti.pp @@ -47,7 +47,12 @@ type TRttiProperty = class; TRttiInstanceType = class; - TFunctionCallCallback = Pointer; + TFunctionCallCallback = class + protected + function GetCodeAddress: CodePointer; virtual; abstract; + public + property CodeAddress: CodePointer read GetCodeAddress; + end; TFunctionCallFlag = ( fcfStatic @@ -451,15 +456,14 @@ type end; TFunctionCallParameterArray = specialize TArray; - TFunctionCallProc = procedure(const aArgs: TValueArray; out aResult: TValue; aContext: Pointer); - TFunctionCallMethod = procedure(const aArgs: TValueArray; out aResult: TValue; aContext: Pointer) of object; + TFunctionCallProc = procedure(const aArgs: specialize TArray; aResult: Pointer; aContext: Pointer); + TFunctionCallMethod = procedure(const aArgs: specialize TArray; aResult: Pointer; aContext: Pointer) of object; TFunctionCallManager = record Invoke: procedure(CodeAddress: CodePointer; const Args: TFunctionCallParameterArray; CallingConvention: TCallConv; ResultType: PTypeInfo; ResultValue: Pointer; Flags: TFunctionCallFlags); - CreateCallbackProc: function(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; - CreateCallbackMethod: function(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; - FreeCallback: procedure(aCallback: TFunctionCallCallback; aCallConv: TCallConv); + CreateCallbackProc: function(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; + CreateCallbackMethod: function(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; end; TFunctionCallManagerArray = array[TCallConv] of TFunctionCallManager; @@ -480,9 +484,8 @@ procedure GetFunctionCallManagers(out aFuncCallMgrs: TFunctionCallManagerArray); function Invoke(aCodeAddress: CodePointer; const aArgs: TValueArray; aCallConv: TCallConv; aResultType: PTypeInfo; aIsStatic: Boolean; aIsConstructor: Boolean): TValue; -function CreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; -function CreateCallbackMethod(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; -procedure FreeCallback(aCallback: TFunctionCallCallback; aCallConv: TCallConv); +function CreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; +function CreateCallbackMethod(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; function IsManaged(TypeInfo: PTypeInfo): boolean; @@ -670,29 +673,23 @@ begin raise ENotImplemented.Create(SErrInvokeNotImplemented); end; -function NoCreateCallbackProc(aFunc: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; +function NoCreateCallbackProc(aFunc: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; begin Result := Nil; raise ENotImplemented.Create(SErrCallbackNotImplented); end; -function NoCreateCallbackMethod(aFunc: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; +function NoCreateCallbackMethod(aFunc: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; begin Result := Nil; raise ENotImplemented.Create(SErrCallbackNotImplented); end; -procedure NoFreeCallback(aCallback: TFunctionCallCallback; aCallConv: TCallConv); -begin - raise ENotImplemented.Create(SErrCallbackNotImplented); -end; - const NoFunctionCallManager: TFunctionCallManager = ( Invoke: @NoInvoke; CreateCallbackProc: @NoCreateCallbackProc; CreateCallbackMethod: @NoCreateCallbackMethod; - FreeCallback: @NoFreeCallback ); procedure SetFunctionCallManager(aCallConv: TCallConv; constref aFuncCallMgr: TFunctionCallManager; @@ -931,7 +928,7 @@ begin mgr.Invoke(aCodeAddress, args, aCallConv, restype, resptr, flags); end; -function CreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; +function CreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; begin if not Assigned(FuncCallMgr[aCallConv].CreateCallbackProc) then raise ENotImplemented.Create(SErrCallbackNotImplented); @@ -942,7 +939,7 @@ begin Result := FuncCallMgr[aCallConv].CreateCallbackProc(aHandler, aCallConv, aArgs, aResultType, aFlags, aContext); end; -function CreateCallbackMethod(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; +function CreateCallbackMethod(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback; begin if not Assigned(FuncCallMgr[aCallConv].CreateCallbackMethod) then raise ENotImplemented.Create(SErrCallbackNotImplented); @@ -953,12 +950,6 @@ begin Result := FuncCallMgr[aCallConv].CreateCallbackMethod(aHandler, aCallConv, aArgs, aResultType, aFlags, aContext); end; -procedure FreeCallback(aCallback: TFunctionCallCallback; aCallConv: TCallConv); -begin - if Assigned(FuncCallMgr[aCallConv].FreeCallback) then - FuncCallMgr[aCallConv].FreeCallback(aCallback, aCallConv); -end; - function IsManaged(TypeInfo: PTypeInfo): boolean; begin if Assigned(TypeInfo) then