如何让我的应用程序在多个核心上运行？

Question

我在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,参数不正确.我很确定这SingleProcessorMask是正确的.是否有问题TThread.Handle？

如果我将此代码称为管理员,在笔记本电脑上运行或在i9上运行,则无关紧要.结果总是一样的.

是的,我确实需要强制线程,否则它们都会聚集在同一个核心上.

更新
一旦我修复了进程关联以匹配系统关联,就没有必要将每个线程分配给特定的核心.在这种情况下,自动处理工作.这是使用:

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

Answer 1

看起来您正在尝试为除运行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;