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