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