multithreading - 如何使我的应用程序在多个内核上运行？

我在Windows 10上运行以下代码。

  function SingleProcessorMask(const ProcessorIndex: Integer): DWORD_PTR;
  begin
    Result:= 1; Result:= Result shl (ProcessorIndex);  //Make sure it works on processor 33 and up.
  end;

procedure TForm2.BtnCreateLookup5x5to3x3UsingSpeculativeExplorationClick(Sender: TObject);
var
  ThreadCount: integer;
  Threads: TArray<TThread>;
  CurrentProcessor: integer;
  i,a: integer;
  Done: boolean;
begin
  ThreadCount:= System.CpuCount;
  SetLength(Threads, ThreadCount);
  CurrentProcessor:= GetCurrentProcessorNumber;
  a:= 0;
  for i:= 1 to ThreadCount-1 do begin
    Threads[i]:= TThread.CreateAnonymousThread(procedure begin
      CreateLookupUsingGridSolver(i, ThreadCount);
    end);
    Threads[i].FreeOnTerminate:= false;
    if (CurrentProcessor = a) then Inc(a);  //Skip the current processor.
    Inc(a);
    //if (SetThreadAffinityMask(Threads[i].handle, SingleProcessorMask(a))) = 0 then RaiseLastOSError;  << fails here as well.
    Threads[i].Start;
    if (SetThreadAffinityMask(Threads[i].handle, SingleProcessorMask(a))) = 0 then RaiseLastOSError;
  end; {for i}
  CreateLookupUsingGridSolver(0, ThreadCount, NewLookup);
  {Wait for all threads to finish}
  .....
  //Rest of the proc omitted to save space.
end;

我不断收到错误87，参数错误。
我相当确定the SingleProcessorMask is correct。
TThread.Handle可能有问题吗？

我是否将此代码称为以管理员身份运行，在笔记本电脑上运行还是在i9上运行都没有关系。结果总是一样的。

是的，我确实确实需要强制使用线程，否则它们都将聚集在同一个内核上。

更新
一旦我确定了进程亲和力以匹配系统亲和力，就无需为每个线程分配一个特定的内核而费解了。在这种情况下，自动处理将起作用。使用以下命令完成此操作：

GetProcessAffinityMask(GetCurrentProcess(), ProcessAffinityMask, SystemAffinityMask);
SetProcessAffinityMask(GetCurrentProcess(), SystemAffinityMask);
//Error checking omitted for brevity

最佳答案

看起来您正在尝试为运行OnClick处理程序的“当前” CPU以外的每个CPU创建单独的线程。但是，永远不要在亲和力掩码中使用CPU 0，因为您过早增加a。但更重要的是，线程的亲和力掩码必须是进程的亲和力掩码的子集，它指定允许进程在其上运行的CPU：


线程只能在其进程可以运行的处理器上运行。因此，当进程亲和力掩码为处理器指定0位时，线程亲和力掩码不能为处理器指定1位。


进程亲和力掩码本身是系统亲和力掩码的子集，它指定要安装的CPU。

因此，错误的可能原因是您正在计算操作系统拒绝对进程无效的线程相似性掩码。

改用类似这样的方法（注意：如果操作系统安装了64个以上的CPU，则不会考虑CPU处理器组）：

procedure TForm2.BtnCreateLookup5x5to3x3UsingSpeculativeExplorationClick(Sender: TObject);
var
  ThreadCount, MaxThreadCount: integer;
  Threads: TArray<TThread>;
  i, CurrentProcessor: integer;
  ProcessAffinityMask, SystemAffinityMask, AllowedThreadMask, NewThreadMask: DWORD_PTR;
  Thread: TThread;
  ...
begin
  if not GetProcessAffinityMask(GetCurrentProcess(), ProcessAffinityMask, SystemAffinityMask) then RaiseLastOSError;

  // optional: up the CPUs this process can run on, if needed...
  {
  if not SetProcessAffinityMask(GetCurrentProcess(), SystemAffinityMask) then RaiseLastOSError;
  ProcessAffinityMask := SystemAffinityMask;
  }

  AllowedThreadMask := DWORD_PTR(-1) and ProcessAffinityMask;
  CurrentProcessor := GetCurrentProcessorNumber;

  ThreadCount := 0;
  MaxThreadCount := System.CpuCount;
  NewThreadMask := 1;

  SetLength(Threads, MaxThreadCount);
  try
    for i := 0 to MaxThreadCount-1 do
    begin
      if (i <> CurrentProcessor) and //Skip the current processor.
         ((AllowedThreadMask and NewThreadMask) <> 0) then // is this CPU allowed?
      begin
        Thread := TThread.CreateAnonymousThread(
          procedure
          begin
            CreateLookupUsingGridSolver(...);
          end
        );
        try
          Thread.FreeOnTerminate := false;
          if not SetThreadAffinityMask(Thread.Handle, NewThreadMask) then RaiseLastOSError;
          Thread.Start;
        except
          Thread.Free;
          raise;
        end;
        Threads[ThreadCount] := Thread;
        Inc(ThreadCount);
      end;
      NewThreadMask := NewThreadMask shl 1;
    end;
    CreateLookupUsingGridSolver(...);

    // Wait for all threads to finish...
    // ...

  finally
    for i := 0 to ThreadCount-1 do
      Threads[i].Free;
  end;
end;