paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 16:48:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

* rework low level callback API

Browse Source 
git-svn-id: trunk@40697 -
This commit is contained in:
svenbarth 2018-12-29 19:21:09 +00:00
parent feff0c673f
commit 9a23613b9d
2 changed files with 16 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
packages/libffi/src/ffi.manager.pp
View File

@ -500,7 +500,6 @@ const
Invoke: @FFIInvoke;
CreateCallbackProc: Nil;
CreateCallbackMethod: Nil;
FreeCallback: Nil
);
var

41
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -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<TFunctionCallParameter>;
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<Pointer>; aResult: Pointer; aContext: Pointer);
TFunctionCallMethod = procedure(const aArgs: specialize TArray<Pointer>; 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