MycLib/Src/Myc.Core.Notifier.pas

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

procedure TMycNotifyList<T>.Create;
begin
    FFirst := 1;
    FList := nil;
end;

procedure TMycNotifyList<T>.Destroy;
begin
    // Because refcounting is thread-safe, this will always be entered once after all references
    // to Self are dropped. No locking needed!
    Assert( not IsLocked );
    FFirst := FFirst and not 3;
    UnadviseAll;
end;

function TMycNotifyList<T>.Advise(const Receiver: T): TTag;
var
    Item: PItem;
begin
    Assert( IsLocked );

    if FFirst=0 then
    begin
        IInterface( FFirst ) := Receiver;
        exit( PPointer(@Receiver)^ );
    end;

    Item := AllocItem;
    Item.Receiver := Receiver;
    Item.Prev := nil;
    Item.Next := FList;
    if Item.Next<>nil then
        Item.Next.Prev := Item;

    FList := Item;

    exit( Item );
end;

procedure TMycNotifyList<T>.Lock;
begin
    repeat
        if FFirst and 1 = 0 then
        begin
            YieldProcessor;
            continue;
        end;
    until TInterlocked.BitTestAndClear( PNativeUint( @FFirst )^, 0 );

    Assert( IsLocked, 'Locking failed' );
end;

class function TMycNotifyList<T>.AllocItem: PItem;
begin
    Result := AllocMem( sizeof( TItem ) );
end;

class procedure TMycNotifyList<T>.FreeItem(Item: PItem);
begin
    FreeMem( Item, sizeof( TItem ) );
end;

function TMycNotifyList<T>.IsLocked: Boolean;
begin
    Result := FFirst and 1 = 0;
end;

procedure TMycNotifyList<T>.Notify(Func: TPredicate<T>);
var
    Item, P: PItem;
begin
    Assert( IsLocked );

    if FFirst<>0 then
        if not Func( IInterface( FFirst ) ) then
            IInterface( FFirst ) := nil;

    Item := FList;
    while Item<>nil do
    begin
        P := Item.Next;
        if not Func( Item.Receiver ) then
            Unadvise( TTag( Item ) );
        Item := P;
    end;
end;

procedure TMycNotifyList<T>.Release;
begin
    Assert( IsLocked );
    TInterlocked.Exchange( Pointer( FFirst ), Pointer( FFirst or 1 ) );
end;

procedure TMycNotifyList<T>.Unadvise(Tag: TTag);
var
    Item: PItem;
begin
    Assert( IsLocked );

    if NativeUInt(Tag) = FFirst then
    begin
        IInterface( FFirst ) := nil;
        exit;
    end;

    if FList = nil then
        exit;

    Item := PItem( Tag );

    if Item = FList then
        FList := Item.Next;

    if Item.Prev<>nil then
        Item.Prev.Next := Item.Next;
    if Item.Next<>nil then
        Item.Next.Prev := Item.Prev;

    Item.Receiver := nil;

    FreeItem( Item );
end;

procedure TMycNotifyList<T>.UnadviseAll;
begin
    Assert( IsLocked );

    IInterface( FFirst ) := nil;
    while FList<>nil do
        Unadvise( TTag( FList ) );
end;

end.