1 (* Copyright (C) Doom 2D: Forever Developers
2 *
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.
7 *
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.
12 *
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/>.
15 *)
16 {$INCLUDE a_modes.inc}
17 {$DEFINE MEM_DISABLE_ACCOUNTING}
20 interface
22 {$IFDEF USE_MEMPOOL}
23 uses
24 SysUtils;
27 type
30 private
38 public
47 public
55 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
58 {$ENDIF}
60 {$ENDIF}
62 (* Simple "mark/release" allocator *)
63 type
67 private
72 public
75 // free all allocated memory
78 // forget everything
81 // mark current position
83 // forget everything from the given mark
86 // allocate some memory
87 // WARNING! pool can realloc it's internal storage and invalidate all previous pointers!
90 // get pointer for the given mark
91 // WARNING! pointer can become invalid after next call to `alloc()`!
97 type
99 public
103 private
109 public
124 public
129 var
133 implementation
135 uses
136 SysUtils
137 {$IFDEF USE_MEMPOOL}
138 , hashtable
139 {$ENDIF}
140 ;
143 // ////////////////////////////////////////////////////////////////////////// //
145 begin
147 begin
150 end
151 else
152 begin
160 // free all allocated memory
162 begin
170 // forget everything
172 begin
177 // mark current position
179 begin
184 // forget everything from the given mark
186 begin
187 if (amark < 0) or (amark > mUsed) then raise Exception.Create('MarkReleasePool is fucked (release)');
192 // allocate some memory
193 // WARNING! pool can realloc it's internal storage and invalidate all previous pointers!
195 begin
196 if (size < 0) then raise Exception.Create('MarkReleasePool: cannot allocate negative amount of bytes');
197 if (size > 1024*1024) then raise Exception.Create('MarkReleasePool: why do you need to allocate more than 1MB?');
198 // do we need to get more memory?
200 begin
201 if (mUsed+size > 1024*1024*64) then raise Exception.Create('MarkReleasePool: more than 64MB in MarkReleasePool is insanity!');
203 begin
204 // less than 256KB: 64KB steps
206 // less than 1MB: 128KB steps
208 // otherwise, 1MB steps
220 // get pointer for the given mark
221 // WARNING! pointer can become invalid after next call to `alloc()`!
223 begin
224 if (amark < 0) or (amark > mUsed) then raise Exception.Create('MarkReleasePool is fucked (getPtr)');
230 begin
236 // ////////////////////////////////////////////////////////////////////////// //
238 begin
244 begin
253 begin
257 mCount := Integer(PtrUInt(framePool.curPtr)-PtrUInt(framePool.getPtr(mMark))) div Integer(sizeof(T));
263 begin
270 begin
271 //if (mCurrent+1 >= 0) and (mCurrent+1 < mCount) then result := mCount-(mCurrent+1) else result := 0;
277 begin
288 begin
297 begin
298 if (mCurrent < 0) or (mCurrent >= mCount) then raise Exception.Create('getCurrent() range error');
304 begin
310 begin
317 // ////////////////////////////////////////////////////////////////////////// //
318 {$IFDEF USE_MEMPOOL}
319 uses
320 hashtable;
322 type
324 public
330 THashPtrPtr = specialize THashBase<Pointer, PMemPool, THashKeyPtr>; // key: TClass; value: PMemPool
332 var
336 // ////////////////////////////////////////////////////////////////////////// //
337 class function THashKeyPtr.hash (const k: Pointer): LongWord; inline; begin result := fnvHash(PByte(@k)^, sizeof(k)); end;
338 class function THashKeyPtr.equ (const a, b: Pointer): Boolean; inline; begin result := (a = b); end;
343 begin
346 begin
354 // ////////////////////////////////////////////////////////////////////////// //
356 begin
367 procedure TMemPool.setCapacity (acount: Integer); // ensure capacity for at least `acount` objects
368 begin
373 begin
378 begin
388 begin
393 // ////////////////////////////////////////////////////////////////////////// //
394 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
396 var
397 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
399 {$ENDIF}
401 begin
402 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
405 {$ELSE}
408 {$ENDIF}
415 var
417 begin
421 {$ENDIF}
424 // ////////////////////////////////////////////////////////////////////////// //
425 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
427 var
430 begin
434 begin
439 {$ENDIF}
442 initialization
443 //mpoolMap := TMemPool.Create('textmap', 64);
445 finalization
446 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
448 {$ENDIF}