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