home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / AEXMPSRC.RAR / MEMMGR / PERFMGR.PAS < prev   
Pascal/Delphi Source File  |  2000-08-15  |  2KB  |  74 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples  Version 2.1             █}
  4. {█      Implements TMemoryManager replacement            █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 192000 vpascal.com                 █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. {$Delphi+,Use32+}
  11.  
  12. unit PerfMgr;
  13.  
  14. interface
  15.  
  16. const
  17.   GetMemCalls     : Longint = 0;                // Number of calls to
  18.   FreeMemCalls    : Longint = 0;                // each of the Memory Manager
  19.   ReAllocMemCalls : Longint = 0;                // routines
  20.  
  21. const
  22.   cGetMem     = 1;                              // Timer indices used
  23.   cFreeMem    = 2;
  24.   cReAllocMem = 3;
  25.  
  26. implementation
  27.  
  28. uses
  29.   P5Timer;
  30.  
  31. var
  32.   VPMemMan: TMemoryManager;                     // Original memory manager
  33.  
  34. // Implementation of new memory manager
  35.  
  36. function PerfGetMem(Size: Longint): Pointer;
  37. begin
  38.   tmStart( cGetMem );                           // Start GetMem timer
  39.   inc( GetMemCalls );                           // Inc calls to GetMem
  40.   Result := VPMemMan.GetMem(Size);              // Get memory
  41.   tmPause( cGetMem );                           // Pause GetMem timer
  42. end;
  43.  
  44. function PerfFreeMem(P: Pointer): Longint;
  45. begin
  46.   tmStart( cFreeMem );                          // Start FreeMem timer
  47.   inc( FreeMemCalls );                          // Inc calls to FreeMem
  48.   Result := VPMemMan.FreeMem(P);                // Free memory
  49.   tmPause( cFreeMem );                          // Pause FreeMem timer
  50. end;
  51.  
  52. function PerfReallocMem(P: Pointer; Size: Longint): Pointer;
  53. begin
  54.   tmStart( cReAllocMem );                       // Start ReAllocMem timer
  55.   inc( ReAllocMemCalls );                       // Inc calls to ReAllocMem
  56.   Result := VPMemMan.ReAllocMem(P, Size);       // ReAlloc memory
  57.   tmPause( cReAllocMem );                       // Pause ReAllocMem timer
  58. end;
  59.  
  60. const
  61.   NewManager: TMemoryManager = (
  62.     GetMem: PerfGetMem;
  63.     FreeMem: PerfFreeMem;
  64.     ReallocMem: PerfReallocMem);
  65.  
  66. // Unit initialization code installs the new memory manager
  67.  
  68. initialization
  69.   GetMemoryManager(VPMemMan);
  70.   SetMemoryManager(NewManager);
  71. finalization
  72.   SetMemoryManager(VPMemMan);
  73. end.
  74.