Free Pascal allows you to write and use your own memory manager. The standard functions
GetMem, FreeMem, ReallocMem etc. use a special record in the system unit to do the actual memory
management. The system unit initializes this record with the system unit’s own memory manager,
but you can read and set this record using the GetMemoryManager and SetMemoryManager
calls:
                                                                            
                                                                            
procedure GetMemoryManager(var MemMgr: TMemoryManager);
 
procedure SetMemoryManager(const MemMgr: TMemoryManager);
the TMemoryManager record is defined as follows:
                                                                            
                                                                            
  TMemoryManager = record
 
    NeedLock    : Boolean;
 
    Getmem      : Function(Size:PtrInt):Pointer;
 
    Freemem     : Function(var p:pointer):PtrInt;
 
    FreememSize : Function(var p:pointer;Size:PtrInt):PtrInt;
 
    AllocMem    : Function(Size:PtrInt):Pointer;
 
    ReAllocMem  : Function(var p:pointer;Size:PtrInt):Pointer;
 
    MemSize     : function(p:pointer):PtrInt;
 
    InitThread          : procedure;
 
    DoneThread          : procedure;
 
    RelocateHeap        : procedure;
 
    GetHeapStatus       : function :THeapStatus;
 
    GetFPCHeapStatus    : function :TFPCHeapStatus;
 
  end;
As you can see, the elements of this record are mostly procedural variables. The system unit does
nothing but call these various variables when you allocate or deallocate memory.
Each of these fields corresponds to the corresponding call in the system unit. We’ll describe each
one of them:
     
- 
NeedLock 
 - This boolean indicates whether the memory manager needs a lock: if the memory
     manager itself is not thread-safe, then this can be set to True and the Memory routines
     will use a lock for all memory routines. If this field is set to False, no lock will be used.
     
 - 
Getmem 
 - This function allocates a new block on the heap. The block should be Size bytes
     long. The return value is a pointer to the newly allocated block.
     
 - 
Freemem 
 - should release a previously allocated block. The pointer P points to a previously
     allocated block. The Memory manager should implement a mechanism to determine
     what the size of the memory block is. 
     The return value is optional, and can be used to return the size of the freed memory.
     
 - 
FreememSize 
 - This function should release the memory pointed to by P. The argument Size
     is the expected size of the memory block pointed to by P. This should be disregarded,
     but can be used to check the behavior of the program.
     
 - 
AllocMem 
 - Is the same as getmem, only the allocated memory should be filled with zeros
     before the call returns.
     
 - 
ReAllocMem 
 - Should allocate a memory block of the specified Size, and should fill it with
     the contents of the memory block pointed to by P, truncating this to the new size of
     needed. After that, the memory pointed to by P may be deallocated. The return value
     is a pointer to the new memory block. Note that P may be Nil, in which case the
     behavior is equivalent to GetMem.
                                                                            
                                                                            
     
 - 
MemSize 
 - should return the size of the memory block P. This function may return zero if
     the memory manager does not allow to determine this information.
     
 - 
InitThread 
 - This routine is called when a new thread is started: it should initialize the heap
     structures for the current thread (if any).
     
 - 
DoneThread 
 - This routine is called when a thread is ended: it should clean up any heap
     structures for the current thread.
     
 - 
RelocateHeap 
 - Relocates the heap - this is only for thread-local heaps.
     
 - 
GetHeapStatus 
 - should  return  a  THeapStatus record  with  the  status  of  the  memory
     manager. This record should be filled with Delphi-compliant values.
     
 - 
GetHeapStatus 
 - should return a TFPCHeapStatus record with the status of the memory
     manager. This record should be filled with FPC-Compliant values.
 
To implement your own memory manager, it is sufficient to construct such a record and to issue a
call to SetMemoryManager.
To avoid conflicts with the system memory manager, setting the memory manager should happen
as soon as possible in the initialization of your program, i.e. before any call to getmem is
processed.
This means in practice that the unit implementing the memory manager should be the first in the
uses clause of your program or library, since it will then be initialized before all other units -
except the system unit itself, of course.
This also means that it is not possible to use the heaptrc unit in combination with a custom
memory manager, since the heaptrc unit uses the system memory manager to do all its
allocation. Putting the heaptrc unit after the unit implementing the memory manager would
overwrite the memory manager record installed by the custom memory manager, and vice
versa.
The following unit shows a straightforward implementation of a custom memory manager
using the memory manager of the C library. It is distributed as a package with Free
Pascal.
                                                                            
                                                                            
unit cmem;
 
 
interface
 
 
Const
 
  LibName = 'libc';
 
 
Function Malloc (Size : ptrint) : Pointer;
 
  cdecl; external LibName name 'malloc';
 
Procedure Free (P : pointer);
 
  cdecl; external LibName name 'free';
 
function ReAlloc (P : Pointer; Size : ptrint) : pointer;
 
  cdecl; external LibName name 'realloc';
 
Function CAlloc (unitSize,UnitCount : ptrint) : pointer;
 
  cdecl; external LibName name 'calloc';
 
 
implementation
 
 
type
 
  pptrint = ^ptrint;
 
 
Function CGetMem  (Size : ptrint) : Pointer;
 
 
begin
 
  CGetMem:=Malloc(Size+sizeof(ptrint));
 
  if (CGetMem <> nil) then
 
    begin
 
      pptrint(CGetMem)^ := size;
 
      inc(CGetMem,sizeof(ptrint));
 
    end;
 
end;
 
 
Function CFreeMem (P : pointer) : ptrint;
 
 
begin
 
  if (p <> nil) then
 
    dec(p,sizeof(ptrint));
 
  Free(P);
 
  CFreeMem:=0;
 
end;
 
 
Function CFreeMemSize(p:pointer;Size:ptrint):ptrint;
 
 
begin
 
  if size<=0 then
 
    begin
 
      if size<0 then
 
        runerror(204);
 
      exit;
                                                                            
                                                                            
 
    end;
 
  if (p <> nil) then
 
    begin
 
      if (size <> pptrint(p-sizeof(ptrint))^) then
 
        runerror(204);
 
    end;
 
  CFreeMemSize:=CFreeMem(P);
 
end;
 
 
Function CAllocMem(Size : ptrint) : Pointer;
 
 
begin
 
  CAllocMem:=calloc(Size+sizeof(ptrint),1);
 
  if (CAllocMem <> nil) then
 
    begin
 
      pptrint(CAllocMem)^ := size;
 
      inc(CAllocMem,sizeof(ptrint));
 
    end;
 
end;
 
 
Function CReAllocMem (var p:pointer;Size:ptrint):Pointer;
 
 
begin
 
  if size=0 then
 
    begin
 
      if p<>nil then
 
        begin
 
          dec(p,sizeof(ptrint));
 
          free(p);
 
          p:=nil;
 
        end;
 
    end
 
  else
 
    begin
 
      inc(size,sizeof(ptrint));
 
      if p=nil then
 
        p:=malloc(Size)
 
      else
 
        begin
 
          dec(p,sizeof(ptrint));
 
          p:=realloc(p,size);
 
        end;
 
      if (p <> nil) then
 
        begin
 
          pptrint(p)^ := size-sizeof(ptrint);
 
          inc(p,sizeof(ptrint));
 
        end;
 
    end;
 
  CReAllocMem:=p;
 
end;
 
 
Function CMemSize (p:pointer): ptrint;
 
 
begin
                                                                            
                                                                            
 
  CMemSize:=pptrint(p-sizeof(ptrint))^;
 
end;
 
 
function CGetHeapStatus:THeapStatus;
 
 
var res: THeapStatus;
 
 
begin
 
  fillchar(res,sizeof(res),0);
 
  CGetHeapStatus:=res;
 
end;
 
 
function CGetFPCHeapStatus:TFPCHeapStatus;
 
 
begin
 
  fillchar(CGetFPCHeapStatus,sizeof(CGetFPCHeapStatus),0);
 
end;
 
 
Const
 
 CMemoryManager : TMemoryManager =
 
    (
 
      NeedLock : false;
 
      GetMem : @CGetmem;
 
      FreeMem : @CFreeMem;
 
      FreememSize : @CFreememSize;
 
      AllocMem : @CAllocMem;
 
      ReallocMem : @CReAllocMem;
 
      MemSize : @CMemSize;
 
      InitThread : Nil;
 
      DoneThread : Nil;
 
      RelocateHeap : Nil;
 
      GetHeapStatus : @CGetHeapStatus;
 
      GetFPCHeapStatus: @CGetFPCHeapStatus;
 
    );
 
 
Var
 
  OldMemoryManager : TMemoryManager;
 
 
Initialization
 
  GetMemoryManager (OldMemoryManager);
 
  SetMemoryManager (CmemoryManager);
 
 
Finalization
 
  SetMemoryManager (OldMemoryManager);
 
end.