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

时间:2018-11-08 15:34:01

标签: multithreading delphi winapi

我在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 correctTThread.Handle可能有问题吗?

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

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

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

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

2 个答案:

答案 0 :(得分:5)

似乎您正在尝试为运行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;

答案 1 :(得分:4)

SetThreadAffinityMask有两个参数,线程句柄和掩码。从代码中可以很明显地看出线程句柄是有效的。离开面具。 documentation明确声明以下内容:

  

如果线程关联掩码请求未为进程关联掩码选择的处理器,则最后一个错误代码为ERROR_INVALID_PARAMETER

很难看到还有什么可以解释您举报的行为。