我在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:
A thread can only run on the processors its process can run on. Therefore, the thread affinity mask cannot specify a 1 bit for a processor when the process affinity mask specifies a 0 bit for that processor.
进程亲和力掩码本身是系统亲和力掩码的子集,它指定要安装的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;
关于multithreading - 如何使我的应用程序在多个内核上运行?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/53211041/