mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 20:09:27 +02:00
no message
This commit is contained in:
parent
5fb0678de2
commit
e9676f56b8
@ -4,9 +4,9 @@ program DumpClass;
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils;
|
Classes, SysUtils;
|
||||||
|
|
||||||
const
|
const
|
||||||
VMT_COUNT = 100;
|
VMT_COUNT = 100;
|
||||||
|
|
||||||
|
|
||||||
type
|
type
|
||||||
@ -20,32 +20,40 @@ type
|
|||||||
Entries: packed array[0..9999999] of TMethodNameTableEntry;
|
Entries: packed array[0..9999999] of TMethodNameTableEntry;
|
||||||
end;
|
end;
|
||||||
PMethodNameTable = ^TMethodNameTable;
|
PMethodNameTable = ^TMethodNameTable;
|
||||||
|
|
||||||
TPointerArray = packed array[0..9999999] of Pointer;
|
TPointerArray = packed array[0..9999999] of Pointer;
|
||||||
PPointerArray = ^TPointerArray;
|
PPointerArray = ^TPointerArray;
|
||||||
|
|
||||||
PFieldInfo = ^TFieldInfo;
|
PFieldInfo = ^TFieldInfo;
|
||||||
TFieldInfo = packed record
|
TFieldInfo = packed record
|
||||||
FieldOffset: LongWord;
|
FieldOffset: LongWord;
|
||||||
ClassTypeIndex: Word;
|
ClassTypeIndex: Word;
|
||||||
Name: ShortString;
|
Name: ShortString;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
PFieldClassTable = ^TFieldClassTable;
|
PFieldClassTable = ^TFieldClassTable;
|
||||||
TFieldClassTable = packed record
|
TFieldClassTable =
|
||||||
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
packed
|
||||||
|
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
record
|
||||||
Count: Word;
|
Count: Word;
|
||||||
Entries: array[Word] of TPersistentClass;
|
Entries: array[Word] of TPersistentClass;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
PFieldTable = ^TFieldTable;
|
PFieldTable = ^TFieldTable;
|
||||||
TFieldTable = packed record
|
TFieldTable =
|
||||||
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
packed
|
||||||
|
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||||
|
record
|
||||||
FieldCount: Word;
|
FieldCount: Word;
|
||||||
ClassTable: PFieldClassTable;
|
ClassTable: PFieldClassTable;
|
||||||
{ Fields: array[Word] of TFieldInfo; Elements have variant size! }
|
{ Fields: array[Word] of TFieldInfo; Elements have variant size! }
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$M+}
|
{$M+}
|
||||||
TMyTest = class(TObject)
|
TMyTest = class(TObject)
|
||||||
published
|
published
|
||||||
F1: TMyTest;
|
F1: TMyTest;
|
||||||
F2: TMyTest;
|
F2: TMyTest;
|
||||||
@ -55,7 +63,7 @@ type
|
|||||||
{$M-}
|
{$M-}
|
||||||
|
|
||||||
TMyTest2 = class(TMyTest)
|
TMyTest2 = class(TMyTest)
|
||||||
F3: TMyTest;
|
F3: TMyTest;
|
||||||
F4: TMyTest;
|
F4: TMyTest;
|
||||||
procedure P2; override;
|
procedure P2; override;
|
||||||
procedure P3; virtual;
|
procedure P3; virtual;
|
||||||
@ -65,28 +73,28 @@ type
|
|||||||
procedure P1; virtual;
|
procedure P1; virtual;
|
||||||
procedure P2; virtual;
|
procedure P2; virtual;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMyTest.P1;
|
procedure TMyTest.P1;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMyTest.P2;
|
procedure TMyTest.P2;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMyTest2.P2;
|
procedure TMyTest2.P2;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMyTest2.P3;
|
procedure TMyTest2.P3;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMyPersistent.P1;
|
procedure TMyPersistent.P1;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TMyPersistent.P2;
|
procedure TMyPersistent.P2;
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -100,7 +108,7 @@ var
|
|||||||
Indent: String;
|
Indent: String;
|
||||||
n, idx: Integer;
|
n, idx: Integer;
|
||||||
SearchAddr: Pointer;
|
SearchAddr: Pointer;
|
||||||
begin
|
begin
|
||||||
WriteLn('---------------------------------------------');
|
WriteLn('---------------------------------------------');
|
||||||
WriteLn('Dump of ', AClass.ClassName);
|
WriteLn('Dump of ', AClass.ClassName);
|
||||||
WriteLn('---------------------------------------------');
|
WriteLn('---------------------------------------------');
|
||||||
@ -109,7 +117,7 @@ begin
|
|||||||
begin
|
begin
|
||||||
WriteLn(Indent, 'Processing ', AClass.Classname);
|
WriteLn(Indent, 'Processing ', AClass.Classname);
|
||||||
Indent := Indent + ' ';
|
Indent := Indent + ' ';
|
||||||
|
|
||||||
//---
|
//---
|
||||||
Cmnt := PPointer(Pointer(AClass) + vmtMethodTable)^;
|
Cmnt := PPointer(Pointer(AClass) + vmtMethodTable)^;
|
||||||
if Cmnt <> nil
|
if Cmnt <> nil
|
||||||
@ -117,11 +125,11 @@ begin
|
|||||||
WriteLn(Indent, 'Method count: ', IntToStr(Cmnt^.Count));
|
WriteLn(Indent, 'Method count: ', IntToStr(Cmnt^.Count));
|
||||||
|
|
||||||
Cvmt := Pointer(AClass) + vmtMethodStart;
|
Cvmt := Pointer(AClass) + vmtMethodStart;
|
||||||
|
|
||||||
for n := 0 to Cmnt^.Count - 1 do
|
for n := 0 to Cmnt^.Count - 1 do
|
||||||
begin
|
begin
|
||||||
Write(Indent, 'Search: ', Cmnt^.Entries[n].Name^);
|
Write(Indent, 'Search: ', Cmnt^.Entries[n].Name^);
|
||||||
|
|
||||||
SearchAddr := Cmnt^.Entries[n].Addr;
|
SearchAddr := Cmnt^.Entries[n].Addr;
|
||||||
for idx := 0 to VMT_COUNT - 1 do
|
for idx := 0 to VMT_COUNT - 1 do
|
||||||
begin
|
begin
|
||||||
@ -135,11 +143,11 @@ begin
|
|||||||
WriteLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^, '" not found in "', AClass.ClassName, '"');
|
WriteLn('[WARNING] VMT entry "', Cmnt^.Entries[n].Name^, '" not found in "', AClass.ClassName, '"');
|
||||||
Break;
|
Break;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
//---
|
//---
|
||||||
Cft := PPointer(Pointer(AClass) + vmtFieldTable)^;
|
Cft := PPointer(Pointer(AClass) + vmtFieldTable)^;
|
||||||
if Cft <> nil
|
if Cft <> nil
|
||||||
@ -147,22 +155,26 @@ begin
|
|||||||
WriteLn(Indent, 'Field count: ', Cft^.FieldCount);
|
WriteLn(Indent, 'Field count: ', Cft^.FieldCount);
|
||||||
fi := @Cft^.ClassTable + SizeOf(Cft^.ClassTable);
|
fi := @Cft^.ClassTable + SizeOf(Cft^.ClassTable);
|
||||||
for n := 0 to Cft^.FieldCount - 1 do
|
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));
|
Move(fi^.FieldOffset, FieldOffset, SizeOf(FieldOffset));
|
||||||
WriteLn(Indent, ' ', n, ': ', fi^.Name, ' @', FieldOffset);
|
WriteLn(Indent, ' ', n, ': ', fi^.Name, ' @', FieldOffset);
|
||||||
fi := @fi^.name + 1 + Ord(fi^.name[0]);
|
fi := @fi^.name + 1 + Ord(fi^.name[0]);
|
||||||
end;
|
end;
|
||||||
WriteLn(Indent, 'Field class count: ', Cft^.ClassTable^.Count);
|
WriteLn(Indent, 'Field class count: ', Cft^.ClassTable^.Count);
|
||||||
for n := 0 to Cft^.ClassTable^.Count - 1 do
|
for n := 0 to Cft^.ClassTable^.Count - 1 do
|
||||||
begin
|
begin
|
||||||
WriteLn(Indent, ' ', n, ': ', Cft^.ClassTable^.Entries[n].ClassName);
|
WriteLn(Indent, ' ', n, ': ', Cft^.ClassTable^.Entries[n].ClassName);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
AClass := AClass.ClassParent;
|
AClass := AClass.ClassParent;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
ClassDump(TMyTest);
|
ClassDump(TMyTest);
|
||||||
ClassDump(TMyTest2);
|
ClassDump(TMyTest2);
|
||||||
|
Loading…
Reference in New Issue
Block a user