From: Ketmar Dark Date: Thu, 17 Aug 2017 12:46:30 +0000 (+0300) Subject: more profiling code X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;ds=inline;h=7869ee331ead2e3f765af47eeca1566ed97faa19;hp=675775b9ff4b38c4ce8efbe29154da1fd776d30c;p=d2df-sdl.git more profiling code --- diff --git a/src/game/g_console.pas b/src/game/g_console.pas index 694a9fa..0669339 100644 --- a/src/game/g_console.pas +++ b/src/game/g_console.pas @@ -390,6 +390,7 @@ begin AddCommand('dpp', ProfilerCommands); AddCommand('dpu', ProfilerCommands); + AddCommand('dpc', ProfilerCommands); AddCommand('r_draw_grid', ProfilerCommands); AddCommand('dbg_coldet_grid', ProfilerCommands); diff --git a/src/game/g_game.pas b/src/game/g_game.pas index f966e26..fa9c288 100644 --- a/src/game/g_game.pas +++ b/src/game/g_game.pas @@ -312,6 +312,7 @@ var g_profile_frame_update: Boolean = false; g_profile_frame_draw: Boolean = false; + g_profile_collision: Boolean = false; procedure g_ResetDynlights (); procedure g_AddDynLight (x, y, radius: Integer; r, g, b, a: Single); @@ -460,17 +461,27 @@ end; *) -procedure drawProfiles (x, y: Integer; prof: TProfiler); +function calcProfilesHeight (prof: TProfiler): Integer; +begin + result := 0; + if (prof = nil) then exit; + if (length(prof.bars) = 0) then exit; + result := length(prof.bars)*(16+2); +end; + +// returns width +function drawProfiles (x, y: Integer; prof: TProfiler): Integer; var wdt, hgt: Integer; yy: Integer; ii, idx: Integer; begin + result := 0; if (prof = nil) then exit; // gScreenWidth if (length(prof.bars) = 0) then exit; wdt := 192; - hgt := length(prof.bars)*(16+2); + hgt := calcProfilesHeight(prof); if (x < 0) then x := gScreenWidth-(wdt-1)+x; if (y < 0) then y := gScreenHeight-(hgt-1)+y; // background @@ -483,6 +494,7 @@ begin e_TextureFontPrintEx(x+2+4*prof.bars[ii].level, yy, Format('%s: %d', [prof.bars[ii].name, prof.bars[ii].value]), gStdFont, 255, 255, 0, 1, false); Inc(yy, 16+2); end; + result := wdt; end; @@ -1477,6 +1489,8 @@ var w: Word; i, b: Integer; begin + g_Map_ProfilersBegin(); + g_ResetDynlights(); // Ïîðà âûêëþ÷àòü èãðó: if gExit = EXIT_QUIT then @@ -1998,6 +2012,8 @@ begin end; if gGameOn then g_Weapon_AddDynLights(); + + g_Map_ProfilersEnd(); end; procedure g_Game_LoadData(); @@ -2997,6 +3013,14 @@ begin p.DrawGUI(); end; +procedure drawProfilers (); +var + px: Integer = -1; +begin + if g_profile_frame_draw then px := px-drawProfiles(px, -1, profileFrameDraw); + if g_profile_collision then px := px-drawProfiles(px, -1, profMapCollision); +end; + procedure g_Game_Draw(); var ID: DWORD; @@ -3319,7 +3343,7 @@ begin Format('%d:%.2d:%.2d', [gTime div 1000 div 3600, (gTime div 1000 div 60) mod 60, gTime div 1000 mod 60]), gStdFont); - if g_profile_frame_draw then drawProfiles(-1, -1, profileFrameDraw); //drawProfiles(-1, -1, 'MAP RENDER'); + drawProfilers(); end; procedure g_Game_Quit(); @@ -5006,6 +5030,11 @@ begin g_profile_frame_update := not g_profile_frame_update; exit; end; + if cmd = 'dpc' then + begin + g_profile_collision := not g_profile_collision; + exit; + end; if cmd = 'r_draw_grid' then begin case getBool(1) of @@ -6853,6 +6882,9 @@ begin s := Find_Param_Value(pars, '--profile-frame'); if (s <> '') then g_profile_frame_draw := true; + s := Find_Param_Value(pars, '--profile-coldet'); + if (s <> '') then g_profile_collision := true; + // Debug mode: s := Find_Param_Value(pars, '--debug'); if (s <> '') then diff --git a/src/game/g_map.pas b/src/game/g_map.pas index 4283144..b84bf3a 100644 --- a/src/game/g_map.pas +++ b/src/game/g_map.pas @@ -20,7 +20,7 @@ interface uses e_graphics, g_basic, MAPSTRUCT, g_textures, Classes, - g_phys, wadreader, BinEditor, g_panel, g_grid, md5; + g_phys, wadreader, BinEditor, g_panel, g_grid, md5, xprofiler; type TMapInfo = record @@ -90,6 +90,9 @@ procedure g_Map_LoadState(Var Mem: TBinMemoryReader); procedure g_Map_DrawPanelShadowVolumes(lightX: Integer; lightY: Integer; radius: Integer); +procedure g_Map_ProfilersBegin (); +procedure g_Map_ProfilersEnd (); + const RESPAWNPOINT_PLAYER1 = 1; RESPAWNPOINT_PLAYER2 = 2; @@ -133,6 +136,7 @@ var gdbg_map_use_grid_render: Boolean = true; gdbg_map_use_grid_coldet: Boolean = true; + profMapCollision: TProfiler = nil; //WARNING: FOR DEBUGGING ONLY! implementation @@ -194,6 +198,26 @@ var gMapGrid: TBodyGrid = nil; +procedure g_Map_ProfilersBegin (); +begin + if (profMapCollision = nil) then profMapCollision := TProfiler.Create('MAP COLLISION'); + profMapCollision.mainBegin(g_profile_collision); + // create sections + if g_profile_collision then + begin + profMapCollision.sectionBeginAccum('wall coldet'); + profMapCollision.sectionEnd(); + profMapCollision.sectionBeginAccum('liquid coldet'); + profMapCollision.sectionEnd(); + end; +end; + +procedure g_Map_ProfilersEnd (); +begin + if (profMapCollision <> nil) then profMapCollision.mainEnd(); +end; + + function g_Map_IsSpecialTexture(Texture: String): Boolean; begin Result := (Texture = TEXTURE_NAME_WATER) or @@ -2189,13 +2213,19 @@ function g_Map_CollidePanel(X, Y: Integer; Width, Height: Word; PanelType: Word; end; begin - if gdbg_map_use_grid_coldet then - begin - result := gMapGrid.forEachInAABB(X, Y, Width, Height, checker); - end - else - begin - result := g_Map_CollidePanelOld(X, Y, Width, Height, PanelType, b1x3); + //TODO: detailed profile + if (profMapCollision <> nil) then profMapCollision.sectionBeginAccum('wall coldet'); + try + if gdbg_map_use_grid_coldet then + begin + result := gMapGrid.forEachInAABB(X, Y, Width, Height, checker); + end + else + begin + result := g_Map_CollidePanelOld(X, Y, Width, Height, PanelType, b1x3); + end; + finally + if (profMapCollision <> nil) then profMapCollision.sectionEnd(); end; end; @@ -2247,15 +2277,21 @@ var end; begin - if not gdbg_map_use_grid_coldet then - begin - result := g_Map_CollideLiquid_TextureOld(X, Y, Width, Height); - end - else - begin - texid := TEXTURE_NONE; - gMapGrid.forEachInAABB(X, Y, Width, Height, checker); - result := texid; + //TODO: detailed profile? + if (profMapCollision <> nil) then profMapCollision.sectionBeginAccum('liquid coldet'); + try + if not gdbg_map_use_grid_coldet then + begin + result := g_Map_CollideLiquid_TextureOld(X, Y, Width, Height); + end + else + begin + texid := TEXTURE_NONE; + gMapGrid.forEachInAABB(X, Y, Width, Height, checker); + result := texid; + end; + finally + if (profMapCollision <> nil) then profMapCollision.sectionEnd(); end; end; 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.