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

* also take param flags into consideration

Browse Source 
git-svn-id: trunk@39890 -
This commit is contained in:
svenbarth 2018-10-07 12:25:49 +00:00
parent 3ca2529b58
commit b91c856e38
1 changed files with 109 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -41,7 +41,7 @@ begin
Dispose(t); Dispose(t);
end; end;
function TypeInfoToFFIType(aTypeInfo: PTypeInfo): pffi_type; forward; function TypeInfoToFFIType(aTypeInfo: PTypeInfo; aFlags: TParamFlags): pffi_type; forward;
function RecordOrObjectToFFIType(aTypeInfo: PTypeInfo): pffi_type; function RecordOrObjectToFFIType(aTypeInfo: PTypeInfo): pffi_type;
var var
@ -99,7 +99,7 @@ begin
Dec(remoffset, SizeOf(Byte)) Dec(remoffset, SizeOf(Byte))
end; end;
{ now add the real field type } { now add the real field type }
AddElement(TypeInfoToFFIType(field^.TypeRef)); AddElement(TypeInfoToFFIType(field^.TypeRef, []));
Inc(field); Inc(field);
curoffset := field^.FldOffset; curoffset := field^.FldOffset;
end; end;
@ -153,7 +153,7 @@ begin
Tpffi_typeArray(Result^.elements) := elements; Tpffi_typeArray(Result^.elements) := elements;
end; end;
function TypeInfoToFFIType(aTypeInfo: PTypeInfo): pffi_type; function TypeInfoToFFIType(aTypeInfo: PTypeInfo; aFlags: TParamFlags): pffi_type;
function TypeKindName: String; function TypeKindName: String;
begin begin
@ -167,6 +167,9 @@ begin
Result := @ffi_type_void; Result := @ffi_type_void;
if Assigned(aTypeInfo) then begin if Assigned(aTypeInfo) then begin
td := GetTypeData(aTypeInfo); td := GetTypeData(aTypeInfo);
if aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> [] then
Result := @ffi_type_pointer
else
case aTypeInfo^.Kind of case aTypeInfo^.Kind of
tkInteger, tkInteger,
tkEnumeration, tkEnumeration,
@ -263,7 +266,7 @@ begin
end; end;
end; end;
function ValueToFFIValue(constref aValue: Pointer; aKind: TTypeKind; aIsResult: Boolean): Pointer; function ValueToFFIValue(constref aValue: Pointer; aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Pointer;
const const
ResultTypeNeedsIndirection = [ ResultTypeNeedsIndirection = [
tkAString, tkAString,
@ -274,7 +277,9 @@ const
]; ];
begin begin
Result := aValue; Result := aValue;
if (aKind = tkSString) or (aIsResult and (aKind in ResultTypeNeedsIndirection)) then if (aKind = tkSString) or
(aIsResult and (aKind in ResultTypeNeedsIndirection)) or
(aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> []) then
Result := @aValue; Result := @aValue;
end; end;
@ -444,8 +449,8 @@ begin
{ the order is Self/Vmt (if any), Result param (if any), other params } { the order is Self/Vmt (if any), Result param (if any), other params }
if not (fcfStatic in aFlags) and retparam then begin if not (fcfStatic in aFlags) and retparam then begin
argtypes[0] := TypeInfoToFFIType(aArgs[0].Info.ParamType); argtypes[0] := TypeInfoToFFIType(aArgs[0].Info.ParamType, aArgs[0].Info.ParamFlags);
argvalues[0] := ValueToFFIValue(aArgs[0].ValueRef, aArgs[0].Info.ParamType^.Kind, False); argvalues[0] := ValueToFFIValue(aArgs[0].ValueRef, aArgs[0].Info.ParamType^.Kind, aArgs[0].Info.ParamFlags, False);
if retparam then if retparam then
Inc(retidx); Inc(retidx);
argstart := 1; argstart := 1;
@ -453,16 +458,16 @@ begin
argstart := 0; argstart := 0;
for i := Low(aArgs) + argstart to High(aArgs) do begin for i := Low(aArgs) + argstart to High(aArgs) do begin
argtypes[i - Low(aArgs) + Low(argtypes) + argoffset] := TypeInfoToFFIType(aArgs[i].Info.ParamType); argtypes[i - Low(aArgs) + Low(argtypes) + argoffset] := TypeInfoToFFIType(aArgs[i].Info.ParamType, aArgs[i].Info.ParamFlags);
argvalues[i - Low(aArgs) + Low(argtypes) + argoffset] := ValueToFFIValue(aArgs[i].ValueRef, aArgs[i].Info.ParamType^.Kind, False); argvalues[i - Low(aArgs) + Low(argtypes) + argoffset] := ValueToFFIValue(aArgs[i].ValueRef, aArgs[i].Info.ParamType^.Kind, aArgs[i].Info.ParamFlags, False);
end; end;
if retparam then begin if retparam then begin
argtypes[retidx] := TypeInfoToFFIType(aResultType); argtypes[retidx] := TypeInfoToFFIType(aResultType, []);
argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, True); argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, [], True);
rtype := @ffi_type_void; rtype := @ffi_type_void;
end else begin end else begin
rtype := TypeInfoToFFIType(aResultType); rtype := TypeInfoToFFIType(aResultType, []);
end; end;
if ffi_prep_cif(@cif, abi, arglen, rtype, @argtypes[0]) <> FFI_OK then if ffi_prep_cif(@cif, abi, arglen, rtype, @argtypes[0]) <> FFI_OK then