Skip to content
Permalink
Browse files

use FreeBSD 8.1+ fastest clocks if available

  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Mar 12, 2019
1 parent 3118496 commit bd3f1ddc922c85232ac6a8cd076452722871fe30
Showing with 75 additions and 62 deletions.
  1. +2 −7 SQLite3/mORMotDDD.pas
  2. +72 −54 SynFPCLinux.pas
  3. +1 −1 SynopseCommit.inc
@@ -493,7 +493,6 @@ TDDDRepositoryRestFactory = class(TInterfaceResolverForSingleInterface)
procedure TablePropToAggregate(
aRecord: TSQLRecord; aRecordProp: TSQLPropInfo;
aAggregate: TObject; aAggregateProp: TSQLPropInfo); virtual;
function GetAggregateRTTIOptions: TSQLPropInfoListOptions; virtual;
// main IoC/DI method, returning a TDDDRepositoryRest instance
function CreateInstance: TInterfacedObject; override;
public
@@ -1293,7 +1292,8 @@ constructor TDDDRepositoryRestFactory.Create(
fPropsMapping.Init(aTable,RawUTF8(aAggregate.ClassName),aRest,false);
fPropsMapping.MapFields(['ID','####']); // no ID/RowID for our aggregates
fPropsMapping.MapFields(TableAggregatePairs);
fAggregateRTTI := TSQLPropInfoList.Create(aAggregate, GetAggregateRTTIOptions);
fAggregateRTTI := TSQLPropInfoList.Create(aAggregate,
[pilAllowIDFields,pilSubClassesFlattening,pilIgnoreIfGetter]);
SetLength(fAggregateToTable,fAggregateRTTI.Count);
SetLength(fAggregateProp,fAggregateRTTI.Count);
ComputeMapping;
@@ -1311,11 +1311,6 @@ constructor TDDDRepositoryRestFactory.Create(const aInterface: TGUID;
Create(aInterface,aImplementation,aAggregate,aRest,aTable,[],aOwner);
end;

function TDDDRepositoryRestFactory.GetAggregateRTTIOptions: TSQLPropInfoListOptions;
begin
Result := [pilAllowIDFields,pilSubClassesFlattening,pilIgnoreIfGetter];
end;

destructor TDDDRepositoryRestFactory.Destroy;
begin
{$ifdef WITHLOG}
@@ -77,29 +77,14 @@ procedure DeleteCriticalSection(var cs : TRTLCriticalSection); inline;

{$ifdef LINUX}

{$ifdef LINUXNOTBSD}
const
CLOCK_REALTIME = 0;
CLOCK_MONOTONIC = 1;
CLOCK_REALTIME_COARSE = 5; // see http://lwn.net/Articles/347811
CLOCK_MONOTONIC_COARSE = 6;

var
// contains CLOCK_REALTIME_COARSE since kernel 2.6.32
CLOCK_REALTIME_TICKCOUNT: integer = CLOCK_REALTIME;
// contains CLOCK_MONOTONIC_COARSE since kernel 2.6.32
CLOCK_MONOTONIC_TICKCOUNT: integer = CLOCK_MONOTONIC;

{$endif LINUXNOTBSD}

/// used by TSynMonitorMemory.RetrieveMemoryInfo to compute the sizes in byte
function getpagesize: Integer; cdecl; external 'c';

/// compatibility function, wrapping Win32 API high resolution timer
procedure QueryPerformanceCounter(out Value: Int64);

/// slightly faster than QueryPerformanceCounter() div 1000 - but not for Windows
procedure QueryPerformanceMicroSeconds(out Value: Int64);
procedure QueryPerformanceMicroSeconds(out Value: Int64); inline;

/// compatibility function, wrapping Win32 API high resolution timer
function QueryPerformanceFrequency(out Value: Int64): boolean;
@@ -131,11 +116,11 @@ function CompareStringW(GetThreadLocale: DWORD; dwCmpFlags: DWORD; lpString1: Pw
function GetNowUTC: TDateTime;

/// returns the current UTC time, as Unix Epoch seconds
function GetUnixUTC: Int64; inline;
function GetUnixUTC: Int64;

/// returns the current UTC time, as Unix Epoch milliseconds
// - will call clock_gettime(CLOCK_REALTIME_COARSE) if available
function GetUnixMSUTC: Int64; inline;
function GetUnixMSUTC: Int64;

/// returns the current UTC time as TSystemTime
procedure GetNowUTCSystem(out result: TSystemTime);
@@ -149,11 +134,35 @@ procedure GetNowUTCSystem(out result: TSystemTime);
// - under Linux/FPC, this API truncates the name to 16 chars
procedure SetUnixThreadName(ThreadID: TThreadID; const Name: RawByteString);

{$ifndef DARWIN} // OSX has no clock_gettime() API

{$ifdef BSD}
const // see https://github.com/freebsd/freebsd/blob/master/sys/sys/time.h
CLOCK_REALTIME = 0;
CLOCK_MONOTONIC = 4;
CLOCK_REALTIME_COARSE = 10; // named CLOCK_REALTIME_FAST in FreeBSD 8.1+
CLOCK_MONOTONIC_COARSE = 12;
{$else}
const
CLOCK_REALTIME = 0;
CLOCK_MONOTONIC = 1;
CLOCK_REALTIME_COARSE = 5; // see http://lwn.net/Articles/347811
CLOCK_MONOTONIC_COARSE = 6;
{$endif BSD}

var
// contains CLOCK_REALTIME_COARSE since kernel 2.6.32
CLOCK_REALTIME_FAST: integer = CLOCK_REALTIME;
// contains CLOCK_MONOTONIC_COARSE since kernel 2.6.32
CLOCK_MONOTONIC_FAST: integer = CLOCK_MONOTONIC;

{$endif DARWIN}

{$endif LINUX}

/// compatibility function, to be implemented according to the running OS
// - expect more or less the same result as the homonymous Win32 API function
function GetTickCount64: Int64;
function GetTickCount64: Int64; inline;

/// compatibility function, to be implemented according to the running OS
// - expect more or less the same result as the homonymous Win32 API function
@@ -169,7 +178,13 @@ implementation

{$ifdef LINUX}
uses
Classes, Unix, BaseUnix, {$ifdef LINUXNOTBSD}linux,{$endif} dl;
Classes,
Unix,
BaseUnix,
{$ifdef LINUXNOTBSD}
Linux,
{$endif}
dl;
{$endif LINUX}

procedure InitializeCriticalSection(var cs : TRTLCriticalSection);
@@ -204,7 +219,6 @@ procedure DeleteCriticalSection(var cs : TRTLCriticalSection);
C_MILLION = Int64(C_THOUSAND * C_THOUSAND);
C_BILLION = Int64(C_THOUSAND * C_THOUSAND * C_THOUSAND);


procedure JulianToGregorian(JulianDN: PtrUInt; out result: TSystemTime);
var YYear,XYear,Temp,TempMonth: PtrUInt;
begin
@@ -322,32 +336,26 @@ function clock_gettime(ID: cardinal; r: ptimespec): Integer;
cdecl external 'libc.so' name 'clock_gettime';
function clock_getres(ID: cardinal; r: ptimespec): Integer;
cdecl external 'libc.so' name 'clock_getres';
const
CLOCK_REALTIME = 0;
CLOCK_MONOTONIC = 4;
CLOCK_MONOTONIC_FAST = 12; // FreeBSD specific
CLOCK_MONOTONIC_TICKCOUNT = CLOCK_MONOTONIC;
CLOCK_REALTIME_TICKCOUNT = CLOCK_REALTIME;
{$endif BSD}

function GetTickCount64: Int64;
var tp: timespec;
begin
clock_gettime(CLOCK_MONOTONIC_TICKCOUNT,@tp); // likely = CLOCK_MONOTONIC_COARSE
clock_gettime(CLOCK_MONOTONIC_FAST,@tp); // likely = CLOCK_MONOTONIC_COARSE
Result := (Int64(tp.tv_sec) * C_THOUSAND) + (tp.tv_nsec div C_MILLION); // in ms
end;

function GetUnixMSUTC: Int64;
var r: timespec;
begin
clock_gettime(CLOCK_REALTIME_TICKCOUNT,@r); // likely = CLOCK_REALTIME_COARSE
clock_gettime(CLOCK_REALTIME_FAST,@r); // likely = CLOCK_REALTIME_COARSE
result := (Int64(r.tv_sec) * C_THOUSAND) + (r.tv_nsec div C_MILLION); // in ms
end;

function GetUnixUTC: Int64;
var r: timespec;
begin
clock_gettime(CLOCK_REALTIME_TICKCOUNT,@r);
clock_gettime(CLOCK_REALTIME_FAST,@r);
result := r.tv_sec;
end;

@@ -368,7 +376,7 @@ procedure QueryPerformanceMicroSeconds(out Value: Int64);
procedure GetNowUTCSystem(out result: TSystemTime);
var r: timespec;
begin
clock_gettime(CLOCK_REALTIME_TICKCOUNT,@r); // faster than fpgettimeofday()
clock_gettime(CLOCK_REALTIME_FAST,@r); // faster than fpgettimeofday()
EpochToSystemTime(r.tv_sec,result);
result.MilliSecond := r.tv_nsec div C_MILLION;
end;
@@ -449,6 +457,7 @@ procedure SleepHiRes(ms: cardinal);
procedure GetKernelRevision;
var uts: UtsName;
P: PAnsiChar;
tp: timespec;
function GetNext: cardinal;
var c: cardinal;
begin
@@ -467,23 +476,26 @@ procedure GetKernelRevision;
if fpuname(uts)=0 then begin
P := @uts.release[0];
KernelRevision := GetNext shl 16+GetNext shl 8+GetNext;
{$ifdef LINUXNOTBSD}
if KernelRevision>=$020620 then begin // expects kernel 2.6.32 or higher
CLOCK_MONOTONIC_TICKCOUNT := CLOCK_MONOTONIC_COARSE;
CLOCK_REALTIME_TICKCOUNT := CLOCK_REALTIME_COARSE;
end;
{$endif LINUXNOTBSD}
end;
{$ifdef DARWIN}
mach_timebase_info(mach_timeinfo);
mach_timecoeff := mach_timeinfo.Numer/mach_timeinfo.Denom;
mach_timenanosecond := (mach_timeinfo.Numer=1) and (mach_timeinfo.Denom=1);
{$else}
{$ifdef LINUX}
// try Linux kernel 2.6.32+ or FreeBSD 8.1+ fastest clocks
if clock_gettime(CLOCK_REALTIME_COARSE, @tp) = 0 then
CLOCK_REALTIME_FAST := CLOCK_REALTIME_COARSE;
if clock_gettime(CLOCK_MONOTONIC_COARSE, @tp) = 0 then
CLOCK_MONOTONIC_FAST := CLOCK_MONOTONIC_COARSE;
{$endif LINUX}
{$endif DARWIN}
end;


type
TExternalLibraries = object
Lock: TRTLCriticalSection;
Loaded: boolean;
{$ifdef LINUX}
pthread: pointer;
@@ -499,28 +511,33 @@ procedure GetKernelRevision;

procedure TExternalLibraries.EnsureLoaded;
begin
if Loaded then
exit;
{$ifdef LINUX}
pthread := dlopen({$ifdef ANDROID}'libc.so'{$else}'libpthread.so.0'{$endif}, RTLD_LAZY);
if pthread <> nil then begin
{$ifdef LINUXNOTBSD}
@pthread_setname_np := dlsym(pthread, 'pthread_setname_np');
{$endif LINUXNOTBSD}
EnterCriticalSection(Lock);
if not Loaded then begin
{$ifdef LINUX}
pthread := dlopen({$ifdef ANDROID}'libc.so'{$else}'libpthread.so.0'{$endif}, RTLD_LAZY);
if pthread <> nil then begin
{$ifdef LINUXNOTBSD}
@pthread_setname_np := dlsym(pthread, 'pthread_setname_np');
{$endif LINUXNOTBSD}
end;
{$endif LINUX}
Loaded := true;
end;
{$endif LINUX}
Loaded := true;
LeaveCriticalSection(Lock);
end;

procedure TExternalLibraries.Done;
begin
if not Loaded then
exit;
{$ifdef LINUX}
if pthread <> nil then
dlclose(pthread);
{$endif LINUX}
Loaded := false;
EnterCriticalSection(Lock);
if Loaded then begin
@pthread_setname_np := nil;
{$ifdef LINUX}
if pthread <> nil then
dlclose(pthread);
{$endif LINUX}
end;
LeaveCriticalSection(Lock);
DeleteCriticalSection(Lock);
end;

procedure SetUnixThreadName(ThreadID: TThreadID; const Name: RawByteString);
@@ -557,6 +574,7 @@ procedure SetUnixThreadName(ThreadID: TThreadID; const Name: RawByteString);

initialization
GetKernelRevision;
InitializeCriticalSection(ExternalLibraries.Lock);

finalization
ExternalLibraries.Done;
@@ -1 +1 @@
'1.18.5094'
'1.18.5096'

0 comments on commit bd3f1dd

Please sign in to comment.
You can’t perform that action at this time.