If you poke around enough in Delphi internals, you'll find something strange and apparently undocumented about TTypeInfo records generated by the compiler. If the PTypeInfo points to a TTypeInfo record at address X, at X - 4
you'll find the next 4 bytes describe a pointer to X. For example:
procedure test(info: PTypeInfo);
var
addr: cardinal;
ptr: PPointer;
begin
addr := cardinal(info);
writeln('addr: ', addr);
dec(addr, 4);
ptr := PPointer(addr);
addr := cardinal(ptr^);
writeln('addr: ', addr);
end;
Pass any legitimate PTypeInfo generated by the compiler into this routine, and it'll output the same address twice. I've poked around in TypInfo.pas a little, but I don't see anything that mentions this "identity pointer" or what it's there for. Does anyone know why this is there? This appears to be true in every version of Delphi from at least D3 to D2010.
It's very simple: packages and dynamic linking.
BPLs are DLLs. DLLs are linked up through tables being patched, rather than all the code in the EXE or DLL linking against the DLL being patched (which would do great harm to sharing of read-only memory between multiple processes). To prevent the need for a reference to TypeInfo(SomeType)
somewhere in the code, or typeinfo of an EXE or DLL, being modified when linking against the BPL, instead there's an indirection through the import table.
It's easy to see the difference when linking statically versus linking against a BPL in this program:
{$apptype console}
uses TypInfo, SysUtils;
type
TFoo = class(TObject);
var
x: PPTypeInfo;
begin
x := GetTypeData(TypeInfo(TFoo))^.ParentInfo;
Writeln(x^^.Name);
Writeln(Format('x %p', [x]));
Writeln(Format('x^ %p', [x^]));
end.
On my local machine, compiled with dcc32 test.pas
, it outputs:
TObject
x 00401B64
x^ 00401B68
But when compiled with the RTL package with dcc32 -LUrtl test.pas
, it outputs:
TObject
x 004051F0
x^ 40001DA4
Hopefully this clears it up.
Don't understand completely what is going on, but when you have a look at for example IsPublishedProp
in the TypInfo
unit, you'll see that it casts the ClassInfo of the instance as a pointer to a TypeInfo structure:
PTypeInfo(Instance.ClassInfo)
When you look at the ClassInfo method, it returns a simple pointer the value of which seems related to the vmt table:
Result := PPointer(Integer(Self) + vmtTypeInfo)^;
vmtTypeInfo
has a value of -72. Four bytes before that at -76 is vmtInitTable
. vmtTypeInfo is followed by FieldTable, MethodTable, DynamicTable etc.
the vmtInitTable value is used in for example TObject.CleanupInstance
and passed to _FinalizeRecord
as the pointer to the TypeInfo structure.
So the four bytes before the TypeInfo structure pointing to the TypeInfo structure seem to be there by design and part of the vmt structure.
Edit
As Mason rightly pointed out the above is a complete red herring (see comments). I am leaving the answer so others won't have to chase it down.
Update To avoid confusion over variables and their addresses, I have rewritten Mason's test procedure as follows:
procedure test(info: PTypeInfo);
begin
writeln('value of info : ', cardinal(info));
writeln('info - 4 : ', cardinal(info) - 4);
writeln('value 4 bytes before: ', cardinal(PPointer(cardinal(info)-4)^));
end;
and call it with the following information:
procedure TryRTTIStuff;
begin
writeln('TPersistent');
test(TypeInfo(TPersistent));
writeln('TTypeKind enumeration');
test(TypeInfo(TTypeKind));
writeln('Integer');
test(TypeInfo(Integer));
writeln('Nonsense');
test(PTypeInfo($420000));
end;
The first three produce the results that Mason describes. I only added an extra writeln to show the pointer value for the last writeln. The last call in TryRTTIStuff is to show that when you do not pass in a pointer to a valid TypeInfo structure, you do not get the same value on the first and third writeln's for the call.
No clue yet as to what is going on with the TypeInfo. Maybe we should ask Barry Kelly as he is the author of the new D2010 RTTI so should know a lot about the old one as well...
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With