* refactored uutlHandleManager

* removed uutlStored
* small improvements and bug fixing

bitSpaceUtils.lpk

@@ -11,7 +11,7 @@
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
     </CompilerOptions>
-    <Files Count="31">
+    <Files Count="30">
       <Item1>
         <Filename Value="uutlAlgorithm.pas"/>
         <UnitName Value="uutlAlgorithm"/>
@@ -117,25 +117,21 @@
         <UnitName Value="uutlXmlHelper"/>
       </Item26>
       <Item27>
-        <Filename Value="uutlStored.pas"/>
-        <UnitName Value="uutlStored"/>
-      </Item27>
-      <Item28>
         <Filename Value="uutlVariantObject.pas"/>
         <UnitName Value="uutlVariantObject"/>
-      </Item28>
-      <Item29>
+      </Item27>
+      <Item28>
         <Filename Value="uutlVariantProperty.pas"/>
         <UnitName Value="uutlVariantProperty"/>
-      </Item29>
-      <Item30>
+      </Item28>
+      <Item29>
         <Filename Value="uutlVariantEnum.pas"/>
         <UnitName Value="uutlVariantEnum"/>
-      </Item30>
-      <Item31>
+      </Item29>
+      <Item30>
         <Filename Value="uutlVariantSet.pas"/>
         <UnitName Value="uutlVariantSet"/>
-      </Item31>
+      </Item30>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

bitSpaceUtils.pas

@@ -11,8 +11,7 @@ uses
   uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlCompression, uutlEmbeddedProfiler, uutlEnumerator, 
   uutlEvent, uutlEventManager, uutlFilter, uutlGenerics, uutlInterfaces, uutlKeyCodes, uutlLinq, uutlListBase, 
   uutlLogger, uutlMCF, uutlObservable, uutlSScanf, uutlStreamHelper, uutlSyncObjs, uutlThreads, uutlTypes, 
-  uutlXmlHelper, uutlStored, uutlVariantObject, uutlVariantProperty, uutlVariantEnum, uutlVariantSet, 
-  LazarusPackageIntf;
+  uutlXmlHelper, uutlVariantObject, uutlVariantProperty, uutlVariantEnum, uutlVariantSet, LazarusPackageIntf;
 
 implementation
 

tests/tests.lpi

@@ -33,7 +33,7 @@
         <PackageName Value="FCL"/>
       </Item3>
     </RequiredPackages>
-    <Units Count="40">
+    <Units Count="41">
       <Unit0>
         <Filename Value="tests.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -194,6 +194,10 @@
         <Filename Value="uutlVariantSetTest.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit39>
+      <Unit40>
+        <Filename Value="uutlHandleManagerTests.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit40>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

tests/tests.lpr

@@ -17,7 +17,7 @@ uses
   // units unter test
   uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlEnumerator, uutlFilter, uutlGenerics, uutlInterfaces,
   uutlLinq, uutlListBase, uutlLogger, uutlStreamHelper, uutlSyncObjs, uutlTypes, uutlXmlHelper, uutlObservable,
-  uutlSetHelperTests, uutlVariantEnumTest, uutlVariantSetTest;
+  uutlSetHelperTests, uutlVariantEnumTest, uutlVariantSetTest, uutlHandleManagerTests;
 
 {$R *.res}
 

tests/uutlHandleManagerTests.pas

@@ -0,0 +1,181 @@
+unit uutlHandleManagerTests;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, TestFramework,
+  uutlGenerics;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TStringHandleManager = specialize TutlHandleManager<String>;
+  TutlHandleManagerTests = class(TTestCase)
+  private
+    fManager: TStringHandleManager;
+
+  public
+    procedure SetUp; override;
+    procedure TearDown; override;
+
+  published
+    procedure Add;
+    procedure GetValue;
+    procedure SetValue;
+    procedure ComplexAddAndRemove;
+    procedure Enumerate;
+  end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlHandleManagerTests////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManagerTests.SetUp;
+begin
+  inherited SetUp;
+  fManager := TStringHandleManager.Create(true);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManagerTests.TearDown;
+begin
+  FreeAndNil(fManager);
+  inherited TearDown;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManagerTests.Add;
+var
+  h: TutlHandle;
+begin
+  h := fManager.Add(0, 0, 'test');
+  AssertEquals($0000000100000000, h);
+
+  h := fManager.Add(1, 0, 'test');
+  AssertEquals($0001000100000001, h);
+
+  h := fManager.Add(2, 0, 'test');
+  AssertEquals($0002000100000002, h);
+
+  h := fManager.Add(0, 1, 'test');
+  AssertEquals($0100000100000000, h);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManagerTests.GetValue;
+var
+  h: TutlHandle;
+  s: String;
+  b: Boolean;
+begin
+  h := fManager.Add(0, 0, 'test');
+  b := fManager.TryGetValue(h, s);
+  AssertTrue  (b);
+  AssertEquals('test', s);
+
+  b := fManager.TryGetValue(123, s);
+  AssertFalse(b);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManagerTests.SetValue;
+var
+  b: Boolean;
+  s: String;
+begin
+  b := fManager.TrySetValue($0000000100000010, 'test');
+  AssertTrue(b);
+
+  b := fManager.TryGetValue($0000000100000010, s);
+  AssertTrue  (b);
+  AssertEquals('test', s);
+
+  b := fManager.TrySetValue($0000000100000010, 'hello');
+  AssertTrue(b);
+
+  b := fManager.TryGetValue($0000000100000010, s);
+  AssertTrue  (b);
+  AssertEquals('hello', s);
+
+  b := fManager.TrySetValue($0000000200000010, 'blubb');
+  AssertFalse(b);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManagerTests.ComplexAddAndRemove;
+var
+  h1, h2, h3, h4, h5: TutlHandle;
+  b: Boolean;
+begin
+  h1 := fManager.Add(0, 0, '1');
+  AssertEquals($0000000100000000, h1);
+
+  h2 := fManager.Add(0, 0, '2');
+  AssertEquals($0000000100000001, h2);
+
+  h3 := fManager.Add(0, 0, '3');
+  AssertEquals($0000000100000002, h3);
+
+  h4 := fManager.Add(0, 0, '4');
+  AssertEquals($0000000100000003, h4);
+
+  h5 := fManager.Add(0, 0, '5');
+  AssertEquals($0000000100000004, h5);
+
+  b := fManager.Remove(h2);
+  AssertTrue(b);
+
+  h2 := fManager.Add(0, 0, '12');
+  AssertEquals($0000000200000001, h2);
+
+  b := fManager.Remove(h4);
+  AssertTrue(b);
+
+  b := fManager.Remove(h3);
+  AssertTrue(b);
+
+  h3 := fManager.Add(0, 0, '13');
+  AssertEquals($0000000200000002, h3);
+
+  h4 := fManager.Add(0, 0, '14');
+  AssertEquals($0000000200000003, h4);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManagerTests.Enumerate;
+var
+  h, h1, h2, h3: TutlHandle;
+  b: Boolean;
+  e: TStringHandleManager.IEnumerator;
+begin
+  e := fManager.GetEnumerator;
+
+  h1 := fManager.Add(0, 0, '1');
+  h2 := fManager.Add(0, 0, '2');
+  h3 := fManager.Add(0, 0, '3');
+
+  b := e.MoveNext;
+  AssertTrue(b);
+  h := e.Current;
+  AssertTrue(h1 = h);
+
+  b := e.MoveNext;
+  AssertTrue(b);
+  h := e.Current;
+  AssertTrue(h2 = h);
+
+  b := e.MoveNext;
+  AssertTrue(b);
+  h := e.Current;
+  AssertTrue(h3 = h);
+
+  b := e.MoveNext;
+  AssertFalse(b);
+end;
+
+initialization
+  RegisterTest(TutlHandleManagerTests.Suite);
+end.
+

tests/uutlObservableHashSetTests.pas

@@ -19,7 +19,7 @@ type
     fEventArgs: TEventArgList;
     fEventListener: IutlEventListener;
 
-    procedure EventHandler(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+    procedure EventHandler(aSender: TObject; aEventArgs: IutlEventArgs);
 
   public
     procedure SetUp; override;
@@ -37,7 +37,7 @@ implementation
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 //TutlObservableHashSetTests////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableHashSetTests.EventHandler(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+procedure TutlObservableHashSetTests.EventHandler(aSender: TObject; aEventArgs: IutlEventArgs);
 begin
   if fCaptureEvents then
     fEventArgs.Add(aEventArgs);

tests/uutlObservableListTests.pas

@@ -19,7 +19,7 @@ type
     fEventArgs: TEventArgList;
     fEventListener: IutlEventListener;
 
-    procedure EventHandler(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+    procedure EventHandler(aSender: TObject; aEventArgs: IutlEventArgs);
 
   public
     procedure SetUp; override;
@@ -37,7 +37,7 @@ implementation
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 //TutlObservableListTests///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableListTests.EventHandler(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+procedure TutlObservableListTests.EventHandler(aSender: TObject; aEventArgs: IutlEventArgs);
 begin
   if fCaptureEvents then
     fEventArgs.Add(aEventArgs);

tests/uutlObservableMapTests.pas

@@ -19,7 +19,7 @@ type
     fEventArgs: TEventArgList;
     fEventListener: IutlEventListener;
 
-    procedure EventHandler(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+    procedure EventHandler(aSender: TObject; aEventArgs: IutlEventArgs);
 
   public
     procedure SetUp; override;
@@ -37,7 +37,7 @@ implementation
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 //TutlObservableMapTests////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableMapTests.EventHandler(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+procedure TutlObservableMapTests.EventHandler(aSender: TObject; aEventArgs: IutlEventArgs);
 begin
   if fCaptureEvents then
     fEventArgs.Add(aEventArgs);
@@ -154,9 +154,15 @@ begin
 
   fMap.Clear;
 
-  AssertEquals(1, fEventArgs.Count);
+  AssertEquals(4, fEventArgs.Count);
   AssertTrue  (Supports(fEventArgs[0], TutlObservableEventArgs, ea));
   AssertTrue  (oetClear = ea.EventType);
+  AssertTrue  (Supports(fEventArgs[1], TutlObservableEventArgs, ea));
+  AssertTrue  (oetRemove = ea.EventType);
+  AssertTrue  (Supports(fEventArgs[2], TutlObservableEventArgs, ea));
+  AssertTrue  (oetRemove = ea.EventType);
+  AssertTrue  (Supports(fEventArgs[3], TutlObservableEventArgs, ea));
+  AssertTrue  (oetRemove = ea.EventType);
 end;
 
 initialization

uutlCommon.pas

@@ -24,7 +24,12 @@ type
     property AutoFree: Boolean read fAutoFree write fAutoFree;
     property RefCount: LongInt read fRefCount;
 
+    procedure AfterConstruction; override;
+
     constructor Create;
+
+  public
+    class function NewInstance: TObject; override;
   end;
   TutlInterfaceNoRefCount = TutlInterfacedObject;
 
@@ -61,6 +66,7 @@ type
   end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  EInternal = class(Exception);
   EOutOfRangeException = class(Exception)
   private
     fMin: Integer;
@@ -92,6 +98,7 @@ function  GetPlatformIdentitfier(): String;
 function  utlRateLimited    (const Reference: QWord; const Interval: QWord): boolean;
 function  utlFinalizeObject (var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean): Boolean;
 function  utlFilterBuilder  (): IutlFilterBuilder;
+function  utlBitCount       (const aValue: DWord): Integer;
 
 implementation
 
@@ -303,6 +310,16 @@ begin
   result := TFilterBuilderImpl.Create;
 end;
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function utlBitCount(const aValue: DWord): Integer;
+var
+  t: DWord;
+begin
+  t := aValue - ((aValue shr 1) and &33333333333)
+              - ((aValue shr 2) and &11111111111);
+  result := ((t + (t shr 3)) and &30707070707) mod 63;
+end;
+
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 //TutlInterfacedObject///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -317,23 +334,37 @@ end;
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 function TutlInterfacedObject._AddRef: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
-  result := InterLockedIncrement(fRefCount);
+  _AddRef := interlockedincrement(fRefCount);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 function TutlInterfacedObject._Release: longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
-  result := InterLockedDecrement(fRefCount);
-  if (result = 0) and fAutoFree then
+  _Release := InterLockedDecrement(fRefCount);
+  if (_Release = 0) and fAutoFree then
     Destroy;
 end;
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlInterfacedObject.AfterConstruction;
+begin
+  inherited AfterConstruction;
+  InterLockedDecrement(fRefCount);
+end;
+
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 constructor TutlInterfacedObject.Create;
 begin
   inherited Create;
   fAutoFree := false;
-  fRefCount := 0;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TutlInterfacedObject.NewInstance: TObject;
+begin
+  result := inherited NewInstance;
+  if Assigned(result) then
+    TutlInterfacedObject(result).fRefCount := 1;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

uutlEvent.pas

@@ -17,11 +17,11 @@ type
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   IutlEventListener = interface(IUnknown)
   ['{BC45E26B-96F7-4151-87F1-C330C8C668E5}']
-    procedure DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+    procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
   end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlEventHandler = procedure (constref aSender: TObject; constref aEventArgs: IutlEventArgs) of object;
+  TutlEventHandler = procedure (aSender: TObject; aEventArgs: IutlEventArgs) of object;
   TutlEventArgs = class(TutlInterfacedObject, IutlEventArgs)
   public
     constructor Create;
@@ -30,8 +30,8 @@ type
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   IutlObservable = interface(IUnknown)
     ['{C54BD844-8273-4ACF-90C5-05DACF4359AF}']
-    procedure RegisterEventListener  (constref aListener: IutlEventListener);
-    procedure UnregisterEventListener(constref aListener: IutlEventListener);
+    procedure RegisterEventListener  (aListener: IutlEventListener);
+    procedure UnregisterEventListener(aListener: IutlEventListener);
   end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -49,12 +49,12 @@ type
   TutlNotifyEventList = specialize TutlEventList<TNotifyEvent>;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlEventHandlerList = class(
+  TutlEventListenerList = class(
     specialize TutlEventList<TutlEventHandler>
     , IutlEventListener)
 
   public { IutlEventListener }
-    procedure DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+    procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
 
   public
     constructor Create;
@@ -63,7 +63,8 @@ type
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   TutlEventListenerSet = class(
     specialize TutlCustomHashSet<IutlEventListener>
-    , IutlEventListener)
+    , IutlEventListener
+    , IutlObservable)
 
   private type
     TComparer = class(TInterfacedObject, IComparer)
@@ -73,7 +74,11 @@ type
     end;
 
   public { IutlEventListener }
-    procedure DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+    procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
+
+  public { IutlObservable }
+    procedure RegisterEventListener  (aListener: IutlEventListener);
+    procedure UnregisterEventListener(aListener: IutlEventListener);
 
   public
     constructor Create; reintroduce;
@@ -88,7 +93,7 @@ type
     fHandler: TutlEventHandler;
 
   public { IEventListener }
-    procedure DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+    procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
 
   public
     constructor Create(const aHandler: TutlEventHandler);
@@ -114,7 +119,7 @@ type
     function PopEventPair(out aPair: TEventPair): Boolean;
 
   public { IEventListener }
-    procedure DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+    procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
 
   public
     procedure DispatchEvents;
@@ -169,9 +174,9 @@ begin
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlEventHandlerList///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlEventListenerList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEventHandlerList.DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+procedure TutlEventListenerList.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
 var
   e: TutlEventHandler;
 begin
@@ -180,7 +185,7 @@ begin
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlEventHandlerList.Create;
+constructor TutlEventListenerList.Create;
 begin
   inherited Create;
   AutoFree := true;
@@ -208,7 +213,7 @@ end;
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 //TutlEventListenerSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEventListenerSet.DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+procedure TutlEventListenerSet.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
 var
   e: IutlEventListener;
 begin
@@ -216,6 +221,18 @@ begin
     e.DispatchEvent(aSender, aEventArgs);
 end;
 
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEventListenerSet.RegisterEventListener(aListener: IutlEventListener);
+begin
+  Add(aListener);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlEventListenerSet.UnregisterEventListener(aListener: IutlEventListener);
+begin
+  Remove(aListener);
+end;
+
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 constructor TutlEventListenerSet.Create;
 begin
@@ -225,7 +242,7 @@ end;
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 //TutlEventListenerCallback//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEventListenerCallback.DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+procedure TutlEventListenerCallback.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
 begin
   fHandler(aSender, aEventArgs);
 end;
@@ -266,7 +283,7 @@ begin
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlEventListenerAsync.DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+procedure TutlEventListenerAsync.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
 var
   p: TEventPair;
 begin

uutlEventManager.pas

@@ -10,7 +10,7 @@ interface
 
 uses
   Classes, SysUtils, Controls,
-  uutlEvent;
+  uutlEvent, uutlCommon;
 
 type
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -110,7 +110,10 @@ type
   end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlWinControlEventManager = class(TutlEventListenerSet)
+  TutlWinControlEventManager = class(
+    TutlInterfacedObject
+    , IutlObservable)
+
   public const
     EVENT_MOUSE_DOWN        =  0;
     EVENT_MOUSE_UP          =  1;
@@ -186,6 +189,7 @@ type
     fKeyboard: TKeyboardState;
     fMouse: TMouseState;
     fWindow: TWindowState;
+    fEventListener: TutlEventListenerSet;
 
     procedure HandlerMouseDown  (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
     procedure HandlerMouseUp    (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
@@ -204,7 +208,8 @@ type
     procedure HandlerDeactivate (Sender: TObject);
 
   protected
-    procedure RecordEvent(constref aEventArgs: IutlEventArgs); virtual;
+    procedure RecordEvent(aEventArgs: IutlEventArgs); virtual;
+    procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
 
     function CreateMouseEventArgs(
       aControl: TControl;
@@ -226,20 +231,26 @@ type
       aControl: TControl;
       aType: TutlEventType): IutlEventArgs; virtual;
 
+  public { IutlObservable }
+    procedure RegisterEventListener  (aListener: IutlEventListener);
+    procedure UnregisterEventListener(aListener: IutlEventListener);
+
   public
     property Keyboard: TKeyboardState read fKeyboard;
     property Mouse:    TMouseState    read fMouse;
     property Window:   TWindowState   read fWindow;
 
-    procedure DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
-    procedure AttachEvents (const aControl: TWinControl; const aTypes: TutlEventTypes);
+    procedure AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes);
+
+    constructor Create;
+    destructor Destroy; override;
   end;
 
 implementation
 
 uses
   LCLIntf, Forms,
-  uutlKeyCodes, uutlCommon;
+  uutlKeyCodes;
 
 type
   TWinControlVisibilityClass = class(TWinControl)
@@ -416,7 +427,7 @@ begin
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlWinControlEventManager.RecordEvent(constref aEventArgs: IutlEventArgs);
+procedure TutlWinControlEventManager.RecordEvent(aEventArgs: IutlEventArgs);
 var
   mea: TutlMouseEventArgs;
   kea: TutlKeyEventArgs;
@@ -491,6 +502,13 @@ begin
   end;
 end;
 
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlWinControlEventManager.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
+begin
+  RecordEvent(aEventArgs);
+  fEventListener.DispatchEvent(aSender, aEventArgs);
+end;
+
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 function TutlWinControlEventManager.CreateMouseEventArgs(
   aControl: TControl;
@@ -552,10 +570,17 @@ begin
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlWinControlEventManager.DispatchEvent(constref aSender: TObject; constref aEventArgs: IutlEventArgs);
+procedure TutlWinControlEventManager.RegisterEventListener(aListener: IutlEventListener);
 begin
-  RecordEvent(aEventArgs);
-  inherited DispatchEvent(aSender, aEventArgs);
+  if Assigned(fEventListener) then
+    fEventListener.Add(aListener);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlWinControlEventManager.UnregisterEventListener(aListener: IutlEventListener);
+begin
+  if Assigned(fEventListener) then
+    fEventListener.Remove(aListener);
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -595,5 +620,19 @@ begin
   end;
 end;
 
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlWinControlEventManager.Create;
+begin
+  inherited Create;
+  fEventListener := TutlEventListenerSet.Create;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TutlWinControlEventManager.Destroy;
+begin
+  FreeAndNil(fEventListener);
+  inherited Destroy;
+end;
+
 end.
 

uutlGenerics.pas

@@ -1,6 +1,7 @@
 unit uutlGenerics;
 
 {$mode objfpc}{$H+}
+{$modeswitch advancedrecords}
 
 interface
 
@@ -198,7 +199,7 @@ type
     function  Extract     (const aItem: T; const aDefault: T): T; overload;
     function  Remove      (const aItem: T): Integer;
 
-    constructor Create    (const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
+    constructor Create    (aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
     destructor Destroy; override;
   end;
 
@@ -241,7 +242,7 @@ type
     function  Remove    (constref aItem: T): Boolean;
     procedure Delete    (const aIndex: Integer);
 
-    constructor Create  (const aComparer: IComparer; const aOwnsItems: Boolean);
+    constructor Create  (aComparer: IComparer; const aOwnsItems: Boolean);
     destructor Destroy; override;
   end;
 
@@ -287,7 +288,7 @@ type
       procedure Release(var aItem: TKeyValuePair; const aFreeItem: Boolean); override;
 
     public
-      constructor Create(const aOwner: TutlCustomMap; const aComparer: IComparer);
+      constructor Create(const aOwner: TutlCustomMap; aComparer: IComparer);
     end;
 
     ////////////////////////////////////////////////////////////////////////////////////////////////
@@ -479,7 +480,10 @@ type
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   TutlHandle = QWord;
-  generic TutlHandleManager<T> = class(TObject)
+  generic TutlHandleManager<T> = class(
+    TutlInterfacedObject
+    , specialize IutlEnumerable<TutlHandle>)
+
   private type
     THandleData = packed record
       case Integer of
@@ -488,47 +492,124 @@ type
            );
 
         1: (
-              Index: Cardinal;        //  0..31
-              Counter: Word;          // 32..47
-              Identifier: Word        // 48..63
+              Index: Cardinal;        //  0..31 index in data array (unique for each priority)
+              Counter: Word;          // 32..47 reusage counter
+              TypeID: Byte;           // 48..55 Stored Data Type
+              Priority: Byte;         // 56..63 Priority to share handles between multiple systems
            );
     end;
 
-    THandleEntry = bitpacked record
-      Data: T;
-      NextFreeIndex: Cardinal;        //  0..31
-      Counter: Word;                  // 32..47
-      IsActive: Boolean;              // 48
-      __reserved: 0..((1 shl 15)-1);  // 49..63
+    TIndex = Cardinal;
+    TEntryStatus = byte;
+    PHandleEntry = ^THandleEntry;
+    THandleEntry = packed record
+      Next: TIndex;                   //  0..31 next used/free item
+      Prev: TIndex;                   // 32..63 prev used/free item
+      Counter: Word;                  // 64..79 current counter value
+      Status: TEntryStatus;           // 80..87 item status
+      TypeID: Byte;                   // 88..95 type id
+      Data: T;                        //        actual data
+    end;
+
+    THandleEntries = array of THandleEntry;
+    PPriorityItem = ^TPriorityItem;
+    TPriorityItem = packed record
+      FirstFree: TIndex;
+      LastFree: TIndex;
+      FirstUsed: TIndex;
+      LastUsed: TIndex;
+      Handles: THandleEntries;
+
+      function  GetHandleEntry(const aIndex: TIndex): PHandleEntry;
+      procedure Grow(const aSize: Integer = 0);
+
+      procedure PushFront(const aIndex: TIndex; var FirstIndex, LastIndex: TIndex; const aStatus: TEntryStatus);
+      procedure PushBack (const aIndex: TIndex; var FirstIndex, LastIndex: TIndex; const aStatus: TEntryStatus);
+      procedure Remove   (const aIndex: TIndex; var FirstIndex, LastIndex: TIndex; const aStatus: TEntryStatus);
+
+      function  PopFront(var FirstIndex, LastIndex: TIndex; const aStatus: TEntryStatus; const aCanGrow: Boolean): TIndex;
+      function  PopBack (var FirstIndex, LastIndex: TIndex; const aStatus: TEntryStatus; const aCanGrow: Boolean): TIndex;
+
+      procedure PushFrontFreeIndex(const aIndex: TIndex); inline;
+      procedure PushBackFreeIndex (const aIndex: TIndex); inline;
+      procedure PushFrontUsedIndex(const aIndex: TIndex); inline;
+      procedure PushBackUsedIndex (const aIndex: TIndex); inline;
+      procedure RemoveFreeIndex   (const aIndex: TIndex); inline;
+      procedure RemoveUsedIndex   (const aIndex: TIndex); inline;
+
+      function  PopFrontFreeIndex: TIndex;
+      function  PopBackFreeIndex: TIndex;
+      function  PopFrontUsedIndex: TIndex;
+      function  PopBackUsedIndex: TIndex;
+    end;
+
+    TPriorityItems = array of TPriorityItem;
+
+    TEnumerator = class(specialize TutlEnumerator<TutlHandle>)
+    private
+      fOwner: TutlHandleManager;
+      fPriority: Integer;
+      fIndex: TIndex;
+      fHandle: THandleEntry;
+
+    protected
+      function  InternalMoveNext: Boolean; override;
+      procedure InternalReset; override;
+
+    public
+      function  GetCurrent: TutlHandle; override;
+
+      constructor Create(const aOwner: TutlHandleManager);
     end;
 
+  private const
+    UNKNOWN_INDEX: TIndex   = high(TIndex);
+    GROW_SIZE               = 100;
+
+    ENTRY_STATUS_UNKNOWN: byte = 0;
+    ENTRY_STATUS_FREE:    byte = 1;
+    ENTRY_STATUS_USED:    byte = 2;
+
+  private
+    class function HighIndex(constref aEntries: THandleEntries): TIndex; inline;
+
+  public type
+    IEnumerator = specialize IEnumerator<TutlHandle>;
+    IutlEnumerator = specialize IutlEnumerator<TutlHandle>;
+
   private
     fCount: Integer;
-    fGrowSize: Integer;
-    fEntries: array of THandleEntry;
-    fFirstFreeIndex: Cardinal;
+    fItems: TPriorityItems;
     fOwnsValues: Boolean;
 
-    procedure Grow;
+    function GetPriorityItem(const aPriority: Byte): PPriorityItem;
 
   public
-    function  Get    (const aHandle: TutlHandle): T;
-    function  TryGet (const aHandle: TutlHandle; out aData: T): Boolean;
-    function  Add    (constref aData: T; const aIdentifier: Word): TutlHandle;
-    function  IsValid(const aHandle: TutlHandle): Boolean; inline;
-    procedure Update (const aHandle: TutlHandle; aData: T);
-    procedure Remove (const aHandle: TutlHandle);
+    function  GetValue    (const aHandle: TutlHandle): T;
+    function  TryGetValue (const aHandle: TutlHandle; out aData: T): Boolean;
+    procedure SetValue    (const aHandle: TutlHandle; aData: T);
+    function  TrySetValue (const aHandle: TutlHandle; aData: T): Boolean;
+    function  Add         (const aTypeID: Byte; const aPriority: Byte; constref aData: T): TutlHandle;
+    function  IsValid     (const aHandle: TutlHandle): Boolean; inline;
+    procedure Update      (const aHandle: TutlHandle; aData: T);
+    function  Remove      (const aHandle: TutlHandle): Boolean;
+    procedure Delete      (const aHandle: TutlHandle);
     procedure Clear;
 
+  public { IutlEnumerable }
+    function GetEnumerator: IEnumerator;
+    function GetUtlEnumerator: IutlEnumerator;
+
   public
-    property Items[const aHandle: TutlHandle]: T read Get write Update;
+    property Items[const aHandle: TutlHandle]: T read GetValue write SetValue; default;
     property Count: Integer read fCount;
 
     constructor Create(const aOwnsValues: Boolean);
     destructor  Destroy; override;
 
   public
-    class function GetIdentifier(const aHandle: TutlHandle): Word; inline;
+    class function GetTypeID  (const aHandle: TutlHandle): Byte; inline;
+    class function GetPriority(const aHandle: TutlHandle): Byte; inline;
   end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1180,7 +1261,7 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCustomList.Create(const aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
+constructor TutlCustomList.Create(aEqualityComparer: IEqualityComparer; const aOwnsItems: Boolean);
 begin
   if not Assigned(aEqualityComparer) then
     raise EArgumentNilException.Create('aEqualityComparer');
@@ -1261,7 +1342,7 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCustomHashSet.Create(const aComparer: IComparer; const aOwnsItems: Boolean);
+constructor TutlCustomHashSet.Create(aComparer: IComparer; const aOwnsItems: Boolean);
 begin
   inherited Create(aOwnsItems);
   fComparer := aComparer;
@@ -1295,7 +1376,7 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlCustomMap.THashSet.Create(const aOwner: TutlCustomMap; const aComparer: IComparer);
+constructor TutlCustomMap.THashSet.Create(const aOwner: TutlCustomMap; aComparer: IComparer);
 begin
   inherited Create(aComparer, true);
   fOwner := aOwner;
@@ -1681,69 +1762,388 @@ begin
   FreeAndNil(fHashSetImpl);
 end;
 
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlHandleManager.TPriorityItem////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TPriorityItem.GetHandleEntry(const aIndex: TIndex): PHandleEntry;
+begin
+  if (aIndex > HighIndex(Handles)) then
+    Grow;
+  result := @Handles[aIndex];
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.Grow(const aSize: Integer);
+var
+  oldIdx, newIdx, i: TIndex;
+begin
+  oldIdx := Length(Handles);
+  if (aSize = 0) then
+    SetLength(Handles, Length(Handles) + GROW_SIZE)
+  else if (Length(Handles) >= aSize) then
+    exit
+  else
+    SetLength(Handles, aSize);
+  newIdx := High(Handles);
+  for i := oldIdx to newIdx do begin
+    FillByte(Handles[i].Data, SizeOf(T), 0);
+    Handles[i].Counter := 0;
+    Handles[i].Status  := ENTRY_STATUS_UNKNOWN;
+    Handles[i].Next    := High(TIndex);
+    Handles[i].Prev    := High(TIndex);
+    PushBackFreeIndex(i);
+  end;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.PushFront(const aIndex: TIndex; var FirstIndex, LastIndex: TIndex;
+  const aStatus: TEntryStatus);
+begin
+  Assert(aIndex <= HighIndex(Handles));
+  Assert(Handles[aIndex].Status = ENTRY_STATUS_UNKNOWN);
+  if      (FirstIndex <> UNKNOWN_INDEX)
+      and (FirstIndex <= HighIndex(Handles))
+      and (Handles[FirstIndex].Status = aStatus)
+  then
+    Handles[FirstIndex].Prev := aIndex;
+  with Handles[aIndex] do begin
+    Prev   := UNKNOWN_INDEX;
+    Next   := FirstIndex;
+    Status := aStatus;
+  end;
+  FirstIndex := aIndex;
+  if (LastIndex = UNKNOWN_INDEX) then
+    LastIndex := aIndex;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.PushBack(const aIndex: TIndex; var FirstIndex, LastIndex: TIndex;
+  const aStatus: TEntryStatus);
+begin
+  Assert(aIndex <= HighIndex(Handles));
+  Assert(Handles[aIndex].Status = ENTRY_STATUS_UNKNOWN);
+  if      (LastIndex <> UNKNOWN_INDEX)
+      and (LastIndex <= HighIndex(Handles))
+      and (Handles[LastIndex].Status = aStatus)
+  then
+    Handles[LastIndex].Next := aIndex;
+  with Handles[aIndex] do begin
+    Prev   := LastIndex;
+    Next   := UNKNOWN_INDEX;
+    Status := aStatus;
+  end;
+  LastIndex := aIndex;
+  if (FirstIndex = UNKNOWN_INDEX) then
+    FirstIndex := aIndex;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.Remove(const aIndex: TIndex; var FirstIndex, LastIndex: TIndex; const aStatus: TEntryStatus);
+begin
+  Assert(aIndex <> UNKNOWN_INDEX);
+  Assert(aIndex <= HighIndex(Handles));
+  Assert(Handles[aIndex].Status = aStatus);
+  with Handles[aIndex] do begin
+    if (Prev <> UNKNOWN_INDEX) then begin
+      Assert(Prev <= HighIndex(Handles));
+      Handles[Prev].Next := Next;
+    end;
+    if (Next <> UNKNOWN_INDEX) then begin
+      Assert(Next <= HighIndex(Handles));
+      Handles[Next].Prev := Prev;
+    end;
+    if (aIndex = FirstIndex) then
+      FirstIndex := Next;
+    if (aIndex = LastIndex) then
+      LastIndex := Prev;
+    Prev   := UNKNOWN_INDEX;
+    Next   := UNKNOWN_INDEX;
+    Status := ENTRY_STATUS_UNKNOWN;
+  end;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TPriorityItem.PopFront(var FirstIndex, LastIndex: TIndex; const aStatus: TEntryStatus; const aCanGrow: Boolean): TIndex;
+begin
+  if        aCanGrow
+      and (    (FirstIndex = UNKNOWN_INDEX)
+            or (FirstIndex > HighIndex(Handles)))
+  then
+    Grow;
+  Assert(FirstIndex <> UNKNOWN_INDEX);
+  Assert(FirstIndex <= HighIndex(Handles));
+  Assert(Handles[FirstIndex].Status = aStatus);
+  result := FirstIndex;
+  with Handles[result] do begin
+    if (LastIndex = FirstIndex) then
+      LastIndex := Next;
+    FirstIndex := Next;
+    Prev       := UNKNOWN_INDEX;
+    Next       := UNKNOWN_INDEX;
+    Status     := ENTRY_STATUS_UNKNOWN;
+  end;
+  if      (FirstIndex <> UNKNOWN_INDEX)
+      and (FirstIndex <= HighIndex(Handles))
+      and (Handles[FirstIndex].Status = aStatus)
+  then
+    Handles[FirstIndex].Prev := UNKNOWN_INDEX;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TPriorityItem.PopBack(var FirstIndex, LastIndex: TIndex; const aStatus: TEntryStatus; const aCanGrow: Boolean): TIndex;
+begin
+  if        aCanGrow
+      and (    (LastIndex <> UNKNOWN_INDEX)
+            or (LastIndex <= HighIndex(Handles)))
+  then
+    Grow;
+  Assert(LastIndex <> UNKNOWN_INDEX);
+  Assert(LastIndex <= HighIndex(Handles));
+  Assert(Handles[LastIndex].Status = aStatus);
+  result := LastIndex;
+  with Handles[result] do begin
+    if (FirstIndex = LastIndex) then
+      FirstIndex := Next;
+    LastIndex := Prev;
+    Prev      := UNKNOWN_INDEX;
+    Next      := UNKNOWN_INDEX;
+    Status    := ENTRY_STATUS_UNKNOWN;
+  end;
+  if      (LastIndex <> UNKNOWN_INDEX)
+      and (LastIndex <= HighIndex(Handles))
+      and (Handles[LastIndex].Status = aStatus)
+  then
+    Handles[LastIndex].Next := UNKNOWN_INDEX;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.PushFrontFreeIndex(const aIndex: TIndex);
+begin
+  PushFront(aIndex, FirstFree, LastFree, ENTRY_STATUS_FREE);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.PushBackFreeIndex(const aIndex: TIndex);
+begin
+  PushBack(aIndex, FirstFree, LastFree, ENTRY_STATUS_FREE);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.PushFrontUsedIndex(const aIndex: TIndex);
+begin
+  PushFront(aIndex, FirstUsed, LastUsed, ENTRY_STATUS_USED);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.PushBackUsedIndex(const aIndex: TIndex);
+begin
+  PushBack(aIndex, FirstUsed, LastUsed, ENTRY_STATUS_USED);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.RemoveFreeIndex(const aIndex: TIndex);
+begin
+  Remove(aIndex, FirstFree, LastFree, ENTRY_STATUS_FREE);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TPriorityItem.RemoveUsedIndex(const aIndex: TIndex);
+begin
+  Remove(aIndex, FirstUsed, LastUsed, ENTRY_STATUS_USED);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TPriorityItem.PopFrontFreeIndex: TIndex;
+begin
+  result := PopFront(FirstFree, LastFree, ENTRY_STATUS_FREE, true);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TPriorityItem.PopBackFreeIndex: TIndex;
+begin
+  result := PopBack(FirstFree, LastFree, ENTRY_STATUS_FREE, false);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TPriorityItem.PopFrontUsedIndex: TIndex;
+begin
+  result := PopFront(FirstUsed, LastUsed, ENTRY_STATUS_USED, false);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TPriorityItem.PopBackUsedIndex: TIndex;
+begin
+  result := PopBack(FirstUsed, LastUsed, ENTRY_STATUS_USED, false);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlHandleManager.TEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TEnumerator.InternalMoveNext: Boolean;
+var
+  p: PPriorityItem;
+begin
+  repeat
+    if (fIndex = UNKNOWN_INDEX) then begin
+      inc(fPriority);
+      if (fPriority > High(fOwner.fItems)) then
+        break;
+      p      := fOwner.GetPriorityItem(fPriority);
+      fIndex := p^.FirstUsed;
+    end else begin
+      p      := fOwner.GetPriorityItem(fPriority);
+      fIndex := p^.Handles[fIndex].Next;
+      if (fIndex > HighIndex(p^.Handles)) then
+        fIndex := UNKNOWN_INDEX;
+    end;
+  until (fPriority > High(fOwner.fItems)) or (fIndex <> UNKNOWN_INDEX);
+  result := (fPriority <= High(fOwner.fItems));
+  if result then begin
+    p       := fOwner.GetPriorityItem(fPriority);
+    fHandle := p^.Handles[fIndex];
+  end else
+    FillByte(fHandle, SizeOf(fHandle), 0);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.TEnumerator.InternalReset;
+begin
+  fPriority := -1;
+  fIndex    :=  UNKNOWN_INDEX;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TEnumerator.GetCurrent: TutlHandle;
+begin
+  if (fHandle.Status <> ENTRY_STATUS_USED) then
+    raise EInvalidOperation.Create('enumerator not initialized or collection changed');
+  with THandleData(result) do begin
+    Index    := fIndex;
+    Counter  := fHandle.Counter;
+    TypeID   := fHandle.TypeID;
+    Priority := fPriority;
+  end;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TutlHandleManager.TEnumerator.Create(const aOwner: TutlHandleManager);
+begin
+  if not Assigned(aOwner) then
+    raise EArgumentNilException.Create('aOwner');
+  inherited Create;
+  fOwner := aOwner;
+  FillByte(fHandle, SizeOf(fHandle), 0);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TutlHandleManager Class Methods////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TutlHandleManager.HighIndex(constref aEntries: THandleEntries): TIndex;
+begin
+  result := TIndex(High(aEntries));
+end;
+
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 //TutlHandleManager//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlHandleManager.Grow;
+function TutlHandleManager.GetPriorityItem(const aPriority: Byte): PPriorityItem;
 var
   oldIdx, newIdx, i: Integer;
 begin
-  oldIdx := High(fEntries);
-  SetLength(fEntries, Length(fEntries) + fGrowSize);
-  newIdx := High(fEntries);
-  for i := oldIdx to newIdx do
-    fEntries[i].NextFreeIndex := i + 1;
+  if (aPriority > High(fItems)) then begin
+    oldIdx := Length(fItems);
+    SetLength(fItems, aPriority + 1);
+    newIdx := High(fItems);
+    for i := oldIdx to newIdx do with fItems[i] do begin
+      FirstFree := UNKNOWN_INDEX;
+      LastFree  := UNKNOWN_INDEX;
+      FirstUsed := UNKNOWN_INDEX;
+      LastUsed  := UNKNOWN_INDEX;
+      SetLength(Handles, 0);
+    end;
+  end;
+  result := @fItems[aPriority];
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlHandleManager.Get(const aHandle: TutlHandle): T;
+function TutlHandleManager.GetValue(const aHandle: TutlHandle): T;
 begin
-  if not TryGet(aHandle, result) then
+  if not TryGetValue(aHandle, result) then
     raise EArgumentException.Create('unknown or invalid handle');
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlHandleManager.TryGet(const aHandle: TutlHandle; out aData: T): Boolean;
+function TutlHandleManager.TryGetValue(const aHandle: TutlHandle; out aData: T): Boolean;
 begin
+  result := IsValid(aHandle);
   with THandleData(aHandle) do begin
-    result := IsValid(aHandle);
     if result
-      then aData := fEntries[Index].Data
+      then aData := fItems[Priority].Handles[Index].Data
       else FillByte(aData, SizeOf(T), 0);
   end;
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlHandleManager.Add(constref aData: T; const aIdentifier: Word): TutlHandle;
+procedure TutlHandleManager.SetValue(const aHandle: TutlHandle; aData: T);
+begin
+  if not TrySetValue(aHandle, aData) then
+    raise EArgumentException.Create('unknown or invalid handle');
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.TrySetValue(const aHandle: TutlHandle; aData: T): Boolean;
+var
+  p: PPriorityItem;
+  h: PHandleEntry;
+begin
+  if not IsValid(aHandle) then with THandleData(aHandle) do begin
+    p := GetPriorityItem(Priority);
+    p^.Grow(Index + 1);
+    h := p^.GetHandleEntry(Index);
+    result := (h^.Status = ENTRY_STATUS_FREE);
+    if result then begin
+      p^.RemoveFreeIndex  (Index);
+      p^.PushBackUsedIndex(Index);
+      h^.Counter := Counter;
+      h^.Data    := aData;
+    end;
+  end else
+    Update(aHandle, aData);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.Add(const aTypeID: Byte; const aPriority: Byte; constref aData: T): TutlHandle;
 var
+  p: PPriorityItem;
+  h: PHandleEntry;
   i: Integer;
 begin
-  i := fFirstFreeIndex;
-  if (High(fEntries) < i) then
-    Grow;
-  Assert(not fEntries[i].IsActive);
-  fFirstFreeIndex := fEntries[i].NextFreeIndex;
-  fEntries[i].NextFreeIndex := 0;
-  fEntries[i].Counter       := fEntries[i].Counter + 1;
-  if (fEntries[i].Counter = 0) then
-    fEntries[i].Counter := 1;
-  fEntries[i].IsActive  := true;
-  fEntries[i].Data      := aData;
-  inc(fCount);
+  p := GetPriorityItem(aPriority);
+  i := p^.PopFrontFreeIndex;
+       p^.PushBackUsedIndex(i);
+  h := p^.GetHandleEntry(i);
+  h^.TypeID  := aTypeID;
+  h^.Counter := h^.Counter + 1;
+  if (h^.Counter = 0) then
+    h^.Counter := 1;
+  h^.Data := aData;
   with THandleData(result) do begin
-    Index      := i;
-    Counter    := fEntries[i].Counter;
-    Identifier := aIdentifier;
+    Index    := i;
+    Counter  := h^.Counter;
+    TypeID   := aTypeID;
+    Priority := aPriority;
   end;
+  inc(fCount);
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 function TutlHandleManager.IsValid(const aHandle: TutlHandle): Boolean;
 begin
   with THandleData(aHandle) do begin
-    result :=     (fEntries[Index].Counter = Counter)
-              and (fEntries[Index].IsActive)
-              and (h.Index <= High(fEntries));
+    result :=     (Priority <= High(fItems))
+              and (Index    <= HighIndex(fItems[Priority].Handles))
+              and (fItems[Priority].Handles[Index].Counter = Counter)
+              and (fItems[Priority].Handles[Index].Status = ENTRY_STATUS_USED);
   end;
 end;
 
@@ -1753,60 +2153,88 @@ begin
   if not IsValid(aHandle) then
     raise EArgumentException.Create('unknown or invalid handle');
   with THandleData(aHandle) do begin
-    if not utlFinalizeObject(fEntries[Index].Data, TypeInfo(T), fOwnsValues) then
-      Finalize(fEntries[Index].Data);
-    fEntries[Index].Data := aData;
+    if not utlFinalizeObject(fItems[Priority].Handles[Index].Data, TypeInfo(T), fOwnsValues) then
+      Finalize(fItems[Priority].Handles[Index].Data);
+    fItems[Priority].Handles[Index].Data := aData;
   end;
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlHandleManager.Remove(const aHandle: TutlHandle);
+function TutlHandleManager.Remove(const aHandle: TutlHandle): Boolean;
+var
+  p: PPriorityItem;
 begin
-  if not IsValid(aHandle) then
-    raise EArgumentException.Create('unknown or invalid handle');
+  result := IsValid(aHandle);
+  if not result then
+    exit;
   with THandleData(aHandle) do begin
-    fEntries[Index].NextFreeIndex := fFirstFreeIndex;
-    fEntries[Index].IsActive      := false;
-    fFirstFreeIndex               := Index;
-    if not utlFinalizeObject(fEntries[Index].Data, TypeInfo(T), fOwnsValues) then
-      Finalize(fEntries[Index].Data);
+    p := GetPriorityItem(Priority);
+    p^.RemoveUsedIndex(Index);
+    p^.PushFrontFreeIndex(Index);
   end;
   dec(fCount);
 end;
 
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TutlHandleManager.Delete(const aHandle: TutlHandle);
+begin
+  if not Remove(aHandle) then
+    raise EArgumentException.Create('unknown or invalid handle');
+end;
+
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 procedure TutlHandleManager.Clear;
 var
-  i: Integer;
+  i, j: Integer;
 begin
-  for i := low(fEntries) to high(fEntries) do begin
-    if fEntries[i].IsActive and not utlFinalizeObject(fEntries[i].Data, TypeInfo(T), fOwnsValues) then
-      Finalize(fEntries[i].Data);
+  for j := low(fItems) to high(fItems) do begin
+    for i := low(fItems[j].Handles) to high(fItems[j].Handles) do begin
+      if (fItems[j].Handles[i].Status = ENTRY_STATUS_USED) and not utlFinalizeObject(fItems[j].Handles[i].Data, TypeInfo(T), fOwnsValues) then
+        Finalize(fItems[j].Handles[i].Data);
+      FillByte(fItems[j].Handles[i].Data, SizeOf(T), 0);
+    end;
+    SetLength(fItems[j].Handles, 0);
   end;
-  SetLength(fEntries, 0);
+  SetLength(fItems, 0);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.GetEnumerator: IEnumerator;
+begin
+  result := TEnumerator.Create(self);
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TutlHandleManager.GetUtlEnumerator: IutlEnumerator;
+begin
+  result := TEnumerator.Create(self);
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 constructor TutlHandleManager.Create(const aOwnsValues: Boolean);
 begin
   inherited Create;
-  fGrowSize       := 50;
-  fCount          := 0;
-  fFirstFreeIndex := 0;
-  fOwnsValues     := aOwnsValues;
+  fCount      := 0;
+  fOwnsValues := aOwnsValues;
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 destructor TutlHandleManager.Destroy;
 begin
-  Clear;
+//  Clear;
   inherited Destroy;
 end;
 
 /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlHandleManager.GetIdentifier(const aHandle: TutlHandle): Word;
+class function TutlHandleManager.GetTypeID(const aHandle: TutlHandle): Byte;
+begin
+  result := THandleData(aHandle).TypeID;
+end;
+
+/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class function TutlHandleManager.GetPriority(const aHandle: TutlHandle): Byte;
 begin
-  result := THandleData(aHandle).Identifier;
+  result := THandleData(aHandle).Priority;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

uutlObservable.pas

@@ -86,8 +86,8 @@ type
     procedure DoClear     (); virtual;
 
   public { IutlObservable }
-    procedure RegisterEventListener  (constref aListener: IutlEventListener);
-    procedure UnregisterEventListener(constref aListener: IutlEventListener);
+    procedure RegisterEventListener  (aListener: IutlEventListener);
+    procedure UnregisterEventListener(aListener: IutlEventListener);
 
   protected
     procedure SetItem(const aIndex: Integer; aValue: T); override;
@@ -146,8 +146,8 @@ type
     procedure DoClear     (); virtual;
 
   public { IutlObservable }
-    procedure RegisterEventListener  (constref aListener: IutlEventListener);
-    procedure UnregisterEventListener(constref aListener: IutlEventListener);
+    procedure RegisterEventListener  (aListener: IutlEventListener);
+    procedure UnregisterEventListener(aListener: IutlEventListener);
 
   public
     procedure Clear; override;
@@ -213,8 +213,8 @@ type
     procedure DoClear     (); virtual;
 
   public { IutlObservable }
-    procedure RegisterEventListener  (constref aListener: IutlEventListener);
-    procedure UnregisterEventListener(constref aListener: IutlEventListener);
+    procedure RegisterEventListener  (aListener: IutlEventListener);
+    procedure UnregisterEventListener(aListener: IutlEventListener);
 
   public
     constructor Create(const aHashSet: TObservableHashSet; const aOwnsKeys: Boolean; const aOwnsValues: Boolean); reintroduce;
@@ -350,13 +350,13 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableCustomList.RegisterEventListener(constref aListener: IutlEventListener);
+procedure TutlObservableCustomList.RegisterEventListener(aListener: IutlEventListener);
 begin
   fEventListener.Add(aListener);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableCustomList.UnregisterEventListener(constref aListener: IutlEventListener);
+procedure TutlObservableCustomList.UnregisterEventListener(aListener: IutlEventListener);
 begin
   fEventListener.Remove(aListener);
 end;
@@ -490,13 +490,13 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableCustomHashSet.RegisterEventListener(constref aListener: IutlEventListener);
+procedure TutlObservableCustomHashSet.RegisterEventListener(aListener: IutlEventListener);
 begin
   fEventListener.Add(aListener);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableCustomHashSet.UnregisterEventListener(constref aListener: IutlEventListener);
+procedure TutlObservableCustomHashSet.UnregisterEventListener(aListener: IutlEventListener);
 begin
   fEventListener.Remove(aListener);
 end;
@@ -659,13 +659,13 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableCustomMap.RegisterEventListener(constref aListener: IutlEventListener);
+procedure TutlObservableCustomMap.RegisterEventListener(aListener: IutlEventListener);
 begin
   fEventListener.Add(aListener);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlObservableCustomMap.UnregisterEventListener(constref aListener: IutlEventListener);
+procedure TutlObservableCustomMap.UnregisterEventListener(aListener: IutlEventListener);
 begin
   fEventListener.Remove(aListener);
 end;

uutlStored.pas

@@ -1,496 +0,0 @@
-unit uutlStored;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils,
-  DOM,
-  uutlMCF;
-
-type
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  IutlStored = interface(IUnknown)
-    ['{1AAA369A-B938-4430-AFAA-E4B5FD9D5A8D}']
-    function  GetStoredCount(): Integer;                                     // returns the number of stored values
-    function  GetStoredName (const aIndex: Integer): String;                 // returns the name of the stored value
-    function  GetStoredValue(const aIndex: Integer): Variant;                // returns the stored value as string
-    procedure SetStoredValue(const aIndex: Integer; const aValue: Variant);  // set the stored value
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  IutlStoredWriter = interface(IUnknown)
-    ['{AE592B18-DDC2-408A-BB26-DAA24E2A7C34}']
-    procedure Write(constref aObj: IutlStored; const aStream: TStream);
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  IutlStoredReader = interface(IUnknown)
-    ['{B596DCD9-5F34-45F9-82C7-790F5407E1E8}']
-    function Read(constref aObj: IutlStored; const aStream: TStream): Boolean;
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlStoredWriter = class(
-    TInterfacedObject
-    , IutlStoredWriter)
-
-  public { IutlStoredWriter }
-    procedure Write(constref aObj: IutlStored; const aStream: TStream); virtual;
-    constructor Create; virtual;
-
-  public
-    class function CreateWriter: IutlStoredWriter;
-  end;
-  TutlStoredWriterClass = class of TutlStoredWriter;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlStoredReader = class(
-    TInterfacedObject
-    , IutlStoredReader)
-
-  public { IutlStoredReader }
-    function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; virtual;
-    constructor Create; virtual;
-
-  public
-    class function CreateReader: IutlStoredReader;
-  end;
-  TutlStoredReaderClass = class of TutlStoredReader;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlStoredXmlWriter = class(TutlStoredWriter)
-  private
-    fRootName: String;
-
-  protected
-    property RootName: String read fRootName write fRootName;
-
-    procedure Write(constref aObj: IutlStored; const aElement: TDOMElement); virtual;
-
-  public
-    procedure Write(constref aObj: IutlStored; const aStream: TStream); override;
-    constructor Create; override;
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlStoredXmlReader = class(TutlStoredReader)
-  protected
-    function  CreateObject(constref aOwner: IutlStored; const aElement: TDOMElement): IutlStored; virtual;
-    procedure Read        (constref aObj: IutlStored; const aElement: TDOMElement); virtual;
-
-  public
-    function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; override;
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlStoredMcfWriter = class(TutlStoredWriter)
-  protected
-    procedure Write(constref aObj: IutlStored; const aName: String; const aParent: TutlMCFSection); virtual;
-    procedure Write(constref aObj: IutlStored; const aSection: TutlMCFSection); virtual;
-
-  public
-    procedure Write(constref aObj: IutlStored; const aStream: TStream); override;
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TutlStoredMcfReader = class(TutlStoredReader)
-  private
-    function TryFindStoredName(const aObj: IutlStored; const aName: String; out aIndex: Integer): Boolean;
-
-  protected
-    function  CreateObject(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): IutlStored; virtual;
-    function  ReadValue   (constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): Variant; virtual;
-    procedure ReadSection (constref aObj: IutlStored; const aSection: TutlMCFSection); virtual;
-
-  public
-    function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; override;
-  end;
-
-implementation
-
-uses
-  XMLWrite, XMLRead, variants,
-  uutlXmlHelper, uutlSyncObjs;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlStoredWriter//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStoredWriter.Write(constref aObj: IutlStored; const aStream: TStream);
-begin
-  // DUMMY
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlStoredWriter.Create;
-begin
-  inherited Create;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlStoredWriter.CreateWriter: IutlStoredWriter;
-begin
-  result := TutlStoredWriterClass(ClassType).Create;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlStoredReader//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStoredReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean;
-begin
-  result := false;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlStoredReader.Create;
-begin
-  inherited Create;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-class function TutlStoredReader.CreateReader: IutlStoredReader;
-begin
-  result := TutlStoredReaderClass(ClassType).Create;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlStoredXmlWriter///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStoredXmlWriter.Write(constref aObj: IutlStored; const aElement: TDOMElement);
-var
-  i, c: Integer;
-  s: DOMString;
-  v: Variant;
-  vt: TVarType;
-  intf: IUnknown;
-  lock: IutlLockable;
-  stored: IutlStored;
-begin
-  if not Supports(aObj, IutlLockable, lock) then
-    lock := nil;
-  if Assigned(lock) then
-    lock.Lock;
-  try
-    with TutlXmlHelper.Create(aElement) do begin
-      c := aObj.GetStoredCount;
-      for i := 0 to c-1 do begin
-        s  := DOMString(aObj.GetStoredName(i));
-        v  :=           aObj.GetStoredValue(i);
-        vt := VarType(v);
-        case vt of
-          varunknown: begin
-            intf := IUnknown(v);
-            if Supports(intf, IutlStored, stored) then
-              Write(stored, AppendNode(s));
-          end;
-        else
-          SetAttribString(s, String(v));
-        end;
-      end;
-    end;
-  finally
-    if Assigned(lock) then
-      lock.Unlock;
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStoredXmlWriter.Write(constref aObj: IutlStored; const aStream: TStream);
-var
-  doc: TXMLDocument;
-  root: TDOMElement;
-begin
-  doc := TXMLDocument.Create;
-  try
-    root := doc.CreateElement(DOMString(fRootName));
-    doc.AppendChild(root);
-    Write(aObj, root);
-    WriteXMLFile(doc, aStream);
-  finally
-    FreeAndNil(doc);
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TutlStoredXmlWriter.Create;
-begin
-  inherited Create;
-  fRootName := 'root';
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlStoredXmlReader///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStoredXmlReader.CreateObject(constref aOwner: IutlStored; const aElement: TDOMElement): IutlStored;
-begin
-  result := nil;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStoredXmlReader.Read(constref aObj: IutlStored; const aElement: TDOMElement);
-var
-  i, j: Integer;
-  s: DOMString;
-  v: Variant;
-  vt: TVarType;
-  intf: IUnknown;
-  stored: IutlStored;
-  attribs: TDOMNamedNodeMap;
-  attrib: TDOMNode;
-  el: TDOMElement;
-
-  function TryFindStoredName(const aName: String; out aIndex: Integer): Boolean;
-  var
-    c, i: Integer;
-  begin
-    result := true;
-    c := aObj.GetStoredCount;
-    for i := 0 to c-1 do begin
-      aIndex := i;
-      if (aObj.GetStoredName(aIndex) = aName) then
-        exit;
-    end;
-    aIndex := -1;
-    result := false;
-  end;
-
-begin
-  with TutlXmlHelper.Create(aElement) do begin
-    attribs := aElement.Attributes;
-    for i := 0 to attribs.Length-1 do begin
-      attrib := attribs.Item[i];
-      s      := attrib.NodeName;
-      v      := attrib.TextContent;
-      if not TryFindStoredName(String(s), j) then
-        continue;
-      aObj.SetStoredValue(j, v);
-    end;
-
-    for el in Nodes('') do begin
-      s      := el.NodeName;
-      v      := Unassigned;
-      stored := nil;
-      if TryFindStoredName(String(s), j) then begin
-        v  := aObj.GetStoredValue(j);
-        vt := VarType(v);
-        case vt of
-          varunknown: begin
-            intf := v;
-            if not Supports(intf, IutlStored, stored) then
-              stored := nil;
-          end;
-        else
-          raise EInvalidOperation.Create('expected ' + String(s) + ' to be an stored object');
-        end;
-      end else
-        j := -1;
-      if not Assigned(stored) then
-        stored := CreateObject(aObj, el);
-      if not Assigned(stored) then
-        continue;
-      Read(stored, el);
-      aObj.SetStoredValue(j, stored);
-    end;
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStoredXmlReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean;
-var
-  doc: TXMLDocument;
-  p: Int64;
-begin
-  p   := aStream.Position;
-  doc := TXMLDocument.Create;
-  try try
-    result := true;
-    ReadXMLFile(doc, aStream);
-    Read(aObj, (doc.FirstChild as TDOMElement));
-  except
-    result := false;
-    aStream.Position := p;
-  end;
-  finally
-    FreeAndNil(doc);
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlStoredMcfWriter///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aName: String; const aParent: TutlMCFSection);
-begin
-  Write(aObj, aParent.Section(aName));
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aSection: TutlMCFSection);
-var
-  lock: IutlLockable;
-  i, c: Integer;
-  s: String;
-  v: Variant;
-  vt: TVarType;
-  intf: IUnknown;
-  stored: IutlStored;
-begin
-  if not Supports(aObj, IutlLockable, lock) then
-    lock := nil;
-  if Assigned(lock) then
-    lock.Lock;
-  try
-    c := aObj.GetStoredCount;
-    for i := 0 to c-1 do begin
-      s  := aObj.GetStoredName (i);
-      v  := aObj.GetStoredValue(i);
-      vt := VarType(v);
-      case vt of
-        varunknown: begin
-          intf := IUnknown(v);
-          if Supports(intf, IutlStored, stored) then
-            Write(stored, s, aSection);
-        end;
-
-        varboolean:
-          aSection.SetBool(s, v);
-
-        {$IFNDEF FPUNONE}
-        varsingle,
-        vardouble:
-          aSection.SetFloat(s, v);
-        {$ENDIF}
-
-        vardecimal,
-        varshortint,
-        varbyte,
-        varword,
-        varlongword,
-        varint64,
-        varqword,
-        varsmallint,
-        varinteger:
-          aSection.SetInt(s, v);
-      else
-        aSection.SetString(s, String(v));
-      end;
-    end;
-  finally
-    if Assigned(lock) then
-      lock.Unlock;
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aStream: TStream);
-var
-  mcf: TutlMCFFile;
-begin
-  mcf := TutlMCFFile.Create(nil);
-  try
-    Write(aObj, mcf);
-    mcf.SaveToStream(aStream);
-  finally
-    FreeAndNil(mcf);
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TutlStoredMcfReader///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStoredMcfReader.TryFindStoredName(const aObj: IutlStored; const aName: String; out aIndex: Integer): Boolean;
-var
-  c, i: Integer;
-begin
-  result := true;
-  c := aObj.GetStoredCount;
-  for i := 0 to c-1 do begin
-    aIndex := i;
-    if (aObj.GetStoredName(aIndex) = aName) then
-      exit;
-  end;
-  aIndex := -1;
-  result := false;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStoredMcfReader.CreateObject(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): IutlStored;
-begin
-  result := nil;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStoredMcfReader.ReadValue(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): Variant;
-begin
-  result := aParent.GetString(aName);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TutlStoredMcfReader.ReadSection(constref aObj: IutlStored; const aSection: TutlMCFSection);
-var
-  i, j, c: Integer;
-  s: String;
-  v: Variant;
-  vt: TVarType;
-  intf: IUnknown;
-  stored: IutlStored;
-begin
-  c := aSection.ValueCount;
-  for i := 0 to c-1 do begin
-    s := aSection.ValueNameAt[i];
-    v := ReadValue(aObj, s, aSection);
-    if (VarType(v) <> varempty) and TryFindStoredName(aObj, s, j) then
-      aObj.SetStoredValue(j, v);
-  end;
-
-  c := aSection.SectionCount;
-  for i := 0 to c-1 do begin
-    s       := aSection.SectionNameAt[i];
-    v       := Unassigned;
-    stored  := nil;
-    if TryFindStoredName(aObj, s, j) then begin
-      v  := aObj.GetStoredValue(j);
-      vt := VarType(v);
-      case vt of
-        varunknown: begin
-          intf := v;
-          if not Supports(intf, IutlStored, stored) then
-            stored := nil;
-        end;
-      else
-        raise EInvalidOperation.Create('expected ' + s + ' to be an stored object');
-      end;
-    end else
-      j := -1;
-    if not Assigned(stored) then
-      stored := CreateObject(aObj, s, aSection);
-    if not Assigned(stored) then
-      continue;
-    ReadSection(stored, aSection.Section(s));
-    aObj.SetStoredValue(j, stored);
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TutlStoredMcfReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean;
-var
-  p: Int64;
-  mcf: TutlMCFFile;
-begin
-  p   := aStream.Position;
-  mcf := TutlMCFFile.Create(nil);
-  try try
-    result := true;
-    mcf.LoadFromStream(aStream);
-    ReadSection(aObj, mcf);
-  except
-    result := false;
-    aStream.Position := p;
-  end;
-  finally
-    FreeAndNil(mcf);
-  end;
-end;
-
-end.
-

uutlSyncObjs.pas

@@ -115,11 +115,10 @@ type
   public type
     ILock = specialize IutlLock<T>;
 
-  private
+  protected
     fLock: IutlLockable;
     fObject: T;
 
-
   public
     function LockedObject: T; inline;