src/shared/xprofiler.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 // stopwatch timer to measure short periods (like frame rendering phases)
  17 {$INCLUDE a_modes.inc}
  18 {.$DEFINE XPROFILER_SLOW_AVERAGE}
  19 unit xprofiler;
  20
  21 interface
  22
  23 uses
  24   SysUtils,
  25   {$IF DEFINED(LINUX)}
  26     {$DEFINE STOPWATCH_IS_HERE}
  27     unixtype, linux
  28   {$ELSEIF DEFINED(WINDOWS)}
  29     {$DEFINE STOPWATCH_IS_HERE}
  30     Windows
  31   {$ELSEIF DEFINED(HAIKU)}
  32     {$DEFINE STOPWATCH_IS_HERE}
  33     unixtype
  34   {$ELSE}
  35     {$IFDEF STOPWATCH_IS_HERE}
  36       {$UNDEF STOPWATCH_IS_HERE}
  37     {$ENDIF}
  38     {$WARNING You suck!}
  39   {$ENDIF}
  40   ;
  41
  42 {$IF DEFINED(STOPWATCH_IS_HERE)}
  43 type
  44   TStopWatch = record
  45   strict private
  46     mElapsed: Int64;
  47     mRunning: Boolean;
  48     mStartPosition: UInt64;
  49
  50   strict private
  51     procedure updateElapsed ();
  52
  53     function getElapsedMicro (): Int64;
  54     function getElapsedMilli (): Int64;
  55
  56   public
  57     class function Create (): TStopWatch; static;
  58     class function startNew (): TStopWatch; static;
  59
  60   public
  61     procedure clear (); inline; // full clear
  62     procedure start (reset: Boolean=true); // start or restart timer
  63     procedure stop ();
  64     // the following is like start/stop, but doesn't reset elapsed time
  65     procedure pause ();
  66     procedure resume ();
  67
  68     property elapsedMicro: Int64 read getElapsedMicro;
  69     property elapsedMilli: Int64 read getElapsedMilli;
  70     property isRunning: Boolean read mRunning;
  71   end;
  72 {$ENDIF}
  73
  74
  75 const
  76   TProfHistorySize = 1000;
  77
  78 type
  79   TProfilerBar = record
  80   private
  81     //const FilterFadeoff = 0.05; // 5%
  82
  83   private
  84     history: array of Integer; // circular buffer
  85     hisLast: Integer;
  86     //curval: Single;
  87     curAccum: UInt64;
  88     curAccumCount: Integer;
  89     mName: AnsiString;
  90     mLevel: Integer;
  91
  92   private
  93     procedure initialize (aHistSize: Integer); inline;
  94     function getvalue (): Integer; inline;
  95     function getvalat (idx: Integer): Integer; inline;
  96     function getcount (): Integer; inline;
  97
  98   public
  99     procedure update (val: Integer);
 100
 101     property value: Integer read getvalue;
 102     property name: AnsiString read mName;
 103     property level: Integer read mLevel;
 104     property count: Integer read getcount;
 105     property values[idx: Integer]: Integer read getvalat;
 106   end;
 107
 108   TProfiler = class(TObject)
 109   private
 110     {$IF DEFINED(STOPWATCH_IS_HERE)}
 111     type
 112       PProfSection = ^TProfSection;
 113       TProfSection = record
 114         name: AnsiString;
 115         timer: TStopWatch;
 116         level: Integer;
 117         prevAct: Integer; // this serves as stack
 118       end;
 119
 120     var
 121       xptimer: TStopWatch;
 122       xpsecs: array of TProfSection;
 123       xpsused: Integer;
 124       xpscur: Integer; // currently running section
 125     {$ENDIF}
 126
 127   public
 128     bars: array of TProfilerBar; // 0: total time
 129     name: AnsiString;
 130     histSize: Integer;
 131
 132   public
 133     constructor Create (aName: AnsiString; aHistSize: Integer);
 134     destructor Destroy (); override;
 135
 136     // call this on frame start
 137     procedure mainBegin (reallyActivate: Boolean=true);
 138     // call this on frame end
 139     procedure mainEnd ();
 140
 141     procedure sectionBegin (aName: AnsiString);
 142     procedure sectionEnd ();
 143
 144     // this will reuse the section with the given name (if there is any); use `sectionEnd()` to end it as usual
 145     procedure sectionBeginAccum (aName: AnsiString);
 146   end;
 147
 148
 149 function getTimeMicro (): UInt64; inline;
 150 function getTimeMilli (): UInt64; inline;
 151
 152
 153 implementation
 154
 155 {$IF DEFINED(LINUX)}
 156 type THPTimeType = TTimeSpec;
 157 {$ELSE}
 158 type THPTimeType = Int64;
 159 {$ENDIF}
 160
 161 var
 162   mFrequency: Int64 = 0;
 163   mHasHPTimer: Boolean = false;
 164
 165
 166 // ////////////////////////////////////////////////////////////////////////// //
 167 procedure initTimerIntr ();
 168 var
 169   r: THPTimeType;
 170 begin
 171   if (mFrequency = 0) then
 172   begin
 173 {$IF DEFINED(LINUX)}
 174     if (clock_getres(CLOCK_MONOTONIC, @r) <> 0) then raise Exception.Create('profiler error: cannot get timer resolution');
 175     mHasHPTimer := (r.tv_nsec <> 0);
 176     if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available');
 177     mFrequency := 1; // just a flag
 178     if (r.tv_nsec <> 0) then mFrequency := 1000000000000000000 div r.tv_nsec;
 179 {$ELSEIF DEFINED(WINDOWS)}
 180     mHasHPTimer := QueryPerformanceFrequency(r);
 181     if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available');
 182     mFrequency := r;
 183 {$ENDIF}
 184   end;
 185 end;
 186
 187
 188 function getTimeMicro (): UInt64; inline;
 189 var
 190   r: THPTimeType;
 191 begin
 192   //if (mFrequency = 0) then initTimerIntr();
 193   {$IF DEFINED(LINUX)}
 194   clock_gettime(CLOCK_MONOTONIC, @r);
 195   result := UInt64(r.tv_sec)*1000000+UInt64(r.tv_nsec) div 1000; // microseconds
 196   {$ELSEIF DEFINED(WINDOWS)}
 197   QueryPerformanceCounter(r);
 198   result := UInt64(r)*1000000 div mFrequency;
 199   {$ENDIF}
 200 end;
 201
 202
 203 function getTimeMilli (): UInt64; inline;
 204 begin
 205   result := getTimeMicro div 1000;
 206 end;
 207
 208
 209 // ////////////////////////////////////////////////////////////////////////// //
 210 class function TStopWatch.Create (): TStopWatch;
 211 begin
 212   result.clear();
 213 end;
 214
 215
 216 class function TStopWatch.startNew (): TStopWatch;
 217 begin
 218   result := TStopWatch.Create();
 219   result.start();
 220 end;
 221
 222
 223 procedure TStopWatch.updateElapsed ();
 224 var
 225   e: UInt64;
 226 begin
 227   e := getTimeMicro();
 228   if (mStartPosition > e) then mStartPosition := e;
 229   Inc(mElapsed, e-mStartPosition);
 230   mStartPosition := e;
 231 end;
 232
 233
 234 function TStopWatch.getElapsedMicro (): Int64;
 235 begin
 236   if mRunning then updateElapsed();
 237   result := mElapsed; // microseconds
 238 end;
 239
 240
 241 function TStopWatch.getElapsedMilli (): Int64;
 242 begin
 243   if mRunning then updateElapsed();
 244   result := mElapsed div 1000; // milliseconds
 245 end;
 246
 247
 248 procedure TStopWatch.clear ();
 249 begin
 250   mElapsed := 0;
 251   mRunning := false;
 252   mStartPosition := 0;
 253 end;
 254
 255
 256 procedure TStopWatch.start (reset: Boolean=true);
 257 begin
 258   if mRunning and not reset then exit; // nothing to do
 259   mStartPosition := getTimeMicro();
 260   mRunning := true;
 261   if (reset) then mElapsed := 0;
 262 end;
 263
 264
 265 procedure TStopWatch.stop ();
 266 begin
 267   if not mRunning then exit;
 268   mRunning := false;
 269   updateElapsed();
 270 end;
 271
 272
 273 procedure TStopWatch.pause ();
 274 begin
 275   stop();
 276 end;
 277
 278
 279 procedure TStopWatch.resume ();
 280 begin
 281   if mRunning then exit;
 282   start(false); // don't reset
 283 end;
 284
 285
 286 // ////////////////////////////////////////////////////////////////////////// //
 287 procedure TProfilerBar.initialize (aHistSize: Integer); begin SetLength(history, aHistSize); hisLast := -1; curAccum := 0; curAccumCount := 0; end;
 288
 289 procedure TProfilerBar.update (val: Integer);
 290 var
 291   idx: Integer;
 292 begin
 293   if (val < 0) then val := 0; //else if (val > 1000000) val := 1000000;
 294   if (hisLast = -1) then begin hisLast := High(history); curAccum := 0; curAccumCount := 0; for idx := 0 to High(history) do history[idx] := val; end;
 295   if (curAccumCount = Length(history)) then Dec(curAccum, UInt64(history[(hisLast+1) mod Length(history)])) else Inc(curAccumCount);
 296   Inc(hisLast);
 297   if (hisLast >= Length(history)) then hisLast := 0;
 298   Inc(curAccum, UInt64(val));
 299   history[hisLast] := val;
 300   //curval := FilterFadeoff*val+(1.0-FilterFadeoff)*curval;
 301 end;
 302
 303 function TProfilerBar.getvalue (): Integer;
 304 {$IFDEF XPROFILER_SLOW_AVERAGE}
 305 var idx: Integer;
 306 {$ENDIF}
 307 begin
 308   {$IFDEF XPROFILER_SLOW_AVERAGE}
 309   result := 0;
 310   for idx := 0 to High(history) do Inc(result, history[idx]);
 311   result := result div Length(history);
 312   {$ELSE}
 313   //result := round(curval);
 314   if curAccumCount > 0 then result := Integer(curAccum div curAccumCount) else result := 0;
 315   {$ENDIF}
 316 end;
 317
 318 function TProfilerBar.getcount (): Integer; begin result := Length(history); end;
 319
 320 function TProfilerBar.getvalat (idx: Integer): Integer;
 321 begin
 322   if (idx < 0) or (idx >= Length(history)) then result := 0 else result := history[(hisLast-idx+Length(history)*2) mod Length(history)];
 323 end;
 324
 325
 326 // ////////////////////////////////////////////////////////////////////////// //
 327 constructor TProfiler.Create (aName: AnsiString; aHistSize: Integer);
 328 begin
 329   name := aName;
 330   bars := nil;
 331   if (aHistSize < 10) then aHistSize := 10;
 332   if (aHistSize > 10000) then aHistSize := 10000;
 333   histSize := aHistSize;
 334   {$IF DEFINED(STOPWATCH_IS_HERE)}
 335   xptimer.clear();
 336   xpsecs := nil;
 337   xpsused := 0;
 338   xpscur := -1;
 339   {$ENDIF}
 340 end;
 341
 342
 343 destructor TProfiler.Destroy ();
 344 var
 345   idx: Integer;
 346 begin
 347   for idx := 0 to High(bars) do bars[idx].history := nil;
 348   bars := nil;
 349   {$IF DEFINED(STOPWATCH_IS_HERE)}
 350   xpsecs := nil;
 351   {$ENDIF}
 352   inherited;
 353 end;
 354
 355
 356 procedure TProfiler.mainBegin (reallyActivate: Boolean=true);
 357 begin
 358   {$IF DEFINED(STOPWATCH_IS_HERE)}
 359   xpsused := 0;
 360   xpscur := -1;
 361   xptimer.clear();
 362   if reallyActivate then xptimer.start();
 363   {$ENDIF}
 364 end;
 365
 366 procedure TProfiler.mainEnd ();
 367 {$IF DEFINED(STOPWATCH_IS_HERE)}
 368 var
 369   idx: Integer;
 370   emm: Integer;
 371
 372   procedure finishProfiling ();
 373   var
 374     idx: Integer;
 375   begin
 376     if (xpsused > 0) then
 377     begin
 378       for idx := 0 to xpsused-1 do
 379       begin
 380         xpsecs[idx].timer.stop();
 381         xpsecs[idx].prevAct := -1;
 382       end;
 383     end;
 384     xptimer.stop();
 385     xpscur := -1;
 386   end;
 387 {$ENDIF}
 388 begin
 389   {$IF DEFINED(STOPWATCH_IS_HERE)}
 390   if not xptimer.isRunning then exit;
 391   finishProfiling();
 392   if (xpsused > 0) then
 393   begin
 394     // first time?
 395     if (length(bars) = 0) or (length(bars) <> xpsused+1) then
 396     begin
 397       //if (length(bars) <> 0) then raise Exception.Create('FUUUUUUUUUUUUUUU');
 398       SetLength(bars, xpsused+1);
 399       for idx := 1 to xpsused do
 400       begin
 401         bars[idx].initialize(histSize);
 402         bars[idx].mName := xpsecs[idx-1].name;
 403         bars[idx].mLevel := xpsecs[idx-1].level+1;
 404       end;
 405       bars[0].initialize(histSize);
 406       bars[0].mName := name;
 407       bars[0].mLevel := 0;
 408     end;
 409     // update bars
 410     emm := 0;
 411     for idx := 1 to xpsused do
 412     begin
 413       bars[idx].update(Integer(xpsecs[idx-1].timer.elapsedMicro));
 414       Inc(emm, Integer(xpsecs[idx-1].timer.elapsedMicro));
 415     end;
 416     //bars[0].update(xptimer.elapsedMicro);
 417     bars[0].update(emm);
 418   end
 419   else
 420   begin
 421     if (length(bars) <> 1) then
 422     begin
 423       SetLength(bars, 1);
 424       bars[0].initialize(histSize);
 425       bars[0].mName := name;
 426       bars[0].mLevel := 0;
 427     end;
 428     bars[0].update(xptimer.elapsedMicro);
 429   end;
 430   {$ENDIF}
 431 end;
 432
 433 procedure TProfiler.sectionBegin (aName: AnsiString);
 434 {$IF DEFINED(STOPWATCH_IS_HERE)}
 435 var
 436   sid: Integer;
 437   pss: PProfSection;
 438 {$ENDIF}
 439 begin
 440   {$IF DEFINED(STOPWATCH_IS_HERE)}
 441   if not xptimer.isRunning then exit;
 442   if (Length(xpsecs) = 0) then SetLength(xpsecs, 512); // why not?
 443   if (xpsused >= Length(xpsecs)) then raise Exception.Create('too many profile sections');
 444   sid := xpsused;
 445   Inc(xpsused);
 446   pss := @xpsecs[sid];
 447   pss.name := aName;
 448   pss.timer.clear();
 449   pss.prevAct := xpscur;
 450   // calculate level
 451   if (xpscur = -1) then pss.level := 0 else pss.level := xpsecs[xpscur].level+1;
 452   xpscur := sid;
 453   pss.timer.start();
 454   {$ENDIF}
 455 end;
 456
 457 procedure TProfiler.sectionBeginAccum (aName: AnsiString);
 458 {$IF DEFINED(STOPWATCH_IS_HERE)}
 459 var
 460   idx: Integer;
 461 {$ENDIF}
 462 begin
 463   {$IF DEFINED(STOPWATCH_IS_HERE)}
 464   if not xptimer.isRunning then exit;
 465   if (xpsused > 0) then
 466   begin
 467     for idx := 0 to xpsused-1 do
 468     begin
 469       if (xpsecs[idx].name = aName) then
 470       begin
 471         if (idx = xpscur) then raise Exception.Create('profiler error(0): double resume: "'+aName+'"');
 472         if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): double resume: "'+aName+'"');
 473         xpsecs[idx].prevAct := xpscur;
 474         xpscur := idx;
 475         xpsecs[idx].timer.resume();
 476         exit;
 477       end;
 478     end;
 479   end;
 480   sectionBegin(aName);
 481   {$ENDIF}
 482 end;
 483
 484 procedure TProfiler.sectionEnd ();
 485 {$IF DEFINED(STOPWATCH_IS_HERE)}
 486 var
 487   pss: PProfSection;
 488 {$ENDIF}
 489 begin
 490   {$IF DEFINED(STOPWATCH_IS_HERE)}
 491   if not xptimer.isRunning then exit;
 492   if (xpscur = -1) then exit; // this is bug, but meh...
 493   pss := @xpsecs[xpscur];
 494   pss.timer.stop();
 495   // go back to parent
 496   xpscur := pss.prevAct;
 497   pss.prevAct := -1;
 498   {$ENDIF}
 499 end;
 500
 501
 502 begin
 503   initTimerIntr();
 504 end.