1 (* Copyright (C) DooM 2D:Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE a_modes.inc}
17 {$DEFINE MEM_DISABLE_ACCOUNTING}
32 mObjSize
: Integer; // not a limit, just a recommendation
39 constructor Create (const aname
: AnsiString
; aobjsize
: Integer);
41 procedure setCapacity (acount
: Integer); // ensure capacity for at least `acount` objects
42 procedure release (); // release all pool memory
44 function alloc (len
: Integer): Pointer; // throws on OOM
45 procedure free (ptr
: Pointer); // currently it is noop
48 property name
: ShortString read mName
;
49 property allocCount
: Integer read mAllocCount
;
50 property allocTotal
: Integer read mAllocTotal
;
55 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
56 public class function NewInstance (): TObject
; override;
57 public procedure FreeInstance (); override;
71 class function hash (const k
: Pointer): LongWord
; inline;
72 class function equ (const a
, b
: Pointer): Boolean; inline;
73 class procedure freekey (k
: Pointer); inline;
76 THashPtrPtr
= specialize THashBase
<Pointer, PMemPool
, THashKeyPtr
>; // key: TClass; value: PMemPool
79 pools
: THashPtrPtr
= nil;
82 // ////////////////////////////////////////////////////////////////////////// //
83 class function THashKeyPtr
.hash (const k
: Pointer): LongWord
; inline; begin result
:= fnvHash(PByte(@k
)^, sizeof(k
)); end;
84 class function THashKeyPtr
.equ (const a
, b
: Pointer): Boolean; inline; begin result
:= (a
= b
); end;
85 class procedure THashKeyPtr
.freekey (k
: Pointer); inline; begin end;
88 function getPoolFor (c
: TClass
): PMemPool
;
90 if (pools
= nil) then pools
:= THashPtrPtr
.Create();
91 if not pools
.get(Pointer(c
), result
) then
93 GetMem(result
, sizeof(TMemPool
));
94 result
.Create(c
.ClassName
, c
.InstanceSize
);
95 pools
.put(Pointer(c
), result
);
100 // ////////////////////////////////////////////////////////////////////////// //
101 constructor TMemPool
.Create (const aname
: AnsiString
; aobjsize
: Integer);
103 if (aobjsize
< 1) then aobjsize
:= 16; // arbitrary number
105 mObjSize
:= aobjsize
;
113 procedure TMemPool
.setCapacity (acount
: Integer); // ensure capacity for at least `acount` objects
118 procedure TMemPool
.release (); // release all pool memory
123 function TMemPool
.alloc (len
: Integer): Pointer; // throws on OOM
125 if (len
> 0) then mAllocTotal
+= len
;
126 if (len
< 1) then len
:= 1;
128 FillChar(PByte(result
)^, len
, 0);
133 procedure TMemPool
.free (ptr
: Pointer); // currently it is noop
139 // ////////////////////////////////////////////////////////////////////////// //
140 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
141 class function TPoolObject
.NewInstance (): TObject
;
143 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
148 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
149 pool
:= getPoolFor(self
.ClassType
);
150 ptr
:= pool
.alloc(self
.InstanceSize
);
152 GetMem(ptr
, self
.InstanceSize
);
153 FillChar(PByte(ptr
)^, self
.InstanceSize
, 0); // hello, Wyoming Knott!
155 result
:= TObject(ptr
);
156 self
.InitInstance(ptr
);
160 procedure TPoolObject
.FreeInstance ();
164 pool
:= getPoolFor(self
.ClassType
);
165 pool
.free(Pointer(self
));
170 // ////////////////////////////////////////////////////////////////////////// //
171 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
172 procedure dumpPools ();
175 kv
: THashPtrPtr
.PEntry
;
177 AssignFile(fo
, 'zmemlog.txt');
179 for kv
in pools
.byKeyValue
do
181 writeln(fo
, kv
.value
.name
, ': count=', kv
.value
.allocCount
, '; total=', kv
.value
.allocTotal
);
189 //mpoolMap := TMemPool.Create('textmap', 64);
191 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
194 {$ENDIF} // USE_MEMPOOL