|
@@ -4,9 +4,9 @@ program DumpClass;
|
|
|
|
|
|
uses
|
|
|
Classes, SysUtils;
|
|
|
-
|
|
|
+
|
|
|
const
|
|
|
- VMT_COUNT = 100;
|
|
|
+ VMT_COUNT = 100;
|
|
|
|
|
|
|
|
|
type
|
|
@@ -20,32 +20,40 @@ type
|
|
|
Entries: packed array[0..9999999] of TMethodNameTableEntry;
|
|
|
end;
|
|
|
PMethodNameTable = ^TMethodNameTable;
|
|
|
-
|
|
|
+
|
|
|
TPointerArray = packed array[0..9999999] of Pointer;
|
|
|
PPointerArray = ^TPointerArray;
|
|
|
-
|
|
|
+
|
|
|
PFieldInfo = ^TFieldInfo;
|
|
|
TFieldInfo = packed record
|
|
|
FieldOffset: LongWord;
|
|
|
ClassTypeIndex: Word;
|
|
|
Name: ShortString;
|
|
|
end;
|
|
|
-
|
|
|
+
|
|
|
PFieldClassTable = ^TFieldClassTable;
|
|
|
- TFieldClassTable = packed record
|
|
|
+ TFieldClassTable =
|
|
|
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
|
+ packed
|
|
|
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
|
+ record
|
|
|
Count: Word;
|
|
|
Entries: array[Word] of TPersistentClass;
|
|
|
end;
|
|
|
|
|
|
PFieldTable = ^TFieldTable;
|
|
|
- TFieldTable = packed record
|
|
|
+ TFieldTable =
|
|
|
+{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
|
+ packed
|
|
|
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
|
+ record
|
|
|
FieldCount: Word;
|
|
|
ClassTable: PFieldClassTable;
|
|
|
{ Fields: array[Word] of TFieldInfo; Elements have variant size! }
|
|
|
end;
|
|
|
-
|
|
|
+
|
|
|
{$M+}
|
|
|
- TMyTest = class(TObject)
|
|
|
+ TMyTest = class(TObject)
|
|
|
published
|
|
|
F1: TMyTest;
|
|
|
F2: TMyTest;
|
|
@@ -55,7 +63,7 @@ type
|
|
|
{$M-}
|
|
|
|
|
|
TMyTest2 = class(TMyTest)
|
|
|
- F3: TMyTest;
|
|
|
+ F3: TMyTest;
|
|
|
F4: TMyTest;
|
|
|
procedure P2; override;
|
|
|
procedure P3; virtual;
|
|
@@ -65,28 +73,28 @@ type
|
|
|
procedure P1; virtual;
|
|
|
procedure P2; virtual;
|
|
|
end;
|
|
|
-
|
|
|
-procedure TMyTest.P1;
|
|
|
+
|
|
|
+procedure TMyTest.P1;
|
|
|
begin
|
|
|
end;
|
|
|
|
|
|
-procedure TMyTest.P2;
|
|
|
+procedure TMyTest.P2;
|
|
|
begin
|
|
|
end;
|
|
|
|
|
|
-procedure TMyTest2.P2;
|
|
|
+procedure TMyTest2.P2;
|
|
|
begin
|
|
|
end;
|
|
|
|
|
|
-procedure TMyTest2.P3;
|
|
|
+procedure TMyTest2.P3;
|
|
|
begin
|
|
|
end;
|
|
|
|
|
|
-procedure TMyPersistent.P1;
|
|
|
+procedure TMyPersistent.P1;
|
|
|
begin
|
|
|
end;
|
|
|
|
|
|
-procedure TMyPersistent.P2;
|
|
|
+procedure TMyPersistent.P2;
|
|
|
begin
|
|
|
end;
|
|
|
|
|
@@ -100,7 +108,7 @@ var
|
|
|
Indent: String;
|
|
|
n, idx: Integer;
|
|
|
SearchAddr: Pointer;
|
|
|
-begin
|
|
|
+begin
|
|
|
WriteLn('---------------------------------------------');
|
|
|
WriteLn('Dump of ', AClass.ClassName);
|
|
|
WriteLn('---------------------------------------------');
|
|
@@ -109,7 +117,7 @@ begin
|
|
|
begin
|
|
|
WriteLn(Indent, 'Processing ', AClass.Classname);
|
|
|
Indent := Indent + ' ';
|
|
|
-
|
|
|
+
|
|
|
//---
|
|
|
Cmnt := PPointer(Pointer(AClass) + vmtMethodTable)^;
|
|
|
if Cmnt <> nil
|
|
@@ -117,11 +125,11 @@ begin
|
|
|
WriteLn(Indent, 'Method count: ', IntToStr(Cmnt^.Count));
|
|
|
|
|
|
Cvmt := Pointer(AClass) + vmtMethodStart;
|
|
|
-
|
|
|
+
|
|
|
for n := 0 to Cmnt^.Count - 1 do
|
|
|
- begin
|
|
|
+ begin
|
|
|
Write(Indent, 'Search: ', Cmnt^.Entries[n].Name^);
|
|
|
-
|
|
|
+
|
|
|
SearchAddr := Cmnt^.Entries[n].Addr;
|
|
|
for idx := 0 to VMT_COUNT - 1 do
|
|
|
begin
|
|
@@ -135,11 +143,11 @@ begin
|
|
|
WriteLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^, '" not found in "', AClass.ClassName, '"');
|
|
|
Break;
|
|
|
end;
|
|
|
- end;
|
|
|
+ end;
|
|
|
end;
|
|
|
end;
|
|
|
-
|
|
|
-
|
|
|
+
|
|
|
+
|
|
|
//---
|
|
|
Cft := PPointer(Pointer(AClass) + vmtFieldTable)^;
|
|
|
if Cft <> nil
|
|
@@ -147,22 +155,26 @@ begin
|
|
|
WriteLn(Indent, 'Field count: ', Cft^.FieldCount);
|
|
|
fi := @Cft^.ClassTable + SizeOf(Cft^.ClassTable);
|
|
|
for n := 0 to Cft^.FieldCount - 1 do
|
|
|
- begin
|
|
|
+ begin
|
|
|
+{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
|
+ pointer(fi):=align(fi,sizeof(pointer));
|
|
|
+{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
|
+
|
|
|
Move(fi^.FieldOffset, FieldOffset, SizeOf(FieldOffset));
|
|
|
WriteLn(Indent, ' ', n, ': ', fi^.Name, ' @', FieldOffset);
|
|
|
fi := @fi^.name + 1 + Ord(fi^.name[0]);
|
|
|
end;
|
|
|
WriteLn(Indent, 'Field class count: ', Cft^.ClassTable^.Count);
|
|
|
for n := 0 to Cft^.ClassTable^.Count - 1 do
|
|
|
- begin
|
|
|
+ begin
|
|
|
WriteLn(Indent, ' ', n, ': ', Cft^.ClassTable^.Entries[n].ClassName);
|
|
|
end;
|
|
|
end;
|
|
|
-
|
|
|
+
|
|
|
AClass := AClass.ClassParent;
|
|
|
end;
|
|
|
end;
|
|
|
-
|
|
|
+
|
|
|
begin
|
|
|
ClassDump(TMyTest);
|
|
|
ClassDump(TMyTest2);
|