Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Using the Delphi XE7 Parallel Library

I have a time consuming routine which I'd like to process in parallel using Delphi XE7's new parallel library.

Here is the single threaded version:

procedure TTerritoryList.SetUpdating(const Value: boolean);
var
  i, n: Integer;
begin
  if (fUpdating <> Value) or not Value then
  begin
    fUpdating := Value;

    for i := 0 to Count - 1 do
    begin
      Territory[i].Updating := Value; // <<<<<< Time consuming routine
      if assigned(fOnCreateShapesProgress) then
        fOnCreateShapesProgress(Self, 'Reconfiguring ' + Territory[i].Name, i / (Count - 1));
    end;
  end;
end;

There is really nothing complex going on. If the territory list variable is changed or set to false then the routine loops around all the sales territories and recreates the territory border (which is the time consuming task).

So here is my attempt to make it parallel:

procedure TTerritoryList.SetUpdating(const Value: boolean);
var
  i, n: Integer;
begin
  if (fUpdating <> Value) or not Value then
  begin
    fUpdating := Value;

    n := Count;
    i := 0;

    TParallel.For(0, Count - 1,
      procedure(Index: integer)
      begin
        Territory[Index].Updating := fUpdating; // <<<<<< Time consuming routine
        TInterlocked.Increment(i);
        TThread.Queue(TThread.CurrentThread,
          procedure
            begin
              if assigned(fOnCreateShapesProgress) then
                fOnCreateShapesProgress(nil, 'Reconfiguring ', i / n);
            end);
      end
    );
  end;
end;

I've replaced the for-loop with a parallel for-loop. The counter, 'i' is locked as it is incremented to show progress. I then wrap the OnCreateShapeProgress event in a TThread.Queue, which will be handled by the main thread. The OnCreateShapeProgress event is handled by a routine which updates the progress bar and label describing the task.

The routine works if I exclude the call to the OnCreateShapeProgress event. It crashes with an EAurgumentOutOfRange error.

So my question is simple:

Am I doing anything anything stupid?

How to do you call an event handler from within a TParallel.For loop or TTask?

like image 780
Steve Maughan Avatar asked Sep 29 '22 10:09

Steve Maughan


1 Answers

The most obvious problem that I can see is that you queue to the worker thread.

Your call to TThread.Queue passes TThread.CurrentThread. That is the very thread on which you are calling TThread.Queue. I think it is safe to say that you should never pass TThread.CurrentThread to TThread.Queue.

Instead, remove that parameter. Use the one parameter overload that just accepts a thread procedure.

Otherwise I'd note that the incrementing of the progress counter i is not really handled correctly. Well, the incrementing is fine, but you then read it later and that's a race. You can report progress out of order if thread 1 increments before thread 2 but thread 2 queues progress before thread 1. Solve that by moving the counter increment code to the main thread. Simply increment it inside the queued anonymous method. Added bonus to that is you no longer need to use an atomic increment since all modifications are on the main thread.

Beyond that, this QC report seems rather similar to what you report: http://qc.embarcadero.com/wc/qcmain.aspx?d=128392

Finally, AtomicIncrement is the idiomatic way to perform lock free incrementing in the latest versions of Delphi.

like image 83
David Heffernan Avatar answered Oct 03 '22 00:10

David Heffernan