Results 1 to 3 of 3

Thread: The script profiler [Lape]

  1. #1
    Join Date
    May 2012
    Location
    Moscow, Russia
    Posts
    661
    Mentioned
    35 Post(s)
    Quoted
    102 Post(s)

    Default The script profiler [Lape]

    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:
    Simba 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:
    Simba Code:
    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:
    Simba Code:
    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.
    Last edited by CynicRus; 04-16-2015 at 07:44 AM.
    Per aspera ad Astra!
    ----------------------------------------
    Slow and steady wins the race.

  2. #2
    Join Date
    Feb 2006
    Location
    Helsinki, Finland
    Posts
    1,395
    Mentioned
    30 Post(s)
    Quoted
    107 Post(s)

    Default

    Quote Originally Posted by CynicRus View Post
    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:
    Simba 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:
    Simba Code:
    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:
    Simba Code:
    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.

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



    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!

  3. #3
    Join Date
    May 2012
    Location
    Moscow, Russia
    Posts
    661
    Mentioned
    35 Post(s)
    Quoted
    102 Post(s)

    Default

    Thank you, Jani
    Per aspera ad Astra!
    ----------------------------------------
    Slow and steady wins the race.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •