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

Code formatting

Browse Source
This commit is contained in:
Michael Schimmel
2025-06-05 10:26:28 +02:00
parent f033ef2c0f
commit 6bed68748d
22 changed files with 1884 additions and 1743 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Core.Notifier.pas
+53 -50
View File
@@ -3,7 +3,8 @@ unit Myc.Core.Notifier;
interface
uses
System.SysUtils, System.SyncObjs;
System.SysUtils,
System.SyncObjs;
type
// Low-level implementation for thread-safe multicast events.
@@ -13,35 +14,37 @@ type
// `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.
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;
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.
// 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.
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.
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.
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.
procedure Notify(
Func: TPredicate<T>
); // Iterates through registered receivers and invokes the predicate; removes receiver if predicate returns false.
end;
implementation
@@ -56,7 +59,7 @@ 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 );
Assert(not IsLocked);
FFirst := FFirst and not 3;
UnadviseAll;
end;
@@ -65,24 +68,24 @@ function TMycNotifyList<T>.Advise(const Receiver: T): TTag;
var
Item: PItem;
begin
Assert( IsLocked );
Assert(IsLocked);
if FFirst=0 then
if FFirst = 0 then
begin
IInterface( FFirst ) := Receiver;
exit( PPointer(@Receiver)^ );
IInterface(FFirst) := Receiver;
exit(PPointer(@Receiver)^);
end;
Item := AllocItem;
Item.Receiver := Receiver;
Item.Prev := nil;
Item.Next := FList;
if Item.Next<>nil then
if Item.Next <> nil then
Item.Next.Prev := Item;
FList := Item;
exit( Item );
exit(Item);
end;
procedure TMycNotifyList<T>.Lock;
@@ -93,19 +96,19 @@ begin
YieldProcessor;
continue;
end;
until TInterlocked.BitTestAndClear( PNativeUint( @FFirst )^, 0 );
until TInterlocked.BitTestAndClear(PNativeUint(@FFirst)^, 0);
Assert( IsLocked, 'Locking failed' );
Assert(IsLocked, 'Locking failed');
end;
class function TMycNotifyList<T>.AllocItem: PItem;
begin
Result := AllocMem( sizeof( TItem ) );
Result := AllocMem(sizeof(TItem));
end;
class procedure TMycNotifyList<T>.FreeItem(Item: PItem);
begin
FreeMem( Item, sizeof( TItem ) );
FreeMem(Item, sizeof(TItem));
end;
function TMycNotifyList<T>.IsLocked: Boolean;
@@ -117,65 +120,65 @@ procedure TMycNotifyList<T>.Notify(Func: TPredicate<T>);
var
Item, P: PItem;
begin
Assert( IsLocked );
Assert(IsLocked);
if FFirst<>0 then
if not Func( IInterface( FFirst ) ) then
IInterface( FFirst ) := nil;
if FFirst <> 0 then
if not Func(IInterface(FFirst)) then
IInterface(FFirst) := nil;
Item := FList;
while Item<>nil do
while Item <> nil do
begin
P := Item.Next;
if not Func( Item.Receiver ) then
Unadvise( TTag( Item ) );
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 ) );
Assert(IsLocked);
TInterlocked.Exchange(Pointer(FFirst), Pointer(FFirst or 1));
end;
procedure TMycNotifyList<T>.Unadvise(Tag: TTag);
var
Item: PItem;
begin
Assert( IsLocked );
Assert(IsLocked);
if NativeUInt(Tag) = FFirst then
begin
IInterface( FFirst ) := nil;
IInterface(FFirst) := nil;
exit;
end;
if FList = nil then
exit;
Item := PItem( Tag );
Item := PItem(Tag);
if Item = FList then
FList := Item.Next;
if Item.Prev<>nil then
if Item.Prev <> nil then
Item.Prev.Next := Item.Next;
if Item.Next<>nil then
if Item.Next <> nil then
Item.Next.Prev := Item.Prev;
Item.Receiver := nil;
FreeItem( Item );
FreeItem(Item);
end;
procedure TMycNotifyList<T>.UnadviseAll;
begin
Assert( IsLocked );
Assert(IsLocked);
IInterface( FFirst ) := nil;
while FList<>nil do
Unadvise( TTag( FList ) );
IInterface(FFirst) := nil;
while FList <> nil do
Unadvise(TTag(FList));
end;
end.