X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxprofiler.pas;h=083704863848142f8e7f8342f3c57a260d1e9959;hb=7869ee331ead2e3f765af47eeca1566ed97faa19;hp=225e9de4e324cfd4f6fada7088713c578eca5ca6;hpb=675775b9ff4b38c4ce8efbe29154da1fd776d30c;p=d2df-sdl.git diff --git a/src/shared/xprofiler.pas b/src/shared/xprofiler.pas index 225e9de..0837048 100644 --- a/src/shared/xprofiler.pas +++ b/src/shared/xprofiler.pas @@ -14,7 +14,6 @@ * along with this program. If not, see . *) // stopwatch timer to measure short periods (like frame rendering phases) -// TStopWatch is based on the code by Inoussa OUEDRAOGO, Copyright (c) 2012 {$INCLUDE a_modes.inc} unit xprofiler; @@ -39,46 +38,31 @@ uses {$IF DEFINED(STOPWATCH_IS_HERE)} type TStopWatch = record - private - {$IF DEFINED(LINUX)} - type TBaseMesure = TTimeSpec; - {$ELSE} - type TBaseMesure = Int64; - {$ENDIF} - - strict private - class var mFrequency: Int64; - class var mIsHighResolution: Boolean; - strict private mElapsed: Int64; mRunning: Boolean; - mStartPosition: TBaseMesure; + mStartPosition: UInt64; strict private - class procedure initTimerIntr (); static; - procedure updateElapsed (); - function getElapsedMilliseconds (): Int64; - function getElapsedMicroseconds (): Int64; - function getElapsedTicks (): Int64; + function getElapsedMicro (): Int64; + function getElapsedMilli (): Int64; public class function Create (): TStopWatch; static; class function startNew (): TStopWatch; static; - class property frequency : Int64 read mFrequency; - class property isHighResolution : Boolean read mIsHighResolution; - public procedure clear (); inline; // full clear - procedure start (); // start or restart timer + procedure start (reset: Boolean=true); // start or restart timer procedure stop (); + // the following is like start/stop, but doesn't reset elapsed time + procedure pause (); + procedure resume (); - property elapsedMilli: Int64 read getElapsedMilliseconds; - property elapsedMicro: Int64 read getElapsedMicroseconds; - property elapsedTicks: Int64 read getElapsedTicks; + property elapsedMicro: Int64 read getElapsedMicro; + property elapsedMilli: Int64 read getElapsedMilli; property isRunning: Boolean read mRunning; end; {$ENDIF} @@ -116,88 +100,98 @@ type end; TProfiler = class(TObject) + private + {$IF DEFINED(STOPWATCH_IS_HERE)} + type + PProfSection = ^TProfSection; + TProfSection = record + name: AnsiString; + timer: TStopWatch; + level: Integer; + prevAct: Integer; // this serves as stack + end; + + var + xptimer: TStopWatch; + xpsecs: array of TProfSection; + xpsused: Integer; + xpscur: Integer; // currently running section + {$ENDIF} + public - bars: array of TProfilerBar; + bars: array of TProfilerBar; // 0: total time name: AnsiString; public constructor Create (aName: AnsiString); destructor Destroy (); override; + // call this on frame start procedure mainBegin (reallyActivate: Boolean=true); + // call this on frame end 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 xprofEnd (); -function xprofTotalMicro (): Int64; // total duration, microseconds -function xprofTotalMilli (): Int64; // total duration, milliseconds -function xprofTotalCount (): Integer; // all items - -// don't fuckup pairing of there, 'cause they can be nested! -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) -// current item info -function xprofItName (): AnsiString; // current section name -function xprofItMicro (): Int64; // current section duration, microseconds -function xprofItMilli (): Int64; // current section duration, milliseconds -function xprofItHasChildren (): Boolean; -function xprofItIsChild (): Boolean; -function xprofItLevel (): Integer; // 0: top - -function xprofItDive (): Boolean; // dive into childrens -function xprofItPop (): Boolean; // pop into parent -function xprofItNext (): Boolean; // move to next sibling; false: no more siblings (and current item is unchanged) + // this will reuse the section with the given name (if there is any); use `sectionEnd()` to end it as usual + procedure sectionBeginAccum (name: AnsiString); + end; implementation -const - TicksPerNanoSecond = 100; - TicksPerMilliSecond = 10000; - TicksPerSecond = 10000000000000000; +{$IF DEFINED(LINUX)} +type THPTimeType = TTimeSpec; +{$ELSE} +type THPTimeType = Int64; +{$ENDIF} + +var + mFrequency: Int64 = 0; + mHasHPTimer: Boolean = false; // ////////////////////////////////////////////////////////////////////////// // -class procedure TStopWatch.initTimerIntr (); -{$IF DEFINED(LINUX)} +procedure initTimerIntr (); var - r: TBaseMesure; -{$ENDIF} + r: THPTimeType; begin if (mFrequency = 0) then begin {$IF DEFINED(LINUX)} - mIsHighResolution := (clock_getres(CLOCK_MONOTONIC, @r) = 0); - mIsHighResolution := mIsHighResolution and (r.tv_nsec <> 0); + if (clock_getres(CLOCK_MONOTONIC, @r) <> 0) then raise Exception.Create('profiler error: cannot get timer resolution'); + mHasHPTimer := (r.tv_nsec <> 0); + if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available'); + mFrequency := 1; // just a flag if (r.tv_nsec <> 0) then mFrequency := 1000000000000000000 div r.tv_nsec; {$ELSE} - mIsHighResolution := QueryPerformanceFrequency(mFrequency); + mHasHPTimer := QueryPerformanceFrequency(r); + if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available'); + mFrequency := r; {$ENDIF} end; end; +function curTimeMicro (): UInt64; inline; +var + r: THPTimeType; +begin + if (mFrequency = 0) then initTimerIntr(); + {$IF DEFINED(LINUX)} + clock_gettime(CLOCK_MONOTONIC, @r); + result := UInt64(r.tv_sec)*1000000+UInt64(r.tv_nsec) div 1000; // microseconds + {$ELSE} + QueryPerformanceCounter(r); + result := UInt64(r)*1000000 div mFrequency; + {$ENDIF} +end; + + +// ////////////////////////////////////////////////////////////////////////// // class function TStopWatch.Create (): TStopWatch; begin - initTimerIntr(); result.clear(); end; @@ -209,89 +203,45 @@ begin end; -function TStopWatch.getElapsedMilliseconds (): Int64; +procedure TStopWatch.updateElapsed (); +var + e: UInt64; begin - if (mFrequency = 0) then begin result := 0; exit; end; - if mRunning then updateElapsed(); - {$IF DEFINED(LINUX)} - result := mElapsed div 1000000; - {$ELSE} - result := elapsedTicks*TicksPerMilliSecond; - {$ENDIF} + e := curTimeMicro(); + if (mStartPosition > e) then mStartPosition := e; + Inc(mElapsed, e-mStartPosition); + mStartPosition := e; end; -function TStopWatch.getElapsedMicroseconds (): Int64; +function TStopWatch.getElapsedMicro (): Int64; begin - if (mFrequency = 0) then begin result := 0; exit; end; if mRunning then updateElapsed(); - {$IF DEFINED(LINUX)} - result := mElapsed div 1000; - {$ELSE} - result := elapsedTicks*(TicksPerMilliSecond div 100); - {$ENDIF} + result := mElapsed; // microseconds end; -function TStopWatch.getElapsedTicks (): Int64; +function TStopWatch.getElapsedMilli (): Int64; begin - if (mFrequency = 0) then begin result := 0; exit; end; if mRunning then updateElapsed(); - {$IF DEFINED(LINUX)} - result := mElapsed div TicksPerNanoSecond; - {$ELSE} - result := (mElapsed*TicksPerSecond) div mFrequency; - {$ENDIF} + result := mElapsed div 1000; // milliseconds end; procedure TStopWatch.clear (); begin - //FillChar(self, sizeof(self), 0); mElapsed := 0; mRunning := false; - //mStartPosition: TBaseMesure; + mStartPosition := 0; end; -procedure TStopWatch.start (); +procedure TStopWatch.start (reset: Boolean=true); begin - //if mRunning then exit; - if (mFrequency = 0) then initTimerIntr(); + if mRunning and not reset then exit; // nothing to do + mStartPosition := curTimeMicro(); mRunning := true; - mElapsed := 0; - {$IF DEFINED(LINUX)} - clock_gettime(CLOCK_MONOTONIC, @mStartPosition); - {$ELSE} - QueryPerformanceCounter(mStartPosition); - {$ENDIF} -end; - - -procedure TStopWatch.updateElapsed (); -var - locEnd: TBaseMesure; - {$IF DEFINED(LINUX)} - s, n: Int64; - {$ENDIF} -begin - {$IF DEFINED(LINUX)} - clock_gettime(CLOCK_MONOTONIC, @locEnd); - if (locEnd.tv_nsec < mStartPosition.tv_nsec) then - begin - s := locEnd.tv_sec-mStartPosition.tv_sec-1; - n := 1000000000000000000+locEnd.tv_nsec-mStartPosition.tv_nsec; - end - else - begin - s := locEnd.tv_sec-mStartPosition.tv_sec; - n := locEnd.tv_nsec-mStartPosition.tv_nsec; - end; - mElapsed := mElapsed+(s*1000000000000000000)+n; - {$ELSE} - QueryPerformanceCounter(locEnd); - mElapsed := mElapsed+(UInt64(locEnd)-UInt64(mStartPosition)); - {$ENDIF} + if (reset) then mElapsed := 0; end; @@ -303,255 +253,19 @@ begin end; -// ////////////////////////////////////////////////////////////////////////// // -// high-level profiler -{$IF DEFINED(STOPWATCH_IS_HERE)} -type - PProfSection = ^TProfSection; - TProfSection = record - name: AnsiString; - timer: TStopWatch; - parent: Integer; // section index in xpsecs or -1 - firstChild: Integer; // first child, or -1 - next: Integer; // next sibling, or -1 - level: Integer; - end; - -var - xptimer: TStopWatch; - xpsecs: array of TProfSection = nil; - xpsused: Integer = 0; - xpscur: Integer = -1; // currently running section - xpslevel: Integer = 0; - xitcur: Integer = -1; // for iterator - - -// call this on frame start -procedure xprofBegin (reallyActivate: Boolean=true); +procedure TStopWatch.pause (); begin - xpsused := 0; - xpscur := -1; - xitcur := -1; // reset iterator - xpslevel := 0; - xptimer.clear(); - if reallyActivate then xptimer.start(); + stop(); end; -// call this on frame end -procedure xprofEnd (); +procedure TStopWatch.resume (); begin - if not xptimer.isRunning then exit; - while xpscur <> -1 do - begin - xpsecs[xpscur].timer.stop(); - xpscur := xpsecs[xpscur].parent; - end; - xptimer.stop(); -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); - pss := @xpsecs[sid]; - pss.name := name; - pss.timer.clear(); - pss.parent := xpscur; - pss.firstChild := -1; - pss.next := -1; - pss.level := xpslevel; - Inc(xpslevel); - // link to list - if (xpscur <> -1) then - begin - // child - t := xpsecs[xpscur].firstChild; - if (t = -1) then - begin - xpsecs[xpscur].firstChild := sid; - end - else - begin - 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(); -end; - - -procedure xprofEndSection (); -var - pss: PProfSection; -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 - xpscur := pss.parent; -end; - - -procedure xprofGlobalInit (); -begin - //SetLength(xpsecs, 1024); // 'cause why not? 'cause don't pay for something you may not need - xptimer.clear(); + if mRunning then exit; + start(false); // don't reset end; -// ////////////////////////////////////////////////////////////////////////// // -// iterator -function xprofTotalMicro (): Int64; begin result := xptimer.elapsedMicro; end; -function xprofTotalMilli (): Int64; begin result := xptimer.elapsedMilli; end; - -// all items -function xprofTotalCount (): Integer; -begin - if xptimer.isRunning then result := 0 else result := xpsused; -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; - if xptimer.isRunning then exit; - if (xpsused = 0) then exit; // no sections - xitcur := 0; - assert(xpsecs[0].parent = -1); - result := true; -end; - - -// from current item to eol (not including children, but including current item) -function xprofItCount (): Integer; -var - idx: Integer; -begin - result := 0; - idx := xitcur; - while (idx <> -1) do - begin - Inc(result); - idx := xpsecs[idx].next; - end; -end; - - -// current item info -function xprofItName (): AnsiString; begin if (xitcur = -1) then result := '' else result := xpsecs[xitcur].name; end; -function xprofItMicro (): Int64; begin if (xitcur = -1) then result := 0 else result := xpsecs[xitcur].timer.elapsedMicro; end; -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 xprofItLevel (): Integer; begin if (xitcur = -1) then result := 0 else result := xpsecs[xitcur].level; end; - -// dive into childrens -function xprofItDive (): Boolean; -begin - if (xitcur = -1) or (xpsecs[xitcur].firstChild = -1) then - begin - result := false; - end - else - begin - result := true; - xitcur := xpsecs[xitcur].firstChild; - end; -end; - -// pop into parent -function xprofItPop (): Boolean; -begin - if (xitcur = -1) or (xpsecs[xitcur].parent = -1) then - begin - result := false; - end - else - begin - result := true; - xitcur := xpsecs[xitcur].parent; - end; -end; - -// move to next sibling; false: no more siblings (and current item is unchanged) -function xprofItNext (): Boolean; -begin - if (xitcur = -1) or (xpsecs[xitcur].next = -1) then - begin - result := false; - end - else - begin - result := true; - xitcur := xpsecs[xitcur].next; - end; -end; - -{$ELSE} -procedure xprofBegin (reallyActivate: Boolean=true); begin end; -procedure xprofEnd (); begin end; -procedure xprofBeginSection (name: AnsiString); begin end; -procedure xprofEndSection (); begin end; - -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 -function xprofItName (): AnsiString; begin result := ''; end; -function xprofItMicro (): Int64; begin result := 0; end; -function xprofItMilli (): Int64; begin result := 0; end; -function xprofItHasChildren (): Boolean; begin result := false; end; -function xprofItIsChild (): Boolean; begin result := false; end; - -function xprofItDepth (): Integer; begin result := 0; end; - -function xprofItDive (): Boolean; begin result := false; end; -function xprofItPop (): Boolean; begin result := false; end; -function xprofItNext (): Boolean; begin result := false; end; -{$ENDIF} - - // ////////////////////////////////////////////////////////////////////////// // procedure TProfilerBar.initialize (); begin hisHead := -1; curval := 0; end; @@ -567,7 +281,16 @@ begin curval := FilterFadeoff*val+(1.0-FilterFadeoff)*curval; end; -function TProfilerBar.getvalue (): Integer; begin result := round(curval); end; +function TProfilerBar.getvalue (): Integer; +//var idx: Integer; +begin + result := round(curval); + { + result := 0; + for idx := 0 to TProfHistorySize-1 do Inc(result, history[idx]); + result := result div TProfHistorySize; + } +end; function TProfilerBar.getcount (): Integer; begin result := TProfHistorySize; end; @@ -582,62 +305,169 @@ constructor TProfiler.Create (aName: AnsiString); begin name := aName; bars := nil; + {$IF DEFINED(STOPWATCH_IS_HERE)} + xptimer.clear(); + xpsecs := nil; + xpsused := 0; + xpscur := -1; + {$ENDIF} end; destructor TProfiler.Destroy (); begin bars := nil; + {$IF DEFINED(STOPWATCH_IS_HERE)} + xpsecs := nil; + {$ENDIF} inherited; end; procedure TProfiler.mainBegin (reallyActivate: Boolean=true); begin - xprofBegin(reallyActivate); + {$IF DEFINED(STOPWATCH_IS_HERE)} + xpsused := 0; + xpscur := -1; + xptimer.clear(); + if reallyActivate then xptimer.start(); + {$ENDIF} end; procedure TProfiler.mainEnd (); +{$IF DEFINED(STOPWATCH_IS_HERE)} var idx: Integer; + emm: Integer; + + procedure finishProfiling (); + var + idx: Integer; + begin + if (xpsused > 0) then + begin + for idx := 0 to xpsused-1 do + begin + xpsecs[idx].timer.stop(); + xpsecs[idx].prevAct := -1; + end; + end; + xptimer.stop(); + xpscur := -1; + end; +{$ENDIF} begin - xprofEnd(); - if (xprofTotalCount > 0) then + {$IF DEFINED(STOPWATCH_IS_HERE)} + if not xptimer.isRunning then exit; + finishProfiling(); + if (xpsused > 0) then begin // first time? - if (length(bars) = 0) or (length(bars) <> xprofTotalCount+1) then + if (length(bars) = 0) or (length(bars) <> xpsused+1) then begin //if (length(bars) <> 0) then raise Exception.Create('FUUUUUUUUUUUUUUU'); - SetLength(bars, xprofTotalCount+1); - for idx := 1 to xprofTotalCount do + SetLength(bars, xpsused+1); + for idx := 1 to xpsused do begin bars[idx].initialize(); - bars[idx].mName := xprofNameAt(idx-1); - bars[idx].mLevel := xprofLevelAt(idx-1)+1; + bars[idx].mName := xpsecs[idx-1].name; + bars[idx].mLevel := xpsecs[idx-1].level+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); + emm := 0; + for idx := 1 to xpsused do + begin + bars[idx].update(Integer(xpsecs[idx-1].timer.elapsedMicro)); + Inc(emm, Integer(xpsecs[idx-1].timer.elapsedMicro)); + end; + //bars[0].update(xptimer.elapsedMicro); + bars[0].update(emm); + end + else + begin + if (length(bars) <> 1) then + begin + SetLength(bars, 1); + bars[0].initialize(); + bars[0].mName := name; + bars[0].mLevel := 0; + end; + bars[0].update(xptimer.elapsedMicro); end; + {$ENDIF} end; procedure TProfiler.sectionBegin (name: AnsiString); +{$IF DEFINED(STOPWATCH_IS_HERE)} +var + sid: Integer; + pss: PProfSection; +{$ENDIF} begin - xprofBeginSection(name); + {$IF DEFINED(STOPWATCH_IS_HERE)} + if not xptimer.isRunning then exit; + if (Length(xpsecs) = 0) then SetLength(xpsecs, 512); // why not? + if (xpsused >= Length(xpsecs)) then raise Exception.Create('too many profile sections'); + sid := xpsused; + Inc(xpsused); + pss := @xpsecs[sid]; + pss.name := name; + pss.timer.clear(); + pss.prevAct := xpscur; + // calculate level + if (xpscur = -1) then pss.level := 0 else pss.level := xpsecs[xpscur].level+1; + xpscur := sid; + pss.timer.start(); + {$ENDIF} end; -procedure TProfiler.sectionEnd (); +procedure TProfiler.sectionBeginAccum (name: AnsiString); +{$IF DEFINED(STOPWATCH_IS_HERE)} +var + idx: Integer; +{$ENDIF} begin - xprofEndSection(); + {$IF DEFINED(STOPWATCH_IS_HERE)} + if not xptimer.isRunning then exit; + if (xpsused > 0) then + begin + for idx := 0 to xpsused-1 do + begin + if (xpsecs[idx].name = name) then + begin + if (idx = xpscur) then raise Exception.Create('profiler error(0): dobule resume: "'+name+'"'); + if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): dobule resume: "'+name+'"'); + xpsecs[idx].prevAct := xpscur; + xpscur := idx; + xpsecs[idx].timer.resume(); + exit; + end; + end; + end; + sectionBegin(name); + {$ENDIF} end; - +procedure TProfiler.sectionEnd (); +{$IF DEFINED(STOPWATCH_IS_HERE)} +var + pss: PProfSection; +{$ENDIF} begin {$IF DEFINED(STOPWATCH_IS_HERE)} - xprofGlobalInit(); + if not xptimer.isRunning then exit; + if (xpscur = -1) then exit; // this is bug, but meh... + pss := @xpsecs[xpscur]; + pss.timer.stop(); + // go back to parent + xpscur := pss.prevAct; + pss.prevAct := -1; {$ENDIF} +end; + + end.