* adjust Invoke API of FunctionCallManager to not rely on TValue

git-svn-id: trunk@39881 -

packages/libffi/src/ffi.manager.pp

@@ -263,7 +263,7 @@ begin
   end;
 end;
 
-function ValueToFFIValue(constref Value: TValue; var aIndirect: Pointer; aIsResult: Boolean): Pointer;
+function ValueToFFIValue(constref aValue: Pointer; aKind: TTypeKind; aIsResult: Boolean): Pointer;
 const
   ResultTypeNeedsIndirection = [
    tkAString,
@@ -273,17 +273,85 @@ const
    tkDynArray
   ];
 begin
-  aIndirect := Nil;
-  Result := Value.GetReferenceToRawData;
-  if (Value.Kind = tkSString) or (aIsResult and (Value.Kind in ResultTypeNeedsIndirection)) then begin
-    aIndirect := Result;
-    Result := @aIndirect;
-  end;
+  Result := aValue;
+  if (aKind = tkSString) or (aIsResult and (aKind in ResultTypeNeedsIndirection)) then
+    Result := @aValue;
 end;
 
-function FFIValueToValue(Value: Pointer; TypeInfo: PTypeInfo): TValue;
+procedure FFIValueToValue(Source, Dest: Pointer; TypeInfo: PTypeInfo);
+var
+  size: SizeInt;
+  td: PTypeData;
 begin
-  TValue.Make(Value, TypeInfo, Result);
+  td := GetTypeData(TypeInfo);
+  size := 0;
+  case TypeInfo^.Kind of
+    tkChar,
+    tkWChar,
+    tkUChar,
+    tkEnumeration,
+    tkBool,
+    tkInteger,
+    tkInt64,
+    tkQWord:
+      case td^.OrdType of
+        otSByte,
+        otUByte:
+          size := 1;
+        otSWord,
+        otUWord:
+          size := 2;
+        otSLong,
+        otULong:
+          size := 4;
+        otSQWord,
+        otUQWord:
+          size := 8;
+      end;
+    tkSet:
+      size := td^.SetSize;
+    tkFloat:
+      case td^.FloatType of
+        ftSingle:
+          size := SizeOf(Single);
+        ftDouble:
+          size := SizeOf(Double);
+        ftExtended:
+          size := SizeOf(Extended);
+        ftComp:
+          size := SizeOf(Comp);
+        ftCurr:
+          size := SizeOf(Currency);
+      end;
+    tkMethod:
+      size := SizeOf(TMethod);
+    tkSString:
+      size := td^.MaxLength + 1;
+    tkDynArray,
+    tkLString,
+    tkAString,
+    tkUString,
+    tkWString,
+    tkClass,
+    tkPointer,
+    tkClassRef,
+    tkInterfaceRaw:
+      size := SizeOf(Pointer);
+    tkVariant:
+      size := SizeOf(tvardata);
+    tkArray:
+      size := td^.ArrayData.Size;
+    tkRecord:
+      size := td^.RecSize;
+    tkProcVar:
+      size := SizeOf(CodePointer);
+    tkObject: ;
+    tkHelper: ;
+    tkFile: ;
+  end;
+
+  if size > 0 then
+    Move(Source^, Dest^, size);
 end;
 
 { move this to type info? }
@@ -304,7 +372,7 @@ begin
 end;
 
 procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
-            aResultType: PTypeInfo; out aResultValue: TValue; aFlags: TFunctionCallFlags);
+            aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
 
   function CallConvName: String; inline;
   begin
@@ -315,14 +383,14 @@ var
   abi: ffi_abi;
   argtypes: array of pffi_type;
   argvalues: array of Pointer;
-  argindirect: array of Pointer;
   rtype: pffi_type;
   rvalue: ffi_arg;
   i, arglen, argoffset, retidx, argstart: LongInt;
   cif: ffi_cif;
   retparam: Boolean;
 begin
-  aResultValue := TValue.Empty;
+  if Assigned(aResultType) and not Assigned(aResultValue) then
+    raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
 
   if not (fcfStatic in aFlags) and (Length(aArgs) = 0) then
     raise EInvocationError.Create(SErrMissingSelfParam);
@@ -372,13 +440,12 @@ begin
 
   SetLength(argtypes, arglen);
   SetLength(argvalues, arglen);
-  SetLength(argindirect, arglen);
 
   { 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].Value.TypeInfo);
-    argvalues[0] := ValueToFFIValue(aArgs[0].Value, argindirect[0], False);
+    argtypes[0] := TypeInfoToFFIType(aArgs[0].Info.ParamType);
+    argvalues[0] := ValueToFFIValue(aArgs[0].ValueRef, aArgs[0].Info.ParamType^.Kind, False);
     if retparam then
       Inc(retidx);
     argstart := 1;
@@ -386,14 +453,13 @@ begin
     argstart := 0;
 
   for i := Low(aArgs) + argstart to High(aArgs) do begin
-    argtypes[i - Low(aArgs) + Low(argtypes) + argoffset] := TypeInfoToFFIType(aArgs[i].Value.TypeInfo);
-    argvalues[i - Low(aArgs) + Low(argtypes) + argoffset] := ValueToFFIValue(aArgs[i].Value, argindirect[i + argoffset], False);
+    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);
   end;
 
   if retparam then begin
     argtypes[retidx] := TypeInfoToFFIType(aResultType);
-    TValue.Make(Nil, aResultType, aResultValue);
-    argvalues[retidx] := ValueToFFIValue(aResultValue, argindirect[retidx], True);
+    argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, True);
     rtype := @ffi_type_void;
   end else begin
     rtype := TypeInfoToFFIType(aResultType);
@@ -405,7 +471,7 @@ begin
   ffi_call(@cif, ffi_fn(aCodeAddress), @rvalue, @argvalues[0]);
 
   if Assigned(aResultType) and not retparam then
-    aResultValue := FFIValueToValue(@rvalue, aResultType);
+    FFIValueToValue(@rvalue, aResultValue, aResultType);
 end;
 
 const

packages/rtl-objpas/src/inc/rtti.pp

@@ -381,11 +381,16 @@ type
   EInvocationError = class(Exception);
   ENonPublicType = class(Exception);
 
-  TFunctionCallParameter = record
-    Value: TValue;
+  TFunctionCallParameterInfo = record
+    ParamType: PTypeInfo;
     ParamFlags: TParamFlags;
     ParaLocs: PParameterLocations;
   end;
+
+  TFunctionCallParameter = record
+    ValueRef: Pointer;
+    Info: TFunctionCallParameterInfo;
+  end;
   TFunctionCallParameterArray = specialize TArray<TFunctionCallParameter>;
 
   TFunctionCallFlag = (
@@ -400,7 +405,7 @@ type
 
   TFunctionCallManager = record
     Invoke: procedure(CodeAddress: CodePointer; const Args: TFunctionCallParameterArray; CallingConvention: TCallConv;
-              ResultType: PTypeInfo; out ResultValue: TValue; Flags: TFunctionCallFlags);
+              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);
@@ -433,6 +438,7 @@ function IsManaged(TypeInfo: PTypeInfo): boolean;
 { these resource strings are needed by units implementing function call managers }
 resourcestring
   SErrInvokeNotImplemented = 'Invoke functionality is not implemented';
+  SErrInvokeResultTypeNoValue = 'Function has a result type, but no result pointer provided';
   SErrInvokeFailed = 'Invoke call failed';
   SErrCallbackNotImplented = 'Callback functionality is not implemented';
   SErrCallConvNotSupported = 'Calling convention not supported: %s';
@@ -573,7 +579,7 @@ var
   FuncCallMgr: TFunctionCallManagerArray;
 
 procedure NoInvoke(aCodeAddress: CodePointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
-            aResultType: PTypeInfo; out aResultValue: TValue; aFlags: TFunctionCallFlags);
+            aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
 begin
   raise ENotImplemented.Create(SErrInvokeNotImplemented);
 end;
@@ -722,12 +728,18 @@ begin
 
   SetLength(funcargs, Length(aArgs));
   for i := Low(aArgs) to High(aArgs) do begin
-    funcargs[i - Low(aArgs) + Low(funcargs)].Value := aArgs[i];
-    funcargs[i - Low(aArgs) + Low(funcargs)].ParamFlags := [];
-    funcargs[i - Low(aArgs) + Low(funcargs)].ParaLocs := Nil;
+    funcargs[i - Low(aArgs) + Low(funcargs)].ValueRef := aArgs[i].GetReferenceToRawData;
+    funcargs[i - Low(aArgs) + Low(funcargs)].Info.ParamType := aArgs[i].TypeInfo;
+    funcargs[i - Low(aArgs) + Low(funcargs)].Info.ParamFlags := [];
+    funcargs[i - Low(aArgs) + Low(funcargs)].Info.ParaLocs := Nil;
   end;
 
-  FuncCallMgr[aCallConv].Invoke(aCodeAddress, funcargs, aCallConv, aResultType, Result, flags);
+  if Assigned(aResultType) then
+    TValue.Make(Nil, aResultType, Result)
+  else
+    Result := TValue.Empty;
+
+  FuncCallMgr[aCallConv].Invoke(aCodeAddress, funcargs, aCallConv, aResultType, Result.GetReferenceToRawData, flags);
 end;
 
 function CreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of PTypeInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;