X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxprofiler.pas;h=5e6212b921b5b7ddc04784ad9d601503b3d93483;hb=0e101bd452c40da601236aaa2dd4106be47ddce1;hp=225e9de4e324cfd4f6fada7088713c578eca5ca6;hpb=d8e15c7dbfcaf848ae7db165289b7ee9c687133c;p=d2df-sdl.git diff --git a/src/shared/xprofiler.pas b/src/shared/xprofiler.pas index 225e9de..5e6212b 100644 --- a/src/shared/xprofiler.pas +++ b/src/shared/xprofiler.pas @@ -1,9 +1,8 @@ -(* Copyright (C) DooM 2D:Forever Developers +(* Copyright (C) Doom 2D: Forever Developers * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. + * the Free Software Foundation, version 3 of the License ONLY. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -14,20 +13,36 @@ * 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} +{.$DEFINE XPROFILER_SLOW_AVERAGE} unit xprofiler; interface -uses - SysUtils, - {$IF DEFINED(LINUX)} +{$IFNDEF IN_TOOLS} + uses + {$IFDEF USE_SDL} + SDL, + {$ENDIF} + {$IFDEF USE_SDL2} + SDL2, + {$ENDIF} + SysUtils; + + {$DEFINE STOPWATCH_IS_HERE} + +{$ELSE} + uses + SysUtils + {$IF DEFINED(LINUX) OR DEFINED(ANDROID)} {$DEFINE STOPWATCH_IS_HERE} - unixtype, linux + , unixtype, linux {$ELSEIF DEFINED(WINDOWS)} {$DEFINE STOPWATCH_IS_HERE} - Windows + , Windows + {$ELSEIF DEFINED(HAIKU)} + {$DEFINE STOPWATCH_IS_HERE} + , unixtype {$ELSE} {$IFDEF STOPWATCH_IS_HERE} {$UNDEF STOPWATCH_IS_HERE} @@ -35,72 +50,65 @@ uses {$WARNING You suck!} {$ENDIF} ; +{$ENDIF} // IN_TOOLS + +{$IFDEF USE_SDL} + type + UInt64 = QWord; (* !!! *) +{$ENDIF} {$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} const - TProfHistorySize = 100; + TProfHistorySize = 1000; type TProfilerBar = record private - const FilterFadeoff = 0.05; // 5% + //const FilterFadeoff = 0.05; // 5% private - history: array [0..TProfHistorySize-1] of Integer; // circular buffer - hisHead: Integer; - curval: Single; + history: array of Integer; // circular buffer + hisLast: Integer; + //curval: Single; + curAccum: UInt64; + curAccumCount: Integer; mName: AnsiString; mLevel: Integer; private - procedure initialize (); inline; + procedure initialize (aHistSize: Integer); inline; function getvalue (): Integer; inline; function getvalat (idx: Integer): Integer; inline; function getcount (): Integer; inline; @@ -116,528 +124,429 @@ 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; + histSize: Integer; public - constructor Create (aName: AnsiString); + constructor Create (aName: AnsiString; aHistSize: Integer); 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 sectionBegin (aName: 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; + // this will reuse the section with the given name (if there is any); use `sectionEnd()` to end it as usual + procedure sectionBeginAccum (aName: AnsiString); + end; -// 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) +function getTimeMicro (): UInt64; inline; +function getTimeMilli (): UInt64; inline; implementation -const - TicksPerNanoSecond = 100; - TicksPerMilliSecond = 10000; - TicksPerSecond = 10000000000000000; +{$IFNDEF IN_TOOLS} +type + THPTimeType = Int64; +{$ELSE} +{$IF DEFINED(LINUX)} +type THPTimeType = TTimeSpec; +{$ELSE} +type THPTimeType = Int64; +{$ENDIF} + +var + mFrequency: Int64 = 0; + mHasHPTimer: Boolean = false; +{$ENDIF} // ////////////////////////////////////////////////////////////////////////// // -class procedure TStopWatch.initTimerIntr (); -{$IF DEFINED(LINUX)} +procedure initTimerIntr (); +{$IFDEF IN_TOOLS} var - r: TBaseMesure; + r: THPTimeType; {$ENDIF} begin +{$IFDEF IN_TOOLS} 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); +{$ELSEIF DEFINED(WINDOWS)} + mHasHPTimer := QueryPerformanceFrequency(r); + if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available'); + mFrequency := r; {$ENDIF} end; +{$ENDIF} + (* init sdl timers? *) end; -class function TStopWatch.Create (): TStopWatch; -begin - initTimerIntr(); - result.clear(); -end; - - -class function TStopWatch.startNew (): TStopWatch; -begin - result := TStopWatch.Create(); - result.start(); -end; - - -function TStopWatch.getElapsedMilliseconds (): Int64; -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} -end; - - -function TStopWatch.getElapsedMicroseconds (): 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} -end; - - -function TStopWatch.getElapsedTicks (): Int64; +{$IF DEFINED(IN_TOOLS)} +function getTimeMicro (): UInt64; inline; +var + r: THPTimeType; begin - if (mFrequency = 0) then begin result := 0; exit; end; - if mRunning then updateElapsed(); + //if (mFrequency = 0) then initTimerIntr(); {$IF DEFINED(LINUX)} - result := mElapsed div TicksPerNanoSecond; - {$ELSE} - result := (mElapsed*TicksPerSecond) div mFrequency; + clock_gettime(CLOCK_MONOTONIC, @r); + result := UInt64(r.tv_sec)*1000000+UInt64(r.tv_nsec) div 1000; // microseconds + {$ELSEIF DEFINED(WINDOWS)} + QueryPerformanceCounter(r); + result := UInt64(r)*1000000 div mFrequency; {$ENDIF} end; - - -procedure TStopWatch.clear (); +(* !!! +{$ELSEIF DEFINED(USE_SDL)} +function getTimeMicro: UInt64; inline; begin - //FillChar(self, sizeof(self), 0); - mElapsed := 0; - mRunning := false; - //mStartPosition: TBaseMesure; + {$WARNING use inaccurate profiling timer} + result := SDL_GetTicks() * 1000 end; - - -procedure TStopWatch.start (); +*) +{$ELSEIF DEFINED(USE_SDL2)} +function getTimeMicro (): UInt64; inline; begin - //if mRunning then exit; - if (mFrequency = 0) then initTimerIntr(); - mRunning := true; - mElapsed := 0; - {$IF DEFINED(LINUX)} - clock_gettime(CLOCK_MONOTONIC, @mStartPosition); - {$ELSE} - QueryPerformanceCounter(mStartPosition); - {$ENDIF} + Result := SDL_GetPerformanceCounter() * 1000000 div SDL_GetPerformanceFrequency() end; - - -procedure TStopWatch.updateElapsed (); -var - locEnd: TBaseMesure; - {$IF DEFINED(LINUX)} - s, n: Int64; - {$ENDIF} +{$ELSE} +function getTimeMicro: UInt64; inline; 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} + {$WARNING use stub profiling timer} end; +{$ENDIF} -procedure TStopWatch.stop (); +function getTimeMilli (): UInt64; inline; begin - if not mRunning then exit; - mRunning := false; - updateElapsed(); + result := getTimeMicro() div 1000; 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); +class function TStopWatch.Create (): TStopWatch; begin - xpsused := 0; - xpscur := -1; - xitcur := -1; // reset iterator - xpslevel := 0; - xptimer.clear(); - if reallyActivate then xptimer.start(); + result.clear(); end; -// call this on frame end -procedure xprofEnd (); +class function TStopWatch.startNew (): TStopWatch; begin - if not xptimer.isRunning then exit; - while xpscur <> -1 do - begin - xpsecs[xpscur].timer.stop(); - xpscur := xpsecs[xpscur].parent; - end; - xptimer.stop(); + result := TStopWatch.Create(); + result.start(); end; -// don't fuckup pairing of there, 'cause they can be nested! -//FIXME: rewrite without schlemiel's algo! -procedure xprofBeginSection (name: AnsiString); +procedure TStopWatch.updateElapsed (); var - sid, t: Integer; - pss: PProfSection; + e: UInt64; 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(); + e := getTimeMicro(); + if (mStartPosition > e) then mStartPosition := e; + Inc(mElapsed, e-mStartPosition); + mStartPosition := e; end; -procedure xprofEndSection (); -var - pss: PProfSection; +function TStopWatch.getElapsedMicro (): Int64; 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; + if mRunning then updateElapsed(); + result := mElapsed; // microseconds end; -procedure xprofGlobalInit (); +function TStopWatch.getElapsedMilli (): Int64; begin - //SetLength(xpsecs, 1024); // 'cause why not? 'cause don't pay for something you may not need - xptimer.clear(); + if mRunning then updateElapsed(); + result := mElapsed div 1000; // milliseconds end; -// ////////////////////////////////////////////////////////////////////////// // -// iterator -function xprofTotalMicro (): Int64; begin result := xptimer.elapsedMicro; end; -function xprofTotalMilli (): Int64; begin result := xptimer.elapsedMilli; end; - -// all items -function xprofTotalCount (): Integer; +procedure TStopWatch.clear (); begin - if xptimer.isRunning then result := 0 else result := xpsused; + mElapsed := 0; + mRunning := false; + mStartPosition := 0; 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; +procedure TStopWatch.start (reset: Boolean=true); 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; + if mRunning and not reset then exit; // nothing to do + mStartPosition := getTimeMicro(); + mRunning := true; + if (reset) then mElapsed := 0; end; -// from current item to eol (not including children, but including current item) -function xprofItCount (): Integer; -var - idx: Integer; +procedure TStopWatch.stop (); begin - result := 0; - idx := xitcur; - while (idx <> -1) do - begin - Inc(result); - idx := xpsecs[idx].next; - end; + if not mRunning then exit; + mRunning := false; + updateElapsed(); 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; +procedure TStopWatch.pause (); begin - if (xitcur = -1) or (xpsecs[xitcur].firstChild = -1) then - begin - result := false; - end - else - begin - result := true; - xitcur := xpsecs[xitcur].firstChild; - end; + stop(); 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; +procedure TStopWatch.resume (); begin - if (xitcur = -1) or (xpsecs[xitcur].next = -1) then - begin - result := false; - end - else - begin - result := true; - xitcur := xpsecs[xitcur].next; - end; + if mRunning then exit; + start(false); // don't reset 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; +procedure TProfilerBar.initialize (aHistSize: Integer); begin SetLength(history, aHistSize); hisLast := -1; curAccum := 0; curAccumCount := 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; + if (hisLast = -1) then begin hisLast := High(history); curAccum := 0; curAccumCount := 0; for idx := 0 to High(history) do history[idx] := val; end; + if (curAccumCount = Length(history)) then Dec(curAccum, UInt64(history[(hisLast+1) mod Length(history)])) else Inc(curAccumCount); + Inc(hisLast); + if (hisLast >= Length(history)) then hisLast := 0; + Inc(curAccum, UInt64(val)); + history[hisLast] := val; + //curval := FilterFadeoff*val+(1.0-FilterFadeoff)*curval; end; -function TProfilerBar.getvalue (): Integer; begin result := round(curval); end; +function TProfilerBar.getvalue (): Integer; +{$IFDEF XPROFILER_SLOW_AVERAGE} +var idx: Integer; +{$ENDIF} +begin + {$IFDEF XPROFILER_SLOW_AVERAGE} + result := 0; + for idx := 0 to High(history) do Inc(result, history[idx]); + result := result div Length(history); + {$ELSE} + //result := round(curval); + if curAccumCount > 0 then result := Integer(curAccum div curAccumCount) else result := 0; + {$ENDIF} +end; -function TProfilerBar.getcount (): Integer; begin result := TProfHistorySize; end; +function TProfilerBar.getcount (): Integer; begin result := Length(history); 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]; + if (idx < 0) or (idx >= Length(history)) then result := 0 else result := history[(hisLast-idx+Length(history)*2) mod Length(history)]; end; // ////////////////////////////////////////////////////////////////////////// // -constructor TProfiler.Create (aName: AnsiString); +constructor TProfiler.Create (aName: AnsiString; aHistSize: Integer); begin name := aName; bars := nil; + if (aHistSize < 10) then aHistSize := 10; + if (aHistSize > 10000) then aHistSize := 10000; + histSize := aHistSize; + {$IF DEFINED(STOPWATCH_IS_HERE)} + xptimer.clear(); + xpsecs := nil; + xpsused := 0; + xpscur := -1; + {$ENDIF} end; destructor TProfiler.Destroy (); +var + idx: Integer; begin + for idx := 0 to High(bars) do bars[idx].history := nil; 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].initialize(histSize); + bars[idx].mName := xpsecs[idx-1].name; + bars[idx].mLevel := xpsecs[idx-1].level+1; end; - bars[0].initialize(); + bars[0].initialize(histSize); 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(histSize); + bars[0].mName := name; + bars[0].mLevel := 0; + end; + bars[0].update(xptimer.elapsedMicro); end; + {$ENDIF} +end; + +procedure TProfiler.sectionBegin (aName: AnsiString); +{$IF DEFINED(STOPWATCH_IS_HERE)} +var + sid: Integer; + pss: PProfSection; +{$ENDIF} +begin + {$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 := aName; + 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.sectionBegin (name: AnsiString); +procedure TProfiler.sectionBeginAccum (aName: AnsiString); +{$IF DEFINED(STOPWATCH_IS_HERE)} +var + idx: Integer; +{$ENDIF} begin - xprofBeginSection(name); + {$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 = aName) then + begin + if (idx = xpscur) then raise Exception.Create('profiler error(0): double resume: "'+aName+'"'); + if (xpsecs[idx].prevAct <> -1) then raise Exception.Create('profiler error(1): double resume: "'+aName+'"'); + xpsecs[idx].prevAct := xpscur; + xpscur := idx; + xpsecs[idx].timer.resume(); + exit; + end; + end; + end; + sectionBegin(aName); + {$ENDIF} end; procedure TProfiler.sectionEnd (); +{$IF DEFINED(STOPWATCH_IS_HERE)} +var + pss: PProfSection; +{$ENDIF} begin - xprofEndSection(); + {$IF DEFINED(STOPWATCH_IS_HERE)} + 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; begin - {$IF DEFINED(STOPWATCH_IS_HERE)} - xprofGlobalInit(); - {$ENDIF} + initTimerIntr(); end.