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

* correctly handle Comp and Currency parameters as well as results (at least on the X86 platforms :/ )

Browse Source 
git-svn-id: trunk@41838 -
This commit is contained in:
svenbarth 2019-04-04 19:32:26 +00:00
parent 04f681d7c6
commit 9e9aca6fea
1 changed files with 59 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -220,12 +220,9 @@ begin
Result := @ffi_type_double; Result := @ffi_type_double;
ftExtended: ftExtended:
Result := @ffi_type_longdouble; Result := @ffi_type_longdouble;
{ Comp and Currency are passed as Int64 (ToDo: on all platforms?) }
ftComp: ftComp:
{$ifndef FPC_HAS_TYPE_EXTENDED}
Result := @ffi_type_sint64; Result := @ffi_type_sint64;
{$else}
Result := @ffi_type_longdouble;
{$endif}
ftCurr: ftCurr:
Result := @ffi_type_sint64; Result := @ffi_type_sint64;
end; end;
@ -400,6 +397,12 @@ procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterAr
WriteStr(Result, aCallConv); WriteStr(Result, aCallConv);
end; end;
{ on X86 platforms Currency and Comp results are passed by the X87 if the
Extended type is available }
{$if (defined(CPUI8086) or defined(CPUI386) or defined(CPUX86_64)) and defined(FPC_HAS_TYPE_EXTENDED) and (not defined(FPC_COMP_IS_INT64) or not defined(FPC_CURRENCY_IS_INT64))}
{$define USE_EXTENDED_AS_COMP_CURRENCY_RES}
{$endif}
var var
abi: ffi_abi; abi: ffi_abi;
argtypes: array of pffi_type; argtypes: array of pffi_type;
@ -409,6 +412,10 @@ var
i, arglen, argoffset, retidx, argstart: LongInt; i, arglen, argoffset, retidx, argstart: LongInt;
cif: ffi_cif; cif: ffi_cif;
retparam: Boolean; retparam: Boolean;
{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
restypedata: PTypeData;
resextended: Extended;
{$endif}
begin begin
if Assigned(aResultType) and not Assigned(aResultValue) then if Assigned(aResultType) and not Assigned(aResultValue) then
raise EInvocationError.Create(SErrInvokeResultTypeNoValue); raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
@ -483,18 +490,61 @@ begin
argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, [], True); argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, [], True);
rtype := @ffi_type_void; rtype := @ffi_type_void;
rvalue := Nil; rvalue := Nil;
{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
restypedata := Nil;
{$endif}
end else begin end else begin
rtype := TypeInfoToFFIType(aResultType, []); rvalue := Nil;
if Assigned(aResultType) then {$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
rvalue := aResultValue { special case for Comp/Currency as such arguments are passed as Int64,
else but the result is handled through the X87 }
rvalue := Nil; if Assigned(aResultType) and (aResultType^.Kind = tkFloat) then begin
restypedata := GetTypeData(aResultType);
case restypedata^.FloatType of
{$ifndef FPC_CURRENCY_IS_INT64}
ftCurr: begin
rtype := @ffi_type_longdouble;
rvalue := @resextended;
end;
{$endif}
{$ifndef FPC_COMP_IS_INT64}
ftComp: begin
rtype := @ffi_type_longdouble;
rvalue := @resextended;
end;
{$endif}
end;
end else
restypedata := Nil;
{$endif}
if not Assigned(rvalue) then begin
rtype := TypeInfoToFFIType(aResultType, []);
if Assigned(aResultType) then
rvalue := aResultValue
else
rvalue := Nil;
end;
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
raise EInvocationError.Create(SErrInvokeFailed); raise EInvocationError.Create(SErrInvokeFailed);
ffi_call(@cif, ffi_fn(aCodeAddress), rvalue, @argvalues[0]); ffi_call(@cif, ffi_fn(aCodeAddress), rvalue, @argvalues[0]);
{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
if Assigned(restypedata) then begin
case restypedata^.FloatType of
{$ifndef FPC_CURRENCY_IS_INT64}
ftCurr:
PCurrency(aResultValue)^ := Currency(resextended) / 10000;
{$endif}
{$ifndef FPC_COMP_IS_INT64}
ftComp:
PComp(aResultValue)^ := Comp(resextended);
{$endif}
end;
end;
{$endif}
end; end;
const const