diff --git a/Src/Myc.Core.Notifier.pas b/Src/Myc.Core.Notifier.pas index d4e83fc..2fcbf7c 100644 --- a/Src/Myc.Core.Notifier.pas +++ b/Src/Myc.Core.Notifier.pas @@ -24,7 +24,6 @@ type 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. @@ -37,7 +36,7 @@ type 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 Unadvise(Tag: TTag); 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. @@ -51,8 +50,7 @@ implementation procedure TMycNotifyList.Create; begin - FFirst := 1; - FList := nil; + NativeUInt(FList) := 1; end; procedure TMycNotifyList.Destroy; @@ -60,7 +58,7 @@ 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; + NativeUInt(FList) := NativeUInt(FList) and not 1; UnadviseAll; end; @@ -70,11 +68,8 @@ var begin Assert(IsLocked); - if FFirst = 0 then - begin - IInterface(FFirst) := Receiver; - exit(PPointer(@Receiver)^); - end; + if not Assigned(Receiver) then + exit( nil ); Item := AllocItem; Item.Receiver := Receiver; @@ -90,13 +85,8 @@ end; procedure TMycNotifyList.Lock; begin - repeat - if FFirst and 1 = 0 then - begin - YieldProcessor; - continue; - end; - until TInterlocked.BitTestAndClear(PNativeUint(@FFirst)^, 0); + while not TInterlocked.BitTestAndClear(NativeUint(FList), 0) do + YieldProcessor; Assert(IsLocked, 'Locking failed'); end; @@ -113,33 +103,77 @@ end; function TMycNotifyList.IsLocked: Boolean; begin - Result := FFirst and 1 = 0; + Result := NativeUInt(FList) and 1 = 0; end; procedure TMycNotifyList.Notify(Func: TPredicate); var - Item, P: PItem; + Item: PItem; + Last: PItem; + tmp: PItem; begin Assert(IsLocked); - if FFirst <> 0 then - if not Func(IInterface(FFirst)) then - IInterface(FFirst) := nil; - + tmp := nil; + Last := nil; Item := FList; - while Item <> nil do + while (Item <> nil) and Assigned(Item.Receiver) do begin - P := Item.Next; if not Func(Item.Receiver) then - Unadvise(TTag(Item)); - Item := P; + begin + // Receiver wants no more notifications, detach it + 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; + + // release the receiver + Item.Receiver := nil; + + // and save the list item in a tmp list for later use + var nxt := Item.Next; + Item.Next := tmp; + tmp := Item; + Item := nxt; + end + else + begin + Last := Item; + Item := Last.Next; + end; + end; + + // Append all detached items at end of the list. We can't simply free them, because the subscription is owned by the client. + while tmp <> nil do + begin + Item := tmp; + tmp := Item.Next; + + if Last = nil then + begin + Item.Prev := nil; + Item.Next := FList; + FList := Item; + end + else + begin + Item.Prev := Last; + Item.Next := Last.Next; + if Item.Prev <> nil then + Item.Prev.Next := Item; + end; + if Item.Next <> nil then + Item.Next.Prev := Item; end; end; procedure TMycNotifyList.Release; begin Assert(IsLocked); - TInterlocked.Exchange(Pointer(FFirst), Pointer(FFirst or 1)); + TInterlocked.Exchange(NativeUint(FList), NativeUint(FList) or 1); end; procedure TMycNotifyList.Unadvise(Tag: TTag); @@ -148,11 +182,19 @@ var begin Assert(IsLocked); - if NativeUInt(Tag) = FFirst then - begin - IInterface(FFirst) := nil; + if (Tag = nil) or (FList = nil) then exit; + + {$ifdef DEBUG} + Item := FList; + while Item<>nil do + begin + if Item = Tag then + break; + Item := Item.Next; end; + Assert( Item <> nil, 'Receiver not advised' ); + {$endif} if FList = nil then exit; @@ -175,8 +217,6 @@ end; procedure TMycNotifyList.UnadviseAll; begin Assert(IsLocked); - - IInterface(FFirst) := nil; while FList <> nil do Unadvise(TTag(FList)); end; diff --git a/Src/Myc.Core.Signals.pas b/Src/Myc.Core.Signals.pas index 34f77f9..bcf761a 100644 --- a/Src/Myc.Core.Signals.pas +++ b/Src/Myc.Core.Signals.pas @@ -32,7 +32,6 @@ type strict private FSubscribers: TMycNotifyList; function GetSignal: TSignal; - function GetIsSet: Boolean; public constructor Create; destructor Destroy; override; @@ -197,11 +196,6 @@ begin inherited; end; -function TMycEvent.GetIsSet: Boolean; -begin - Result := true; -end; - function TMycEvent.GetSignal: TSignal; begin Result := Self; diff --git a/Src/Myc.Signals.pas b/Src/Myc.Signals.pas index ea482d6..62b20ec 100644 --- a/Src/Myc.Signals.pas +++ b/Src/Myc.Signals.pas @@ -223,6 +223,7 @@ begin if Assigned(FSignal) then begin FSignal.Unsubscribe(FTag); + FTag := nil; FSignal := TSignal.Null; end; FTag := nil;