PDA

View Full Version : The script profiler [Lape]


CynicRus
04-15-2015, 07:35 PM
Hey guys. Today I had a little time, and I write this script. Its purpose - the code profiling. It really helps in the development of algorithms. This tool allows you to find a code requires optimization.

Requrements:
- Lape

Code:
type
TCallInfo = record
Tag: string;
WholeTime: Int64;
StartTime: Int64;
ProcOrder: boolean;
HitCount: UInt64;
end;
TCallInfoArray = array of TCallInfo;
TCallInfoList = record
FList: TCallInfoArray;
end;
TScriptProfiler = record
FInfo: TCallInfoList;
end;

procedure TCallInfoList.Init;
begin
SetLEngth(FList, 0);
end;

procedure TCallInfoList.Destroy;
begin
SetLEngth(FList, 0);
end;

function TCallInfoList.GetCount: integer;
begin
result := Length(Flist);
end;

function TCallInfoList.GetItem(Index: Integer): TCallInfo;
begin
if (Index >= 0) and (Index < GetCount()) then
Result := FList[Index];
end;

procedure TCallInfoList.SetItem(Index: integer; aItem: TCallInfo);
begin
if Index <=GetCount() then
FList[Index] := aItem;
end;

procedure TCallInfoList.Add(aItem: TCallInfo);
var
len: integer;
begin
len := Length(FList);
SetLength(FList, len + 1);
FList[len] := aItem;
end;

function TCallInfoList.Remove(const Idx: Integer; const Count: Integer): Integer;
var
I, J, L, M, F: Integer;
begin
L := Length(Flist);
if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
begin
Result := 0;
exit;
end;
I := Max(Idx, 0);
J := Min(Count, L - I);
M := L - J - I;
for F := 0 to M - 1 do
FList[I + F] := FList[I + J + F];
SetLength(FList, L - J);
Result := J;
end;

function TCallInfoList.IndexOf(aTag: string): Integer;
var
I, len: Integer;
begin
len := GetCount();
for I := 0 to len - 1 do
if FList[i].Tag = aTag then
begin
Result := I;
Exit;
end;
Result := - 1;
end;

procedure TCallInfo.Init(aTag: string; aStartTime: Int64);
begin
Tag := aTag;
WholeTime := 0;
Hitcount := 0;
StartTime := aStartTime;
ProcOrder := false;
end;

procedure TCallInfo.Start(aStartTime: Int64);
begin
if ProcOrder then
begin
WriteLn(Format('Before the recall procedure Start, you must first call the procedure Stop for tag = %s', [tag]));
TerminateScript;
end;
StartTime := aStartTime;
ProcOrder := true;
Inc(HitCount);
end;

procedure TCallInfo.Stop(StopTime: Int64);
begin
WholeTime := WholeTime - StartTime + stopTime;
ProcOrder := false;
end;

procedure TScriptProfiler.Init;
begin
FInfo.Init;
end;

procedure TScriptProfiler.Destroy;
begin
FInfo.Destroy;
end;

procedure TScriptProfiler.Start(Tag: string);
var
CallInfo: TCallInfo;
ElemIndex: integer;
t: UInt64;
begin
ElemIndex := FInfo.IndexOf(Tag);
t := getTickCount64();
if (ElemIndex > - 1) then
begin
CallInfo := FInfo.GetItem(ElemIndex);
if CallInfo.ProcOrder then
begin
WriteLn(Format('You must first call the procedure Stop for tag = %s', [tag]));
TerminateScript;
end;
CallInfo.Start(t);
//FInfo.Remove(ElemIndex, 1);
FInfo.SetItem(ElemIndex,CallInfo);
end
else
begin
CallInfo.Init(Tag, t);
CallInfo.Start(t);
FInfo.Add(CallInfo);
end;
end;

procedure TScriptProfiler.Stop(Tag: string);
var
CallInfo: TCallInfo;
ElemIndex: integer;
t: UInt64;
begin
t := getTickCount64();
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex = - 1) then
begin
WriteLn(Format('You must first call the procedure Start for tag = %s', [tag]));
TerminateScript;
end;
CallInfo := FInfo.GetItem(ElemIndex);
CallInfo.Stop(t);
FInfo.SetItem(ElemIndex,CallInfo);
end;

procedure TScriptProfiler.Show(Tag: string);
var
ElemIndex: integer;
CallInfo: TCallInfo;
t: UInt64
begin
t := getTickCount64();
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex = - 1) then
begin
WriteLn(Format('Item with tag = %s not found!', [tag]));
TerminateScript;
end;
CallInfo := FInfo.GetITem(ElemIndex);
if not CallInfo.ProcOrder then
WriteLn(tag + ': ' + FormatFloat('0.0000', CallInfo.wholeTime / 1000) + ' s., calls: ' + IntToStr(CallInfo.hitcount))
else
WriteLn(Format('You must first call the procedure Stop for tag = %s', [CallInfo.tag]));
end;

procedure TScriptProfiler.ShowAll;
var
i, len: integer;
begin
len := FInfo.GetCount;
for i := 0 to len - 1 do
Show(FInfo.GetItem(I).Tag);
end;

How to use:

var
list: TCallInfoList;
test1, test2, test3: TCallInfo;
i, j: integer;
Profiler: TScriptProfiler;
begin
PRofiler.Init;
Profiler.Start('test1');
//testing of cusom list
List.Init;
test1.tag := 'test1';
test2.tag := 'test2';
test3.tag := 'test3';
List.Add(test1);
List.Add(test2);
List.Add(test3);
WriteLn(ToStr(List.IndexOf('test3')));
for i := 0 to List.GetCount - 1 do
writeln(list.getitem(i).tag);
List.Destroy;
//end of custom list testing
profiler.Stop('test1');
profiler.Start('test2');
for i := 0 to 100000 do
begin
profiler.Start('test3');
j := random(20000);
profiler.Stop('test3');
end;
profiler.Stop('test2');
profiler.ShowAll;
profiler.Destroy;
end.


Testing output:

Compiled successfully in 265 ms.
2
test1
test2
test3
test1: 0.0160 s., calls: 1
test2: 0.9200 s., calls: 1
test3: 0.4510 s., calls: 100001
Successfully executed.


I've optimized the profiler code today:P

Thanks for you attention,
Cheers, Cynic.
Janilabo
04-15-2015, 08:05 PM
Hey guys. Today I had a little time, and I write this script. Its purpose - the code profiling. It really helps in the development of algorithms. This tool allows you to find a code requires optimization.

Requrements:
- Lape

Code:
type
TCallInfo = record
Tag: string;
WholeTime: Int64;
StartTime: Int64;
ProcOrder: boolean;
HitCount: UInt64;
end;
TCallInfoArray = array of TCallInfo;
TCallInfoList = record
FList: TCallInfoArray;
end;
TScriptProfiler = record
FInfo: TCallInfoList;
end;

procedure TCallInfoList.Init;
begin
SetLEngth(FList, 0);
end;

procedure TCallInfoList.Destroy;
begin
SetLEngth(FList, 0);
end;

function TCallInfoList.GetCount: integer;
begin
result := Length(Flist);
end;

function TCallInfoList.GetItem(Index: Integer): TCallInfo;
begin
if (Index >= 0) and (Index < GetCount()) then
Result := FList[Index];
end;

procedure TCallInfoList.Add(aItem: TCallInfo);
var
len: integer;
begin
len := Length(FList);
SetLength(FList, len + 1);
FList[len] := aItem;
end;

function TCallInfoList.Remove(const Idx: Integer; const Count: Integer): Integer;
var
I, J, L, M, F: Integer;
begin
L := Length(Flist);
if (Idx >= L) or (Idx + Count <= 0) or (L = 0) or (Count = 0) then
begin
Result := 0;
exit;
end;
I := Max(Idx, 0);
J := Min(Count, L - I);
M := L - J - I;
for F := 0 to M - 1 do
FList[I + F] := FList[I + J + F];
SetLength(FList, L - J);
Result := J;
end;

function TCallInfoList.IndexOf(aTag: string): Integer;
var
I, len: Integer;
begin
len := GetCount();
for I := 0 to len - 1 do
if FList[i].Tag = aTag then
begin
Result := I;
Exit;
end;
Result := - 1;
end;

procedure TCallInfo.Init(aTag: string; aStartTime: Int64);
begin
Tag := aTag;
WholeTime := 0;
Hitcount := 0;
StartTime := aStartTime;
ProcOrder := false;
end;

procedure TCallInfo.Start(aStartTime: Int64);
begin
if ProcOrder then
begin
WriteLn(Format('Before the recall procedure Start, you must first call the procedure Stop for tag = %s', [tag]));
TerminateScript;
end;
StartTime := aStartTime;
ProcOrder := true;
Inc(HitCount);
end;

procedure TCallInfo.Stop(StopTime: Int64);
begin
WholeTime := WholeTime - StartTime + stopTime;
ProcOrder := false;
end;

procedure TScriptProfiler.Init;
begin
FInfo.Init;
end;

procedure TScriptProfiler.Destroy;
begin
FInfo.Destroy;
end;

procedure TScriptProfiler.Start(Tag: string);
var
CallInfo: TCallInfo;
ElemIndex: integer;
t: UInt64;
begin
ElemIndex := FInfo.IndexOf(Tag);
t := getTickCount64();
if (ElemIndex > - 1) then
begin
CallInfo := FInfo.GetItem(ElemIndex);
if CallInfo.ProcOrder then
begin
WriteLn(Format('You must first call the procedure Stop for tag = %s', [tag]));
TerminateScript;
end;
CallInfo.Start(t);
FInfo.Remove(ElemIndex, 1);
FInfo.Add(CallInfo);
end
else
begin
CallInfo.Init(Tag, t);
CallInfo.Start(t);
FInfo.Add(CallInfo);
end;
end;

procedure TScriptProfiler.Stop(Tag: string);
var
CallInfo: TCallInfo;
ElemIndex: integer;
t: UInt64;
begin
t := getTickCount64();
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex = - 1) then
begin
WriteLn(Format('You must first call the procedure Start for tag = %s', [tag]));
TerminateScript;
end;
CallInfo := FInfo.GetItem(ElemIndex);
CallInfo.Stop(t);
FInfo.Remove(ElemIndex, 1);
FInfo.Add(CallInfo);
end;

procedure TScriptProfiler.Show(Tag: string);
var
ElemIndex: integer;
CallInfo: TCallInfo;
t: UInt64
begin
t := getTickCount64();
ElemIndex := FInfo.IndexOf(Tag);
if (ElemIndex = - 1) then
begin
WriteLn(Format('Item with tag = %s not found!', [tag]));
TerminateScript;
end;
CallInfo := FInfo.GetITem(ElemIndex);
if not CallInfo.ProcOrder then
WriteLn(tag + ': ' + FormatFloat('0.0000', CallInfo.wholeTime / 1000) + ' s., calls: ' + IntToStr(CallInfo.hitcount))
else
WriteLn(Format('You must first call the procedure Stop for tag = %s', [CallInfo.tag]));
end;

procedure TScriptProfiler.ShowAll;
var
i, len: integer;
begin
len := FInfo.GetCount;
for i := 0 to len - 1 do
Show(FInfo.GetItem(I).Tag);
end;

How to use:

var
list: TCallInfoList;
test1, test2, test3: TCallInfo;
i, j: integer;
Profiler: TScriptProfiler;
begin
PRofiler.Init;
Profiler.Start('test1');
//testing of cusom list
List.Init;
test1.tag := 'test1';
test2.tag := 'test2';
test3.tag := 'test3';
List.Add(test1);
List.Add(test2);
List.Add(test3);
WriteLn(ToStr(List.IndexOf('test3')));
for i := 0 to List.GetCount - 1 do
writeln(list.getitem(i).tag);
List.Destroy;
//end of custom list testing
profiler.Stop('test1');
profiler.Start('test2');
for i := 0 to 100000 do
begin
profiler.Start('test3');
j := random(20000);
profiler.Stop('test3');
end;
profiler.Stop('test2');
profiler.ShowAll;
profiler.Destroy;
end.


Testing output:

Compiled successfully in 343 ms.
2
test1
test2
test3
test1: 0.0160 s., calls: 1
test3: 0.9200 s., calls: 100001
test2: 2.1680 s., calls: 1
Successfully executed.


The code is written in haste, and may require optimization.

Thanks for you attention,
Cheers, Cynic.Well well, you sure got my attention mate. :p

Very happy to see you actively contributing snippets here - me liek!
Hoooowever, I am sorry CynicRus, but...

http://i.imgur.com/b4HU4fy.png

It is impossible for me to hit you with some highly deserved reputation++ at the moment. I will definitely do it in the future.

Cheers and thanks for sharing man, much appreciated!
CynicRus
04-15-2015, 08:07 PM
Thank you, Jani:)