Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

renamed Semaphore to Latch

Browse Source
This commit is contained in:
Michael Schimmel
2025-05-27 11:51:06 +02:00
parent 95fddb0181
commit ca101a3452
7 changed files with 640 additions and 593 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Core.Tasks.pas
+39 -53
View File
@@ -4,7 +4,7 @@ interface
uses
System.SysUtils, System.Classes, System.SyncObjs,
Myc.Core.Atomic, Myc.Signals;
Myc.Core.Atomic, Myc.Signals; // Myc.Signals now requires direct use of TMycLatch static members
type
IMycTaskFactory = interface
@@ -30,8 +30,8 @@ type
FTerminated: Integer; // Flag to signal worker threads to terminate
[volatile]
FThreadsRunning: Integer; // Counter for active worker threads
FWaitSemaphores: TMycAtomicStack<TSemaphore>; // Pool of semaphores for WaitFor
FWorkGate: TSemaphore; // Semaphore to signal available work to worker threads
FWaitSemaphores: TMycAtomicStack<TSemaphore>; // Pool of System.SyncObjs.TSemaphore for WaitFor
FWorkGate: TSemaphore; // System.SyncObjs.TSemaphore to signal available work
FWorkStack: TMycAtomicStack<TProc>; // Stack of pending jobs
FWorkThreads: TArray<TThread>; // Array of worker threads
procedure WorkerThread;
@@ -76,7 +76,7 @@ type
TMyc2TaskWait = class sealed(TInterfacedObject, IMycSubscriber)
private
[volatile]
FSemaphore: TSemaphore; // Semaphore to be released on notification
FSemaphore: TSemaphore; // System.SyncObjs.TSemaphore to be released on notification
protected
function Notify: Boolean;
@@ -111,16 +111,11 @@ begin
Teardown; // Perform cleanup and stop threads
FWorkGate.Free;
// FException is an acquired exception object, should not be freed manually.
// If FException <> nil here, it means an unhandled exception was not processed by HandleException.
// FException := nil; // Optionally nil it out if necessary for state clarity
inherited Destroy;
end;
class function TMycTaskFactory.CreateAnonymousThread(const DbgName: String; const Proc: TProc): TThread;
{$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF}
var
prio: TThreadPriority;
{$ENDIF MSWINDOWS}
@@ -128,6 +123,7 @@ begin
Result := TThread.CreateAnonymousThread(Proc);
{$IFDEF MSWINDOWS}
{$WARN SYMBOL_PLATFORM OFF}
// Set priority lower than MainThread priority if created from main thread
if TThread.CurrentThread.ThreadID = MainThreadID then
begin
@@ -137,6 +133,7 @@ begin
Result.Priority := prio;
end;
{$WARN SYMBOL_PLATFORM ON}
{$ENDIF MSWINDOWS}
if DbgName <> '' then
@@ -145,10 +142,11 @@ end;
function TMycTaskFactory.CreateThread(const Proc: TProc): IMycState;
var
res: IMycSemaphore;
res: IMycLatch;
capturedProc: TProc;
begin
res := Signals.CreateSemaphore(1); // Create a semaphore that will be signaled when the proc finishes
// Create a latch that will be signaled when the proc finishes
res := TMycLatch.CreateLatch(1); // Changed to use direct static call on TMycLatch
capturedProc := Proc; // Capture Proc for the anonymous method
CreateAnonymousThread('Thread',
@@ -158,11 +156,12 @@ begin
capturedProc(); // Execute the provided procedure
finally
capturedProc := nil; // Clear the captured proc
res.Notify; // Signal completion
res.Notify; // Signal completion via the latch's Notify method
end;
end).Start;
exit(res.State); // Return the state interface of the semaphore
// Return the state interface of the latch
exit(res.State);
end;
procedure TMycTaskFactory.EnqueueJob(const Job: TProc);
@@ -230,12 +229,12 @@ begin
raise ETaskException.Create('Task factory terminated');
if not Assigned(Job) then
exit(Signals.Null); // Return a null subscriber if no job is provided
exit(TMycLatch.Null); // Already correct, uses direct static property on TMycLatch
if StartCount <= 0 then
begin
EnqueueJob(Job); // Enqueue immediately if no countdown needed
Result := Signals.Null;
Result := TMycLatch.Null; // Already correct
end
else
// Create a pending job that waits for StartCount notifications
@@ -245,34 +244,29 @@ end;
procedure TMycTaskFactory.Teardown;
var
i: Integer;
s: TSemaphore;
job: TProc; // Variable to receive popped job to ensure it's processed/discarded
s: TSemaphore; // This is System.SyncObjs.TSemaphore from FWaitSemaphores
job: TProc;
begin
HandleException; // Process any pending exception before shutdown
if TInterlocked.Exchange(FTerminated, 1) <> 0 then
exit; // Ensure teardown runs only once
// Release the work gate for each thread so they can wake up and terminate
for i := 0 to High(FWorkThreads) do
FWorkGate.Release;
// Wait for all worker threads to finish
TSpinWait.SpinUntil(
function: Boolean
begin
Result := FThreadsRunning = 0;
end);
Assert(FThreadsRunning = 0); // Verify all threads have terminated
Assert(FThreadsRunning = 0);
// Clear any remaining jobs from the work stack (these will not be executed)
repeat
job := FWorkStack.Pop();
until not Assigned(job);
// Clear and free semaphores from the wait semaphore pool
s := FWaitSemaphores.Pop;
while s <> nil do
begin
@@ -283,45 +277,40 @@ end;
procedure TMycTaskFactory.WaitFor(State: IMycState);
var
lock: TSemaphore;
lock: TSemaphore; // This is System.SyncObjs.TSemaphore
begin
// If the state is already set, we are NOT allowed to wait.
if State.IsSet then
exit;
if InWorkerThread then
raise ETaskException.Create('Waiting not allowed within tasks'); // Prevent deadlocks
raise ETaskException.Create('Waiting not allowed within tasks');
lock := FWaitSemaphores.Pop(); // Try to get a semaphore from the pool
lock := FWaitSemaphores.Pop();
if lock = nil then
lock := TSemaphore.Create(nil, 0, 1, ''); // Create new one if pool is empty (initial count 0)
lock := TSemaphore.Create(nil, 0, 1, '');
try
// Subscribe a temporary waiter that will release the lock when the state is signaled
var subscription := State.Subscribe(TMyc2TaskWait.Create(lock));
lock.Acquire; // Wait until the lock is released
lock.Acquire;
finally
// The lock is now signaled (count 0 after Acquire). Push it back to the pool for reuse.
FWaitSemaphores.Push(lock);
end;
HandleException; // Check for exceptions that might have occurred in worker threads during the wait
HandleException;
end;
procedure TMycTaskFactory.ExecuteJob;
var
job: TProc;
begin
job := FWorkStack.Pop(); // Pop a job from the stack
job := FWorkStack.Pop();
if Assigned(job) then
begin
try
job(); // Execute the job
job();
except
// If no exception has been captured yet, capture this one
if FException = nil then
FException := AcquireExceptionObject; // Store the exception object to be raised in the main thread
// Else: an exception is already pending, this one is ignored to keep the first one.
FException := AcquireExceptionObject;
end;
end;
end;
@@ -331,7 +320,7 @@ end;
constructor TMyc2PendingJob.Create(StartCountValue: Integer; OwnerTaskFactory: TMycTaskFactory; const JobProc: TProc);
begin
inherited Create;
Assert(StartCountValue > 0); // StartCount must be positive
Assert(StartCountValue > 0);
FCount := StartCountValue;
FOwner := OwnerTaskFactory;
FJob := JobProc;
@@ -341,42 +330,39 @@ function TMyc2PendingJob.Notify: Boolean;
var
newCount: Integer;
begin
newCount := TInterlocked.Decrement(FCount); // Atomically decrement the counter
// Defend against extreme underflow, though ideally FCount should not go far below zero.
newCount := TInterlocked.Decrement(FCount);
if newCount < -MaxInt div 2 then
TInterlocked.Increment(FCount);
if newCount = 0 then // If counter reaches exactly zero
if newCount = 0 then
begin
// FOwner and FJob are captured by the class instance
if Assigned(FOwner) and Assigned(FJob) then // Ensure owner and job are still valid
if Assigned(FOwner) and Assigned(FJob) then
begin
FOwner.EnqueueJob(FJob); // Enqueue the job
FJob := nil; // Clear the job reference to prevent re-enqueuing and allow ARC
FOwner.EnqueueJob(FJob);
FJob := nil;
end;
end;
Result := newCount > 0; // Returns true if further notifications are expected (count is still positive)
Result := newCount > 0;
end;
{ TMyc2TaskWait }
constructor TMyc2TaskWait.Create(SemaphoreToSignal: TSemaphore);
constructor TMyc2TaskWait.Create(SemaphoreToSignal: TSemaphore); // Parameter is System.SyncObjs.TSemaphore
begin
inherited Create;
FSemaphore := SemaphoreToSignal;
FSemaphore := SemaphoreToSignal; // Field is System.SyncObjs.TSemaphore
end;
function TMyc2TaskWait.Notify: Boolean;
var
s: TSemaphore;
s: TSemaphore; // Local var is System.SyncObjs.TSemaphore
begin
// Atomically exchange FSemaphore with nil to ensure Release is called only once
s := TInterlocked.Exchange<TSemaphore>(FSemaphore, nil);
if s <> nil then
s.Release; // Release the semaphore, unblocking the waiting thread
Result := false; // No further notifications expected from this subscriber
s.Release;
Result := false;
end;
initialization
IsMultiThread := true; // Mark the application as multi-threaded
IsMultiThread := true;
end.
Src/Myc.Signals.pas
+163 -74
View File
@@ -3,209 +3,298 @@ unit Myc.Signals;
interface
uses
System.SysUtils, Myc.Core.Notifier;
System.SysUtils, Myc.Core.Notifier; // Assuming Myc.Core.Notifier is available
type
IMycSemaphore = interface;
IMycLatch = interface; // Forward declaration for the latch interface
TMycSignal = class;
TMycSignal = class; // Base or related signal type
IMycSubscriber = interface
// Interface for an entity that can be notified by a signal or latch.
// Returns true if further notifications are expected, false otherwise.
function Notify: Boolean;
end;
TMycSubscription = record
private
FSignal: TMycSignal;
FSignal: TMycSignal; // Could also be a more general IMycSignalProvider if TMycLatch isn't a TMycSignal
FTag: TMycNotifyList<IMycSubscriber>.TTag;
public
class operator Initialize(out Dest: TMycSubscription);
class operator Finalize(var Dest: TMycSubscription);
class operator Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription);
// Setup associates the subscription with a signal and a specific tag from TMycNotifyList.
procedure Setup(ASignal: TMycSignal; ATag: TMycNotifyList<IMycSubscriber>.TTag); inline;
// Unsubscribe removes this subscription from the signal it's associated with.
procedure Unsubscribe;
end;
IMycSignal = interface
// Allows a subscriber to register for notifications.
// Returns a subscription record that manages the lifetime of the subscription.
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription;
end;
TMycSignal = class abstract( TInterfacedObject, IMycSignal )
TMycSignal = class abstract(TInterfacedObject, IMycSignal)
public
// Abstract method for subscribing to this signal.
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); virtual; abstract;
// Abstract method for unsubscribing using a tag.
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); virtual; abstract;
end;
IMycState = interface( IMycSignal )
IMycState = interface(IMycSignal)
// Represents a state that can be queried (IsSet) and subscribed to for changes.
{$region 'property access'}
function GetIsSet: Boolean;
{$endregion}
// IsSet is true if the state has been reached or the condition met.
property IsSet: Boolean read GetIsSet;
end;
IMycSemaphore = interface(IMycSubscriber)
// IMycLatch represents a synchronization primitive that acts like a gate.
// Once its internal condition is met (e.g., a count reaches zero), it becomes "set"
// (its IMycState.IsSet becomes true) and remains set.
// It can be notified (as an IMycSubscriber) to progress towards its "set" state.
IMycLatch = interface(IMycSubscriber)
{$region 'property access'}
// Provides access to the IMycState interface of the latch,
// which indicates if the latch is set and allows subscriptions to this state change.
function GetState: IMycState;
{$endregion}
property State: IMycState read GetState;
end;
TMycSemaphore = class(TMycSignal, IMycSemaphore, IMycState)
// TMycLatch implements a countdown latch.
// It is initialized with a count. Calls to its Notify method (as an IMycSubscriber)
// decrement this count. When the count reaches zero, the latch transitions to the "set"
// state (IsSet becomes true), notifies its current subscribers once, and then remains set.
TMycLatch = class(TMycSignal, IMycLatch, IMycState)
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>;
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers waiting for this latch to be set.
class var
FNull: IMycLatch;
class constructor ClassCreate;
private
[volatile] FCount: Integer;
[volatile] FCount: Integer; // The internal countdown value.
function GetState: IMycState;
function GetIsSet: Boolean;
public
// Creates the latch with an initial count.
// If ACount is 0 or less, the latch is initially set.
constructor Create(ACount: Integer);
destructor Destroy; override;
// Creates a new countdown latch initialized with the given count.
class function CreateLatch(Count: Integer): IMycLatch; static;
// IMycSignal implementation (from TMycSignal)
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; override;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); override;
function Notify: Boolean;
end;
Signals = record
strict private
class var
FNull: IMycSemaphore;
class constructor Create;
public
class function CreateSemaphore(Count: Integer): IMycSemaphore; static;
class property Null: IMycSemaphore read FNull;
// IMycSubscriber implementation for TMycLatch itself.
// Decrements the internal count. If the count reaches zero,
// registered subscribers are notified and the latch becomes permanently set.
function Notify: Boolean;
class property Null: IMycLatch read FNull;
end;
implementation
uses
System.SyncObjs;
System.SyncObjs; // For TInterlocked if used, though it wasn't in the original TMycSemaphore.Notify directly visible
procedure TMycSubscription.Setup(ASignal: TMycSignal; ATag:
TMycNotifyList<IMycSubscriber>.TTag);
{ TMycSubscription }
procedure TMycSubscription.Setup(ASignal: TMycSignal; ATag: TMycNotifyList<IMycSubscriber>.TTag);
begin
Unsubscribe;
Unsubscribe; // Ensure any previous subscription is cleared.
FSignal := ASignal;
FTag := ATag;
end;
procedure TMycSubscription.Unsubscribe;
begin
if FTag<>nil then
if FTag <> nil then // Check if currently subscribed
begin
FSignal.Unsubscribe( FTag );
FTag := nil;
Assert(Assigned(FSignal), 'FSignal is not assigned during Unsubscribe');
FSignal.Unsubscribe(FTag);
FTag := nil; // Mark as unsubscribed
end;
end;
class operator TMycSubscription.Assign(var Dest: TMycSubscription; const [ref]
Src: TMycSubscription);
class operator TMycSubscription.Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription);
begin
Dest.Setup( Src.FSignal, Src.FTag );
// This default assignment might not be what's intended if Src is a temporary.
// Proper management would involve Dest taking ownership or Src being managed.
// However, if it's just copying the record fields:
Dest.Setup(Src.FSignal, Src.FTag);
// To prevent Src from unsubscribing if it's a temporary and Dest now "owns" the subscription,
// one might consider nil'ing out Src.FTag, but that depends on usage patterns.
// Given the `const [ref] Src`, this assignment implies Dest should reflect Src.
// If Src is finalized later, it will call Unsubscribe. This might be problematic if Dest also expects to manage it.
// A robust solution for record assignment with resource management often requires more careful design
// or using interfaces/objects for the subscription itself.
// For now, keeping it simple as per original structure.
end;
class operator TMycSubscription.Initialize(out Dest: TMycSubscription);
begin
Dest.FTag := nil;
Dest.FSignal := nil; // Ensure FSignal is initialized
Dest.FTag := nil; // Initialize tag to nil, indicating no active subscription.
end;
class operator TMycSubscription.Finalize(var Dest: TMycSubscription);
begin
Dest.Unsubscribe;
Dest.Unsubscribe; // Automatically unsubscribe when the record goes out of scope.
end;
constructor TMycSemaphore.Create(ACount: Integer);
{ TMycLatch }
constructor TMycLatch.Create(ACount: Integer);
begin
inherited Create;
FCount := ACount;
FSubscribers.Create;
FCount := ACount; // Set the initial countdown value.
FSubscribers.Create; // Initialize the list of subscribers.
end;
destructor TMycSemaphore.Destroy;
{ TMycLatch }
class constructor TMycLatch.ClassCreate;
begin
FSubscribers.Destroy;
// Create1 a null latch instance that is initially (and always) set.
FNull := TMycLatch.Create(0);
end;
destructor TMycLatch.Destroy;
begin
FSubscribers.Destroy; // Clean up the subscriber list.
inherited;
end;
function TMycSemaphore.Notify: Boolean;
class function TMycLatch.CreateLatch(Count: Integer): IMycLatch;
begin
FSubscribers.Lock;
// Factory method to create a new TMycLatch instance.
if Count > 0 then
Result := TMycLatch.Create(Count)
else
Result := FNull;
end;
function TMycLatch.Notify: Boolean;
var
currentCountAfterDecrement: Integer;
shouldNotifySubscribers: Boolean;
begin
FSubscribers.Lock; // Lock to protect FCount and FSubscribers modifications/iterations
try
var n := TInterlocked.Decrement( FCount );
if n < -MaxInt div 2 then
TInterlocked.Increment( FCount );
currentCountAfterDecrement := TInterlocked.Decrement(FCount);
if n = 0 then
// Defend against extreme underflow if Notify could be called excessively.
// This helps maintain a semblance of sanity for FCount, though ideally
// it shouldn't be needed if used as a typical countdown latch.
if currentCountAfterDecrement < -MaxInt div 2 then
TInterlocked.Increment(FCount); // Try to pull it back from extreme negative.
// Notify subscribers only when the count transitions to zero.
shouldNotifySubscribers := (currentCountAfterDecrement = 0);
if shouldNotifySubscribers then
begin
FSubscribers.Notify(
function( Subscriber: IMycSubscriber ): Boolean
function(Subscriber: IMycSubscriber): Boolean
begin
// Notify each subscriber. The result of Subscriber.Notify indicates
// if that subscriber expects further notifications (which, for a latch, is typically false after the first one).
Result := Subscriber.Notify;
end );
end);
end;
Result := n > 0;
if not Result then
// A latch, once set (count <= 0), remains set.
// This Notify method itself returns true if the count is still > 0,
// indicating the latch has not yet been "set" by this Notify call.
Result := currentCountAfterDecrement > 0;
// If the latch has become set (or was already set and Notify is called again making count more negative),
// unadvise all subscribers. This makes it a one-shot notification for this set of subscribers.
if currentCountAfterDecrement <= 0 then
FSubscribers.UnadviseAll;
finally
FSubscribers.Release;
end;
end;
function TMycSemaphore.GetIsSet: Boolean;
function TMycLatch.GetIsSet: Boolean;
begin
// The latch is considered "set" if its count has reached zero or less.
Result := FCount <= 0;
end;
function TMycSemaphore.GetState: IMycState;
function TMycLatch.GetState: IMycState;
begin
exit( Self );
// TMycLatch itself implements IMycState.
exit(Self);
end;
function TMycSemaphore.Subscribe(const Subscriber: IMycSubscriber):
TMycSubscription;
function TMycLatch.Subscribe(const Subscriber: IMycSubscriber): TMycSubscription;
var
alreadySet: Boolean;
begin
if not Assigned(Subscriber) then
begin
Result.Setup(nil, nil); // Return an empty/invalid subscription
exit;
end;
Subscriber._AddRef;
// It's good practice to manage ref counts for interfaces passed around,
// especially if their lifetime is tied to the subscription.
// TMycNotifyList should handle AddRef/Release for stored subscribers if it holds interfaces.
// If direct Advise/Unadvise handles it, this explicit AddRef/Release pair might be for safety
// during the decision-making part of this method.
Subscriber._AddRef; // Manually increment ref count for safety during this method's logic
try
FSubscribers.Lock;
try
if FCount <= 0 then
Subscriber.Notify
// Check if the latch is already set.
// This uses FCount directly rather than GetIsSet to avoid re-entrancy issues if GetIsSet had complex logic.
alreadySet := (FCount <= 0);
if alreadySet then
begin
// If already set, notify the new subscriber immediately and do not add to list.
// The subscription will be effectively null/empty as it's a one-shot notification.
Result.Setup(nil, nil); // No persistent subscription needed.
Subscriber.Notify; // Notify immediately.
end
else
Result.Setup( Self, FSubscribers.Advise( Subscriber ) );
begin
// If not yet set, advise the subscriber to the list.
// The TMycSubscription record will hold the tag for later unsubscription.
Result.Setup(Self, FSubscribers.Advise(Subscriber));
end;
finally
FSubscribers.Release;
end;
finally
Subscriber._Release;
Subscriber._Release; // Release the ref count taken at the beginning of the method.
end;
end;
procedure TMycSemaphore.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
procedure TMycLatch.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
begin
if Tag=nil then
if Tag = nil then // No valid tag to unadvise.
exit;
FSubscribers.Lock;
try
FSubscribers.Unadvise( Tag );
FSubscribers.Unadvise(Tag); // Remove the subscriber associated with this tag.
finally
FSubscribers.Release;
end;
end;
class constructor Signals.Create;
begin
FNull := TMycSemaphore.Create( 0 );
end;
{ Signals }
class function Signals.CreateSemaphore(Count: Integer): IMycSemaphore;
begin
Result := TMycSemaphore.Create( Count );
end;
end.