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