Set ‘TMonitorData’s without locking.

packages/rtl-objpas/src/inc/fpmonitor.pp

@@ -408,7 +408,6 @@ var
   _oldMonitor,
   _monitor : TMonitorManager;
   _DummySpinCount : Integer;
-  _MemLock : TRTLCriticalSection;
 
 function GetMonitorData(aObject : TObject) : PMonitorData; inline;
 
@@ -416,28 +415,31 @@ begin
   Result:=PMonitorData(_monitor.DoGetMonitorObjectData(aObject));
 end;
 
-procedure SetMonitorData(aObject : TObject; aData : PMonitorData); inline;
+function SetMonitorData(aObject : TObject; aData,aComparand : PMonitorData) : PMonitorData; inline;
 
 begin
-  _monitor.DoSetMonitorObjectData(aObject,aData);
+  Result:=_monitor.DoSetMonitorObjectData(aObject,aData,aComparand);
 end;
 
 function SyncEnsureData(aObject : TObject) : PMonitorData;
 
 begin
-  EnterCriticalSection(_MemLock);
-  try
+  repeat
     Result:=GetMonitorData(aObject);
-    if Result=Nil then
+    if Result<>Nil then
       begin
-      // At some point we could cache this.
-      New(Result);
-      Result^.Init;
-      SetMonitorData(aObject,Result);
+      ReadDependencyBarrier; // Read Result fields after Result pointer.
+      exit;
       end;
-  finally
-    LeaveCriticalSection(_MemLock);
-  end;
+
+    // At some point we could cache this.
+    New(Result);
+    Result^.Init;
+    WriteBarrier; // Write pointer with SetMonitorData only after Result fields have been written.
+    if SetMonitorData(aObject,Result,nil)=nil then
+      break;
+    Dispose(Result); // And retry GetMonitorData + ReadDependencyBarrier from the beginning of the loop, which will guaranteedly succeed.
+  until false;
 end;
 
 procedure SyncFreeData(aData : PMonitorData);
@@ -549,7 +551,6 @@ end;
 procedure RegisterMonitorSupport;
 
 begin
-  InitCriticalSection(_MemLock);
   InitMonitorSupport;
   _OldMonitor:=SetMonitorManager(_Monitor);
 end;
@@ -557,7 +558,6 @@ end;
 procedure UnRegisterMonitorSupport;
 
 begin
-  DoneCriticalSection(_MemLock);
   SetMonitorManager(_oldMonitor);
 end;
 

rtl/inc/monitor.inc

@@ -85,9 +85,9 @@ end;
   Monitor manager
   *********************************************************************}
 
-procedure SysMonitorSetObjectDataProc(const aObject : TObject; aData : Pointer);
+function SysMonitorSetObjectDataProc(const aObject : TObject; aData,aComparand : Pointer) : Pointer;
 begin
-  aObject.SetMonitorData(aData);
+  Result:=aObject.SetMonitorData(aData,aComparand);
 end;
 
 function SysMonitorGetObjectDataFunc (const aObject : TObject): Pointer;

rtl/inc/objpas.inc

@@ -1175,9 +1175,9 @@ end;
 
       {$IFDEF SYSTEM_HAS_FEATURE_MONITOR}
 
-       procedure TObject.SetMonitorData(aData : Pointer);
+       function TObject.SetMonitorData(aData,aComparand : Pointer) : Pointer;
        begin
-         _MonitorData:=aData;
+         Result:=InterlockedCompareExchange(_MonitorData,aData,aComparand);
        end;
 
        function TObject.GetMonitorData: Pointer;

rtl/inc/objpash.inc

@@ -245,7 +245,7 @@
        strict private
           _MonitorData : Pointer;
        private
-          procedure SetMonitorData(aData : Pointer); inline;
+          function SetMonitorData(aData,aComparand : Pointer) : Pointer; inline;
           function GetMonitorData: Pointer; inline;
        {$ENDIF}
        protected
@@ -620,7 +620,7 @@
     TMonitorFunc = function(const aObject : TObject) : Boolean;
     TMonitorTimeoutFunc = function(const aObject : TObject; aTimeout : Cardinal) : Boolean;
     TMonitorLockTimeoutFunc = function(const aObject,aLock : TObject; aTimeout : Cardinal) : Boolean;
-    TMonitorSetObjectDataProc = procedure (const aObject : TObject; aData : Pointer);
+    TMonitorSetObjectDataProc = function (const aObject : TObject; aData,aComparand : Pointer) : Pointer;
     TMonitorGetObjectDataFunc = function (const aObject : TObject): Pointer;
     TMonitorFreeDataProc = procedure (aData : Pointer);
   Public