multithreading in Delphi

Question

I have a number crunching application with a TExecution class that is included in a separate unit Execution.pas and carries out all the calculations. The class instances are created from the main form of the program. Very often the code in Execution.pas needs to run 10-15 times in a row and I want to create several TExecution instances in different threads and run them in parallel. A simplified version of the code is as follows:

Main Form with one Button1 in it:

unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Threading, Execution;

type
  TMainForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  MainForm1: TMainForm1;

implementation

{$R *.dfm}

procedure TMainForm1.Button1Click(Sender: TObject);
var
  ExecutionThread: array of TThread;
  NoThreads: integer;
  Execution: array of TExecution;
  thread_ID: integer;
begin
    NoThreads := 5;
    SetLength(Execution,NoThreads);
    SetLength(ExecutionThread,NoThreads);
    //----------------------------------------------------------------------------------
   for thread_ID := 0 to Pred(NoThreads) do
    begin
        ExecutionThread[thread_ID] := TThread.CreateAnonymousThread(
        procedure
        begin
            try
                Execution[thread_ID] := TExecution.Create;
                Execution[thread_ID].CalculateSum;
            finally
                if Assigned(Execution[thread_ID]) then
                begin
                    Execution[thread_ID] := nil;
                    Execution[thread_ID].Free;
                end;
            end;
        end);
        ExecutionThread[thread_ID].FreeOnTerminate := true;
        ExecutionThread[thread_ID].Start;
    end;

end;

end.

Execution.pas unit:

unit Execution;

interface
uses
System.SysUtils, Vcl.Dialogs, System.Classes, WinApi.Windows;

 type
   TExecution = Class
      const
        NoOfTimes = 1000000;
      var
        Sum: integer;
      private
        procedure IncrementSum(var Sum: integer);
      published
        procedure CalculateSum;
   End;

implementation

procedure TExecution.CalculateSum;
var
  i: integer;
begin
    Sum := 0;
    for i := 0 to Pred(NoofTimes) do
    begin
        IncrementSum(Sum);
    end;
end;

procedure TExecution.IncrementSum(var Sum: integer);
begin
    Inc(Sum);
end;

end.

Whenever I run the code above by clicking Button1 the TExecution instances run, but when I close the program, I get an Access Violation in GetMem.inc in function SysFreeMem. Obviously, the code messes up the memory, I guess it is because of the parallel memory allocation, but I was unable to find the cause and fix a solution to it. I note that with one thread (NoThreads := 1), or with a serial execution of the code (either with a single new thread and 5 TExecution instances, or when the instances of TExecution are created directly from MainForm), I do not get similar memory problems. What is the problem with my code? Many thanks in advance!

Answer 1

The problem comes from ExecutionThread and Execution which are local variables. When all threads are started, the procedure Button1Click exits, the two variables are freed, long before threads are terminated.

Move the two variables ExecutionThread and Execution to the TMainForm1 field and your problem will be gone. Of course: if you close the program before the threads are terminated, you'll be again in trouble.

Also, invert the two lines:

Execution[thread_ID] := nil;
Execution[thread_ID].Free;

You must free before niling.

BTW: You should get a compiler warning about published in TExecution.

EDIT: Following the comment on this answer, here is the code for the same process but using an explicit worker thread and a generic TList to maintain the list of running thread.

Source for the main form:

unit ThreadExecutionDemoMain;

interface

uses
    Winapi.Windows, Winapi.Messages,
    System.SysUtils, System.Variants, System.Classes,
    System.Generics.Collections,
    Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
    ThreadExecutionDemoExecution,
    ThreadExecutionDemoWorkerThread;

type
    TMainForm = class(TForm)
        StartButton: TButton;
        DisplayMemo: TMemo;
        procedure StartButtonClick(Sender: TObject);
    private
        ThreadList : TList<TWorkerThread>;
        procedure WrokerThreadTerminate(Sender : TObject);
    public
        constructor Create(AOwner : TComponent); override;
        destructor  Destroy; override;
    end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

constructor TMainForm.Create(AOwner: TComponent);
begin
    ThreadList := TList<TWorkerThread>.Create;
    inherited Create(AOwner);
end;

destructor TMainForm.Destroy;
begin
    FreeAndNil(ThreadList);
    inherited Destroy;;
end;

procedure TMainForm.StartButtonClick(Sender: TObject);
var
    NoThreads    : Integer;
    ID           : Integer;
    WorkerThread : TWorkerThread;
begin
    NoThreads := 5;
    for ID := 0 to Pred(NoThreads) do begin
        WorkerThread := TWorkerThread.Create(TRUE);
        WorkerThread.ID          := ID;
        WorkerThread.OnTerminate := WrokerThreadTerminate;
        WorkerThread.FreeOnTerminate := TRUE;
        ThreadList.Add(WorkerThread);
        DisplayMemo.Lines.Add(Format('Starting thread %d', [WorkerThread.ID]));
        WorkerThread.Start;
    end;
    DisplayMemo.Lines.Add(Format('There are %d running threads', [ThreadList.Count]));
end;

procedure TMainForm.WrokerThreadTerminate(Sender: TObject);
var
    WorkerThread : TWorkerThread;
begin
    WorkerThread := TWorkerThread(Sender);
    ThreadList.Remove(WorkerThread);
    // This event handler is executed in the context of the main thread
    // we can access the user interface directly
    DisplayMemo.Lines.Add(Format('Thread %d done. Sum=%d',
                                 [WorkerThread.ID, WorkerThread.Sum]));
    if ThreadList.Count = 0 then
        DisplayMemo.Lines.Add('No more running threads');
end;

end.

Source for the execution unit:

unit ThreadExecutionDemoExecution;

interface

type
    TExecution = class
    const
        NoOfTimes = 1000000;
    private
        FSum: Integer;
        procedure IncrementSum(var ASum: Integer);
    public
        procedure CalculateSum;
        property Sum: Integer    read  FSum
                                 write FSum;
    end;


implementation

{ TExecution }

procedure TExecution.CalculateSum;
var
    I: Integer;
begin
    FSum := 0;
    for I := 0 to Pred(NoOfTimes) do
        IncrementSum(FSum);
end;

procedure TExecution.IncrementSum(var ASum: Integer);
begin
    Inc(ASum);
end;

end.

Source for the worker thread:

unit ThreadExecutionDemoWorkerThread;

interface

uses
    System.SysUtils, System.Classes,
    ThreadExecutionDemoExecution;

type
    TWorkerThread = class(TThread)
    private
        FExecution : TExecution;
        FID        : Integer;
        FSum       : Integer;
    protected
        procedure Execute; override;
    public
        property ID        : Integer    read  FID
                                        write FID;
        property Sum       : Integer    read  FSum
                                        write FSum;
    end;


implementation

{ TWorkerThread }

procedure TWorkerThread.Execute;
begin
    FExecution := TExecution.Create;
    try
        FExecution.CalculateSum;
        FSum := FExecution.Sum;
    finally
        FreeAndNil(FExecution);
    end;
end;

end.