freepascal.compiler/packages/vcl-compat/src/system.diagnostics.pp

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 2023 the Free Pascal development team.

    Delphi compatibility unit to provide a stopwatch.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
// Todo: better resolution for non-windows, non-linux:
// macos should have mach_absolute_time somewhere.
// FreeBSD should have clock_gettime routines, but they seem not to be exposed in FPC units?
unit system.diagnostics;

{$mode objfpc}
{$modeswitch advancedrecords}

interface

uses System.TimeSpan;

const
  StopWatchResolution = 10*1000*1000; // 0.1 microsecond
  TicksPerMillisecond = 10*1000;
  TicksPerSecond      = StopWatchResolution;

type

  { TStopwatch }

  TStopwatch = record
  private
    class var _Frequency: Int64;
    class var _IsHighResolution: Boolean;
    class var _TickFrequency: Double;
    Class procedure _Init; static;
  private
    FElapsed: Int64;
    FRunning: Boolean;
    FStartTimeStamp: Int64;
    function GetElapsedTimespanTicks: Int64; inline;
    function GetElapsed: TTimeSpan;
    function GetElapsedMilliseconds: Int64;
    function GetElapsedTicks: Int64;
  public
    class function Create: TStopwatch; static;
    class function GetTimeStamp: Int64; static;
    class function StartNew: TStopwatch; static;
    class property Frequency: Int64 read _Frequency;
    class property IsHighResolution: Boolean read _IsHighResolution;
  public  
    procedure Reset;
    procedure Start;
    procedure Stop;
    property Elapsed: TTimeSpan read GetElapsed;
    property ElapsedMilliseconds: Int64 read GetElapsedMilliseconds;
    property ElapsedTicks: Int64 read GetElapsedTicks;
    property IsRunning: Boolean read FRunning;
  end;

implementation

uses
{$IFDEF FPC_DOTTEDUNITS}
  {$IFDEF WINDOWS}
  Winapi.Windows,
  {$ELSE}
  {$IFDEF LINUX}
  UnixApi.Types,
  LinuxApi,
  {$ENDIF LINUX}
  {$ENDIF WINDOWS}
  System.SysUtils;

{$ELSE FPC_DOTTEDUNITS}

  {$IFDEF WINDOWS}
  Windows,
  {$ELSE}
  {$IFDEF LINUX}
  UnixType,
  Linux,
  {$ENDIF LINUX}
  {$ENDIF WINDOWS}
  SysUtils;

{$ENDIF FPC_DOTTEDUNITS}

{ TStopwatch }

function TStopwatch.GetElapsedTimespanTicks: Int64;

begin
  Result:=ElapsedTicks;
  if _IsHighResolution then
    Result:=Trunc(Result*_TickFrequency);
end;


function TStopwatch.GetElapsed: TTimeSpan;

begin
  Result:=TTimeSpan.Create(GetElapsedTimeSpanTicks);
end;


function TStopwatch.GetElapsedMilliseconds: Int64;

begin
  Result:=GetElapsedTimeSpanTicks div TicksPerMillisecond;
end;


function TStopwatch.GetElapsedTicks: Int64;

begin
  Result:=FElapsed;
  if Not FRunning then
    exit;
  Result:=Result+GetTimeStamp-FStartTimeStamp;
end;


class function TStopwatch.Create: TStopwatch;

begin
  Result.Reset;
end;


class function TStopwatch.StartNew: TStopwatch;

begin
  Result.Reset;
  Result.Start;
end;


procedure TStopwatch.Reset;

begin
  FElapsed:=0;
  FRunning:=False;
  FStartTimeStamp:=0;
end;


procedure TStopwatch.Start;

begin
  if FRunning then
    exit;
  FRunning:=True;
  FStartTimeStamp:=GetTimeStamp;
end;


procedure TStopwatch.Stop;

begin
  if Not FRunning then
    exit;
  FRunning:=False;
  Inc(FElapsed,(GetTimeStamp-FStartTimeStamp));
end;


{$IFDEF LINUX}
class function TStopwatch.GetTimeStamp: Int64;

var
  res: timespec;

begin
  clock_gettime(CLOCK_MONOTONIC, @res);
  Result:=((Int64(1000000000)*res.tv_sec)+res.tv_nsec) div 100;
end;


class procedure TStopwatch._Init;

begin
  _IsHighResolution:=True;
  _Frequency:=StopWatchResolution;
  _TickFrequency:=1;
end;

{$ELSE UNIX}

{$IFDEF WINDOWS}
class function TStopwatch.GetTimeStamp: Int64;

begin
  if _IsHighResolution then
    QueryPerformanceCounter(Result)
  else
    Result:=GetTickCount64*TicksPerMillisecond;
end;


class procedure TStopWatch._Init;

begin
  _IsHighResolution:=QueryPerformanceFrequency(_Frequency);
  if _IsHighResolution then
    TStopWatch._TickFrequency:=StopWatchResolution/_Frequency
  else
    begin
    _TickFrequency:=1;
    _Frequency:=TicksPerSecond;
    end;
end;

{$ELSE WINDOWS}

class procedure TStopWatch._Init;

begin
  _IsHighResolution:=False;
  _TickFrequency:=1;
  _Frequency:=TicksPerSecond;
end;


class function TStopwatch.GetTimeStamp: Int64;
begin
  Result:=GetTickCount*TicksPerMillisecond;
end;

{$ENDIF WINDOWS}
{$ENDIF UNIX}

initialization
  TStopWatch._Init;
end.