////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Real Time Clock procedures.                                                //
// Provides fast monotonic time measurement functions:                        //
// GetTickCount   - obsolete timer, use GetTickCount64 instead.               //
// GetTickCount64 - fast monotonic millisec since system start.               //
// mSecNow        - fast monotonic millisec since XMas (01.01.0001-00:00:00). //
// mkSecNow       - fast monotonic mikroseconds since system start.           //
// ReadTimeStampCounter - CPU clock (required thread affinity to single CPU). //
// Also time conversion function provided (Unix/Java/OLE/FileTime, LMT/GMT).  //
// The mSecNow uses as general time function for CRW-DAQ system.              //
// It takes about 25 nanosec per call on i7-4700MQ 2.4GHz.                    //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20010705 - Creation (uses CRW16) & test                                    //
// 20010707 - test (Ok), GetDateStr/GetTimeStr overload                       //
// 20011009 - TIntervalTimer (uses CRW16) & test (Ok)                         //
// 20011028 - uses wasborn,mustdie                                            //
// 20011031 - TLatch                                                          //
// 20030517 - MkSecNow                                                        //
// 20041116 - msecnow,intmsecnow modified                                     //
// 20041130 - msecnow makes faster; msecnowerrors                             //
// 20051225 - msecnow modified,FileTimeNow,NativeTimeNow,                     //
//            LocalMeanFileTimeBiasNow,GMTFileTimeToLMT,LMTFileTimeToGMT,     //
//            FileTimeToMsec,MsecToFileTime etc.                              //
// 20060906 - Get/SetClockResolution                                          //
// 20061212 - RDTSC                                                           //
// 20170302 - JavaTimeBase, UnixTimeBase, GetMidnightByTimeMs                 //
// 20200401 - GetTickCount64,GetTickCount64_Fallback,UseKernelGetTickCount64  //
// 20200402 - Timer_Check_RTC_Monotonicity,Allow_Check_RTC_Monotonicity       //
// 20221121 - Time units functions: MsToUnixTime,UnixTimeToMs,..,OleTimeToMs. //
// 20221224 - StrTimeFmt.                                                     //
// 20230507 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_rtc; { real time clock }

{$I _crw_sysdef}

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

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, baseunix, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 {$IFDEF LINUX} linux, {$ENDIF}
 sysutils, classes, math, types,
 _crw_alloc, _crw_fpu, _crw_proc, _crw_str;

 {
 ****************************************************************************
 В качестве основной единицы текущего (глобального) времени CRW использует
 число миллисекунд, начиная от Рождества Христа (Xmas), то есть в качестве
 нуля времени принят момент 01/01/0001-00:00:00:000. Достоинством является
 линейность глобального времени,  компактность хранения и высокая скорость
 чтения (вызов функции MSecNow занимает около 25 наносекунд на i7-2.4GHz).
 Функции глобального времени корректно работают с 0001 года до 9999 года.
 Учитывая линейность глобального времени,  для получения интервала времени
 между двумя моментами t1,t2 можно использовать разность миллисекунд t2-t1.

 Альтернативой глобального времени в миллисекундах является календарное
 время, хранимое в записях типа TSystemTime, которое ближе к обыденному
 восприятию, однако это время не линейно и не пригодно для критичных по
 времени фрагментов (вызов NativeTimeNow занимает около 300 нс на i7-2.4GHz).
 Имеются функции для перевода миллисекунд в календарное время и наоборот.

 Наконец,  для быстрого измерения кратких интервалов времени лучше всего
 использовать функцию Windows.GetTickCount, вызов которой занимает около
 10 нс на i7-2.4GHz, однако это время не глобально. Это значит, что само
 по себе значение GetTickCount не определяет абсолютного момента времени,
 так как зависит от времени старта компьютера.
 *****************************************************************************
 }

 {
 *******************************************************************************
 Измерение времени - сложная проблема, даже само описание времени - довольно
 запутанное дело, поскольку различные системы измерения времени имеют различное
 начало, единицы измерения, географическую локализацию, источник.
 *******************************************************************************
 Источники времени:
 ------------------
 1) Кварцевый генератор системной платы, обычно с частотой 1193180 Hz,
    синхронизирует системные процессы, такие как прерывания таймера,
    переключение потоков и т.д.
    Достоинство - монотонность и непрерывность, высокая стабильность.
    Недостаток - энергозависимое время (работает только при включении питания),
    квантование (реально счетчик приращивается по прерываниям таймера каждые
    10 миллисекунд).
 2) Часы CMOS, на них основано календарное время, так как они энергонезависимы
    (питаются от батарейки).
    Достоинство - энергонезависимость.
    Недостаток - разрывность при смене времени, невысокая стабильность, квантование.
 3) Счетчик процессора - только у новых моделей, для измерения коротких времен.
 *******************************************************************************
 Служба времени Windows использует комбинацию времен из этих источников.
 1)GetTickCount            - связан с кварцем, время от старта системы.
 2)GetSystemTimeAsFileTime - связан с кварцем (смещение) и с часами CMOS (начало).
 3)QueryPerformanceCounter - связан либо с кварцем, либо со счетчиком процессора.
 Остальные функции времени - производные от этих основных.
 *******************************************************************************
 Системы локализации времени:
 ----------------------------
 1) GMT - Greenwich Mean Time - всемирное время или время по Гринвичу
    (Гринвичская обсерватория находится на нулевом меридиане),
    не зависит от локального часового пояса.
 2) LMT - Local Mean Time - время по локальному часовому поясу,
    смещено относительно GMT на константу, зависящую от параметров локализации,
    то есть от текущего часового пояса, летнего\зимнего времени и т.д.
 3) UTC - Universal Time Coordinated -  означает Всемирное координированное
    время, является международной шкалой времени, рекомендованной Международным
    бюро мер и весов (BIPM) в качестве правовой основы для времени. В первом
    приближении GMT и UTC совпадают, но GMT определяется астрономически, а UTC
    по атомным часам. Их различие имеет в основном научное значение и разница
    составляет доли секунды (по результатам сложных измерений).
    В пакете CRW-DAQ принято, что GMT является синонимом UTC.
 *******************************************************************************
 Единицы времени:
 ----------------
 1) ms - миллисекунды, как msecnow.
 2) mks - микросекунды, как mksecnow.
 3) 100-ns - в тиках по 100 наносекунд, как FileTimeNow.
 4) В Грегорианском календаре - год,месяц,число,часов,минут,секунд,миллисекунд,
    как в NativeTimeNow.
 *******************************************************************************
 Начала отсчета времени:
 -----------------------
 1) От Рождества Христова (Xmas) 0001.01.01-00:00:000, как msecnow.
 2) От 1601.01.01-00:00, как FileTimeNow.
 3) От старта Windows, как GetTickCount.
 4) От старта текущей программы, как mksecnow.
 *******************************************************************************
 Монотонность и непрерывность.
 -----------------------------
 При смене системного времени, сетевой синхронизации времени, переходе
 на летнее\зимнее время, системное время FileTimeNow терпит разрыв,
 что может отрицательно сказаться на алгоритмах управления в реальном времени.
 Поэтому измерение времени в DAQ системах должно быть основано на вызовах типа
 Windows.GetTickCount или Windows.QueryPerformanceCouter, которые дают монотонное
 и непрерывное время (с учетом возможного переполнения счетчиков).
 По этой причине непрерывное время на основе GetTickCount мы назовем DAQ-временем,
 а время по системным часам - SYS, см. константы rtc_SYS,rtc_DAQ.
 *******************************************************************************
 Краткое описание:
 -----------------
 FileTimeNow              возвращает текущее астрономическое время в 100-ns
                          единицах от момента 1601.01.01-00:00.
                          Параметр Mode принимает значения rtc_LMT, rtc_GMT,
                          при этом выдается локальное время LMT или
                          Гринвичское время GMT соответственно.
 NativeTimeNow            возвращает текущее календарное время в виде записи
                          TSystemTime - по Грегорианскому календарю.
                          Параметр Mode принимает значения rtc_LMT, rtc_GMT,
                          при этом выдается локальное время LMT или
                          Гринвичское время GMT соответственно.
 LocalMeanFileTimeBiasNow возвращает текущее смещение локального астрономического
                          (с учетом часового пояса) времени LMT относительно
                          всемирного времени по Гринвичу (GMT) в 100-ns
                          единицах, при этом выполняется равенство
                          LocalTimeZoneBiasNow=FileTimeNow(LMT)-FileTimeNow(GMT)
                          Смещение зависит от настройки локализации, то есть от
                          часового пояса, учета летнего/зимнего времени и т.д.
 Основные характеристики функций времени:
 ----------------------------------------
  Функция            Вызов,ns Квант,ms Единицы Начало отсчета от  Локализация   Базируется на
  GetTickCount       25       10/15    ms      старта Windows     не зависит    GetTickCount
  FileTimeNow(GMT)   41       10/15    100-ns  1601.01.01-00:00   GMT           GetSystemTimeAsFileTime
  FileTimeNow(LMT)   59       10/15    100-ns  1601.01.01-00:00   LMT           GetSystemTimeAsFileTime
  mSecNow(SYS+LMT)   97       10/15    ms      0001.01.01-00:00   LMT           GetSystemTimeAsFileTime
  mSecNow(SYS+GMT)   97       10/15    ms      0001.01.01-00:00   GMT,          GetSystemTimeAsFileTime
  mSecNow(DAQ+LMT)   194      10/15    ms      0001.01.01-00:00   LMT           GetTickCount
  mSecNow(DAQ+GMT)   194      10/15    ms      0001.01.01-00:00   GMT           GetTickCount
  NativeTimeNow(GMT) 452      10/15    календ. 0001.01.01-00:00   GMT           GetSystemTimeAsFileTime
  NativeTimeNow(LMT) 466      10/15    календ. 0001.01.01-00:00   LMT           GetSystemTimeAsFileTime
  mkSecNow           1610     нет      mks     старта программы   не зависит    QueryPerformanceCounter
 *******************************************************************************
 Примечания:
 -----------
 1)Время вызова указано для P4-2000.
 2)Все перечисленные функции, кроме mksecnow, измеряют время с квантом,
   определяемым ядром Windows, которое составляет 10 ms (single processor)
   или 15 ms (multiprocessor).
 3)msecnow, mksecnow - дает локально-непрерывное астрономическое время,
   то есть время астрономическое, но нет разрыва времени при изменении системных
   часов в пределах одного сеанса.
   GetTickCount - дает локально-непрерывное время от старта, но переполняется
   через 49.7 дней непрерывной работы (это можно учитывать программно).
   QueryPerformanceCounter - дает локально-непрерывное неквантованное время
   от старта, вызов функции стоит относительно дорого.
   Остальные функции дают локально-разрывное время, то есть терпят разрыв
   при смене системного времени, сетевой синхронизации часов или смене часового
   пояса, летнего\зимнего времени и т.д.
 *******************************************************************************
 }

const
 rtc_DAQ     = 0;               // DAQ applications, GetTickCount - based timing
 rtc_SYS     = 1;               // SYS applications, FileTimeNow  - based timing
 rtc_LMT     = 0;               // LMT - based timing
 rtc_GMT     = 2;               // GMT - based timing
 rtc_LMT_DAQ = rtc_LMT+rtc_DAQ; // LMT timing for DAQ applications
 rtc_GMT_DAQ = rtc_GMT+rtc_DAQ; // GMT timing for DAQ applications
 rtc_LMT_SYS = rtc_LMT+rtc_SYS; // LMT timing for SYS applications
 rtc_GMT_SYS = rtc_GMT+rtc_SYS; // GMT timing for SYS applications
 rtc_DEFAULT = rtc_LMT_DAQ;     // Default for msecnow

function  FileTimeNow(Mode:Integer=rtc_DEFAULT):Int64;
function  NativeTimeNow(Mode:Integer=rtc_DEFAULT):TSystemTime;
function  LocalMeanFileTimeBiasNow(GMT:Int64=0):Int64;

 {
 Перевод времени:
 из единиц FileTimeNow(GMT) в FileTimeNow(LMT) и обратно
 из единиц mSecNow в FileTimeNow и обратно
 }
function  GMTFileTimeToLMT(GMT:Int64):Int64;
function  LMTFileTimeToGMT(LMT:Int64):Int64;
function  FileTimeToMsec(FileTime:Int64):Double;
function  MsecToFileTime(mSecTime:Double):Int64;

{$IFDEF LINUX}
const CLOCK_MONOTONIC_FAST = CLOCK_MONOTONIC_COARSE;
// Fast clock_gettime() based on libc which use vDSO very fast syscalls.
// With CLOCK_MONOTONIC_COARSE, works much faster then FPC GetTickCount.
function clock_gettime(clk_id : clockid_t; tp: ptimespec) : cint; cdecl;
function GetTickCount:Cardinal; // Replace slow FPC version on Linux
{$ENDIF LINUX}

{$IFDEF WINDOWS}
function GetTickCount:Cardinal;
{$ENDIF ~WINDOWS}

 {
 *******************************************************************************
 Команда RDTSC (ReaD from Time Stamp Counter) — чтение 64-разрядного счетчика
 меток реального времени TSC (Time Stamp Counter). Команда не имеет операндов.
 Машинный код этой команды — OF,31 - задается как "DW $310F"  или "DB $0F,$31".
 RDTSC возвращает значение в паре 32-битных регистров EDX:ЕАХ. Команда может
 вызывать исключение, так как является привилегированной.
 *******************************************************************************
 Счетчик меток реального времени TSC (Time Stamp Counter) — регистр CPU,
 содержимое которого инкрементируется с каждым тактом процессорного ядра.
 Регистр присутствует в системе команд процессоров x86 начиная с Pentium.
 Каждый раз при аппаратном сбросе (сигналом RESET) отсчет в этом счетчике
 начинается с нуля. Разрядность регистра обеспечивает счет без переполнения
 в течение сотен лет (2^64/(1e9*3600*24*365)=584 лет на 1 GHz CPU).
 Счетчик продолжает счет как при исполнении инструкции HLT, так и при остановке
 процессора по сигналу STPCLK# (для энергосбережения).
 Чтение счетчика обеспечивает инструкция RDTSC. Установкой второго бита регистра
 CR4.TSD (Time Stamp Disable — отключить счетчик меток реального времени)
 ее можно сделать привилегированной (доступной лишь при CPL=0).
 * если CR4.TSD=0, то выполнение RDTSC разрешается на любом уровне привилегий.
 * если CR4.TSD=1, то выполнение RDTSC разрешается только на 0 уровне привилегий.
 Чтение и запись TSC возможны также по инструкциям обращения к MSR (при CPL=0),
 причем запись может выполняться только в младшие 32 бита, а старшие биты
 при операции записи обнуляются.
 *******************************************************************************
 Присутствие счетчика TSC определяется:
 1) В WinNt - вызовом IsProcessorFeaturePresent(PF_RDTSC_INSTRUCTION_AVAILABLE).
 2) По инструкции CPUID (ЕАХ=1). Если в результате ее вызова бит 4 регистра EDX
    равен 1, то процессор поддерживает RDTSC. Сначала,разумеется, надо проверить
    наличие самой команды CPUID.
 *******************************************************************************
 RDTSC
  Функция выполняет команду RDTSC без проверок и может вызвать исключение, если
  команда не поддерживается или запрещена на данном уровне привилегий.
 ReadTimeStampCounter
  Безопасная оболочка для вызова RDTSC. Возвращает либо ненулевой счетчик TSC,
  либо 0, если команда RDTSC недоступна.
 EastimateCpuFrequencyMHz
  Функция  оценивает частоту процессора в MHz, при этом надо учитывать, что она
  "засыпает" на TimeOut. Точность определения частоты пропорциональна TimeOut.
  Частота оценивается по вызовам ReadTimeStampCounter и mksecnow. Оценка частоты
  идет в отдельном потоке, который привязывается к первому доступному для
  данного процесса процессору. Это делается для обеспечения корректной работы
  в многопроцессорных системах, см. описание проблем использования RDTSC.
 *******************************************************************************
 Возможные проблемы использования RDTSC:
 1)На мультипроцессорных системах RDTSC не дает надежного способа тайминга.
   Причина в том, что никто не гарантирует синхронность счетчиков разных
   процессоров, а поток может в приципе выполняться на разных процессорах.
   Поэтому тайминг на основе RDTSC будет надежно работать только если процесс
   (поток) привязан к одному процессору.
 1)RDTSC не дает надежного способа тайминга еще и потому, что стабильность
   частоты процессора не гарантируется. Возможно изменение частоты в режиме
   энергосбережения и т.д.
  По перечисленным причинам применение RDTSC ограничено случаями когда
  1)Измеряются очень краткие интервалы времени, когда маловероятно переключение
    процессора или изменение его частоты.
  2)Процесс или поток привязан к одному процессору, а функции энергосбережения
   отключены.
 *******************************************************************************
  Оценка (примерная) времен вызова в циклах процессора (Pentium-D-3GHz):
  call                 - 10
  GetTickCount         - 15
  ReadTimeStampCounter - 105
  msecnow              - 220
  mksecnow             - 1100
 *******************************************************************************
 }
function RDTSC:Int64;
function ReadTimeStampCounter:Int64;
function EastimateCpuFrequencyMHz(TimeOut:Cardinal):Double;

{$IFDEF WINDOWS}
 {
 Импортируемые из ntdll.dll функции Native Timer API.
 Возвращают статус >=0 при успехе и <0 при возникновении ошибки.
 Могут не работать в новых версиях Windows, при этом будет возвращаться
 значение STATUS_UNSUCCESSFUL=$C0000001. Функции NtSetTimerResolution,
 NtQueryTimerResolution используются "внутренним" образом в функциях типа
 timeBeginPeriod,timeEndPeriod etc, использование которых более надежно
 (т.к. они включены в Win32 API), однако возможности их меньше.

 Оригинальная статья Марка Руссиновича (http://sysinternals.com):

 Inside Windows NT High Resolution Timers
 Copyright © 1997 Mark Russinovich
 Last Updated: Last updated July 9, 1997
 Note: The information presented here is the result of my own study.
 No source code was used.

 Introduction
 High resolution timers are desirable in a wide variety of different applications.
 For example, the most common use of such timers in Windows is by multimedia applications
 that are producing sound or audio that require precise control. MIDI is a perfect example
 because MIDI sequencers must maintain the pace of MIDI events with 1 millisecond accuracy.
 This article describes how high resolution timers are implemented in NT and documents
 NtSetTimerResolution and NtQueryTimerResolution, the NT kernel functions that manipulate
 and return information about the system clock. Unfortunately, NtSetTimerResolution and
 NtQueryTimerResolution are not exported by the NT kernel, so they are not available
 to kernel-mode device drivers.

 The Timer API
 Windows NT bases all of its timer support off of one system clock interrupt,
 which by default runs at a 10 millisecond granularity. This is therefore the resolution
 of standard Windows timers. When a multimedia application uses the timeBeginPeriod mutlimedia API,
 which is exported by the Windows NT dynamic link library WINMM.DLL, the call is redirected
 into the Windows NT kernel-mode function NtSetTimerResolution, which is exported by the native
 Windows NT library NTDLL.DLL.

 NtSetTimerResolution and NtQueryTimerResolution are defined as follows.
 All times are specifified in hundreds of nanoseconds.

 NTSTATUS NtSetTimerResolution (
    IN ULONG RequestedResolution,
    IN BOOLEAN Set,
    OUT PULONG ActualResolution);
 Parameters
 RequestedResolution
 The desired timer resolution. Must be within the legal range of system timer values
 supported by NT. On standard x86 systems this is 1-10 milliseconds. Values that are within
 the acceptable range are rounded to the next highest millisecond boundary by the standard x86 HAL.
 This parameter is ignored if the Set parameter is FALSE.
 Set
 This is TRUE if a new timer resolution is being requested, and FALSE if the application
 is indicating it no longer needs a previously implemented resolution.
 ActualResolution
 The timer resolution in effect after the call is returned in this parameter.
 Comments
 NtSetTimerResolution returns STATUS_SUCCESS=0 if the resolution requested is within
 the valid range of timer values. If Set is FALSE, the caller must have made a previous
 call to NtSetTimerResolution or STATUS_TIMER_RESOLUTION_NOT_SET=$C0000245 is returned.

 NTSTATUS NtQueryTimerResolution (
    OUT PULONG MinimumResolution,
    OUT PULONG Maximum Resolution,
    OUT PULONG ActualResolution);
 Parameters
 MinimumResolution
 The minimum timer resolution. On standard x86 systems this is 0x2625A, which is about 10 milliseconds
 MaximumResolution
 The maximum timer resolution. On standard x86 systems this is 0x2710, which is about 1 millisecond.
 ActualResolution
 This is the current resolution of the system clock.

 Implementation Details
 NtSetTimerResolution can be called to set timer resolutions by more than on application.
 To support a subsequent process setting a timer resolution without violating the resolution
 assumptions of a previous caller, NtSetTimerResolution never lowers the timer's resolution,
 only raises it. For example, if a process sets the resolution to 5 milliseconds, subequent
 calls to set the resolution to between 5 and 10 millseconds will return a status code indicating
 success, but the timer will be left at 5 milliseconds.
 NtSetTimerResolution also keeps track of whether a process has set the timer resolution in its
 process control block, so that when a call is made with Set equal to FALSE it can verify that
 the caller has previously requested a new resolution. Every time a new resolution is set a global
 counter is incremented, and every time it is reset the counter is decremented. When the counter
 becomes 0 on a reset call the timer is changed back to its default rate, otherwise no action is taken.
 Again, this preserves the timer resolution assumptions of all the applications that have requested
 high resolution timers by guaranteeing that the resolution will be at least as good as what they specified.
 }
function NtSetTimerResolution(RequestedResolution:DWORD; SetResolution:BOOL;
    var ActualResolution:DWORD) : LongInt stdcall;
function NtQueryTimerResolution(var MinimumResolution, MaximumResolution,
    ActualResolution:DWORD) : LongInt stdcall;
{$ENDIF}

 {
 GetClockResolution
  позволяет определить временные параметры системного таймера, по которым ядро
  возбуждает прерывания системного таймера и планировщика. Все времена задаются
  в единицах 100 ns. Поэтому, например, для получения разрешения в ms надо
  использовать GetClockResolution/10000. В случае ошибки возвращается 0.
  Функции работают только с ядром NT (не работают под Win9x).
  Врочем, время Win9x прошло...
 GetClockResolution(cr_StdRes):
  Стандартная частота прерываний системного таймера и планировщика.
  Именно с таким шагом инкрементируется GetTickCount и переключаются потоки
  в обычном режиме работы (по умолчанию). Обычно это величина порядка 100000=10[ms]
  для Single CPU или 150000=15[ms] для Multi CPU.
 GetClockResolution(cr_MinRes):
  Минимальное разрешение системного таймера. Обычно это величина  порядка
  100000=10[ms], совпадающая с GetClockResolution(cr_StdRes).
 GetClockResolution(cr_MaxRes):
  Максимальное разрешение системного таймера. Обычно это величина  порядка
  10000=1[ms], при которой частота опроса потоков максимальна.
 GetClockResolution(cr_ActRes):
  Актуальная (текущая) частота прерываний системного таймера. Именно с таким шагом
  переключаются потоки данного процесса. В то же время GetTickCount, msecnow
  инкрементируется с частотой GetClockResolution(cr_StdRes).
 SetClockResolution
  позволяет задавать частоту прерываний системного таймера, по которым ядро
  возбуждает прерывания системного таймера и планировщика. Разрешение задается
  в единицах 100 ns. Положительное число разрешает, а отрицательное запрещает
  изменение частоты таймера. В случае ошибки возвращается 0. Надо иметь в виду,
  что изменение разрешения таймера основано на счетчике, поэтому отмена таймера
  произойдет, только когда все запросы будут отменены.
  Пример:
   clock:=GetClockResolution(2); // Определить наилучшее разрешение
   SetClockResolution(+clock);   // Установить это разрешение
   ...
   SetClockResolution(-clock);   // Отменить   это разрешение
 Для Linux:
  GetClockResolution возвращает квант времени часов CLOCK_MONOTONIC_COARSE,
  обычно это 4 миллисекунды. SetClockResolution возвращает ту же величину,
  а установка кванта игнорируется (не реализована).
 }
const
 cr_StdRes = 0; // Standard timer resolution, uses by GetTickCount
 cr_MinRes = 1; // Maximal timer period, minimal resolution
 cr_MaxRes = 2; // Minimal timer period, maximal resolution
 cr_ActRes = 3; // Actual timer resolution

function GetClockResolution(What:Integer=cr_StdRes):LongInt;
function SetClockResolution(NewRes:LongInt):LongInt;

 {
 MSecNow возвращает текущее астрономическое время, выраженное в миллисекундах
 от Рождества Христа, то есть от 01/01/0001-00:00:00:000.
 Это основная функция CRW для получения текущего времени по часам PC.
 Функция потокобезопасна, вызов занимает около 0.2 мкс на K7-650.
 IntMSecNow - целочисленная версия с временем вызова около 0.1 мкс на K7-650.
 Значение времени, возвращаемое функцией, основано на вызове GetTickCount.
 При этом вызов получается быстрым, однако квант времени может составлять
 до 10 миллисекунд под Win-NT/2K/XP. Для прецизионных измерений коротких
 интервалов времени надо использовать функцию mksecnow, однако mksecnow
 вызывается существенно медленнее (около 1.5 mks) и кроме того, возвращает
 локальное время, а не астрономическое. Поэтому надо отдавать предпочтение
 вызовам msecnow, если можно обойтись без прецизионной точности mksecnow.
 Реализовано два метода определения времени:
 1) Method=0, основной, основан на GetTickCount, с учетом возможного переполнения.
    При изменении системного времени msecnow(0) остается непрерывным,
    но появляется разница между системным временем Windows и временем программы,
    которая продолжает работать по часам, выставленным при старте программы.
    Такой метод подходит для систем сбора данных, так как там время обязано быть
    непрерывным, но при изменении системного времени могут неверно работать
    функции, основанные на системном времени Windows.
 2) Method=1, дополнительный, основан на GetSystemTimeAsFileTime.
    При изменении системного времени msecnow(1) терпит разрыв, в соответствии
    с новым системным временем Windows.
 Таким образом, разница msecnow(0)-msecnow(1), равная в начале нулю, показывает,
 на сколько изменилось системное время Windows в процессе выполнения программы.
 Если системное время не изменялось, разница должна быть нулем.
 MSecNowErrors - счетчик обнаруженных нарушений монотонности msecnow.
 Начиная с Windows Vista появилась функция GetTickCount64 - время в ms от загрузки.
 В отличие от GetTickCount, время GetTickCount64 не переполняется, поэтому при его
 использовании 1) вызов идет быстрее и 2) не надо блокировать потоки.
 Использованием GetTickCount64 управляет флаг UseKernelGetTickCount64.
 Примечания:
 1) Функция GetTickCount64_Fallback должна периодически вызываться в фоне,
 чтобы поддерживать актуальность времени, иначе может произойти переполнение
 счетчика GetTickCount. Это можно делать периодическим вызовом Timer_Check_RTC.
 2) Процедура Timer_Check_RTC служит для периодической (по таймеру) проверки
 функций времени на предмет монотонности. В случае нарушения монотонности
 инкрементируется счетчик ошибок MSecNowErrors.
 3) Флаг UseKernelGetTickCount64 управляет работой функций времени - если true
 (по умолчанию), используется быстрая версия, если false - запасная (надежная,
 но существенно более медленная).
 }

const     UseKernelGetTickCount64:Boolean=true;   // Use kernel32.GetTickCount64 if one supported
function  IsKernelGetTickCount64:Boolean;         // True if kernel32.GetTickCount64 is supported and uses now
function  HasKernelGetTickCount64:Boolean;        // True if kernel32.GetTickCount64 is supported and may be used
function  GetTickCount64:QWord; stdcall;          // Uptime by kernel32.GetTickCount64 if one supported and enabled
function  GetTickCount64_Standard:QWord; stdcall; // Uptime by kernel32.GetTickCount64 if one supported and enabled
function  GetTickCount64_Relevant:QWord; stdcall; // Uptime by kernel32.GetTickCount64 if one supported (since Vista)
function  GetTickCount64_Fallback:QWord; stdcall; // Uptime by kernel32.GetTickCount - fallback version for obsolete systems
function  IntMSecNow(Method:Integer=rtc_DEFAULT):QWord;
function  MSecNow(Method:Integer=rtc_DEFAULT):Double;
function  MSecNowErrors:QWORD;
procedure MSecNowErrorFound;
procedure MSecNowErrorClear;
procedure Timer_Check_RTC_Monotonicity;
const     Allow_Check_RTC_Monotonicity:Boolean=true;

 ////////////////////////////////////////////////////////////////////
 // program Test_RTC; {$APPTYPE CONSOLE} {$I _sysdef}
 // uses ShareMem,SysUtils,Windows,_alloc,_str,_rtc;
 // begin
 //  Writeln(Benchmark_RTC(1000*1000*100,true));
 //  Writeln(Benchmark_RTC(1000*1000*100,false));
 // end.
 ////////////////////////////////////////////////////////////////////
 // =======================================================
 // Benchmark_RTC() - time functions benchmark measurement.
 // =======================================================
 // Test for CPU: Intel(R) Core(TM) i7-4700MQ CPU @ 2.40GHz
 // =======================================================
 // Function \ OS > WinXPx32  W10LTSCx32  W10PROx32   units
 // =======================================================
 // Benchmark_RTC(100000000,1) => UseKernelGetTickCount64=1
 // GetTickCount       2.030       4.060      4.220 ns/call
 // GetTickCount64    20.620       6.410      6.410 ns/call
 // IntMSecNow        21.250       7.970      7.970 ns/call
 // MSecNow           29.070      14.690     15.000 ns/call
 // Benchmark_RTC(100000000,0) => UseKernelGetTickCount64=0
 // GetTickCount       2.030       4.070      4.220 ns/call
 // GetTickCount64    20.630      23.900     24.530 ns/call
 // IntMSecNow        21.090      25.780     26.720 ns/call
 // MSecNow           29.220      33.750     34.680 ns/call
 ////////////////////////////////////////////////////////////////////
function  Benchmark_RTC(n:DWORD=1000*1000*100; Kern:Boolean=true):String;

 {
 MkSecNow возвращает текущее локальное время в микросекундах, считая от старта
 программы. Функция, в отличие от msecnow, не возвращает астрономическое время,
 так как разрядная сетка Double позволяет без округления вместить интервал
 времени длиной в 2^53 микросекунд, то есть 2^53/356/24/60/60/1000000=285.6 лет,
 после чего начнется потеря точности. Поэтому функция применяется в основном
 для высокоточного измерения интервалов времени между событиями, а не для
 фиксации астрономического времени событий. Если все же требуется вычисление
 точного астрономического времени, надо использовать комбинацию вызовов msecnow
 для фиксации старта и mksecnow для фиксации приращения времени, однако в этом
 случае квант времени составит не менее 10 микросекунд, из-за округлений,
 связанных с ограниченной разрядной сеткой типа Double, принятого в CRW-DAQ
 за базовый вещественный тип.
 Если msecnow имеет разрешение порядка 10 миллисекунд (под NT/2K/XP), то
 разрешение mksecnow составляет порядка микросекунды. В то же время вызов
 msecnow занимает порядка 0.2 мкс, а вызов mksecnow занимает порядка 1.5 мкс,
 поэтому вызовами mksecnow не стоит злоупотреблять.
 Это основная функция CRW для получения высокоточного времени по часам PC.
 Функция потокобезопасна. Однако ее вызов может быть неуспешным, если
 высокоточный таймер не поддерживается аппаратурой (хотя на PC это маловероятно).
 В этом случае функция будет всегда возвращать ноль.
 }
function MkSecNow:Extended;

 {
 AssignNativeTime присваивает начальное значение записи, содержащей
 календарное время и дату
 }

function  AssignNativeTime(Year         : Word = 1;
                           Month        : Word = 1;
                           Day          : Word = 1;
                           Hour         : Word = 0;
                           Minute       : Word = 0;
                           Second       : Word = 0;
                           Milliseconds : Word = 0): TSystemTime;

 {
 Функции перехода от календарного времени к глобальному и наоборот.
 }

function  MSecToNativeTime(mSecond:Double):TSystemTime;
function  NativeTimeToMSec(const T:TSystemTime):Double;

function  GetMidnightByTimeMs(ms:Double):Double;

function  DateTimeToMSec(Year  : Word = 1;
                         Month : Word = 1;
                         Day   : Word = 1;
                         Hour  : Word = 0;
                         Min   : Word = 0;
                         Sec   : Word = 0;
                         MSec  : Word = 0): Double;
procedure MSecToDateTime(T:Double; out Year,Month,Day,Hour,Min,Sec,MSec:Word);

 {
 General Date,Time format function.
 Similar to FormatDateTime but uses ms since Xmas instead of TDateTime.
 Return empty string if ms is out of range [MSecRangeMin,MSecRangeMax].
 Also use exception handler.
 }                                      
function StrTimeFmt(const Fmt:String; ms:Double; mode:Integer=0):String;

const             // StrTimeFmt mode:
 stfm_Report = 0; // BugReport on error, return empty string
 stfm_Ignore = 1; // Ignore exceptions,  return empty string
 stfm_Raise  = 2; // Raise an exception on EConvertError

 {
 Функции строкового представления даты и времени (в мс от начала новой эры).
 За счет перегрузки и параметров по умолчанию возможны разные варианды вызова.
 Примеры : для ms=63129943111030 дата 05.07.2001-15:18:31:030
 GetDateStr(ms)                = 05.07.2001   - стандартный формат даты
 GetDateStr(ms,'\')            = 05\07\2001   - разделитель '\'
 GetDateStr(ms,'.',true)       = 2001.07.05   - порядок (год,месяц,день)
 GetDateStr(ms,#0,true)        = 20010705     - без разделителя
 GetDateStr(ms,'.',false,true) = 05.07.01     - короткий формат года
 GetTimeStr(ms)                = 15:18:31     - стандартный формат времени
 GetTimeStr(ms,#0)             = 151831       - без разделителя
 GetTimeStr(ms,':',true)       = 15:18:31:030 - показать миллисекунды
 }
function  GetDateStr(const Time      : TSystemTime;     { global time to convert }
                           Delim     : Char    = '.';   { #0 for no delim }
                           YMD_Order : Boolean = false; { Year,Month,Day order }
                           ShortYear : Boolean = false  { Year takes 2 chars }
                           ): LongString; overload;
function  GetDateStr(ms        : Double;                { global time to convert }
                     Delim     : Char    = '.';         { #0 for no delim }
                     YMD_Order : Boolean = false;       { Year,Month,Day order }
                     ShortYear : Boolean = false        { Year takes 2 chars }
                     ): LongString; overload;
function  GetTimeStr(const Time      : TSystemTime;     { global time to convert }
                           Delim     : Char    = ':';   { #0 for no delim }
                           ShowMSec  : Boolean = false  { to show milliseconds }
                           ): LongString; overload;
function  GetTimeStr(ms        : Double;                { global time to convert }
                     Delim     : Char    = ':';         { #0 for no delim }
                     ShowMSec  : Boolean = false        { to show milliseconds }
                     ): LongString; overload;

 {
 Основная функция строкового представления времени (в мс от начала новой эры).
 StdDateTimeStr(ms,Mode) возвращает строковое представление времени в обычном
 (стандартном для CRW-DAQ) формате. Если ms=0, для него подставляется mSecNow.
 Режим Mode задает вид:
  0,3 - дата и время вида 2023.05.25-15:03:35
  1,5 - только дата  вида 2023.05.25
  2   - только время вида 15:03:35
  6   - только время вида 15:03:35.123
  4,7 - дата и время вида 2023.05.25-15:03:35.123
 StdDateTimeStrUsesSysUtils задает флаг режима преобразования - если задан,
 используется стандартная функция FormatDateTime вместо собственных функций.
 }
const StdDateTimeStrUsesSysUtils : Boolean = true;
function StdDateTimeStr(ms:Double=0; Mode:Integer=0):LongString;

 {
 Интервальный таймер - объект для организации измерения времени и
 программируемых задержек, а также выполнения каких-то циклических действий
 при обработке данных по таймеру.
 Программист задает режим (циклический/одинарный) и набор интервалов,
 которые характеризуются длительностью и кодом события, которое наступает
 в конце интервала. В начале работы вызывается Start. После этого в цикле
 обработки событий нужно вызывать функцию Event, которая вернет true
 по завершении очередного интервала таймера. Чтобы узнать, какое событие
 произошло, надо вызвать What. По достижении конца очередного интервала Event
 возвращает true и затем начинается отсчет следующего интервала.
 Если режим циклический - tmCyclic, то по достижении последнего события
 начинается новый цикл. Если режим нециклический, по достижении последнего
 события таймер останавливается.
 Вызов Event и LocalTime стоит около 0.27 mks на K7-650.
 ****************************
 Пример 1 - измерение времени
 ****************************
  program test1;
  uses _rtc;
  var P:TIntervalTimer;
  begin
   P:=NewIntervalTimer;
   P.LocalTimeUnits:=1000;  // секунды
   P.Start;
   while P.LocalTime<10 do begin
    Echo(Format('%g',[P.LocalTime]));
    Sleep(3);
   end;
   P.Stop;
   Kill(P);
  end.
 ************************************************************
 Пример 2 - генерация циклической последовательности событий:
 ************************************************************
  program test2;
  uses _rtc;
  var P:TIntervalTimer;
  begin
   P:=NewIntervalTimer(tmCyclic,NewIntervalMs(300,1,
                                NewIntervalMs(3000,2,
                                NewIntervalMs(1000,3,
                                nil))));
   P.LocalTimeUnits:=1000;  // секунды
   P.Start;
   while P.LocalTime<10 do begin
    if P.Event then
    case P.What of
     1:Echo('1');
     2:Echo('2');
     3:Echo('3');
    end;
   end;
   P.Stop;
   Kill(P);
  end.
 }
const               { биты режима таймера }
 tmCyclic  = $0001; { циклический режим таймера }
 tmStart   = $8000; { для функции IntervalTimer }
 tmNothing = 0;     { таймер ждет наступления очередного события }

type
 TTimerInterval = packed record
  Delta : Double;
  Event : Word;
 end;
 PTimerIntervalArray = ^TTimerIntervalArray;
 TTimerIntervalArray = packed array[0..1000] of TTimerInterval;
 PIntervalItem = ^TIntervalItem;
 TIntervalItem = packed record
  Delta : Double;
  Event : Integer;
  Next  : PIntervalItem;
 end;
 TIntervalTimer = class(TLatch)
 private
  myNumInt     : Integer;             { число интервалов }
  myCurInt     : Integer;             { номер текущего интервала }
  myFlags      : Word;                { флаги состояния таймера }
  myiWhat      : Word;                { код последнего события }
  mygStart     : Double;              { время когда был старт }
  myiStart     : Double;              { когда был старт очередного интервала }
  myiLimit     : Double;              { когда ожидается конец интервала }
  myInterval   : PTimerIntervalArray; { массив длительностей в миллисекундах }
  myMsPerUnit  : Double;              { обратный множитель }
  myUnitPerMs  : Double;              { множитель локального времени }
  function    GetIntervalMs(i:Integer):Double;
  procedure   SetIntervalMs(i:Integer; Ms:Double);
  function    GetIntervalEvent(i:Integer):Word;
  procedure   SetIntervalEvent(i:Integer; Event:Word);
  function    GetLocalTimeUnits:Double;
  procedure   SetLocalTimeUnits(MSecPerUnit:Double);
  function    GetLocalTime:Double;
  function    GetNumIntervals:Integer;
  function    GetCurrentInterval:Integer;
  function    GetTime:Double;
  function    GetStartTime:Double;
  function    GetIntervalStartTime:Double;
  function    GetEvent:boolean;
  function    GetWhat:Word;
 public
  {
  Создать таймер.
  }
  constructor Create(Mode:Word=tmNothing; IntervalList:PIntervalItem=nil);
  {
  Уничтожить таймер.
  }
  destructor  Destroy; override;
  {
  Стартовать таймер, считая временем старта указанное при вызове время, заданное
  в глобальных миллисекундах.
  }
  procedure   StartAt(OriginTime:Double);
  {
  Стартовать таймер с текущего времени.
  }
  procedure   Start;
  {
  Остановка таймера.
  }
  procedure   Stop;
  {
  Проверка - был ли дан старт.
  }
  function    isStart:boolean;
  {
  Добавить интервал заданной длительности в миллисекундах и кодом события
  }
  procedure   AddIntervalMs(IntervalMs:Double; EventId:Word);
  {
  Каково текущее время (в глобальных миллисекундах) ?
  }
  property    GlobalTime : Double            read GetTime;
  {
  Каково текущее время с начала старта в единицах пользователя ?
  LocalTime=(GlobalTime-StartTime)/LocalTimeUnits
  }
  property    LocalTime : Double             read GetLocalTime;
  {
  Узнать или установить текущие единицы измерения локального времени.
  Показывает сколько миллисекунд в пользовательской единице времени.
  Например, если LocalTimeUnits=1000, то время в секундах.
  }
  property    LocalTimeUnits : Double        read GetLocalTimeUnits write SetLocalTimeUnits;
  {
  Когда был старт (в глобальных миллисекундах) ?
  }
  property    StartTime : Double             read GetStartTime;
  {
  Когда был старт текущего интервала (в глобальных миллисекундах) ?
  }
  property    IntervalStartTime : Double     read GetIntervalStartTime;
  {
  Выдает true по достижении конца интервала.
  Эта функция должна проверяться в цикле опоса.
  }
  property    Event : boolean                read GetEvent;
  {
  Выдает код последнего события.
  Это значение What корректно до следующего вызова Event.
  }
  property    What : Word                    read GetWhat;
  {
  Каково текущее число интервалов ?
  }
  property    NumIntervals : Integer         read GetNumIntervals;
  {
  Каков номер текущего интервала ?
  }
  property    CurrentInterval : Integer      read GetCurrentInterval;
  {
  Проверить или задать длительность интервала с заданным номером.
  }
  property    IntervalMs[i:Integer] : Double read GetIntervalMs write SetIntervalMs;
  {
  Проверить или задать событие интервала с заданным номером.
  }
  property    IntervalEvent[i:Integer] : Word read GetIntervalEvent write SetIntervalEvent;
 end;

 {
 Функция для создания списков интервалов.
 Пример:
  P:=IntervalTimer(tmCyclic,NewIntervalMs(300,1,
                            NewIntervalMs(3000,2,
                            NewIntervalMs(1000,3,
                            nil))));
 }
function  NewIntervalMs(Interval:Double; Event:Word; Next: PIntervalItem): PIntervalItem;

 {
 Уничтожение с присвоением nil
 }
procedure Kill(var TheObject:TIntervalTimer); overload;

 {
 Функция для упрощенного создания интервального таймера.
 При вызове с флагом tmStart стартует таймер с момента создания.
 }
function NewIntervalTimer(Mode:Word=tmNothing; IntervalList:PIntervalItem=nil):TIntervalTimer;

 {
 Magic numerals
 }
const
 QuartzFrequency  = 1193180;
 CountsPerTick    = 65536;
 SecsPerDay       = 24 * 60 * 60;
 MSecsPerDay      = SecsPerDay  * 1000;
 TicksPerDay      = 1573040 {QuartzFrequency / CountsPerTick * SecsPerDay};
 SecsPerTick      = SecsPerDay  / TicksPerDay;
 TicksPerSec      = TicksPerDay / SecsPerDay;
 MSecsPerTick     = MSecsPerDay / TicksPerDay;
 TicksPerMSec     = TicksPerDay / MSecsPerDay;
 DateDelta        = 693594;             // Days from Xmas to 1899.12.31-00:00:00.000
 FileTimesPerMSec = 10000;              // Num. 100 ns FileTime's ticks per 1 ms
 TickCountOverInc = $100000000;         // GetTickCount increment, when overflow
 FileTimeZeroOffs = 504911232000000000; // FileTimeZero-XmasTimeZero,[100ns]
 XmasTimeZeroDate = '0001.01.01-00:00'; // Christmas time zero date
 FileTimeZeroDate = '1601.01.01-00:00'; // Win32 GMT time zero date
 JavaTimeBase     = 621355968e5;        // 1970.01.01-00:00:00 UTC Epoch
 JavaTimeUnit     = 1;                  // JavaScript use ms since Epoch
 UnixTimeBase     = 621355968e5;        // 1970.01.01-00:00:00 UTC Epoch
 UnixTimeUnit     = 1000;               // Unix time(), secs since Epoch
 FileTimeBase     = 504911232e5;        // 1601.01.01-00:00:00 UTC Win32
 FileTimeUnit     = 1e-4;               // FileTime uses 100 ns units
 WinsTimeBase     = 504911232e5;        // 1601.01.01-00:00:00 UTC Win32
 WinsTimeUnit     = 1;                  // SystemTime uses ms unit Win32
 OleTimeBase      = 599264352e5;        // 1899.12.30-00:00:00 - OLE Automation date format
 OleTimeUnit      = 86400000;           // Equals MSecsPerDay  - OLE Automation date format
 DateTimeBase     = 599264352e5;        // DateTime is same as OleTime - uses in FPC`s Now
 DateTimeUnit     = 86400000;           // DateTime is same as OleTime - uses in FPC`s Now

const                                   // Range of Msec since Xmas
 MsecRangeMin     = 0;                  // 01/01/0001 00:00:00.000 - Xmas
 MsecRangeMax     = 315537897599999;    // 12/31/9999 23:59:59.999 - High(TDateTime)

 {
 Time unit conversion routines.
 }

 {
 Note: 'ms' means 'milliseconds since Xmas'
 Xmas is: 0001.01.0.1-00:00:00 +0000 (UTC).
 It's DaqPascal msecnow function time unit.
 }

 {
 UnixTime is number of seconds since Epoch.
 Epoch is: 1970-01-01 00:00:00 +0000 (UTC).
 It's standard Unix/Linux time(.) function.
 }
function MsToUnixTime(ms:Double):Double;
function UnixTimeToMs(tm:Double):Double;

 {
 JavaTime is number of milliseconds since Epoch.
 It's time units uses by JavaScript new Data().
 }
function MsToJavaTime(ms:Double):Double;
function JavaTimeToMs(tm:Double):Double;

 {
 FileTime is number of 100 ns units since 1601.01.01-00:00:00 UTC.
 It's time units uses by Win32 GetSystemTimeAsFileTime() FILETIME.
 }
function MsToFileTime(ms:Double):Double;
function FileTimeToMs(tm:Double):Double;

 {
 WinsTime is number milliseconds since 1601.01.01-00:00:00 UTC.
 It's time units uses by Win32 GetSystemTime.
 }
function MsToWinsTime(ms:Double):Double;
function WinsTimeToMs(tm:Double):Double;

 {
 OleTime is number of days since 1899.12.30-00:00:00 UTC.
 It's time unit uses by OLE,OLEDB,ADO,OPCDA,Delphi & FPC.
 TDateTime is same as OleTime and uses in FPC`s Now call.
 }
function MsToOleTime(ms:Double):Double;
function OleTimeToMs(tm:Double):Double;

 {
 TDateTime is same as OleTime and uses in FPC`s Now call.
 It`s default DateTime unit for Delphi and FPC functions.
 }
function MsToDateTime(ms:Double):Double;
function DateTimeToMs(tm:Double):Double;

implementation

function MsToUnixTime(ms:Double):Double;
begin
 MsToUnixTime:=(ms-UnixTimeBase)/UnixTimeUnit;
end;
function UnixTimeToMs(tm:Double):Double;
begin
 UnixTimeToMs:=tm*UnixTimeUnit+UnixTimeBase;
end;

function MsToJavaTime(ms:Double):Double;
begin
 MsToJavaTime:=(ms-JavaTimeBase)/JavaTimeUnit;
end;
function JavaTimeToMs(tm:Double):Double;
begin
 JavaTimeToMs:=tm*JavaTimeUnit+JavaTimeBase;
end;

function MsToFileTime(ms:Double):Double;
begin
 MsToFileTime:=(ms-FileTimeBase)/FileTimeUnit;
end;
function FileTimeToMs(tm:Double):Double;
begin
 FileTimeToMs:=tm*FileTimeUnit+FileTimeBase;
end;

function MsToWinsTime(ms:Double):Double;
begin
 MsToWinsTime:=(ms-WinsTimeBase)/WinsTimeUnit;
end;
function WinsTimeToMs(tm:Double):Double;
begin
 WinsTimeToMs:=tm*WinsTimeUnit+WinsTimeBase;
end;

function MsToOleTime(ms:Double):Double;
begin
 MsToOleTime:=(ms-OleTimeBase)/OleTimeUnit;
end;
function OleTimeToMs(tm:Double):Double;
begin
 OleTimeToMs:=tm*OleTimeUnit+OleTimeBase;
end;

function MsToDateTime(ms:Double):Double;
begin
 MsToDateTime:=(ms-DateTimeBase)/DateTimeUnit;
end;
function DateTimeToMs(tm:Double):Double;
begin
 DateTimeToMs:=tm*DateTimeUnit+DateTimeBase;
end;

 {
 *****************************
 TIntervalTimer implementation
 *****************************
 }
constructor TIntervalTimer.Create(Mode:Word=tmNothing; IntervalList:PIntervalItem=nil);
var
 I : PIntervalItem;
begin
 inherited Create;
 myNumInt:=0;
 myCurInt:=0;
 myFlags:=Mode and not tmStart;
 mygStart:=0;
 myiStart:=0;
 myiLimit:=0;
 myiWhat:=tmNothing;
 myInterval:=nil;
 LocalTimeUnits:=1;
 while Assigned(IntervalList) do begin
  AddIntervalMs(IntervalList.Delta,IntervalList.Event);
  I:=IntervalList;
  IntervalList:=IntervalList.Next;
  Dispose(I);
 end;
 if Mode and tmStart <> 0 then Start;
end;

destructor TIntervalTimer.Destroy;
begin
 Lock;
 Deallocate(Pointer(myInterval));
 Unlock;
 inherited Destroy;
end;

procedure TIntervalTimer.AddIntervalMs(IntervalMs:Double; EventId:Word);
var
 i           : Integer;
 OldInterval : PTimerIntervalArray;
begin
 if Assigned(Self) then begin
  Lock;
  OldInterval:=myInterval;
  myInterval:=Allocate((myNumInt+1)*sizeof(myInterval[0]));
  if Assigned(myInterval) then begin
   if Assigned(OldInterval) then
   for i:=0 to myNumInt-1 do myInterval[i]:=OldInterval[i];
   myInterval[myNumInt].Delta:=IntervalMs;
   myInterval[myNumInt].Event:=EventId;
   Deallocate(Pointer(OldInterval));
   inc(myNumInt);
  end else begin
   Deallocate(Pointer(myInterval));
   myInterval:=OldInterval;
  end;
  Unlock;
 end;
end;

procedure  TIntervalTimer.StartAt(OriginTime:Double);
begin
 if Assigned(Self) then begin
  Lock;
  Stop;
  myFlags:=myFlags or tmStart;
  myCurInt:=0;
  mygStart:=OriginTime;
  myiStart:=mygStart;
  myiLimit:=myiStart+IntervalMs[myCurInt];
  myiWhat:=tmNothing;
  Unlock;
 end;
end;

procedure  TIntervalTimer.Start;
begin
 StartAt(MSecNow);
end;

procedure  TIntervalTimer.Stop;
begin
 if Assigned(Self) then begin
  Lock;
  myFlags:=myFlags and not tmStart;
  Unlock;
 end;
end;

function TIntervalTimer.isStart:boolean;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=(myFlags and tmStart<>0);
  Unlock;
 end else Result:=false;
end;

function TIntervalTimer.GetTime:Double;
begin
 GetTime:=msecnow;
end;

function  TIntervalTimer.GetStartTime:Double;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=mygStart;
  Unlock;
 end else Result:=0;
end;

function  TIntervalTimer.GetIntervalStartTime:Double;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myiStart;
  Unlock;
 end else Result:=0;
end;

function  TIntervalTimer.GetLocalTime:Double;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=(MSecNow-mygStart)*myUnitPerMs;
  Unlock;
 end else Result:=0;
end;

function  TIntervalTimer.GetEvent:boolean;
var
 Time : Double;
begin
 Result:=false;
 if Assigned(Self) then begin
  Lock;
  myiWhat:=tmNothing;
  if (myFlags and tmStart <> 0) and (myNumInt > 0) then begin
   Time:=MSecNow;
   if Time>=myiLimit then begin
    myiWhat:=IntervalEvent[myCurInt];
    Result:=true;
    inc(myCurInt);
    if myCurInt>=myNumInt then begin
     myCurInt:=0;
     if myFlags and tmCyclic = 0 then Stop;
    end;
    if myFlags and tmStart <> 0 then begin
     myiStart:=Time;
     myiLimit:=myiStart+IntervalMs[myCurInt];
    end;
   end;
  end;
  Unlock;
 end;
end;

function TIntervalTimer.GetWhat:Word;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myiWhat;
  Unlock;
 end else Result:=tmNothing;
end;

function  TIntervalTimer.GetNumIntervals:Integer;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myNumInt;
  Unlock;
 end else Result:=0;
end;

function  TIntervalTimer.GetCurrentInterval:Integer;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myCurInt;
  Unlock;
 end else Result:=0;
end;

function  TIntervalTimer.GetIntervalMs(i:Integer):Double;
begin
 if Assigned(Self) then begin
  Lock;
  if (i>=0) and (i<myNumInt) and Assigned(myInterval)
  then Result:=myInterval[i].Delta
  else Result:=0;
  Unlock;
 end else Result:=0;
end;

procedure TIntervalTimer.SetIntervalMs(i:Integer; Ms:Double);
begin
 if Assigned(Self) then begin
  Lock;
  if (i>=0) and (i<myNumInt) and Assigned(myInterval) then begin
   myInterval[i].Delta:=Ms;
   if (myFlags and tmStart <> 0) and (i=myCurInt) then myiLimit:=myiStart+Ms;
  end;
  Unlock;
 end;
end;

function  TIntervalTimer.GetIntervalEvent(i:Integer):Word;
begin
 if Assigned(Self) then begin
  Lock;
  if (i>=0) and (i<myNumInt) and Assigned(myInterval)
  then Result:=myInterval[i].Event
  else Result:=tmNothing;
  Unlock;
 end else Result:=tmNothing;
end;

procedure TIntervalTimer.SetIntervalEvent(i:Integer; Event:Word);
begin
 if Assigned(Self) then begin
  Lock;
  if (i>=0) and (i<myNumInt) and Assigned(myInterval)
  then myInterval[i].Event:=Event;
  Unlock;
 end;
end;

function TIntervalTimer.GetLocalTimeUnits:Double;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myMsPerUnit;
  Unlock;
 end else Result:=0;
end;

procedure TIntervalTimer.SetLocalTimeUnits(MSecPerUnit:Double);
begin
 if Assigned(Self) then begin
  Lock;
  myMsPerUnit:=MSecPerUnit;
  myUnitPerMs:=1/myMsPerUnit;
  Unlock;
 end;
end;

function NewIntervalMs(Interval:Double; Event:Word; Next: PIntervalItem): PIntervalItem;
begin
 Result:=New(PIntervalItem);
 if Assigned(Result) then begin
  Result.Delta:=Interval;
  Result.Event:=Event;
  Result.Next:=Next;
 end;
end;

function NewIntervalTimer(Mode:Word=tmNothing; IntervalList:PIntervalItem=nil):TIntervalTimer;
begin
 Result:=nil;
 try
  Result:=TIntervalTimer.Create(Mode,IntervalList);
 except
  on E:Exception do BugReport(E,nil,'NewIntervalTimer');
 end;
end;

procedure Kill(var TheObject:TIntervalTimer); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 {
 Date / Time conversion
 }

const // Uses for DateTime conversions.
 FloatMSecsPerDay : Double = MSecsPerDay;
 MonthTable       : array[Boolean] of array[1..12] of Word =
                    ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
                     (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
 {
procedure DivMod(Dividend:LongInt; Divisor:Word; var Result,Remainder:Word);
begin
 Result    := Dividend div Divisor;
 Remainder := Dividend mod Divisor;
end;
 }
procedure DivMod(Dividend:LongInt; Divisor:Word; out Result,Remainder:Word); inline;
begin
 Result:=0; Remainder:=0;
 math.DivMod(Dividend,Divisor,Result,Remainder);
end;

function EncodeTime(Hour,Min,Sec,MSec:Word; out MSecFromMidnight:LongInt):boolean;
begin
 Result:=false;
 if (Hour<24) and (Min<60) and (Sec<60) and (MSec<1000) then begin
  MSecFromMidnight:=((LongInt(Hour)*60+Min)*60+Sec)*1000+MSec;
  Result:=true;
 end else MSecFromMidnight:=0;
end;

procedure DecodeTime(MSecFromMidnight:LongInt; out Hour,Min,Sec,MSec:Word);
var
 MinCount  : Word;
 MSecCount : Word;
begin
 DivMod(MSecFromMidnight, 60000, MinCount, MSecCount);
 DivMod(MinCount, 60, Hour, Min);
 DivMod(MSecCount, 1000, Sec, MSec);
end;

function IsLeapYear(Year: Word): Boolean;
begin
 Result:=(Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;

function EncodeDate(Year,Month,Day:Word; out NumDaysFromXmas:LongInt):Boolean;
var
 I      : LongInt;
 isLeap : Boolean;
begin
 Result := False;
 NumDaysFromXmas := 0;
 isLeap := IsLeapYear(Year);
 if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
   (Day >= 1) and (Day <= MonthTable[isLeap][Month]) then
 begin
  for I := 1 to Month - 1 do Inc(Day, MonthTable[isLeap][I]);
  I := Year - 1;
  NumDaysFromXmas := I * 365 + I div 4 - I div 100 + I div 400 + Day - 1;
  Result:= True;
 end;
end;

procedure DecodeDate(NumDaysFromXmas:LongInt; out Year,Month,Day,DayOfWeek:Word);
const
  D1   = 365;
  D4   = D1 * 4 + 1;
  D100 = D4 * 25 - 1;
  D400 = D100 * 4 + 1;
var
 Y      : Word;
 M      : Word;
 D      : Word;
 I      : Word;
 T      : LongInt;
 isLeap : Boolean;
begin
 T := NumDaysFromXmas + 1;
 if T <= 0 then begin
  Year := 0;
  Month := 0;
  Day := 0;
  DayOfWeek:=0;
 end else begin
  DayOfWeek := T mod 7;
  Dec(T);
  Y := 1;
  while T >= D400 do begin
   Dec(T, D400);
   Inc(Y, 400);
  end;
  DivMod(T, D100, I, D);
  if I = 4 then begin
   Dec(I);
   Inc(D, D100);
  end;
  Inc(Y, I * 100);
  DivMod(D, D4, I, D);
  Inc(Y, I * 4);
  DivMod(D, D1, I, D);
  if I = 4 then begin
   Dec(I);
   Inc(D, D1);
  end;
  Inc(Y, I);
  isLeap := IsLeapYear(Y);
  M := 1;
  while True do begin
   I := MonthTable[isLeap][M];
   if D < I then Break;
   Dec(D, I);
   Inc(M);
  end;
  Year := Y;
  Month := M;
  Day := D + 1;
 end;
end;

function AssignNativeTime(Year         : Word = 1;
                          Month        : Word = 1;
                          Day          : Word = 1;
                          Hour         : Word = 0;
                          Minute       : Word = 0;
                          Second       : Word = 0;
                          Milliseconds : Word = 0): TSystemTime;
begin
 Result.Year:=Year;
 Result.Month:=Month;
 Result.Day:=Day;
 Result.DayOfWeek:=sysutils.DayOfWeek(sysutils.EncodeDate(Year, Month, Day));
 Result.Hour:=Hour;
 Result.Minute:=Minute;
 Result.Second:=Second;
 Result.Millisecond:=Milliseconds;
end;

function MSecToNativeTime(mSecond:Double):TSystemTime;
var
 NumDaysFromXmas  : LongInt;
 MSecFromMidnight : LongInt;
begin
 NumDaysFromXmas:=trunc(mSecond/FloatMSecsPerDay);
 MSecFromMidnight:=trunc(mSecond-NumDaysFromXmas*FloatMSecsPerDay);
 with Result do begin
  DecodeTime(MSecFromMidnight,Hour,Minute,Second,Millisecond);
  DecodeDate(NumDaysFromXmas,Year,Month,Day,DayOfWeek);
 end;
end;

function NativeTimeToMSec(const T:TSystemTime):Double;
var
 NumDaysFromXmas  : LongInt;
 MSecFromMidnight : LongInt;
begin
 with T do begin
  if EncodeDate(Year,Month,Day,NumDaysFromXmas) and
     EncodeTime(Hour,Minute,Second,Millisecond,MSecFromMidnight)
  then Result:=NumDaysFromXmas*FloatMSecsPerDay+MSecFromMidnight
  else Result:=_NaN;
 end;
end;

function GetMidnightByTimeMs(ms:Double):Double;
var st:TSystemTime;
begin
 st:=MSecToNativeTime(ms);
 st.Hour:=0; st.Minute:=0; st.Second:=0; st.Millisecond:=0;
 Result:=NativeTimeToMSec(st);
end;

function  DateTimeToMSec(Year  : Word = 1;
                         Month : Word = 1;
                         Day   : Word = 1;
                         Hour  : Word = 0;
                         Min   : Word = 0;
                         Sec   : Word = 0;
                         MSec  : Word = 0): Double;
var
 NumDaysFromXmas  : LongInt;
 MSecFromMidnight : LongInt;
begin
 if EncodeDate(Year,Month,Day,NumDaysFromXmas) and
    EncodeTime(Hour,Min,Sec,MSec,MSecFromMidnight)
 then Result:=NumDaysFromXmas*FloatMSecsPerDay+MSecFromMidnight
 else Result:=_NaN;
end;

procedure  MSecToDateTime(T:Double; out Year,Month,Day,Hour,Min,Sec,MSec:Word);
var
 NumDaysFromXmas  : LongInt;
 MSecFromMidnight : LongInt;
 DayOfWeek        : Word;
begin
 NumDaysFromXmas:=trunc(T/FloatMSecsPerDay);
 MSecFromMidnight:=trunc(T-NumDaysFromXmas*FloatMSecsPerDay);
 DecodeTime(MSecFromMidnight,Hour,Min,Sec,MSec);
 DecodeDate(NumDaysFromXmas,Year,Month,Day,DayOfWeek);
end;

function StrTimeFmt(const Fmt:String; ms:Double; mode:Integer=0):String;
begin
 Result:='';
 if (ms>=MsecRangeMin) then
 if (ms<=MsecRangeMax) then
 try
  Result:=FormatDateTime(Fmt,MsToDateTime(ms));
 except
  on E:EConvertError do begin
   case mode of
    stfm_Report: BugReport(E,nil,'StrTimeFmt');
    stfm_Ignore: Exit;
    else raise;
   end;
  end;
  on E:Exception do BugReport(E,nil,'StrTimeFmt');
 end;
end;

function  GetDateStr(const Time      : TSystemTime;     { global time to convert }
                           Delim     : Char    = '.';   { #0 for no delim }
                           YMD_Order : Boolean = false; { Year,Month,Day order }
                           ShortYear : Boolean = false  { Year takes 2 chars }
                           ): LongString;
var
 fmt  : String[30];
 Year : Word;
begin
 if ShortYear then begin
  Year:=Time.Year mod 100;
  fmt:='%2.2d';
 end else begin
  Year:=Time.Year;
  fmt:='%4.4d';
 end;
 if YMD_Order then begin
  if Delim<>#0 then fmt:=fmt+Delim;
  fmt:=fmt+'%2.2d';
  if Delim<>#0 then fmt:=fmt+Delim;
  fmt:=fmt+'%2.2d';
  Result:=Format(fmt,[Year,Time.Month,Time.Day]);
 end else begin
  if Delim<>#0 then fmt:=Delim+fmt;
  fmt:='%2.2d'+fmt;
  if Delim<>#0 then fmt:=Delim+fmt;
  fmt:='%2.2d'+fmt;
  Result:=Format(fmt,[Time.Day,Time.Month,Year]);
 end;
end;

function  GetDateStr(ms        : Double;          { global time to convert }
                     Delim     : Char    = '.';   { #0 for no delim }
                     YMD_Order : Boolean = false; { Year,Month,Day order }
                     ShortYear : Boolean = false  { Year takes 2 chars }
                     ): LongString;
begin
 Result:=GetDateStr(MSecToNativeTime(ms),Delim,YMD_Order,ShortYear);
end;

function  GetTimeStr(const Time      : TSystemTime;     { global time to convert }
                           Delim     : Char    = ':';   { #0 for no delim }
                           ShowMSec  : Boolean = false  { to show milliseconds }
                           ): LongString;
var
 fmt   : String[30];
begin
 fmt:='%2.2d';
 if Delim<>#0 then fmt:=fmt+Delim;
 fmt:=fmt+'%2.2d';
 if Delim<>#0 then fmt:=fmt+Delim;
 fmt:=fmt+'%2.2d';
 if ShowMSec then begin
  if Delim<>#0 then fmt:=fmt+Delim;
  fmt:=fmt+'%3.3d';
  Result:=Format(fmt,[Time.Hour,Time.Minute,Time.Second,Time.MilliSecond]);
 end else begin
  Result:=Format(fmt,[Time.Hour,Time.Minute,Time.Second]);
 end;
end;

function  GetTimeStr(ms        : Double;          { global time to convert }
                     Delim     : Char    = ':';   { #0 for no delim }
                     ShowMSec  : Boolean = false  { to show milliseconds }
                     ): LongString;
begin
 Result:=GetTimeStr(MSecToNativeTime(ms),Delim,ShowMSec);
end;

function StdDateTimeStr(ms:Double=0; Mode:Integer=0):LongString;
var dt:TDateTime;
begin
 if (ms=0) then ms:=mSecNow;
 if StdDateTimeStrUsesSysUtils then begin
  dt:=MsToDateTime(ms);
  case Mode of
   0,3 : Result:=FormatDateTime(StdDateTimeFormat,dt);
   1,5 : Result:=FormatDateTime(StdDateOnlyFormat,dt);
   2   : Result:=FormatDateTime(StdTimeOnlyFormat,dt);
   6   : Result:=FormatDateTime(StdTimeOnlyFormatMs,dt);
   4,7 : Result:=FormatDateTime(StdDateTimeFormatMs,dt);
   else  Result:=FormatDateTime(StdDateTimeFormat,dt);
  end;
 end else begin
  case Mode of
   0,3 : Result:=GetDateStr(ms,'.',true)+'-'+GetTimeStr(ms);
   1,5 : Result:=GetDateStr(ms,'.',true);
   2   : Result:=GetTimeStr(ms);
   6   : Result:=GetTimeStr(ms,':',true);
   4,7 : Result:=GetDateStr(ms,'.',true)+'-'+GetTimeStr(ms,':',true);
   else  Result:=GetDateStr(ms,'.',true)+'-'+GetTimeStr(ms);
  end;
 end;
end;

 {
 ***********************************
 MSecNow & IntMSecNow implementation
 ***********************************
 }

const
 LMT_Offset   : Int64    = 0;  // LMT-GMT  time offset, [100 ns units]
 GMT_Base_FB  : Int64    = 0;  // GMT Base time, [ms] (Fallback)
 LMT_Base_FB  : Int64    = 0;  // LMT Base time, [ms] (Fallback)
 GMT_Base_RV  : Int64    = 0;  // GMT Base time, [ms] (Relevant)
 LMT_Base_RV  : Int64    = 0;  // LMT Base time, [ms] (Relevant)
 TheFailures  : SizeUInt = 0;  // Time failures counter

const GetTickCount64_Kernel:function:QWord; stdcall = nil;

{$IFDEF LINUX}
// libc's clock_gettime function uses vDSO (avoid syscall) while FPC by default
// is compiled without FPC_USE_LIBC defined and do a syscall each time
//   GetTickCount64 fpc    2 494 563 op/sec - syscall bases version
//   GetTickCount64 libc 119 919 893 op/sec - vDSO    based version
// note: for high-resolution QueryPerformanceCounter is also slower
//       because of syscall takes over 250 ns (for CPU i74700MQ-2.4GHz)
function clock_gettime(clk_id : clockid_t; tp: ptimespec) : cint; cdecl; external 'c' name 'clock_gettime';

function clock_gettime_millisec(id:clockid_t):QWord; inline;
var tp:timespec;
begin
 if (clock_gettime(id, @tp)=0) // exists since Linux Kernel 2.6
 then Result:=(Int64(tp.tv_sec)*1000)+(tp.tv_nsec div 1000000)
 else Result:=0;
end;

function clock_gettime_microsec(id:clockid_t):QWord; inline;
var tp:timespec;
begin
 if (clock_gettime(id, @tp)=0) // exists since Linux Kernel 2.6
 then Result:=(Int64(tp.tv_sec)*1000000)+(tp.tv_nsec div 1000)
 else Result:=0;
end;

function clock_gettime_supported(id:clockid_t):Boolean;
var tp:timespec;
begin
 if (id in [CLOCK_REALTIME..CLOCK_MONOTONIC_COARSE])
 then Result:=(clock_getres(id,@tp)=0) and (clock_gettime(id,@tp)=0)
 else Result:=false;
end;

function clock_getres_millisec(id:clockid_t):QWord; inline;
var tp:timespec;
begin
 if (clock_getres(id, @tp)=0) // exists since Linux Kernel 2.6
 then Result:=(Int64(tp.tv_sec)*1000)+(tp.tv_nsec div 1000000)
 else Result:=0;
end;

function GetTickCount64_kernel_linux:QWord; stdcall;
begin
 Result:=clock_gettime_millisec(CLOCK_MONOTONIC_FAST);
end;

function GetTickCount:Cardinal;
begin
 Result:=GetTickCount64;
end;
{$ENDIF}

{$IFDEF WINDOWS}
function GetTickCount:Cardinal;
begin
 Result:=Windows.GetTickCount;
end;
{$ENDIF ~WINDOWS}

procedure InitGetTickCount64;
begin
 {$IFDEF WINDOWS}
 @GetTickCount64_Kernel:=GetProcAddress(GetModuleHandle('kernel32.dll'),'GetTickCount64');
 {$ENDIF}
 {$IFDEF LINUX}
 if clock_gettime_supported(CLOCK_MONOTONIC_FAST) then
 if (clock_gettime_millisec(CLOCK_MONOTONIC_FAST)<>0) then
 @GetTickCount64_Kernel:=@GetTickCount64_Kernel_Linux;
 {$ENDIF}
end;

function HasKernelGetTickCount64:Boolean;
begin
 Result:=Assigned(GetTickCount64_Kernel);
end;

function IsKernelGetTickCount64:Boolean;
begin
 Result:=Assigned(GetTickCount64_Kernel) and UseKernelGetTickCount64;
end;

function GetTickCount64_Fallback:QWord; stdcall;
begin
 Result:=SysUtils.GetTickCount64;
end;

function GetTickCount64_Relevant:QWord; stdcall;
begin
 if Assigned(GetTickCount64_Kernel)
 then Result:=GetTickCount64_Kernel
 else Result:=GetTickCount64_Fallback;
end;

function GetTickCount64_Standard:QWord; stdcall;
begin
 if Assigned(GetTickCount64_Kernel) and UseKernelGetTickCount64
 then Result:=GetTickCount64_Kernel
 else Result:=GetTickCount64_Fallback;
end;

function GetTickCount64:QWord; stdcall;
begin
 if Assigned(GetTickCount64_Kernel) and UseKernelGetTickCount64
 then Result:=GetTickCount64_Kernel
 else Result:=GetTickCount64_Fallback;
end;

procedure InitializeMSecNow;
var TheDateTime:TDateTime; TickTime_FB,TickTime_RV:Int64; Tick:QWORD; Iter:Integer;
const Quantum=1; MaxIter=10;
begin
 InitGetTickCount64;
 LMT_Offset:=Int64(GetLocalTimeOffset)*(60*1000);
 for Iter:=1 to MaxIter do begin
  Tick:=GetTickCount64;
  TickTime_FB:=GetTickCount64_Fallback;
  TickTime_RV:=GetTickCount64_Relevant;
  TheDateTime:=Now;
  if (GetTickCount64-Tick<=Quantum) then Break;
 end;
 LMT_Base_FB:=Round(DateTimeToMs(TheDateTime))-TickTime_FB;
 LMT_Base_RV:=Round(DateTimeToMs(TheDateTime))-TickTime_RV;
 GMT_Base_FB:=LMT_Base_FB+LMT_Offset;
 GMT_Base_RV:=LMT_Base_RV+LMT_Offset;
end;

procedure FinalizeMSecNow;
begin
 ResourceLeakageLog(Format('%-60s = %d',['MSecNow.Monotone.Violations', TheFailures]));
end;

function MSecNow(Method:Integer):Double;
var aTime : Int64;
begin
 if Method and rtc_SYS = rtc_SYS then begin
  aTime:=Round(DateTimeToMs(Now));
  if Method and rtc_GMT = rtc_GMT
  then Result:=aTime+LMT_Offset
  else Result:=aTime;
 end else begin
  if Assigned(GetTickCount64_Kernel) and UseKernelGetTickCount64 then begin
   if Method and rtc_GMT = rtc_GMT
   then Result:=GMT_Base_RV+GetTickCount64_Kernel
   else Result:=LMT_Base_RV+GetTickCount64_Kernel;
  end else begin
   if Method and rtc_GMT = rtc_GMT
   then Result:=GMT_Base_FB+GetTickCount64_Fallback
   else Result:=LMT_Base_FB+GetTickCount64_Fallback;
  end;
 end;
end;

function IntMSecNow(Method:Integer):QWord;
var aTime : Int64;
begin
 if Method and rtc_SYS = rtc_SYS then begin
  aTime:=Round(DateTimeToMs(Now));
  if Method and rtc_GMT = rtc_GMT
  then Result:=aTime+LMT_Offset
  else Result:=aTime;
 end else begin
  if Assigned(GetTickCount64_Kernel) and UseKernelGetTickCount64 then begin
   if Method and rtc_GMT = rtc_GMT
   then Result:=GMT_Base_RV+GetTickCount64_Kernel
   else Result:=LMT_Base_RV+GetTickCount64_Kernel;
  end else begin
   if Method and rtc_GMT = rtc_GMT
   then Result:=GMT_Base_FB+GetTickCount64_Fallback
   else Result:=LMT_Base_FB+GetTickCount64_Fallback;
  end;
 end;
end;

function MSecNowErrors:QWORD;
begin
 Result:=TheFailures;
end;

procedure MSecNowErrorFound;
begin
 LockedInc(TheFailures);
end;

procedure MSecNowErrorClear;
begin
 LockedExchange(TheFailures,0);
end;

procedure Timer_Check_RTC_Monotonicity;
const Last : array[1..2] of Int64 = (0,0);
const ThId : SizeUInt = 0;
var i:Integer; Tick:Int64;
begin
 if not Allow_Check_RTC_Monotonicity then Exit;
 if ThId=0 then ThId:=GetCurrentThreadId;
 if (GetCurrentThreadId<>ThId) then Exit;
 for i:=Low(Last) to High(Last) do begin
  if i=Low(Last)
  then Tick:=GetTickCount64_Relevant
  else Tick:=GetTickCount64_Fallback;
  //  Monotonicity violation checking
  if Tick<Last[i] then MSecNowErrorFound;
  Last[i]:=Tick;
 end;
end;

function Benchmark_RTC(n:DWORD=1000*1000*100; Kern:Boolean=true):String;
var i:Integer; qw:Int64; dt,t,ms:Double; Save:Boolean; b:Boolean;
procedure Nop(x:Double); begin x:=x+1; end;
begin
 Save:=UseKernelGetTickCount64;
 UseKernelGetTickCount64:=Kern;
 Result:=Format('Benchmark_RTC(%d,%d):',[n,Ord(Kern)]);
 // Testing
 ms:=mSecNow;
 for b:=false to true do for i:=0 to 7 do begin
  StdDateTimeStrUsesSysUtils:=b;
  Result:=Result+EOL+Format('StdDateTimeStr %d %d %s',      [ord(b),i,StdDateTimeStr(ms,i)]);
 end;
 qw:=mSecToFileTime(ms);
 Result:=Result+EOL+Format('FileTime %s LMT, %s GMT',
  [StdDateTimeStr(FileTimeToMsec(qw),4),StdDateTimeStr(FileTimeToMsec(LMTFileTimeToGMT(qw)),4)]);
 qw:=FileTimeNow;
 Result:=Result+EOL+Format('FileTime %s LMT, %s GMT',
  [StdDateTimeStr(FileTimeToMsec(qw),4),StdDateTimeStr(FileTimeToMsec(LMTFileTimeToGMT(qw)),4)]);
 qw:=GMTFileTimeToLMT(FileTimeNow(rtc_GMT));
 Result:=Result+EOL+Format('FileTime %s LMT, %s GMT',
  [StdDateTimeStr(FileTimeToMsec(qw),4),StdDateTimeStr(FileTimeToMsec(LMTFileTimeToGMT(qw)),4)]);
 //
 // GetTickCount64
 //
 qw:=0; t:=0;
 dt:=GetTickCount64;
 for i:=1 to n do qw:=GetTickCount64;
 dt:=GetTickCount64-dt;
 Result:=Result+EOL+Format('GetTickCount64 %7.3f ns/call',[1e6*dt/n]);
 Nop(qw);
 //
 // IntMSecNow
 //
 dt:=GetTickCount64;
 for i:=1 to n do qw:=IntMSecNow;
 dt:=GetTickCount64-dt;
 Result:=Result+EOL+Format('IntMSecNow     %7.3f ns/call',[1e6*dt/n]);
 Nop(qw);
 //
 // MSecNow
 //
 dt:=GetTickCount64;
 for i:=1 to n do t:=MSecNow;
 dt:=GetTickCount64-dt;
 Result:=Result+EOL+Format('MSecNow        %7.3f ns/call',[1e6*dt/n]);
 Nop(t);
 //
 // Summary
 //
 Result:=Result+EOL+Format('GetTickCount64 %d ms',[GetTickCount64_Standard])+' (Standard)';
 Result:=Result+EOL+Format('GetTickCount64 %d ms',[GetTickCount64_Fallback])+' (Fallback)';
 Result:=Result+EOL+Format('IntMSecNow     %d ms',[IntMSecNow]);
 Result:=Result+EOL+Format('MSecNow        %g ms',[MSecNow]);
 ms:=mSecNow;
 Result:=Result+EOL+Format('Date-Time      %s-%s',   [GetDateStr(ms,'.',true),GetTimeStr(ms)]);
 Result:=Result+EOL+Format('Date/Time      %s',      [FormatDateTime(StdDateTimeFormat,MsToDateTime(ms))]);
 UseKernelGetTickCount64:=Save;
end;

 {
 *******************************************************************************
 FileTimeNow, NativeTimeNow, LocalMeanFileTimeBiasNow etc
 *******************************************************************************
 }
function FileTimeNow(Mode:Integer=rtc_DEFAULT):Int64;
begin
 Result:=MSecToFileTime(DateTimeToMs(Now));
 if Mode and rtc_GMT = rtc_GMT then Result:=LMTFileTimeToGMT(Result);
end;

function NativeTimeNow(Mode:Integer):TSystemTime;
begin
 Result:=MSecToNativeTime(FileTimeToMsec(FileTimeNow(Mode)));
end;

function LocalMeanFileTimeBiasNow(GMT:Int64=0):Int64;
begin
 Result:=-LMT_Offset*FileTimesPerMSec;
end;

function GMTFileTimeToLMT(GMT:Int64):Int64;
begin
 Result:=GMT-LMT_Offset*FileTimesPerMSec;
end;

function LMTFileTimeToGMT(LMT:Int64):Int64;
begin
 Result:=LMT+LMT_Offset*FileTimesPerMSec;
end;

function FileTimeToMsec(FileTime:Int64):Double;
begin
 Result:=FileTimeToMs(FileTime);
end;

function MsecToFileTime(mSecTime:Double):Int64;
begin
 Result:=Round(MsToFileTime(mSecTime));
end;

{$PUSH}
{$ASMMODE Intel}
{$IFDEF CPU32}
function RDTSC:Int64;{$ifdef FPC}nostackframe; assembler;{$endif}
asm
 rdtsc                       // returns the TSC in EDX:EAX
end;
{$ENDIF}
{$IFDEF CPU64}
function RDTSC:Int64;{$ifdef FPC}nostackframe; assembler;{$endif}
asm
 rdtsc                       // returns the TSC in EDX:EAX
 shl     rdx, 32             // then copy EDX:EAX
 or      rax, rdx            // to RAX
end;
{$ENDIF}
{$POP}

function ReadTimeStampCounter:Int64;
const Flag:LongInt=0;
begin
 Result:=0;
 if Flag>0 then begin            // If initialization was successed
  try
   Result:=RDTSC;                // Read Time Stamp Counter register
   if Result=0 then Inc(Result); // Zero Result reserved for errors
  except                         // Exception on privileges ?
   Result:=0;                    // Set "Error" result
  end;
 end else
 if Flag<0 then begin            // If initialization failed
  Result:=0;                     // Set "Error" result
 end else                        // Initialization should be done
 try                             // Protected initialization, exception possible
  Result:=RDTSC;                 // Read Time Stamp Counter register
  if Result=0 then Inc(Result);  // Zero Result reserved for errors
  LockedExchange(Flag,+1);       // Set "Ok" flag for future calls
 except                          // Exception means that RDTSC is not supported
  Result:=0;                     // Set "Error" result
  LockedExchange(Flag,-1);       // Set "Error" flag
 end;
end;

type
 TCpuThread=class(TThread)
 protected
  FreqMHz : Double;
  TimeOut : Cardinal;
  AffMask : QWord;
  procedure Execute; override;
 end;

procedure TCpuThread.Execute;
const
 MaxIter = 100;
 Quantum = 1;
var
 tsc1,tsc2:Int64; i:Integer; t1,t2:QWord; mks1,mks2:Double;
begin
 FreqMHz:=0;
 try
  SetThreadAffinityMask(0,AffMask); // set thread affinity
  if ReadTimeStampCounter<>0 then begin
   for i:=1 to MaxIter do begin
    t1:=GetTickCount64;
    mks1:=mksecnow;
    tsc1:=ReadTimeStampCounter;
    t2:=GetTickCount64;
    if (t2-t1<=Quantum) then Break; // All timers measured at the same time quantum?
   end;
   Sleep(TimeOut);
   for i:=1 to MaxIter do begin
    t1:=GetTickCount64;
    mks2:=mksecnow;
    tsc2:=ReadTimeStampCounter;
    t2:=GetTickCount64;
    if (t2-t1<=Quantum) then Break; // All timers measured at the same time quantum?
   end;
   FreqMHz:=(tsc2-tsc1)/(mks2-mks1);
  end;
 except
  on E:Exception do BugReport(E,Self,'Execute');
 end;
end;

 //
 // We should use separate thread with affinity mask assigned to 1-st available
 // CPU only to avoid problems with RDTSC in multi-processor systems.
 //
function EastimateCpuFrequencyMHz(TimeOut:Cardinal):Double;
var t:TCpuThread; i:Integer; affm,mask:QWORD;
begin
 Result:=0;
 try
  t:=TCpuThread.Create(true);                // Create suspended thread
  t.Priority:=tpTimeCritical;                // with highest priority
  t.FreeOnTerminate:=False;
  t.TimeOut:=TimeOut;
  try
   mask:=1;
   affm:=GetProcessAffinityMask;
   if (affm<>0) then
   for i:=0 to 63 do begin
    if (mask and affm <> 0) then begin        // Find 1-st available CPU
     t.AffMask:=mask;
     Break;
    end;
    mask:=mask shl 1;
   end;
   t.Start;
   t.WaitFor;
   Result:=t.FreqMHz;
   cpu_mhz(2,Result);
  finally
   Kill(TThread(t));
  end;
 except
  on E:Exception do BugReport(E,nil,'EastimateCpuFrequencyMHz');
 end;
end;

 {
 *************************************
 Get/SetClockResolution implementation
 *************************************
 }
{$IFDEF WINDOWS}
const
 hNtDll : HINST = 0;
 _NtSetTimerResolution : function(RequestedResolution:DWORD; SetResolution:BOOL;
    var ActualResolution:DWORD) : LongInt stdcall = nil;
 _NtQueryTimerResolution : function(var MinimumResolution, MaximumResolution,
    ActualResolution:DWORD) : LongInt stdcall = nil;

procedure ExitNtDll;
begin
 try
  if hNtDll <> 0 then FreeLibrary(hNtDll);
  _NtQueryTimerResolution:=nil;
  _NtSetTimerResolution:=nil;
  hNtDll:=0;
 except
  on E:Exception do BugReport(E,nil,'ExitNtDll');
 end;
end;

procedure InitNtDll;
begin
 if Win32Platform >= VER_PLATFORM_WIN32_NT then
 try
  if hNtDll=0 then begin
   hNtDll := LoadLibrary(PChar('ntdll.dll'));
   if hNtDll <> 0 then begin
    @_NtSetTimerResolution := GetProcAddress(hNtDll, PChar('NtSetTimerResolution'));
    @_NtQueryTimerResolution := GetProcAddress(hNtDll, PChar('NtQueryTimerResolution'));
    if not Assigned(_NtSetTimerResolution) then ExitNtDll;
    if not Assigned(_NtQueryTimerResolution) then ExitNtDll;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'InitNtDll');
 end;
end;

function NtSetTimerResolution(RequestedResolution:DWORD; SetResolution:BOOL;
    var ActualResolution:DWORD) : LongInt stdcall;
begin
 Result:=LongInt($C0000001); // STATUS_UNSUCCESSFUL
 try
  if Assigned(_NtSetTimerResolution) then
  Result:=_NtSetTimerResolution(RequestedResolution, SetResolution, ActualResolution);
 except
  on E:Exception do BugReport(E,nil,'NtSetTimerResolution');
 end;
end;

function NtQueryTimerResolution(var MinimumResolution, MaximumResolution,
    ActualResolution:DWORD) : LongInt stdcall;
begin
 Result:=LongInt($C0000001); // STATUS_UNSUCCESSFUL
 try
  if Assigned(_NtQueryTimerResolution) then
  Result:=_NtQueryTimerResolution(MinimumResolution, MaximumResolution, ActualResolution);
 except
  on E:Exception do BugReport(E,nil,'NtQueryTimerResolution');
 end;
end;
{$ENDIF}

{$IFDEF WINDOWS}
function GetClockResolution(What:Integer):LongInt;
var
 Adj,StdRes,MinRes,MaxRes,ActRes:DWORD; AdjDisabled:BOOL;
begin
 Result:=0;
 if Win32Platform >= VER_PLATFORM_WIN32_NT then
 try
  AdjDisabled:=false; Adj:=0; StdRes:=0; MinRes:=0; MaxRes:=0; ActRes:=0;
  case What of
   cr_StdRes: if GetSystemTimeAdjustment(Adj,StdRes,AdjDisabled) then Result:=StdRes;
   cr_MinRes: if NtQueryTimerResolution(MinRes,MaxRes,ActRes)>=0 then Result:=MinRes;
   cr_MaxRes: if NtQueryTimerResolution(MinRes,MaxRes,ActRes)>=0 then Result:=MaxRes;
   cr_ActRes: if NtQueryTimerResolution(MinRes,MaxRes,ActRes)>=0 then Result:=ActRes;
  end;
 except
  on E:Exception do BugReport(E,nil,'GetClockResolution');
 end;
end;
{$ENDIF}
{$IFDEF UNIX}
function GetClockResolution(What:Integer):LongInt;
begin
 Result:=clock_getres_millisec(CLOCK_MONOTONIC_FAST)*FileTimesPerMSec;
end;
{$ENDIF}

{$IFDEF WINDOWS}
function SetClockResolution(NewRes:LongInt):LongInt;
var
 ActRes:DWORD;
begin
 Result:=0;
 if NewRes<>0 then
 if Win32Platform >= VER_PLATFORM_WIN32_NT then
 try
  ActRes:=0;
  if NtSetTimerResolution(Abs(NewRes),(NewRes>0),ActRes)>=0 then Result:=ActRes;
 except
  on E:Exception do BugReport(E,nil,'SetClockResolution');
 end;
end;
{$ENDIF}
{$IFDEF UNIX}
function SetClockResolution(NewRes:LongInt):LongInt;
begin
 Result:=clock_getres_millisec(CLOCK_MONOTONIC_FAST)*FileTimesPerMSec;
end;
{$ENDIF}

 {
 ***********************
 MkSecNow implementation
 ***********************
 }
{$IFDEF WINDOWS}
var
 FixPerformanceFrequency : Int64;
 FixPerformanceCounter   : Int64;
 FixPerformanceFactor    : Extended;
{$ENDIF}

procedure InitializeMkSecNow;
begin
 {$IFDEF WINDOWS}
 if QueryPerformanceCounter(FixPerformanceCounter) and
    QueryPerformanceFrequency(FixPerformanceFrequency) and
    (FixPerformanceFrequency>0)
 then FixPerformanceFactor:=1000000.0/FixPerformanceFrequency
 else begin
  FixPerformanceFrequency:=0;
  FixPerformanceCounter:=0;
  FixPerformanceFactor:=0;
 end;
 {$ENDIF}
end;

function MkSecNow:Extended;
var PerformanceCounter : Int64;
begin
 Result:=0;
 {$IFDEF WINDOWS}
 PerformanceCounter:=0;
 if QueryPerformanceCounter(PerformanceCounter) then begin
  Dec(PerformanceCounter,FixPerformanceCounter);
  Result:=PerformanceCounter*FixPerformanceFactor;
 end;
 {$ENDIF}
 {$IFDEF UNIX}
 PerformanceCounter:=clock_gettime_microsec(CLOCK_MONOTONIC);
 Result:=PerformanceCounter;
 {$ENDIF}
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_rtc;
begin
 {$IFDEF WINDOWS}
 InitNtDll;
 {$ENDIF}
 InitializeMSecNow;
 InitializeMkSecNow;
end;

procedure Free_crw_rtc;
begin
 FinalizeMSecNow;
 {$IFDEF WINDOWS}
 ExitNtDll;
 {$ENDIF}
end;

initialization

 Init_crw_rtc;

finalization

 Free_crw_rtc;

end.

//////////////
// END OF FILE
//////////////

