X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fmempool.pas;h=a521626e051439be0cb5bc75417bbdaa036b17fd;hb=c737ec14212534a2b7069615641afdf329ea8cb4;hp=7d30a9bc92e12f5fb02e90fd2cb10fe1584f884c;hpb=1bddfaf7b6421f1659a6f211dfdb1dfaef5d5173;p=d2df-sdl.git diff --git a/src/shared/mempool.pas b/src/shared/mempool.pas index 7d30a9b..a521626 100644 --- a/src/shared/mempool.pas +++ b/src/shared/mempool.pas @@ -2,8 +2,7 @@ * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. + * the Free Software Foundation, version 3 of the License ONLY. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -59,8 +58,259 @@ type end; {$ENDIF} +(* Simple "mark/release" allocator *) +type + PoolMark = Integer; + + PPoolMarkRelease = ^TPoolMarkRelease; + TPoolMarkRelease = record + private + mMemory: Pointer; + mSize: Integer; + mUsed: Integer; + + public + constructor Create (aInitSize: Integer); + + // free all allocated memory + procedure kill (); + + // forget everything + procedure reset (); + + // mark current position + function mark (): PoolMark; inline; + // forget everything from the given mark + procedure release (amark: PoolMark); inline; + + // allocate some memory + // WARNING! pool can realloc it's internal storage and invalidate all previous pointers! + function alloc (size: Integer): Pointer; inline; + + // get pointer for the given mark + // WARNING! pointer can become invalid after next call to `alloc()`! + function getPtr (amark: PoolMark): Pointer; inline; + function curPtr (): Pointer; inline; + end; + + +type + generic PoolIter = record + public + type Ptr = ^T; + type MyType = specialize PoolIter; + + private + mPool: PPoolMarkRelease; + mMark: PoolMark; + mCount: Integer; + mCurrent: Integer; + mFinished: Boolean; + + public + constructor Create (var apool: TPoolMarkRelease); // idiotic FPC doesn't support arg-less ctors for rectord + procedure finishIt (); inline; // sets count + + procedure rewind (); inline; + function length (): Integer; inline; + procedure release (); inline; // reset pool + + function moveNext (): Boolean; inline; + function getCurrent (): Ptr; inline; + function getEnumerator (): MyType; inline; + + function first (): Ptr; inline; + + public + property current: Ptr read getCurrent; + end; + + +var + framePool: TPoolMarkRelease; // temporary per-frame allocation pool + + implementation +uses + SysUtils +{$IFDEF USE_MEMPOOL} + , hashtable +{$ENDIF} + ; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TPoolMarkRelease.Create (aInitSize: Integer); +begin + if (aInitSize > 0) then + begin + mSize := aInitSize; + GetMem(mMemory, mSize); + end + else + begin + mMemory := nil; + mSize := 0; + end; + mUsed := 0; +end; + + +// free all allocated memory +procedure TPoolMarkRelease.kill (); +begin + if (mMemory <> nil) then FreeMem(mMemory); + mMemory := nil; + mSize := 0; + mUsed := 0; +end; + + +// forget everything +procedure TPoolMarkRelease.reset (); +begin + mUsed := 0; +end; + + +// mark current position +function TPoolMarkRelease.mark (): PoolMark; inline; +begin + result := mUsed; +end; + + +// forget everything from the given mark +procedure TPoolMarkRelease.release (amark: PoolMark); inline; +begin + if (amark < 0) or (amark > mUsed) then raise Exception.Create('MarkReleasePool is fucked (release)'); + mUsed := amark; +end; + + +// allocate some memory +// WARNING! pool can realloc it's internal storage and invalidate all previous pointers! +function TPoolMarkRelease.alloc (size: Integer): Pointer; inline; +begin + if (size < 0) then raise Exception.Create('MarkReleasePool: cannot allocate negative amount of bytes'); + if (size > 1024*1024) then raise Exception.Create('MarkReleasePool: why do you need to allocate more than 1MB?'); + // do we need to get more memory? + if (mUsed+size > mSize) then + begin + if (mUsed+size > 1024*1024*64) then raise Exception.Create('MarkReleasePool: more than 64MB in MarkReleasePool is insanity!'); + while (mUsed+size > mSize) do + begin + // less than 256KB: 64KB steps + if (mSize < 256*1024) then mSize += 64*1024 + // less than 1MB: 128KB steps + else if (mSize < 1024*1024) then mSize += 128*1024 + // otherwise, 1MB steps + else mSize += 1024*1024; + end; + ReallocMem(mMemory, mSize); + if (mMemory = nil) then raise Exception.Create('MarkReleasePool: out of memory!'); + end; + result := Pointer(PAnsiChar(mMemory)+mUsed); + mUsed += size; + assert(mUsed <= mSize); +end; + + +// get pointer for the given mark +// WARNING! pointer can become invalid after next call to `alloc()`! +function TPoolMarkRelease.getPtr (amark: PoolMark): Pointer; inline; +begin + if (amark < 0) or (amark > mUsed) then raise Exception.Create('MarkReleasePool is fucked (getPtr)'); + result := Pointer(PAnsiChar(mMemory)+amark); +end; + + +function TPoolMarkRelease.curPtr (): Pointer; inline; +begin + result := Pointer(PAnsiChar(mMemory)+mUsed); +end; + + + +// ////////////////////////////////////////////////////////////////////////// // +constructor PoolIter.Create (var apool: TPoolMarkRelease); +begin + mPool := @apool; + mMark := mPool^.mark(); + mCount := 0; + mCurrent := -1; + mFinished := false; +end; + + +procedure PoolIter.finishIt (); inline; // sets count +begin + if (mFinished) then raise Exception.Create('double fatality'); + if (mPool = nil) then raise Exception.Create('void fatality'); + mFinished := true; + mCount := Integer(PtrUInt(mPool^.curPtr)-PtrUInt(mPool^.getPtr(mMark))) div Integer(sizeof(T)); + if (mCount < 0) then raise Exception.Create('wutafu?'); +end; + + +procedure PoolIter.rewind (); inline; +begin + if (mPool = nil) then raise Exception.Create('void rewind'); + mCurrent := -1; +end; + + +function PoolIter.length (): Integer; inline; +begin + //if (mCurrent+1 >= 0) and (mCurrent+1 < mCount) then result := mCount-(mCurrent+1) else result := 0; + result := mCount; +end; + + +procedure PoolIter.release (); inline; // reset pool +begin + if (mPool = nil) then raise Exception.Create('double release'); + mPool^.release(mMark); + mPool := nil; + mCount := 0; + mCurrent := -1; + mFinished := false; +end; + + +function PoolIter.moveNext (): Boolean; inline; +begin + if (mPool = nil) then raise Exception.Create('void moveNext()'); + if (not mFinished) then raise Exception.Create('moveNext() on unfinished'); + Inc(mCurrent); + result := (mCurrent < mCount); +end; + + +function PoolIter.getCurrent (): Ptr; inline; +begin + if (mPool = nil) then raise Exception.Create('getCurrent() on nothing'); + if (mCurrent < 0) or (mCurrent >= mCount) then raise Exception.Create('getCurrent() range error'); + result := Ptr(mPool^.getPtr(mMark+mCurrent*Integer(sizeof(T)))); +end; + + +function PoolIter.getEnumerator (): PoolIter; inline; +begin + result := self; +end; + + +function PoolIter.first (): Ptr; inline; +begin + if (mPool = nil) then raise Exception.Create('void moveNext()'); + if (not mFinished) then raise Exception.Create('moveNext() on unfinished'); + result := Ptr(mPool^.getPtr(mMark)); +end; + + +// ////////////////////////////////////////////////////////////////////////// // {$IFDEF USE_MEMPOOL} uses hashtable; @@ -187,6 +437,7 @@ end; initialization //mpoolMap := TMemPool.Create('textmap', 64); + framePool := TPoolMarkRelease.Create(65536); finalization {$IF DEFINED(D2F_DEBUG) and NOT DEFINED(MEM_DISABLE_ACCOUNTING)} dumpPools();