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 // TStopWatch is based on the code by Inoussa OUEDRAOGO, Copyright (c) 2012
  18 {$INCLUDE a_modes.inc}
  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   private
  43   {$IF DEFINED(LINUX)}
  44     type TBaseMesure = TTimeSpec;
  45   {$ELSE}
  46     type TBaseMesure = Int64;
  47   {$ENDIF}
  48
  49   strict private
  50     class var mFrequency: Int64;
  51     class var mIsHighResolution: Boolean;
  52
  53   strict private
  54     mElapsed: Int64;
  55     mRunning: Boolean;
  56     mStartPosition: TBaseMesure;
  57
  58   strict private
  59     class procedure initTimerIntr (); static;
  60
  61     procedure updateElapsed ();
  62
  63     function getElapsedMilliseconds (): Int64;
  64     function getElapsedMicroseconds (): Int64;
  65     function getElapsedTicks (): Int64;
  66
  67   public
  68     class function Create (): TStopWatch; static;
  69     class function startNew (): TStopWatch; static;
  70
  71     class property frequency : Int64 read mFrequency;
  72     class property isHighResolution : Boolean read mIsHighResolution;
  73
  74   public
  75     procedure clear (); inline; // full clear
  76     procedure start (); // start or restart timer
  77     procedure stop ();
  78
  79     property elapsedMilli: Int64 read getElapsedMilliseconds;
  80     property elapsedMicro: Int64 read getElapsedMicroseconds;
  81     property elapsedTicks: Int64 read getElapsedTicks;
  82     property isRunning: Boolean read mRunning;
  83   end;
  84 {$ENDIF}
  85
  86
  87 // call this on frame start
  88 procedure xprofBegin (reallyActivate: Boolean=true);
  89 // call this on frame end
  90 procedure xprofEnd ();
  91
  92 function xprofTotalMicro (): Int64; // total duration, microseconds
  93 function xprofTotalMilli (): Int64; // total duration, milliseconds
  94 function xprofTotalCount (): Integer; // all items
  95
  96 // don't fuckup pairing of there, 'cause they can be nested!
  97 procedure xprofBeginSection (name: AnsiString);
  98 procedure xprofEndSection ();
  99
 100 function xprofNameAt (idx: Integer): AnsiString;
 101 function xprofMicroAt (idx: Integer): Int64;
 102 function xprofMilliAt (idx: Integer): Int64;
 103 function xprofHasChildrenAt (idx: Integer): Boolean;
 104 function xprofLevelAt (idx: Integer): Integer;
 105
 106 // iterator
 107 function xprofItReset (): Boolean; // false: no sections
 108 function xprofItCount (): Integer; // from current item to eol (not including children, but including current item)
 109 // current item info
 110 function xprofItName (): AnsiString; // current section name
 111 function xprofItMicro (): Int64; // current section duration, microseconds
 112 function xprofItMilli (): Int64; // current section duration, milliseconds
 113 function xprofItHasChildren (): Boolean;
 114 function xprofItIsChild (): Boolean;
 115 function xprofItLevel (): Integer; // 0: top
 116
 117 function xprofItDive (): Boolean; // dive into childrens
 118 function xprofItPop (): Boolean; // pop into parent
 119 function xprofItNext (): Boolean; // move to next sibling; false: no more siblings (and current item is unchanged)
 120
 121
 122 implementation
 123
 124 const
 125   TicksPerNanoSecond = 100;
 126   TicksPerMilliSecond = 10000;
 127   TicksPerSecond = 10000000000000000;
 128
 129
 130 // ////////////////////////////////////////////////////////////////////////// //
 131 class procedure TStopWatch.initTimerIntr ();
 132 {$IF DEFINED(LINUX)}
 133 var
 134   r: TBaseMesure;
 135 {$ENDIF}
 136 begin
 137   if (mFrequency = 0) then
 138   begin
 139 {$IF DEFINED(LINUX)}
 140     mIsHighResolution := (clock_getres(CLOCK_MONOTONIC, @r) = 0);
 141     mIsHighResolution := mIsHighResolution and (r.tv_nsec <> 0);
 142     if (r.tv_nsec <> 0) then mFrequency := 1000000000000000000 div r.tv_nsec;
 143 {$ELSE}
 144     mIsHighResolution := QueryPerformanceFrequency(mFrequency);
 145 {$ENDIF}
 146   end;
 147 end;
 148
 149
 150 class function TStopWatch.Create (): TStopWatch;
 151 begin
 152   initTimerIntr();
 153   result.clear();
 154 end;
 155
 156
 157 class function TStopWatch.startNew (): TStopWatch;
 158 begin
 159   result := TStopWatch.Create();
 160   result.start();
 161 end;
 162
 163
 164 function TStopWatch.getElapsedMilliseconds (): Int64;
 165 begin
 166   if (mFrequency = 0) then begin result := 0; exit; end;
 167   if mRunning then updateElapsed();
 168   {$IF DEFINED(LINUX)}
 169     result := mElapsed div 1000000;
 170   {$ELSE}
 171     result := elapsedTicks*TicksPerMilliSecond;
 172   {$ENDIF}
 173 end;
 174
 175
 176 function TStopWatch.getElapsedMicroseconds (): Int64;
 177 begin
 178   if (mFrequency = 0) then begin result := 0; exit; end;
 179   if mRunning then updateElapsed();
 180   {$IF DEFINED(LINUX)}
 181   result := mElapsed div 1000;
 182   {$ELSE}
 183   result := elapsedTicks*(TicksPerMilliSecond div 100);
 184   {$ENDIF}
 185 end;
 186
 187
 188 function TStopWatch.getElapsedTicks (): Int64;
 189 begin
 190   if (mFrequency = 0) then begin result := 0; exit; end;
 191   if mRunning then updateElapsed();
 192   {$IF DEFINED(LINUX)}
 193   result := mElapsed div TicksPerNanoSecond;
 194   {$ELSE}
 195   result := (mElapsed*TicksPerSecond) div mFrequency;
 196   {$ENDIF}
 197 end;
 198
 199
 200 procedure TStopWatch.clear ();
 201 begin
 202   //FillChar(self, sizeof(self), 0);
 203   mElapsed := 0;
 204   mRunning := false;
 205   //mStartPosition: TBaseMesure;
 206 end;
 207
 208
 209 procedure TStopWatch.start ();
 210 begin
 211   //if mRunning then exit;
 212   if (mFrequency = 0) then initTimerIntr();
 213   mRunning := true;
 214   mElapsed := 0;
 215   {$IF DEFINED(LINUX)}
 216   clock_gettime(CLOCK_MONOTONIC, @mStartPosition);
 217   {$ELSE}
 218   QueryPerformanceCounter(mStartPosition);
 219   {$ENDIF}
 220 end;
 221
 222
 223 procedure TStopWatch.updateElapsed ();
 224 var
 225   locEnd: TBaseMesure;
 226   {$IF DEFINED(LINUX)}
 227   s, n: Int64;
 228   {$ENDIF}
 229 begin
 230   {$IF DEFINED(LINUX)}
 231   clock_gettime(CLOCK_MONOTONIC, @locEnd);
 232   if (locEnd.tv_nsec < mStartPosition.tv_nsec) then
 233   begin
 234     s := locEnd.tv_sec-mStartPosition.tv_sec-1;
 235     n := 1000000000000000000+locEnd.tv_nsec-mStartPosition.tv_nsec;
 236   end
 237   else
 238   begin
 239     s := locEnd.tv_sec-mStartPosition.tv_sec;
 240     n := locEnd.tv_nsec-mStartPosition.tv_nsec;
 241   end;
 242   mElapsed := mElapsed+(s*1000000000000000000)+n;
 243   {$ELSE}
 244   QueryPerformanceCounter(locEnd);
 245   mElapsed := mElapsed+(UInt64(locEnd)-UInt64(mStartPosition));
 246   {$ENDIF}
 247 end;
 248
 249
 250 procedure TStopWatch.stop ();
 251 begin
 252   if not mRunning then exit;
 253   mRunning := false;
 254   updateElapsed();
 255 end;
 256
 257
 258 // ////////////////////////////////////////////////////////////////////////// //
 259 // high-level profiler
 260 {$IF DEFINED(STOPWATCH_IS_HERE)}
 261 type
 262   PProfSection = ^TProfSection;
 263   TProfSection = record
 264     name: AnsiString;
 265     timer: TStopWatch;
 266     parent: Integer; // section index in xpsecs or -1
 267     firstChild: Integer; // first child, or -1
 268     next: Integer; // next sibling, or -1
 269     level: Integer;
 270   end;
 271
 272 var
 273   xptimer: TStopWatch;
 274   xpsecs: array of TProfSection = nil;
 275   xpsused: Integer = 0;
 276   xpscur: Integer = -1; // currently running section
 277   xpslevel: Integer = 0;
 278   xitcur: Integer = -1; // for iterator
 279
 280
 281 // call this on frame start
 282 procedure xprofBegin (reallyActivate: Boolean=true);
 283 begin
 284   xpsused := 0;
 285   xpscur := -1;
 286   xitcur := -1; // reset iterator
 287   xpslevel := 0;
 288   xptimer.clear();
 289   if reallyActivate then xptimer.start();
 290 end;
 291
 292
 293 // call this on frame end
 294 procedure xprofEnd ();
 295 begin
 296   if not xptimer.isRunning then exit;
 297   while xpscur <> -1 do
 298   begin
 299     xpsecs[xpscur].timer.stop();
 300     xpscur := xpsecs[xpscur].parent;
 301   end;
 302   xptimer.stop();
 303 end;
 304
 305
 306 // don't fuckup pairing of there, 'cause they can be nested!
 307 //FIXME: rewrite without schlemiel's algo!
 308 procedure xprofBeginSection (name: AnsiString);
 309 var
 310   sid, t: Integer;
 311   pss: PProfSection;
 312 begin
 313   if not xptimer.isRunning then exit;
 314   if (Length(xpsecs) = 0) then SetLength(xpsecs, 65536); // why not?
 315   if (xpsused >= Length(xpsecs)) then raise Exception.Create('too many profile sections');
 316   sid := xpsused;
 317   Inc(xpsused);
 318   pss := @xpsecs[sid];
 319   pss.name := name;
 320   pss.timer.clear();
 321   pss.parent := xpscur;
 322   pss.firstChild := -1;
 323   pss.next := -1;
 324   pss.level := xpslevel;
 325   Inc(xpslevel);
 326   // link to list
 327   if (xpscur <> -1) then
 328   begin
 329     // child
 330     t := xpsecs[xpscur].firstChild;
 331     if (t = -1) then
 332     begin
 333       xpsecs[xpscur].firstChild := sid;
 334     end
 335     else
 336     begin
 337       while (xpsecs[t].next <> -1) do t := xpsecs[t].next;
 338       xpsecs[t].next := sid;
 339     end;
 340   end
 341   else
 342   begin
 343     // top level
 344     if (sid <> 0) then
 345     begin
 346       t := 0;
 347       while (xpsecs[t].next <> -1) do t := xpsecs[t].next;
 348       xpsecs[t].next := sid;
 349     end;
 350   end;
 351   xpscur := sid;
 352   pss.timer.start();
 353 end;
 354
 355
 356 procedure xprofEndSection ();
 357 var
 358   pss: PProfSection;
 359 begin
 360   if not xptimer.isRunning then exit;
 361   if (xpscur = -1) then exit; // this is bug, but meh...
 362   Dec(xpslevel);
 363   pss := @xpsecs[xpscur];
 364   pss.timer.stop();
 365   // go back to parent
 366   xpscur := pss.parent;
 367 end;
 368
 369
 370 procedure xprofGlobalInit ();
 371 begin
 372   //SetLength(xpsecs, 1024); // 'cause why not? 'cause don't pay for something you may not need
 373   xptimer.clear();
 374 end;
 375
 376
 377 // ////////////////////////////////////////////////////////////////////////// //
 378 // iterator
 379 function xprofTotalMicro (): Int64; begin result := xptimer.elapsedMicro; end;
 380 function xprofTotalMilli (): Int64; begin result := xptimer.elapsedMilli; end;
 381
 382 // all items
 383 function xprofTotalCount (): Integer;
 384 begin
 385   if xptimer.isRunning then result := 0 else result := xpsused;
 386 end;
 387
 388
 389 function xprofNameAt (idx: Integer): AnsiString; begin if xptimer.isRunning or (idx < 0) or (idx >= xpsused) then result := '' else result := xpsecs[idx].name; end;
 390 function xprofMicroAt (idx: Integer): Int64; begin if xptimer.isRunning or (idx < 0) or (idx >= xpsused) then result := 0 else result := xpsecs[idx].timer.elapsedMicro; end;
 391 function xprofMilliAt (idx: Integer): Int64; begin if xptimer.isRunning or (idx < 0) or (idx >= xpsused) then result := 0 else result := xpsecs[idx].timer.elapsedMilli; end;
 392 function xprofHasChildrenAt (idx: Integer): Boolean; begin if xptimer.isRunning or (idx < 0) or (idx >= xpsused) then result := false else result := (xpsecs[idx].firstChild <> -1); end;
 393 function xprofLevelAt (idx: Integer): Integer; begin if xptimer.isRunning or (idx < 0) or (idx >= xpsused) then result := 0 else result := xpsecs[idx].level; end;
 394
 395
 396 // false: no sections
 397 function xprofItReset (): Boolean;
 398 begin
 399   result := false;
 400   xitcur := -1;
 401   if xptimer.isRunning then exit;
 402   if (xpsused = 0) then exit; // no sections
 403   xitcur := 0;
 404   assert(xpsecs[0].parent = -1);
 405   result := true;
 406 end;
 407
 408
 409 // from current item to eol (not including children, but including current item)
 410 function xprofItCount (): Integer;
 411 var
 412   idx: Integer;
 413 begin
 414   result := 0;
 415   idx := xitcur;
 416   while (idx <> -1) do
 417   begin
 418     Inc(result);
 419     idx := xpsecs[idx].next;
 420   end;
 421 end;
 422
 423
 424 // current item info
 425 function xprofItName (): AnsiString; begin if (xitcur = -1) then result := '' else result := xpsecs[xitcur].name; end;
 426 function xprofItMicro (): Int64; begin if (xitcur = -1) then result := 0 else result := xpsecs[xitcur].timer.elapsedMicro; end;
 427 function xprofItMilli (): Int64; begin if (xitcur = -1) then result := 0 else result := xpsecs[xitcur].timer.elapsedMilli; end;
 428 function xprofItHasChildren (): Boolean; begin if (xitcur = -1) then result := false else result := (xpsecs[xitcur].firstChild <> -1); end;
 429 function xprofItIsChild (): Boolean; begin if (xitcur = -1) then result := false else result := (xpsecs[xitcur].parent <> -1); end;
 430 function xprofItLevel (): Integer; begin if (xitcur = -1) then result := 0 else result := xpsecs[xitcur].level; end;
 431
 432 // dive into childrens
 433 function xprofItDive (): Boolean;
 434 begin
 435   if (xitcur = -1) or (xpsecs[xitcur].firstChild = -1) then
 436   begin
 437     result := false;
 438   end
 439   else
 440   begin
 441     result := true;
 442     xitcur := xpsecs[xitcur].firstChild;
 443   end;
 444 end;
 445
 446 // pop into parent
 447 function xprofItPop (): Boolean;
 448 begin
 449   if (xitcur = -1) or (xpsecs[xitcur].parent = -1) then
 450   begin
 451     result := false;
 452   end
 453   else
 454   begin
 455     result := true;
 456     xitcur := xpsecs[xitcur].parent;
 457   end;
 458 end;
 459
 460 // move to next sibling; false: no more siblings (and current item is unchanged)
 461 function xprofItNext (): Boolean;
 462 begin
 463   if (xitcur = -1) or (xpsecs[xitcur].next = -1) then
 464   begin
 465     result := false;
 466   end
 467   else
 468   begin
 469     result := true;
 470     xitcur := xpsecs[xitcur].next;
 471   end;
 472 end;
 473
 474 {$ELSE}
 475 procedure xprofBegin (reallyActivate: Boolean=true); begin end;
 476 procedure xprofEnd (); begin end;
 477 procedure xprofBeginSection (name: AnsiString); begin end;
 478 procedure xprofEndSection (); begin end;
 479
 480 function xprofTotalMicro (): Int64; begin result := 0; end;
 481 function xprofTotalMilli (): Int64; begin result := 0; end;
 482 function xprofTotalCount (): Integer; begin result := 0; end;
 483
 484 function xprofNameAt (idx: Integer): AnsiString; begin result := ''; end;
 485 function xprofMicroAt (idx: Integer): Int64; begin result := 0; end;
 486 function xprofMilliAt (idx: Integer): Int64; begin result := 0; end;
 487 function xprofHasChildrenAt (idx: Integer): Boolean; begin result := false; end;
 488 function xprofLevelAt (idx: Integer): Integer; begin result := 0; end;
 489
 490 function xprofItReset (): Boolean; begin result := false; end;
 491 function xprofItCount (): Integer; begin result := 0; end;
 492 // current item info
 493 function xprofItName (): AnsiString; begin result := ''; end;
 494 function xprofItMicro (): Int64; begin result := 0; end;
 495 function xprofItMilli (): Int64; begin result := 0; end;
 496 function xprofItHasChildren (): Boolean; begin result := false; end;
 497 function xprofItIsChild (): Boolean; begin result := false; end;
 498
 499 function xprofItDepth (): Integer; begin result := 0; end;
 500
 501 function xprofItDive (): Boolean; begin result := false; end;
 502 function xprofItPop (): Boolean; begin result := false; end;
 503 function xprofItNext (): Boolean; begin result := false; end;
 504 {$ENDIF}
 505
 506 begin
 507   {$IF DEFINED(STOPWATCH_IS_HERE)}
 508   xprofGlobalInit();
 509   {$ENDIF}
 510 end.