Why do the threads run serially in this console application?

Question

I'm creating an console application which needs to run several threads in order to accomplish a task. My problem is that threads are running one after another (thread1 start -> work -> end and ONLY then start thread2) instead of running all in the same time. Also i don't want more than 10 threads to work in the same time(performance issues). Bellow is a example code of console application and of the datamodule used. my application is working on the same manner. i have used a datamodule because after the threads are finished i must fill a database with those informations. Also there are comments in the code for explain which is the reason for doing something.

app console code:

    program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Unit1 in 'Unit1.pas' {DataModule1: TDataModule};

var dm:TDataModule1;
begin
   dm:=TDataModule1.Create(nil);
   try
     dm.execute;
   finally
    FreeAndNil(dm);
   end;
end.

and datamodule code

    unit Unit1;

interface

uses
  SysUtils, Classes, SyncObjs, Windows, Forms;

var   FCritical: TRTLCriticalSection;//accessing the global variables  

type
  TTestThread = class(TThread)
  protected
    procedure Execute;override;
  end;
  TDataModule1 = class(TDataModule)
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Déclarations privées }
  public

    procedure execute;
    procedure CreateThread();
    procedure Onterminatethrd(Sender: TObject);
  end;

var
  DataModule1       : TDataModule1;
  FthreadCount      : Integer;  //know how many threads are running


implementation

{$R *.dfm}

{ TTestThread }

procedure TTestThread.Execute;
var
  f                 : TextFile;
  i                 : integer;
begin
  EnterCriticalSection(fcritical);
  AssignFile(f, 'd:\a' + inttostr(FthreadCount) + '.txt');
  LeaveCriticalSection(fcritical);
  Rewrite(f);
  try
    i := 0;
    while i <= 1000000 do // do some work...
      Inc(i);
    Writeln(f, 'done');
  finally
    CloseFile(f);
  end;
end;

{ TDataModule1 }

procedure TDataModule1.CreateThread;
var
  aThrd             : TTestThread;
begin
  aThrd := TTestThread.Create(True);
  aThrd.FreeOnTerminate := True;
  EnterCriticalSection(fcritical);
  Inc(FthreadCount);
  LeaveCriticalSection(fcritical);
  aThrd.OnTerminate:=Onterminatethrd;
  try
    aThrd.Resume;
  except
    FreeAndNil(aThrd);
  end;
end;

procedure TDataModule1.Onterminatethrd(Sender: TObject);
begin
  EnterCriticalSection(fcritical);
  Dec(FthreadCount);
  LeaveCriticalSection(fcritical);
end;

procedure TDataModule1.DataModuleCreate(Sender: TObject);
begin
  InitializeCriticalSection(fcritical);
end;

procedure TDataModule1.DataModuleDestroy(Sender: TObject);
begin
  DeleteCriticalSection(fcritical);
end;

procedure TDataModule1.execute;
var
  i                 : integer;
begin
  i := 0;
  while i < 1000 do
  begin
    while (FthreadCount = 10) do
      Application.ProcessMessages;//wait for an thread to finish. max threads at a //time =10

    CreateThread;

    EnterCriticalSection(fcritical);
    Inc(i);
    LeaveCriticalSection(fcritical);

    while FthreadCount > 0 do //wait for all threads to finish in order to close the //main thread
    begin
      Application.ProcessMessages;
      CheckSynchronize;
    end;
  end;
end;

end.

so, as i've said the problem is that my threads are running one after another, instead of working all in the same time. also i've seen that sometimes only first thread worked, after that all the rest just create and finished. in my application all the code is protected by try-excepts but no errors are raised.

Can someone give me an advice?

Answer 1

At the very least you should put

while FthreadCount > 0 do //wait for all threads to finish in order to close the //main thread
begin
  Application.ProcessMessages;
  CheckSynchronize;
end;

outside of the main loop. This wait loop is what is causing the hold up. For every integer i of the mainloop, it waits until the FThreadCount drops to zero.

On a sidenote: normally you don't need to protect local variables with critical sections. Though having process messages in there may screw things up as it may cause re-entrancy.

Answer 2

i've followed Marjan's suggestion and the following code seems to work correct. i'm answering to my own question in order to provide a response code, which can be analyzed by others, and corrected if needed.

unit Unit1;

interface

uses
  SysUtils, Classes, SyncObjs, Windows, Forms, Dialogs;

var   FCritical: TRTLCriticalSection;  

type
  TTestThread = class(TThread)
  protected
    procedure Execute;override;
  end;
  TDataModule1 = class(TDataModule)
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Déclarations privées }
  public

    procedure execute;
    procedure CreateThread();
    procedure Onterminatethrd(Sender: TObject);
  end;

var
  DataModule1       : TDataModule1;
  FthreadCount      : Integer;


implementation

{$R *.dfm}

{ TTestThread }

procedure TTestThread.Execute;
var
  f                 : TextFile;
  i                 : integer;

begin
 AssignFile(f, 'd:\a\a' + inttostr(FthreadCount) + '.txt');
 if fileexists('d:\a\a' + inttostr(FthreadCount) + '.txt') then
  Append(f)
 else
  Rewrite(f);
   try
    i := 0;
    while i <= 1000000 do
      Inc(i);
  Writeln(f, 'done '+floattostr(self.Handle));
  finally
    CloseFile(f);
  end;
end;

{ TDataModule1 }

procedure TDataModule1.CreateThread;
var
  aThrd             : TTestThread;
begin
  aThrd := TTestThread.Create(True);
  aThrd.FreeOnTerminate := True;
  EnterCriticalSection(fcritical);
  Inc(FthreadCount);
  LeaveCriticalSection(fcritical);
  aThrd.OnTerminate:=Onterminatethrd;
  try
    aThrd.Resume;
  except
    FreeAndNil(aThrd);
  end;
end;

procedure TDataModule1.Onterminatethrd(Sender: TObject);
begin
  EnterCriticalSection(fcritical);
    Dec(FthreadCount);
  LeaveCriticalSection(fcritical);
end;

procedure TDataModule1.DataModuleCreate(Sender: TObject);
begin
  InitializeCriticalSection(fcritical);
end;

procedure TDataModule1.DataModuleDestroy(Sender: TObject);
begin
  DeleteCriticalSection(fcritical);
end;

procedure TDataModule1.execute;
var
  i                 : integer;
begin
  i := 0;
 try
  while i < 1000 do
  begin
    while (FthreadCount = 10) do
     begin
      Application.ProcessMessages;
      CheckSynchronize
     end;
    CreateThread;
    Inc(i);
  end;
    while FthreadCount > 0 do
    begin
      Application.ProcessMessages;
      CheckSynchronize;
    end;
 except on e:Exception do
//
 end;
end;

end.

at this moment i've test this code for several times and it seems to work fine. if Rob will answer me with a small example on how i can implement semaphores over this problem i'll post the entire code here also.