Multi access array/list in thread-safe mode? - multithreading

Question

has for some time that I'm trying to make sure this class with threads.
Unfortunately I can not understand where to act properly.
The problem:
The saving procedures take a long time, therefore I would like to use it in a dedicated thread.
The idea is that every change in the root node, is increased the demand for saving if the thread saving is running. When the thread of saving ends if there are requests then resave still zeroing requests until there aren't requests.
But until I add nodes, there is no problem. At the moment, however, to remove a node (then all child nodes), if the thread saving is running, then creates rightly exceptions.
There is a solution or another way to save the root node at the same time making it editable.
Obviously without duplicating the entire node for each saving request?
Thank you all.
Base Class:
interface
uses
System.Classes, System.SysUtils;
type
TNode<T> = class
public type
TNodeForEachProc = reference to procedure( const ANode: TNode<T>; var ABreak: Boolean );
TNodeWriteProc = reference to procedure( const AWriter: TBinaryWriter; const AData: T );
TNodeReadProc = reference to function( const AReader: TBinaryReader ): T;
TNodeBufferedWriteProc = reference to procedure( const AWriter: TBufferedWriter; const AData: T );
TNodeBufferedReadProc = reference to function( const AReader: TBufferedReader ): T;
TNodeProgressProc = reference to procedure( const AIndex, ACount: Integer );
private
FCount: Integer;
FCapacity: Integer;
FNodes: TArray<TNode<T>>;
{$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}FParent: TNode<T>;
procedure Grow;
procedure SetCapacity( const AValue: Integer );
function Get( AIndex: Integer ): TNode<T>; inline;
function GetIndex: Integer;
function GetLevel: Integer;
procedure Adopt( const ANode: TNode<T> );
procedure Orphan;
procedure SetParent( const AValue: TNode<T> );
protected
property Nodes:TArray<TNode<T>> read FNodes;
public
Data: T;
constructor Create( const ACapacity: Integer = 0 ); overload;
constructor Create( const ANode: TNode<T> ); overload;
destructor Destroy; override;
procedure Assign( const ANode: TNode<T> );
function Add( const AData: T ): TNode<T>;
procedure Clear; inline;
function Count( const ARecursive: Boolean = False ): Integer; inline;
function Empty: Boolean; inline;
procedure Delete( const AIndex: Integer; const ACount: Integer = 1 );
function ForEach( const AProc: TNodeForEachProc; const ARecursive: Boolean = True ): Boolean;
property Index: Integer read GetIndex;
property Node[ Index: Integer ]: TNode<T> read Get; default;
property Level: Integer read GetLevel;
property Parent: TNode<T> read FParent write SetParent;
procedure SaveToStream( const AStream: TStream; const AWriterProc: TNodeWriteProc; const AProgressProc: TNodeProgressProc = nil );
procedure LoadFromStream( const AStream: TStream; const AReaderProc: TNodeReadProc; const AProgressProc: TNodeProgressProc = nil );
procedure SaveToFile( const AFileName: TFileName; const AWriterProc: TNodeBufferedWriteProc; const AProgressProc: TNodeProgressProc = nil );
procedure LoadFromFile( const AFileName: TFileName; const AReaderProc: TNodeBufferedReadProc; const AProgressProc: TNodeProgressProc = nil );
end;
implementation
{ TNode<T> }
constructor TNode<T>.Create( const ACapacity: Integer = 0 );
begin
SetCapacity( ACapacity );
end;
constructor TNode<T>.Create( const ANode: TNode<T> );
begin
Assign( ANode );
end;
destructor TNode<T>.Destroy;
begin
Clear;
Orphan;
inherited;
end;
procedure TNode<T>.Assign( const ANode: TNode<T> );
var
VIndex: Integer;
begin
Clear;
Data := ANode.Data;
FCount := ANode.FCount;
SetLength( FNodes, FCount );
for VIndex := 0 to FCount - 1 do
begin
FNodes[ VIndex ] := TNode<T>.Create;
FNodes[ VIndex ].Assign( ANode.FNodes[ VIndex ] );
end;
end;
function TNode<T>.Add( const AData: T ): TNode<T>;
begin
Result := TNode<T>.Create;
Result.Data := AData;
Adopt( Result );
end;
procedure TNode<T>.Clear;
begin
Delete( 0, FCount );
FNodes := nil;
FCount := 0;
FCapacity := 0;
end;
function TNode<T>.Count( const ARecursive: Boolean = False ): Integer;
var
VCount: Integer;
begin
if ARecursive then
begin
VCount := 0;
ForEach(
procedure( const Node: TNode<T>; var ABreak: Boolean )
begin
Inc( VCount );
end
);
Result := VCount;
end else
Result := FCount;
end;
procedure TNode<T>.Delete( const AIndex: Integer; const ACount: Integer = 1 );
var
VIndex: Integer;
begin
for VIndex := AIndex to AIndex + ACount - 1 do
begin
FNodes[ VIndex ].FParent := nil;
FNodes[ VIndex ].DisposeOf;
Dec( FCount );
end;
System.Delete( FNodes, AIndex, ACount );
end;
function TNode<T>.Empty: Boolean;
begin
Result := FCount = 0;
end;
function TNode<T>.ForEach( const AProc: TNodeForEachProc; const ARecursive: Boolean = True ): Boolean;
type
TTypeNode = TNode<T>;
var
VIndex: Integer;
VTypeNode: TTypeNode;
VBreak: Boolean;
begin
Result := True;
if Assigned( AProc ) then
for VIndex := 0 to Count - 1 do
begin
VTypeNode := FNodes[ VIndex ];
VBreak := False;
AProc( VTypeNode, VBreak );
if VBreak then
Exit( False );
if ARecursive then
if not VTypeNode.ForEach( AProc ) then
Exit( False );
end;
end;
procedure TNode<T>.Grow;
var
VDelta: Integer;
begin
if FCapacity > 64 then
VDelta := FCapacity div 4
else
if FCapacity > 8 then
VDelta := 16
else
VDelta := 4;
SetCapacity( FCapacity + VDelta );
end;
procedure TNode<T>.SetCapacity( const AValue: Integer );
begin
if AValue > FCapacity then
begin
SetLength( FNodes, AValue );
FCapacity := AValue;
end;
end;
function TNode<T>.Get( AIndex: Integer ): TNode<T>;
begin
Result := FNodes[ AIndex ];
end;
function TNode<T>.GetIndex: Integer;
var
VIndex: Integer;
begin
if FParent <> nil then
for VIndex := 0 to FParent.Count - 1 do
if FParent[ VIndex ] = Self then
Exit( VIndex );
Result := - 1;
end;
function TNode<T>.GetLevel: Integer;
begin
if FParent = nil then
Result := 0
else
Result := FParent.Level + 1;
end;
procedure TNode<T>.Adopt( const ANode: TNode<T> );
var
VIndex: Integer;
begin
ANode.FParent := Self;
VIndex := FCount;
if VIndex = FCapacity then
Grow;
FNodes[ VIndex ] := ANode;
Inc( FCount );
end;
procedure TNode<T>.Orphan;
begin
if FParent <> nil then
begin
System.Delete( FParent.FNodes, Index, 1 );
Dec( FParent.FCount );
end;
end;
procedure TNode<T>.SetParent( const AValue: TNode<T> );
begin
if FParent <> AValue then
begin
Orphan;
FParent := AValue;
if FParent <> nil then
FParent.Adopt( Self );
end;
end;
procedure TNode<T>.SaveToStream( const AStream: TStream; const AWriterProc: TNodeWriteProc; const AProgressProc: TNodeProgressProc = nil );
var
VCount: Integer;
VIndex: Integer;
VWriter: TBinaryWriter;
begin
if Assigned( AWriterProc ) then
begin
VCount := Count( True );
VIndex := 0;
VWriter := TBinaryWriter.Create( AStream );
try
VWriter.Write( VCount );
AWriterProc( VWriter, Data );
VWriter.Write( Count );
ForEach(
procedure( const ANode: TNode<T>; var ABreak: Boolean )
begin
AWriterProc( VWriter, ANode.Data );
VWriter.Write( ANode.Count );
if Assigned( AProgressProc ) then
begin
AProgressProc( VIndex, VCount );
Inc( VIndex );
end;
end
);
finally
VWriter.DisposeOf;
end;
end;
end;
procedure TNode<T>.LoadFromStream( const AStream: TStream; const AReaderProc: TNodeReadProc; const AProgressProc: TNodeProgressProc = nil );
var
VIndex: Integer;
VCount: Integer;
VReader: TBinaryReader;
VCurrentNode: TNode<T>;
VEntryNode: TNode<T>;
begin
if Assigned( AReaderProc ) then
begin
Clear;
VReader := TBinaryReader.Create( AStream );
try
VCount := VReader.ReadInteger;
Data := AReaderProc( VReader );
SetCapacity( VReader.ReadInteger );
VCurrentNode := Self;
for VIndex := 0 to VCount - 1 do
begin
VEntryNode := VCurrentNode.Add( AReaderProc( VReader ) );
VEntryNode.SetCapacity( VReader.ReadInteger );
if VEntryNode.FCapacity > 0 then
VCurrentNode := VEntryNode
else if VCurrentNode.FCount = VCurrentNode.FCapacity then
if VCurrentNode.Parent <> nil then
begin
VCurrentNode := VCurrentNode.Parent;
while ( VCurrentNode.FCount = VCurrentNode.FCapacity ) and ( VCurrentNode <> Self ) do
if VCurrentNode.Parent = nil then
VCurrentNode := Self
else
VCurrentNode := VCurrentNode.Parent;
end else
VCurrentNode := Self;
if Assigned( AProgressProc ) then
AProgressProc( VIndex, VCount );
end;
finally
VReader.DisposeOf;
end;
end;
end;
procedure TNode<T>.SaveToFile( const AFileName: TFileName; const AWriterProc: TNodeBufferedWriteProc; const AProgressProc: TNodeProgressProc = nil );
var
VCount: Integer;
VIndex: Integer;
VWriter: TBufferedWriter;
begin
if Assigned( AWriterProc ) then
begin
VCount := Count( True );
VIndex := 0;
VWriter := TBufferedWriter.Create( AFileName );
try
VWriter.WriteInteger( VCount );
AWriterProc( VWriter, Data );
VWriter.WriteInteger( Count );
if Assigned( AProgressProc ) then
begin
AProgressProc( VIndex, VCount );
Inc( VIndex );
end;
ForEach(
procedure( const ANode: TNode<T>; var ABreak: Boolean )
begin
AWriterProc( VWriter, ANode.Data );
VWriter.WriteInteger( ANode.Count );
if Assigned( AProgressProc ) then
begin
AProgressProc( VIndex, VCount );
Inc( VIndex );
end;
end
);
finally
VWriter.DisposeOf;
end;
end;
end;
procedure TNode<T>.LoadFromFile( const AFileName: TFileName; const AReaderProc: TNodeBufferedReadProc; const AProgressProc: TNodeProgressProc = nil );
var
VIndex: Integer;
VCount: Integer;
VReader: TBufferedReader;
VCurrentNode: TNode<T>;
VEntryNode: TNode<T>;
begin
if Assigned( AReaderProc ) then
begin
Clear;
VReader := TBufferedReader.Create( AFileName );
try
VCount := VReader.ReadInteger;
Data := AReaderProc( VReader );
SetCapacity( VReader.ReadInteger );
VCurrentNode := Self;
for VIndex := 0 to VCount - 1 do
begin
VEntryNode := VCurrentNode.Add( AReaderProc( VReader ) );
VEntryNode.SetCapacity( VReader.ReadInteger );
if VEntryNode.FCapacity > 0 then
VCurrentNode := VEntryNode
else if VCurrentNode.FCount = VCurrentNode.FCapacity then
if VCurrentNode.Parent <> nil then
begin
VCurrentNode := VCurrentNode.Parent;
while ( VCurrentNode.FCount = VCurrentNode.FCapacity ) and ( VCurrentNode <> Self ) do
if VCurrentNode.Parent = nil then
VCurrentNode := Self
else
VCurrentNode := VCurrentNode.Parent;
end else
VCurrentNode := Self;
if Assigned( AProgressProc ) then
AProgressProc( VIndex, VCount );
end;
finally
VReader.DisposeOf;
end;
end;
end;
end.

Answer 1

The simplest way to add 'some' multithreading to your tree is to add TCriticalSection object to its root. The point is to ensure, that saving and editing are not happening simultaneously. So, when saving thread is executing, you can work with other objects in main thread (for example, GUI works all right), you can also gain access to this tree, but when you try to edit this tree when saving is not done, main thread will wait for all saving procedures to be complete.
I would point out that adding new nodes while saving thread is executing is potentially dangerous because it requires updating lists of nodes. At this moment reallocation of memory could happen (having bigger chunk at other place to contain all the elements) and saving thread accessing list at this very moment will fail dramatically!
There are possibilities to put critical section at every node of tree so our main thread will wait only if it modifies a node which is saved exactly at this moment, you can use TThreadList instead of TArray for storing list of nodes which will allow you to add new nodes while the old ones are still saving, but this way you get thousands of possibilities to shoot yourself in the leg, only with extreme caution it will work as it should
So I think, you should start with one critical section and see if it is fast enough for your needs.

Answer 2

Finally, thanks to your suggestions, here is the best I could do.
Unfortunately, slow, and with the double memory usage in the saving step.
Time on mobile phones are considered x500 and for the saving step x1000 :(
Tested in Interl I7 with 1.000.000 of short string: "Item Index XXX.XXX"
Thanks all.
Some log:
...
ForEach ( 1000000 ) in 1719 ms
Deleting ( 1000000 ) in 1250 ms
Saving File ( 940150 ) in 3078 ms
Adding ( 1000000 ) in 1828 ms
ForEach ( 1000000 ) in 1094 ms
Adding ( 1000000 ) in 1219 ms
Deleting ( 970781 ) in 1406 ms
ForEach ( 970781 ) in 1625 ms
Adding ( 1000000 ) in 1703 ms
Deleting ( 1000000 ) in 531 ms
Saving File ( 1000000 ) in 3625 ms
ForEach ( 1000000 ) in 813 ms
Adding ( 1000000 ) in 1016 ms
...
Simple class:
TThreadSafeNode<T> = class
private
FNode: TNode<T>;
FCriticalSection: TCriticalSection;
public
constructor Create;
destructor Destroy; override;
function Lock: TNode<T>;
procedure Unlock;
end;
And testing threads:
var
VThreadSafeNode: TThreadSafeNode<String>;
begin
Randomize;
VThreadSafeNode := TThreadSafeNode<String>.Create;
// ---------------------------------------------------------------------------
TThread.CreateAnonymousThread(
procedure
var
VIndex: Integer;
VCount: Integer;
VTickCount: Cardinal;
VRoot: TNode<String>;
begin
while True do
begin
VTickCount := TThread.GetTickCount;
VRoot := VThreadSafeNode.Lock;
try
VRoot.Clear;
VRoot.Capacity := Nodes;
for VIndex := 1 to Nodes do
begin
VRoot.Add( 'Item Index ' + VIndex.ToString );
end;
VCount := VRoot.Count( True );
finally
VThreadSafeNode.Unlock;
end;
TThread.Synchronize(
nil,
procedure
begin
Memo1.Lines.Add( 'Adding ( ' + VCount.ToString + ' ) in ' + ( TThread.GetTickCount - VTickCount ).ToString + ' ms' );
end
);
end;
end
).Start;
TThread.CreateAnonymousThread(
procedure
var
VIndex: Integer;
VCount: Integer;
VTickCount: Cardinal;
VRoot: TNode<String>;
begin
while True do
begin
VTickCount := TThread.GetTickCount;
VRoot := VThreadSafeNode.Lock;
try
VIndex := Random( VRoot.Count );
VRoot.Delete( VIndex, Random( VRoot.Count ) - VIndex );
VCount := VRoot.Count( True );
finally
VThreadSafeNode.Unlock;
end;
TThread.Synchronize(
nil,
procedure
begin
Memo1.Lines.Add( 'Deleting ( ' + VCount.ToString + ' ) in ' + ( TThread.GetTickCount - VTickCount ).ToString + ' ms' );
end
);
TThread.Sleep( Random( 1000 ) );
end;
end
).Start;
TThread.CreateAnonymousThread(
procedure
var
VCount: Integer;
VTickCount: Cardinal;
VRoot: TNode<String>;
begin
while True do
begin
VTickCount := TThread.GetTickCount;
VRoot := VThreadSafeNode.Lock;
try
VRoot.ForEach(
procedure( const Item: TNode<String>; var ABreak: Boolean )
begin
Item.Value := Item.Value;
end
);
VCount := VRoot.Count( True );
finally
VThreadSafeNode.Unlock;
end;
TThread.Synchronize(
nil,
procedure
begin
Memo1.Lines.Add( 'ForEach ( ' + VCount.ToString + ' ) in ' + ( TThread.GetTickCount - VTickCount ).ToString + ' ms' );
end
);
TThread.Sleep( Random( 1000 ) );
end;
end
).Start;
TThread.CreateAnonymousThread(
procedure
var
VCount: Integer;
VLastPercent: Integer;
VTickCount: Cardinal;
VRoot: TNode<String>;
begin
while True do
begin
VTickCount := TThread.GetTickCount;
VLastPercent := 0;
VRoot := TNode<String>.Create;
try
VRoot.Assign( VThreadSafeNode.Lock );
finally
VThreadSafeNode.Unlock;
end;
try
VRoot.SaveToFile(
TPath.Combine( TPath.GetSharedDocumentsPath, 'test.txt' ),
procedure( const AWriter: TBufferedWriter; const AData: String )
begin
AWriter.WriteString( AData );
end,
procedure( const AIndex, ACount: Integer )
var
VPercent: Integer;
begin
VPercent := Trunc( ( ( AIndex + 1 ) * 100 ) / ACount );
if VLastPercent <> VPercent then
begin
VLastPercent := VPercent;
TThread.Synchronize(
nil,
procedure
begin
ProgressBar1.Value := VLastPercent;
end
);
end;
end
);
VCount := VRoot.Count( True );
finally
VRoot.DisposeOf;
end;
TThread.Synchronize(
nil,
procedure
begin
Memo1.Lines.Add( 'Saving File ( ' + VCount.ToString + ' ) in ' + ( TThread.GetTickCount - VTickCount ).ToString + ' ms' );
end
);
TThread.Sleep( Random( 1000 ) );
end;
end
).Start;
end;