{ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ}
{Û                                                       Û}
{Û      Virtual Pascal Examples  Version 2.1             Û}
{Û      TMemoryManager Interface Example                 Û}
{Û      ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÛ}
{Û      Copyright (C) 192000 vpascal.com                 Û}
{Û                                                       Û}
{ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}

{$Delphi+,H-,Use32+}

{ Replaces the default memory manager with a wrapper that }
{ allows performance data to be collected.  It then runs  }
{ a simple program and outputs the data collected by the  }
{ new memory manager.                                     }

{ This example only works on Pentium class processors, as }
{ the RDTSC instruction is used for high-accuracy timing. }

{ NOTE: Modify the CPUSpeed constant of the Timers unit   }
{       to get accurate results in milli-seconds.         }

program MemMgrEx;

{&PMTYPE VIO}

uses
  P5Timer, PerfMgr, SysUtils, Classes;

const
  // Contains the total time spent in the memory manager for all tests
  TotalMemMgr: Double = 0;

procedure ResetCalls;
begin
  GetMemCalls := 0;
  FreeMemCalls := 0;
  ReAllocMemCalls := 0;
end;

procedure ShowStats(const _What: ShortString);
var
  strGet: String;
  strFree: String;
  strReAlloc: String;
  callGet: Longint;
  callFree: Longint;
  callReAlloc: Longint;
begin
  // Pause overall timer
  tmPause(4);

  // Get performance data before displaying it, as calling WriteLn and
  // Format is likely to use the memory manager
  TotalMemMgr := TotalMemMgr + tmElapsed(cGetMem) + tmElapsed(cFreeMem) + tmElapsed(cReAllocMem);
  strGet := tmStop(cGetMem);
  strFree := tmStop(cFreeMem);
  strReAlloc := tmStop(cReAllocMem);
  callGet := GetMemCalls;
  callFree := FreeMemCalls;
  callReAlloc := ReAllocMemCalls;

  Writeln;
  Writeln(Format('Test: %-20s Total Calls    Time/msec', [_What]));
  Writeln(Format('%15s GetMem     %11d %12s', ['-', callGet, strGet]));
  Writeln(Format('%15s FreeMem    %11d %12s', ['-', callFree,strFree]));
  Writeln(Format('%15s ReAllocMem %11d %12s', ['-', callReAlloc, strReAlloc]));

  ResetCalls;
  // Restart overall timer
  tmStart(4);
end;

function Hello: AnsiString;
begin
  Result := 'Hello, World!';
end;

procedure Example;
var
  p: Pointer;
  S: AnsiString;
  i: Longint;
  t: tStringList;
begin
  ResetCalls;
  for i := 1 to 1000 do
    begin
      GetMem(P, i);
      ReAllocMem(P, i*3);
      FreeMem(P);
    end;
  ShowStats('Simple Get/FreeMem');

  s := '';
  for i := 1 to 1000 do
    try
      raise Exception.CreateFmt('An error occured, i=%d', [i]);
    except
      on E:Exception do
        s := s + E.Message;
    end;
  ShowStats('Exceptions');

  t := tStringList.Create;
  s := 'Initial String';
  for i := 1 to 1000 do
    begin
      s := s + Hello + IntToStr(i);
      t.Add(s);
    end;
  t.Free;
  ShowStats('TStringList usage');
end;

begin
  WriteLn('TMemoryManager Example    Version 2.10 Copyright (C) 192000 vpascal.com');
  Writeln('  ** This example runs on Pentium machines Only **');
  tmStart(4); // Start a timer monitoring overall time

  Example;

  Writeln;
  Writeln('              ------------------------');
  Writeln(Format('  Total execution time       : %20s msec', [tmStop(4)]));
  Writeln(Format('  Of which Memory Management : %20.2f msec', [TotalMemMgr]));
  Writeln;
  Write('Enter>');
  ReadLn;
end.


