Hallo

Ich wollte mal probieren, ob ich einen Thread zur Laufzeit eines Programmes einem bestimmten CPU-Kern zuweisen kann. Auf einem Dual-Core und auch Quad-Core lief alles. Jetzt habe ich das Testprogramm jemanden testen lassen, der eine aktuelle Intel-CPU (Sandy Bridge) hat. Die soll wohl 4 Kerne und zusätzlich 4 virtuelle Kerne haben. Und prompt macht mein Programm nicht das, was es soll.
Wer will, kann das Programm gerne selbst testen. http://darkware.de/SwitchThreadAtRuntime.exe

Wäre nett, wenn das jemand probieren würde bzw. sich zumindest mal den Quellcode anschaut.

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit_Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Combobox_numcores: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  function getNumCPUs:integer;

var
  Form1: TForm1;
  Thread:TMyThread;
  Tmyhandle:Cardinal;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var selCore:integer;
begin
  FreeandNil(Thread);
  selCore:=Combobox_numcores.ItemIndex;

  Thread:=TMyThread.Create(false);
  Tmyhandle:=Thread.Handle;
  setThreadAffinityMask(Tmyhandle,1 shl selCore);

  Button1.Enabled:=false;
  Button2.Enabled:=true;
  Button3.Enabled:=true;
end;

// get the number of installed cpu's
function getNumCPUs:integer;
var
  SystemInfo: TSystemInfo;
begin
  GetSystemInfo(SystemInfo);
  Result:=SystemInfo.dwNumberOfProcessors;
End;

procedure TForm1.Button2Click(Sender: TObject);
var selCore:integer;
begin
  selCore:=Combobox_numcores.ItemIndex;

  Tmyhandle:=Thread.Handle;
  setThreadAffinityMask(Tmyhandle,1 shl selCore);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Thread.Terminate;
  Button1.Enabled:=true;
  Button2.Enabled:=false;
  Button3.Enabled:=false;
end;

procedure TForm1.FormShow(Sender: TObject);
var numCores:integer;
    i:integer;
begin
  NumCores:=getNumCPUs();
  Combobox_numcores.Clear;
  for i:=1 to NumCores do
    Begin
      Combobox_numcores.Items.Add(inttostr(i));
    End;
  ComboBox_numcores.ItemIndex:=0;
end;

end.

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit_Thread;

interface

uses
  Classes;

type

TMyThread = class(TThread)
  private
    { Private-Deklarationen }
  protected
    Zaehler:integer;
    procedure Execute; override;
  end;


implementation

procedure TMyThread.Execute;
var zaehler:integer;
Begin
  Zaehler:=0;

  while not Terminated do
  Begin
    Zaehler:=Zaehler+1;
    if Zaehler>=100000 then Zaehler:=0;
  End;
end;

end.

In Delphi Windows wird ein Thread nicht sofort gestartet, wenn er erstellt wurde.

Tmyhandle wird da vermutlich noch 0 sein, wenn du es abrufst.
Außerdem hat SetThreadAffinityMask einen Rückgabewert, welchen man auch noch prüfen kann.

Leider ist dieses ein Problem, welches man schwer debuggen kann, denn wenn man im Einzelschritt über TMyThread.Create(false); und ds Abfragen von Thread.Handle geht, dann wird durch den Eingriff des debuggers vermutlich zwischenzeitlich der andere Thread doch "sofort" gestartet.

markieren

Delphi-Quellcode:

Thread := TMyThread.Create(false);
if Thread.Handle = 0 then
  ShowMessage('nee, is noch nich');
Tmyhandle := Thread.Handle;
...

Aber versuch es mal so

markieren

Delphi-Quellcode:

Thread := TMyThread.Create(false);
Application.ProcessMessages;
Sleep(20);
Application.ProcessMessages;
if Thread.Handle = 0 then
  ShowMessage('nee, is noch nich');
Tmyhandle := Thread.Handle;
...

Und ja, das ist mein voller Ernst.
- Sleep, damit Windows mal aus den Puschen kommt
- und ProcessMessages für's Delphi

In Windows gibt es für jedes Programm ein gewisses Zeitfenster und da kann es schonmal ein paar Millisekunden dauern, bis ein (neuer) Thread reagiert.

Ansonsten solltest du das SetThreadAffinityMask einfach als ersten Befehl im Execute des Threads ausführen, denn zu diesem Zeitpunkt existiert der Thread auf jeden Fall.
selCore in diesem Fall einfach mit an den Thread übergeben, bevor er gestartet wird. (Propert oder in einem eigenem Constructor).

Zitat von himitsu:

- Sleep, damit Windows mal aus den Puschen kommt

Sleep mit 0 kann ich nur empfehlen. Es ist nicht soooo wichtig dort einen Wert größer Null zu geben, da 20ms ohnehin "relativ" sind (auf einem Rechner passiert da was, auf 'nem anderen eher noch nicht). Mit Sleep(0) forciert man die Abgabe der eigenen Rechenzeit.

Zitat von MSDN:

A value of zero causes the thread to relinquish the remainder of its time slice to any other thread that is ready to run. If there are no other threads ready to run, the function returns immediately, and the thread continues execution.
Windows XP/2000: A value of zero causes the thread to relinquish the remainder of its time slice to any other thread of equal priority that is ready to run. If there are no other threads of equal priority ready to run, the function returns immediately, and the thread continues execution. This behavior changed starting with Windows Server 2003.

Zunächst mal bedanke ich mich für Eure Hilfe. Der Fehler lag nicht im Quellcode, sondern der "Übeltäter" war der Cache von Firefox. Ich hatte nämlich in einer vorherigen Version einen Fehler. Und genau diese Version des Programmes lag noch im Cache von Firefox. Dementsprechend hat der Tester immer die fehlerhafte Version getestet.

Peinlich peinlich... sorry.

Sleep(0) hat leider nicht immer ausgereicht, wobei mir es so auch lieber gewesen wäre
Sleep(20) war ein guter Wert ... bisher noch immer lang genug und sonst kaum zu spüren (wenn man es nicht zu oft aufruft)


Ansonsten ... wenigstens mal Einer mit einem guten Ende.

himitsu, Deinen Vorschlag habe ich trotzdem sicherheitshalber eingebaut. Man weiß ja nie.