home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
vp21beta.zip
/
AEXMPSRC.RAR
/
MEMMGR
/
PERFMGR.PAS
< prev
Wrap
Pascal/Delphi Source File
|
2000-08-15
|
2KB
|
74 lines
{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█ █}
{█ Virtual Pascal Examples Version 2.1 █}
{█ Implements TMemoryManager replacement █}
{█ ─────────────────────────────────────────────────█}
{█ Copyright (C) 192000 vpascal.com █}
{█ █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
{$Delphi+,Use32+}
unit PerfMgr;
interface
const
GetMemCalls : Longint = 0; // Number of calls to
FreeMemCalls : Longint = 0; // each of the Memory Manager
ReAllocMemCalls : Longint = 0; // routines
const
cGetMem = 1; // Timer indices used
cFreeMem = 2;
cReAllocMem = 3;
implementation
uses
P5Timer;
var
VPMemMan: TMemoryManager; // Original memory manager
// Implementation of new memory manager
function PerfGetMem(Size: Longint): Pointer;
begin
tmStart( cGetMem ); // Start GetMem timer
inc( GetMemCalls ); // Inc calls to GetMem
Result := VPMemMan.GetMem(Size); // Get memory
tmPause( cGetMem ); // Pause GetMem timer
end;
function PerfFreeMem(P: Pointer): Longint;
begin
tmStart( cFreeMem ); // Start FreeMem timer
inc( FreeMemCalls ); // Inc calls to FreeMem
Result := VPMemMan.FreeMem(P); // Free memory
tmPause( cFreeMem ); // Pause FreeMem timer
end;
function PerfReallocMem(P: Pointer; Size: Longint): Pointer;
begin
tmStart( cReAllocMem ); // Start ReAllocMem timer
inc( ReAllocMemCalls ); // Inc calls to ReAllocMem
Result := VPMemMan.ReAllocMem(P, Size); // ReAlloc memory
tmPause( cReAllocMem ); // Pause ReAllocMem timer
end;
const
NewManager: TMemoryManager = (
GetMem: PerfGetMem;
FreeMem: PerfFreeMem;
ReallocMem: PerfReallocMem);
// Unit initialization code installs the new memory manager
initialization
GetMemoryManager(VPMemMan);
SetMemoryManager(NewManager);
finalization
SetMemoryManager(VPMemMan);
end.