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!

Simply because I have not thought about it (and I never thought that this was possible). How can one create the thread, call the calculation procedure and then destroy the class? The sytnax is the same, but it creates the new class in a new thread? — Stelios Antoniou
– Stelios Antoniou, Commented Jul 22, 2021 at 14:44
That's class inheritance: you'll instanciate objects from TExecute which is an extension of a TThread, just with your additional variables/procedures. Welcome to OOP. — AmigoJack
– AmigoJack, Commented Jul 22, 2021 at 15:22

fpiette · Accepted Answer · 2021-07-22 19:14:37Z

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.

edited Jul 22, 2021 at 19:14

answered Jul 22, 2021 at 14:11

fpiette

12.5k1 gold badge34 silver badges52 bronze badges

Sign up to request clarification or add additional context in comments.

12 Comments

Stelios Antoniou Over a year ago

Thanks @fpiette. I tried it, but I get exactly the same behaviour. I tried adding the the variables to the TMainForm1 class (as either private or public variables) or as variables in the MainForm unit. In all cases, the behaviour does not change.

fpiette Over a year ago

Be sure to have all thread terminated before leaving the program. Change the number of iterations to a smaller value if you don't want to wait for the threads and still being sure they are done.

fpiette Over a year ago

FreeAndNil first save the address, then set to nil, then free the saved address. That's not what you do: you first nil and loose the address then call Free using the nil address and this won't free the memory.

fpiette Over a year ago

I used your code with the change I described and it works here using Delphi 10.4.2. Maybe the code you showed is not the real code you use or you use an older Delphi which has a different behavior. Maybe try with an explicit thread (A class inheriting from TThread) instead of an anonymous thread.

fpiette Over a year ago

You'd better restart with the code I wrote.

|

Collectives™ on Stack Overflow

multithreading in Delphi

1 Answer 1

12 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

12 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related