Nehmen wir mal an, ein (Delphi-)object, welches eine Liste gleicher Objekte verwalten soll. Man könnte das einen Baum nennen.
TValueList = array of TValue;
TValue = object
FList: TValueList;
SomeOtherStuff: integer;
end; |
TValueList = array of TValue;
TValue = object
FList: TValueList;
SomeOtherStuff: integer;
end;
(Für später geborene: das ist die alte Syntax für „record mit Methoden“.)
Leider nimmt uns der Compiler das so nicht ab. Warum? Weil TValue natürlich vorher noch nicht bekannt ist. Und im Gegensatz zu Klassen kann man Records nicht vorwärtsdeklarieren. Wie also könnten wir dieses Problem lösen? Man könnte Pointer verwenden, und bei Verwendung entsprechend erzeugen. Aber freigeben? Es gibt ja keinen Destructor, also keine Option. Man könnte das gesamte Objekt in eine Klassen-Instanz verwandeln, die von IUnknown die Referenzzählung erbt. Das ist aber wesentlich mehr Aufwand als das bisherige „Deklarieren und Verwenden“.
Die Lösung hier zeigt sich in einem fiesen, aber einfachen Hack:
TValueListAlias = array of boolean;
TValue = object
FList: TValueListAlias;
SomeOtherStuff: integer;
end;
TValueList = array of TValue; |
TValueListAlias = array of boolean;
TValue = object
FList: TValueListAlias;
SomeOtherStuff: integer;
end;
TValueList = array of TValue;
Dabei spielt es keine Rolle, welchen Basistypen man für das Alias verwendet. Es muss sich nur um ein dynamisches Array handeln. Jetzt kann man in jedem Zugriff auf das eigentliche TValueList casten und alles funktioniert. Dabei kann man die Hässlichkeiten wunderbar in Zugriffsmethoden verbergen.
SetLength(TValueList(FList), 42); |
SetLength(TValueList(FList), 42);
Das funktioniert auch, aber wenn TValue nun Felder die finialisiert werden müssen enthält, wird sich FastMM beschweren, dass eben diese nie freigegeben werden. Es stellt sich heraus, dass SetLength zwar den BaseType richtig speichert und auch in @DynArrayClear exakt diesen wieder beräumt, aber Felder im Gegensatz zu Variablen nicht damit, sondern mit FinalizeArray freigegeben werden. Und dieses richtet sich nach der Deklaration, nicht nach dem was wirklich passiert.
Hier kommt dann der eigentliche Grund für diesen Beitrag: wir sagen der RTL einfach: „Vertrau mir, das ist ein anderer Datentyp!“. Mit anderen Worten: wir patchen die Feld-Tabelle der betroffenen Klasse so, dass FinalizeArray dort ein TValueList (BaseType also TValue, nicht unser Dummy von weiter oben) sieht und dieses korrekt finalisiert.
Das ist zunächst einfacher als gedacht:
TI:= TypeInfo(TValue);
FT := Pointer(Integer(TI) + Byte(TI.Name[0]));
for I := FT.Count-1 downto 0 do begin
if FT.Fields[I].TypeInfo^ = TypeInfo(TValueListAlias) then
ppti:= FT.Fields[I].TypeInfo^:= TypeInfo(TValueList);
end; |
TI:= TypeInfo(TValue);
FT := Pointer(Integer(TI) + Byte(TI.Name[0]));
for I := FT.Count-1 downto 0 do begin
if FT.Fields[I].TypeInfo^ = TypeInfo(TValueListAlias) then
ppti:= FT.Fields[I].TypeInfo^:= TypeInfo(TValueList);
end;
Nur – das funktioniert so nicht 😉 Runtime Error 216 ist die Folge einer Exception beim Schreiben der neuen TypeInfo. Da hat nämlich mal jemand mitgedacht und die dazugehörige Seite als PAGE_EXECUTE_READ markiert. Was man zum Glück in seinem eigenen Prozess beliebig ändern kann, und so ergibt sich (mit allen Deklarationen) folgendes Meisterwerk:
procedure FixFieldTable(TheRecord, Find, Replace: PTypeInfo);
type
TFieldInfo = packed record
TypeInfo: PPTypeInfo;
Offset: Cardinal;
end;
PFieldTable = ^TFieldTable;
TFieldTable = packed record
X: Word;
Size: Cardinal;
Count: Cardinal;
Fields: array [0..0] of TFieldInfo;
end;
var
FT: PFieldTable;
ppti: PPTypeInfo;
I, old, dummy: cardinal;
begin
FT := Pointer(Integer(TheRecord) + Byte(TheRecord.Name[0]));
for I := FT.Count-1 downto 0 do begin
if FT.Fields[I].TypeInfo^ = Find then begin
ppti:= FT.Fields[I].TypeInfo;
VirtualProtect(ppti,SizeOf(ppti), PAGE_READWRITE, old);
try
ppti^:= Replace;
finally
VirtualProtect(ppti, sizeof(ppti), old, dummy);
end;
end;
end;
end;
{...}
FixFieldTable(TypeInfo(TValue), TypeInfo(TValueListAlias), TypeInfo(TValueList)); |
procedure FixFieldTable(TheRecord, Find, Replace: PTypeInfo);
type
TFieldInfo = packed record
TypeInfo: PPTypeInfo;
Offset: Cardinal;
end;
PFieldTable = ^TFieldTable;
TFieldTable = packed record
X: Word;
Size: Cardinal;
Count: Cardinal;
Fields: array [0..0] of TFieldInfo;
end;
var
FT: PFieldTable;
ppti: PPTypeInfo;
I, old, dummy: cardinal;
begin
FT := Pointer(Integer(TheRecord) + Byte(TheRecord.Name[0]));
for I := FT.Count-1 downto 0 do begin
if FT.Fields[I].TypeInfo^ = Find then begin
ppti:= FT.Fields[I].TypeInfo;
VirtualProtect(ppti,SizeOf(ppti), PAGE_READWRITE, old);
try
ppti^:= Replace;
finally
VirtualProtect(ppti, sizeof(ppti), old, dummy);
end;
end;
end;
end;
{...}
FixFieldTable(TypeInfo(TValue), TypeInfo(TValueListAlias), TypeInfo(TValueList));
Wer sich die Datenstruktur ansieht, wird feststellen dass TFieldTable ein Feld namens „Size“ enthält. Sollten wir das nicht anpassen? Die einfache Antwort ist: nein! In TValue selbst wird vom dynamischen Array nur ein Pointer auf den Anfang gespeichert, und der ist unabhängig vom genauen Aussehen des Arrays immer gleich groß: nämlich 32bit oder 4 Byte. Es ändert sich also nichts.
Außerdem praktisch: da SetLength den Array-Typ anlegt, den man ihm übergibt (und wir ja auf TValueList casten), werden auch untergeordnete Arrays als das freigegeben was in ihnen steckt.
Das funktioniert so bis mindestens BDS2006, ich kann mir aber vorstellen dass die neuen RTTI-Strukturen in XE hier einige Änderungen notwendig machen. Das müssen dann aber andere testen 😉
Oh, übrigens, wer es nicht erkannt hat: der Titel ist natürlich eine Referenz auf Disney’s Dschungelbuch.
