paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-01 15:40:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazLogger: added basic profiling

Browse Source 
git-svn-id: trunk@42871 -
This commit is contained in:
martin 2013-09-19 13:58:38 +00:00
parent 2dbd046864
commit f69430a084
3 changed files with 138 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/lazutils/lazlogger.pas
View File

@ -112,6 +112,7 @@ type
constructor Create;
destructor Destroy; override;
procedure Assign(Src: TLazLogger); override;
function CurrentIndentLevel: Integer; override;
// A param on the commandline, that may contain the name (if not already set)
// example/default: --debug-log=
property ParamForLogFileName: String read FParamForLogFileName write SetParamForLogFileName;
@ -602,6 +603,11 @@ begin
end;
end;
function TLazLoggerFile.CurrentIndentLevel: Integer;
begin
Result := FDebugNestLvl;
end;
procedure TLazLoggerFile.AddBlockHandler(AHandler: TLazLoggerBlockHandler);
begin
FBlockHandler.Add(AHandler);

12
components/lazutils/lazloggerbase.pas
View File

@ -122,6 +122,7 @@ type
procedure Init;
procedure Finish;
function CurrentIndentLevel: Integer; virtual;
property NestLvlIndent: Integer read FNestLvlIndent write SetNestLvlIndent;
property MaxNestPrefixLen: Integer read FMaxNestPrefixLen write SetMaxNestPrefixLen;
@ -669,6 +670,11 @@ begin
FIsInitialized := False;
end;
function TLazLogger.CurrentIndentLevel: Integer;
begin
Result := 0;
end;
function TLazLogger.RegisterLogGroup(const AConfigName: String;
ADefaulEnabled: Boolean): PLazLoggerLogGroup;
begin
@ -770,7 +776,8 @@ end;
procedure TLazLogger.DebugLnEnter(Args: array of const);
begin
DoDebugLn(ArgsToString(Args));
if high(Args) > low(Args) then
DoDebugLn(ArgsToString(Args));
IncreaseIndent;
end;
@ -799,7 +806,8 @@ end;
procedure TLazLogger.DebugLnExit(Args: array of const);
begin
DecreaseIndent;
DoDebugLn(ArgsToString(Args));
if high(Args) > low(Args) then
DoDebugLn(ArgsToString(Args));
end;
procedure TLazLogger.DebugLnExit(s: string; Args: array of const);

124
components/lazutils/lazloggerprofiling.pas
View File

@ -54,8 +54,23 @@ type
function DbgsMemUsed(AFormat: String = '%0:d'): string;
function DbgsTimeUsed(AFormat: String = '%0:n'): string;
procedure DbgStartTimer(AName: String);
procedure DbgStopTimer(AName: String);
procedure DbgStartMemWatch(AName: String);
procedure DbgStopMemWatch(AName: String);
function DbgsMemUsed(AFormat: String; AName: String): string;
function DbgsTimeUsed(AFormat: String; AName: String): string;
implementation
var
NamedMemWatches: TStringList = nil;
NamedTimer: TStringList = nil;
NamedMemWatchesData: Array of record Sum, Last: Int64; end;
NamedTimerData: array of record Sum, Last: QWord; end;
function GetMemWatch: TLazLoggerBlockMemWatch;
var
i: Integer;
@ -88,7 +103,7 @@ var
i: Integer;
begin
Result := '';
i := DebugLogger.NestLvlIndent;
i := DebugLogger.CurrentIndentLevel;
l := GetMemWatch;
if l = nil then exit;
try
@ -104,7 +119,7 @@ var
i: Integer;
begin
Result := '';
i := DebugLogger.NestLvlIndent;
i := DebugLogger.CurrentIndentLevel;
l := GetTimer;
if l = nil then exit;
try
@ -114,6 +129,105 @@ begin
end;
end;
procedure DbgStartTimer(AName: String);
var
idx: Integer;
begin
if NamedTimer = nil then begin
NamedTimer := TStringList.Create;
NamedTimer.Sorted := True;
NamedTimer.Duplicates := dupError;
end;
idx := NamedTimer.IndexOf(AName);
if idx < 0 then begin
idx := NamedTimer.AddObject(AName, TObject(length(NamedTimerData)));
SetLength(NamedTimerData, length(NamedTimerData) + 1);
NamedTimerData[length(NamedTimerData)-1].Sum := 0;
end;
idx := PtrInt(NamedTimer.Objects[idx]);
NamedTimerData[idx].Last := GetTickCount64;
end;
procedure DbgstopTimer(AName: String);
var
idx: Integer;
t: QWord;
begin
if NamedTimer = nil then exit;
idx := NamedTimer.IndexOf(AName);
if idx < 0 then exit;
idx := PtrInt(NamedTimer.Objects[idx]);
t := GetTickCount64;
if t >= NamedTimerData[idx].Last then
t := t - NamedTimerData[idx].Last
else // timer overflow
t := high(t) - NamedTimerData[idx].Last + t;
NamedTimerData[idx].Sum := NamedTimerData[idx].Last + t;
end;
procedure DbgStartMemWatch(AName: String);
var
idx: Integer;
begin
if NamedMemWatches = nil then begin
NamedMemWatches := TStringList.Create;
NamedMemWatches.Sorted := True;
NamedMemWatches.Duplicates := dupError;
end;
idx := NamedMemWatches.IndexOf(AName);
if idx < 0 then begin
idx := NamedMemWatches.AddObject(AName, TObject(length(NamedMemWatchesData)));
SetLength(NamedMemWatchesData, length(NamedMemWatchesData) + 1);
NamedMemWatchesData[length(NamedMemWatchesData)-1].Sum := 0;
end;
idx := PtrInt(NamedMemWatches.Objects[idx]);
NamedMemWatchesData[idx].Last := GetHeapStatus.TotalAllocated;
end;
procedure DbgStopMemWatch(AName: String);
var
idx: Integer;
begin
if NamedMemWatches = nil then exit;
idx := NamedMemWatches.IndexOf(AName);
if idx < 0 then exit;
idx := PtrInt(NamedMemWatches.Objects[idx]);
NamedMemWatchesData[idx].Sum := NamedMemWatchesData[idx].Sum + (GetHeapStatus.TotalAllocated - NamedMemWatchesData[idx].Last);
NamedMemWatchesData[idx].Last := 0;
end;
function DbgsMemUsed(AFormat: String; AName: String): string;
var
idx: Integer;
begin
Result := '';
if NamedMemWatches = nil then exit;
idx := NamedMemWatches.IndexOf(AName);
if idx < 0 then exit;
idx := PtrInt(NamedMemWatches.Objects[idx]);
try
Result := Format(AFormat, [NamedMemWatchesData[idx].Sum]);
except
Result := Format('%d', [NamedMemWatchesData[idx].Sum]);
end;
end;
function DbgsTimeUsed(AFormat: String; AName: String): string;
var
idx: Integer;
begin
Result := '';
if NamedTimer = nil then exit;
idx := NamedTimer.IndexOf(AName);
if idx < 0 then exit;
idx := PtrInt(NamedTimer.Objects[idx]);
try
Result := Format(AFormat, [NamedTimerData[idx].Sum/1000]);
except
Result := Format('%n', [NamedTimerData[idx].Sum /1000]);
end;
end;
{ TLazLoggerBlockMemWatch }
procedure TLazLoggerBlockMemWatch.SetMaxDepth(AValue: Integer);
@ -229,5 +343,11 @@ initialization
DebugLogger.AddBlockHandler(TLazLoggerBlockTimer.Create);
DebugLogger.AddBlockHandler(TLazLoggerBlockMemWatch.Create);
finalization
FreeAndNil(NamedTimer);
FreeAndNil(NamedMemWatches);
NamedTimerData := nil;
NamedMemWatchesData := nil;
end.