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
68 private
73 public
76 // free all allocated memory
79 // forget everything
82 // mark current position
84 // forget everything from the given mark
87 // allocate some memory
88 // WARNING! pool can realloc it's internal storage and invalidate all previous pointers!
91 // get pointer for the given mark
92 // WARNING! pointer can become invalid after next call to `alloc()`!
98 type
100 public
104 private
111 public
112 constructor Create (var apool: TPoolMarkRelease); // idiotic FPC doesn't support arg-less ctors for rectord
125 public
130 var
134 implementation
136 uses
137 SysUtils
138 {$IFDEF USE_MEMPOOL}
139 , hashtable
140 {$ENDIF}
141 ;
144 // ////////////////////////////////////////////////////////////////////////// //
146 begin
148 begin
151 end
152 else
153 begin
161 // free all allocated memory
163 begin
171 // forget everything
173 begin
178 // mark current position
180 begin
185 // forget everything from the given mark
187 begin
188 if (amark < 0) or (amark > mUsed) then raise Exception.Create('MarkReleasePool is fucked (release)');
193 // allocate some memory
194 // WARNING! pool can realloc it's internal storage and invalidate all previous pointers!
196 begin
197 if (size < 0) then raise Exception.Create('MarkReleasePool: cannot allocate negative amount of bytes');
198 if (size > 1024*1024) then raise Exception.Create('MarkReleasePool: why do you need to allocate more than 1MB?');
199 // do we need to get more memory?
201 begin
202 if (mUsed+size > 1024*1024*64) then raise Exception.Create('MarkReleasePool: more than 64MB in MarkReleasePool is insanity!');
204 begin
205 // less than 256KB: 64KB steps
207 // less than 1MB: 128KB steps
209 // otherwise, 1MB steps
221 // get pointer for the given mark
222 // WARNING! pointer can become invalid after next call to `alloc()`!
224 begin
225 if (amark < 0) or (amark > mUsed) then raise Exception.Create('MarkReleasePool is fucked (getPtr)');
231 begin
237 // ////////////////////////////////////////////////////////////////////////// //
239 begin
249 begin
259 begin
266 begin
267 //if (mCurrent+1 >= 0) and (mCurrent+1 < mCount) then result := mCount-(mCurrent+1) else result := 0;
273 begin
284 begin
293 begin
295 if (mCurrent < 0) or (mCurrent >= mCount) then raise Exception.Create('getCurrent() range error');
301 begin
307 begin
314 // ////////////////////////////////////////////////////////////////////////// //
315 {$IFDEF USE_MEMPOOL}
316 uses
317 hashtable;
319 type
321 public
327 THashPtrPtr = specialize THashBase<Pointer, PMemPool, THashKeyPtr>; // key: TClass; value: PMemPool
329 var
333 // ////////////////////////////////////////////////////////////////////////// //
334 class function THashKeyPtr.hash (const k: Pointer): LongWord; inline; begin result := fnvHash(PByte(@k)^, sizeof(k)); end;
335 class function THashKeyPtr.equ (const a, b: Pointer): Boolean; inline; begin result := (a = b); end;
340 begin
343 begin
351 // ////////////////////////////////////////////////////////////////////////// //
353 begin
364 procedure TMemPool.setCapacity (acount: Integer); // ensure capacity for at least `acount` objects
365 begin
370 begin
375 begin
385 begin
390 // ////////////////////////////////////////////////////////////////////////// //
391 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
393 var
394 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
396 {$ENDIF}
398 begin
399 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
402 {$ELSE}
405 {$ENDIF}
412 var
414 begin
418 {$ENDIF}
421 // ////////////////////////////////////////////////////////////////////////// //
422 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
424 var
427 begin
431 begin
436 {$ENDIF}
439 initialization
440 //mpoolMap := TMemPool.Create('textmap', 64);
442 finalization
443 {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)}
445 {$ENDIF}