Delphi tread flere cpu'er

Hvis du starter en windows tråd, så vil windows schedulere dem til at kunne køre på hver sin CPU.

Det sker ikke, når jeg kalder dem på følgende måde:

  T1 := TMyThread1.Create(True);
  T1.Resume;
  T2 := TMyThread2.Create(True);
  T2.Resume;

så kører begge treads på samme cpu

Hvis T1 enten afslutter hurtigt eller sleeper, så kan T2 godt komme til at køre på samme CPU som T1.

Men ofte vil den køre på en anden CPU.

Demo kode:

program thrfun;

{$APPTYPE CONSOLE}

uses
  Classes, SysUtils, Windows;

  type
  TCPUID    = array[1..4] of Longint;
 
function GetCPUID : integer; assembler; register;

asm
  MOV    EAX,1
  DW      $A20F      {CPUID Command}
  SHR    EBX, 24
  MOV    EAX, EBX
end;

var
  MyLock: TRTLCriticalSection;

type
  TMyThread1 = class(TThread)
      protected
        procedure Execute; override;
      end;

procedure TMyThread1.Execute;

begin
  EnterCriticalSection(MyLock);
  writeln('Thread ', ThreadID, ' running on CPU ', GetCPUID);
  LeaveCriticalSection(MyLock);
  Sleep(1000);
end;

var
  T1, T2 : TMyThread1;
  before, after : integer;

begin
  InitializeCriticalSection(MyLock);
  T1 := TMyThread1.Create(True);
  T2 := TMyThread1.Create(True);
  before := GetTickCount;
  T1.Resume;
  T2.Resume;
  T1.WaitFor;
  T2.WaitFor;
  after := GetTickCount;
  T1.Destroy;
  T2.Destroy;
  DeleteCriticalSection(MyLock);
  writeln('Exceuting 2 x sleep 1000 took ', after - before);
  readln;
end.

unit ThreadMultiCPU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TCPUID    = array[1..4] of Longint;

TMyThread1 = class(TThread)
  private
    FCounter1: Integer;
    procedure DoProgress;
  protected
    procedure Execute; override;
  end;
  TMyThread2 = class(TThread)
  private
    FCounter2: Integer;
    procedure DoProgress;
  protected
    procedure Execute; override;
  end;
  TForm2 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    ProgressBar2: TProgressBar;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  MinTread1, MinTread2 : boolean;
  MyLock1, MyLock2: TRTLCriticalSection;

implementation

{$R *.dfm}
function GetCPUID : integer; assembler; register;

asm
  MOV    EAX,1
  DW      $A20F      {CPUID Command}
  SHR    EBX, 24
  MOV    EAX, EBX
end;

procedure TMyThread1.Execute;
begin
    FreeOnTerminate := True;
    EnterCriticalSection(MyLock1);
    form2.Edit1.Text := 'Thread ' +  inttostr(ThreadID) + ' running on CPU ' + inttostr(GetCPUID);
    LeaveCriticalSection(MyLock1);
    while FCounter1 < Form2.ProgressBar1.max do begin
        Synchronize(DoProgress);
        Inc(FCounter1);
        Sleep(20);
    end;
    MinTread1 := false;
end;

procedure TMyThread1.DoProgress;
begin
  Form2.ProgressBar1.Position := FCounter1;
end;

procedure TMyThread2.Execute;
begin
    FreeOnTerminate := True;
    EnterCriticalSection(MyLock2);
    form2.Edit2.Text := 'Thread ' +  inttostr(ThreadID) + ' running on CPU ' + inttostr(GetCPUID);
    LeaveCriticalSection(MyLock2);
    while FCounter2 < Form2.ProgressBar2.max do begin
        Synchronize(DoProgress);
        Inc(FCounter2);
        Sleep(30);
    end;
    MinTread2 := false;
end;

procedure TMyThread2.DoProgress;
begin
  Form2.ProgressBar2.Position := FCounter2;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  T1: TMyThread1;
  T2: TMyThread2;
  before, after : integer;
begin
    MinTread1 := true;
    MinTread2 := true;
    InitializeCriticalSection(MyLock1);
    InitializeCriticalSection(MyLock2);
    T1 := TMyThread1.Create(True);
    T1.Resume;
    T2 := TMyThread2.Create(True);
    T2.Resume;
    before := GetTickCount;
    Button1.Caption := 'Slut';
    while MinTread1 and MinTread2 do begin
        Application.ProcessMessages;
    end;
    after := GetTickCount;
    DeleteCriticalSection(MyLock1);
    DeleteCriticalSection(MyLock2);
    close;
end;

end.


Jeg har lagt det ind som du beskrev, jeg får at vide at hver thread kører på hver sin CPU, men belastnings mæssigt set, er det kun en CPU der bliver belastet, har læst lidt SetThreadAffinityMask, er det ikke den vej man skal?

Lytter lige med...

Så vidt jeg kan se så er TForm2.Button1Click den eneste kode som faktisk bruger noget CPU.

Så det skal nok passe at der kun er belastning på en CPU.

Så du mener at de kører på samme CPU fordi de bliver oprettet i den samme procedure? Synes ikke rigtig det giver mening, men vil det så sige, at oprettes de via en anden knap, så vil det køre på en anden CPU eller kan du forklare det, så det er til at forstå?

Pft

Nej.

Jeg siger at:
* TForm2.Button1Click bruger CPU
* TMyThread1.Execute bruger ikke CPU
* TMyThread2.Execute bruger ikke CPU

og saa er det ikke saa overraskende, at der kun er belastning paa en CPU

OK, nu tror jeg, at jeg forstår, belastningen med at checke for true er den største belastning, prøver at lægge noget belastning på de 2 thread og undlade sleep og helt afslutte Button1Click

De to andre bruger sleep - det goer den her loekke ikke.

Hvis du satte en sleep ind i den her loekke, saa tror jeg at CPU forbruger ville falde til meget lidt.

unit ThreadMultiCPU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
TMyThread1 = class(TThread)
  private
    FCounter1: Integer;
    procedure DoProgress;
  protected
    procedure Execute; override;
  end;
  TMyThread2 = class(TThread)
  private
    FCounter2: Integer;
    procedure DoProgress;
  protected
    procedure Execute; override;
  end;
  TMyThread3 = class(TThread)
  private
    FCounter3: Integer;
    procedure DoProgress;
  protected
    procedure Execute; override;
  end;
  TForm2 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    ProgressBar2: TProgressBar;
    Edit1: TEdit;
    Button2: TButton;
    ProgressBar3: TProgressBar;
    Edit3: TEdit;
    Edit2: TEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
    Form2: TForm2;
    MinTread1, MinTread2, MinTread3 : boolean;
    ireal, ireal1, ireal2, ireal3 : real;
    before, after, FCounter : integer;

implementation

{$R *.dfm}
procedure TMyThread1.Execute;
begin
    FreeOnTerminate := True;
    while FCounter1 < Form2.ProgressBar1.max do begin
        Synchronize(DoProgress);
        Inc(FCounter1);
        ireal1 := FCounter1 * 500 * cos(30) / 25 / 40 * 2 / cos(30);
        form2.Edit1.Text := IntToStr(trunc(ireal1));
    end;
    MinTread1 := false;
    Form2.Button1.Caption := 'Slut';
    if not(MinTread2) and not(MinTread3) then begin
        After := GetTickCount;
        form2.Edit1.Text := 'Forbrugt tid : ' + IntToStr(After-Before);
    end;
end;

procedure TMyThread1.DoProgress;
begin
    Form2.ProgressBar1.Position := FCounter1;
    Application.ProcessMessages;
end;

procedure TMyThread2.Execute;
begin
    FreeOnTerminate := True;
    while FCounter2 < Form2.ProgressBar2.max do begin
        Synchronize(DoProgress);
        Inc(FCounter2);
        ireal2 := FCounter2 * 500 * cos(30) / 25 / 40 * 2 / cos(30);
        form2.Edit2.Text := IntToStr(trunc(ireal2));
    end;
    MinTread2 := false;
    Form2.Button2.Caption := 'Slut';
    if not(MinTread1) and not(MinTread3) then begin
        After := GetTickCount;
        form2.Edit1.Text := 'Forbrugt tid : ' + IntToStr(After-Before);
    end;
end;

procedure TMyThread3.DoProgress;
begin
  Form2.ProgressBar3.Position := FCounter3;
  Application.ProcessMessages;
end;

procedure TMyThread3.Execute;
begin
    FreeOnTerminate := True;
    while FCounter3 < Form2.ProgressBar3.max do begin
        Synchronize(DoProgress);
        Inc(FCounter3);
        ireal3 := FCounter3 * 500 * cos(30) / 25 / 40 * 2 / cos(30);
        form2.Edit3.Text := IntToStr(trunc(ireal3));
    end;
    MinTread3 := false;
    Form2.Button3.Caption := 'Slut';
    if not(MinTread1) and not(MinTread2) then begin
        After := GetTickCount;
        form2.Edit1.Text := 'Forbrugt tid : ' + IntToStr(After-Before);
    end;
end;

procedure TMyThread2.DoProgress;
begin
  Form2.ProgressBar2.Position := FCounter2;
  Application.ProcessMessages;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  T1: TMyThread1;
  T2: TMyThread2;
  T3: TMyThread3;
begin
    MinTread1 := true;
    MinTread2 := true;
    T1 := TMyThread1.Create(True);
    T1.Resume;
    Button1.Caption := 'Arbejder';
    T2 := TMyThread2.Create(True);
    T2.Resume;
    Button2.Caption := 'Arbejder';
    T3 := TMyThread3.Create(True);
    T3.Resume;
    Button3.Caption := 'Arbejder';
    Before := GetTickCount;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
    Before := GetTickCount;
    FCounter := 0;
    while FCounter < Form2.ProgressBar1.max do begin
        Inc(FCounter);
        ireal := FCounter * 500 * cos(30) / 25 / 40 * 2 / cos(30);
        form2.Edit2.Text := IntToStr(trunc(ireal));
        Form2.ProgressBar1.Position := FCounter;
        Application.ProcessMessages;
    end;
    FCounter := 0;
    while FCounter < Form2.ProgressBar2.max do begin
        Inc(FCounter);
        ireal := FCounter * 500 * cos(30) / 25 / 40 * 2 / cos(30);
        form2.Edit2.Text := IntToStr(trunc(ireal));
        Form2.ProgressBar2.Position := FCounter;
        Application.ProcessMessages;
    end;
    FCounter := 0;
    while FCounter < Form2.ProgressBar3.max do begin
        Inc(FCounter);
        ireal := FCounter * 500 * cos(30) / 25 / 40 * 2 / cos(30);
        form2.Edit2.Text := IntToStr(trunc(ireal));
        Form2.ProgressBar3.Position := FCounter;
        Application.ProcessMessages;
    end;
    After := GetTickCount;
    form2.Edit2.Text := 'Forbrugt tid : ' + IntToStr(After-Before);

end;

end.

Har nu afprøvet ovenstående, med progressbar max 2500 og får på en Quad core´, selve afviklingen af de 3 tråde tager det 1594 og når det køres via botton2 tager det 826, så noget kan tyde på, at programmet ikke bruger 3 cpu'er, kan nogen teste det på en anden computer, idet jeg ikke fatter hvorfor det tager længere tid med brug af tråde

Du har skrevet en masse linier, men de linier laver en masse interaktion med main traad.

Jeg kan ikke laengere umiddelbart genneskue hvorfor den ikke koerer fuld skrue paa flere cores.

Men koden er ihvertfald meget lidt velegnet til at vise brug af traade og flere cores.

Jeg forstår ikke helt hvad du mener med at de enkelte tråde har interaktion med main tråden, det er sikkert fordi jeg ikke helt forstår det her, håber der er nogen der kan åbenbare dette for mig

Hvis de tråde skal bruge mange CPU kerner, så skal de lave noget.

Jeg kan godt prøv og se om jeg kan bixe et eksempel.

Ja, mit program skal bruge meget CPU kraft, så hver tråd vil få hver deres opgave, hvor de enkelte tråd skal levere data til den næste og så fremdeles, opgaven vil formentlig dage en uge eller måske 2, kommer lidt an på, hvor meget CPU kraft man får, det tager ihvertfald mere end en måned ved brug af en enkelt 3 Ghz CPU, så hvis du kan stykke noget sammen, vil jeg blive meget glad, for forstår nemlig ikke hvorfor det ikke bare bruger cpu'erne fuldt ud

Hele pointen er at du sjak lave noget CPU intensivt for at brug kernerne.

Prøv og køre følgende og se om den kan få alle dine kerner i brug:

program thrfun2;

{$APPTYPE CONSOLE}

uses
  Classes,
  SysUtils,
  Windows;

type
  TMyThread1 = class(TThread)
      protected
        procedure Execute; override;
      end;
  TMyThread1Range = 1..8;
  TMyThread1Array = array [TMyThread1Range] of TMyThread1;

procedure TMyThread1.Execute;

const
  REP = 100;
  N = 1000000000;

var
  sum, i, j  : integer;

begin
  for J := 1 to REP do begin
    sum := 0;
    for i := 0 to (N - 1) do begin
      sum := ((sum + 1) * 2 + 1) div 2;
    end;
    if sum <> N then writeln('Houston we have a problem');;
  end;
end;

var
  T : TMyThread1Array;
  i : TMyThread1Range;

begin
  for i := 1 to 8 do T[i] := TMyThread1.Create(True);
  for i := 1 to 8 do T[i].Resume;
  for i := 1 to 8 do T[i].WaitFor;
  for i := 1 to 8 do T[i].Destroy;
end.

OK mange tak Arne, jeg har puttet indholdet af din tråd ind i hver af mine 3 tråde og jeg får fuld CPU belastning på alle 4 cpu'er.

Kan du forklare lidt om hvad det betyder at tråden udfører interaktion med main tråden, har testet at application.ProcessMessages, Synchronize(DoProgress) og opdatering edit.text tager en masse CPU kraft, men gælder det også globe variable, som jeg vil bruge til at styre de 3 tråde ?

Smid et svar Arne, det har bragt mig til en vis forståelse for hvad man kan/må putte ind i en tråd.

Hvis det ellers lige nogle guldkorn omkring generell brug af tråde, ja så lytter jeg gerne´.

Jeg mistænkte:

Synchronize(DoProgress);

Application.ProcessMessages;

for at forhindre trådene i at gnaske masser af CPU i sig.

Men hvis du siger at de er OK, så er forskellen nok snarere at min kode have en meget tung beregning.

Tilgang til globale variable koster ikke i sig selv noget, men den synkronisering du skal bruge for at undgå concurrency problemer kan godt koste noget. Så det skal du designe forsigtigt.

Og et svar.

Jeg forstår ikke helt dine kvaler .. Det er bare at sætte trådene i gang så klarer Windows resten.

Jeg har lavet et eksempel her : borrisholt.dk/Eksperten/Thread.zip

Lidt GUI og lidt "matematik"

Hvad angår spil2vind / ArneV forslag så vil de give en AV idet GetCPUID piller i EBX registeret uden at gemme den orginale værdi først ...

En løsning kunne se således ud :

onst
  ID_BIT = $200000; // EFLAGS ID bit
type
  TVendor = array[0..11] of Char;
  TCPUID = array[1..4] of Longint;

function IsCPUID_Available: Boolean; register;
asm
    PUSHFD {direct access to flags no possible, only via stack}
    POP EAX {flags to EAX}
    MOV EDX,EAX {save current flags}
    XOR EAX,ID_BIT {not ID bit}
    PUSH EAX {onto stack}
    POPFD {from stack to flags, with not ID bit}
    PUSHFD {back to stack}
    POP EAX {get back to EAX}
    XOR EAX,EDX {check if ID bit affected}
    JZ @exit {no, CPUID not availavle}
    MOV AL,True {Result=True}
    @exit:
end;

function GetCPUID: TCPUID; assembler; register;
asm
    PUSH    EBX        {Save affected register}
    PUSH    EDI
    MOV    EDI,EAX    {@Resukt}
    MOV    EAX,1
    DW      $A20F      {CPUID Command}
    STOSD                {CPUID[1]}
    MOV    EAX,EBX
    STOSD              {CPUID[2]}
    MOV    EAX,ECX
    STOSD              {CPUID[3]}
    MOV    EAX,EDX
    STOSD              {CPUID[4]}
    POP    EDI        {Restore registers}
    POP    EBX
end;

function GetCPUVendor: TVendor; assembler; register;
asm
      PUSH EBX {Save affected register}
      PUSH EDI
      MOV EDI,EAX {@Result (TVendor)}
      MOV EAX,0
      DW $A20F {CPUID Command}
      MOV EAX,EBX
      XCHG EBX,ECX {save ECX result}
      MOV ECX,4
      @1:
      STOSB
      SHR EAX,8
      LOOP @1
      MOV EAX,EDX
      MOV ECX,4
      @2:
      STOSB
      SHR EAX,8
      LOOP @2
      MOV EAX,EBX
      MOV ECX,4
      @3:
      STOSB
      SHR EAX,8
      LOOP @3
      POP EDI {Restore registers}
      POP EBX
end;

Skal det så omformes til en streng  kunne man gøre noget alla det her :

function GetCPUInfo: string;
var
  CPUID: TCPUID;
  I: Integer;
  S: TVendor;
begin
  for I := Low(CPUID) to High(CPUID) do
    CPUID[I] := -1;
  if IsCPUID_Available then
  begin
    CPUID := GetCPUID;
    S := GetCPUVendor;
    Result := IntToHex(CPUID[1], 8)
      + '-' + IntToHex(CPUID[2], 8)
      + '-' + IntToHex(CPUID[3], 8)
      + '-' + IntToHex(CPUID[4], 8);
  end
  else
    Result := 'CPUID not available';
end;

Grunden til jeg ikke har det med i mit eksempel er fordi jeg ikke lige kunne få funktionerne til at exekvere fra andet en mail tråden, fordi så passede register værdierne ikke, og jeg gad ikke at debugge ;)

Det samme vil gøre sig gældende for spil2vind / ArneV hvis ellers man rettede den AV så vil CPUID være det der tilhørte main tråden, fordi det er i den koden er exekveret.

Jens B

Jeg skrev at ProcessMessages og Synchronize(DoProgress) gjorde at løkken blev bremset, men ok, jeg fik jo styr på hvorledes man skal bruge flere tråde, men forstår ikke helt Boris, dit svar kan jeg ikke se, at det skulle give en større forståelse for brug af tråde, det er vel i grunden lige gyldigt hvilken cpu tråden kører? forstår udfra det Arne skriver at windows selv vælger den cpu der er mindst belastet eller fortolker jeg helt forkert?

Hvis windows ikke selv placer trådene på forskellige cpu'er vil det jo være nødvendigt at vide hvorledes man tildeler tråde til hver sin cpu.

spil2vind>>Det er fuldstendig korrekt ... Den eneste grund til jeg begynte at intressere mig for hvilken tråd der kørte på hvilken CPU var fordi dig/arne v begynte ... Jeg ville jeg bare gøre opmærksom på ar jeres måde at hente CPUID var forkert.

Hvis du henter mit eksempel på http://borrisholt.dk/Eksperten/Thread.zip vil du også opdage at i det er der vist hvordan man arbejder med tråde, og hvordan man får det synkroniseret med main tråden.

Jeg har heller ikke noget CPU halløj i mit eksempel.

D ogsåopdage at Application.ProcessMessages er forkert at kalde inde i en tråd. Dels er det 100% overflødigt og dels er resultatet af kaldet uforudsigeligt ...

Det der tilgændgæld er 100% forudsigeligt er at hvis du piller i EBX registeret UDEN at gemme det først og restore værdien bagefter så får du en AV ganske som tidligere belyst.

Nu brugte jeg nu bare ProcessMessages til at kunne se fremskridt på skærmen, at det ødelagde tråden fandt jeg så udaf, men tak for dine input, rart at få info omkring brug af tråde, samt de fælder der nu er, samt andres erfaringer, glæder mig faktisk til at afprøve det med min opgave, som har en masse ting, som kan opdeles i tråde, dog er opgaven jo noget svær, idet den enkelte tråd, skal afvente at den forrige er færdig eller har fundet en løsning til opgaven.

En tråd har et onterminate Event ...

CPUID er ikke specielt vigtigt for problem stilling. Den kom kun på banen for at vise at trådene faktisk kørte på forskellige CPU'er.

En hurtig googling siger at har ret i at EBX skal bevares. Så koden må skulle være:

function GetCPUID : integer; assembler; register;

asm
  PUSH    EBX
  MOV    EAX,1
  DW      $A20F      {CPUID Command}
  SHR    EBX, 24
  MOV    EAX, EBX
  POP    EBX
end;

Imidlertid gav den ingen fejl i eksemplet, så det problem opdagede jeg ikke. EBX må tilsyneladende ikke blive brugt i den kode. Men det kunne den jo nemt blive i noget andet kode.

Funktionen bliver kaldt i de startede tråde ikke i main tråd.