时间戳

首页 > 解决方案 > 如何让我的应用程序在多个内核上运行？

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，参数不正确。我相当确定这SingleProcessorMask是正确的。可能有问题TThread.Handle吗？

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

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

更新
一旦我修复了进程亲和性以匹配系统亲和性，就无需将每个线程分配给特定的核心。在这种情况下，自动处理工作。这是使用以下方法完成的：

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

标签： multithreadingdelphiwinapi

解决方案

看起来您正在尝试为每个 CPU 创建一个单独的线程，而不是运行您的处理程序的“当前”CPU OnClick。但是，你永远不会在你的关联掩码中使用 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;

推荐阅读