X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxprofiler.pas;h=225e9de4e324cfd4f6fada7088713c578eca5ca6;hb=675775b9ff4b38c4ce8efbe29154da1fd776d30c;hp=4dc4eaf603072203db39deceed1c06ddca6c903f;hpb=0da2f21c266e1986dc46af7bbf620c0ed97df2e2;p=d2df-sdl.git

diff --git a/src/shared/xprofiler.pas b/src/shared/xprofiler.pas
index 4dc4eaf..225e9de 100644
--- a/src/shared/xprofiler.pas
+++ b/src/shared/xprofiler.pas
@@ -14,7 +14,7 @@
  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  *)
 // stopwatch timer to measure short periods (like frame rendering phases)
-// based on the code by Inoussa OUEDRAOGO, Copyright (c) 2012
+// TStopWatch is based on the code by Inoussa OUEDRAOGO, Copyright (c) 2012
 {$INCLUDE a_modes.inc}
 unit xprofiler;
 
@@ -72,6 +72,7 @@ type
     class property isHighResolution : Boolean read mIsHighResolution;
 
   public
+    procedure clear (); inline; // full clear
     procedure start (); // start or restart timer
     procedure stop ();
 
@@ -83,6 +84,54 @@ type
 {$ENDIF}
 
 
+const
+  TProfHistorySize = 100;
+
+type
+  TProfilerBar = record
+  private
+    const FilterFadeoff = 0.05; // 5%
+
+  private
+    history: array [0..TProfHistorySize-1] of Integer; // circular buffer
+    hisHead: Integer;
+    curval: Single;
+    mName: AnsiString;
+    mLevel: Integer;
+
+  private
+    procedure initialize (); inline;
+    function getvalue (): Integer; inline;
+    function getvalat (idx: Integer): Integer; inline;
+    function getcount (): Integer; inline;
+
+  public
+    procedure update (val: Integer);
+
+    property value: Integer read getvalue;
+    property name: AnsiString read mName;
+    property level: Integer read mLevel;
+    property count: Integer read getcount;
+    property values[idx: Integer]: Integer read getvalat;
+  end;
+
+  TProfiler = class(TObject)
+  public
+    bars: array of TProfilerBar;
+    name: AnsiString;
+
+  public
+    constructor Create (aName: AnsiString);
+    destructor Destroy (); override;
+
+    procedure mainBegin (reallyActivate: Boolean=true);
+    procedure mainEnd ();
+
+    procedure sectionBegin (name: AnsiString);
+    procedure sectionEnd ();
+  end;
+
+
 // call this on frame start
 procedure xprofBegin (reallyActivate: Boolean=true);
 // call this on frame end
@@ -96,6 +145,12 @@ function xprofTotalCount (): Integer; // all items
 procedure xprofBeginSection (name: AnsiString);
 procedure xprofEndSection ();
 
+function xprofNameAt (idx: Integer): AnsiString;
+function xprofMicroAt (idx: Integer): Int64;
+function xprofMilliAt (idx: Integer): Int64;
+function xprofHasChildrenAt (idx: Integer): Boolean;
+function xprofLevelAt (idx: Integer): Integer;
+
 // iterator
 function xprofItReset (): Boolean; // false: no sections
 function xprofItCount (): Integer; // from current item to eol (not including children, but including current item)
@@ -105,7 +160,7 @@ function xprofItMicro (): Int64; // current section duration, microseconds
 function xprofItMilli (): Int64; // current section duration, milliseconds
 function xprofItHasChildren (): Boolean;
 function xprofItIsChild (): Boolean;
-function xprofItDepth (): Integer; // 0: top
+function xprofItLevel (): Integer; // 0: top
 
 function xprofItDive (): Boolean; // dive into childrens
 function xprofItPop (): Boolean; // pop into parent
@@ -143,7 +198,7 @@ end;
 class function TStopWatch.Create (): TStopWatch;
 begin
   initTimerIntr();
-  FillChar(result, sizeof(result), 0);
+  result.clear();
 end;
 
 
@@ -190,11 +245,21 @@ begin
 end;
 
 
+procedure TStopWatch.clear ();
+begin
+  //FillChar(self, sizeof(self), 0);
+  mElapsed := 0;
+  mRunning := false;
+  //mStartPosition: TBaseMesure;
+end;
+
+
 procedure TStopWatch.start ();
 begin
   //if mRunning then exit;
   if (mFrequency = 0) then initTimerIntr();
   mRunning := true;
+  mElapsed := 0;
   {$IF DEFINED(LINUX)}
   clock_gettime(CLOCK_MONOTONIC, @mStartPosition);
   {$ELSE}
@@ -249,6 +314,7 @@ type
     parent: Integer; // section index in xpsecs or -1
     firstChild: Integer; // first child, or -1
     next: Integer; // next sibling, or -1
+    level: Integer;
   end;
 
 var
@@ -256,8 +322,8 @@ var
   xpsecs: array of TProfSection = nil;
   xpsused: Integer = 0;
   xpscur: Integer = -1; // currently running section
+  xpslevel: Integer = 0;
   xitcur: Integer = -1; // for iterator
-  xitdepth: Integer = 0;
 
 
 // call this on frame start
@@ -266,7 +332,8 @@ begin
   xpsused := 0;
   xpscur := -1;
   xitcur := -1; // reset iterator
-  xitdepth := 0;
+  xpslevel := 0;
+  xptimer.clear();
   if reallyActivate then xptimer.start();
 end;
 
@@ -285,37 +352,49 @@ end;
 
 
 // don't fuckup pairing of there, 'cause they can be nested!
+//FIXME: rewrite without schlemiel's algo!
 procedure xprofBeginSection (name: AnsiString);
 var
   sid, t: Integer;
   pss: PProfSection;
 begin
   if not xptimer.isRunning then exit;
+  if (Length(xpsecs) = 0) then SetLength(xpsecs, 65536); // why not?
+  if (xpsused >= Length(xpsecs)) then raise Exception.Create('too many profile sections');
   sid := xpsused;
   Inc(xpsused);
-  if (sid = Length(xpsecs)) then SetLength(xpsecs, sid+1024);
   pss := @xpsecs[sid];
   pss.name := name;
+  pss.timer.clear();
   pss.parent := xpscur;
   pss.firstChild := -1;
   pss.next := -1;
-  // link to children
-  if xpscur <> -1 then
+  pss.level := xpslevel;
+  Inc(xpslevel);
+  // link to list
+  if (xpscur <> -1) then
   begin
+    // child
     t := xpsecs[xpscur].firstChild;
-    if t = -1 then
+    if (t = -1) then
     begin
       xpsecs[xpscur].firstChild := sid;
     end
     else
     begin
-      //FIXME: rewrite without schlemiel's algo!
       while (xpsecs[t].next <> -1) do t := xpsecs[t].next;
       xpsecs[t].next := sid;
     end;
   end
   else
   begin
+    // top level
+    if (sid <> 0) then
+    begin
+      t := 0;
+      while (xpsecs[t].next <> -1) do t := xpsecs[t].next;
+      xpsecs[t].next := sid;
+    end;
   end;
   xpscur := sid;
   pss.timer.start();
@@ -328,6 +407,7 @@ var
 begin
   if not xptimer.isRunning then exit;
   if (xpscur = -1) then exit; // this is bug, but meh...
+  Dec(xpslevel);
   pss := @xpsecs[xpscur];
   pss.timer.stop();
   // go back to parent
@@ -338,6 +418,7 @@ end;
 procedure xprofGlobalInit ();
 begin
   //SetLength(xpsecs, 1024); // 'cause why not? 'cause don't pay for something you may not need
+  xptimer.clear();
 end;
 
 
@@ -353,12 +434,18 @@ begin
 end;
 
 
+function xprofNameAt (idx: Integer): AnsiString; begin if xptimer.isRunning or (idx < 0) or (idx >= xpsused) then result := '' else result := xpsecs[idx].name; end;
+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;
+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;
+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;
+function xprofLevelAt (idx: Integer): Integer; begin if xptimer.isRunning or (idx < 0) or (idx >= xpsused) then result := 0 else result := xpsecs[idx].level; end;
+
+
 // false: no sections
 function xprofItReset (): Boolean;
 begin
   result := false;
   xitcur := -1;
-  xitdepth := 0;
   if xptimer.isRunning then exit;
   if (xpsused = 0) then exit; // no sections
   xitcur := 0;
@@ -388,7 +475,7 @@ function xprofItMicro (): Int64; begin if (xitcur = -1) then result := 0 else re
 function xprofItMilli (): Int64; begin if (xitcur = -1) then result := 0 else result := xpsecs[xitcur].timer.elapsedMilli; end;
 function xprofItHasChildren (): Boolean; begin if (xitcur = -1) then result := false else result := (xpsecs[xitcur].firstChild <> -1); end;
 function xprofItIsChild (): Boolean; begin if (xitcur = -1) then result := false else result := (xpsecs[xitcur].parent <> -1); end;
-function xprofItDepth (): Integer; begin result := xitdepth; end;
+function xprofItLevel (): Integer; begin if (xitcur = -1) then result := 0 else result := xpsecs[xitcur].level; end;
 
 // dive into childrens
 function xprofItDive (): Boolean;
@@ -401,7 +488,6 @@ begin
   begin
     result := true;
     xitcur := xpsecs[xitcur].firstChild;
-    Inc(xitdepth);
   end;
 end;
 
@@ -416,7 +502,6 @@ begin
   begin
     result := true;
     xitcur := xpsecs[xitcur].parent;
-    Dec(xitdepth);
   end;
 end;
 
@@ -444,6 +529,12 @@ function xprofTotalMicro (): Int64; begin result := 0; end;
 function xprofTotalMilli (): Int64; begin result := 0; end;
 function xprofTotalCount (): Integer; begin result := 0; end;
 
+function xprofNameAt (idx: Integer): AnsiString; begin result := ''; end;
+function xprofMicroAt (idx: Integer): Int64; begin result := 0; end;
+function xprofMilliAt (idx: Integer): Int64; begin result := 0; end;
+function xprofHasChildrenAt (idx: Integer): Boolean; begin result := false; end;
+function xprofLevelAt (idx: Integer): Integer; begin result := 0; end;
+
 function xprofItReset (): Boolean; begin result := false; end;
 function xprofItCount (): Integer; begin result := 0; end;
 // current item info
@@ -460,6 +551,91 @@ function xprofItPop (): Boolean; begin result := false; end;
 function xprofItNext (): Boolean; begin result := false; end;
 {$ENDIF}
 
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure TProfilerBar.initialize (); begin hisHead := -1; curval := 0; end;
+
+procedure TProfilerBar.update (val: Integer);
+var
+  idx: Integer;
+begin
+  if (val < 0) then val := 0; //else if (val > 1000000) val := 1000000;
+  if (hisHead = -1) then begin hisHead := 0; curval := 0; for idx := 0 to TProfHistorySize-1 do history[idx] := val; end;
+  history[hisHead] := val;
+  Inc(hisHead);
+  if (hisHead = TProfHistorySize) then hisHead := 0;
+  curval := FilterFadeoff*val+(1.0-FilterFadeoff)*curval;
+end;
+
+function TProfilerBar.getvalue (): Integer; begin result := round(curval); end;
+
+function TProfilerBar.getcount (): Integer; begin result := TProfHistorySize; end;
+
+function TProfilerBar.getvalat (idx: Integer): Integer;
+begin
+  if (idx < 0) or (idx >= TProfHistorySize) then result := 0 else result := history[(hisHead-idx-1+TProfHistorySize*2) mod TProfHistorySize];
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TProfiler.Create (aName: AnsiString);
+begin
+  name := aName;
+  bars := nil;
+end;
+
+
+destructor TProfiler.Destroy ();
+begin
+  bars := nil;
+  inherited;
+end;
+
+
+procedure TProfiler.mainBegin (reallyActivate: Boolean=true);
+begin
+  xprofBegin(reallyActivate);
+end;
+
+procedure TProfiler.mainEnd ();
+var
+  idx: Integer;
+begin
+  xprofEnd();
+  if (xprofTotalCount > 0) then
+  begin
+    // first time?
+    if (length(bars) = 0) or (length(bars) <> xprofTotalCount+1) then
+    begin
+      //if (length(bars) <> 0) then raise Exception.Create('FUUUUUUUUUUUUUUU');
+      SetLength(bars, xprofTotalCount+1);
+      for idx := 1 to xprofTotalCount do
+      begin
+        bars[idx].initialize();
+        bars[idx].mName := xprofNameAt(idx-1);
+        bars[idx].mLevel := xprofLevelAt(idx-1)+1;
+      end;
+      bars[0].initialize();
+      bars[0].mName := name;
+      bars[0].mLevel := 0;
+    end;
+    // update bars
+    for idx := 1 to xprofTotalCount do bars[idx].update(xprofMicroAt(idx-1));
+    bars[0].update(xprofTotalMicro);
+  end;
+end;
+
+procedure TProfiler.sectionBegin (name: AnsiString);
+begin
+  xprofBeginSection(name);
+end;
+
+procedure TProfiler.sectionEnd ();
+begin
+  xprofEndSection();
+end;
+
+
 begin
   {$IF DEFINED(STOPWATCH_IS_HERE)}
   xprofGlobalInit();