- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
- 68
- 69
- 70
- 71
- 72
- 73
- 74
- 75
- 76
- 77
- 78
- 79
- 80
- 81
- 82
- 83
- 84
- 85
- 86
- 87
- 88
- 89
- 90
- 91
- 92
- 93
- 94
- 95
- 96
- 97
- 98
- 99
- 100
// к говнокоду 7101:
interface
type TObjectAuto = class;
TSmartPtr = packed record
data: TObjectAuto;
end;
TSmartPtrA = array of TSmartPtr;
//-------------------------------------------------------------------------------------------
// класс с "авто"-деструктором
TObjectAuto = class(TObject)
n: integer; // для тестов
constructor Create(var ptr: TSmartPtrA);
destructor Destroy(); override;
end;
implementation
uses Windows;
var winheap: Cardinal;
var savedlinks: array of integer; // в тестовом примере сойдет, а вообще надо хеш-таблицу
//-------------------------------------------------------------------------------------------
constructor TObjectAuto.Create(var ptr: TSmartPtrA);
begin
inherited Create();
SetLength(ptr, 1);
ptr[0].data := self;
// сохраняем адрес выделенной памяти под массив (у него еще есть длина и счетчик ссылок)
SetLength(savedlinks, Length(savedlinks) + 1);
savedlinks[Length(savedlinks) - 1] := integer(ptr) - 2 * sizeof(integer);
end;
//-------------------------------------------------------------------------------------------
destructor TObjectAuto.Destroy();
begin
n := 0; // сюда брякпойнт поставим:)
inherited;
end;
//-------------------------------------------------------------------------------------------
function WinGetMem(Size: Integer): Pointer;
begin
Result := HeapAlloc(winheap, 0, Size);
end;
//-------------------------------------------------------------------------------------------
function WinFreeMem(P: Pointer): Integer;
var i, j: integer;
begin
// ищем адрес освобождаемой памяти среди сохраненных
i := 0; j := 0; while(i < Length(savedlinks))do begin
// если нашли, то вызываем "авто"-деструктор
if (savedlinks[i] = integer(P)) then
TSmartPtrA(integer(p) + 2 * sizeof(integer))[0].data.Free()
else begin
savedlinks[j] := savedlinks[i];
inc(j);
end;
inc(i);
end;
SetLength(savedlinks, j);
HeapFree(winheap, 0, P);
Result := 0;
end;
//-------------------------------------------------------------------------------------------
function WinReallocMem(P: Pointer; Size: Integer): Pointer;
begin
Result := HeapReAlloc(winheap, 0, P, Size);
end;
//-------------------------------------------------------------------------------------------
var winmem: TMemoryManager = (
GetMem: WinGetMem;
FreeMem: WinFreeMem;
ReallocMem: WinReallocMem);
oldmem: TMemoryManager;
//-------------------------------------------------------------------------------------------
initialization
begin
winheap := GetProcessHeap();
GetMemoryManager(oldmem);
SetMemoryManager(winmem);
SetLength(savedlinks, 0);
end;
//-------------------------------------------------------------------------------------------
finalization
begin
SetLength(savedlinks, 0);
SetMemoryManager(oldmem);
end;
//-------------------------------------------------------------------------------------------
end.
// пример использования:
procedure TfrmTest.Button1Click(Sender: TObject);
var ptr: TSmartPtrA;
obj: TObjectAuto;
begin
obj := TObjectAuto.Create(ptr);
obj.n := 222; // ptr[0].data.n := 222;
// тут obj удалится сам
end;
1)При создании каждого 1 экземпляра класса - нужно создать 1 локальный массив.
2)При создании каждого 1 класса - нужно создать 1 магический конструктор и 1 магический деструктор.
3)Дописать ещё несколько костылей.
3)Теперь объект соизволит удавлиться сам.
4)??????
5)PROFIT
Умереть, не встать... Лучше я сам деструктор вызову, а потом уйду в другой язык и не вернусь.
1)Зачем winheap?
2)Зачем SetLength(savedlinks, 0); в finalization?
2. Ну так - для порядка. в нормальной реализации там должен быть класс хештаблицы или еще что может подойти, но не массив
Претензии:
Переопределять менеджер памяти через HeapAlloc не надо, это тормоза большие, лучше через старые GetMem/FreeMem. Стандартный менеджер сам по себе весьма хорош, надо только сделать над ним небольшую надстройку.
Ну и мёртвая привязка начала блока к -8 му смещению указателя на динмассив не очень. Надо найти структуру из модуля System и привязаться к её размеру.
да, конечно лучше через структуру.
в реальных проектах сам вряд ли буду использовать - проще самому освободить. ну или если кто-нибудь освободит вручную - то будет плохо.
Что-то не замечал утечек из-за плохой работы именно менеджера памяти.
var n: array of Pointer;
i: integer;
p: Pointer;
begin
SetLength(n, 10000);
for i := 0 to 9999 do begin
GetMem(p, 100000); (**)
GetMem(n[i], 1);
FreeMem(p); (**)
end;
// Сюда ставить брякпойнт, смотреть, сколько сожрал, сравнить с вариантом без строк (**)
// дальше честная очистка n.
for i := 0 to 9999 do FreeMem(n[i]);
SetLength(n, 0);
От дельфи и так много выделений. Говнопрограмма на говнопрограмме с его то порогом вхождения. Зачем ещё?
что правда, то правда
кстати, если в getmem указать 1 метр вместо 100к, то будет EOutOfMemory
У меня есть универсальный контейнер для всего, основан на префиксном дереве. Понятно, что такм везде указатели, уничтожать его надо вручную. Так я всерьёз думал ради безопасности переписать это дерево на динмассив. То есть когда нужна новая вершина - мы удлиняет массив на 1 и пишем в эту вершину указатель на новый элемент индекс нового элемента. Надо убрать вершину - ну помечаем элементы массива как неиспользуемые, например. Потом перекидываем элементы, перекинув индекс родителя.
ну а сам контейнер придется создавать/удалять.при переходе на массивы скорее всего проиграете в производительности.
стоит ли впадать в крайности?
Что касается производительности, то мне в таких вещах лишь бы алгоритмическая сложность не портилась.
Не взлетить. Компилер меджик мать ее