paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 18:49:27 +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

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

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