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 {$ELSEIF DEFINED(USE_SDL2)}
 231 function getTimeMicro (): UInt64; inline;
 232 begin
 233   Result := SDL_GetPerformanceCounter() * 1000000 div SDL_GetPerformanceFrequency()
 234 end;
 235 {$ELSE}
 236 function getTimeMicro: UInt64; inline;
 237 begin
 238   result := Round(TimeStampToMSecs(DateTimeToTimeStamp(Now())) * 1000);
 239 end;
 240 {$ENDIF}
 241
 242
 243 function getTimeMilli (): UInt64; inline;
 244 begin
 245   result := getTimeMicro() div 1000;
 246 end;
 247
 248
 249 // ////////////////////////////////////////////////////////////////////////// //
 250 class function TStopWatch.Create (): TStopWatch;
 251 begin
 252   result.clear();
 253 end;
 254
 255
 256 class function TStopWatch.startNew (): TStopWatch;
 257 begin
 258   result := TStopWatch.Create();
 259   result.start();
 260 end;
 261
 262
 263 procedure TStopWatch.updateElapsed ();
 264 var
 265   e: UInt64;
 266 begin
 267   e := getTimeMicro();
 268   if (mStartPosition > e) then mStartPosition := e;
 269   Inc(mElapsed, e-mStartPosition);
 270   mStartPosition := e;
 271 end;
 272
 273
 274 function TStopWatch.getElapsedMicro (): Int64;
 275 begin
 276   if mRunning then updateElapsed();
 277   result := mElapsed; // microseconds
 278 end;
 279
 280
 281 function TStopWatch.getElapsedMilli (): Int64;
 282 begin
 283   if mRunning then updateElapsed();
 284   result := mElapsed div 1000; // milliseconds
 285 end;
 286
 287
 288 procedure TStopWatch.clear ();
 289 begin
 290   mElapsed := 0;
 291   mRunning := false;
 292   mStartPosition := 0;
 293 end;
 294
 295
 296 procedure TStopWatch.start (reset: Boolean=true);
 297 begin
 298   if mRunning and not reset then exit; // nothing to do
 299   mStartPosition := getTimeMicro();
 300   mRunning := true;
 301   if (reset) then mElapsed := 0;
 302 end;
 303
 304
 305 procedure TStopWatch.stop ();
 306 begin
 307   if not mRunning then exit;
 308   mRunning := false;
 309   updateElapsed();
 310 end;
 311
 312
 313 procedure TStopWatch.pause ();
 314 begin
 315   stop();
 316 end;
 317
 318
 319 procedure TStopWatch.resume ();
 320 begin
 321   if mRunning then exit;
 322   start(false); // don't reset
 323 end;
 324
 325
 326 // ////////////////////////////////////////////////////////////////////////// //
 327 procedure TProfilerBar.initialize (aHistSize: Integer); begin SetLength(history, aHistSize); hisLast := -1; curAccum := 0; curAccumCount := 0; end;
 328
 329 procedure TProfilerBar.update (val: Integer);
 330 var
 331   idx: Integer;
 332 begin
 333   if (val < 0) then val := 0; //else if (val > 1000000) val := 1000000;
 334   if (hisLast = -1) then begin hisLast := High(history); curAccum := 0; curAccumCount := 0; for idx := 0 to High(history) do history[idx] := val; end;
 335   if (curAccumCount = Length(history)) then Dec(curAccum, UInt64(history[(hisLast+1) mod Length(history)])) else Inc(curAccumCount);
 336   Inc(hisLast);
 337   if (hisLast >= Length(history)) then hisLast := 0;
 338   Inc(curAccum, UInt64(val));
 339   history[hisLast] := val;
 340   //curval := FilterFadeoff*val+(1.0-FilterFadeoff)*curval;
 341 end;
 342
 343 function TProfilerBar.getvalue (): Integer;
 344 {$IFDEF XPROFILER_SLOW_AVERAGE}
 345 var idx: Integer;
 346 {$ENDIF}
 347 begin
 348   {$IFDEF XPROFILER_SLOW_AVERAGE}
 349   result := 0;
 350   for idx := 0 to High(history) do Inc(result, history[idx]);
 351   result := result div Length(history);
 352   {$ELSE}
 353   //result := round(curval);
 354   if curAccumCount > 0 then result := Integer(curAccum div curAccumCount) else result := 0;
 355   {$ENDIF}
 356 end;
 357
 358 function TProfilerBar.getcount (): Integer; begin result := Length(history); end;
 359
 360 function TProfilerBar.getvalat (idx: Integer): Integer;
 361 begin
 362   if (idx < 0) or (idx >= Length(history)) then result := 0 else result := history[(hisLast-idx+Length(history)*2) mod Length(history)];
 363 end;
 364
 365
 366 // ////////////////////////////////////////////////////////////////////////// //
 367 constructor TProfiler.Create (aName: AnsiString; aHistSize: Integer);
 368 begin
 369   name := aName;
 370   bars := nil;
 371   if (aHistSize < 10) then aHistSize := 10;
 372   if (aHistSize > 10000) then aHistSize := 10000;
 373   histSize := aHistSize;
 374   {$IF DEFINED(STOPWATCH_IS_HERE)}
 375   xptimer.clear();
 376   xpsecs := nil;
 377   xpsused := 0;
 378   xpscur := -1;
 379   {$ENDIF}
 380 end;
 381
 382
 383 destructor TProfiler.Destroy ();
 384 var
 385   idx: Integer;
 386 begin
 387   for idx := 0 to High(bars) do bars[idx].history := nil;
 388   bars := nil;
 389   {$IF DEFINED(STOPWATCH_IS_HERE)}
 390   xpsecs := nil;
 391   {$ENDIF}
 392   inherited;
 393 end;
 394
 395
 396 procedure TProfiler.mainBegin (reallyActivate: Boolean=true);
 397 begin
 398   {$IF DEFINED(STOPWATCH_IS_HERE)}
 399   xpsused := 0;
 400   xpscur := -1;
 401   xptimer.clear();
 402   if reallyActivate then xptimer.start();
 403   {$ENDIF}
 404 end;
 405
 406 procedure TProfiler.mainEnd ();
 407 {$IF DEFINED(STOPWATCH_IS_HERE)}
 408 var
 409   idx: Integer;
 410   emm: Integer;
 411
 412   procedure finishProfiling ();
 413   var
 414     idx: Integer;
 415   begin
 416     if (xpsused > 0) then
 417     begin
 418       for idx := 0 to xpsused-1 do
 419       begin
 420         xpsecs[idx].timer.stop();
 421         xpsecs[idx].prevAct := -1;
 422       end;
 423     end;
 424     xptimer.stop();
 425     xpscur := -1;
 426   end;
 427 {$ENDIF}
 428 begin
 429   {$IF DEFINED(STOPWATCH_IS_HERE)}
 430   if not xptimer.isRunning then exit;
 431   finishProfiling();
 432   if (xpsused > 0) then
 433   begin
 434     // first time?
 435     if (length(bars) = 0) or (length(bars) <> xpsused+1) then
 436     begin
 437       //if (length(bars) <> 0) then raise Exception.Create('FUUUUUUUUUUUUUUU');
 438       SetLength(bars, xpsused+1);
 439       for idx := 1 to xpsused do
 440       begin
 441         bars[idx].initialize(histSize);
 442         bars[idx].mName := xpsecs[idx-1].name;
 443         bars[idx].mLevel := xpsecs[idx-1].level+1;
 444       end;
 445       bars[0].initialize(histSize);
 446       bars[0].mName := name;
 447       bars[0].mLevel := 0;
 448     end;
 449     // update bars
 450     emm := 0;
 451     for idx := 1 to xpsused do
 452     begin
 453       bars[idx].update(Integer(xpsecs[idx-1].timer.elapsedMicro));
 454       Inc(emm, Integer(xpsecs[idx-1].timer.elapsedMicro));
 455     end;
 456     //bars[0].update(xptimer.elapsedMicro);
 457     bars[0].update(emm);
 458   end
 459   else
 460   begin
 461     if (length(bars) <> 1) then
 462     begin
 463       SetLength(bars, 1);
 464       bars[0].initialize(histSize);
 465       bars[0].mName := name;
 466       bars[0].mLevel := 0;
 467     end;
 468     bars[0].update(xptimer.elapsedMicro);
 469   end;
 470   {$ENDIF}
 471 end;
 472
 473 procedure TProfiler.sectionBegin (aName: AnsiString);
 474 {$IF DEFINED(STOPWATCH_IS_HERE)}
 475 var
 476   sid: Integer;
 477   pss: PProfSection;
 478 {$ENDIF}
 479 begin
 480   {$IF DEFINED(STOPWATCH_IS_HERE)}
 481   if not xptimer.isRunning then exit;
 482   if (Length(xpsecs) = 0) then SetLength(xpsecs, 512); // why not?
 483   if (xpsused >= Length(xpsecs)) then raise Exception.Create('too many profile sections');
 484   sid := xpsused;
 485   Inc(xpsused);
 486   pss := @xpsecs[sid];
 487   pss.name := aName;
 488   pss.timer.clear();
 489   pss.prevAct := xpscur;
 490   // calculate level
 491   if (xpscur = -1) then pss.level := 0 else pss.level := xpsecs[xpscur].level+1;
 492   xpscur := sid;
 493   pss.timer.start();
 494   {$ENDIF}
 495 end;
 496
 497 procedure TProfiler.sectionBeginAccum (aName: AnsiString);
 498 {$IF DEFINED(STOPWATCH_IS_HERE)}
 499 var
 500   idx: Integer;
 501 {$ENDIF}
 502 begin
 503   {$IF DEFINED(STOPWATCH_IS_HERE)}
 504   if not xptimer.isRunning then exit;
 505   if (xpsused > 0) then
 506   begin
 507     for idx := 0 to xpsused-1 do
 508     begin
 509       if (xpsecs[idx].name = aName) then
 510       begin
 511         if (idx = xpscur) then raise Exception.Create('profiler error(0): double resume: "'+aName+'"');
 512         if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): double resume: "'+aName+'"');
 513         xpsecs[idx].prevAct := xpscur;
 514         xpscur := idx;
 515         xpsecs[idx].timer.resume();
 516         exit;
 517       end;
 518     end;
 519   end;
 520   sectionBegin(aName);
 521   {$ENDIF}
 522 end;
 523
 524 procedure TProfiler.sectionEnd ();
 525 {$IF DEFINED(STOPWATCH_IS_HERE)}
 526 var
 527   pss: PProfSection;
 528 {$ENDIF}
 529 begin
 530   {$IF DEFINED(STOPWATCH_IS_HERE)}
 531   if not xptimer.isRunning then exit;
 532   if (xpscur = -1) then exit; // this is bug, but meh...
 533   pss := @xpsecs[xpscur];
 534   pss.timer.stop();
 535   // go back to parent
 536   xpscur := pss.prevAct;
 537   pss.prevAct := -1;
 538   {$ENDIF}
 539 end;
 540
 541
 542 begin
 543   initTimerIntr();
 544 end.