PageRenderTime 55ms CodeModel.GetById 15ms RepoModel.GetById 1ms app.codeStats 0ms

/3rdparty/epiktimer/epiktimer.pas

http://github.com/graemeg/fptest
Pascal | 816 lines | 468 code | 109 blank | 239 comment | 11 complexity | eb2f4b7eb476d20cf9afd6021b78d080 MD5 | raw file
  1. unit EpikTimer;
  2. { Name: EpikTimer
  3. Description: Precision timer/stopwatch component for Lazarus/FPC
  4. Author: Tom Lisjac <netdxr@gmail.com>
  5. Started on: June 24, 2003
  6. Features:
  7. Dual selectable timebases: Default:System (uSec timeofday or "now" in Win32)
  8. Optional: Pentium Time Stamp Counter.
  9. Default timebase should work on most Unix systems of any architecture.
  10. Timebase correlation locks time stamp counter accuracy to system clock.
  11. Timers can be started, stopped, paused and resumed.
  12. Unlimited number of timers can be implemented with one component.
  13. Low resources required: 25 bytes per timer; No CPU overhead.
  14. Internal call overhead compensation.
  15. System sleep function
  16. Designed to support multiple operating systems and Architectures
  17. Designed to support other hardware tick sources
  18. Credits: Thanks to Martin Waldenburg for a lot of great ideas for using
  19. the Pentium's RDTSC instruction in wmFastTime and QwmFastTime.
  20. }
  21. { Copyright (C) 2003-2014 by Tom Lisjac <netdxr@gmail.com>,
  22. Felipe Monteiro de Carvalho and Marcel Minderhoud
  23. This library is licensed on the same Modified LGPL as Free Pascal RTL and LCL are
  24. Please contact the author if you'd like to use this component but the Modified LGPL
  25. doesn't work with your project licensing.
  26. This program is distributed in the hope that it will be useful, but WITHOUT
  27. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  28. FITNESS FOR A PARTICULAR PURPOSE.
  29. Contributor(s):
  30. * Felipe Monteiro de Carvalho (felipemonteiro.carvalho@gmail.com)
  31. * Marcel Minderhoud
  32. * Graeme Geldenhuys <graemeg@gmail.com>
  33. }
  34. {
  35. Known Issues
  36. - If system doesn't have microsecond system clock resolution, the component
  37. falls back to a single gated measurement of the hardware tick frequency via
  38. nanosleep. This usually results in poor absolute accuracy due large amounts
  39. of jitter in nanosleep... but for typical short term measurements, this
  40. shouldn't be a problem.
  41. }
  42. {$IFDEF FPC}
  43. {$MODE DELPHI}{$H+}
  44. {$ENDIF}
  45. {$IFNDEF FPC}
  46. {$DEFINE Windows}
  47. {$ENDIF}
  48. {$IFDEF Win32}
  49. {$DEFINE Windows}
  50. {$ENDIF}
  51. interface
  52. uses
  53. {$IFDEF Windows}
  54. Windows, MMSystem,
  55. {$ELSE}
  56. unix, unixutil, baseunix,
  57. {$IFDEF LINUX}
  58. Linux, // for clock_gettime() access
  59. {$ENDIF}
  60. {$IFDEF FreeBSD}
  61. FreeBSD, // for clock_gettime() access
  62. {$ENDIF}
  63. {$ENDIF}
  64. Classes, SysUtils, dateutils;
  65. Const
  66. DefaultSystemTicksPerSecond = 1000000; //Divisor for microsecond resolution
  67. { HW Tick frequency falls back to gated measurement if the initial system
  68. clock measurement is outside this range plus or minus.}
  69. SystemTicksNormalRangeLimit = 100000;
  70. type
  71. TickType = Int64; // Global declaration for all tick processing routines
  72. FormatPrecision = 1..12; // Number of decimal places in elapsed text format
  73. // Component powers up in System mode to provide some cross-platform safety.
  74. TickSources = (SystemTimebase, HardwareTimebase); // add others if desired
  75. (* * * * * * * * * * * Timebase declarations * * * * * * * * * * *)
  76. { There are two timebases currently implemented in this component but others
  77. can be added by declaring them as "TickSources", adding a TimebaseData
  78. variable to the Private area of TEpikTimer and providing a "Ticks" routine
  79. that returns the current counter value.
  80. Timebases are "calibrated" during initialization by taking samples of the
  81. execution times of the SystemSleep and Ticks functions measured with in the
  82. tick period of the selected timebase. At runtime, these values are retrieved
  83. and used to remove the call overhead to the best degree possible.
  84. System latency is always present and contributes "jitter" to the edges of
  85. the sample measurements. This is especially true if a microsecond system
  86. clock isn't detected on the host system and a fallback gated measurement
  87. (based on nanosleep in Linux and sleep in Win32) is used to determine the
  88. timebase frequency. This is sufficient for short term measurements where
  89. high resolution comparisons are desired... but over a long measurement
  90. period, the hardware and system wall clock will diverge significantly.
  91. If a microsecond system clock is found, timebase correlation is used to
  92. synchronize the hardware counter and system clock. This is described below.
  93. }
  94. TickCallFunc = function: Ticktype; // Ticks interface function
  95. // Contains timebase overhead compensation factors in ticks for each timebase
  96. TimebaseCalibrationParameters = record
  97. FreqCalibrated: Boolean; // Indicates that the tickfrequency has been calibrated
  98. OverheadCalibrated: Boolean; // Indicates that all call overheads have been calibrated
  99. TicksIterations: Integer; // number of iterations to use when measuring ticks overhead
  100. SleepIterations: Integer; // number of iterations to use when measuring SystemSleep overhead
  101. FreqIterations: Integer; // number of iterations to use when measuring ticks frequency
  102. FrequencyGateTimeMS: Integer; // gate time to use when measuring ticks frequency
  103. end;
  104. // This record defines the Timebase context
  105. TimebaseData = record
  106. CalibrationParms: TimebaseCalibrationParameters; // Calibration data for this timebase
  107. TicksFrequency: TickType; // Tick frequency of this timebase
  108. TicksOverhead: Ticktype; // Ticks call overhead in TicksFrequency for this timebase
  109. SleepOverhead: Ticktype; // SystemSleep all overhead in TicksFrequency for this timebase
  110. Ticks: TickCallFunc; // all methods get their ticks from this function when selected
  111. end;
  112. TimeBaseSelector = ^TimebaseData;
  113. (* * * * * * * * * * * Timebase Correlation * * * * * * * * * * *)
  114. { The TimeBaseCorrelation record stores snapshot samples of both the system
  115. ticks (the source of known accuracy) and the hardware tick source (the
  116. source of high measurement resolution). An initial sample is taken at power
  117. up. The CorrelationMode property sets where and when updates are acquired.
  118. When an update snapshot is acquired, the differences between it and the
  119. startup value can be used to calculate the hardware clock frequency with
  120. high precision from the accuracy of the accumulated system clocks. The
  121. longer time that elapses between startup and a call to "CorrelateTimebases",
  122. the better the accuracy will be. On a 1.6 Ghz P4, it only takes a few
  123. seconds to achieve measurement certainty down to a few Hertz.
  124. Of course this system is only as good as your system clock accuracy, so
  125. it's a good idea to periodically sync it with NTP or against another source
  126. of known accuracy if you want to maximize the long term of the timers. }
  127. TimebaseCorrelationData = record
  128. SystemTicks: TickType;
  129. HWTicks: TickType;
  130. end;
  131. // If the Correlation property is set to automatic, an update sample is taken
  132. // anytime the user calls Start or Elapsed. If in manual, the correlation
  133. // update is only done when "CorrelateTimebases" is called. Doing updates
  134. // with every call adds a small amount of overhead... and after the first few
  135. // minutes of operation, there won't be very much correcting to do!
  136. CorrelationModes=(Manual, OnTimebaseSelect, OnGetElapsed);
  137. (* * * * * * * * * * * Timer Data record structure * * * * * * * * * * *)
  138. // This is the timer data context. There is an internal declaration of this
  139. // record and overloaded methods if you only want to use the component for a
  140. // single timer... or you can declare multiple TimerData records in your
  141. // program and create as many instances as you want with only a single
  142. // component on the form. See the "Stopwatch" methods in the TEpikTimer class.
  143. // Each timers points to the timebase that started it... so you can mix system
  144. // and hardware timers in the same application.
  145. TimerData = record
  146. Running:Boolean; // Timer is currently running
  147. TimebaseUsed:TimeBaseSelector; // keeps timer aligned with the source that started it.
  148. StartTime:TickType; // Ticks sample when timer was started
  149. TotalTicks:TickType; // Total ticks... for snapshotting and pausing
  150. end;
  151. TEpikTimer= class(TComponent)
  152. private
  153. BuiltInTimer:TimerData; // Used to provide a single built-in timer;
  154. FHWTickSupportAvailable:Boolean; // True if hardware tick support is available
  155. FHWCapabilityDataAvailable:Boolean; // True if hardware tick support is available
  156. FHWTicks:TimeBaseData; // The hardware timebase
  157. FSystemTicks:TimeBaseData; // The system timebase
  158. FSelectedTimebase:TimeBaseSelector; // Pointer to selected database
  159. FTimeBaseSource: TickSources; // use hardware or system timebase
  160. FWantDays: Boolean; // true if days are to be displayed in string returns
  161. FWantMS: Boolean; // True to display milliseconds in string formatted calls
  162. FSPrecision: FormatPrecision; // number of digits to display in string calls
  163. FMicrosecondSystemClockAvailable:Boolean; // true if system has microsecond clock
  164. StartupCorrelationSample:TimebaseCorrelationData; // Starting ticks correlation snapshot
  165. UpdatedCorrelationSample:TimebaseCorrelationData; // Snapshot of last correlation sample
  166. FCorrelationMode: CorrelationModes; // mode to control when correlation updates are performed
  167. protected
  168. function GetSelectedTimebase: TimebaseData;
  169. procedure SetSelectedTimebase(const AValue: TimebaseData);
  170. procedure SetTimebaseSource(const AValue: TickSources); //setter for TB
  171. Procedure GetCorrelationSample(Var CorrelationData:TimeBaseCorrelationData);
  172. public
  173. { Stopwatch emulation routines
  174. These routines behave exactly like a conventional stopwatch with start,
  175. stop, elapsed (lap) and clear methods. The timers can be started,
  176. stopped and resumed. The Elapsed routines provide a "lap" time analog.
  177. The methods are overloaded to make it easy to simply use the component's
  178. BuiltInTimer as a single timer... or to declare your own TimerData records
  179. in order to implement unlimited numbers of timers using a single component
  180. on the form. The timers are very resource efficient because they consume
  181. no CPU overhead and only require about 25 bytes of memory.
  182. }
  183. // Stops and resets the timer
  184. procedure Clear; overload;// Call this routine to use the built-in timer record
  185. procedure Clear(Var T:TimerData); overload; // pass your TimerData record to this one
  186. //Start or resume a stopped timer
  187. procedure Start; overload;
  188. procedure Start(Var T:TimerData); overload;
  189. //Stop or pause a timer
  190. procedure Stop; overload;
  191. procedure Stop(Var T:TimerData); overload;
  192. //Return elapsed time in seconds as an extended type
  193. function Elapsed:Extended; overload;
  194. function Elapsed(var T: TimerData):Extended; overload;
  195. //Return a string in Day:Hour:Minute:Second format. Milliseconds can be
  196. //optionally appended via the WantMilliseconds property
  197. function ElapsedDHMS:String; overload;
  198. function ElapsedDHMS(var T: TimerData):String; overload;
  199. //Return a string in the format of seconds.milliseconds
  200. function ElapsedStr:String; overload;
  201. function ElapsedStr(var T:TimerData):String; overload;
  202. function WallClockTime:String; // Return time of day string from system time
  203. //Overhead compensated system sleep to provide a best possible precision delay
  204. function SystemSleep(Milliseconds: Integer):integer; Virtual;
  205. //Diagnostic taps for development and fine grained timebase adjustment
  206. property HWTimebase: TimeBaseData read FHWTicks write FHWTicks; // The hardware timebase
  207. property SysTimebase: TimebaseData read FSystemTicks write FSystemTicks;
  208. function GetHardwareTicks:TickType; // return raw tick value from hardware source
  209. function GetSystemTicks:Ticktype; // Return system tick value(in microseconds of Epoch time)
  210. function GetTimebaseCorrelation:TickType;
  211. function CalibrateCallOverheads(Var TimeBase:TimebaseData) : Integer; Virtual;
  212. function CalibrateTickFrequency(Var TimeBase:TimebaseData): Integer; Virtual;
  213. property MicrosecondSystemClockAvailable:Boolean read FMicrosecondSystemClockAvailable;
  214. property SelectedTimebase:TimebaseSelector read FSelectedTimebase write FSelectedTimebase;
  215. property HWTickSupportAvailable:Boolean read FHWTickSupportAvailable;
  216. property HWCapabilityDataAvailable:Boolean read FHWCapabilityDataAvailable;
  217. procedure CorrelateTimebases; // Manually call to do timebase correlation snapshot and update
  218. constructor Create(AOwner:TComponent); Override;
  219. destructor Destroy; Override;
  220. Published
  221. property StringPrecision: FormatPrecision read FSPrecision write FSPrecision;
  222. property WantMilliseconds: Boolean read FWantMS write FWantMS default True;
  223. property WantDays: Boolean read FWantDays write FWantDays default False;
  224. property TimebaseSource: TickSources read FTimeBaseSource write SetTimebaseSource;
  225. property CorrelationMode:CorrelationModes read FCorrelationMode write FCorrelationMode;
  226. end;
  227. implementation
  228. (* * * * * * * * * * * * * * Timebase Section * * * * * * * * * * * * *)
  229. {
  230. There are two tick sources defined in this section. The first uses a hardware
  231. source which, in this case, is the Pentium's internal 64 Time Stamp Counter.
  232. The second source (the default) uses the given environment's most precision
  233. "timeofday" system call so it can work across OS platforms and architectures.
  234. The hardware timer's accuracy depends on the frequency of the timebase tick
  235. source that drives it... in other words, how many of the timebase's ticks
  236. there are in a second. This frequency is measured by capturing a sample of the
  237. timebase ticks for a known period against a source of known accuracy. There
  238. are two ways to do this.
  239. The first is to capture a large sample of ticks from both the unknown and
  240. known timing sources. Then the frequency of the unknown tick stream can be
  241. calculated by: UnknownSampleTicks / (KnownSampleTicks / KnownTickFrequency).
  242. Over a short period of time, this can provide a precise synchronization
  243. mechanism that effectively locks the measurements taken with the high
  244. resolution source to the known accuracy of the system clock.
  245. The first method depends on the existance of an accurate system time source of
  246. microsecond resolution. If the host system doesn't provide this, the second
  247. fallback method is to gate the unknown tick stream by a known time. This isn't
  248. as good because it usually involves calling a system "delay" routine that
  249. usually has a lot of overhead "jitter" and non-deterministic behavior. This
  250. approach is usable, however, for short term, high resolution comparisons where
  251. absolute accuracy isn't important.
  252. }
  253. const
  254. NanoPerSec = 1000000000; // 1 billionth of a second
  255. NanoPerMilli = 1000000; // 1 millionth of a millisecond
  256. MilliPerSec = 1000;
  257. USecPerSec = 1000000; // Microsecond. 1 millionth of a second
  258. (* * * * * * * * Start of i386 Hardware specific code * * * * * * *)
  259. {$IFDEF CPUI386}
  260. { Some references for this section can be found at:
  261. http://www.sandpile.org/ia32/cpuid.htm
  262. http://www.sandpile.org/ia32/opc_2.htm
  263. http://www.sandpile.org/ia32/msr.htm
  264. }
  265. // Pentium specific... push and pop the flags and check for CPUID availability
  266. function HasHardwareCapabilityData: Boolean;
  267. begin
  268. asm
  269. PUSHFD
  270. POP EAX
  271. MOV EDX,EAX
  272. XOR EAX,$200000
  273. PUSH EAX
  274. POPFD
  275. PUSHFD
  276. POP EAX
  277. XOR EAX,EDX
  278. JZ @EXIT
  279. MOV AL,TRUE
  280. @EXIT:
  281. end;
  282. end;
  283. function HasHardwareTickCounter: Boolean;
  284. var FeatureFlags: Longword;
  285. begin
  286. FeatureFlags:=0;
  287. asm
  288. PUSH EBX
  289. XOR EAX,EAX
  290. DW $A20F
  291. POP EBX
  292. CMP EAX,1
  293. JL @EXIT
  294. XOR EAX,EAX
  295. MOV EAX,1
  296. PUSH EBX
  297. DW $A20F
  298. MOV FEATUREFLAGS,EDX
  299. POP EBX
  300. @EXIT:
  301. end;
  302. Result := (FeatureFlags and $10) <> 0;
  303. end;
  304. // Execute the Pentium's RDTSC instruction to access the counter value.
  305. function HardwareTicks: TickType; assembler; asm DW 0310FH end;
  306. (* * * * * * * * End of i386 Hardware specific code * * * * * * *)
  307. // These are here for architectures that don't have a precision hardware
  308. // timing source. They'll return zeros for overhead values. The timers
  309. // will work but there won't be any error compensation for long
  310. // term accuracy.
  311. {$ELSE} // add other architectures and hardware specific tick sources here
  312. function HasHardwareCapabilityData: Boolean; begin Result:=False end;
  313. function HasHardwareTickCounter: Boolean; begin Result:=false end;
  314. function HardwareTicks:TickType; begin result:=0 end;
  315. {$ENDIF}
  316. function NullHardwareTicks:TickType; begin Result:=0 end;
  317. // Return microsecond normalized time source for a given platform.
  318. // This should be sync'able to an external time standard (via NTP, for example).
  319. function SystemTicks: TickType;
  320. {$IFDEF WINDOWS}
  321. begin
  322. QueryPerformanceCounter(Result);
  323. {$ELSE}
  324. {$IF defined(LINUX) or defined(FreeBSD)}
  325. // This is essentially the same as FPC 3.0.4's GetTickCount64() call
  326. function _GetTickCount: QWord;
  327. var
  328. ts: TTimeSpec;
  329. t: timeval;
  330. begin
  331. // use the Posix clock_gettime() call
  332. if clock_gettime(CLOCK_MONOTONIC, @ts)=0 then
  333. begin
  334. Result := (TickType(ts.tv_sec) * MilliPerSec) + (ts.tv_nsec div NanoPerMilli);
  335. Exit;
  336. end;
  337. // Use the FPC fallback
  338. fpgettimeofday(@t,nil);
  339. Result := (TickType(t.tv_sec) * MilliPerSec) + (t.tv_usec div 1000 { microsecond to millisecond });
  340. end;
  341. begin
  342. Result := _GetTickCount;
  343. {$ELSE}
  344. Result := GetTickCount64;
  345. {$ENDIF}
  346. {$ENDIF}
  347. end;
  348. function TEpikTimer.SystemSleep(Milliseconds: Integer): integer;
  349. begin
  350. Sleep(Milliseconds);
  351. Result := 0;
  352. end;
  353. function TEpikTimer.GetHardwareTicks: TickType;
  354. begin
  355. Result:=FHWTicks.Ticks();
  356. end;
  357. function TEpikTimer.GetSystemTicks: Ticktype;
  358. begin
  359. Result:=FSystemTicks.Ticks();
  360. end;
  361. procedure TEpikTimer.SetTimebaseSource(const AValue: TickSources);
  362. procedure UseSystemTimer;
  363. begin
  364. FTimeBaseSource := SystemTimebase;
  365. SelectedTimebase := @FSystemTicks;
  366. end;
  367. begin
  368. case AValue of
  369. HardwareTimebase:
  370. try
  371. if HWTickSupportAvailable then
  372. begin
  373. SelectedTimebase:=@FHWTicks;
  374. FTimeBaseSource:=HardwareTimebase;
  375. If CorrelationMode<>Manual then CorrelateTimebases
  376. end
  377. except // If HW init fails, fall back to system tick source
  378. UseSystemTimer
  379. end;
  380. SystemTimeBase: UseSystemTimer
  381. end
  382. end;
  383. function TEpikTimer.GetSelectedTimebase: TimebaseData;
  384. begin
  385. Result := FSelectedTimebase^;
  386. end;
  387. procedure TEpikTimer.SetSelectedTimebase(const AValue: TimebaseData);
  388. begin
  389. FSelectedTimebase^ := AValue;
  390. end;
  391. (* * * * * * * * * * Time measurement core routines * * * * * * * * * *)
  392. procedure TEpikTimer.Clear(var T: TimerData);
  393. begin
  394. with T do
  395. begin
  396. Running:=False; StartTime:=0; TotalTicks:=0; TimeBaseUsed:=FSelectedTimebase
  397. end;
  398. end;
  399. procedure TEpikTimer.Start(var T: TimerData);
  400. begin
  401. if not T.running then
  402. With FSelectedTimebase^ do
  403. begin
  404. T.StartTime:=Ticks()-TicksOverhead;
  405. T.TimebaseUsed:=FSelectedTimebase;
  406. T.Running:=True
  407. end
  408. end;
  409. procedure TEpikTimer.Stop(var T: TimerData);
  410. Var CurTicks:TickType;
  411. Begin
  412. if T.Running then
  413. With T.TimebaseUsed^ do
  414. Begin
  415. CurTicks:=Ticks()-TicksOverhead; // Back out the call overhead
  416. T.TotalTicks:=(CurTicks - T.Starttime)+T.TotalTicks; T.Running:=false
  417. end
  418. end;
  419. function TEpikTimer.Elapsed(var T: TimerData): Extended;
  420. var
  421. CurTicks: TickType;
  422. begin
  423. With T.TimebaseUsed^ do
  424. if T.Running then
  425. Begin
  426. CurTicks:=Ticks()-TicksOverhead; // Back out the call overhead
  427. If CorrelationMode>OnTimebaseSelect then CorrelateTimebases;
  428. Result := ((CurTicks - T.Starttime)+T.TotalTicks) / TicksFrequency
  429. End
  430. Else Result := T.TotalTicks / TicksFrequency;
  431. end;
  432. (* * * * * * * * * * Output formatting routines * * * * * * * * * *)
  433. function TEpikTimer.ElapsedDHMS(var T: TimerData): String;
  434. var
  435. Tmp, MS: extended;
  436. D, H, M, S: Integer;
  437. P, SM: string;
  438. begin
  439. Tmp := Elapsed(T);
  440. P := inttostr(FSPrecision);
  441. MS := frac(Tmp); SM := format('%0.'+P+'f',[MS]); delete(SM,1,1);
  442. D := trunc(Tmp / 86400); Tmp := Trunc(tmp) mod 86400;
  443. H := trunc(Tmp / 3600); Tmp := Trunc(Tmp) mod 3600;
  444. M := Trunc(Tmp / 60); S := (trunc(Tmp) mod 60);
  445. if FWantDays then
  446. Result := format('%2.3d:%2.2d:%2.2d:%2.2d',[D,H,M,S])
  447. else
  448. Result := format('%2.2d:%2.2d:%2.2d',[H,M,S]);
  449. if FWantMS then
  450. Result := Result+SM;
  451. end;
  452. function TEpikTimer.ElapsedStr(var T: TimerData): String;
  453. begin
  454. Result := format('%.'+inttostr(FSPrecision)+'f',[Elapsed(T)]);
  455. end;
  456. function TEpikTimer.WallClockTime: String;
  457. var
  458. Y, D, M, hour, min, sec, ms, us: Word;
  459. {$IFNDEF Windows}
  460. t: timeval;
  461. {$ENDIF}
  462. begin
  463. {$IFDEF Windows}
  464. DecodeDatetime(Now, Y, D, M, Hour, min, Sec, ms);
  465. us:=0;
  466. {$ELSE}
  467. // "Now" doesn't report milliseconds on Linux... appears to be broken.
  468. // I opted for this approach which also provides microsecond precision.
  469. fpgettimeofday(@t,nil);
  470. EpochToLocal(t.tv_sec, Y, M, D, hour, min, sec);
  471. ms:=t.tv_usec div MilliPerSec;
  472. us:=t.tv_usec mod MilliPerSec;
  473. {$ENDIF}
  474. Result:='';
  475. If FWantDays then
  476. Result := Format('%4.4d/%2.2d/%2.2d-',[Y,M,D]);
  477. Result := Result + Format('%2.2d:%2.2d:%2.2d',[hour,min,sec]);
  478. If FWantMS then
  479. Result := Result + Format('.%3.3d%3.3d',[ms,us])
  480. end;
  481. (* * * Overloaded methods to use the component's internal timer data * * *)
  482. procedure TEpikTimer.Clear;
  483. begin
  484. Clear(BuiltInTimer);
  485. end;
  486. procedure TEpikTimer.Start;
  487. begin
  488. Start(BuiltInTimer);
  489. end;
  490. procedure TEpikTimer.Stop;
  491. begin
  492. Stop(BuiltInTimer);
  493. end;
  494. function TEpikTimer.Elapsed: Extended;
  495. begin
  496. Result := Elapsed(BuiltInTimer);
  497. end;
  498. function TEpikTimer.ElapsedStr: String;
  499. begin
  500. Result := ElapsedStr(BuiltInTimer);
  501. end;
  502. function TEpikTimer.ElapsedDHMS: String;
  503. begin
  504. Result := ElapsedDHMS(BuiltInTimer);
  505. end;
  506. (* * * * * * * * * * Timebase calibration section * * * * * * * * * *)
  507. // Set up compensation for call overhead to the Ticks and SystemSleep functions.
  508. // The Timebase record contains Calibration parameters to be used for each
  509. // timebase source. These have to be unique as the output of this measurement
  510. // is measured in "ticks"... which are different periods for each timebase.
  511. function TEpikTimer.CalibrateCallOverheads(var TimeBase: TimebaseData): Integer;
  512. var i:Integer; St,Fin,Total:TickType;
  513. begin
  514. with Timebase, Timebase.CalibrationParms do
  515. begin
  516. Total:=0; Result:=1;
  517. for I:=1 to TicksIterations do // First get the base tick getting overhead
  518. begin
  519. St:=Ticks(); Fin:=Ticks();
  520. Total:=Total+(Fin-St); // dump the first sample
  521. end;
  522. TicksOverhead:=Total div TicksIterations;
  523. Total:=0;
  524. For I:=1 to SleepIterations do
  525. Begin
  526. St:=Ticks();
  527. if SystemSleep(0)<>0 then exit;
  528. Fin:=Ticks();
  529. Total:=Total+((Fin-St)-TicksOverhead);
  530. End;
  531. SleepOverhead:=Total div SleepIterations;
  532. OverheadCalibrated:=True; Result:=0
  533. End
  534. end;
  535. // CalibrateTickFrequency is a fallback in case a microsecond resolution system
  536. // clock isn't found. It's still important because the long term accuracy of the
  537. // timers will depend on the determination of the tick frequency... in other words,
  538. // the number of ticks it takes to make a second. If this measurement isn't
  539. // accurate, the counters will proportionately drift over time.
  540. //
  541. // The technique used here is to gate a sample of the tick stream with a known
  542. // time reference which, in this case, is nanosleep. There is a *lot* of jitter
  543. // in a nanosleep call so an attempt is made to compensate for some of it here.
  544. function TEpikTimer.CalibrateTickFrequency(var TimeBase: TimebaseData): Integer;
  545. var
  546. i: Integer;
  547. Total, SS, SE: TickType;
  548. ElapsedTicks, SampleTime: Extended;
  549. begin
  550. With Timebase, Timebase.CalibrationParms do
  551. Begin
  552. Result:=1; //maintain unitialized default in case something goes wrong.
  553. Total:=0;
  554. For i:=1 to FreqIterations do
  555. begin
  556. SS:=Ticks();
  557. SystemSleep(FrequencyGateTimeMS);
  558. SE:=Ticks();
  559. Total:=Total+((SE-SS)-(SleepOverhead+TicksOverhead))
  560. End;
  561. //doing the floating point conversion allows SampleTime parms of < 1 second
  562. ElapsedTicks:=Total div FreqIterations;
  563. SampleTime:=FrequencyGateTimeMS;
  564. TicksFrequency:=Trunc( ElapsedTicks / (SampleTime / MilliPerSec));
  565. FreqCalibrated:=True;
  566. end;
  567. end;
  568. // Grab a snapshot of the system and hardware tick sources... as quickly as
  569. // possible and with overhead compensation. These samples will be used to
  570. // correct the accuracy of the hardware tick frequency source when precision
  571. // long term measurements are desired.
  572. procedure TEpikTimer.GetCorrelationSample(var CorrelationData: TimeBaseCorrelationData);
  573. Var
  574. TicksHW, TicksSys: TickType;
  575. THW, TSYS: TickCallFunc;
  576. begin
  577. THW:=FHWTicks.Ticks; TSYS:=FSystemTicks.Ticks;
  578. TicksHW:=THW(); TicksSys:=TSYS();
  579. With CorrelationData do
  580. Begin
  581. SystemTicks:= TicksSys-FSystemTicks.TicksOverhead;
  582. HWTicks:=TicksHW-FHWTicks.TicksOverhead;
  583. End
  584. end;
  585. (* * * * * * * * * * Timebase correlation section * * * * * * * * * *)
  586. { Get another snapshot of the system and hardware tick sources and compute a
  587. corrected value for the hardware frequency. In a short amount of time, the
  588. microsecond system clock accumulates enough ticks to perform a *very*
  589. accurate frequency measurement of the typically picosecond time stamp counter. }
  590. function TEpikTimer.GetTimebaseCorrelation: TickType;
  591. Var
  592. HWDiff, SysDiff, Corrected: Extended;
  593. begin
  594. If HWtickSupportAvailable then
  595. Begin
  596. GetCorrelationSample(UpdatedCorrelationSample);
  597. HWDiff:=UpdatedCorrelationSample.HWTicks-StartupCorrelationSample.HWTicks;
  598. SysDiff:=UpdatedCorrelationSample.SystemTicks-StartupCorrelationSample.SystemTicks;
  599. Corrected:=HWDiff / (SysDiff / DefaultSystemTicksPerSecond);
  600. Result:=trunc(Corrected)
  601. End
  602. else result:=0
  603. end;
  604. { If an accurate reference is available, update the TicksFrequency of the
  605. hardware timebase. }
  606. procedure TEpikTimer.CorrelateTimebases;
  607. begin
  608. If MicrosecondSystemClockAvailable and HWTickSupportAvailable then
  609. FHWTicks.TicksFrequency:=GetTimebaseCorrelation
  610. end;
  611. (* * * * * * * * Initialization: Constructor and Destructor * * * * * * *)
  612. constructor TEpikTimer.Create(AOwner: TComponent);
  613. Procedure InitTimebases;
  614. Begin
  615. { Tick frequency rates are different for the system and HW timebases so we
  616. need to store calibration data in the period format of each one. }
  617. FSystemTicks.Ticks:=@SystemTicks; // Point to Ticks routine
  618. With FSystemTicks.CalibrationParms do
  619. Begin
  620. FreqCalibrated:=False;
  621. OverheadCalibrated:=False;
  622. TicksIterations:=5;
  623. SleepIterations:=10;
  624. FrequencyGateTimeMS:=100;
  625. FreqIterations:=1;
  626. End;
  627. // Initialize the HW tick source data
  628. FHWCapabilityDataAvailable:=False;
  629. FHWTickSupportAvailable:=False;
  630. FHWTicks.Ticks:=@NullHardwareTicks; // returns a zero if no HW support
  631. FHWTicks.TicksFrequency:=1;
  632. With FHWTicks.CalibrationParms do
  633. Begin
  634. FreqCalibrated:=False;
  635. OverheadCalibrated:=False;
  636. TicksIterations:=10;
  637. SleepIterations:=20;
  638. FrequencyGateTimeMS:=150;
  639. FreqIterations:=1;
  640. End;
  641. if HasHardwareCapabilityData then
  642. Begin
  643. FHWCapabilityDataAvailable:=True;
  644. If HasHardwareTickCounter then
  645. Begin
  646. FHWTicks.Ticks:=@HardwareTicks;
  647. FHWTickSupportAvailable:=CalibrateCallOverheads(FHWTicks)=0
  648. End
  649. end;
  650. CalibrateCallOverheads(FSystemTicks);
  651. CalibrateTickFrequency(FSystemTicks);
  652. // Overheads are set... get starting timestamps for long term calibration runs
  653. GetCorrelationSample(StartupCorrelationSample);
  654. With FSystemTicks do
  655. If (TicksFrequency>(DefaultSystemTicksPerSecond-SystemTicksNormalRangeLimit)) and
  656. (TicksFrequency<(DefaultSystemTicksPerSecond+SystemTicksNormalRangeLimit)) then
  657. Begin // We've got a good microsecond system clock
  658. FSystemTicks.TicksFrequency:=DefaultSystemTicksPerSecond; // assume it's pure
  659. FMicrosecondSystemClockAvailable:=True;
  660. If FHWTickSupportAvailable then
  661. Begin
  662. SystemSleep(FHWTicks.CalibrationParms.FrequencyGateTimeMS); // rough gate
  663. CorrelateTimebases
  664. End
  665. end
  666. else
  667. Begin
  668. FMicrosecondSystemClockAvailable:=False;
  669. If FHWTickSupportAvailable then
  670. CalibrateTickFrequency(FHWTicks) // sloppy but usable fallback calibration
  671. End;
  672. End;
  673. begin
  674. inherited Create(AOwner);
  675. StringPrecision := 6;
  676. FWantMS := True;
  677. FWantDays := False;
  678. InitTimebases;
  679. CorrelationMode := OnTimebaseSelect;
  680. // Default is the safe, cross-platform but less precise system timebase
  681. TimebaseSource := SystemTimebase;
  682. Clear(BuiltInTimer)
  683. end;
  684. destructor TEpikTimer.Destroy;
  685. begin
  686. inherited Destroy;
  687. // here in case we need to clean something up in a later version
  688. end;
  689. end.