unit uRDTSC;

//使用目的
// ・この関数は全体の何割を消費してるか知りたい
// ・この処理は現在何クロックを消費してるか知りたい
// という趣味の領域が目的です
//
//使用方法
//  測定したい処理全体の先頭で startRDTSC;
//  測定したいユニットの先頭で RDTSCst(dtTSC[n]);
//  測定したいユニットの終了で RDTSCed(dtTSC[n]);
//    ....
// 測定したい処理全体の終了 endRDTSC;
// 　この時点で結果はクリップボードに出力されます
// 　ユニットには名前を付けておけます  dtTSC[n].name='func1'; なくても問題ない
// nは0～9の数字でユニットを識別
//  つまり最大10個のユニットを識別出来ます(増やすならTSCtimerSizeを修正)

// パフォーマンスチェックの都度、入れたり外したりが面倒なら
// 関数の先頭で
//   { $IFDEF enTSC}RDTSCst(dtTSC[0]);{$ENDIF}
// のように入れて 終了で
//   { $IFDEF enTSC}RDTSCed(dtTSC[0]);{$ENDIF}
// と入れます。enTSC をコンパイル時に入れなければこれらは外れます

// 関数の先頭は常に同じ場所を通りますが、exitやraiseがあると入れ忘れる場合もあるでしょう
// その場合は処理時間が少な目に出るので stcntとedcntのカウント値で確認出来ます
// また意図的に途中終了の比率を確認する事にも使えるでしょう

// 結果を自分で表示処理したい場合は
// endRDTSC;をendRDTSC(false);として、その後でdtTSC配列を確認して下さい

// 作者：裏目小僧
// 利用はご自由に。
// Lazarus2.2.4 32bit/64bit Delphi5である程度動作する事を確認しています
// Delphiで利用するにはUTF8からの文字コード変換が必要です
{$IFDEF FPC} {$mode Delphi}{$H+}   {$ENDif}

interface

uses
  Classes, SysUtils, Windows;

//RDTSC命令を利用して64bitのカウンタを読み出します
function RDTSC: int64;


type TrdTSCdt = record
    TSC, sum: int64;
    stcnt, edcnt: DWORD;
    Name: string;
  end;
const TSCtimerSize = 10;
var  dtTSC: array [0..TSCtimerSize] of TrdTSCdt;//最後は startRDTSC/endRDTSCの為に

procedure RDTSCst(var dt: TrdTSCdt); register;//dt.TSC:=RDTSC
procedure RDTSCed(var dt: TrdTSCdt); register;//dt.sum+=RDTSC-TSC
procedure startRDTSC();
procedure endRDTSC(clpBd: boolean = True); //clpBd=trueならクリップボードに結果を出力
var startRDTSCcnt, endRDTSCcnt: int64;
var startRDTSCtime, endRDTSCtime: TDateTime;
implementation
uses
  Clipbrd;
procedure startRDTSC();
var i: integer;
begin
  for i := 0 to High(dtTSC) do with  dtTSC[i] do
    begin
      TSC := 0;    // 0.. 7   //最後に RDTSCstが呼ばれた時のTSC
      sum := 0;    // 8..15   //RDTSCst～RDTSCed間の累計値
      stcnt := 0;  //16..19   //RDTSCstが呼ばれた回数
      edcnt := 0;  //20..23   //RDTSCedが呼ばれた回数
    end;
  startRDTSCtime := now;
  startRDTSCcnt := 0;
  endRDTSCcnt := 0;
  QueryPerformanceCounter(startRDTSCcnt);
  RDTSCst(dtTSC[High(dtTSC)]);
end;
function dtTSCprt1(n: integer): string;
var ms: double;
  timdiv: int64;
begin
  ms := (endRDTSCtime - startRDTSCtime) * 24 * 60 * 60 * 1000;
  if QueryPerformanceFrequency(timdiv) then
  begin //QueryPerformanceCounterが有効なら
    //現在のWin64だとNowでも時間分解能は十分なようだが
    ms := 1000.0 * (endRDTSCcnt - startRDTSCcnt) / timdiv;
  end;
  if n = -1 then
  begin
    //nn,1234567890, 99.99,123456,123456, 99.99,"name"
    Result := 'no,       cyc,全体の,st回数,ed回数,ed/st ,"name"';
    exit;
  end;
  if n = High(dtTSC) then
  begin
    with dtTSC[n] do
      Result := Format('  ,%10dcyc=%4.2fms このCPUは1msで%6.1fcyc実行', [sum, ms, sum / ms]);
    exit;
  end;

  with dtTSC[n] do                                   //d 10d  ,%6.2f                        ,%6d  ,%6d  ,%6.2f,"%s"
    Result := Format('%2d,%10d,%6.2f,%6d,%6d,%6.2f,"%s"', [n, sum, 100.0 * sum / dtTSC[High(dtTSC)].sum, stcnt, edcnt, 100.0 * edcnt / stcnt, Name]);

end;
function addS(s: array of ansistring): ansistring; //文字連結
var
  len, i, n: integer;
begin
  len := 0;
  for i := 0 to High(s) do len := len + length(s[i]);
  Setlength(Result, len);
  n := 1;
  for i := 0 to High(s) do
  begin
    move(s[i][1], Result[n], length(s[i]));
    Inc(n, length(s[i]));
  end;
end;
procedure endRDTSC(clpBd: boolean);
var s: string;
var i: integer;
begin
  RDTSCed(dtTSC[High(dtTSC)]);
  QueryPerformanceCounter(endRDTSCcnt);
  endRDTSCtime := Now;
  if not clpBD then exit;

  s := dtTSCprt1(-1);
  for i := 0 to High(dtTSC) do
    if dtTSC[i].TSC <> 0 then
      s := addS([s, #13#10, dtTSCprt1(i)]);
  Clipboard.AsText := s;
end;
//以下アセンブラ内で RDTSCをDB 0Fh, 031Hと記載してるのはDelphi5でRDTSCを使う為です
{$IFDEF FPC}{$ASMMODE intel}    {$ENDif}
{$IFDEF WIN64}
function RDTSC:Int64;{$IFDEF FPC} assembler;{$ENDif}
asm
// DB 048H   64bit版も結果は同じのようだ
DB 0Fh, 031H//  RDTSC //EDX:EAX
 SHL RDX,32
// MOV RAX,EAX   //RAX上位32bitは既に0になってる
 OR  RAX,RDX
end;

procedure RDTSCst(var dt:TrdTSCdt );register; {$IFDEF FPC} assembler;{$ENDif} //dt.TSC:=RDTSCl
asm    //        RCX=@dt
DB 0Fh, 031H//  RDTSC //EDX:EAX
 mov   DWORD ptr  [RCX],EAX;
 mov   DWORD ptr  [RCX+4],EDX;
 inc   DWORD ptr [RCX+16];
end;
procedure RDTSCed(var dt:TrdTSCdt ); register;{$IFDEF FPC} assembler;{$ENDif}//dt.sum+=RDTSCl-TSC
asm    //        RCX=@dt
DB 0Fh, 031H//  RDTSC //EDX:EAX  RAXの上位は0になるようだ
 SHL RDX,32
 OR  RAX,RDX
 sub RAX,[RCX];
 add [RCX+8],RAX
 inc  DWORD ptr [RCX+20];
end;
{$ELSE}//Win32 todo　以下はまだデバッグしていない
function RDTSC: int64;{$IFDEF FPC} assembler;{$ENDif}
asm
         DB      0Fh, 031H//    RDTSC //EDX:EAX
end;

procedure RDTSCst(var dt: TrdTSCdt); {$IFDEF FPC} assembler;{$ENDif} //dt.TSC:=RDTSCl
asm        //    EAX=@dt
         MOV     ECX,EAX
         DB      0Fh, 031H//         RDTSC //EDX:EAX
         MOV     [ECX  ],EAX;
         MOV     [ECX+4],EDX;
         INC     DWORD ptr   [ECX+16];
end;
procedure RDTSCed(var dt: TrdTSCdt); register;{$IFDEF FPC} assembler;{$ENDif}//dt.sum+=RDTSCl-TSC
asm       //     EAX=@dt
         MOV     ECX,EAX
         DB      0Fh, 031H//        RDTSC //EDX:EAX  RAXの上位は0になるようだ
         SUB     EAX,[ECX]
         SUB     EDX,[ECX+4]
         ADD     [ECX+ 8],EAX;
         ADC     [ECX+12],EDX;
         INC     DWORD ptr    [ECX+20];
end;
{$ENDif}
end.