Delphi 2010: Pas de filetage vs discussions

Question

Je suis l'utilisateur de Delphi 2010, ma machine actuelle est Intel Core i7, fonctionnant sous Windows 7 x64. J'ai écris les codes suivants:

type 
    TForm1 = class(TForm) 
    Memo1: TMemo; 
    Button1: TButton; 
    Button2: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
    private 
    FCount: Integer; 
    FTickCount: Cardinal; 
    procedure DoTest; 
    procedure OnTerminate(Sender: TObject); 
    end; 

    TMyThread = class(TThread) 
    private 
    FMethod: TProc; 
    protected 
    procedure Execute; override; 
    public 
    constructor Create(const aCreateSuspended: Boolean; const aMethod: TProc); 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

procedure TForm1.Button1Click(Sender: TObject); 
var i: integer; 
    T1, T2: Cardinal; 
begin 
    T1 := GetTickCount; 
    for i := 0 to 9 do 
    DoTest; 
    T2 := GetTickCount; 
    Memo1.Lines.Add(Format('no thread=%4f', [(T2 - T1)/1000])); 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
var T: TMyThread; 
    i: integer; 
begin 
    FCount := 0; 
    FTickCount := GetTickCount; 

    for i := 0 to 9 do begin 
    T := TMyThread.Create(True, DoTest); 
    T.OnTerminate := OnTerminate; 
    T.Priority := tpTimeCritical; 

    if SetThreadAffinityMask(T.Handle, 1 shl (i mod 8)) = 0 then 
     raise Exception.Create(IntToStr(GetLastError)); 

    Inc(FCount); 
    T.Start; 
    end; 
end; 

procedure TForm1.DoTest; 
var i: integer; 
begin 
    for i := 1 to 10000000 do 
    IntToStr(i); 
end; 

procedure TForm1.OnTerminate(Sender: TObject); 
begin 
    Dec(FCount); 
    if FCount = 0 then 
    Memo1.Lines.Add(Format('thread=%4f', [(GetTickCount - FTickCount)/1000])); 
end; 

constructor TMyThread.Create(const aCreateSuspended: Boolean; const aMethod: 
    TProc); 
begin 
    inherited Create(aCreateSuspended); 
    FMethod := aMethod; 
    FreeOnTerminate := True; 
end; 

procedure TMyThread.Execute; 
begin 
    FMethod; 
end; 

Cliquez sur Button1 sera affiche 12,25 secondes, tandis que Bouton2 vous affichera 12.14 secondes. Mon problème est pourquoi je ne peux pas obtenir plus de différence évidente de temps pris (moins de 10 secondes) bien que je cours des fils parallèles?

Answer 1

L'allocation de mémoire semble être le principal problème ici.

Si vous remplacez la charge utile avec

procedure TForm6.DoTest; 
var i: integer; 
    a: double; 
begin 
    a := 0; 
    for i := 1 to 10000000 do 
    a := Cos(a); 
end; 

le code paralléliser indiquant bien qu'il n'y a pas de problème réel avec votre cadre.

Si vous, cependant, remplacer la charge utile avec l'allocation de mémoire/désallocation

procedure TForm6.DoTest; 
var i: integer; 
    p: pointer; 
begin 
    for i := 1 to 10000000 do begin 
    GetMem(p, 10); 
    FreeMem(p); 
    end; 
end; 

la version parallèle sera beaucoup plus lent que celui monothread. Lorsque vous appelez IntToStr, une chaîne temporaire est allouée et détruite et cette allocation/désallocation crée le goulot d'étranglement. BTW1: À moins que vous ne sachiez vraiment ce que vous faites, je déconseille vivement d'exécuter des threads à la priorité tpTimeCritical. Même si vous savez vraiment ce que vous faites, vous ne devriez pas le faire. BTW2: À moins que vous ne sachiez vraiment ce que vous faites, vous ne devriez pas jouer avec les masques d'affinité au niveau des threads. Le système est assez intelligent pour planifier les discussions correctement.

Answer 2

Si vous avez des fils à haute intensité de mémoire (plusieurs allocations de mémoire/désallocations) vous feriez mieux d'utiliser TopMM au lieu de FastMM: http://www.topsoftwaresite.nl/

FastMM utilise un verrou qui bloque tous les autres fils, TopMM ne pas il échelles beaucoup mieux sur plusieurs noyaux/cpus!

Answer 3

Je ne suis pas sûr à 100%, mais il y a une chance que l'événement OnTerminate soit appelé à partir du contexte de la TThread. Si c'est le cas (je dois admettre que je n'ai pas vérifié cela), vous feriez mieux d'utiliser InterlockedDecrement sur FCount, et de synchroniser les mises à jour de l'interface graphique. Juste un point mineur, mais dans le code de production, ces choses sont importantes.