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