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

TaskFactory added

Browse Source
This commit is contained in:
Michael Schimmel
2025-05-26 00:27:09 +02:00
parent 10ef4cbcf2
commit 95fddb0181
13 changed files with 1292 additions and 251 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Core.Notifier.pas
+46 -69
View File
@@ -1,49 +1,47 @@
unit Myc.Core.Notifier;
interface
uses
System.SysUtils, System.SyncObjs;
type
// Low-level implementation for thread-safe multicast events.
// Implemented as a list referencing IInterface instances, with a locking mechanism for thread safety.
// Utilizes minimal memory.
// `Advise` adds an interface and returns a tag for constant-time removal by `Unadvise`.
// `UnadviseAll` removes all registered interfaces.
// After `Finalize` is called, the list is cleared, and no new interfaces can be added (closed state).
TMycNotifyList<T: IInterface> = record
type
TTag = Pointer; // Opaque tag used to identify a registered receiver for unsubscription.
PItem = ^TItem; // Pointer to an internal list item.
TItem = record // Internal structure for storing a receiver and list linkage.
Next, Prev: PItem; // Pointers to the next and previous items in the doubly linked list.
Receiver: T; // The registered interface instance (the event sink).
end;
strict private
FFirst: NativeUInt; // Stores the first receiver if no list is allocated, or acts as a combined lock and state field.
// Bit 0: Lock state (0 = locked, 1 = unlocked).
// Bit 1: Finalized state (0 = not finalized, 1 = finalized).
// Other bits (if not 0 and bit 0 is 1) can be a direct interface pointer if FList is nil.
FList: PItem; // Head of the linked list for additional receivers beyond the first one.
class function AllocItem: PItem; static; inline; // Allocates and initializes memory for a new TItem.
class procedure FreeItem( Item: PItem ); static; inline; // Frees memory previously allocated for a TItem.
public
procedure Create; // Initializes the notification list, preparing it for use.
procedure Destroy; // Cleans up all resources, including unadvising all receivers. Assumes no concurrent access.
function Advise(const Receiver: T): TTag; // Registers a receiver interface and returns an opaque tag for later unsubscription.
procedure Unadvise(Tag: TTag); // Unregisters a specific receiver using the tag obtained from Advise.
procedure UnadviseAll; // Unregisters all currently advised receivers.
procedure Finalize; // Clears all receivers and permanently prevents new interfaces from being added.
procedure Lock; inline; // Acquires an exclusive lock for thread-safe operations on the list.
procedure Release; inline;// Releases the previously acquired exclusive lock.
function IsLocked: Boolean; inline; // Checks if the list is currently locked by any thread.
function IsFinalized: Boolean; inline; // Checks if the list has been finalized and no longer accepts new receivers.
procedure Notify(Func: TPredicate<T>); // Iterates through registered receivers and invokes the predicate; removes receiver if predicate returns false.
interface
uses
System.SysUtils, System.SyncObjs;
type
// Low-level implementation for thread-safe multicast events.
// Implemented as a list referencing IInterface instances, with a locking mechanism for thread safety.
// Utilizes minimal memory.
// `Advise` adds an interface and returns a tag for constant-time removal by `Unadvise`.
// `UnadviseAll` removes all registered interfaces.
// After `Finalize` is called, the list is cleared, and no new interfaces can be added (closed state).
TMycNotifyList<T: IInterface> = record
type
TTag = Pointer; // Opaque tag used to identify a registered receiver for unsubscription.
PItem = ^TItem; // Pointer to an internal list item.
TItem = record // Internal structure for storing a receiver and list linkage.
Next, Prev: PItem; // Pointers to the next and previous items in the doubly linked list.
Receiver: T; // The registered interface instance (the event sink).
end;
strict private
FFirst: NativeUInt; // Stores the first receiver if no list is allocated, or acts as a combined lock and state field.
// Bit 0: Lock state (0 = locked, 1 = unlocked).
// Bit 1: Finalized state (0 = not finalized, 1 = finalized).
// Other bits (if not 0 and bit 0 is 1) can be a direct interface pointer if FList is nil.
FList: PItem; // Head of the linked list for additional receivers beyond the first one.
class function AllocItem: PItem; static; inline; // Allocates and initializes memory for a new TItem.
class procedure FreeItem( Item: PItem ); static; inline; // Frees memory previously allocated for a TItem.
public
procedure Create; // Initializes the notification list, preparing it for use.
procedure Destroy; // Cleans up all resources, including unadvising all receivers. Assumes no concurrent access.
function Advise(const Receiver: T): TTag; // Registers a receiver interface and returns an opaque tag for later unsubscription.
procedure Unadvise(Tag: TTag); // Unregisters a specific receiver using the tag obtained from Advise.
procedure UnadviseAll; // Unregisters all currently advised receivers.
procedure Lock; inline; // Acquires an exclusive lock for thread-safe operations on the list.
procedure Release; inline;// Releases the previously acquired exclusive lock.
function IsLocked: Boolean; inline; // Checks if the list is currently locked by any thread.
procedure Notify(Func: TPredicate<T>); // Iterates through registered receivers and invokes the predicate; removes receiver if predicate returns false.
end;
implementation
@@ -69,9 +67,6 @@ var
begin
Assert( IsLocked );
if IsFinalized then
exit( 0 );
if FFirst=0 then
begin
IInterface( FFirst ) := Receiver;
@@ -108,13 +103,6 @@ begin
Result := AllocMem( sizeof( TItem ) );
end;
procedure TMycNotifyList<T>.Finalize;
begin
Assert( IsLocked );
UnadviseAll;
FFirst := FFirst or 2;
end;
class procedure TMycNotifyList<T>.FreeItem(Item: PItem);
begin
FreeMem( Item, sizeof( TItem ) );
@@ -125,20 +113,12 @@ begin
Result := FFirst and 1 = 0;
end;
function TMycNotifyList<T>.IsFinalized: Boolean;
begin
Result := FFirst and 2 <> 0;
end;
procedure TMycNotifyList<T>.Notify(Func: TPredicate<T>);
var
Item, P: PItem;
begin
Assert( IsLocked );
if IsFinalized then
exit;
if FFirst<>0 then
if not Func( IInterface( FFirst ) ) then
IInterface( FFirst ) := nil;
@@ -165,15 +145,15 @@ var
begin
Assert( IsLocked );
if IsFinalized then
exit;
if NativeUInt(Tag) = FFirst then
begin
IInterface( FFirst ) := nil;
exit;
end;
if FList = nil then
exit;
Item := PItem( Tag );
if Item = FList then
@@ -193,9 +173,6 @@ procedure TMycNotifyList<T>.UnadviseAll;
begin
Assert( IsLocked );
if IsFinalized then
exit;
IInterface( FFirst ) := nil;
while FList<>nil do
Unadvise( TTag( FList ) );