index 4dc4eaf603072203db39deceed1c06ddca6c903f..225e9de4e324cfd4f6fada7088713c578eca5ca6 100644 (file)
--- a/src/shared/xprofiler.pas
+++ b/src/shared/xprofiler.pas
* 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;
class property isHighResolution : Boolean read mIsHighResolution;
public
+ procedure clear (); inline; // full clear
procedure start (); // start or restart timer
procedure stop ();
{$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
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)
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
class function TStopWatch.Create (): TStopWatch;
begin
initTimerIntr();
- FillChar(result, sizeof(result), 0);
+ result.clear();
end;
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}
parent: Integer; // section index in xpsecs or -1
firstChild: Integer; // first child, or -1
next: Integer; // next sibling, or -1
+ level: Integer;
end;
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
xpsused := 0;
xpscur := -1;
xitcur := -1; // reset iterator
- xitdepth := 0;
+ xpslevel := 0;
+ xptimer.clear();
if reallyActivate then xptimer.start();
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();
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
procedure xprofGlobalInit ();
begin
//SetLength(xpsecs, 1024); // 'cause why not? 'cause don't pay for something you may not need
+ xptimer.clear();
end;
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;
begin
result := true;
xitcur := xpsecs[xitcur].firstChild;
- Inc(xitdepth);
end;
end;
begin
result := true;
xitcur := xpsecs[xitcur].parent;
- Dec(xitdepth);
end;
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
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();