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