unit globalmemorymanager;

(*
  Windows API で直接メモリを確保するメモリマネージャ（遅い）
  dprファイルの最初でusesする
*)

{..$DEFINE REPLACE_MANAGER}


interface

function NewGetMem(Size: Integer): Pointer;
function NewFreeMem(P: Pointer): Integer;
function NewReallocMem(P: Pointer; Size: Integer): Pointer;


implementation

uses
  Windows;

function NewGetMem(Size: Integer): Pointer;
begin
  Result := Pointer(GlobalAlloc(GMEM_FIXED,Size));
end;

function NewFreeMem(P: Pointer): Integer;
begin
  Result := GlobalFree(HGLOBAL(P));
end;

function NewReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  Result := Pointer(GlobalReAlloc(HGLOBAL(P),Size,GMEM_MOVEABLE));
end;

{$IFDEF REPLACE_MANAGER}
var
  OldMgr: TMemoryManager;

const
  NewMgr: TMemoryManager =
  (
    GetMem: NewGetMem;
    FreeMem: NewFreeMem;
    ReAllocMem: NewReAllocMem;
  );

procedure Startup;
begin
  GetMemoryManager(OldMgr);
  SetMemoryManager(NewMgr);
end;

procedure Cleanup;
begin
  SetMemoryManager(OldMgr);
end;

initialization
  Startup;
finalization
  Cleanup;
{$ENDIF}

end.
