introducing very efficient TOSLightLock

- calls the Slim Reader/Writer (SRW) Win32 API in exclusive mode or directly the pthreads library in non-recursive/fast mode on Linux
- on XP, where SRW are not available, fallback to a TLightLock
- on non-Linux POSIX, fallback to regular cthreads/TRTLCriticalSection
- same signature as TOSLock/TLightLock, usable as compile time alternatives
- numbers make it a better alternative to TLightLock, when some contention occurs (e.g. our async server gives 15% better RPS on Linux)

src/core/mormot.core.os.pas

@@ -2175,6 +2175,9 @@   TSystemD = record
 
 {$endif ISDELPHI}
 
+  /// handle for Slim Reader/Writer (SRW) locks in exclusive mode
+  TOSLightMutex = pointer;
+
 /// returns the current UTC time as TSystemTime
 // - under Delphi/Windows, directly call the homonymous Win32 API
 // - redefined in mormot.core.os to avoid dependency to the Windows unit
@@ -2198,16 +2201,33 @@ function FileTimeToUnixTime(const FT: TFileTime): TUnixTime;
 function FileTimeToUnixMSTime(const FT: TFileTime): TUnixMSTime;
   {$ifdef FPC} inline; {$endif}
 
+var
+  // Slim Reader/Writer (SRW) API exclusive mode - fallback to TLightLock on XP
+  InitializeSRWLock,
+  AcquireSRWLockExclusive,
+  ReleaseSRWLockExclusive: procedure(var P: TOSLightMutex); stdcall;
+  TryAcquireSRWLockExclusive: function (var P: TOSLightMutex): BOOL; stdcall;
+
 {$else}
 
 type
   /// system-specific type returned by FileAge(): UTC 64-bit Epoch on POSIX
   TFileAge = TUnixTime;
 
+  /// system-specific structure holding a non-recursive mutex
+  TOSLightMutex = TRTLCriticalSection;
+
 {$ifdef OSLINUX}
   {$define OSPTHREADS} // direct pthread calls were tested on Linux only
 {$endif OSLINUX}
 
+{$ifdef OSPTHREADS}
+var // defined here for proper inlining
+  pthread_mutex_trylock: function(mutex: pointer): integer; cdecl;
+  pthread_mutex_lock: function(mutex: pointer): integer; cdecl;
+  pthread_mutex_unlock: function(mutex: pointer): integer; cdecl;
+{$endif OSPTHREADS}
+
 {$endif OSWINDOWS}
 
 /// raw cross-platform library loading function
@@ -2274,6 +2294,7 @@ procedure LeaveCriticalSection(var cs: TRTLCriticalSection); inline;
 var TryEnterCriticalSection: function(var cs: TRTLCriticalSection): integer;
 
 {$endif OSDARWIN}
+
 {$endif OSPOSIX}
 
 /// returns TRUE if the supplied mutex has been initialized
@@ -3456,10 +3477,10 @@   TRWLock = record
   end;
   PRWLock = ^TRWLock;
 
-  /// the rentrant lock supplied by the Operating System
+  /// the standard rentrant lock supplied by the Operating System
   // - maps TRTLCriticalSection, i.e. calls Win32 API or pthreads library
   // - don't forget to call Init and Done to properly initialize the structure
-  // - similar signature to TLightLock, so could be used as compile time alternative
+  // - same signature as TLightLock/TOSLightLock, usable as compile time alternatives
   {$ifdef USERECORDWITHMETHODS}
   TOSLock = record
   {$else}
@@ -3474,6 +3495,7 @@   TOSLock = record
     /// to be called to finalize the instance
     procedure Done;
     /// enter an OS lock
+    // - notice: this method IS reentrant/recursive
     procedure Lock;
       {$ifdef FPC} inline; {$endif}
     /// try to enter an OS lock
@@ -3485,6 +3507,39 @@   TOSLock = record
       {$ifdef FPC} inline; {$endif}
   end;
 
+  /// the fastest non-rentrant lock supplied by the Operating System
+  // - calls Slim Reader/Writer (SRW) Win32 API in exclusive mode or directly
+  // the pthreads library in non-recursive/fast mode on Linux
+  // - on XP, where SRW are not available, fallback to a TLightLock
+  // - on non-Linux POSIX, fallback to regular cthreads/TRTLCriticalSection
+  // - don't forget to call Init and Done to properly initialize the structure
+  // - same signature as TOSLock/TLightLock, usable as compile time alternatives
+  {$ifdef USERECORDWITHMETHODS}
+  TOSLightLock = record
+  {$else}
+  TOSLightLock = object
+  {$endif USERECORDWITHMETHODS}
+  private
+    fMutex: TOSLightMutex;
+  public
+    /// to be called to setup the instance
+    // - mandatory in all cases, even if TOSLock is part of a class
+    procedure Init;
+    /// to be called to finalize the instance
+    procedure Done;
+    /// enter an OS lock
+    // - warning: this method is NOT reentrant/recursive
+    procedure Lock;
+      {$ifdef HASINLINE} inline; {$endif}
+    /// try to enter an OS lock
+    // - if returned true, caller should eventually call UnLock()
+    function TryLock: boolean;
+      {$ifdef HASINLINE} inline; {$endif}
+    /// leave an OS lock
+    procedure UnLock;
+      {$ifdef HASINLINE} inline; {$endif}
+  end;
+
 type
   /// how TSynLocker handles its thread processing
   // - by default, uSharedLock will use the main TRTLCriticalSection
@@ -7559,7 +7614,7 @@ procedure TOSLock.Init;
 
 procedure TOSLock.Done;
 begin
-  mormot.core.os.DeleteCriticalSection(CS);
+  DeleteCriticalSectionIfNeeded(CS);
 end;
 
 procedure TOSLock.Lock;

src/core/mormot.core.os.posix.inc

@@ -822,10 +822,74 @@ var
   pthread_setname_np: function(thread: pointer; name: PAnsiChar): integer; cdecl;
   pthread_cancel: function (thread: pointer): integer; cdecl;
   pthread_setaffinity_np: function (thread: pointer;
-    cpusetsize: size_t; cpuset: pointer): integer; cdecl;
+    cpusetsize: SizeUInt; cpuset: pointer): integer; cdecl;
+  pthread_mutex_init: function(mutex, attr: pointer): integer; cdecl;
+  pthread_mutex_destroy: function(mutex: pointer): integer; cdecl;
+
+{ TOSLightLock }
+
+procedure TOSLightLock.Init;
+begin
+  FillCharFast(fMutex, SizeOf(fMutex), 0);
+  if Assigned(pthread_mutex_init) then
+    pthread_mutex_init(@fMutex, nil) // no recursive attribute -> fast mutex
+  else
+    EOSException.Create('TOSLightLock.Init: no pthread_mutex_init');
+end;
+
+procedure TOSLightLock.Done;
+begin
+  if IsInitializedCriticalSection(fMutex) then
+    pthread_mutex_destroy(@fMutex);
+end;
+
+procedure TOSLightLock.Lock;
+begin
+  pthread_mutex_lock(@fMutex);
+end;
+
+function TOSLightLock.TryLock: boolean;
+begin
+  result := pthread_mutex_trylock(@fMutex) = 0;
+end;
+
+procedure TOSLightLock.UnLock;
+begin
+  pthread_mutex_unlock(@fMutex);
+end;
+
+{$else} // fallback to plain recursive TRTLCriticalSection
+
+{ TOSLightLock }
+
+procedure TOSLightLock.Init;
+begin
+  InitCriticalSection(fMutex);
+end;
+
+procedure TOSLightLock.Done;
+begin
+  DeleteCriticalSectionIfNeeded(fMutex);
+end;
+
+procedure TOSLightLock.Lock;
+begin
+  EnterCriticalSection(fMutex);
+end;
+
+function TOSLightLock.TryLock: boolean;
+begin
+  result := TryEnterCriticalSection(@fMutex) <> 0;
+end;
+
+procedure TOSLightLock.UnLock;
+begin
+  LeaveCriticalSection(fMutex);
+end;
 
 {$endif OSPTHREADS}
 
+
 procedure SetUnixThreadName(ThreadID: TThreadID; const Name: RawByteString);
 var
   // truncated to 16 non space chars (including #0)
@@ -3484,6 +3548,11 @@ begin
     @pthread_setname_np := dlsym(pthread, 'pthread_setname_np');
     @pthread_cancel := dlsym(pthread, 'pthread_cancel');
     @pthread_setaffinity_np := dlsym(pthread, 'pthread_setaffinity_np');
+    @pthread_mutex_init := dlsym(pthread, 'pthread_mutex_init');
+    @pthread_mutex_destroy := dlsym(pthread, 'pthread_mutex_destroy');
+    @pthread_mutex_trylock := dlsym(pthread, 'pthread_mutex_trylock');
+    @pthread_mutex_lock    := dlsym(pthread, 'pthread_mutex_lock');
+    @pthread_mutex_unlock  := dlsym(pthread, 'pthread_mutex_unlock');
   end;
   {$endif OSPTHREADS}
   // some ARM/AARCH64 specific initialization

src/core/mormot.core.os.windows.inc

@@ -848,6 +848,26 @@ begin
   result := p^.V;
 end; // warning: FPC's GetTickCount64 doesn't handle 49 days wrap on XP :(
 
+procedure InitializeSRWLockForXP(var P: TOSLightMutex); stdcall;
+begin
+  TLightLock(P).Init; // TLightLock is good enough on XP
+end;
+
+procedure AcquireSRWLockExclusiveForXP(var P: TOSLightMutex); stdcall;
+begin
+  TLightLock(P).Lock;
+end;
+
+procedure ReleaseSRWLockExclusiveForXP(var P: TOSLightMutex); stdcall;
+begin
+  TLightLock(P).UnLock;
+end;
+
+function TryAcquireSRWLockExclusiveForXP(var P: TOSLightMutex): BOOL; stdcall;
+begin
+  result := TLightLock(P).TryLock;
+end;
+
 procedure SleepHiRes(ms: cardinal);
 begin
   if ms <> 0 then
@@ -857,6 +877,33 @@ begin
 end;
 
 
+{ TOSLightLock }
+
+procedure TOSLightLock.Init;
+begin
+  InitializeSRWLock(fMutex);
+end;
+
+procedure TOSLightLock.Done;
+begin // nothing needed
+end;
+
+procedure TOSLightLock.Lock;
+begin
+  AcquireSRWLockExclusive(fMutex);
+end;
+
+function TOSLightLock.TryLock: boolean;
+begin
+  result := TryAcquireSRWLockExclusive(fMutex);
+end;
+
+procedure TOSLightLock.UnLock;
+begin
+  ReleaseSRWLockExclusive(fMutex);
+end;
+
+
 { TSynEvent }
 
 constructor TSynEvent.Create;
@@ -4127,7 +4174,7 @@ end;
 
 var
   EnvironmentCache: SynUnicode;
-  EnvironmentCacheLock: TLightLock;
+  EnvironmentCacheLock: TLightLock; // just set once
 
 procedure GetEnvironmentCache;
 var
@@ -4462,10 +4509,24 @@ begin
     GetNativeSystemInfo := GetProcAddress(h, 'GetNativeSystemInfo')
   else
     @GetNativeSystemInfo := nil;
-  @GetSystemTimes := GetProcAddress(h, 'GetSystemTimes');
-  @GetProcessTimes := GetProcAddress(h, 'GetProcessTimes');
-  @QueryFullProcessImageNameW := GetProcAddress(h, 'QueryFullProcessImageNameW');
-  @GetLogicalProcessorInformation := GetProcAddress(h, 'GetLogicalProcessorInformation');
+  GetSystemTimes := GetProcAddress(h, 'GetSystemTimes');
+  GetProcessTimes := GetProcAddress(h, 'GetProcessTimes');
+  QueryFullProcessImageNameW := GetProcAddress(h, 'QueryFullProcessImageNameW');
+  GetLogicalProcessorInformation := GetProcAddress(h, 'GetLogicalProcessorInformation');
+  InitializeSRWLock := GetProcAddress(h, 'InitializeSRWLock');
+  AcquireSRWLockExclusive := GetProcAddress(h, 'AcquireSRWLockExclusive');
+  ReleaseSRWLockExclusive := GetProcAddress(h, 'ReleaseSRWLockExclusive');
+  TryAcquireSRWLockExclusive := GetProcAddress(h, 'TryAcquireSRWLockExclusive');
+  if not Assigned(InitializeSRWLock) or
+     not Assigned(AcquireSRWLockExclusive) or
+     not Assigned(ReleaseSRWLockExclusive) or
+     not Assigned(TryAcquireSRWLockExclusive) then
+  begin // SRW was introduced with Vista: on XP, fallback to our TLightLock
+    InitializeSRWLock := @InitializeSRWLockForXP;
+    AcquireSRWLockExclusive := @AcquireSRWLockExclusiveForXP;
+    ReleaseSRWLockExclusive := @ReleaseSRWLockExclusiveForXP;
+    TryAcquireSRWLockExclusive := @TryAcquireSRWLockExclusiveForXP;
+  end;
   h := Windows.LoadLibrary('Psapi.dll');
   if h >= 32 then
   begin

src/mormot.commit.inc

@@ -1 +1 @@
-'2.0.4458'
+'2.0.4459'