How to realize parallel loop in Delphi?

Question

How to realize parallel loop in Delphi (Delphi 200X, Delphi XE) ? How to do this best way? And is there any universal solution?

With examples, please.

Answer 1

If you need only ParallelFor you can use this code:

interface

uses
  Classes, SysUtils;

type
  TParallelProc = reference to procedure(i: Integer; ThreadID: Integer);

  TParallel = class(TThread)
  private
    FProc: TParallelProc;
    FThreadID: Integer; //current thread ID
  protected
    procedure Execute; override;
    function GetNextValue: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    property Proc: TParallelProc
      read FProc write FProc;
    class var
      CurrPos: Integer; //current loop index
      MaxPos: Integer;  //max loops index
      cs: TCriticalSection;
      ThCount: Integer; //thread counter - how much threads have finished execution
  end;


{** ParallelFor Loop - all iterations will be performed in chosen threads
@param nMin - Loop min value (first iteration)
@param nMax - Loop max value (last iteration)
@param nThreads - how much threads to use
@param  aProc - anonymous procedure which will be performed in loop thread
}
procedure ParallelFor(nMin, nMax, nThreads: Integer; aProc: TParallelProc); overload;
{** ParallelFor Loop - all iterations will be performed in max cpu cores
@param nMin - Loop min value (first iteration)
@param nMax - Loop max value (last iteration)
@param  aProc - anonymous procedure which will be performed in loop thread
}
procedure ParallelFor(nMin, nMax: Integer; aProc: TParallelProc); overload;

implementation

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  SyncObjs;

procedure ParallelFor(nMin, nMax, nThreads: Integer; aProc: TParallelProc);
var
  threads: array of TParallel;
  I: Integer;
begin
  if nMin > nMax then
    Exit;
  // initialize TParallel class data
  TParallel.CurrPos := nMin;
  TParallel.MaxPos := nMax;
  TParallel.cs := TCriticalSection.Create;
  TParallel.ThCount := 0;

  // create the threads
  SetLength (threads, nThreads);
  for I := 0 to nThreads - 1 do
  begin
    threads[I] := TParallel.Create; // suspended
    threads[I].FThreadID := I;
    threads[I].Proc := aProc;
    threads[I].Start;
  end;

  for I := 0 to nThreads - 1 do
  begin
    threads[I].WaitFor;
  end;

  for I := 0 to nThreads - 1 do
  begin
    threads[I].Free;
  end;

  TParallel.cs.Free;
end;

procedure ParallelFor(nMin, nMax: Integer; aProc: TParallelProc);
begin
  ParallelFor(nMin, nMax, CPUCount, aProc);
end;

{ TParallel }

constructor TParallel.Create;
begin
  inherited Create(True); // suspended
  InterlockedIncrement(ThCount);
  FreeOnTerminate := False;
  FThreadID := 0;
end;

destructor TParallel.Destroy;
begin
  InterlockedDecrement(ThCount);
  inherited;
end;

procedure TParallel.Execute;
var
  nCurrent: Integer;
begin
  nCurrent := GetNextValue;
  while nCurrent <= MaxPos do
  begin
    Proc(nCurrent, FThreadID);
    nCurrent := GetNextValue;
  end;
end;

function TParallel.GetNextValue: Integer;
begin
  cs.Acquire;
  try
    Result := CurrPos;
    Inc(CurrPos);
  finally
    cs.Release;
  end;
end;

However, if you need more threading "stuff" you should consider using third party libraries.

Answer 2

Depends on what you mean by parallel loop and the application/implementation.

Take a look at TThread and TMultiReadExclusiveWriteSynchronizer.

Answer 3

Probably the best solution at the moment is the Parallel For Loop construct in OmniThreadLibrary. You pass it a collection, or a pair of integers representing lower and upper bounds, and an anonymous method representing the loop body, and it uses a thread pool to run the for loop in parallel.

Note that this will only work if the loop body method is capable of standing on its own. If it modifies any external variables or relies on the value of a calculation made earlier in the loop then it can't be parallelized.

An introduction to the OmniThreadLibrary parallel for can be found here. For example, a simple for loop iterating over numbers looks like this:

Parallel.ForEach(1, testSize).Execute(
  procedure (const elem: integer)
  begin
    // do something with 'elem'
  end);