/// unit obsahujucu novy memory manager, pre lepsie sledovanie alokacie a dealokacie pamate pri debugovani kodu
{$I main.inc}
unit memorymanager;

interface

type
// record obsahujuci pocty alokacii a uvolneni pamate (ak sa zhoduju, tak v programe s velkou pravdepodobnostou nie je memory leak)
  TMemStatus = record
    getmemcount:integer;
    freememcount:integer;
  end;

//function getmemdiff: Integer;

var
  fp: TMemStatus;
  OldMemMgr: TMemoryManager;


implementation
(*
function getmemdiff: Integer;
begin
  fp.getmemcount - fp.freememcount;
end;
*)

/// funkcia volana pri alokovani pamate metodou getmem, zvysuje pocitadlo alokacii pamate,
/// vracia pointer na novo alokovanu pamat
function NewGetMem(Size: Integer): Pointer;
begin
  Inc(fp.GetMemCount);
  Result := OldMemMgr.GetMem(Size);
end;

/// funkcia volana pri dealokovani pamate metodou freemem, zvysuje pocitadlo alokacii pamate,
/// vracia pointer na novo alokovanu pamat
function NewFreeMem(P: Pointer): Integer;
begin
  Inc(fp.FreeMemCount);
  Result := OldMemMgr.FreeMem(P);
end;

/// funkcia volana pri realokovani pamate metodou reallocmem, zvysuje potencialne obe pocidla (ak nebol vstupny pointer = nil),
/// vracia pointer na novo alokovanu pamat
function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  result := OldMemMgr.ReallocMem(p,size);
  if (p <> nil) then begin
    Inc(fp.FreeMemCount);
  if size > 0 then
    Inc(fp.GetMemCount);
  end
  else begin
   if size > 0 then Inc(fp.GetMemCount);
  end;
end;

const
  NewMemMgr: TMemoryManager = (GetMem: NewGetMem; FreeMem: NewFreeMem; ReallocMem: NewReallocMem);

/// procedura, ktora nastavani novy memory manager namiesto povodneho
procedure SetNewMemMgr;
begin
  fp.getmemcount := 0;
  fp.freememcount := 0;
  GetMemoryManager(OldMemMgr);
  SetMemoryManager(NewMemMgr);
end;

{$IFDEF MEMMANAGER}
initialization
  SetNewMemMgr;
{$ENDIF}
end.
