По мотивам -
"Сокровенные" заповеди
Процитирую:
"
- TObjectList. НИКОГДА, кроме случаев совместимости со стандартными библиотеками. Есть Tl3ObjectRefList, Tl3CObjectRefList, Tl3CBaseRefInterfacedList, Tl3SimpleObjectRefList, l3UncomparabeObjectRefList,l3ObjectRefList и т.п. Re: Утечки памяти при работе программ БЧ.
Достаточно положить один объект в два таких списка (TObjectList) и всё. Костей не соберёшь.
"
Ну и отчасти я подсмотрел у Apple:
http://books.google.ru/books?id=fmCvjdrkoPcC&pg=PA360&lpg=PA360&dq=Mac+Os+Zombie+objects&source=bl&ots=IvOBnMHC0H&sig=ccQTEhGB3RVbOfbaWbGASxuEzus&hl=ru&sa=X&ei=rEBdVKrLOM7WPbz4gPAJ&ved=0CC4Q6AEwAg#v=onepage&q=Mac%20Os%20Zombie%20objects&f=false
http://stackoverflow.com/questions/5386160/how-to-enable-nszombie-in-xcode
http://stackoverflow.com/questions/2190227/how-do-i-set-up-nszombieenabled-in-xcode-4
http://ktatsiu.wordpress.com/2012/04/24/learn-objective-c-putting-zombies-into-your-ios-bag-of-tricks/
Процитирую:
"
What is Zombie?
It is a debugging facility from the Foundation framework that when an object is deallocated, its isa
pointer is modified (from your [super dealloc]) to be that of a runtime generated “zombie” class.
Subsequently messages sent to the zombie object cause logged message and can be put to break when running on debugger.
"
Сразу оговорюсь - я
знаю про
FastMem. И я конечно же
читал про это -
Access Violation в деталях
Да и вся речь будет в контексте Delphi без
ARC.
И давайте договоримся - "
языки не обсуждать".
Есть языки
лишённые этих проблем, но у них есть
свои проблемы. И я
знаю - чём говорю.
Я буду говорить про Delphi и только про Delphi. И без ARC.
И ещё - про
потокозащищённость - я тоже пока ничего говорить не буду (это опять же -
отдельная тема).
Я тут занимался рефакторингом нашего кода и столкнулся с проблемой зомби-объектов.
(На самом деле там была
проблема архитектуры, но это повод для
отдельного поста)
Итак.
Что такое зомби-объекты?
Это объекты которые уже убиты (прошёл Destroy
или FreeInstance, или - там не зря - позже объясню почему), но на которые есть ссылки у каких-то других объектов.
И самое ужасное, если по этим ссылкам другие объекты пытаются удалить наших зомби.
Почему ужасное?
Ну просто если есть "просто ссылка", то скорее всего при обращении к убитому объекту мы получим AV (если повезёт) ну или "что-то вменяемое" (если не повезёт).
Почему так?
Потому, что если объект
уничтожен, то его память
отдаётся менеджеру памяти.
И при следующем же распределении
нового объекта эта память (если "не повезёт") может быть отдана ему.
И таким образом - ссылка на "зомби" может начать указывать на
настоящий живой объект, но
другой.
И вызов методов на "зомби"- ссылке - может давать "вменяемые", но "мусорные" результаты (если не повезёт), или AV (если повезёт).
Почему я пишу
повезёт?
Потому, что если мы получаем AV, то его достаточно "просто" поправить.
Хотя и не без проблем. Вопрос - времени.
Другое дело - если AV нет и мы получаем какие-то "вменяемые", но "мусорные" результаты.
Их достаточно сложно диагностировать.
А вот если другой объект зовёт Free или Destroy на "зомби"-ссылке, то проблема -
усугубляется.
В
лучшем случае - мы получим AV.
А вот в
худшем случае - получим тот факт, что убьётся новый объект,
не имеющий никакого отношения к старому. У и нас появится
ещё один зомби-объект.
И процесс может стать "
лавинообразным".
Попробую проиллюстрировать проблемы примером:
var
l_A : TObject;
l_List1 : TObjectList;
l_List2 : TObjectList;
begin
l_A := TObject.Create;
l_List1 := TObjectList.Create(true);
l_List2 := TObjectList.Create(true);
l_List1.Add(l_A);
l_List2.Add(l_A);
...
FreeAndNil(l_List1);
// - тут всё хорошо
...
FreeAndNil(l_List2);
// - тут СКОРЕЕ всего - получим AV
end;
-- это ещё "куда ни шло", такое AV - мы скорее всего рано или поздно найдём.
Но вот другой пример:
var
l_A : TObject;
l_B : TObject;
l_List1 : TObjectList;
l_List2 : TObjectList;
begin
l_A := TObject.Create;
l_List1 := TObjectList.Create(true);
l_List2 := TObjectList.Create(true);
l_List1.Add(l_A);
l_List2.Add(l_A);
...
FreeAndNil(l_List1);
// - тут всё хорошо
...
l_B := TObject.Create;
...
FreeAndNil(l_List2);
// - тут СКОРЕЕ всего - мы НЕ получим AV, по причинам описанным выше
end;
Или ещё:
var
l_A : TObject;
l_B : TObject;
l_С : TObject;
l_List1 : TObjectList;
l_List2 : TObjectList;
l_List3 : TObjectList;
begin
l_A := TObject.Create;
l_List1 := TObjectList.Create(true);
l_List2 := TObjectList.Create(true);
l_List3 := TObjectList.Create(true);
l_List1.Add(l_A);
l_List2.Add(l_A);
l_List3.Add(l_A);
...
FreeAndNil(l_List1);
// - тут всё хорошо
...
l_B := TObject.Create;
...
FreeAndNil(l_List2);
// - тут СКОРЕЕ всего - мы НЕ получим AV, по причинам описанным выше
...
l_С := TObject.Create;
FreeAndNil(l_List3);
// - тут вообще - "малопонятно", что будет происходить, по причинам описанным выше
end;
(Ну и ещё один "тривиальный" пример из той же серии -
http://programmingmindstream.blogspot.ru/2014/11/blog-post_8.html?showComment=1415454485825#c8382170742350856545)
Что же делать?
Один из способов борьбы это -
Подсчёт ссылок
Но это далеко
не всегда подходит, да и
не всегда является панацеей.
Можно пойти другим путём.
Можно подменить методы NewInstance и FreeInstance для "наших" объектов, а желательно для
всех.
Посмотрим на код класса TObject:
TObject = class
constructor Create;
procedure Free;
class function InitInstance(Instance: Pointer): TObject;
procedure CleanupInstance;
function ClassType: TClass;
class function ClassName: ShortString;
class function ClassNameIs(const Name: string): Boolean;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Longint;
class function InheritsFrom(AClass: TClass): Boolean;
class function MethodAddress(const Name: ShortString): Pointer;
class function MethodName(Address: Pointer): ShortString;
function FieldAddress(const Name: ShortString): Pointer;
function GetInterface(const IID: TGUID; out Obj): Boolean;
class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry;
class function GetInterfaceTable: PInterfaceTable;
function SafeCallException(ExceptObject: TObject;
ExceptAddr: Pointer): HResult; virtual;
procedure AfterConstruction; virtual;
procedure BeforeDestruction; virtual;
procedure Dispatch(var Message); virtual;
procedure DefaultHandler(var Message); virtual;
class function NewInstance: TObject; virtual;
procedure FreeInstance; virtual;
destructor Destroy; virtual;
end;
Тут приведу ещё одну полезную ссылку -
Путешествуя по TObject. Или как оно работает.
И на документацию:
http://docwiki.embarcadero.com/Libraries/XE7/en/System.TObject.NewInstance
"
Description
Allocates memory for an instance of an object type and returns a pointer to that new instance.
All constructors call
NewInstance automatically.
NewInstance calls
InstanceSize to determine how much memory containing a particular instance to allocate from the heap. Do not call
NewInstance directly.
Override NewInstance only for special memory allocation requirements. For example, when allocating a large number of identical objects that all need to be in memory at the same time, you can allocate a single block of memory for the entire group, then override NewInstance to use part of that larger block for each instance.
If you override
NewInstance to allocate memory, you may need to override
FreeInstance to deallocate the memory.
Note: By default, NewInstance calls InitInstance.
"
http://docwiki.embarcadero.com/Libraries/XE7/en/System.TObject.FreeInstance
"
Description
Deallocates memory allocated by a previous call to the
NewInstance method.
All destructors call
FreeInstance automatically to deallocate memory that was allocated by overriding
NewInstance.
Do not call
FreeInstance directly.
FreeInstance should be overridden if
NewInstance was overridden to change the way the object's instance data was allocated.
"
Теперь, как можно отследить проблемы в "нашем объекте"?
Напишем
свой базовый TourZombieObject (а лучше бы -
примесь, например -
RefCounted :-) но об этом - позже):
(потом я расскажу про то как распространить это всё и на TObject)
type
TourZombieObject = class(TObject)
class function NewInstance: TObject; override;
procedure FreeInstance; override;
end;//TourZombieObject
// - и его менеджер
TourZobmieObjectManager = class
class function GetObjectMem(aClass: TClass): TObject;
class procedure FreeObjectMem(theObject: TObject);
end;//TourZobmieObjectManager
class function TourZombieObject.NewInstance: TObject;
begin
Result := TourZobmieObjectManager.GetObjectMem(Self);
Result := InitInstance(Result); // - это - ВАЖНО
end;
procedure TourZombieObject.FreeInstance;
begin
CleanupInstance; // - это - ВАЖНО
TourZobmieObjectManager.FreeObjectMem(Self);
end;
class function TourZobmieObjectManager.GetObjectMem(aClass: TClass): TObject;
begin
System.GetMem(Result, aClass.InstanceSize);
FillChar(Result, aClass.InstanceSize, 0); // - это необязательно, но "для порядку"
end;
class procedure TourZobmieObjectManager.FreeObjectMem(theObject: TObject);
begin
System.FreeMem(Pointer(theObject));
// - а вот тут СПЕЦИАЛЬНО ничего не очищаем
end;
-- пока - ничего "
необычного" - просто переопределили методы распределения и освобождения памяти объекта.
Теперь какова идея? Как мы будем ловить зомби-объекты?
Мы изменим наш менеджер памяти так, чтобы он распределял память под объект на SizeOf(Integer) больше и туда будем класть признак "разрушённости объекта".
Пока вот так:
class function TourZobmieObjectManager.GetObjectMem(aClass: TClass): TObject;
var
l_Size : Integer;
begin
l_Size := aClass.InstanceSize + SizeOf(Integer); // - распределяем на SizeOf(Integer) больше
System.GetMem(Result, l_Size);
FillChar(Result, l_Size, 0);
Result := TObject(PAnsiChar(Result) + SizeOf(Integer)); // - сдвигаем указатель на SizeOf(Integer), слева от него у нас лежит НОЛЬ
end;
class procedure TourZobmieObjectManager.FreeObjectMem(theObject: TObject);
var
l_P : Pointer;
begin
l_P := Pointer(theObject);
l_P := PAnsiChar(l_P) - SizeOf(Integer); // - сдвигаем указатель обратно на SizeOf(Integer)
if (PInteger(l_P)^ <> 0) then
// - тут проверяем наш счётчик,который лежит слева от объекта
begin
Assert(false, 'Объект уже был удалён');
Exit;
end;//PInteger(l_P)^ <> 0
Inc(PInteger(l_P)^); // - увеличиваем наш счётчик
System.FreeMem(l_P);
// - а вот тут СПЕЦИАЛЬНО ничего не очищаем
end;
-- что мы тут получили?
Тут мы получили - "призрачную" защиту от того, что мы поймаем нашего зомби.
Почему призрачную? А потому, что память всё равно
отдаётся менеджеру памяти и что он с ней делает - мы вообще говоря -
не знаем.
Но вообще говоря - мы
повысили вероятность найти наших зомби.
Что мы будем делать дальше?
Давайте постараемся "гарантировать" то, что память не будет отдана менеджеру памяти.
Это навскидку сделать - "просто":
class function TourZobmieObjectManager.GetObjectMem(aClass: TClass): TObject;
var
l_Size : Integer;
begin
l_Size := aClass.InstanceSize + SizeOf(Integer); // - распределяем на SizeOf(Integer) больше
System.GetMem(Result, l_Size);
FillChar(Result, l_Size, 0);
Result := TObject(PAnsiChar(Result) + SizeOf(Integer)); // - сдвигаем указатель на SizeOf(Integer), слева от него у нас лежит НОЛЬ
end;
class procedure TourZobmieObjectManager.FreeObjectMem(theObject: TObject);
var
l_P : Pointer;
begin
l_P := Pointer(theObject);
l_P := PAnsiChar(l_P) - SizeOf(Integer); // - сдвигаем указатель обратно на SizeOf(Integer)
if (PInteger(l_P)^ <> 0) then
// - тут проверяем наш счётчик,который лежит слева от объекта
begin
Assert(false, 'Объект уже был удалён');
Exit;
end;//PInteger(l_P)^ <> 0
Inc(PInteger(l_P)^); // - увеличиваем наш счётчик
//System.FreeMem(l_P); - просто КОММЕНТИРУЕМ эту строку
// - а вот тут СПЕЦИАЛЬНО ничего не очищаем
end;
- что мы тут сделали?
Мы перестали возвращать память менеджеру памяти и ещё
повысили вероятность найти наших зомби.
Что мы проиграли?
Проиграли мы то, что память приложения будет
только расти и "когда-нибудь" - кончится. Так - "много не наотлаживаешься".
Что делать?
Сделаем "промежуточный кеш":
class function TourZobmieObjectManager.GetObjectMem(aClass: TClass): TObject;
var
l_Size : Integer;
begin
l_Size := aClass.InstanceSize + SizeOf(Integer); // - распределяем на SizeOf(Integer) больше
System.GetMem(Result, l_Size);
FillChar(Result, l_Size, 0);
Result := TObject(PAnsiChar(Result) + SizeOf(Integer)); // - сдвигаем указатель на SizeOf(Integer), слева от него у нас лежит НОЛЬ
end;
type
TFreedMemory = class(TList)
public
procedure Clear;
end;//TFreedMemory
procedure TFreedMemory.Clear;
var
l_Index : Integer;
l_P : Pointer;
begin
for l_Index := 0 to Pred(Count) do
// - тут освобождаем наши куски памяти
begin
l_P := Items[l_Index];
System.FreeMem(l_P);
end;//for l_Index
inherited Clear;
end;
var
g_FreedMemory : TFreedMemory = nil; // - этот объект может быть никогда не будет удалён
// или будет удалён не вовремя,
// но пусть пока это вас не смущает
// потом можно будет сделать "нормальный" синглетон
class procedure TourZobmieObjectManager.FreeObjectMem(theObject: TObject);
const
cOurMagicCount = 1024 * 1204; // - число неосвобождённых кусков, которые мы потерпим
var
l_P : Pointer;
begin
l_P := Pointer(theObject);
l_P := PAnsiChar(l_P) - SizeOf(Integer); // - сдвигаем указатель обратно на SizeOf(Integer)
if (g_FreedMemory <> nil) then
// - временный кеш был создан
begin
if (g_FreedMemory.Count >= cOurMagicCount) then
// - кеш "типа переполнился", надо его очистить
begin
Assert(g_FreedMemory.IndexOf(l_P) < 0, 'Объект уже был удалён'); // - тут "дополнительная проверка"
g_FreedMemory.Clear; // - Очищаем наши куски памяти и ТЕРЯЕМ возможность для их диагностики
end;//g_FreedMemory.Count >= cOurMagicCount
end;//g_FreedMemory <> nil
if (PInteger(l_P)^ <> 0) then
// - тут проверяем наш счётчик,который лежит слева от объекта
begin
Assert(false, 'Объект уже был удалён');
Exit;
end;//PInteger(l_P)^ <> 0
Inc(PInteger(l_P)^); // - увеличиваем наш счётчик
if (g_FreedMemory = nil) then
g_FreedMemory := TFreedMemory.Create;
g_FreedMemory.Add(l_P); // - добавляем на кусок памяти в наш "временный кеш"
//System.FreeMem(l_P); - просто КОММЕНТИРУЕМ эту строку
// - а вот тут СПЕЦИАЛЬНО ничего не очищаем
end;
...
initialization
...
finalization
if (l_FreedMemory <> nil) then
begin
g_FreedMemory.Clear; // - Очищаем наши куски памяти
FreeAndNil(g_FreedMemory); // - Уничтожаем наш список, НЕ ФАКТ, что вовремя
end;//l_FreedMemory <> nil
-- что мы тут сделали?
Мы по-прежнему -
не отдаём память менеджеру памяти. А складываем её во "временный кеш".
Что нам это даёт?
А даёт это то, что эта память - гарантированно
не будет отдана "кому-то другому". А это значит, что мы сможем
контроллировать наш "флаг разрушенности".
Но при этом - если наш кеш "переполняется" (g_FreedMemory.Count >= cOurMagicCount), то мы
отдаём эту память менеджеру памяти.
Тут мы несколько
уменьшаем вероятность нахождения ошибки, но зато наше приложение не будет "пухнуть".
Можно ещё немного видоизменить наш код.
Удалять только
один кусок памяти.
Первый.
Самый
рано распределённый.
Примерно так:
class function TourZobmieObjectManager.GetObjectMem(aClass: TClass): TObject;
var
l_Size : Integer;
begin
l_Size := aClass.InstanceSize + SizeOf(Integer); // - распределяем на SizeOf(Integer) больше
System.GetMem(Result, l_Size);
FillChar(Result, l_Size, 0);
Result := TObject(PAnsiChar(Result) + SizeOf(Integer)); // - сдвигаем указатель на SizeOf(Integer), слева от него у нас лежит НОЛЬ
end;
type
TFreedMemory = class(TList)
public
procedure Clear;
procedure DeleteFirst;
end;//TFreedMemory
procedure TFreedMemory.Clear;
var
l_Index : Integer;
l_P : Pointer;
begin
for l_Index := 0 to Pred(Count) do
// - тут освобождаем наши куски памяти
begin
l_P := Items[l_Index];
System.FreeMem(l_P);
end;//for l_Index
inherited Clear;
end;
procedure TFreedMemory.DeleteFirst;
var
l_P : Pointer;
begin
l_P := Items[0];
System.FreeMem(l_P);
Delete(0);
end;
var
g_FreedMemory : TFreedMemory = nil; // - этот объект может быть никогда не будет удалён
// или будет удалён не вовремя,
// но пусть пока это вас не смущает
// потом можно будет сделать "нормальный" синглетон
class procedure TourZobmieObjectManager.FreeObjectMem(theObject: TObject);
const
cOurMagicCount = 1024 * 1204; // - число неосвобождённых кусков, которые мы потерпим
var
l_P : Pointer;
begin
l_P := Pointer(theObject);
l_P := PAnsiChar(l_P) - SizeOf(Integer); // - сдвигаем указатель обратно на SizeOf(Integer)
if (g_FreedMemory <> nil) then
// - временный кеш был создан
begin
if (g_FreedMemory.Count >= cOurMagicCount) then
// - кеш "типа переполнился", надо его очистить
begin
Assert(g_FreedMemory.Items[0] <> l_P, 'Объект уже был удалён'); // - тут "дополнительная проверка"
g_FreedMemory.DeleteFirst; // - Очищаем ПЕРВЫЙ кусок памяти и ТЕРЯЕМ возможность для его диагностики
end;//g_FreedMemory.Count >= cOurMagicCount
end;//g_FreedMemory <> nil
if (PInteger(l_P)^ <> 0) then
// - тут проверяем наш счётчик,который лежит слева от объекта
begin
Assert(false, 'Объект уже был удалён');
Exit;
end;//PInteger(l_P)^ <> 0
Inc(PInteger(l_P)^); // - увеличиваем наш счётчик
if (g_FreedMemory = nil) then
g_FreedMemory := TFreedMemory.Create;
g_FreedMemory.Add(l_P); // - добавляем на кусок памяти в наш "временный кеш"
//System.FreeMem(l_P); - просто КОММЕНТИРУЕМ эту строку
// - а вот тут СПЕЦИАЛЬНО ничего не очищаем
end;
...
initialization
...
finalization
if (l_FreedMemory <> nil) then
begin
g_FreedMemory.Clear; // - Очищаем наши куски памяти
FreeAndNil(g_FreedMemory); // - Уничтожаем наш список, НЕ ФАКТ, что вовремя
end;//l_FreedMemory <> nil
Тут мы
повысили вероятность найти ошибку, но согласились с тем, что приложение будет "жрать больше памяти".
Таким образом, что мы получили?
Мы получили то, что если наш объект выглядит так:
type
TmyObject = class(TourZobmieObject)
end;//TmyObject
-- то мы сможем диагностировать ошибки его повторного уничтожения.
Причём с точностью до строчки (за счёт Assert).
Что дальше?
Поставим вопрос - а как можно диагностировать все объекты, а не только наследники от TourZobmieObject?
Тут - варианта два:
1. Сделать примесь и подмешивать её к интересующим нас объектам. Я так обычно и делаю. Но это -
отдельная тема.
2. Подменить методы TObject.NewInstance и TObject.FreeInstance. Благо они - виртуальные.
Пойдём по второму пути. Благо он - "более универсальный".
Вспомним ссылку -
Путешествуя по TObject. Или как оно работает.
Как можно подменить виртуальные метод
объекта (procedure FreeInstance; virtual;) - написано тут -
Переменные "экземпляра мета-класса в Delphi"
Ключевые слова -
VMTOffset и
VirtualProtect.
Как можно подменить метод класса (class function NewInstance: TObject; virtual;) - напишу позже.
Какова идея?
А идея в том, чтобы "внедрить" методы TourZobmieObjectManager в класс TObject.
Как это сделать?
Ну примерно так:
unit ourZombieObjectManager;
interface
type
TourZombieObjectManager = class
...
class procedure HackTObject;
end;//TourZombieObjectManager
implementation
type
TourHackZombieObject = class(TObject)
class function NewInstance: TObject; override;
procedure FreeInstance; override;
end;//TourZombieObject
class function TourHackZombieObject.NewInstance: TObject;
begin
Result := TourZobmieObjectManager.GetObjectMem(Self);
Result := InitInstance(Result); // - это - ВАЖНО
end;
procedure TourHackZombieObject.FreeInstance;
begin
CleanupInstance; // - это - ВАЖНО
TourZobmieObjectManager.FreeObjectMem(Self);
end;
type
TNI = function () : TObject of object; // - ДА ДА of object - СОВМЕСТИМ с class function
TFI = procedure () of object;
class procedure TourZombieObjectManager.HackTObject;
var
l_TObject : TClass;
l_Head : PPointer;
l_Old : DWORD;
l_OldOld : DWORD;
l_M : TMethod;
l_NI : TNI absolute l_M;
l_FI : TNI absolute l_M;
begin
l_TObject := TObject;
l_NI := TourHackZombieObject.NewInstance;
// далее подменяем TObject.NewInstance
asm
mov edx, VMTOffset TObject.NewInstance
// или mov edx, vmtNewInstance
mov eax, l_TObject
add edx, eax
mov l_Head, edx
end;//asm
// - в l_Head лежит указатель на VMT TObject.NewInstance
VirtualProtect(l_Head, 4, PAGE_EXECUTE_READWRITE, @l_Old);
// - разрешаем писать в VMT
PPointer(l_Head)^ := l_M.Code;
// - подменяем указатель TObject.NewInstance -> TourHackZombieObject.NewInstance
VirtualProtect(l_Head, 4, l_Old, @l_OldOld);
// - запрещаем писать в VMT
l_FI := TourHackZombieObject(nil).FreeInstance;
// далее подменяем TObject.FreeInstance
asm
mov edx, VMTOffset TObject.FreeInstance
// или mov edx, vmtFreeInstance
mov eax, l_TObject
add edx, eax
mov l_Head, edx
end;//asm
// - в l_Head лежит указатель на VMT TObject.FreeInstance
VirtualProtect(l_Head, 4, PAGE_EXECUTE_READWRITE, @l_Old);
// - разрешаем писать в VMT
PPointer(l_Head)^ := l_M.Code;
// - подменяем указатель TObject.FreeInstance -> TourHackZombieObject.FreeInstance
VirtualProtect(l_Head, 4, l_Old, @l_OldOld);
// - запрещаем писать в VMT
end;
initialiation
TourZombieObjectManager.HackTObject;
Ну и
ещё можно посмотреть вот сюда:
{ Virtual method table entries }
vmtSelfPtr = -76;
vmtIntfTable = -72;
vmtAutoTable = -68;
vmtInitTable = -64;
vmtTypeInfo = -60;
vmtFieldTable = -56;
vmtMethodTable = -52;
vmtDynamicTable = -48;
vmtClassName = -44;
vmtInstanceSize = -40;
vmtParent = -36;
vmtSafeCallException = -32 deprecated; // don't use these constants.
vmtAfterConstruction = -28 deprecated; // use VMTOFFSET in asm code instead
vmtBeforeDestruction = -24 deprecated;
vmtDispatch = -20 deprecated;
vmtDefaultHandler = -16 deprecated;
vmtNewInstance = -12 deprecated;
vmtFreeInstance = -8 deprecated;
vmtDestroy = -4 deprecated;
vmtQueryInterface = 0 deprecated;
vmtAddRef = 4 deprecated;
vmtRelease = 8 deprecated;
vmtCreateObject = 12 deprecated;
И сюда - System.TMethod -
http://docwiki.embarcadero.com/Libraries/XE7/en/System.TMethod
-- что мы получили?
А мы получили то, что достаточно лишь
первой строчкой включить в проект uses ourZombieObjectManager - и мы получаем возможность диагностировать повторное уничтожение для
всех объектов.
У меня есть компилируемый код всего этого "хозяйства", как только я доведу его до "продакшн" - я обязательно его выложу.
Надеюсь, что это всё оказалось кому-нибудь полезным.
P.S. Если ешё сделать так:
...
class procedure TourZobmieObjectManager.FreeObjectMem(theObject: TObject);
const
cOurMagicCount = 1024 * 1204; // - число неосвобождённых кусков, которые мы потерпим
var
l_P : Pointer;
begin
l_P := Pointer(theObject);
PPointer(l_P)^ := nil; // - обнуляем указатель на VMT
l_P := PAnsiChar(l_P) - SizeOf(Integer); // - сдвигаем указатель обратно на SizeOf(Integer)
if (g_FreedMemory <> nil) then
// - временный кеш был создан
begin
if (g_FreedMemory.Count >= cOurMagicCount) then
// - кеш "типа переполнился", надо его очистить
begin
Assert(g_FreedMemory.Items[0] <> l_P, 'Объект уже был удалён'); // - тут "дополнительная проверка"
g_FreedMemory.DeleteFirst; // - Очищаем ПЕРВЫЙ кусок памяти и ТЕРЯЕМ возможность для его диагностики
end;//g_FreedMemory.Count >= cOurMagicCount
end;//g_FreedMemory <> nil
if (PInteger(l_P)^ <> 0) then
// - тут проверяем наш счётчик,который лежит слева от объекта
begin
Assert(false, 'Объект уже был удалён');
Exit;
end;//PInteger(l_P)^ <> 0
Inc(PInteger(l_P)^); // - увеличиваем наш счётчик
if (g_FreedMemory = nil) then
g_FreedMemory := TFreedMemory.Create;
g_FreedMemory.Add(l_P); // - добавляем на кусок памяти в наш "временный кеш"
//System.FreeMem(l_P); - просто КОММЕНТИРУЕМ эту строку
// - а вот тут СПЕЦИАЛЬНО ничего не очищаем
end;
...
А именно:
PPointer(l_P)^ := nil; // - обнуляем указатель на VMT
-- то
вероятность нахождения ошибки
без вызова деструктора - повысится. Так как мы
упадём на вызове
любого виртуального метода нашего зомби.
