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 [0..TProfHistorySize-1] 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 (); 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
 128   public
 129     constructor Create (aName: AnsiString);
 130     destructor Destroy (); override;
 131
 132     // call this on frame start
 133     procedure mainBegin (reallyActivate: Boolean=true);
 134     // call this on frame end
 135     procedure mainEnd ();
 136
 137     procedure sectionBegin (name: AnsiString);
 138     procedure sectionEnd ();
 139
 140     // this will reuse the section with the given name (if there is any); use `sectionEnd()` to end it as usual
 141     procedure sectionBeginAccum (name: AnsiString);
 142   end;
 143
 144
 145 implementation
 146
 147 {$IF DEFINED(LINUX)}
 148 type THPTimeType = TTimeSpec;
 149 {$ELSE}
 150 type THPTimeType = Int64;
 151 {$ENDIF}
 152
 153 var
 154   mFrequency: Int64 = 0;
 155   mHasHPTimer: Boolean = false;
 156
 157
 158 // ////////////////////////////////////////////////////////////////////////// //
 159 procedure initTimerIntr ();
 160 var
 161   r: THPTimeType;
 162 begin
 163   if (mFrequency = 0) then
 164   begin
 165 {$IF DEFINED(LINUX)}
 166     if (clock_getres(CLOCK_MONOTONIC, @r) <> 0) then raise Exception.Create('profiler error: cannot get timer resolution');
 167     mHasHPTimer := (r.tv_nsec <> 0);
 168     if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available');
 169     mFrequency := 1; // just a flag
 170     if (r.tv_nsec <> 0) then mFrequency := 1000000000000000000 div r.tv_nsec;
 171 {$ELSE}
 172     mHasHPTimer := QueryPerformanceFrequency(r);
 173     if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available');
 174     mFrequency := r;
 175 {$ENDIF}
 176   end;
 177 end;
 178
 179
 180 function curTimeMicro (): UInt64; inline;
 181 var
 182   r: THPTimeType;
 183 begin
 184   if (mFrequency = 0) then initTimerIntr();
 185   {$IF DEFINED(LINUX)}
 186   clock_gettime(CLOCK_MONOTONIC, @r);
 187   result := UInt64(r.tv_sec)*1000000+UInt64(r.tv_nsec) div 1000; // microseconds
 188   {$ELSE}
 189   QueryPerformanceCounter(r);
 190   result := UInt64(r)*1000000 div mFrequency;
 191   {$ENDIF}
 192 end;
 193
 194
 195 // ////////////////////////////////////////////////////////////////////////// //
 196 class function TStopWatch.Create (): TStopWatch;
 197 begin
 198   result.clear();
 199 end;
 200
 201
 202 class function TStopWatch.startNew (): TStopWatch;
 203 begin
 204   result := TStopWatch.Create();
 205   result.start();
 206 end;
 207
 208
 209 procedure TStopWatch.updateElapsed ();
 210 var
 211   e: UInt64;
 212 begin
 213   e := curTimeMicro();
 214   if (mStartPosition > e) then mStartPosition := e;
 215   Inc(mElapsed, e-mStartPosition);
 216   mStartPosition := e;
 217 end;
 218
 219
 220 function TStopWatch.getElapsedMicro (): Int64;
 221 begin
 222   if mRunning then updateElapsed();
 223   result := mElapsed; // microseconds
 224 end;
 225
 226
 227 function TStopWatch.getElapsedMilli (): Int64;
 228 begin
 229   if mRunning then updateElapsed();
 230   result := mElapsed div 1000; // milliseconds
 231 end;
 232
 233
 234 procedure TStopWatch.clear ();
 235 begin
 236   mElapsed := 0;
 237   mRunning := false;
 238   mStartPosition := 0;
 239 end;
 240
 241
 242 procedure TStopWatch.start (reset: Boolean=true);
 243 begin
 244   if mRunning and not reset then exit; // nothing to do
 245   mStartPosition := curTimeMicro();
 246   mRunning := true;
 247   if (reset) then mElapsed := 0;
 248 end;
 249
 250
 251 procedure TStopWatch.stop ();
 252 begin
 253   if not mRunning then exit;
 254   mRunning := false;
 255   updateElapsed();
 256 end;
 257
 258
 259 procedure TStopWatch.pause ();
 260 begin
 261   stop();
 262 end;
 263
 264
 265 procedure TStopWatch.resume ();
 266 begin
 267   if mRunning then exit;
 268   start(false); // don't reset
 269 end;
 270
 271
 272 // ////////////////////////////////////////////////////////////////////////// //
 273 procedure TProfilerBar.initialize (); begin hisLast := -1; curAccum := 0; curAccumCount := 0; end;
 274
 275 procedure TProfilerBar.update (val: Integer);
 276 var
 277   idx: Integer;
 278 begin
 279   if (val < 0) then val := 0; //else if (val > 1000000) val := 1000000;
 280   if (hisLast = -1) then begin hisLast := TProfHistorySize-1; curAccum := 0; curAccumCount := 0; for idx := 0 to TProfHistorySize-1 do history[idx] := val; end;
 281   if (curAccumCount = TProfHistorySize) then Dec(curAccum, UInt64(history[(hisLast+1) mod TProfHistorySize])) else Inc(curAccumCount);
 282   Inc(hisLast);
 283   if (hisLast >= TProfHistorySize) then hisLast := 0;
 284   Inc(curAccum, UInt64(val));
 285   history[hisLast] := val;
 286   //curval := FilterFadeoff*val+(1.0-FilterFadeoff)*curval;
 287 end;
 288
 289 function TProfilerBar.getvalue (): Integer;
 290 {$IFDEF XPROFILER_SLOW_AVERAGE}
 291 var idx: Integer;
 292 {$ENDIF}
 293 begin
 294   {$IFDEF XPROFILER_SLOW_AVERAGE}
 295   result := 0;
 296   for idx := 0 to TProfHistorySize-1 do Inc(result, history[idx]);
 297   result := result div TProfHistorySize;
 298   {$ELSE}
 299   //result := round(curval);
 300   if curAccumCount > 0 then result := Integer(curAccum div curAccumCount) else result := 0;
 301   {$ENDIF}
 302 end;
 303
 304 function TProfilerBar.getcount (): Integer; begin result := TProfHistorySize; end;
 305
 306 function TProfilerBar.getvalat (idx: Integer): Integer;
 307 begin
 308   if (idx < 0) or (idx >= TProfHistorySize) then result := 0 else result := history[(hisLast-idx+TProfHistorySize*2) mod TProfHistorySize];
 309 end;
 310
 311
 312 // ////////////////////////////////////////////////////////////////////////// //
 313 constructor TProfiler.Create (aName: AnsiString);
 314 begin
 315   name := aName;
 316   bars := nil;
 317   {$IF DEFINED(STOPWATCH_IS_HERE)}
 318   xptimer.clear();
 319   xpsecs := nil;
 320   xpsused := 0;
 321   xpscur := -1;
 322   {$ENDIF}
 323 end;
 324
 325
 326 destructor TProfiler.Destroy ();
 327 begin
 328   bars := nil;
 329   {$IF DEFINED(STOPWATCH_IS_HERE)}
 330   xpsecs := nil;
 331   {$ENDIF}
 332   inherited;
 333 end;
 334
 335
 336 procedure TProfiler.mainBegin (reallyActivate: Boolean=true);
 337 begin
 338   {$IF DEFINED(STOPWATCH_IS_HERE)}
 339   xpsused := 0;
 340   xpscur := -1;
 341   xptimer.clear();
 342   if reallyActivate then xptimer.start();
 343   {$ENDIF}
 344 end;
 345
 346 procedure TProfiler.mainEnd ();
 347 {$IF DEFINED(STOPWATCH_IS_HERE)}
 348 var
 349   idx: Integer;
 350   emm: Integer;
 351
 352   procedure finishProfiling ();
 353   var
 354     idx: Integer;
 355   begin
 356     if (xpsused > 0) then
 357     begin
 358       for idx := 0 to xpsused-1 do
 359       begin
 360         xpsecs[idx].timer.stop();
 361         xpsecs[idx].prevAct := -1;
 362       end;
 363     end;
 364     xptimer.stop();
 365     xpscur := -1;
 366   end;
 367 {$ENDIF}
 368 begin
 369   {$IF DEFINED(STOPWATCH_IS_HERE)}
 370   if not xptimer.isRunning then exit;
 371   finishProfiling();
 372   if (xpsused > 0) then
 373   begin
 374     // first time?
 375     if (length(bars) = 0) or (length(bars) <> xpsused+1) then
 376     begin
 377       //if (length(bars) <> 0) then raise Exception.Create('FUUUUUUUUUUUUUUU');
 378       SetLength(bars, xpsused+1);
 379       for idx := 1 to xpsused do
 380       begin
 381         bars[idx].initialize();
 382         bars[idx].mName := xpsecs[idx-1].name;
 383         bars[idx].mLevel := xpsecs[idx-1].level+1;
 384       end;
 385       bars[0].initialize();
 386       bars[0].mName := name;
 387       bars[0].mLevel := 0;
 388     end;
 389     // update bars
 390     emm := 0;
 391     for idx := 1 to xpsused do
 392     begin
 393       bars[idx].update(Integer(xpsecs[idx-1].timer.elapsedMicro));
 394       Inc(emm, Integer(xpsecs[idx-1].timer.elapsedMicro));
 395     end;
 396     //bars[0].update(xptimer.elapsedMicro);
 397     bars[0].update(emm);
 398   end
 399   else
 400   begin
 401     if (length(bars) <> 1) then
 402     begin
 403       SetLength(bars, 1);
 404       bars[0].initialize();
 405       bars[0].mName := name;
 406       bars[0].mLevel := 0;
 407     end;
 408     bars[0].update(xptimer.elapsedMicro);
 409   end;
 410   {$ENDIF}
 411 end;
 412
 413 procedure TProfiler.sectionBegin (name: AnsiString);
 414 {$IF DEFINED(STOPWATCH_IS_HERE)}
 415 var
 416   sid: Integer;
 417   pss: PProfSection;
 418 {$ENDIF}
 419 begin
 420   {$IF DEFINED(STOPWATCH_IS_HERE)}
 421   if not xptimer.isRunning then exit;
 422   if (Length(xpsecs) = 0) then SetLength(xpsecs, 512); // why not?
 423   if (xpsused >= Length(xpsecs)) then raise Exception.Create('too many profile sections');
 424   sid := xpsused;
 425   Inc(xpsused);
 426   pss := @xpsecs[sid];
 427   pss.name := name;
 428   pss.timer.clear();
 429   pss.prevAct := xpscur;
 430   // calculate level
 431   if (xpscur = -1) then pss.level := 0 else pss.level := xpsecs[xpscur].level+1;
 432   xpscur := sid;
 433   pss.timer.start();
 434   {$ENDIF}
 435 end;
 436
 437 procedure TProfiler.sectionBeginAccum (name: AnsiString);
 438 {$IF DEFINED(STOPWATCH_IS_HERE)}
 439 var
 440   idx: Integer;
 441 {$ENDIF}
 442 begin
 443   {$IF DEFINED(STOPWATCH_IS_HERE)}
 444   if not xptimer.isRunning then exit;
 445   if (xpsused > 0) then
 446   begin
 447     for idx := 0 to xpsused-1 do
 448     begin
 449       if (xpsecs[idx].name = name) then
 450       begin
 451         if (idx = xpscur) then raise Exception.Create('profiler error(0): dobule resume: "'+name+'"');
 452         if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): dobule resume: "'+name+'"');
 453         xpsecs[idx].prevAct := xpscur;
 454         xpscur := idx;
 455         xpsecs[idx].timer.resume();
 456         exit;
 457       end;
 458     end;
 459   end;
 460   sectionBegin(name);
 461   {$ENDIF}
 462 end;
 463
 464 procedure TProfiler.sectionEnd ();
 465 {$IF DEFINED(STOPWATCH_IS_HERE)}
 466 var
 467   pss: PProfSection;
 468 {$ENDIF}
 469 begin
 470   {$IF DEFINED(STOPWATCH_IS_HERE)}
 471   if not xptimer.isRunning then exit;
 472   if (xpscur = -1) then exit; // this is bug, but meh...
 473   pss := @xpsecs[xpscur];
 474   pss.timer.stop();
 475   // go back to parent
 476   xpscur := pss.prevAct;
 477   pss.prevAct := -1;
 478   {$ENDIF}
 479 end;
 480
 481
 482 end.