FPPS4/sys/md/md_proc.pas

127 lines
2.8 KiB
Plaintext

unit md_proc;
{$mode ObjFPC}{$H+}
{$CALLING SysV_ABI_CDecl}
interface
uses
ntapi,
windows;
function cpuset_setproc(new:Ptruint):Integer;
function cpuset_getproc(var old:Ptruint):Integer;
function get_proc_prio():Integer;
function set_proc_prio(n:Integer):Integer;
Procedure md_halt(errnum:DWORD); noreturn;
implementation
uses
kern_proc;
function cpuset_setproc(new:Ptruint):Integer;
var
info:SYSTEM_INFO;
i,m,t,n:Integer;
begin
new:=new and $FF;
info.dwNumberOfProcessors:=1;
GetSystemInfo(info);
if (info.dwNumberOfProcessors<8) then
begin
//remap
m:=0;
for i:=0 to 7 do
begin
t:=(new shr i) and 1;
n:=(i mod info.dwNumberOfProcessors);
m:=m or (t shl n);
end;
new:=m;
end;
Result:=NtSetInformationProcess(NtCurrentProcess,
ProcessAffinityMask,
@new,
SizeOf(QWORD));
end;
function cpuset_getproc(var old:Ptruint):Integer;
var
info:PROCESS_BASIC_INFORMATION;
begin
Result:=NtQueryInformationProcess(NtCurrentProcess,
ProcessBasicInformation,
@info,
SizeOf(info),
nil);
if (Result=0) then
begin
old:=info.AffinityMask;
end;
end;
function get_proc_prio():Integer;
var
info:PROCESS_PRIORITY_CLASS;
begin
Result:=NtQueryInformationProcess(NtCurrentProcess,
ProcessPriorityClass,
@info,
SizeOf(info),
nil);
if (Result=0) then
begin
Result:=0;
case info.PriorityClass of
PROCESS_PRIORITY_CLASS_IDLE :Result:=-20;
PROCESS_PRIORITY_CLASS_BELOW_NORMAL:Result:=-10;
PROCESS_PRIORITY_CLASS_NORMAL :Result:=0;
PROCESS_PRIORITY_CLASS_ABOVE_NORMAL:Result:=10;
PROCESS_PRIORITY_CLASS_HIGH :Result:=20;
else;
end;
end else
begin
Result:=0;
end;
end;
function set_proc_prio(n:Integer):Integer;
var
info:PROCESS_PRIORITY_CLASS;
begin
info.Foreground :=False;
info.PriorityClass:=PROCESS_PRIORITY_CLASS_NORMAL;
case n of
-20..-14:info.PriorityClass:=PROCESS_PRIORITY_CLASS_IDLE;
-13.. -7:info.PriorityClass:=PROCESS_PRIORITY_CLASS_BELOW_NORMAL;
-6.. 6:info.PriorityClass:=PROCESS_PRIORITY_CLASS_NORMAL;
7.. 13:info.PriorityClass:=PROCESS_PRIORITY_CLASS_ABOVE_NORMAL;
14.. 20:info.PriorityClass:=PROCESS_PRIORITY_CLASS_HIGH;
else;
end;
Result:=NtSetInformationProcess(NtCurrentProcess,
ProcessPriorityClass,
@info,
SizeOf(info));
end;
Procedure md_halt(errnum:DWORD); noreturn;
begin
NtTerminateProcess(NtCurrentProcess, errnum);
end;
end.