paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 21:47:16 +01:00
Code Issues Packages Projects Releases Wiki Activity

Set ‘TMonitorData’s without locking.

Browse Source
This commit is contained in:
Rika Ichinose 2024-02-26 19:21:24 +03:00 committed by Michael Van Canneyt
parent ba6696d9ed
commit 7589bb39b8
4 changed files with 21 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
packages/rtl-objpas/src/inc/fpmonitor.pp
View File

@ -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
ReadDependencyBarrier; // Read Result fields after Result pointer.
exit;
end;
// At some point we could cache this.
New(Result);
Result^.Init;
SetMonitorData(aObject,Result);
end;
finally
LeaveCriticalSection(_MemLock);
end;
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;

4
rtl/inc/monitor.inc
View File

@ -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;

4
rtl/inc/objpas.inc
View File

@ -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;

4
rtl/inc/objpash.inc
View File

@ -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