{******************************************************************************}
{                                                                              }
{ Project JEDI Code Library (JCL)                                              }
{                                                                              }
{ The contents of this file are subject to the Mozilla Public License Version  }
{ 1.1 (the "License"); you may not use this file except in compliance with the }
{ License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ }
{                                                                              }
{ Software distributed under the License is distributed on an "AS IS" basis,   }
{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for }
{ the specific language governing rights and limitations under the License.    }
{                                                                              }
{ The Original Code is JclCounter.pas.                                         }
{                                                                              }
{ The Initial Developer of the Original Code is documented in the accompanying }
{ help file JCL.chm. Portions created by these individuals are Copyright (C)   }
{ of these individuals.                                                        }
{                                                                              }
{******************************************************************************}
{                                                                              }
{ This unit contains a high performance counter class which can be used for    }
{ highly accurate timing.                                                      }
{                                                                              }
{ Unit owner: Marcel van Brakel                                                }
{ Last modified: November 25, 2001                                             }
{                                                                              }
{******************************************************************************}

unit JclCounter;

{$I jcl.inc}

{$WEAKPACKAGEUNIT ON}

interface

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  Libc,
  {$ENDIF UNIX}
  JclBase;

type
  TJclCounter = class (TObject)
  private
    FCounting: Boolean;
    FElapsedTime: Float;
    FOverhead: Int64;
    FOverallElapsedTime: Float;
    FFrequency: Int64;
    FStart: Int64;
    FStop: Int64;

    {$IFDEF UNIX}
    FTimeval: TTimeval;
    {$ENDIF}

  protected
    function GetRunElapsedTime: Float;

  public
    constructor Create(const Compensate: Boolean = False);
    procedure Continue;
    procedure Start;
    function Stop: Float;

    property Counting: Boolean read FCounting;
    property ElapsedTime: Float read FElapsedTime;
    property Overhead: Int64 read FOverhead;
    property RunElapsedTime: Float read GetRunElapsedTime;
  end;

procedure ContinueCount(var Counter: TJclCounter);
procedure StartCount(var Counter: TJclCounter; const Compensate: Boolean = False);
function StopCount(var Counter: TJclCounter): Float;

type
  EJclCounterError = class (EJclError);

implementation

uses
  SysUtils,
  JclResources;

//------------------------------------------------------------------------------

constructor TJclCounter.Create(const Compensate: Boolean);
const
  Iterations: Integer = 10000;

var
  Count: Integer;
  TmpOverhead: Int64;

begin
  inherited Create;

  {$IFDEF MSWINDOWS}
  if not QueryPerformanceFrequency(FFrequency) then
    raise EJclCounterError.CreateResRec(@RsNoCounter);
  {$ENDIF}

  {$IFDEF UNIX}
  FFrequency := 100000;  // 1 sec = 10E6 microseconds, therefor we have to devide by 10E5
  {$ENDIF}

  FCounting := False;
  FOverhead := 0;

  if Compensate then
  begin
    // Determine overhead associated with calling of the Start and Stop methods.
    // This allows the Stop method to compensate for it and return a more
    // accurate result. Thanks to John O'Harrow (john@elmcrest.demon.co.uk)

   TmpOverhead := 0;

   for Count := 0 to Iterations do
   begin
     Start;
     Stop;
     TmpOverhead := TmpOverhead + (FStop - FStart);
   end;

   FOverHead := Round(TmpOverhead / Iterations);
  end;

  FOverallElapsedTime := 0;
  FElapsedTime := 0;
end;

//------------------------------------------------------------------------------

procedure TJclCounter.Start;
begin
  FCounting := True;
  FElapsedTime := 0;
  FOverallElapsedTime := 0;

  {$IFDEF MSWINDOWS}
    QueryPerformanceCounter(FStart);
  {$ENDIF}

  {$IFDEF UNIX}
    GetTimeOfDay(FTimeval, nil);
    FStart := FTimeval.tv_sec * 100000 + (FTimeval.tv_usec);
  {$ENDIF}
end;

//------------------------------------------------------------------------------

function TJclCounter.Stop: Float;
begin
  {$IFDEF MSWINDOWS}
  QueryPerformanceCounter(FStop);
  {$ENDIF}

  {$IFDEF UNIX}
    GetTimeOfDay(FTimeval, nil);
    FStop := FTimeval.tv_sec * 100000 + (FTimeval.tv_usec);
  {$ENDIF}

  FCounting := False;

  FElapsedTime := FOverallElapsedTime + ((FStop - FStart - FOverhead) / FFrequency);
  FOverallElapsedTime := FElapsedTime;
  Result := FElapsedTime;
end;

//------------------------------------------------------------------------------

function TJclCounter.GetRunElapsedTime: Float;
var
  TimeNow: Int64;

begin
  {$IFDEF MSWINDOWS}
    QueryPerformanceCounter(TimeNow);
  {$ENDIF}

  {$IFDEF UNIX}
    GetTimeOfDay(FTimeval, nil);
    TimeNow := FTimeval.tv_sec * 100000 + (FTimeval.tv_usec);
  {$ENDIF}

  Result := FOverallElapsedTime + ((TimeNow - FStart - FOverhead) / FFrequency);
end;

//------------------------------------------------------------------------------

procedure TJclCounter.Continue;
var
  Overall: Float;

begin
   if not(FCounting) then
   begin
     Overall := FOverallElapsedTime;
     Start;
     FOverallElapsedTime := Overall;
   end;
end;

//------------------------------------------------------------------------------

procedure StartCount(var Counter: TJclCounter; const Compensate: Boolean = False);
begin
  Counter := TJclCounter.Create(Compensate);
  Counter.Start;
end;

//------------------------------------------------------------------------------

function StopCount(var Counter: TJclCounter): Float;
begin
  if Counter <> nil then
  begin
    Result := Counter.Stop;
    FreeAndNil(Counter);
  end
  else
    Result := 0.0;
end;

//------------------------------------------------------------------------------

procedure ContinueCount(var Counter: TJclCounter);
begin
  if Counter <> nil then
    Counter.Continue;
end;

end.