瀏覽代碼

+ add data records TInterfaceData for COM and TInterfaceRawData for raw interfaces that allow for easier access to data that's only accessible by using pointers (and keeping track of alignment) without further polluting TTypeData

git-svn-id: trunk@35339 -
svenbarth 8 年之前
父節點
當前提交
03715bd9a8
共有 1 個文件被更改,包括 84 次插入3 次删除
  1. 84 3
      rtl/objpas/typinfo.pp

+ 84 - 3
rtl/objpas/typinfo.pp

@@ -183,6 +183,8 @@ unit typinfo;
       PTypeInfo = ^TTypeInfo;
       PTypeInfo = ^TTypeInfo;
       PPTypeInfo = ^PTypeInfo;
       PPTypeInfo = ^PTypeInfo;
 
 
+      PPropData = ^TPropData;
+
 { Note: these are only for backwards compatibility. New type references should
 { Note: these are only for backwards compatibility. New type references should
         only use PPTypeInfo directly! }
         only use PPTypeInfo directly! }
 {$ifdef ver3_0}
 {$ifdef ver3_0}
@@ -278,6 +280,49 @@ unit typinfo;
         { ManagedFields: array[0..ManagedFieldCount - 1] of TInitManagedField ; }
         { ManagedFields: array[0..ManagedFieldCount - 1] of TInitManagedField ; }
       end;
       end;
 
 
+      PInterfaceData = ^TInterfaceData;
+      TInterfaceData =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+      private
+        function GetUnitName: ShortString; inline;
+        function GetPropertyTable: PPropData; inline;
+      public
+        Parent: PPTypeInfo;
+        Flags: TIntfFlagsBase;
+        GUID: TGUID;
+        property UnitName: ShortString read GetUnitName;
+        property PropertyTable: PPropData read GetPropertyTable;
+      private
+        UnitNameField: ShortString;
+        { PropertyTable: TPropData }
+      end;
+
+      PInterfaceRawData = ^TInterfaceRawData;
+      TInterfaceRawData =
+      {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
+      packed
+      {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
+      record
+      private
+        function GetUnitName: ShortString; inline;
+        function GetIIDStr: ShortString; inline;
+        function GetPropertyTable: PPropData; inline;
+      public
+        Parent: PPTypeInfo;
+        Flags : TIntfFlagsBase;
+        IID: TGUID;
+        property UnitName: ShortString read GetUnitName;
+        property IIDStr: ShortString read GetIIDStr;
+        property PropertyTable: PPropData read GetPropertyTable;
+      private
+        UnitNameField: ShortString;
+        { IIDStr: ShortString; }
+        { PropertyTable: TPropData }
+      end;
+
       PTypeData = ^TTypeData;
       PTypeData = ^TTypeData;
       TTypeData =
       TTypeData =
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -419,7 +464,7 @@ unit typinfo;
                IntfFlags : TIntfFlagsBase;
                IntfFlags : TIntfFlagsBase;
                GUID: TGUID;
                GUID: TGUID;
                IntfUnit: ShortString;
                IntfUnit: ShortString;
-               { here the properties follow as Word Count & array of TPropInfo }
+               { PropertyTable: TPropData }
               );
               );
             tkInterfaceRaw:
             tkInterfaceRaw:
               (
               (
@@ -428,7 +473,7 @@ unit typinfo;
                IID: TGUID;
                IID: TGUID;
                RawIntfUnit: ShortString;
                RawIntfUnit: ShortString;
                { IIDStr: ShortString; }
                { IIDStr: ShortString; }
-               { here the properties follow as Word Count & array of TPropInfo }
+               { PropertyTable: TPropData }
               );
               );
             tkArray:
             tkArray:
               (ArrayData: TArrayTypeData);
               (ArrayData: TArrayTypeData);
@@ -448,7 +493,6 @@ unit typinfo;
 
 
       PPropInfo = ^TPropInfo;
       PPropInfo = ^TPropInfo;
 
 
-      PPropData = ^TPropData;
       TPropData =
       TPropData =
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
       packed
       packed
@@ -2464,6 +2508,43 @@ begin
     end;
     end;
 end;
 end;
 
 
+{ TInterfaceData }
+
+function TInterfaceData.GetUnitName: ShortString;
+begin
+  Result := UnitNameField;
+end;
+
+function TInterfaceData.GetPropertyTable: PPropData;
+var
+  p: PByte;
+begin
+  p := PByte(@UnitNameField[0]) + SizeOf(UnitNameField[0]) + Length(UnitNameField);
+  Result := aligntoptr(p);
+end;
+
+{ TInterfaceRawData }
+
+function TInterfaceRawData.GetUnitName: ShortString;
+begin
+  Result := UnitNameField;
+end;
+
+function TInterfaceRawData.GetIIDStr: ShortString;
+begin
+  Result := PShortString(PByte(@UnitNameField[0]) + SizeOf(UnitNameField[0]) + Length(UnitNameField))^;
+end;
+
+function TInterfaceRawData.GetPropertyTable: PPropData;
+var
+  p: PByte;
+begin
+  p := PByte(@UnitNameField[0]) + SizeOf(UnitNameField[0]) + Length(UnitNameField);
+  p := p + SizeOf(p^) + p^;
+  Result := aligntoptr(p);
+end;
+
+
 { TTypeData }
 { TTypeData }
 
 
 function TTypeData.GetBaseType: PTypeInfo;
 function TTypeData.GetBaseType: PTypeInfo;