Why are threads running in series in this console application?

Question

I am creating a console application that needs to execute multiple threads to complete a task. My problem is that threads start one after another (thread1 start → work → end and ONLY and then start thread2) instead of starting everything at the same time. Also, I do not want more than 10 threads to work at the same time (performance issues). Bellow is an example of console application code and used datamodule. my application works the same way. I used the datamodule because after the threads have finished, I have to populate the database with this data. There are also comments in the code to explain what is the reason for something.

application 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. 

since I said that the problem is that my threads are working one by one, and not all are working at the same time. I also saw that sometimes only the first thread worked, after which everything else was simply created and ended. in my application all code is protected by try-excepts, but no errors occur.

Can someone give me some advice?

Answer 1

At 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; 

out of the main loop. This wait loop is what causes the delay. For every integer, I mainloop it waits until the FThreadCount falls to zero.

On the side: usually you do not need to protect local variables with critical sections. Although the process reports there may damage, as this may cause a reappearance.

Answer 2

I followed Marian's suggestion and the following code seems to be correct. I answer my question in order to provide an answer code that can be analyzed by others, and correct if necessary.

 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 point, I tested this code several times and it seems to work fine. if Rob answers me with a small example of how I can implement semaphores on this issue, I will also post all the code here.

Answer 3

I have a unit that does exactly what you need. Just download it from:

Cromis.Threading

There are two classes inside you:

• TTaskPool: task pool. Easy way to make things asynchronous.
• TTaskQueue: asynchronous task queue. Works like a standard FIFO queue.

TTaskQueue can be used stand-alone with regular vanilla threads, for example. It blocks inside one thread and queues requests.

If this is not enough, you can check the OmniThreadLibrary at:

OmniThreadLibrary

This is a powerful thread library, far superior to what I have. But also more difficult to use (but still very easy compared to classic carvings).