Browse Source

* implemented binary mode for profiler, defer symbol lookup to postprocessing

master
Martok 7 years ago
parent
commit
67a8598bc6
4 changed files with 67 additions and 74 deletions
  1. +1
    -1
      uutlEmbeddedProfiler.inc
  2. +9
    -45
      uutlEmbeddedProfiler.pas
  3. +29
    -28
      uutlProfilerBinary.inc
  4. +28
    -0
      uutlProfilerBinaryFmt.inc

+ 1
- 1
uutlEmbeddedProfiler.inc View File

@@ -42,4 +42,4 @@
{$DEFINE __PROFSETNAME:=//}
{$DEFINE __PROFENTERNAME:=}
{$ENDIF}

+ 9
- 45
uutlEmbeddedProfiler.pas View File

@@ -5,7 +5,6 @@ unit uutlEmbeddedProfiler;
{$OPTIMIZATION REGVAR}
{$OPTIMIZATION PEEPHOLE}
{$OPTIMIZATION CSE}
{$OPTIMIZATION ASMCSE}

interface

@@ -26,17 +25,11 @@ implementation
{$IFDEF PROFILER_ENABLE}

uses
Windows, lineinfo{%H-}, Classes, fgl, unFastFileStream;
Windows, Classes, unFastFileStream;

type
TWriterThread = class(TThread)
private type
TCacheEntry = record
Name, Src: ShortString; Line: integer;
end;
TCacheList = specialize TFPGMap<PtrUInt, TCacheEntry>;
private
fAddressCache: TCacheList;
fPF: Int64;
procedure SaveCurrentWrite;
public
@@ -56,16 +49,18 @@ type
TProfileDataFile = class
public
constructor Create(const {%H-}aFileName: string);
procedure WriteEnter(Thread: TThreadID; When: Int64; Func, Src: String; Line: Integer); virtual; abstract;
procedure WriteEnter(Thread: TThreadID; When: Int64; Func: PtrUInt; Name: string); virtual; abstract;
procedure WriteLeave(Thread: TThreadID; When: Int64); virtual; abstract;
end;

{$DEFINE __HEAD}
//{$I uutlProfilerPlainText.inc}
{$I uutlProfilerPlainTextMMap.inc}
{$I uutlProfilerBinary.inc}
//{$I uutlProfilerPlainTextMMap.inc}
{$UnDef __HEAD}
//{$I uutlProfilerPlainText.inc}
{$I uutlProfilerPlainTextMMap.inc}
{$I uutlProfilerBinary.inc}
//{$I uutlProfilerPlainTextMMap.inc}


const
@@ -122,20 +117,6 @@ begin
inc(LineNumberComp);
end;

procedure TestDebugInfoPresent;
var
f,s: ShortString;
l: LongInt;
begin
f:= '';
s:= '';
l:= 0;
if not GetLineInfo({%H-}PtrUInt(@TestDebugInfoPresent),f,s,l) then begin
raise Exception.Create('Profiler is enabled, but no suitable debug info could be found.');
Halt();
end;
end;

procedure ProfilerEnterProc(const Addr: Pointer);
begin
ProfilerEnterProc(Addr, '');
@@ -206,14 +187,11 @@ end;
constructor TWriterThread.Create;
begin
inherited Create(false);
fAddressCache:= TCacheList.Create;
fAddressCache.Sorted:= true;
QueryPerformanceFrequency(fPF);
end;

destructor TWriterThread.Destroy;
begin
FreeAndNil(fAddressCache);
inherited Destroy;
end;

@@ -239,7 +217,6 @@ end;

procedure TWriterThread.SaveCurrentWrite;
var
ce: TCacheEntry;
i: integer;
begin
if Events[WritePtr].Func = 0 then
@@ -247,19 +224,7 @@ begin
if Events[WritePtr].Func = RETURN_FUNCTION then
ProfilerDataFile.WriteLeave(Events[WritePtr].Thread, (Events[WritePtr].When * 1000 * 1000) div fPF)
else begin
i:= fAddressCache.IndexOf(Events[WritePtr].Func);
if i < 0 then begin
ce.Line:= 0;
ce.Src:= '';
GetLineInfo(Events[WritePtr].Func,ce.Name,ce.Src,ce.Line);
if (ce.Name = '') then
ce.Name := Format('0x%.16x', [Events[WritePtr].Func]);
fAddressCache.Add(Events[WritePtr].Func, ce);
end else
ce:= fAddressCache.Data[i];
if (Events[WritePtr].Name <> '') then
ce.Name := '[' + Events[WritePtr].Name + '] ' + ce.Name;
ProfilerDataFile.WriteEnter(Events[WritePtr].Thread, (Events[WritePtr].When * 1000 * 1000) div fPF, ce.Name, ce.Src, ce.Line);
ProfilerDataFile.WriteEnter(Events[WritePtr].Thread, (Events[WritePtr].When * 1000 * 1000) div fPF, Events[WritePtr].Func, Events[WritePtr].Name);
end;
Events[WritePtr].Func:= 0;
end;
@@ -284,10 +249,9 @@ initialization
WritePtr:= 0;
WriterThread:= nil;
CalibrateLineNumberCompensation;
TestDebugInfoPresent;
//ProfilerDataFile:= TProfilePlainText.Create(ChangeFileExt(ParamStr(0), '.profraw'));
//ProfilerDataFile:= TProfileBinary.Create(ChangeFileExt(ParamStr(0), '.profbin'));
ProfilerDataFile:= TProfilePlainTextMMap.Create(ChangeFileExt(ParamStr(0), '.profraw'));
ProfilerDataFile:= TProfileBinary.Create(ChangeFileExt(ParamStr(0), '.profbin'));
//ProfilerDataFile:= TProfilePlainTextMMap.Create(ChangeFileExt(ParamStr(0), '.profraw'));
ProfilerEnabled:= true;
{$ENDIF}



+ 29
- 28
uutlProfilerBinary.inc View File

@@ -1,35 +1,31 @@
{$ERROR Do not use, untested/WIP/useless!}
{$ifdef __HEAD}
TProfileBinary = class(TProfileDataFile)
private type
TEnterRec = packed record
Thread: TThreadID;
When: Int64;
Line: Integer;
Func, Src: ShortString;
end;
TLeaveRec = packed record
Thread: TThreadID;
When: Int64;
end;
private
fDF: TMemoryStream;
fDF: TFastFileStream;
public
constructor Create(const aFileName: string);
destructor Destroy; override;
procedure WriteEnter(Thread: TThreadID; When: Int64; Func, Src: String; Line: Integer); override;
procedure WriteEnter(Thread: TThreadID; When: Int64; Func: PtrUInt; Name: string); override;
procedure WriteLeave(Thread: TThreadID; When: Int64); override;
end;

{$I uutlProfilerBinaryFmt.inc}


{$ELSE}

{ TProfileBinary }

constructor TProfileBinary.Create(const aFileName: string);
var
H: TPBHeader;
begin
inherited;
fDF:= TMemoryStream.Create;
fDF.SetSize(50000000);
fDF:= TFastFileStream.Create(aFileName, fmCreate);
H.VersionMagic:= NtoBE(HEADER_VER_MAGIC);
H.PtrSize:= Sizeof(PtrUInt);
H.ProgramName:= ExtractFileName(ParamStr(0));
fDF.Write(H, sizeof(H));
end;

destructor TProfileBinary.Destroy;
@@ -38,25 +34,30 @@ begin
inherited;
end;

procedure TProfileBinary.WriteEnter(Thread: TThreadID; When: Int64; Func, Src: String; Line: Integer);
procedure TProfileBinary.WriteEnter(Thread: TThreadID; When: Int64; Func: PtrUInt; Name: string);
var
t: TEnterRec;
H: TPBEventHeader;
R: TPBEventEnterProc;
begin
t.When:= When;
t.Thread:= Thread;
t.Func:= Func;
t.Src:= Src;
t.Line:= Line;
fDF.Write(t, sizeof(t));
H.ThreadID:= Thread;
H.Timestamp:= When;
H.Kind:= PB_KIND_ENTER;
fDF.Write(H, Sizeof(H));
R.Func:= Func;
R.NameLen:= Length(Name);
fDF.Write(R, Sizeof(R));
if R.NameLen > 0 then
fDF.Write(Name[1], R.NameLen);
end;

procedure TProfileBinary.WriteLeave(Thread: TThreadID; When: Int64);
var
t: TLeaveRec;
H: TPBEventHeader;
begin
t.When:= When;
t.Thread:= Thread;
fDF.Write(t, sizeof(t));
H.ThreadID:= Thread;
H.Timestamp:= When;
H.Kind:= PB_KIND_EXIT;
fDF.Write(H, Sizeof(H));
end;
{$ENDIF}



+ 28
- 0
uutlProfilerBinaryFmt.inc View File

@@ -0,0 +1,28 @@
type
TPBHeader = packed record
VersionMagic: UInt32;
PtrSize: byte;
ProgramName: ShortString;
end;

TPBEventHeader = packed record
ThreadID: UInt32;
Timestamp: UInt64;
Kind: byte;
end;

TPBEventEnterProc = packed record
// H: TPBEventHeader;
Func: PtrUInt;
NameLen: Byte;
end;

TPBEventExitProc = packed record
// H: TPBEventHeader;
end;

const
HEADER_VER_MAGIC = $b5bd0001;
PB_KIND_ENTER = $00;
PB_KIND_EXIT = $01;


Loading…
Cancel
Save