home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / AEXMPSRC.RAR / MEMMGR / MEMMGREX.PAS next >
Pascal/Delphi Source File  |  2000-08-15  |  4KB  |  133 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples  Version 2.1             █}
  4. {█      TMemoryManager Interface Example                 █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 192000 vpascal.com                 █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. {$Delphi+,H-,Use32+}
  11.  
  12. { Replaces the default memory manager with a wrapper that }
  13. { allows performance data to be collected.  It then runs  }
  14. { a simple program and outputs the data collected by the  }
  15. { new memory manager.                                     }
  16.  
  17. { This example only works on Pentium class processors, as }
  18. { the RDTSC instruction is used for high-accuracy timing. }
  19.  
  20. { NOTE: Modify the CPUSpeed constant of the Timers unit   }
  21. {       to get accurate results in milli-seconds.         }
  22.  
  23. program MemMgrEx;
  24.  
  25. {&PMTYPE VIO}
  26.  
  27. uses
  28.   P5Timer, PerfMgr, SysUtils, Classes;
  29.  
  30. const
  31.   // Contains the total time spent in the memory manager for all tests
  32.   TotalMemMgr: Double = 0;
  33.  
  34. procedure ResetCalls;
  35. begin
  36.   GetMemCalls := 0;
  37.   FreeMemCalls := 0;
  38.   ReAllocMemCalls := 0;
  39. end;
  40.  
  41. procedure ShowStats(const _What: ShortString);
  42. var
  43.   strGet: String;
  44.   strFree: String;
  45.   strReAlloc: String;
  46.   callGet: Longint;
  47.   callFree: Longint;
  48.   callReAlloc: Longint;
  49. begin
  50.   // Pause overall timer
  51.   tmPause(4);
  52.  
  53.   // Get performance data before displaying it, as calling WriteLn and
  54.   // Format is likely to use the memory manager
  55.   TotalMemMgr := TotalMemMgr + tmElapsed(cGetMem) + tmElapsed(cFreeMem) + tmElapsed(cReAllocMem);
  56.   strGet := tmStop(cGetMem);
  57.   strFree := tmStop(cFreeMem);
  58.   strReAlloc := tmStop(cReAllocMem);
  59.   callGet := GetMemCalls;
  60.   callFree := FreeMemCalls;
  61.   callReAlloc := ReAllocMemCalls;
  62.  
  63.   Writeln;
  64.   Writeln(Format('Test: %-20s Total Calls    Time/msec', [_What]));
  65.   Writeln(Format('%15s GetMem     %11d %12s', ['-', callGet, strGet]));
  66.   Writeln(Format('%15s FreeMem    %11d %12s', ['-', callFree,strFree]));
  67.   Writeln(Format('%15s ReAllocMem %11d %12s', ['-', callReAlloc, strReAlloc]));
  68.  
  69.   ResetCalls;
  70.   // Restart overall timer
  71.   tmStart(4);
  72. end;
  73.  
  74. function Hello: AnsiString;
  75. begin
  76.   Result := 'Hello, World!';
  77. end;
  78.  
  79. procedure Example;
  80. var
  81.   p: Pointer;
  82.   S: AnsiString;
  83.   i: Longint;
  84.   t: tStringList;
  85. begin
  86.   ResetCalls;
  87.   for i := 1 to 1000 do
  88.     begin
  89.       GetMem(P, i);
  90.       ReAllocMem(P, i*3);
  91.       FreeMem(P);
  92.     end;
  93.   ShowStats('Simple Get/FreeMem');
  94.  
  95.   s := '';
  96.   for i := 1 to 1000 do
  97.     try
  98.       raise Exception.CreateFmt('An error occured, i=%d', [i]);
  99.     except
  100.       on E:Exception do
  101.         s := s + E.Message;
  102.     end;
  103.   ShowStats('Exceptions');
  104.  
  105.   t := tStringList.Create;
  106.   s := 'Initial String';
  107.   for i := 1 to 1000 do
  108.     begin
  109.       s := s + Hello + IntToStr(i);
  110.       t.Add(s);
  111.     end;
  112.   t.Free;
  113.   ShowStats('TStringList usage');
  114. end;
  115.  
  116. begin
  117.   WriteLn('TMemoryManager Example    Version 2.10 Copyright (C) 192000 vpascal.com');
  118.   Writeln('  ** This example runs on Pentium machines Only **');
  119.   tmStart(4); // Start a timer monitoring overall time
  120.  
  121.   Example;
  122.  
  123.   Writeln;
  124.   Writeln('              ------------------------');
  125.   Writeln(Format('  Total execution time       : %20s msec', [tmStop(4)]));
  126.   Writeln(Format('  Of which Memory Management : %20.2f msec', [TotalMemMgr]));
  127.   Writeln;
  128.   Write('Enter>');
  129.   ReadLn;
  130. end.
  131.  
  132.  
  133.