# revisions: 41828,41830,41831,41832,41833,41834,41835,41836,41837,41838,41839,41841,41842,42025,42031,42032,42033,42034,42035,42036,42065,42066,42067,42068,42069,42070,42071,42072,42073,42089,42150,42151,42181,42182,42183,42184,42185,42219,42220,42221,42222

git-svn-id: branches/fixes_3_2@43400 -

.gitattributes

@@ -13928,6 +13928,8 @@ tests/test/tthlp25.pp svneol=native#text/pascal
 tests/test/tthlp26a.pp -text svneol=native#text/pascal
 tests/test/tthlp26b.pp -text svneol=native#text/pascal
 tests/test/tthlp26c.pp -text svneol=native#text/pascal
+tests/test/tthlp27.pp svneol=native#text/pascal
+tests/test/tthlp28.pp svneol=native#text/pascal
 tests/test/tthlp3.pp svneol=native#text/pascal
 tests/test/tthlp4.pp svneol=native#text/pascal
 tests/test/tthlp5.pp svneol=native#text/pascal
@@ -16435,6 +16437,7 @@ tests/webtbs/tw3533.pp svneol=native#text/plain
 tests/webtbs/tw3534.pp svneol=native#text/plain
 tests/webtbs/tw3540.pp svneol=native#text/plain
 tests/webtbs/tw3546.pp svneol=native#text/plain
+tests/webtbs/tw35533.pp svneol=native#text/pascal
 tests/webtbs/tw3554.pp svneol=native#text/plain
 tests/webtbs/tw3564.pp svneol=native#text/plain
 tests/webtbs/tw3567.pp svneol=native#text/plain

compiler/pexpr.pas

@@ -2002,6 +2002,7 @@ implementation
      { shouldn't be used that often, so the extra overhead is ok to save
        stack space }
      dispatchstring : ansistring;
+     autoderef,
      erroroutp1,
      allowspecialize,
      isspecialize,
@@ -2228,6 +2229,7 @@ implementation
                  end
                else
                  isspecialize:=false;
+               autoderef:=false;
                if (p1.resultdef.typ=pointerdef) and
                   (m_autoderef in current_settings.modeswitches) and
                   { don't auto-deref objc.id, because then the code
@@ -2236,6 +2238,7 @@ implementation
                  begin
                    p1:=cderefnode.create(p1);
                    do_typecheckpass(p1);
+                   autoderef:=true;
                  end;
                { procvar.<something> can never mean anything so always
                  try to call it in case it returns a record/object/... }
@@ -2659,7 +2662,20 @@ implementation
                     end;
                   else
                     begin
-                      found:=try_type_helper(p1,nil);
+                      if autoderef then
+                        begin
+                          { always try with the not dereferenced node }
+                          p2:=tderefnode(p1).left;
+                          found:=try_type_helper(p2,nil);
+                          if found then
+                            begin
+                              tderefnode(p1).left:=nil;
+                              p1.destroy;
+                              p1:=p2;
+                            end;
+                        end
+                      else
+                        found:=try_type_helper(p1,nil);
                       if not found then
                         begin
                           if p1.resultdef.typ<>undefineddef then

compiler/systems/t_linux.pas

@@ -374,7 +374,7 @@ begin
      DllCmd[1]:=DllCmd[1]+' $RES';
      DllCmd[2]:='strip --strip-unneeded $EXE';
      ExtDbgCmd[1]:='objcopy --only-keep-debug $EXE $DBG';
-     ExtDbgCmd[2]:='objcopy --add-gnu-debuglink=$DBG $EXE';
+     ExtDbgCmd[2]:='objcopy "--add-gnu-debuglink=$DBGX" $EXE';
      ExtDbgCmd[3]:='strip --strip-unneeded $EXE';
 
      SetupDynlinker(DynamicLinker,libctype);
@@ -1425,6 +1425,7 @@ begin
           SplitBinCmd(Info.ExtDbgCmd[i],binstr,cmdstr);
           Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename));
           Replace(cmdstr,'$DBGFN',maybequoted(extractfilename(current_module.dbgfilename)));
+          Replace(cmdstr,'$DBGX',current_module.dbgfilename);
           Replace(cmdstr,'$DBG',maybequoted(current_module.dbgfilename));
           success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false);
           if not success then

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;
@@ -279,10 +276,11 @@ begin
         else
           raise EInvocationError.CreateFmt(SErrTypeKindNotSupported, [TypeKindName]);
       end;
-  end;
+  end else if aFlags * [pfOut, pfVar, pfConst, pfConstRef] <> [] then
+    Result := @ffi_type_pointer;
 end;
 
-function ValueToFFIValue(constref aValue: Pointer; aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Pointer;
+function ArgIsIndirect(aKind: TTypeKind; aFlags: TParamFlags; aIsResult: Boolean): Boolean;
 const
   ResultTypeNeedsIndirection = [
    tkAString,
@@ -292,11 +290,12 @@ const
    tkDynArray
   ];
 begin
-  Result := aValue;
+  Result := False;
   if (aKind = tkSString) or
       (aIsResult and (aKind in ResultTypeNeedsIndirection)) or
-      (aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> []) then
-    Result := @aValue;
+      (aFlags * [pfArray, pfOut, pfVar, pfConstRef] <> []) or
+      ((aKind = tkUnknown) and (pfConst in aFlags)) then
+    Result := True;
 end;
 
 procedure FFIValueToValue(Source, Dest: Pointer; TypeInfo: PTypeInfo);
@@ -392,8 +391,29 @@ begin
   end;
 end;
 
-procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
-            aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
+{ 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}
+
+type
+  TFFIData = record
+    Types: array of pffi_type;
+    Values: array of Pointer;
+    Indirect: array of Boolean;
+    ResultType: pffi_type;
+    ResultValue: Pointer;
+    ResultIndex: SizeInt;
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+    ResultTypeData: PTypeData;
+    ResultExtended: Extended;
+{$endif}
+    { put this at the end just in case we messed up the size }
+    CIF: ffi_cif;
+  end;
+
+procedure CreateCIF(constref aArgInfos: array of TFunctionCallParameterInfo; constref aArgValues: array of Pointer; aCallConv: TCallConv; aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags; out aData: TFFIData);
 
   function CallConvName: String; inline;
   begin
@@ -402,20 +422,16 @@ procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterAr
 
 var
   abi: ffi_abi;
-  argtypes: array of pffi_type;
-  argvalues: array of Pointer;
-  rtype: pffi_type;
-  rvalue: ffi_arg;
-  i, arglen, argoffset, retidx, argstart: LongInt;
-  cif: ffi_cif;
-  retparam: Boolean;
+  i, arglen, argoffset, argstart: LongInt;
+  usevalues, retparam: Boolean;
+  kind: TTypeKind;
+  types: ppffi_type;
 begin
-  if Assigned(aResultType) and not Assigned(aResultValue) then
-    raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
-
-  if not (fcfStatic in aFlags) and (Length(aArgs) = 0) then
+  if not (fcfStatic in aFlags) and (Length(aArgInfos) = 0) then
     raise EInvocationError.Create(SErrMissingSelfParam);
 
+  Assert((Length(aArgInfos) = Length(aArgValues)) or (Length(aArgValues) = 0), 'Amount of arguments does not match needed arguments');
+
   case aCallConv of
 {$if defined(CPUI386)}
     ccReg:
@@ -447,59 +463,341 @@ begin
       raise EInvocationError.CreateFmt(SErrCallConvNotSupported, [CallConvName]);
   end;
 
+  { if no values are provided we are called to prepare a callback, otherwise
+    we are asked to prepare a invokation }
+  usevalues := (Length(aArgInfos) > 0) and (Length(aArgValues) > 0);
+
   retparam := RetInParam(aCallConv, aResultType);
 
-  arglen := Length(aArgs);
+  arglen := Length(aArgInfos);
   if retparam then begin
     Inc(arglen);
+    usevalues := True;
     argoffset := 1;
-    retidx := 0;
+    aData.ResultIndex := 0;
   end else begin
     argoffset := 0;
-    retidx := -1;
+    aData.ResultIndex := -1;
   end;
 
-  SetLength(argtypes, arglen);
-  SetLength(argvalues, arglen);
+  SetLength(aData.Types, arglen);
+  SetLength(aData.Indirect, arglen);
+  if usevalues then
+    SetLength(aData.Values, 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].Info.ParamType, aArgs[0].Info.ParamFlags);
-    argvalues[0] := ValueToFFIValue(aArgs[0].ValueRef, aArgs[0].Info.ParamType^.Kind, aArgs[0].Info.ParamFlags, False);
+    aData.Types[0] := TypeInfoToFFIType(aArgInfos[0].ParamType, aArgInfos[0].ParamFlags);
+    if Assigned(aArgInfos[0].ParamType) then
+      kind := aArgInfos[0].ParamType^.Kind
+    else
+      kind := tkUnknown;
+    aData.Indirect[0] := ArgIsIndirect(kind, aArgInfos[0].ParamFlags, False);
+    if usevalues then
+      if aData.Indirect[0] then
+        aData.Values[0] := @aArgValues[0]
+      else
+        aData.Values[0] := aArgValues[0];
     if retparam then
-      Inc(retidx);
+      Inc(aData.ResultIndex);
     argstart := 1;
   end else
     argstart := 0;
 
-  for i := Low(aArgs) + argstart to High(aArgs) do begin
-    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);
+  for i := argstart to High(aArgInfos) do begin
+    aData.Types[i + argoffset] := TypeInfoToFFIType(aArgInfos[i].ParamType, aArgInfos[i].ParamFlags);
+    if (pfResult in aArgInfos[i].ParamFlags) and not retparam then
+      aData.ResultIndex := i + argoffset;
+    if Assigned(aArgInfos[i].ParamType) then
+      kind := aArgInfos[i].ParamType^.Kind
+    else
+      kind := tkUnknown;
+    aData.Indirect[i + argoffset] := ArgIsIndirect(kind, aArgInfos[i].ParamFlags, False);
+    if usevalues then
+      if aData.Indirect[i + argoffset] then
+        aData.Values[i + argoffset] := @aArgValues[i]
+      else
+        aData.Values[i + argoffset] := aArgValues[i];
   end;
 
   if retparam then begin
-    argtypes[retidx] := TypeInfoToFFIType(aResultType, []);
-    argvalues[retidx] := ValueToFFIValue(aResultValue, aResultType^.Kind, [], True);
-    rtype := @ffi_type_void;
+    aData.Types[aData.ResultIndex] := TypeInfoToFFIType(aResultType, []);
+    aData.Indirect[aData.ResultIndex] := ArgIsIndirect(aResultType^.Kind, [], True);
+    if usevalues then
+      if aData.Indirect[aData.ResultIndex] then
+        aData.Values[aData.ResultIndex] := @aResultValue
+      else
+        aData.Values[aData.ResultIndex] := aResultValue;
+    aData.ResultType := @ffi_type_void;
+    aData.ResultValue := Nil;
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+    aData.ResultTypeData := Nil;
+{$endif}
   end else begin
-    rtype := TypeInfoToFFIType(aResultType, []);
+    aData.ResultValue := 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
+      aData.ResultTypeData := GetTypeData(aResultType);
+      case aData.ResultTypeData^.FloatType of
+{$ifndef FPC_CURRENCY_IS_INT64}
+        ftCurr: begin
+          aData.ResultType := @ffi_type_longdouble;
+          aData.ResultValue := @aData.ResultExtended;
+        end;
+{$endif}
+{$ifndef FPC_COMP_IS_INT64}
+        ftComp: begin
+          aData.ResultType := @ffi_type_longdouble;
+          aData.ResultValue := @aData.ResultExtended;
+        end;
+{$endif}
+      end;
+    end else
+      aData.ResultTypeData := Nil;
+{$endif}
+    if not Assigned(aData.ResultValue) then begin
+      aData.ResultType := TypeInfoToFFIType(aResultType, []);
+      if Assigned(aResultType) then
+        aData.ResultValue := aResultValue
+      else
+        aData.ResultValue := Nil;
+    end;
   end;
 
-  if ffi_prep_cif(@cif, abi, arglen, rtype, @argtypes[0]) <> FFI_OK then
+  if Assigned(aData.Types) then
+    types := @aData.Types[0]
+  else
+    types := Nil;
+
+  if ffi_prep_cif(@aData.CIF, abi, arglen, aData.ResultType, types) <> FFI_OK then
     raise EInvocationError.Create(SErrInvokeFailed);
+end;
+
+procedure FFIInvoke(aCodeAddress: Pointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
+            aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
+var
+  ffidata: TFFIData;
+  i: SizeInt;
+  arginfos: array of TFunctionCallParameterInfo;
+  argvalues: array of Pointer;
+begin
+  if Assigned(aResultType) and not Assigned(aResultValue) then
+    raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
 
-  ffi_call(@cif, ffi_fn(aCodeAddress), @rvalue, @argvalues[0]);
+  SetLength(arginfos, Length(aArgs));
+  SetLength(argvalues, Length(aArgs));
+  for i := 0 to High(aArgs) do begin
+    arginfos[i] := aArgs[i].Info;
+    argvalues[i] := aArgs[i].ValueRef;
+  end;
+  CreateCIF(arginfos, argvalues, aCallConv, aResultType, aResultValue, aFlags, ffidata);
 
-  if Assigned(aResultType) and not retparam then
-    FFIValueToValue(@rvalue, aResultValue, aResultType);
+  arginfos := Nil;
+  argvalues := Nil;
+
+  ffi_call(@ffidata.CIF, ffi_fn(aCodeAddress), ffidata.ResultValue, @ffidata.Values[0]);
+
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+  if Assigned(ffidata.ResultTypeData) then begin
+    case ffidata.ResultTypeData^.FloatType of
+{$ifndef FPC_CURRENCY_IS_INT64}
+      ftCurr:
+        PCurrency(aResultValue)^ := Currency(ffidata.ResultExtended / 10000);
+{$endif}
+{$ifndef FPC_COMP_IS_INT64}
+      ftComp:
+        PComp(aResultValue)^ := Comp(ffidata.ResultExtended);
+{$endif}
+    end;
+  end;
+{$endif}
 end;
 
+type
+  TFFIFunctionCallback = class(TFunctionCallCallback)
+  private
+    fFFIData: TFFIData;
+    fData: Pointer;
+    fCode: CodePointer;
+    fContext: Pointer;
+  private
+    class procedure ClosureFunc(aCIF: pffi_cif; aRet: Pointer; aArgs: PPointer; aUserData: Pointer); cdecl; static;
+    procedure PassToHandler(aRet: Pointer; aArgs: PPointer);
+  protected
+    function GetCodeAddress: CodePointer; override;
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); virtual; abstract;
+  public
+    constructor Create(aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+    destructor Destroy; override;
+  end;
+
+  TFFIFunctionCallbackMethod = class(TFFIFunctionCallback)
+  private
+    fHandler: TFunctionCallMethod;
+  protected
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); override;
+  public
+    constructor Create(aHandler: TFunctionCallMethod; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+  end;
+
+  TFFIFunctionCallbackProc = class(TFFIFunctionCallback)
+  private
+    fHandler: TFunctionCallProc;
+  protected
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); override;
+  public
+    constructor Create(aHandler: TFunctionCallProc; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+  end;
+
+class procedure TFFIFunctionCallback.ClosureFunc(aCIF: pffi_cif; aRet: Pointer; aArgs: PPointer; aUserData: Pointer); cdecl;
+var
+  this: TFFIFunctionCallback absolute aUserData;
+begin
+  this.PassToHandler(aRet, aArgs);
+end;
+
+procedure TFFIFunctionCallback.PassToHandler(aRet: Pointer; aArgs: PPointer);
+var
+  args: array of Pointer;
+  i, arglen, argidx: SizeInt;
+  resptr: Pointer;
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+{$ifndef FPC_COMP_IS_INT64}
+  rescomp: Comp;
+{$endif}
+{$ifndef FPC_CURR_IS_INT64}
+  rescurr: Currency;
+{$endif}
+{$endif}
+begin
+  arglen := Length(fFFIData.Types);
+  if fFFIData.ResultIndex >= 0 then
+    Dec(arglen);
+  SetLength(args, arglen);
+  argidx := 0;
+  for i := 0 to High(fFFIData.Types) do begin
+    if i = fFFIData.ResultIndex then
+      Continue;
+    args[argidx] := aArgs[i];
+    if fFFIData.Indirect[i] then
+      args[argidx] := PPointer(aArgs[i])^
+    else
+      args[argidx] := aArgs[i];
+    Inc(argidx);
+  end;
+
+  if fFFIData.ResultIndex >= 0 then begin
+    if fFFIData.Indirect[fFFIData.ResultIndex] then
+      resptr := PPointer(aArgs[fFFIData.ResultIndex])^
+    else
+      resptr := aArgs[fFFIData.ResultIndex];
+  end else begin
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+    resptr := Nil;
+    if Assigned(fFFIData.ResultTypeData) then begin
+      case fFFIData.ResultTypeData^.FloatType of
+{$ifndef FPC_COMP_IS_INT64}
+        ftComp:
+          resptr := @rescomp;
+{$endif}
+{$ifndef FPC_CURR_IS_INT64}
+        ftCurr:
+          resptr := @rescurr;
+{$endif}
+      end;
+    end;
+    if not Assigned(resptr) then
+{$endif}
+      resptr := aRet;
+  end;
+
+  CallHandler(args, resptr, fContext);
+
+{$ifdef USE_EXTENDED_AS_COMP_CURRENCY_RES}
+  if Assigned(fFFIData.ResultTypeData) then begin
+    case fFFIData.ResultTypeData^.FloatType of
+{$ifndef FPC_COMP_IS_INT64}
+      ftComp:
+        PExtended(aRet)^ := rescomp;
+{$endif}
+{$ifndef FPC_CURR_IS_INT64}
+      ftCurr:
+        PExtended(aRet) ^ := rescurr * 10000;
+{$endif}
+    end;
+  end;
+{$endif}
+end;
+
+function TFFIFunctionCallback.GetCodeAddress: CodePointer;
+begin
+  Result := fData;
+end;
+
+constructor TFFIFunctionCallback.Create(aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+var
+  res: ffi_status;
+begin
+  fContext := aContext;
+
+  CreateCIF(aArgs, [], aCallConv, aResultType, Nil, aFlags, fFFIData);
+
+  fData := ffi_closure_alloc(SizeOf(ffi_closure), @fCode);
+  if not Assigned(fData) or not Assigned(fCode) then
+    raise ERTTI.Create(SErrMethodImplCreateFailed);
+
+  res := ffi_prep_closure_loc(pffi_closure(fData), @fFFIData.CIF, @ClosureFunc, Self, fCode);
+  if res <> FFI_OK then
+    raise ERTTI.Create(SErrMethodImplCreateFailed);
+end;
+
+destructor TFFIFunctionCallback.Destroy;
+begin
+  if Assigned(fData) then
+    ffi_closure_free(fData);
+end;
+
+constructor TFFIFunctionCallbackProc.Create(aHandler: TFunctionCallProc; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+begin
+  inherited Create(aContext, aCallConv, aArgs, aResultType, aFlags);
+  fHandler := aHandler;
+end;
+
+procedure TFFIFunctionCallbackProc.CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer);
+begin
+  fHandler(aArgs, aResult, aContext);
+end;
+
+constructor TFFIFunctionCallbackMethod.Create(aHandler: TFunctionCallMethod; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+begin
+  inherited Create(aContext, aCallConv, aArgs, aResultType, aFlags);
+  fHandler := aHandler;
+end;
+
+procedure TFFIFunctionCallbackMethod.CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer);
+begin
+  fHandler(aArgs, aResult, aContext);
+end;
+
+function FFICreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
+begin
+  Result := TFFIFunctionCallbackProc.Create(aHandler, aContext, aCallConv, aArgs, aResultType, aFlags);
+end;
+
+function FFICreateCallbackMethod(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
+begin
+  Result := TFFIFunctionCallbackMethod.Create(aHandler, aContext, aCallConv, aArgs, aResultType, aFlags);
+end;
+
+
 const
   FFIManager: TFunctionCallManager = (
     Invoke: @FFIInvoke;
-    CreateCallbackProc: Nil;
-    CreateCallbackMethod: Nil;
+    CreateCallbackProc: @FFICreateCallbackProc;
+    CreateCallbackMethod: @FFICreateCallbackMethod;
   );
 
 var

packages/libffi/src/ffi.pp

@@ -269,7 +269,7 @@ const
 const
   ffilibrary = 'ffi';
 
-{$if defined(CPUX86) and not defined(WIN64)}
+{$if defined(CPUI8086) or defined(CPUI386) or (defined(CPUX86_64) and not defined(WIN64))}
   { Note: we can not use FPC_HAS_TYPE_EXTENDED here as libffi won't have the
           corresponding type no matter what }
   {$define HAVE_LONG_DOUBLE}

packages/rtl-objpas/src/i386/invoke.inc

@@ -123,12 +123,6 @@ resourcestring
 
 procedure SystemInvokeRegister(aCodeAddress: CodePointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
             aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
-type
-  PBoolean16 = ^Boolean16;
-  PBoolean32 = ^Boolean32;
-  PBoolean64 = ^Boolean64;
-  PByteBool = ^ByteBool;
-  PQWordBool = ^QWordBool;
 var
   regstack: array of PtrUInt;
   stackargs: array of SizeInt;
@@ -195,6 +189,8 @@ begin
       AddRegArg(PtrUInt(aArgs[i].ValueRef))
     else if aArgs[i].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
       AddRegArg(PtrUInt(aArgs[i].ValueRef))
+    else if (pfConst in aArgs[i].Info.ParamFlags) and not Assigned(aArgs[i].Info.ParamType) then
+      AddRegArg(PtrUInt(aArgs[i].ValueRef))
     else begin
       td := GetTypeData(aArgs[i].Info.ParamType);
       case aArgs[i].Info.ParamType^.Kind of
@@ -296,6 +292,8 @@ begin
         AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef))
       else if aArgs[stackargs[i]].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
         AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef))
+      else if (pfConst in aArgs[stackargs[i]].Info.ParamFlags) and not Assigned(aArgs[stackargs[i]].Info.ParamType) then
+        AddStackArg(PtrUInt(aArgs[stackargs[i]].ValueRef))
       else begin
         td := GetTypeData(aArgs[stackargs[i]].Info.ParamType);
         case aArgs[stackargs[i]].Info.ParamType^.Kind of
@@ -422,7 +420,7 @@ begin
         ftCurr:
           PCurrency(aResultValue)^ := floatres / 10000;
         ftComp:
-          PComp(aResultValue)^ := floatres;
+          PComp(aResultValue)^ := Comp(floatres);
       end;
     end else if aResultType^.Kind in [tkQWord, tkInt64] then
       PQWord(aResultValue)^ := regstack[0] or (QWord(regstack[1]) shl 32)
@@ -442,11 +440,513 @@ begin
   end;
 end;
 
+const
+  PlaceholderContext = LongWord($12345678);
+  PlaceholderAddress = LongWord($87654321);
+  PlaceholderRetPop  = Word($1234);
+
+  RetNear = $C2;
+  RetFar = $CA;
+
+label
+  CallbackRegisterContext,
+  CallbackRegisterAddress,
+  CallbackRegisterCall,
+  CallbackRegisterRet,
+  CallbackRegisterEnd;
+
+const
+  CallbackRegisterContextPtr: Pointer = @CallbackRegisterContext;
+  CallbackRegisterAddressPtr: Pointer = @CallbackRegisterAddress;
+  CallbackRegisterCallPtr: Pointer = @CallbackRegisterCall;
+  CallbackRegisterRetPtr: Pointer = @CallbackRegisterRet;
+  CallbackRegisterEndPtr: Pointer = @CallbackRegisterEnd;
+
+procedure CallbackRegister; assembler; nostackframe;
+asm
+  { establish frame }
+  pushl %ebp
+  movl %esp, %ebp
+
+  { store registers }
+  pushl %ecx
+  pushl %edx
+  pushl %eax
+
+  { store pointer to stack area (including GP registers) }
+  lea (%esp), %edx
+
+  { also store ebx as we'll use that for the function address }
+  pushl %ebx
+
+  { call function with context }
+CallbackRegisterContext:
+  movl $0x12345678, %eax
+CallbackRegisterAddress:
+  movl $0x87654321, %ebx
+CallbackRegisterCall:
+
+  call *%ebx
+
+  { restore ebx }
+  popl %ebx
+
+  { restore stack }
+  movl %ebp, %esp
+  popl %ebp
+
+CallbackRegisterRet:
+  ret $0x1234
+CallbackRegisterEnd:
+end;
+
+type
+  TSystemFunctionCallback = class(TFunctionCallCallback)
+  private type
+    {$ScopedEnums On}
+    TArgType = (
+      GenReg,
+      Stack
+    );
+    {$ScopedEnums Off}
+
+    TArgInfo = record
+      ArgType: TArgType;
+      ArgIdx: SizeInt;
+      Slots: SizeInt;
+      Offset: SizeInt;
+      Deref: Boolean;
+    end;
+  private
+    fData: Pointer;
+    fSize: PtrUInt;
+    fFlags: TFunctionCallFlags;
+    fContext: Pointer;
+    fArgs: specialize TArray<TFunctionCallParameterInfo>;
+    fArgInfos: specialize TArray<TArgInfo>;
+    fRefArgs: specialize TArray<SizeInt>;
+    fResultType: PTypeInfo;
+    fResultIdx: SizeInt;
+    fResultInParam: Boolean;
+  private
+    function Handler(aStack: Pointer): Int64;
+  protected
+    procedure CreateCallback;
+    procedure CreateArgInfos;
+    function GetCodeAddress: CodePointer; override;
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); virtual; abstract;
+  public
+    constructor Create(aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+    destructor Destroy; override;
+  end;
+
+  TSystemFunctionCallbackMethod = class(TSystemFunctionCallback)
+  private
+    fHandler: TFunctionCallMethod;
+  protected
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); override;
+  public
+    constructor Create(aHandler: TFunctionCallMethod; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+  end;
+
+  TSystemFunctionCallbackProc = class(TSystemFunctionCallback)
+  private
+    fHandler: TFunctionCallProc;
+  protected
+    procedure CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer); override;
+  public
+    constructor Create(aHandler: TFunctionCallProc; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+  end;
+
+function TSystemFunctionCallback.Handler(aStack: Pointer): Int64;
+{
+  aStack has the following layout:
+    0:  EAX
+    4:  EDX
+    8:  ECX
+    12: EBP (not needed)
+    16: RET (not needed)
+    20: ARGS
+}
+var
+  args: specialize TArray<Pointer>;
+  i, len: SizeInt;
+  val: PPtrUInt;
+  resptr: Pointer;
+  genargs, stackargs: PPtrUInt;
+  floatres, floattmp: Extended;
+  td: PTypeData;
+begin
+  len := Length(fArgInfos);
+  if fResultInParam then
+    Dec(len);
+  SetLength(args, len);
+  genargs := PPtrUInt(aStack);
+  stackargs := @genargs[5];
+  for i := 0 to High(fArgInfos) do begin
+    if i = fResultIdx then
+      Continue;
+    case fArgInfos[i].ArgType of
+      TArgType.GenReg:
+        val := @genargs[fArgInfos[i].Offset];
+      TArgType.Stack:
+        val := @stackargs[fArgInfos[i].Offset];
+    end;
+    if fArgInfos[i].Deref then
+      args[fArgInfos[i].ArgIdx] := PPtrUInt(val^)
+    else
+      args[fArgInfos[i].ArgIdx] := val;
+  end;
+
+  if fResultInParam then begin
+    case fArgInfos[fResultIdx].ArgType of
+      TArgType.GenReg:
+        resptr := @genargs[fArgInfos[fResultIdx].Offset];
+      TArgType.Stack:
+        resptr := @stackargs[fArgInfos[fResultIdx].Offset];
+    end;
+    if fArgInfos[fResultIdx].Deref then
+      resptr := PPointer(resptr)^;
+  end else if Assigned(fResultType) then begin
+    if fResultType^.Kind = tkFloat then begin
+      resptr := @floatres;
+    end else
+      resptr := @Result;
+  end else
+    resptr := Nil;
+
+  CallHandler(args, resptr, fContext);
+
+  if Assigned(fResultType) and not fResultInParam and (fResultType^.Kind = tkFloat) then begin
+    td := GetTypeData(fResultType);
+    case td^.FloatType of
+      ftSingle:
+        asm
+          lea floatres, %eax
+          flds (%eax)
+          fwait
+        end ['eax'];
+      ftDouble:
+        asm
+          lea floatres, %eax
+          fldl (%eax)
+          fwait
+        end ['eax'];
+      ftExtended:
+        asm
+          lea floatres, %eax
+          fldt (%eax)
+          fwait
+        end ['eax'];
+      ftCurr,
+      ftComp:
+        asm
+          lea floatres, %eax
+          fildq (%eax)
+          fwait
+        end ['eax'];
+    end;
+  end;
+end;
+
+procedure TSystemFunctionCallback.CreateCallback;
+
+  procedure ReplacePlaceholder(aPlaceholder: PtrUInt; aValue: PtrUInt; aOfs, aSize: PtrUInt);
+  var
+    found: Boolean;
+    i: PtrUInt;
+  begin
+    found := False;
+    for i := aOfs to aOfs + aSize - 1 do begin
+      if PPtrUInt(@PByte(fData)[i])^ = PtrUInt(aPlaceholder) then begin
+        PPtrUInt(@(PByte(fData)[i]))^ := PtrUInt(aValue);
+        found := True;
+        Break;
+      end;
+    end;
+
+    if not found then
+      raise Exception.Create(SErrMethodImplCreateFailed);
+  end;
+
+var
+  src: Pointer;
+  ofs, size: PtrUInt;
+  method: TMethod;
+  i, stacksize: SizeInt;
+begin
+  fSize := PtrUInt(CallbackRegisterEndPtr) - PtrUInt(@CallbackRegister) + 1;
+  fData := AllocateMemory(fSize);
+  if not Assigned(fData) then
+    raise Exception.Create(SErrMethodImplCreateFailed);
+
+  src := @CallbackRegister;
+  Move(src^, fData^, fSize);
+
+  ofs := PtrUInt(CallbackRegisterContextPtr) - PtrUInt(@CallbackRegister);
+  size := PtrUInt(CallbackRegisterAddressPtr) - PtrUInt(CallbackRegisterContextPtr);
+
+  method := TMethod(@Handler);
+
+  ReplacePlaceholder(PlaceholderContext, PtrUInt(method.Data), ofs, size);
+
+  ofs := PtrUInt(CallbackRegisterAddressPtr) - PtrUInt(@CallbackRegister);
+  size := PtrUInt(CallbackRegisterCallPtr) - PtrUInt(CallbackRegisterAddressPtr);
+
+  ReplacePlaceholder(PlaceholderAddress, PtrUInt(method.Code), ofs, size);
+
+  ofs := PtrUInt(CallbackRegisterRetPtr) - PtrUInt(@CallbackRegister);
+  size := PtrUInt(CallbackRegisterEndPtr) - PtrUInt(CallbackRegisterRetPtr);
+
+  if not (PByte(fData)[ofs] = RetNear) and not (PByte(fData)[ofs] = RetFar) then
+    raise Exception.Create(SErrMethodImplCreateFailed);
+
+  stacksize := 0;
+  for i := 0 to High(fArgInfos) do
+    if fArgInfos[i].ArgType = TArgType.Stack then
+      Inc(stacksize, fArgInfos[i].Slots);
+
+  stacksize := stacksize * 4;
+
+  Inc(ofs);
+  if PWord(@PByte(fData)[ofs])^ = PlaceholderRetPop then
+    PWord(@PByte(fData)[ofs])^ := Word(stacksize);
+
+  if not ProtectMemory(fData, fSize, True) then
+    raise Exception.Create(SErrMethodImplCreateFailed);
+end;
+
+procedure TSystemFunctionCallback.CreateArgInfos;
+var
+  pass, genofs, stackofs: LongInt;
+  td: PTypeData;
+  i, c, argcount, stackcount, idx, argidx: SizeInt;
+  stackargs: array of SizeInt;
+begin
+  fResultInParam := ReturnResultInParam(fResultType);
+
+  genofs := 0;
+  stackofs := 0;
+  argidx := 0;
+  argcount := Length(fArgs);
+  if fResultInParam then begin
+    if fcfStatic in fFlags then
+      fResultIdx := 0
+    else
+      fResultIdx := 1;
+    Inc(argcount);
+  end else
+    fResultIdx := -1;
+  SetLength(fArgInfos, argcount);
+  SetLength(fRefArgs, argcount);
+  if fResultIdx >= 0 then begin
+    fArgInfos[fResultIdx].ArgType := TArgType.GenReg;
+    fArgInfos[fResultIdx].Offset := fResultIdx;
+  end;
+
+  SetLength(stackargs, argcount);
+  stackcount := 0;
+
+  for pass := 0 to 1 do begin
+    if pass = 0 then
+      c := High(fArgs)
+    else
+      c := stackcount - 1;
+    for i := 0 to c do begin
+      if argidx = fResultIdx then
+        Inc(argidx);
+      if pfResult in fArgs[i].ParamFlags then begin
+        fResultIdx := argidx;
+        fResultInParam := True;
+      end;
+      if (pass = 0) and (genofs >= 3) then begin
+        stackargs[stackcount] := i;
+        Inc(stackcount);
+        Continue;
+      end;
+      if pass = 0 then
+        idx := i
+      else
+        idx := stackargs[c - i];
+      if pass = 0 then
+        fArgInfos[argidx].ArgType := TArgType.GenReg
+      else
+        fArgInfos[argidx].ArgType := TArgType.Stack;
+      fArgInfos[argidx].Deref := False;
+      fArgInfos[argidx].Slots := 1;
+      if pfArray in fArgs[idx].ParamFlags then
+        fArgInfos[argidx].Deref := True
+      else if fArgs[idx].ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
+        fArgInfos[argidx].Deref := True
+      else if (pfConst in fArgs[idx].ParamFlags) and not Assigned(fArgs[idx].ParamType) then
+        fArgInfos[argidx].Deref := True
+      else begin
+        td := GetTypeData(fArgs[idx].ParamType);
+        case fArgs[idx].ParamType^.Kind of
+          tkSString,
+          tkMethod:
+            fArgInfos[argidx].Deref := True;
+          tkArray:
+            if td^.ArrayData.Size <= 4 then begin
+              fArgInfos[argidx].Deref := True;
+              fArgInfos[argidx].ArgType := TArgType.Stack;
+            end;
+          tkRecord:
+            if td^.RecSize <= 4 then begin
+              fArgInfos[argidx].Deref := True;
+              fArgInfos[argidx].ArgType := TArgType.Stack;
+            end;
+          tkObject,
+          tkWString,
+          tkUString,
+          tkAString,
+          tkDynArray,
+          tkClass,
+          tkClassRef,
+          tkInterface,
+          tkInterfaceRaw,
+          tkProcVar,
+          tkPointer:
+            ;
+          tkInt64,
+          tkQWord: begin
+            fArgInfos[argidx].ArgType := TArgType.Stack;
+            fArgInfos[argidx].Slots := 2;
+          end;
+          tkSet: begin
+            case td^.OrdType of
+              otUByte: begin
+                case td^.SetSize of
+                  0, 1, 2, 4:
+                    ;
+                  else
+                    fArgInfos[argidx].Deref := True;
+                end;
+              end;
+              otUWord,
+              otULong:
+                ;
+            end;
+          end;
+          tkEnumeration,
+          tkInteger:
+            ;
+          tkBool:
+            case td^.OrdType of
+              otUQWord,
+              otSQWord:
+                fArgInfos[argidx].ArgType := TArgType.Stack;
+            end;
+          tkFloat: begin
+            fArgInfos[argidx].ArgType := TArgType.Stack;
+            case td^.FloatType of
+              ftSingle:
+                ;
+              ftCurr,
+              ftComp,
+              ftDouble:
+                fArgInfos[argidx].Slots := 2;
+              ftExtended:
+                fArgInfos[argidx].Slots := 3;
+            end;
+          end;
+        else
+          raise EInvocationError.CreateFmt(SErrFailedToConvertArg, [idx, fArgs[idx].ParamType^.Name]);
+        end;
+      end;
+
+      { ignore stack arguments in first pass }
+      if (pass = 0) and (fArgInfos[argidx].ArgType = TArgType.Stack) then begin
+        stackargs[stackcount] := idx;
+        Inc(stackcount);
+        Continue;
+      end;
+
+      if fArgInfos[argidx].ArgType = TArgType.GenReg then begin
+        fArgInfos[argidx].ArgIdx := idx;
+        fArgInfos[argidx].Offset := genofs;
+        Inc(genofs);
+      end else if fArgInfos[argidx].ArgType = TArgType.Stack then begin
+        fArgInfos[argidx].ArgIdx := idx;
+        fArgInfos[argidx].Offset := stackofs;
+        Inc(stackofs, fArgInfos[argidx].Slots);
+      end;
+
+      Inc(argidx);
+    end;
+  end;
+end;
+
+function TSystemFunctionCallback.GetCodeAddress: CodePointer;
+begin
+  Result := fData;
+end;
+
+constructor TSystemFunctionCallback.Create(aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+
+  function CallConvName: String; inline;
+  begin
+    WriteStr(Result, aCallConv);
+  end;
+
+var
+  i: SizeInt;
+begin
+  if not (aCallConv in [ccReg]) then
+    raise ENotImplemented.CreateFmt(SErrCallConvNotSupported, [CallConvName]);
+  fContext := aContext;
+  SetLength(fArgs, Length(aArgs));
+  for i := 0 to High(aArgs) do
+    fArgs[i] := aArgs[i];
+  fResultType := aResultType;
+  fFlags := aFlags;
+  CreateArgInfos;
+  CreateCallback;
+end;
+
+destructor TSystemFunctionCallback.Destroy;
+begin
+  if Assigned(fData) then
+    FreeMemory(fData, fSize);
+end;
+
+constructor TSystemFunctionCallbackProc.Create(aHandler: TFunctionCallProc; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+begin
+  inherited Create(aContext, aCallConv, aArgs, aResultType, aFlags);
+  fHandler := aHandler;
+end;
+
+procedure TSystemFunctionCallbackProc.CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer);
+begin
+  fHandler(aArgs, aResult, aContext);
+end;
+
+constructor TSystemFunctionCallbackMethod.Create(aHandler: TFunctionCallMethod; aContext: Pointer; aCallConv: TCallConv; constref aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags);
+begin
+  inherited Create(aContext, aCallConv, aArgs, aResultType, aFlags);
+  fHandler := aHandler;
+end;
+
+procedure TSystemFunctionCallbackMethod.CallHandler(constref aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer);
+begin
+  fHandler(aArgs, aResult, aContext);
+end;
+
+function SystemCreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
+begin
+  Result := TSystemFunctionCallbackProc.Create(aHandler, aContext, aCallConv, aArgs, aResultType, aFlags);
+end;
+
+function SystemCreateCallbackMethod(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
+begin
+  Result := TSystemFunctionCallbackMethod.Create(aHandler, aContext, aCallConv, aArgs, aResultType, aFlags);
+end;
+
 const
   SystemFunctionCallManager: TFunctionCallManager = (
     Invoke: @SystemInvoke;
-    CreateCallbackProc: Nil;
-    CreateCallbackMethod: Nil;
+    CreateCallbackProc: @SystemCreateCallbackProc;
+    CreateCallbackMethod: @SystemCreateCallbackMethod;
   );
 
 procedure InitSystemFunctionCallManager;

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

@@ -120,6 +120,7 @@ type
     { Note: a TValue based on an open array is only valid until the routine having the open array parameter is left! }
     generic class function FromOpenArray<T>(constref aValue: array of T): TValue; static; inline;
 {$endif}
+    class function FromOrdinal(aTypeInfo: PTypeInfo; aValue: Int64): TValue; static; {inline;}
     function IsArray: boolean; inline;
     function IsOpenArray: Boolean; inline;
     function AsString: string; inline;
@@ -399,6 +400,7 @@ type
   TRttiMethod = class(TRttiMember)
   private
     FString: String;
+    function GetFlags: TFunctionCallFlags;
   protected
     function GetCallingConvention: TCallConv; virtual; abstract;
     function GetCodeAddress: CodePointer; virtual; abstract;
@@ -429,6 +431,9 @@ type
     function Invoke(aInstance: TObject; const aArgs: array of TValue): TValue;
     function Invoke(aInstance: TClass; const aArgs: array of TValue): TValue;
     function Invoke(aInstance: TValue; const aArgs: array of TValue): TValue;
+    { Note: once "reference to" is supported these will be replaced by a single method }
+    function CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackMethod): TMethodImplementation;
+    function CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackProc): TMethodImplementation;
   end;
 
   TRttiStructuredType = class(TRttiType)
@@ -481,9 +486,10 @@ type
     property DeclaringUnitName: string read GetDeclaringUnitName;
   end;
 
-  EInsufficientRtti = class(Exception);
-  EInvocationError = class(Exception);
-  ENonPublicType = class(Exception);
+  ERtti = class(Exception);
+  EInsufficientRtti = class(ERtti);
+  EInvocationError = class(ERtti);
+  ENonPublicType = class(ERtti);
 
   TFunctionCallParameter = record
     ValueRef: Pointer;
@@ -534,7 +540,8 @@ 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';
+  SErrMethodImplCreateFailed  = 'Failed to create method implementation';
+  SErrCallbackNotImplemented = 'Callback functionality is not implemented';
   SErrCallConvNotSupported = 'Calling convention not supported: %s';
   SErrTypeKindNotSupported = 'Type kind is not supported: %s';
   SErrCallbackHandlerNil = 'Callback handler is Nil';
@@ -545,6 +552,9 @@ implementation
 uses
 {$ifdef windows}
   Windows,
+{$endif}
+{$ifdef unix}
+  BaseUnix,
 {$endif}
   fgl;
 
@@ -697,7 +707,6 @@ resourcestring
   SErrInvokeCallableNotMethod = 'The callable value is not a method variable for: %s';
   SErrMethodImplNoCallback    = 'No callback specified for method implementation';
   SErrMethodImplInsufficientRtti = 'Insufficient RTTI to create method implementation';
-  SErrMethodImplCreateFailed  = 'Failed to create method implementation';
   SErrMethodImplCreateNoArg   = 'TMethodImplementation can not be created this way';
 
 var
@@ -709,8 +718,10 @@ function AllocateMemory(aSize: PtrUInt): Pointer;
 begin
 {$IF DEFINED(WINDOWS)}
   Result := VirtualAlloc(Nil, aSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
+{$ELSEIF DEFINED(UNIX)}
+  Result := fpmmap(Nil, aSize, PROT_READ or PROT_WRITE, MAP_PRIVATE or MAP_ANONYMOUS, 0, 0);
 {$ELSE}
-  Result := GetMem(aSize);
+  Result := Nil;
 {$ENDIF}
 end;
 
@@ -725,17 +736,24 @@ begin
     Result := VirtualProtect(aPtr, aSize, PAGE_EXECUTE_READ, oldprot)
   else
     Result := VirtualProtect(aPtr, aSize, PAGE_READWRITE, oldprot);
+{$ELSEIF DEFINED(UNIX)}
+  if aExecutable then
+    Result := Fpmprotect(aPtr, aSize, PROT_EXEC or PROT_READ) = 0
+  else
+    Result := Fpmprotect(aPtr, aSize, PROT_READ or PROT_WRITE) = 0;
 {$ELSE}
-  Result := True;
+  Result := False;
 {$ENDIF}
 end;
 
-procedure FreeMemory(aPtr: Pointer);
+procedure FreeMemory(aPtr: Pointer; aSize: PtrUInt);
 begin
 {$IF DEFINED(WINDOWS)}
   VirtualFree(aPtr, 0, MEM_RELEASE);
+{$ELSEIF DEFINED(UNIX)}
+  fpmunmap(aPtr, aSize);
 {$ELSE}
-  FreeMem(aPtr);
+  { nothing }
 {$ENDIF}
 end;
 
@@ -753,13 +771,13 @@ end;
 function NoCreateCallbackProc(aFunc: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
 begin
   Result := Nil;
-  raise ENotImplemented.Create(SErrCallbackNotImplented);
+  raise ENotImplemented.Create(SErrCallbackNotImplemented);
 end;
 
 function NoCreateCallbackMethod(aFunc: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
 begin
   Result := Nil;
-  raise ENotImplemented.Create(SErrCallbackNotImplented);
+  raise ENotImplemented.Create(SErrCallbackNotImplemented);
 end;
 
 const
@@ -1319,6 +1337,9 @@ begin
                        raise Exception.CreateFmt(SErrUnableToGetValueForType,[ATypeInfo^.Name]);
                    end;
                  end;
+    tkChar,
+    tkWChar,
+    tkUChar,
     tkEnumeration,
     tkInteger  : begin
                    case GetTypeData(ATypeInfo)^.OrdType of
@@ -1385,7 +1406,7 @@ end;
 {$ifndef NoGenericMethods}
 generic class function TValue.From<T>(constref aValue: T): TValue;
 begin
-  TValue.Make(@aValue, System.TypeInfo(T), Result);
+  TValue.Make(@aValue, PTypeInfo(System.TypeInfo(T)), Result);
 end;
 
 generic class function TValue.FromOpenArray<T>(constref aValue: array of T): TValue;
@@ -1396,10 +1417,19 @@ begin
     arrdata := @aValue[0]
   else
     arrdata := Nil;
-  TValue.MakeOpenArray(arrdata, Length(aValue), System.TypeInfo(aValue), Result);
+  TValue.MakeOpenArray(arrdata, Length(aValue), PTypeInfo(System.TypeInfo(aValue)), Result);
 end;
 {$endif}
 
+class function TValue.FromOrdinal(aTypeInfo: PTypeInfo; aValue: Int64): TValue;
+begin
+  if not Assigned(aTypeInfo) or
+      not (aTypeInfo^.Kind in [tkInteger, tkInt64, tkQWord, tkEnumeration, tkBool, tkChar, tkWChar, tkUChar]) then
+    raise EInvalidCast.Create(SErrInvalidTypecast);
+
+  TValue.Make(@aValue, aTypeInfo, Result);
+end;
+
 function TValue.GetIsEmpty: boolean;
 begin
   result := (FData.FTypeInfo=nil) or
@@ -1496,7 +1526,7 @@ end;
 
 function TValue.IsOrdinal: boolean;
 begin
-  result := (Kind in [tkInteger, tkInt64, tkQWord, tkBool]) or
+  result := (Kind in [tkInteger, tkInt64, tkQWord, tkBool, tkEnumeration, tkChar, tkWChar, tkUChar]) or
             ((Kind in [tkClass, tkClassRef, tkInterfaceRaw, tkUnknown]) and not Assigned(FData.FAsPointer));
 end;
 
@@ -1642,6 +1672,9 @@ begin
     tkQWord   : result := IntToStr(AsUInt64);
     tkInt64   : result := IntToStr(AsInt64);
     tkBool    : result := BoolToStr(AsBoolean, True);
+    tkPointer : result := '(pointer @ ' + HexStr(FData.FAsPointer) + ')';
+    tkInterface : result := '(interface @ ' + HexStr(PPointer(FData.FValueData.GetReferenceToRawData)^) + ')';
+    tkInterfaceRaw : result := '(raw interface @ ' + HexStr(FData.FAsPointer) + ')';
   else
     result := '';
   end;
@@ -1984,7 +2017,7 @@ begin
         if Assigned(aArgs[unhidden].TypeInfo) and not aArgs[unhidden].IsArray and (aArgs[unhidden].Kind <> param.ParamType.TypeKind) then
           raise EInvocationError.CreateFmt(SErrInvokeArrayArgExpected, [param.Name, aName]);
       end else if not (pfHidden in param.Flags) then begin
-        if aArgs[unhidden].Kind <> param.ParamType.TypeKind then
+        if Assigned(param.ParamType) and (aArgs[unhidden].Kind <> param.ParamType.TypeKind) then
           raise EInvocationError.CreateFmt(SErrInvokeArgInvalidType, [param.Name, aName]);
       end;
     end;
@@ -2014,7 +2047,10 @@ begin
 
   for i := 0 to High(aParams) do begin
     param := aParams[i];
-    args[i].Info.ParamType := param.ParamType.FTypeInfo;
+    if Assigned(param.ParamType) then
+      args[i].Info.ParamType := param.ParamType.FTypeInfo
+    else
+      args[i].Info.ParamType := Nil;
     args[i].Info.ParamFlags := param.Flags;
     args[i].Info.ParaLocs := Nil;
 
@@ -2063,7 +2099,7 @@ end;
 function CreateCallbackProc(aHandler: TFunctionCallProc; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
 begin
   if not Assigned(FuncCallMgr[aCallConv].CreateCallbackProc) then
-    raise ENotImplemented.Create(SErrCallbackNotImplented);
+    raise ENotImplemented.Create(SErrCallbackNotImplemented);
 
   if not Assigned(aHandler) then
     raise EArgumentNilException.Create(SErrCallbackHandlerNil);
@@ -2074,7 +2110,7 @@ end;
 function CreateCallbackMethod(aHandler: TFunctionCallMethod; aCallConv: TCallConv; aArgs: array of TFunctionCallParameterInfo; aResultType: PTypeInfo; aFlags: TFunctionCallFlags; aContext: Pointer): TFunctionCallCallback;
 begin
   if not Assigned(FuncCallMgr[aCallConv].CreateCallbackMethod) then
-    raise ENotImplemented.Create(SErrCallbackNotImplented);
+    raise ENotImplemented.Create(SErrCallbackNotImplemented);
 
   if not Assigned(aHandler) then
     raise EArgumentNilException.Create(SErrCallbackHandlerNil);
@@ -2535,7 +2571,10 @@ begin
       Assert((i < Length(fArgs)) and (pfHigh in fArgs[i].ParamFlags), 'Expected high parameter after open array parameter');
       TValue.MakeOpenArray(aArgs[i - 1], SizeInt(aArgs[i]), fArgs[i].ParamType, args[argidx]);
     end else if not (pfHidden in fArgs[i].ParamFlags) or (pfSelf in fArgs[i].ParamFlags) then begin
-      TValue.Make(aArgs[i], fArgs[i].ParamType, args[argidx]);
+      if Assigned(fArgs[i].ParamType) then
+        TValue.Make(aArgs[i], fArgs[i].ParamType, args[argidx])
+      else
+        TValue.Make(@aArgs[i], TypeInfo(Pointer), args[argidx]);
     end;
 
     Inc(i);
@@ -2600,6 +2639,13 @@ begin
   Result := False;
 end;
 
+function TRttiMethod.GetFlags: TFunctionCallFlags;
+begin
+  Result := [];
+  if IsStatic then
+    Include(Result, fcfStatic);
+end;
+
 function TRttiMethod.GetParameters: specialize TArray<TRttiParameter>;
 begin
   Result := GetParameters(False);
@@ -2704,6 +2750,76 @@ begin
   Result := Rtti.Invoke(Name, addr, CallingConvention, IsStatic, aInstance, aArgs, GetParameters(True), ReturnType);
 end;
 
+function TRttiMethod.CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackMethod): TMethodImplementation;
+var
+  params: specialize TArray<TRttiParameter>;
+  args: specialize TArray<TFunctionCallParameterInfo>;
+  res: PTypeInfo;
+  restype: TRttiType;
+  resinparam: Boolean;
+  i: SizeInt;
+begin
+  if not Assigned(aCallback) then
+    raise EArgumentNilException.Create(SErrMethodImplNoCallback);
+
+  resinparam := False;
+  params := GetParameters(True);
+  SetLength(args, Length(params));
+  for i := 0 to High(params) do begin
+    if Assigned(params[i].ParamType) then
+      args[i].ParamType := params[i].ParamType.FTypeInfo
+    else
+      args[i].ParamType := Nil;
+    args[i].ParamFlags := params[i].Flags;
+    args[i].ParaLocs := Nil;
+    if pfResult in params[i].Flags then
+      resinparam := True;
+  end;
+
+  restype := GetReturnType;
+  if Assigned(restype) and not resinparam then
+    res := restype.FTypeInfo
+  else
+    res := Nil;
+
+  Result := TMethodImplementation.Create(GetCallingConvention, args, res, GetFlags, aUserData, aCallback);
+end;
+
+function TRttiMethod.CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackProc): TMethodImplementation;
+var
+  params: specialize TArray<TRttiParameter>;
+  args: specialize TArray<TFunctionCallParameterInfo>;
+  res: PTypeInfo;
+  restype: TRttiType;
+  resinparam: Boolean;
+  i: SizeInt;
+begin
+  if not Assigned(aCallback) then
+    raise EArgumentNilException.Create(SErrMethodImplNoCallback);
+
+  resinparam := False;
+  params := GetParameters(True);
+  SetLength(args, Length(params));
+  for i := 0 to High(params) do begin
+    if Assigned(params[i].ParamType) then
+      args[i].ParamType := params[i].ParamType.FTypeInfo
+    else
+      args[i].ParamType := Nil;
+    args[i].ParamFlags := params[i].Flags;
+    args[i].ParaLocs := Nil;
+    if pfResult in params[i].Flags then
+      resinparam := True;
+  end;
+
+  restype := GetReturnType;
+  if Assigned(restype) and not resinparam then
+    res := restype.FTypeInfo
+  else
+    res := Nil;
+
+  Result := TMethodImplementation.Create(GetCallingConvention, args, res, GetFlags, aUserData, aCallback);
+end;
+
 { TRttiInvokableType }
 
 function TRttiInvokableType.GetParameters: specialize TArray<TRttiParameter>;
@@ -2727,7 +2843,10 @@ begin
   params := GetParameters(True);
   SetLength(args, Length(params));
   for i := 0 to High(params) do begin
-    args[i].ParamType := params[i].ParamType.FTypeInfo;
+    if Assigned(params[i].ParamType) then
+      args[i].ParamType := params[i].ParamType.FTypeInfo
+    else
+      args[i].ParamType := Nil;
     args[i].ParamFlags := params[i].Flags;
     args[i].ParaLocs := Nil;
     if pfResult in params[i].Flags then
@@ -2759,7 +2878,10 @@ begin
   params := GetParameters(True);
   SetLength(args, Length(params));
   for i := 0 to High(params) do begin
-    args[i].ParamType := params[i].ParamType.FTypeInfo;
+    if Assigned(params[i].ParamType) then
+      args[i].ParamType := params[i].ParamType.FTypeInfo
+    else
+      args[i].ParamType := Nil;
     args[i].ParamFlags := params[i].Flags;
     args[i].ParaLocs := Nil;
     if pfResult in params[i].Flags then
@@ -2794,6 +2916,7 @@ var
   total, visible, i: SizeInt;
   ptr: PByte;
   paramtypes: PPPTypeInfo;
+  paramtype: PTypeInfo;
   context: TRttiContext;
   obj: TRttiObject;
 begin
@@ -2850,7 +2973,11 @@ begin
         if Assigned(obj) then
           FParamsAll[i] := obj as TRttiMethodTypeParameter
         else begin
-          FParamsAll[i] := TRttiMethodTypeParameter.Create(infos[i].Handle, infos[i].Name, infos[i].Flags, paramtypes[i]^);
+          if Assigned(paramtypes[i]) then
+            paramtype := paramtypes[i]^
+          else
+            paramtype := Nil;
+          FParamsAll[i] := TRttiMethodTypeParameter.Create(infos[i].Handle, infos[i].Name, infos[i].Flags, paramtype);
           context.AddObject(FParamsAll[i]);
         end;
 

packages/rtl-objpas/src/x86_64/invoke.inc

@@ -125,12 +125,6 @@ end;
 
 procedure SystemInvoke(aCodeAddress: CodePointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
             aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
-type
-  PBoolean16 = ^Boolean16;
-  PBoolean32 = ^Boolean32;
-  PBoolean64 = ^Boolean64;
-  PByteBool = ^ByteBool;
-  PQWordBool = ^QWordBool;
 var
   stackarea: array of PtrUInt;
   stackptr: Pointer;
@@ -165,6 +159,8 @@ begin
       val := PtrUInt(aArgs[i].ValueRef)
     else if aArgs[i].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
       val := PtrUInt(aArgs[i].ValueRef)
+    else if (pfConst in aArgs[i].Info.ParamFlags) and not Assigned(aArgs[i].Info.ParamType) then
+      val := PtrUInt(aArgs[i].ValueRef)
     else begin
       td := GetTypeData(aArgs[i].Info.ParamType);
       case aArgs[i].Info.ParamType^.Kind of
@@ -516,26 +512,15 @@ begin
 end;
 
 procedure TSystemFunctionCallback.CreateArgInfos;
-type
-  PBoolean16 = ^Boolean16;
-  PBoolean32 = ^Boolean32;
-  PBoolean64 = ^Boolean64;
-  PByteBool = ^ByteBool;
-  PQWordBool = ^QWordBool;
 var
-  stackarea: array of PtrUInt;
-  stackptr: Pointer;
-  regs: array[0..3] of PtrUInt;
   i, argidx, ofs: LongInt;
-  val: PtrUInt;
   td: PTypeData;
-  argcount, resreg, refargs: SizeInt;
+  argcount: SizeInt;
 begin
   fResultInParam := ReturnResultInParam(fResultType);
 
   ofs := 0;
   argidx := 0;
-  refargs := 0;
   argcount := Length(fArgs);
   if fResultInParam then begin
     if fcfStatic in fFlags then
@@ -564,6 +549,8 @@ begin
       fArgInfos[argidx].Deref := True
     else if fArgs[i].ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
       fArgInfos[argidx].Deref := True
+    else if (pfConst in fArgs[i].ParamFlags) and not Assigned(fArgs[i].ParamType) then
+      fArgInfos[argidx].Deref := True
     else begin
       td := GetTypeData(fArgs[i].ParamType);
       case fArgs[i].ParamType^.Kind of
@@ -667,7 +654,7 @@ destructor TSystemFunctionCallback.Destroy;
 begin
 {$ifdef windows}
   if Assigned(fData) then
-    FreeMemory(fData);
+    FreeMemory(fData, fSize);
 {$endif}
 end;
 

packages/rtl-objpas/tests/testrunner.rtlobjpas.pp

@@ -8,11 +8,14 @@ program testrunner.rtlobjpas;
 {.$define useffi}
 {$if defined(CPUX64) and defined(WINDOWS)}
 {$define testinvoke}
+{$define testimpl}
 {$elseif defined(CPUI386)}
 {$define testinvoke}
+{$define testimpl}
 {$else}
 {$ifdef useffi}
 {$define testinvoke}
+{$define testimpl}
 {$endif}
 {$endif}
 

packages/rtl-objpas/tests/tests.rtti.impl.pas

@@ -27,12 +27,17 @@ type
     OutputArgs: array of TValue;
     ResultValue: TValue;
     InOutMapping: array of SizeInt;
+    InputUntypedTypes: array of PTypeInfo;
+    InvokedMethodName: String;
 
+    procedure OnHandleIntfMethod(aMethod: TRttiMethod; const aArgs: TValueArray; out aResult: TValue);
+    procedure DoIntfImpl(aIntf: IInterface; aTypeInfo: PTypeInfo; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
 {$ifdef fpc}
     procedure OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue);
     procedure DoMethodImpl(aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
     procedure DoProcImpl(aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
 {$ifndef InLazIDE}
+    {$ifdef fpc}generic{$endif} procedure GenDoIntfImpl<T: IInterface>(aIntf: T; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
     {$ifdef fpc}generic{$endif} procedure GenDoMethodImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
     {$ifdef fpc}generic{$endif} procedure GenDoProcImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
 {$endif}
@@ -42,6 +47,7 @@ type
     procedure Status(const aMsg: String; const aArgs: array of const); inline;
 {$endif}
   published
+    procedure TestIntfMethods;
 {$ifdef fpc}
     procedure TestMethodVars;
     procedure TestProcVars;
@@ -51,6 +57,34 @@ type
 implementation
 
 type
+  {$push}
+  {$M+}
+  ITestInterface = interface
+    ['{1DE799BB-BEE9-405F-9AF3-D55DE978C793}']
+    procedure TestMethod1;
+    function  TestMethod2(aArg1: SizeInt): SizeInt;
+    procedure TestMethod3(aArg1: AnsiString);
+    procedure TestMethod4(aArg1: ShortString);
+    function  TestMethod5: AnsiString;
+    function  TestMethod6: ShortString;
+    procedure TestMethod7(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: SizeInt);
+    procedure TestMethod8(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: AnsiString);
+    procedure TestMethod9(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: ShortString);
+    procedure TestMethod10(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Single);
+    procedure TestMethod11(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Double);
+    procedure TestMethod12(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Extended);
+    procedure TestMethod13(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Comp);
+    procedure TestMethod14(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Currency);
+    function  TestMethod15(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
+    function  TestMethod16(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
+    function  TestMethod17(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
+    function  TestMethod18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
+    function  TestMethod19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
+    function  TestMethod20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
+    procedure TestMethod21(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+  end;
+  {$pop}
+
   TTestMethod1 = procedure of object;
   TTestMethod2 = function(aArg1: SizeInt): SizeInt of object;
   TTestMethod3 = procedure(aArg1: AnsiString) of object;
@@ -71,6 +105,7 @@ type
   TTestMethod18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended of object;
   TTestMethod19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp of object;
   TTestMethod20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency of object;
+  TTestMethod21 = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object;
 
   TTestProc1 = procedure;
   TTestProc2 = function(aArg1: SizeInt): SizeInt;
@@ -92,6 +127,7 @@ type
   TTestProc18 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
   TTestProc19 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
   TTestProc20 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
+  TTestProc21 = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
 
 const
   SingleArg1: Single = 1.23;
@@ -207,6 +243,110 @@ begin
 end;
 {$endif}
 
+procedure TTestImpl.OnHandleIntfMethod(aMethod: TRttiMethod; const aArgs: TValueArray; out aResult: TValue);
+var
+  selfofs, i: SizeInt;
+  name: String;
+begin
+  selfofs := 1;
+
+  Status('In Callback');
+  InvokedMethodName :=  aMethod.Name;
+  Status('Self: ' + HexStr(Self));
+  if Assigned(aMethod.ReturnType) then
+    aResult := CopyValue(ResultValue);
+  Status('Setting input args');
+  SetLength(InputArgs, Length(aArgs));
+  for i := 0 to High(aArgs) do begin
+    Status('Arg %d: %p %p', [i, aArgs[i].GetReferenceToRawData, PPointer(aArgs[i].GetReferenceToRawData)^]);
+    if Assigned(InputUntypedTypes[i]) then
+      TValue.Make(PPointer(aArgs[i].GetReferenceToRawData)^, InputUntypedTypes[i], InputArgs[i])
+    else
+      InputArgs[i] := CopyValue(aArgs[i]);
+  end;
+  Status('Setting output args');
+  { Note: account for Self }
+  for i := 0 to High(InOutMapping) do begin
+    Status('OutputArg %d -> Arg %d', [i, InOutMapping[i] + selfofs]);
+    { check input arg type? }
+    Move(OutputArgs[i].GetReferenceToRawData^, aArgs[InOutMapping[i] + selfofs].GetReferenceToRawData^, OutputArgs[i].DataSize);
+  end;
+  Status('Callback done');
+end;
+
+procedure TTestImpl.DoIntfImpl(aIntf: IInterface; aTypeInfo: PTypeInfo; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
+var
+  context: TRttiContext;
+  t: TRttiType;
+  instance, res: TValue;
+  method: TRttiMethod;
+  i: SizeInt;
+  input: array of TValue;
+  intf: TRttiInterfaceType;
+  mrec: TMethod;
+  name: String;
+  params: array of TRttiParameter;
+begin
+  name := 'TestMethod' + IntToStr(aIndex);
+
+  context := TRttiContext.Create;
+  try
+    t := context.GetType(aTypeInfo);
+    Check(t is TRttiInterfaceType, 'Not a interface type: ' + aTypeInfo^.Name);
+    intf := t as TRttiInterfaceType;
+
+    method := intf.GetMethod(name);
+    Check(Assigned(method), 'Method not found: ' + name);
+
+    Status('Executing method %s', [name]);
+
+    CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping');
+    Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args');
+
+    params := method.GetParameters;
+
+    TValue.Make(@aIntf, aTypeInfo, instance);
+
+    { arguments might be modified by Invoke (Note: Copy() does not uniquify the
+      IValueData of managed types) }
+    SetLength(input, Length(aInputArgs) + 1);
+    SetLength(InputUntypedTypes, Length(aInputArgs) + 1);
+    input[0] := instance;
+    InputUntypedTypes[0] := Nil;
+    for i := 0 to High(aInputArgs) do begin
+      input[i + 1] := CopyValue(aInputArgs[i]);
+      if not Assigned(params[i].ParamType) then
+        InputUntypedTypes[i + 1] := aInputArgs[i].TypeInfo
+      else
+        InputUntypedTypes[i + 1] := Nil;
+    end;
+
+    SetLength(InOutMapping, Length(aInOutMapping));
+    for i := 0 to High(InOutMapping) do
+      InOutMapping[i] := aInOutMapping[i];
+    SetLength(OutputArgs, Length(aOutputArgs));
+    for i := 0 to High(OutputArgs) do
+      OutputArgs[i] := CopyValue(aOutputArgs[i]);
+    ResultValue := aResult;
+
+    res := method.Invoke(instance, aInputArgs);
+    Status('After invoke');
+
+    CheckEquals(name, InvokedMethodName, 'Invoked method name differs for ' + name);
+    Check(EqualValues(ResultValue, res), 'Reported result value differs from returned for ' + name);
+    Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
+    CheckEquals(Length(input), Length(InputArgs), 'Count of input args differs for ' + name);
+    for i := 0 to High(input) do begin
+      Check(EqualValues(input[i], InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
+    end;
+    for i := 0 to High(aOutputArgs) do begin
+      Check(EqualValues(aOutputArgs[i], aInputArgs[InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
+    end;
+  finally
+    context.Free;
+  end;
+end;
+
 {$ifdef fpc}
 procedure TTestImpl.OnHandleInvokable(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out
   aResult: TValue);
@@ -227,7 +367,10 @@ begin
   SetLength(InputArgs, Length(aArgs));
   for i := 0 to High(aArgs) do begin
     Status('Arg %d: %p %p', [i, aArgs[i].GetReferenceToRawData, PPointer(aArgs[i].GetReferenceToRawData)^]);
-    InputArgs[i] := CopyValue(aArgs[i]);
+    if Assigned(InputUntypedTypes[i]) then
+      TValue.Make(PPointer(aArgs[i].GetReferenceToRawData)^, InputUntypedTypes[i], InputArgs[i])
+    else
+      InputArgs[i] := CopyValue(aArgs[i]);
   end;
   Status('Setting output args');
   { Note: account for Self }
@@ -251,6 +394,7 @@ var
   impl: TMethodImplementation;
   mrec: TMethod;
   name: String;
+  params: array of TRttiParameter;
 begin
   name := aTypeInfo^.Name;
 
@@ -266,14 +410,28 @@ begin
     CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping');
     Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args');
 
+    params := method.GetParameters;
+
     { arguments might be modified by Invoke (Note: Copy() does not uniquify the
       IValueData of managed types) }
     SetLength(input, Length(aInputArgs) + 1);
+    SetLength(InputUntypedTypes, Length(aInputArgs) + 1);
     input[0] := GetPointerValue(Self);
-    for i := 0 to High(aInputArgs) do
+    InputUntypedTypes[0] := Nil;
+    for i := 0 to High(aInputArgs) do begin
       input[i + 1] := CopyValue(aInputArgs[i]);
+      if not Assigned(params[i].ParamType) then
+        InputUntypedTypes[i + 1] := aInputArgs[i].TypeInfo
+      else
+        InputUntypedTypes[i + 1] := Nil;
+    end;
 
-    impl := method.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable);
+    try
+      impl := method.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable);
+    except
+      on e: ENotImplemented do
+        Exit;
+    end;
     CheckNotNull(impl, 'Method implementation is Nil');
 
     mrec.Data := Self;
@@ -318,6 +476,7 @@ var
   impl: TMethodImplementation;
   name: String;
   cp: CodePointer;
+  params: array of TRttiParameter;
 begin
   name := aTypeInfo^.Name;
 
@@ -333,13 +492,26 @@ begin
     CheckEquals(Length(aOutputArgs), Length(aInOutMapping), 'Invalid in/out mapping');
     Check(Length(aOutputArgs) <= Length(aInputArgs), 'Output args not part of input args');
 
+    params := proc.GetParameters;
+
     { arguments might be modified by Invoke (Note: Copy() does not uniquify the
       IValueData of managed types) }
     SetLength(input, Length(aInputArgs));
-    for i := 0 to High(aInputArgs) do
+    SetLength(InputUntypedTypes, Length(aInputArgs));
+    for i := 0 to High(aInputArgs) do begin
       input[i] := CopyValue(aInputArgs[i]);
+      if not Assigned(params[i].ParamType) then
+        InputUntypedTypes[i] := aInputArgs[i].TypeInfo
+      else
+        InputUntypedTypes[i] := Nil;
+    end;
 
-    impl := proc.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable);
+    try
+      impl := proc.CreateImplementation({$ifdef fpc}@{$endif}OnHandleInvokable);
+    except
+      on e: ENotImplemented do
+        Exit;
+    end;
     CheckNotNull(impl, 'Method implementation is Nil');
 
     cp := impl.CodeAddress;
@@ -373,6 +545,11 @@ end;
 {$endif}
 
 {$ifndef InLazIDE}
+{$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoIntfImpl<T>(aIntf: T; aIndex: LongInt; aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
+begin
+  DoIntfImpl(aIntf, TypeInfo(T), aIndex, aInputArgs, aOutputArgs, aInOutMapping, aResult);
+end;
+
 {$ifdef fpc}generic{$endif} procedure TTestImpl.GenDoMethodImpl<T>(aInputArgs, aOutputArgs: TValueArray; aInOutMapping: array of SizeInt; aResult: TValue);
 begin
   DoMethodImpl(TypeInfo(T), aInputArgs, aOutputArgs, aInOutMapping, aResult);
@@ -384,6 +561,128 @@ begin
 end;
 {$endif}
 
+procedure TTestImpl.TestIntfMethods;
+var
+  intf: ITestInterface;
+begin
+  try
+    intf := TVirtualInterface.Create(PTypeInfo(TypeInfo(ITestInterface)), {$ifdef fpc}@{$endif}OnHandleIntfMethod) as ITestInterface;
+  except
+    on e: ENotImplemented do
+      Exit;
+  end;
+  Check(Assigned(intf), 'ITestInterface instance is Nil');
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 1, [], [], [], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 2, [GetIntValue(42)], [], [], GetIntValue(21));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 3, [GetAnsiString('Hello World')], [], [], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 4, [GetShortString('Hello World')], [], [], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 5, [], [], [], GetAnsiString('Hello World'));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 6, [], [], [], GetShortString('Hello World'));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 7, [
+    GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
+  ], [
+    GetIntValue(5678), GetIntValue(6789)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 8, [
+    GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
+  ], [
+    GetAnsiString('Gamma'), GetAnsiString('Epsilon')
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 9, [
+    GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
+  ], [
+    GetShortString('Gamma'), GetShortString('Epsilon')
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 10, [
+    GetSingleValue(SingleArg1), GetSingleValue(SingleArg2In), GetSingleValue(0), GetSingleValue(SingleArg4)
+  ], [
+    GetSingleValue(SingleArg2Out), GetSingleValue(SingleArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 11, [
+    GetDoubleValue(DoubleArg1), GetDoubleValue(DoubleArg2In), GetDoubleValue(0), GetDoubleValue(DoubleArg4)
+  ], [
+    GetDoubleValue(DoubleArg2Out), GetDoubleValue(DoubleArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 12, [
+    GetExtendedValue(ExtendedArg1), GetExtendedValue(ExtendedArg2In), GetExtendedValue(0), GetExtendedValue(ExtendedArg4)
+  ], [
+    GetExtendedValue(ExtendedArg2Out), GetExtendedValue(ExtendedArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 13, [
+    GetCompValue(CompArg1), GetCompValue(CompArg2In), GetCompValue(0), GetCompValue(CompArg4)
+  ], [
+    GetCompValue(CompArg2Out), GetCompValue(CompArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 14, [
+    GetCurrencyValue(CurrencyArg1), GetCurrencyValue(CurrencyArg2In), GetCurrencyValue(0), GetCurrencyValue(CurrencyArg4)
+  ], [
+    GetCurrencyValue(CurrencyArg2Out), GetCurrencyValue(CurrencyArg3Out)
+  ], [1, 2], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 15, [
+    GetIntValue(1), GetIntValue(2), GetIntValue(3), GetIntValue(4), GetIntValue(5),
+    GetIntValue(6), GetIntValue(7), GetIntValue(8), GetIntValue(9), GetIntValue(10)
+  ], [], [], GetIntValue(11));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 16, [
+    GetSingleValue(SingleAddArg1), GetSingleValue(SingleAddArg2), GetSingleValue(SingleAddArg3), GetSingleValue(SingleAddArg4), GetSingleValue(SingleAddArg5),
+    GetSingleValue(SingleAddArg6), GetSingleValue(SingleAddArg7), GetSingleValue(SingleAddArg8), GetSingleValue(SingleAddArg9), GetSingleValue(SingleAddArg10)
+  ], [], [], GetSingleValue(SingleAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 17, [
+    GetDoubleValue(DoubleAddArg1), GetDoubleValue(DoubleAddArg2), GetDoubleValue(DoubleAddArg3), GetDoubleValue(DoubleAddArg4), GetDoubleValue(DoubleAddArg5),
+    GetDoubleValue(DoubleAddArg6), GetDoubleValue(DoubleAddArg7), GetDoubleValue(DoubleAddArg8), GetDoubleValue(DoubleAddArg9), GetDoubleValue(DoubleAddArg10)
+  ], [], [], GetDoubleValue(DoubleAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 18, [
+    GetExtendedValue(ExtendedAddArg1), GetExtendedValue(ExtendedAddArg2), GetExtendedValue(ExtendedAddArg3), GetExtendedValue(ExtendedAddArg4), GetExtendedValue(ExtendedAddArg5),
+    GetExtendedValue(ExtendedAddArg6), GetExtendedValue(ExtendedAddArg7), GetExtendedValue(ExtendedAddArg8), GetExtendedValue(ExtendedAddArg9), GetExtendedValue(ExtendedAddArg10)
+  ], [], [], GetExtendedValue(ExtendedAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 19, [
+    GetCompValue(CompAddArg1), GetCompValue(CompAddArg2), GetCompValue(CompAddArg3), GetCompValue(CompAddArg4), GetCompValue(CompAddArg5),
+    GetCompValue(CompAddArg6), GetCompValue(CompAddArg7), GetCompValue(CompAddArg8), GetCompValue(CompAddArg9), GetCompValue(CompAddArg10)
+  ], [], [], GetCompValue(CompAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 20, [
+    GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
+    GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
+  ], [], [], GetCurrencyValue(CurrencyAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [
+    GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
+  ], [
+    GetIntValue(5678), GetIntValue(6789)
+  ], [0, 1], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [
+    GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
+  ], [
+    GetAnsiString('Gamma'), GetAnsiString('Epsilon')
+  ], [0, 1], TValue.Empty);
+
+  { for some reason this fails, though it fails in Delphi as well :/ }
+  {{$ifdef fpc}specialize{$endif}GenDoIntfImpl<ITestInterface>(intf, 21, [
+    GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
+  ], [
+    GetShortString('Gamma'), GetShortString('Epsilon')
+  ], [0, 1], TValue.Empty);}
+end;
+
 {$ifdef fpc}
 procedure TTestImpl.TestMethodVars;
 begin
@@ -476,6 +775,25 @@ begin
     GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
     GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
   ], [], [], GetCurrencyValue(CurrencyAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
+    GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
+  ], [
+    GetIntValue(5678), GetIntValue(6789)
+  ], [0, 1], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
+    GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
+  ], [
+    GetAnsiString('Gamma'), GetAnsiString('Epsilon')
+  ], [0, 1], TValue.Empty);
+
+  { for some reason this fails, though it fails in Delphi as well :/ }
+  {{$ifdef fpc}specialize{$endif}GenDoMethodImpl<TTestMethod21>([
+    GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
+  ], [
+    GetShortString('Gamma'), GetShortString('Epsilon')
+  ], [0, 1], TValue.Empty);}
 end;
 
 procedure TTestImpl.TestProcVars;
@@ -569,6 +887,25 @@ begin
     GetCurrencyValue(CurrencyAddArg1), GetCurrencyValue(CurrencyAddArg2), GetCurrencyValue(CurrencyAddArg3), GetCurrencyValue(CurrencyAddArg4), GetCurrencyValue(CurrencyAddArg5),
     GetCurrencyValue(CurrencyAddArg6), GetCurrencyValue(CurrencyAddArg7), GetCurrencyValue(CurrencyAddArg8), GetCurrencyValue(CurrencyAddArg9), GetCurrencyValue(CurrencyAddArg10)
   ], [], [], GetCurrencyValue(CurrencyAddRes));
+
+  {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
+    GetIntValue(1234), GetIntValue(4321), GetIntValue(0), GetIntValue(9876)
+  ], [
+    GetIntValue(5678), GetIntValue(6789)
+  ], [0, 1], TValue.Empty);
+
+  {$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
+    GetAnsiString('Alpha'), GetAnsiString('Beta'), GetAnsiString(''), GetAnsiString('Delta')
+  ], [
+    GetAnsiString('Gamma'), GetAnsiString('Epsilon')
+  ], [0, 1], TValue.Empty);
+
+  { for some reason this fails, though it fails in Delphi as well :/ }
+  {{$ifdef fpc}specialize{$endif}GenDoProcImpl<TTestProc21>([
+    GetShortString('Alpha'), GetShortString('Beta'), GetShortString(''), GetShortString('Delta')
+  ], [
+    GetShortString('Gamma'), GetShortString('Epsilon')
+  ], [0, 1], TValue.Empty);}
 end;
 {$endif}
 

packages/rtl-objpas/tests/tests.rtti.invoke.pas

@@ -34,6 +34,7 @@ type
     procedure DoMethodInvoke(aInst: TObject; aMethod: TMethod; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
     procedure DoProcVarInvoke(aInst: TObject; aProc: CodePointer; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
     procedure DoProcInvoke(aInst: TObject; aProc: CodePointer; aTypeInfo: PTypeInfo; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
+    procedure DoUntypedInvoke(aInst: TObject; aProc: CodePointer; aMethod: TMethod; aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
 {$ifndef InLazIDE}
     {$ifdef fpc}generic{$endif} procedure GenDoMethodInvoke<T>(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
     {$ifdef fpc}generic{$endif} procedure GenDoProcvarInvoke<T>(aInst: TObject; aProc: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
@@ -65,6 +66,8 @@ type
 
     procedure TestProc;
     procedure TestProcRecs;
+
+    procedure TestUntyped;
   end;
 
 implementation
@@ -697,6 +700,8 @@ type
     function TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
     function TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
     function TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
+
+    procedure TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
   end;
   {$M-}
 
@@ -735,9 +740,13 @@ type
     function TestRecSize8(aArg1: TTestRecord8): TTestRecord8;
     function TestRecSize9(aArg1: TTestRecord9): TTestRecord9;
     function TestRecSize10(aArg1: TTestRecord10): TTestRecord10;
+
+    procedure TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
   public
     InputArgs: array of TValue;
     OutputArgs: array of TValue;
+    ExpectedArgs: array of TValue;
+    OutArgs: array of TValue;
     ResultValue: TValue;
     CalledMethod: SizeInt;
     InOutMapping: array of SizeInt;
@@ -783,6 +792,8 @@ type
   TMethodTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9 of object;
   TMethodTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10 of object;
 
+  TMethodTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4) of object;
+
   TProcVarTest1 = procedure;
   TProcVarTest2 = function: SizeInt;
   TProcVarTest3 = function(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
@@ -817,6 +828,8 @@ type
   TProcVarTestRecSize9 = function(aArg1: TTestRecord9): TTestRecord9;
   TProcVarTestRecSize10 = function(aArg1: TTestRecord10): TTestRecord10;
 
+  TProcVarTestUntyped = procedure(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+
 procedure TTestInterfaceClass.Test1;
 begin
   SetLength(InputArgs, 0);
@@ -1318,10 +1331,38 @@ begin
   CalledMethod := 10 or RecSizeMarker;
 end;
 
+procedure TTestInterfaceClass.TestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+begin
+  if Length(ExpectedArgs) <> 4 then
+    Exit;
+  if Length(OutArgs) <> 2 then
+    Exit;
+
+  SetLength(InputArgs, 4);
+  TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, InputArgs[0]);
+  TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, InputArgs[1]);
+  TValue.Make(@aArg3, ExpectedArgs[2].TypeInfo, InputArgs[2]);
+  TValue.Make(@aArg4, ExpectedArgs[3].TypeInfo, InputArgs[3]);
+
+  Move(PPointer(OutArgs[0].GetReferenceToRawData)^, aArg1, OutArgs[0].DataSize);
+  Move(PPointer(OutArgs[1].GetReferenceToRawData)^, aArg2, OutArgs[1].DataSize);
+
+  SetLength(OutputArgs, 2);
+  TValue.Make(@aArg1, ExpectedArgs[0].TypeInfo, OutputArgs[0]);
+  TValue.Make(@aArg2, ExpectedArgs[1].TypeInfo, OutputArgs[1]);
+  SetLength(InOutMapping, 2);
+  InOutMapping[0] := 0;
+  InOutMapping[1] := 1;
+
+  CalledMethod := -1;
+end;
+
 procedure TTestInterfaceClass.Reset;
 begin
   InputArgs := Nil;
   OutputArgs := Nil;
+  ExpectedArgs := Nil;
+  OutArgs := Nil;
   InOutMapping := Nil;
   ResultValue := TValue.Empty;
   CalledMethod := 0;
@@ -1487,6 +1528,11 @@ begin
   Result := TTestInterfaceClass.ProcVarRecInst.TestRecSize10(aArg1);
 end;
 
+procedure ProcTestUntyped(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+begin
+  TTestInterfaceClass.ProcVarInst.TestUntyped(aArg1, aArg2, aArg3, aArg4);
+end;
+
 procedure TTestInvoke.DoIntfInvoke(aIndex: SizeInt; aInputArgs,
   aOutputArgs: TValueArray; aResult: TValue);
 var
@@ -1718,6 +1764,89 @@ begin
   end;
 end;
 
+procedure TTestInvoke.DoUntypedInvoke(aInst: TObject; aProc: CodePointer;
+  aMethod: TMethod; aTypeInfo: PTypeInfo; aInputArgs, aOutputArgs: TValueArray;
+  aResult: TValue);
+var
+  cls: TTestInterfaceClass;
+  intf: ITestInterface;
+  name: String;
+  context: TRttiContext;
+  t: TRttiType;
+  callable, res: TValue;
+  proc: TRttiInvokableType;
+  method: TRttiMethod;
+  i: SizeInt;
+  input: array of TValue;
+begin
+  cls := aInst as TTestInterfaceClass;
+  cls.Reset;
+
+  name := 'TestUntyped';
+  TTestInterfaceClass.ProcVarInst := cls;
+
+  context := TRttiContext.Create;
+  try
+    method := Nil;
+    proc := Nil;
+    if Assigned(aProc) then begin
+      TValue.Make(@aProc, aTypeInfo, callable);
+
+      t := context.GetType(aTypeInfo);
+      Check(t is TRttiProcedureType, 'Not a procedure variable: ' + aTypeInfo^.Name);
+      proc := t as TRttiProcedureType;
+    end else if Assigned(aMethod.Code) then begin
+      TValue.Make(@aMethod, aTypeInfo, callable);
+
+      t := context.GetType(aTypeInfo);
+      Check(t is TRttiMethodType, 'Not a method variable: ' + aTypeInfo^.Name);
+      proc := t as TRttiMethodType;
+    end else begin
+      intf := cls;
+
+      TValue.Make(@intf, TypeInfo(intf), callable);
+
+      t := context.GetType(TypeInfo(ITestInterface));
+      method := t.GetMethod(name);
+      Check(Assigned(method), 'Method not found: ' + name);
+    end;
+
+    { arguments might be modified by Invoke (Note: Copy() does not uniquify the
+      IValueData of managed types) }
+    SetLength(input, Length(aInputArgs));
+    SetLength(cls.ExpectedArgs, Length(aInputArgs));
+    for i := 0 to High(input) do begin
+      input[i] := CopyValue(aInputArgs[i]);
+      cls.ExpectedArgs[i] := CopyValue(aInputArgs[i]);
+    end;
+    SetLength(cls.OutArgs, Length(aOutputArgs));
+    for i := 0 to High(cls.OutArgs) do begin
+      cls.OutArgs[i] := CopyValue(aOutputArgs[i]);
+    end;
+
+    if Assigned(proc) then
+      res := proc.Invoke(callable, aInputArgs)
+    else
+      res := method.Invoke(callable, aInputArgs);
+
+    CheckEquals(-1, cls.CalledMethod, 'Wrong method called for ' + name);
+    Check(EqualValues(cls.ResultValue, res), 'Reported result value differs from returned for ' + name);
+    Check(EqualValues(aResult, res), 'Expected result value differs from returned for ' + name);
+    CheckEquals(Length(aInputArgs), Length(cls.InputArgs), 'Count of input args differs for ' + name);
+    CheckEquals(Length(cls.OutputArgs), Length(cls.InOutMapping), 'Count of output args and in-out-mapping differs for ' + name);
+    CheckEquals(Length(aOutputArgs), Length(cls.OutputArgs), 'Count of output args differs for ' + name);
+    for i := 0 to High(aInputArgs) do begin
+      Check(EqualValues(input[i], cls.InputArgs[i]), Format('Input argument %d differs for %s', [i + 1, name]));
+    end;
+    for i := 0 to High(aOutputArgs) do begin
+      Check(EqualValues(aOutputArgs[i], cls.OutputArgs[i]), Format('Output argument %d differs for %s', [i + 1, name]));
+      Check(EqualValues(aOutputArgs[i], aInputArgs[cls.InOutMapping[i]]), Format('New output argument %d differs from expected output for %s', [i + 1, name]));
+    end;
+  finally
+    context.Free;
+  end;
+end;
+
 {$ifndef InLazIDE}
 {$ifdef fpc}generic{$endif} procedure TTestInvoke.GenDoMethodInvoke<T>(aInst: TObject; aMethod: T; aIndex: SizeInt; aInputArgs, aOutputArgs: TValueArray; aResult: TValue);
 begin
@@ -2380,6 +2509,96 @@ begin
   end;
 end;
 
+procedure TTestInvoke.TestUntyped;
+var
+  cls: TTestInterfaceClass;
+begin
+  cls := TTestInterfaceClass.Create;
+  try
+    cls._AddRef;
+
+    DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [
+      GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
+      ], [
+      GetIntValue($4321), GetIntValue($5678)
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, Default(TMethod), Nil, [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [
+      GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
+      ], [
+      GetIntValue($4321), GetIntValue($5678)
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, Nil, TMethod({$ifdef fpc}@{$endif}cls.TestUntyped), TypeInfo(TMethodTestUntyped), [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [
+      GetIntValue($1234), GetIntValue($4321), GetIntValue($8765), GetIntValue($5678)
+      ], [
+      GetIntValue($4321), GetIntValue($5678)
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<AnsiString>('StrOut')
+      ], TValue.Empty);
+
+    DoUntypedInvoke(cls, {$ifdef fpc}@{$endif}ProcTestUntyped, Default(TMethod), TypeInfo(TProcVarTestUntyped), [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str1'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str2'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str3'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('Str4')
+      ], [
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrVar'),
+      TValue.{$ifdef fpc}specialize{$endif}From<ShortString>('StrOut')
+      ], TValue.Empty);
+  finally
+    cls._Release;
+  end;
+end;
+
 begin
 {$ifdef fpc}
   RegisterTest(TTestInvoke);

packages/rtl-objpas/tests/tests.rtti.pas

@@ -60,6 +60,11 @@ type
     procedure TestMakeExtended;
     procedure TestMakeCurrency;
     procedure TestMakeComp;
+    procedure TestMakeEnum;
+    procedure TestMakeAnsiChar;
+    procedure TestMakeWideChar;
+
+    procedure TestFromOrdinal;
 
     procedure TestDataSize;
     procedure TestDataSizeEmpty;
@@ -78,6 +83,11 @@ type
 
     procedure TestProcVar;
     procedure TestMethod;
+  private
+    procedure MakeFromOrdinalTObject;
+    procedure MakeFromOrdinalSet;
+    procedure MakeFromOrdinalString;
+    procedure MakeFromOrdinalNil;
   end;
 
 implementation
@@ -665,6 +675,125 @@ begin
   CheckFalse(hadexcept, 'Had unsigned type conversion exception');
 end;
 
+procedure TTestCase1.TestMakeEnum;
+var
+  e: TTestEnum;
+  v: TValue;
+begin
+  e := te1;
+
+  TValue.Make(@e, TypeInfo(e), v);
+  Check(not v.IsClass);
+  Check(not v.IsArray);
+  Check(not v.IsEmpty);
+  Check(not v.IsOpenArray);
+  Check(not v.IsObject);
+  Check(v.IsOrdinal);
+
+  Check(v.GetReferenceToRawData <> @e);
+  Check(TTestEnum(v.AsOrdinal) = te1);
+end;
+
+procedure TTestCase1.TestMakeAnsiChar;
+var
+  c: AnsiChar;
+  v: TValue;
+begin
+  c := #20;
+
+  TValue.Make(@c, TypeInfo(c), v);
+  Check(not v.IsClass);
+  Check(not v.IsArray);
+  Check(not v.IsEmpty);
+  Check(not v.IsOpenArray);
+  Check(not v.IsObject);
+  Check(v.IsOrdinal);
+
+  Check(v.GetReferenceToRawData <> @c);
+  Check(AnsiChar(v.AsOrdinal) = #20);
+end;
+
+procedure TTestCase1.TestMakeWideChar;
+var
+  c: WideChar;
+  v: TValue;
+begin
+  c := #$1234;
+
+  TValue.Make(@c, TypeInfo(c), v);
+  Check(not v.IsClass);
+  Check(not v.IsArray);
+  Check(not v.IsEmpty);
+  Check(not v.IsOpenArray);
+  Check(not v.IsObject);
+  Check(v.IsOrdinal);
+
+  Check(v.GetReferenceToRawData <> @c);
+  Check(WideChar(v.AsOrdinal) = #$1234);
+end;
+
+procedure TTestCase1.MakeFromOrdinalTObject;
+begin
+  TValue.FromOrdinal(TypeInfo(TObject), 42);
+end;
+
+procedure TTestCase1.MakeFromOrdinalSet;
+begin
+  TValue.FromOrdinal(TypeInfo(TTestSet), 42);
+end;
+
+procedure TTestCase1.MakeFromOrdinalString;
+begin
+  TValue.FromOrdinal(TypeInfo(AnsiString), 42);
+end;
+
+procedure TTestCase1.MakeFromOrdinalNil;
+begin
+  TValue.FromOrdinal(Nil, 42);
+end;
+
+procedure TTestCase1.TestFromOrdinal;
+var
+  v: TValue;
+begin
+  v := TValue.FromOrdinal(TypeInfo(LongInt), 42);
+  Check(v.IsOrdinal);
+  CheckEquals(v.AsOrdinal, 42);
+
+  v := TValue.FromOrdinal(TypeInfo(Boolean), Ord(True));
+  Check(v.IsOrdinal);
+  CheckEquals(v.AsOrdinal, Ord(True));
+
+  v := TValue.FromOrdinal(TypeInfo(Int64), $1234123412341234);
+  Check(v.IsOrdinal);
+  CheckEquals(v.AsOrdinal, $1234123412341234);
+
+  v := TValue.FromOrdinal(TypeInfo(QWord), $1234123412341234);
+  Check(v.IsOrdinal);
+  CheckEquals(v.AsOrdinal, $1234123412341234);
+
+  v := TValue.FromOrdinal(TypeInfo(LongBool), Ord(True));
+  Check(v.IsOrdinal);
+  CheckEquals(v.AsOrdinal, Ord(True));
+
+  v := TValue.FromOrdinal(TypeInfo(TTestEnum), Ord(te1));
+  Check(v.IsOrdinal);
+  CheckEquals(v.AsOrdinal, Ord(te1));
+
+  v := TValue.FromOrdinal(TypeInfo(AnsiChar), Ord(#20));
+  Check(v.IsOrdinal);
+  CheckEquals(v.AsOrdinal, Ord(#20));
+
+  v := TValue.FromOrdinal(TypeInfo(WideChar), Ord(#$1234));
+  Check(v.IsOrdinal);
+  CheckEquals(v.AsOrdinal, Ord(#$1234));
+
+  CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalNil, EInvalidCast);
+  CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalTObject, EInvalidCast);
+  CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalSet, EInvalidCast);
+  CheckException({$ifdef fpc}@{$endif}MakeFromOrdinalString, EInvalidCast);
+end;
+
 procedure TTestCase1.TestGetIsReadable;
 var
   c: TRttiContext;

rtl/beos/ossysc.inc

@@ -789,6 +789,13 @@ begin
 end;
 
 
+Function Fpmprotect(start:pointer;len:size_t;prot:cint):cint; [public, alias : 'FPC_SYSC_MPROTECT'];
+begin
+  {$warning TODO BeOS Fpmprotect implementation}
+//  Fpmprotect:=do_syscall(syscall_nr_mprotect,TSysParam(start),TSysParam(len),TSysParam(prot));
+end;
+
+
 {
   Interface to Unix ioctl call.
   Performs various operations on the filedescriptor Handle.

rtl/bsd/ossysc.inc

@@ -470,6 +470,12 @@ begin
 end;
 
 
+Function Fpmprotect(start:pointer;len:size_t;prot:cint):cint; [public, alias : 'FPC_SYSC_MPROTECT'];
+begin
+  Fpmprotect:=do_syscall(syscall_nr_mprotect,TSysParam(start),TSysParam(len),TSysParam(prot));
+end;
+
+
 {
   Interface to Unix ioctl call.
   Performs various operations on the filedescriptor Handle.

rtl/inc/systemh.inc

@@ -552,8 +552,18 @@ Type
   PPCodePointer       = ^PCodePointer;
 
   PBoolean            = ^Boolean;
+
+{$IFNDEF VER3_0}
+  PBoolean8           = ^Boolean8;
+{$ENDIF VER3_0}
+  PBoolean16          = ^Boolean16;
+  PBoolean32          = ^Boolean32;
+  PBoolean64          = ^Boolean64;
+
+  PByteBool           = ^ByteBool;
   PWordBool           = ^WordBool;
   PLongBool           = ^LongBool;
+  PQWordBool          = ^QWordBool;
 
   PNativeInt 	      = ^NativeInt;
   PNativeUInt	      = ^NativeUint;

rtl/linux/ossysc.inc

@@ -599,6 +599,12 @@ begin
   Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(Adr),TSysParam(Len));
 end;
 
+
+Function Fpmprotect(adr:pointer;len:size_t;prot:cint):cint; [public, alias : 'FPC_SYSC_MPROTECT'];
+begin
+  Fpmprotect:=do_syscall(syscall_nr_mprotect,TSysParam(adr),TSysParam(len),TSysParam(prot));
+end;
+
 {
   Interface to Unix ioctl call.
   Performs various operations on the filedescriptor Handle.

rtl/unix/bunxh.inc

@@ -106,6 +106,7 @@ Type TGrpArr = Array [0..0] of TGid;            { C style array workarounds}
     Function  fpSetPriority(Which,Who,What:cint):cint;
     Function  Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; external name 'FPC_SYSC_MMAP';
     Function  Fpmunmap(start:pointer;len:size_t):cint;  external name 'FPC_SYSC_MUNMAP';
+    Function  Fpmprotect(start:pointer;len:size_t;prot:cint):cint; external name 'FPC_SYSC_MPROTECT';
 
     Function  FpGetEnv (name : pChar): pChar; external name 'FPC_SYSC_FPGETENVPCHAR';
     function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;

rtl/unix/oscdeclh.inc

@@ -156,6 +156,7 @@ const
     Function  fpSetPriority (Which,Who,What:cint):cint; cdecl; external clib name 'setpriority';
     function  fpmmap    (addr:pointer;len:size_t;prot:cint;flags:cint;fd:cint;ofs:off_t):pointer; cdecl; external clib name 'mmap'+suffix64bit;
     function  fpmunmap  (addr:pointer;len:size_t):cint; cdecl; external clib name 'munmap';
+    function  fpmprotect(addr:pointer;len:size_t;prot:cint):cint; cdecl; external clib name 'mprotect';
 
     function  fpgetenv  (name : pchar):pchar; cdecl; external clib name 'getenv';
 {$ifndef beos}

tests/test/tthlp27.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+program tthlp27;
+
+{$mode delphi}
+
+type
+  TLongIntHelper = record helper for LongInt
+    procedure Test;
+  end;
+
+procedure TLongIntHelper.Test;
+begin
+
+end;
+
+var
+  p: PLongInt;
+begin
+  p.Test;
+end.

tests/test/tthlp28.pp

@@ -0,0 +1,21 @@
+{ %NORUN }
+
+program tthlp28;
+
+{$mode delphi}
+
+type
+  TPLongIntHelper = record helper for PLongInt
+    procedure Test;
+  end;
+
+procedure TPLongIntHelper.Test;
+begin
+
+end;
+
+var
+  p: PLongInt;
+begin
+  p.Test;
+end.

tests/webtbs/tw35533.pp

@@ -0,0 +1,30 @@
+{ %NORUN }
+
+program tw35533;
+{$mode delphiunicode}
+
+type
+  TPointerHelper = record helper for pointer
+    function AsNativeUint: nativeuint;
+    function PCharLen: uint32;
+  end;
+
+function TPointerHelper.AsNativeUint: nativeuint;
+begin
+  Result := nativeuint(self);
+end;
+
+function TPointerHelper.PCharLen: uint32;
+begin
+  Result := 5; //- Just here to illustrate the issue.
+end;
+
+var
+  P: pointer;
+
+begin
+  P := @ParamStr(0); //- Just a nonsense pointer.
+  Writeln( P.AsNativeUInt );
+  Writeln( P.PCharLen );
+  Readln;
+end.