unit tracemm;

interface

threadvar

 AllocMemCount   : NativeInt;
 ReallocMemCount : NativeInt;
 FreeMemCount    : NativeInt;

implementation

var

 OldMM : TMemoryManagerEx;
 NewMM : TMemoryManagerEx;

function NewGetMem(Size : NativeInt) : Pointer;
begin

 Inc(AllocMemCount);

 Result := OldMM.GetMem(Size);

end;

function NewFreeMem(P : Pointer): Integer;
begin

 Inc(FreeMemCount);

 Result := OldMM.FreeMem(P);

end;

function NewReallocMem(P : Pointer; Size : NativeInt) : Pointer;
begin

 Inc(ReallocMemCount);

 Result := OldMM.ReallocMem(P, Size);

end;

function NewAllocMem(Size : NativeInt) : Pointer;
begin

 Inc(AllocMemCount);

 Result := OldMM.AllocMem(Size);

end;

initialization

 GetMemoryManager(OldMM);

 NewMM := OldMM;

 NewMM.GetMem     := @NewGetMem;
 NewMM.FreeMem    := @NewFreeMem;
 NewMM.ReallocMem := @NewReallocMem;
 NewMM.AllocMem   := @NewAllocMem;

 SetMemoryManager(NewMM);

finalization

 SetMemoryManager(OldMM);

end.