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