diff --git a/packages/libffi/src/ffi.manager.pp b/packages/libffi/src/ffi.manager.pp index e277d31450..8c968b4533 100644 --- a/packages/libffi/src/ffi.manager.pp +++ b/packages/libffi/src/ffi.manager.pp @@ -220,12 +220,9 @@ begin Result := @ffi_type_double; ftExtended: Result := @ffi_type_longdouble; + { Comp and Currency are passed as Int64 (ToDo: on all platforms?) } ftComp: - {$ifndef FPC_HAS_TYPE_EXTENDED} Result := @ffi_type_sint64; - {$else} - Result := @ffi_type_longdouble; - {$endif} ftCurr: Result := @ffi_type_sint64; end; @@ -400,6 +397,12 @@ procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterAr WriteStr(Result, aCallConv); 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 abi: ffi_abi; argtypes: array of pffi_type; @@ -409,6 +412,10 @@ var i, arglen, argoffset, retidx, argstart: LongInt; cif: ffi_cif; retparam: Boolean; +{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES} + restypedata: PTypeData; + resextended: Extended; +{$endif} begin if Assigned(aResultType) and not Assigned(aResultValue) then raise EInvocationError.Create(SErrInvokeResultTypeNoValue); @@ -483,18 +490,61 @@ begin argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, [], True); rtype := @ffi_type_void; rvalue := Nil; +{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES} + restypedata := Nil; +{$endif} end else begin - rtype := TypeInfoToFFIType(aResultType, []); - if Assigned(aResultType) then - rvalue := aResultValue - else - rvalue := Nil; + rvalue := Nil; +{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES} + { special case for Comp/Currency as such arguments are passed as Int64, + but the result is handled through the X87 } + 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; if ffi_prep_cif(@cif, abi, arglen, rtype, @argtypes[0]) <> FFI_OK then raise EInvocationError.Create(SErrInvokeFailed); 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; const