Perché i thread vengono eseguiti in serie in questa applicazione console?

Question

Sto creando un'applicazione console che deve eseguire diversi thread per eseguire un'attività. Il mio problema è che i thread sono in esecuzione uno dopo l'altro (thread1 start -> lavoro -> fine e SOLO quindi avviare thread2) invece di eseguire tutto nello stesso tempo. Inoltre, non voglio che più di 10 thread funzionino nello stesso tempo (problemi di prestazioni). Bellow è un codice di esempio dell'applicazione console e del datamodule utilizzato. la mia applicazione funziona allo stesso modo. ho usato un datamodule perché dopo che i thread sono finiti devo riempire un database con quelle informazioni. Inoltre ci sono commenti nel codice per spiegare quale è la ragione per fare qualcosa.

app codice console:

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. 

e datamodule codice

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. 

modo, come ho detto il problema è che le mie discussioni sono in esecuzione una dopo l'altra, invece di lavorare tutti nella contemporaneamente. ho anche visto che a volte solo il primo thread ha funzionato, dopodiché tutto il resto è stato creato e completato. nella mia applicazione tutto il codice è protetto da try-excepts ma non vengono sollevati errori.

Qualcuno può darmi un consiglio?

Answer 1

Per lo meno si dovrebbe mettere

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

al di fuori del ciclo principale. Questo ciclo di attesa è ciò che sta causando il blocco. Per ogni intero i del mainloop, attende che l'FThreadCount scenda a zero.

Su un sidenote: normalmente non è necessario proteggere le variabili locali con sezioni critiche. Anche se i messaggi di processo che ci sono dentro possono rovinare tutto in quanto potrebbero causare un re-entrancy.

Answer 2

Ho un'unità che fa esattamente quello che ti serve. Basta scaricarlo da:

Cromis.Threading

All'interno ci sono due classi:

1. TTaskPool: Pool di attività. Un modo semplice per fare cose asincrone.
2. TTaskQueue: una coda di attività asincrone. Funziona come una coda FIFO standard.

Il TTaskQueue può essere utilizzato autonomamente con fili di vanila semplici, ad esempio. Blocca all'interno di un singolo thread e accoda le richieste.

Se questo non è sufficiente è possibile controllare l'OmniThreadLibrary a:

OmniThreadLibrary

Questo è un potente libreria di filettatura, di gran lunga superiore a quello che ho. Ma anche più complicato da usare (ma comunque molto semplice rispetto alla filettatura classica).

Answer 3

ho seguito il suggerimento di Marjan e il seguente codice sembra funzionare correttamente. Sto rispondendo alla mia domanda per fornire un codice di risposta, che può essere analizzato da altri, e corretto se necessario.

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. 

in questo momento ho provato questo codice per diverse volte e sembra funzionare bene. se Rob mi risponderà con un piccolo esempio su come posso implementare i semafori su questo problema, invierò anche qui l'intero codice.