unit testrtc;

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes,
 _crw_alloc, _crw_rtc, _crw_fpu, _crw_ascio;

 {
 Тест проверяет модуль _rtc (часы реального времени).
 Test#1 - читает календарное время двумя путями - через msecnow и nativetimenow.
 Значения должны совпадать и соответствовать текущей дате.
 Test#2 - измерение времени вызова функций msecnow, nativetimenow, gettickcount, intmsecnow
 Test#3 - массированная проверка преобразования линейного временри в календарное и наоборот.
 }

procedure Test_Rtc;
//procedure Test_Ascio;

implementation

procedure readln;
begin
end;

 //
 // Check RDTSC instructions
 //
procedure TestRDTSC;
 procedure Nop; begin end;
var
 i,n:Integer;
 t1,t2:Double;
 c1,c2:Int64;
begin
 writeln(ReadTimeStampCounter);
 t1:=mksecnow;
 c1:=ReadTimeStampCounter;
 for i:=1 to 2 do Sleep(1000);
 c2:=ReadTimeStampCounter;
 t2:=mksecnow;
 writeln('CPU freq is: ',(c2-c1)/(t2-t1):1:0,' MHz');
 writeln('CPU freq is: ',EastimateCpuFrequencyMHz(1000),' MHz');
 {}
 n:=100000;
 c1:=ReadTimeStampCounter;
 for i:=1 to n do;
 c2:=ReadTimeStampCounter;
 writeln('FOR takes: ',(c2-c1)/n:1:0,' clocks');
 Sleep(1);
 {}
 n:=1000;
 c1:=ReadTimeStampCounter;
 for i:=1 to n do mksecnow;
 c2:=ReadTimeStampCounter;
 writeln('mksecnow takes: ',(c2-c1)/n:1:0,' clocks');
 Sleep(1);
 {}
 n:=1000;
 c1:=ReadTimeStampCounter;
 for i:=1 to n do msecnow;
 c2:=ReadTimeStampCounter;
 writeln('msecnow takes: ',(c2-c1)/n:1:0,' clocks');
 Sleep(1);
 {}
 n:=100000;
 c1:=ReadTimeStampCounter;
 for i:=1 to n do ReadTimeStampCounter;
 c2:=ReadTimeStampCounter;
 writeln('cpu_clock takes: ',(c2-c1)/n:1:0,' clocks');
 Sleep(1);
 {}
 c1:=ReadTimeStampCounter;
 c2:=ReadTimeStampCounter;
 writeln('cpu_clock takes: ',c2-c1,' clocks');
 Sleep(1);
 {}
 n:=10000;
 c1:=ReadTimeStampCounter;
 for i:=1 to n do ReadTimeStampCounter;
 c2:=ReadTimeStampCounter;
 writeln('cpu_clock takes: ',(c2-c1)/n:1:0,' clocks');
 Sleep(1);
 {}
 n:=1000000;
 c1:=ReadTimeStampCounter;
 for i:=1 to n do GetTickCount;
 c2:=ReadTimeStampCounter;
 writeln('TickCount takes: ',(c2-c1)/n:1:0,' clocks');
 Sleep(1);
 {}
 n:=1000000;
 c1:=ReadTimeStampCounter;
 for i:=1 to n do Nop;
 c2:=ReadTimeStampCounter;
 writeln('Call takes: ',(c2-c1)/n:1:0,' clocks');
 Sleep(1);
 {}
end;

procedure Test_Rtc;
const nmax = 10000;
var
 ms,t0,t,t1,dt:double; nt:TSystemTime;
 Year,Month,Day,Hour,Min,Sec,MSec:word; ErrCnt,mem:LongInt;
 n,it:Int64;
 wt,wt0,wt1:dword;
 p:TIntervalTimer;
 procedure TestDate(y,mn,d,h,m,s,ms:word);
 var Year,Month,Day,Hour,Min,Sec,MSec:word; p:boolean;
 begin
  p:=false;
  if GetTickCount-t0>1000 then begin
   t0:=GetTickCount;
   p:=true;
  end;
  T:=DateTimeToMSec(y,mn,d,h,m,s,ms);
  if p then write('Test ',GetDateStr(AssignNativeTime(y,mn,d,h,m,s,ms)),'-',
                  GetTimeStr(AssignNativeTime(y,mn,d,h,m,s,ms)),' = ',T:14:0,' ');
  MSecToDateTime(T,Year,Month,Day,Hour,Min,Sec,MSec);
  if p then write(Year:4,' ',Month:2,' ',Day:2,' ',Hour:2,' ',Min:2,' ',Sec:2,' ',MSec:3);
  if (y=Year) and (mn=Month) and (Day=d) and (h=Hour) and (m=Min) and (s=sec) and (ms=MSec)
  then begin
   if p then writeln(' OK!');
  end else begin
   if p then writeln(' ERROR!');
   inc(ErrCnt);
  end;
 end;

begin
 writeln;
 writeln('Real time clock tests ( _rtc unit ).');
 writeln;

 mem:=GetAllocMemSize;

 writeln(LocalMeanFileTimeBiasNow(FileTimeNow(rtc_GMT)));

 //
 writeln;
 writeln('Check RDTSC:');
 TestRDTSC;
 writeln;
 readln;
 //exit;

 //
 writeln;
 writeln('Origin clock:');
 writeln('StdClockResolution=',GetClockResolution(0)/10000:1:3,' ms');
 writeln('MinClockResolution=',GetClockResolution(1)/10000:1:3,' ms');
 writeln('MaxClockResolution=',GetClockResolution(2)/10000:1:3,' ms');
 writeln('ActClockResolution=',GetClockResolution(3)/10000:1:3,' ms');
 writeln;
 writeln('Now set new clock:');
 writeln('SetClockResolution=',SetClockResolution(+GetClockResolution(2))/10000:1:3);
 writeln('StdClockResolution=',GetClockResolution(0)/10000:1:3,' ms');
 writeln('MinClockResolution=',GetClockResolution(1)/10000:1:3,' ms');
 writeln('MaxClockResolution=',GetClockResolution(2)/10000:1:3,' ms');
 writeln('ActClockResolution=',GetClockResolution(3)/10000:1:3,' ms');
 writeln;
 writeln('Now reset old clock:');
 writeln('SetClockResolution=',SetClockResolution(-GetClockResolution(0))/10000:1:3);
 writeln('StdClockResolution=',GetClockResolution(0)/10000:1:3,' ms');
 writeln('MinClockResolution=',GetClockResolution(1)/10000:1:3,' ms');
 writeln('MaxClockResolution=',GetClockResolution(2)/10000:1:3,' ms');
 writeln('ActClockResolution=',GetClockResolution(3)/10000:1:3,' ms');
 writeln;
 //exit;

 //
 wt1:=rtc_GMT_DAQ;
 writeln('Test MSecNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  t:=msecnow(wt1);
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('MSecNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //
 writeln('Test IntMSecNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  intmsecnow(wt1);
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('IntMSecNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //exit;

 writeln('Test#0: Interval timer.');
 P:=NewIntervalTimer(tmCyclic,NewIntervalMs(300,1,
                              NewIntervalMs(3000,2,
                              NewIntervalMs(1000,3,
                              nil))));
 writeln('Intervals=',P.NumIntervals);
 P.Start;
 P.LocalTimeUnits:=1000;
 while P.LocalTime<20 do begin
  if P.Event then
  case P.What of
   1:writeln(1);
   2:writeln(2);
   3:writeln(3);
  end;
 end;
 writeln;
 writeln('Test IntervalTimer.Event, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  if p.Event then;
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('IntervalTimer.Event call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 writeln('Test IntervalTimer.LocalTime, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  t:=p.LocalTime;
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('IntervalTimer.LocalTime call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 P.Stop;
 Kill(P);
 mem:=GetAllocMemSize-mem;
 if mem<>0
 then writeln('Memory leak ',mem)
 else writeln('No memory leak found.');
 writeln;
 writeln;

 writeln('Test#1: msecnow & current time.');
 if msecnow<>intmsecnow then writeln('msecnow<>intmsecnow!!!');
 ms:=MSecNow;
 nt:=NativeTimeNow(rtc_LMT);
 writeln('MSecNow    = ',ms:14:0);
 writeln('DateTime   = ',GetDateStr(ms),'-',GetTimeStr(ms));
 writeln('NativeTime = ',GetDateStr(nt),'-',GetTimeStr(nt));
 writeln;
 writeln('Another date/time formatting:');
 writeln('DateTime   = ',GetDateStr(ms,#0,true),'\',GetTimeStr(ms,#0));
 writeln('DateTime   = ',GetDateStr(ms,'\',false,true),'-',GetTimeStr(ms,'\',true));
 writeln;
 writeln('Press Enter, please...');
 writeln;
 readln;

 writeln('Test#2: GetTickCount, MSecNow & NativeTimeNow speed test.');
 writeln;
 //
 writeln('Test GetTickCount, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('GetTickCount call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //
 writeln('Test SystemTimeNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  nt:=NativeTimeNow(rtc_GMT);
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('SystemTimeNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //
 writeln('Test LocalTimeNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  nt:=NativeTimeNow(rtc_LMT);
  wt:=GetTickCount;
  inc(n);
 until(wt-wt0>10000);
 writeln('LocalTimeNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //
 writeln('Test SystemFileTimeNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  FileTimeNow(rtc_GMT);
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('SystemFileTimeNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //
 writeln('Test LocalFileTimeNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  FileTimeNow(rtc_LMT);
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('LocalFileTimeNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //
 writeln('Test MkSecNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  t:=mksecnow;
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('MkSecNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //
 writeln('Test MSecNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  t:=msecnow;
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('MSecNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln;
 //
 writeln('Test IntMSecNow, wait...');
 n:=0;
 wt0:=GetTickCount;
 repeat
  it:=intmsecnow;
  wt:=GetTickCount;
  inc(n);
 until (wt-wt0>nmax);
 writeln('IntMSecNow call takes about ',nmax*1000/n:7:3,' mks');
 writeln('IntMSecNow=',it);
 writeln('Test dead time, wait...');
 dt:=0;
 wt0:=gettickcount;
 wt1:=wt0;
 repeat
  wt:=gettickcount;
  if abs(wt1-wt)>dt then begin
   dt:=abs(wt1-wt);
  end;
  wt1:=wt;
 until(wt-wt0>nmax);
 writeln('Dead time takes about ',dt:7:3,' ms');
 writeln;
 writeln('Test dead time2, wait...');
 dt:=0;
 t0:=mksecnow;
 t1:=t0;
 repeat
  t:=mksecnow;
  if abs(t1-t)>dt then begin
   dt:=abs(t1-t);
  end;
  t1:=t;
 until(t-t0>nmax*1000);
 writeln('Dead time takes about ',dt:7:3,' mks');
 writeln;
 writeln('Test switch time, wait...');
 dt:=10000;
 wt0:=gettickcount;
 wt1:=wt0;
 repeat
  wt:=gettickcount;
  if wt1<>wt then begin
   if dt>wt-wt1 then dt:=wt-wt1;
  end;
  wt1:=wt;
 until(wt-wt0>nmax);
 writeln('Swith time takes about ',dt:7:3,' ms');
 writeln;
 writeln('Press Enter, please...');
 writeln;
 readln;

 writeln;
 t0:=mksecnow;
 wt0:=gettickcount;
 wt1:=wt0;
 repeat
  t:=mksecnow;
  wt:=gettickcount;
  if abs(wt1-wt)>100 then begin
   writeln('ms=',wt-wt0:14,' mks=',t-t0:14:3,' dt=',(wt-wt0)-(t-t0)*1e-3:7:3);
   wt1:=wt;
  end;
 until(wt-wt0>10000);
 writeln;
 writeln('Press Enter, please...');
 writeln;
 readln;

 writeln('Test#3: time conversions.');
 writeln;
 t0:=63129943111030.0;
 t1:=DateTimeToMSec(2001,07,05,15,18,31,030);
 if t0=t1
 then writeln('DateTimeToMSec(2001,07,05,15,18,31,030)=',t1:14:0,' (OK!)')
 else writeln('DateTimeToMSec(2001,07,05,15,18,31,030)=',t1:14:0,' (ERROR!)');

 writeln;
 t0:=63129943111030.0;
 MSecToDateTime(t0,Year,Month,Day,Hour,Min,Sec,MSec);
 if (Year=2001) and (Month=07) and (Day=05) and(Hour=15) and (Min=18) and (Sec=31) and (MSec=030)
 then writeln('MSecToDateTime conversion OK!')
 else writeln('MSecToDateTime conversion ERROR!');

 writeln;
 t0:=63129943111030.0;
 write('GetDateStr,GetTimeStr test ');
 write(GetDateStr(t0,'.',false,false),'-',GetTimeStr(t0,':',true));
 if GetDateStr(t0,'.',false,false)+'-'+GetTimeStr(t0,':',true)='05.07.2001-15:18:31:030'
 then writeln(' OK!')
 else writeln(' ERROR!');
 writeln;
 writeln('Press Enter, please...');
 writeln;
 readln;

 ErrCnt:=0;
 writeln;
 writeln(DateTimeToMSec(1899,12,31,00,00,00,000)/MSecsPerday:14:3);
 writeln(DateTimeToMSec(0001,01,01,00,00,00,000)/MSecsPerday:14:3);
 TestDate(1899,12,31,00,00,00,000);
 TestDate(1899,12,31,03,00,00,000);
 TestDate(0001,01,01,00,00,00,000);
 TestDate(1899,12,30,00,00,00,000);
 TestDate(1900,01,01,18,00,00,000);
 TestDate(1899,12,29,06,00,00,000);
 TestDate(1996,01,01,00,00,00,000);
 T:=(0+DateDelta)*(MSecsPerDay*1.0);
 MSecToDateTime(T,Year,Month,Day,Hour,Min,Sec,MSec);
 writeln(Year:4,' ',Month:2,' ',Day:2,' ',Hour:2,' ',Min:2,' ',Sec:2,' ',MSec:3);
 T:=(2.75+DateDelta)*(MSecsPerDay*1.0);
 MSecToDateTime(T,Year,Month,Day,Hour,Min,Sec,MSec);
 writeln(Year:4,' ',Month:2,' ',Day:2,' ',Hour:2,' ',Min:2,' ',Sec:2,' ',MSec:3);
 T:=(-1.25+DateDelta)*(MSecsPerDay*1.0);
 MSecToDateTime(T,Year,Month,Day,Hour,Min,Sec,MSec);
 writeln(Year:4,' ',Month:2,' ',Day:2,' ',Hour:2,' ',Min:2,' ',Sec:2,' ',MSec:3);
 T:=(35065+DateDelta)*(MSecsPerDay*1.0);
 MSecToDateTime(T,Year,Month,Day,Hour,Min,Sec,MSec);
 writeln(Year:4,' ',Month:2,' ',Day:2,' ',Hour:2,' ',Min:2,' ',Sec:2,' ',MSec:3);
 writeln;
 writeln('Press Enter, please...');
 writeln;
 Readln;
 writeln('Large test of MSecNowToNativeTime/NativeTimeToMSecNow conversion.');
 t0:=gettickcount;
 for Year:=1 to 9999 do
 for Month:=1 to 12 do
 for Day:=1 to MonthDays[isLeapYear(Year)][Month] do
 for Hour:=0 to 23 do
 TestDate(Year,Month,Day,Hour,random(60),random(60),random(1000));
 writeln('Found Errors:',ErrCnt);
 writeln;
 writeln('Press Enter, please...');
 writeln;
 Readln;
end;

const
 Terminated : Boolean = false;

procedure DoExit(const cmnd, args:LongString);
begin
 Terminated:=true;
 StdOut.Put:='Press Enter to continue...';
end;

procedure DoSpecial(const args:LongString);
begin
 StdOut.Put:=Format('Could not recognize "%s"',[args]);
end;

procedure Test_Ascio;
var t1,t2,t3,t4:Double;  s:LongString;
begin
 StdOut.Put:='';
 StdOut.Put:='Time sync tests ( _rtc unit ).';
 StdOut.Put:='';
 Terminated:=false;
 //StdIoThreadTimeOut:=1000; 
 StdIn.SpecHandler:=DoSpecial;
 StdIn.AddCommand('@exit',DoExit);
 while not Terminated do begin
  t1:=msecnow(rtc_LMT_DAQ);
  t2:=msecnow(rtc_LMT_SYS);
  t3:=NativeTimeToMSec(NativeTimeNow(rtc_LMT));
  t4:=FileTimeToMsec(FileTimeNow(rtc_GMT));
  StdOut.Put:=Format('%14.0f %14.0f %14.0f %14.0f ms',[t1,t2-t1,t3-t1,t4-t1]);
  //
  if StdIn.Count>0 then
  while StdIn.TryGet(s) do begin
   StdOut.Put:='< '+s;
   StdIn.Process(s);
  end;
  //
  Sleep(500);
 end;
 StdOut.Free;
 StdIn.Free;
end;

end.
