Browse Source

* Invoke helper definition, allow calling it

Michaël Van Canneyt 2 years ago
parent
commit
90f902c7d4
1 changed files with 73 additions and 0 deletions
  1. 73 0
      rtl/objpas/typinfo.pp

+ 73 - 0
rtl/objpas/typinfo.pp

@@ -131,6 +131,11 @@ unit TypInfo;
        );
        );
 {$pop}
 {$pop}
 
 
+{$IF FPC_FULLVERSION>=30301}
+{$DEFINE HAVE_INVOKEHELPER}
+{$DEFINE HAVE_HIDDENTHUNKCLASS}
+{$ENDIF}
+
 {$MINENUMSIZE DEFAULT}
 {$MINENUMSIZE DEFAULT}
 
 
    const
    const
@@ -143,6 +148,10 @@ unit TypInfo;
       TTypeKinds = set of TTypeKind;
       TTypeKinds = set of TTypeKind;
       ShortStringBase = string[255];
       ShortStringBase = string[255];
 
 
+      {$IFDEF HAVE_INVOKEHELPER}
+      TInvokeHelper = procedure(Instance : Pointer; Args : PPointer);
+      {$ENDIF}
+
       PParameterLocation = ^TParameterLocation;
       PParameterLocation = ^TParameterLocation;
       TParameterLocation =
       TParameterLocation =
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -378,6 +387,7 @@ unit TypInfo;
         property Next: PVmtMethodParam read GetNext;
         property Next: PVmtMethodParam read GetNext;
       end;
       end;
 
 
+
       PIntfMethodEntry = ^TIntfMethodEntry;
       PIntfMethodEntry = ^TIntfMethodEntry;
       TIntfMethodEntry =
       TIntfMethodEntry =
       {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
       {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -396,6 +406,9 @@ unit TypInfo;
         Kind: TMethodKind;
         Kind: TMethodKind;
         ParamCount: Word;
         ParamCount: Word;
         StackSize: SizeInt;
         StackSize: SizeInt;
+        {$IFDEF HAVE_INVOKEHELPER}
+        InvokeHelper : TInvokeHelper;
+        {$ENDIF}
         NamePtr: PShortString;
         NamePtr: PShortString;
         { Params: array[0..ParamCount - 1] of TVmtMethodParam }
         { Params: array[0..ParamCount - 1] of TVmtMethodParam }
         { ResultLocs: PParameterLocations (if ResultType != Nil) }
         { ResultLocs: PParameterLocations (if ResultType != Nil) }
@@ -515,7 +528,9 @@ unit TypInfo;
           Parent: PPTypeInfo;
           Parent: PPTypeInfo;
           Flags: TIntfFlagsBase;
           Flags: TIntfFlagsBase;
           GUID: TGUID;
           GUID: TGUID;
+          {$IFDEF HAVE_HIDDENTHUNKCLASS}
           ThunkClass : PPTypeInfo;
           ThunkClass : PPTypeInfo;
+          {$ENDIF}
           UnitNameField: ShortString;
           UnitNameField: ShortString;
           { PropertyTable: TPropData }
           { PropertyTable: TPropData }
           { MethodTable: TIntfMethodTable }
           { MethodTable: TIntfMethodTable }
@@ -556,7 +571,9 @@ unit TypInfo;
             Parent: PPTypeInfo;
             Parent: PPTypeInfo;
             Flags : TIntfFlagsBase;
             Flags : TIntfFlagsBase;
             IID: TGUID;
             IID: TGUID;
+            {$IFDEF HAVE_HIDDENTHUNKCLASS}
             ThunkClass : PPTypeInfo;
             ThunkClass : PPTypeInfo;
+            {$ENDIF}
             UnitNameField: ShortString;
             UnitNameField: ShortString;
             { IIDStr: ShortString; }
             { IIDStr: ShortString; }
             { PropertyTable: TPropData }
             { PropertyTable: TPropData }
@@ -981,6 +998,7 @@ function GetDynArrayProp(Instance: TObject; PropInfo: PPropInfo): Pointer;
 procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value: Pointer);
 procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value: Pointer);
 procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
 procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
 
 
+
 // Extended RTTI
 // Extended RTTI
 function GetAttributeTable(TypeInfo: PTypeInfo): PAttributeTable;
 function GetAttributeTable(TypeInfo: PTypeInfo): PAttributeTable;
 
 
@@ -988,6 +1006,10 @@ function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: Word): TCustomAttrib
 
 
 function GetAttribute(AttributeTable: PAttributeTable; AttributeNr: Word): TCustomAttribute;
 function GetAttribute(AttributeTable: PAttributeTable; AttributeNr: Word): TCustomAttribute;
 
 
+{$IFDEF HAVE_INVOKEHELPER}
+procedure CallInvokeHelper(aTypeInfo : PTypeInfo; Instance: Pointer; const aMethod : String; aArgs : PPointer);
+{$ENDIF}
+
 // Auxiliary routines, which may be useful
 // Auxiliary routines, which may be useful
 Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
 Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
 Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
 Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
@@ -3789,5 +3811,56 @@ begin
     end;
     end;
 end;
 end;
 
 
+{$IFDEF HAVE_INVOKEHELPER}
+procedure CallInvokeHelper(Instance: Pointer; aMethod : PIntfMethodEntry; aArgs : PPointer);
+
+begin
+  if (aMethod=Nil) then
+    Raise EArgumentNilException.Create('Cannot call invoke helper on nil method info');
+  if (aMethod^.InvokeHelper=Nil) then
+    Raise EArgumentException.CreateFmt('Method %s has no invoke helper.',[aMethod^.Name]);
+  aMethod^.InvokeHelper(Instance,aArgs);
+end;
+
+procedure CallInvokeHelper(aTypeInfo : PTypeInfo; Instance: Pointer; const aMethod : String; aArgs : PPointer);
+
+Var
+  Data : PInterfaceData;
+  DataR : PInterfaceRawData;
+  MethodTable : PIntfMethodTable;
+  MethodEntry : PIntfMethodEntry;
+  I : Integer;
+
+begin
+  If Instance=Nil then
+    Raise EArgumentNilException.Create('Cannot call invoke helper on nil instance');
+  if not (aTypeInfo^.Kind in [tkInterface,tkInterfaceRaw]) then
+    Raise EArgumentException.Create('Cannot call invoke helper non non-interfaces');
+  // Get method table
+  if (aTypeInfo^.Kind=tkInterface) then
+    begin
+    Data:=PInterfaceData(GetTypeData(aTypeInfo));
+    MethodTable:=Data^.MethodTable;
+    end
+  else
+    begin
+    DataR:=PInterfaceRawData(GetTypeData(aTypeInfo));
+    MethodTable:=DataR^.MethodTable;
+    end;
+  // Search method in method table
+  MethodEntry:=nil;
+  I:=MethodTable^.Count-1;
+  While (MethodEntry=Nil) and (I>=0) do
+    begin
+    MethodEntry:=MethodTable^.Method[i];
+    if not SameText(MethodEntry^.Name,aMethod) then
+      MethodEntry:=Nil;
+    Dec(I);
+    end;
+  if MethodEntry=Nil then
+    Raise EArgumentException.CreateFmt('Interface %s has no method %s.',[aTypeInfo^.Name,aMethod]);
+  CallInvokeHelper(Instance,MethodEntry,aArgs);
+end;
+{$ENDIF HAVE_INVOKEHELPER}
 
 
 end.
 end.