123 lines
3.8 KiB
ObjectPascal
123 lines
3.8 KiB
ObjectPascal
{
|
|
Alternative memory manager. To use it, just place a reference to this
|
|
unit *FIRST* in the uses clause of your project (dpr-file). It is a good idea
|
|
to use this memory manager with system dcu replacement by Vladimir Kladov.
|
|
|
|
Heap API used, which is fast and very effective (allocated block granularity
|
|
is 16 bytes). One additional benefit is that some proofing tools (MemProof)
|
|
do not detect API failures, which those can find when standard Delphi memory
|
|
manager used.
|
|
=====================================================================
|
|
Copyright (C) by Vladimir Kladov, 2001
|
|
---------------------------------------------------------------------
|
|
http://xcl.cjb.net
|
|
mailto: bonanzas@xcl.cjb.net
|
|
}
|
|
|
|
unit HeapMM;
|
|
|
|
interface
|
|
|
|
uses windows;
|
|
|
|
const
|
|
HEAP_NO_SERIALIZE = $00001;
|
|
HEAP_GROWABLE = $00002;
|
|
HEAP_GENERATE_EXCEPTIONS = $00004;
|
|
HEAP_ZERO_MEMORY = $00008;
|
|
HEAP_REALLOC_IN_PLACE_ONLY = $00010;
|
|
HEAP_TAIL_CHECKING_ENABLED = $00020;
|
|
HEAP_FREE_CHECKING_ENABLED = $00040;
|
|
HEAP_DISABLE_COALESCE_ON_FREE = $00080;
|
|
HEAP_CREATE_ALIGN_16 = $10000;
|
|
HEAP_CREATE_ENABLE_TRACING = $20000;
|
|
HEAP_MAXIMUM_TAG = $00FFF;
|
|
HEAP_PSEUDO_TAG_FLAG = $08000;
|
|
HEAP_TAG_SHIFT = 16 ;
|
|
|
|
{$DEFINE USE_PROCESS_HEAP}
|
|
|
|
var
|
|
HeapHandle: THandle;
|
|
{* Global handle to the heap. Do not change it! }
|
|
|
|
HeapFlags: DWORD = 0;
|
|
{* Possible flags are:
|
|
HEAP_GENERATE_EXCEPTIONS - system will raise an exception to indicate a
|
|
function failure, such as an out-of-memory
|
|
condition, instead of returning NULL.
|
|
HEAP_NO_SERIALIZE - mutual exclusion will not be used while the HeapAlloc
|
|
function is accessing the heap. Be careful!
|
|
Not recommended for multi-thread applications.
|
|
But faster.
|
|
HEAP_ZERO_MEMORY - obviously. (Slower!)
|
|
}
|
|
|
|
{ Note from MSDN:
|
|
The granularity of heap allocations in Win32 is 16 bytes. So if you
|
|
request a global memory allocation of 1 byte, the heap returns a pointer
|
|
to a chunk of memory, guaranteeing that the 1 byte is available. Chances
|
|
are, 16 bytes will actually be available because the heap cannot allocate
|
|
less than 16 bytes at a time.
|
|
}
|
|
implementation
|
|
|
|
function HeapGetMem(size: Integer): Pointer;
|
|
// Allocate memory block.
|
|
begin
|
|
Result := HeapAlloc( HeapHandle, HeapFlags, size );
|
|
end;
|
|
|
|
function HeapFreeMem(p: Pointer): Integer;
|
|
// Deallocate memory block.
|
|
begin
|
|
Result := Integer( not HeapFree( HeapHandle, HeapFlags and HEAP_NO_SERIALIZE,
|
|
p ) );
|
|
end;
|
|
|
|
function HeapReallocMem(p: Pointer; size: Integer): Pointer;
|
|
// Resize memory block.
|
|
begin
|
|
Result := HeapRealloc( HeapHandle, HeapFlags and (HEAP_NO_SERIALIZE and
|
|
HEAP_GENERATE_EXCEPTIONS and HEAP_ZERO_MEMORY),
|
|
// (Prevent using flag HEAP_REALLOC_IN_PLACE_ONLY here - to allow
|
|
// system to move the block if necessary).
|
|
p, size );
|
|
end;
|
|
|
|
{function HeapMemoryManagerSet: Boolean;
|
|
begin
|
|
Result := TRUE;
|
|
end;}
|
|
|
|
const
|
|
HeapMemoryManager: TMemoryManager = (
|
|
GetMem: HeapGetMem;
|
|
FreeMem: HeapFreeMem;
|
|
ReallocMem: HeapReallocMem);
|
|
|
|
var OldMM: TMemoryManager;
|
|
//OldIsMMset: function : Boolean;
|
|
|
|
initialization
|
|
|
|
{$IFDEF USE_PROCESS_HEAP}
|
|
HeapHandle := GetProcessHeap;
|
|
{$ELSE}
|
|
HeapHandle := HeapCreate( 0, 0, 0 );
|
|
{$ENDIF}
|
|
GetMemoryManager( OldMM );
|
|
//OldIsMMset := IsMemoryManagerSet;
|
|
//IsMemoryManagerSet := HeapMemoryManagerSet;
|
|
SetMemoryManager( HeapMemoryManager );
|
|
|
|
finalization
|
|
|
|
SetMemoryManager( OldMM );
|
|
//IsMemoryManagerSet := OldIsMMset;
|
|
{$IFNDEF USE_PROCESS_HEAP}
|
|
HeapDestroy( HeapHandle );
|
|
{$ENDIF}
|
|
|
|
end.
|