no message

This commit is contained in:
florian 2004-12-27 15:55:32 +00:00
parent 5fb0678de2
commit e9676f56b8

View File

@ -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);