+

rtl/ntapi.pas

@@ -51,6 +51,7 @@ const
  ProcessIoCounters      =2;
  ProcessVmCounters      =3;
  ProcessTimes           =4;
+ ProcessAffinityMask    =21;
 
  FileStandardInformation  = 5;
  FilePositionInformation  =14;
@@ -146,6 +147,17 @@ type
   BasePriority  :DWORD;
  end;
 
+ PPROCESS_BASIC_INFORMATION=^PROCESS_BASIC_INFORMATION;
+ PROCESS_BASIC_INFORMATION=packed record
+  ExitStatus      :DWORD;
+  _align          :DWORD;
+  PebBaseAddress  :QWORD;
+  AffinityMask    :QWORD;
+  BasePriority    :QWORD;
+  UniqueProcessId :QWORD;
+  InheritedFromUPI:QWORD;
+ end;
+
  PKERNEL_USER_TIMES=^KERNEL_USER_TIMES;
  KERNEL_USER_TIMES=packed record
   CreateTime:LARGE_INTEGER;
@@ -258,6 +270,13 @@ function NtQueryInformationProcess(
           ReturnLength            :PULONG
          ):DWORD; stdcall; external 'ntdll';
 
+function NtSetInformationProcess(
+          ProcessHandle:THandle;
+          ProcessInformationClass:DWORD;
+          ProcessInformation:Pointer;
+          ProcessInformationLength:ULONG
+         ):DWORD; stdcall; external 'ntdll';
+
 function NtSetInformationThread(
           ThreadHandle:THandle;
           ThreadInformationClass:DWORD;

sys/kern/kern_cpuset.pas

@@ -1,12 +1,10 @@
 unit kern_cpuset;
 
 {$mode ObjFPC}{$H+}
+{$CALLING SysV_ABI_CDecl}
 
 interface
 
-uses
- trap;
-
 type
  p_cpuset_t=^cpuset_t;
  cpuset_t  =array[0..1] of QWORD;
@@ -31,27 +29,47 @@ uses
 function sys_cpuset_getaffinity(level,which:Integer;id,cpusetsize:QWORD;mask:p_cpuset_t):Integer;
 var
  td:p_kthread;
+ old:QWORD;
 begin
  if (cpusetsize<SizeOf(cpuset_t)) then Exit(ERANGE);
 
  if (level<>CPU_LEVEL_WHICH) then Exit(EINVAL);
- if (level<>CPU_WHICH_TID)   then Exit(EINVAL);
 
- if (int64(id)=-1) then
- begin
-  td:=curkthread;
-  thread_inc_ref(td);
- end else
- begin
-  td:=tdfind(id);
+ Case which of
+  CPU_WHICH_TID:
+    begin
+     if (int64(id)=-1) then
+     begin
+      td:=curkthread;
+      thread_inc_ref(td);
+     end else
+     begin
+      td:=tdfind(id);
+     end;
+
+     if (td=nil) then Exit(ESRCH);
+
+     old:=td^.td_cpuset;
+
+     thread_dec_ref(td);
+    end;
+  CPU_WHICH_PID:
+    begin
+     if (int64(id)=-1) or (id=g_pid) then
+     begin
+      Result:=cpuset_getproc(old);
+      if (Result<>0) then Exit(ESRCH);
+     end else
+     begin
+      Exit(ESRCH);
+     end;
+    end;
+  else
+    Exit(EINVAL);
  end;
 
- if (td=nil) then Exit(ESRCH);
-
- Result:=copyout(@td^.td_cpuset,mask,SizeOf(QWORD));
+ Result:=copyout(@old,mask,SizeOf(QWORD));
  if (Result<>0) then Result:=EFAULT;
-
- thread_dec_ref(td);
 end;
 
 function sys_cpuset_setaffinity(level,which:Integer;id,cpusetsize:QWORD;mask:p_cpuset_t):Integer;
@@ -62,31 +80,46 @@ begin
  if (cpusetsize<SizeOf(cpuset_t)) then Exit(ERANGE);
 
  if (level<>CPU_LEVEL_WHICH) then Exit(EINVAL);
- if (level<>CPU_WHICH_TID)   then Exit(EINVAL);
-
- if (int64(id)=-1) then
- begin
-  td:=curkthread;
-  thread_inc_ref(td);
- end else
- begin
-  td:=tdfind(id);
- end;
-
- if (td=nil) then Exit(ESRCH);
 
  Result:=copyin(mask,@new,SizeOf(QWORD));
+ if (Result<>0) then Exit(EFAULT);
 
- if (Result<>0) then
- begin
-  Result:=EFAULT;
- end else
- begin
-  Result:=cpuset_setaffinity(td,new);
-  if (Result<>0) then Result:=ESRCH;
+ Case which of
+  CPU_WHICH_TID:
+    begin
+     if (int64(id)=-1) then
+     begin
+      td:=curkthread;
+      thread_inc_ref(td);
+     end else
+     begin
+      td:=tdfind(id);
+     end;
+
+     if (td=nil) then Exit(ESRCH);
+
+     Result:=cpuset_setaffinity(td,new);
+     if (Result<>0) then Result:=ESRCH;
+
+     thread_dec_ref(td);
+    end;
+  CPU_WHICH_PID:
+    begin
+     begin
+      if (int64(id)=-1) or (id=g_pid) then
+      begin
+       Result:=cpuset_setproc(new);
+       if (Result<>0) then Result:=ESRCH;
+      end else
+      begin
+       Exit(ESRCH);
+      end;
+     end;
+    end
+  else
+    Exit(EINVAL);
  end;
 
- thread_dec_ref(td);
 end;
 
 end.

sys/kern/vm_machdep.pas

@@ -14,10 +14,15 @@ uses
  sys_kernel,
  kern_thread;
 
+var
+ g_pid:DWORD=0;
+
 function  cpu_thread_alloc(td:p_kthread):Integer;
 function  cpu_thread_free(td:p_kthread):Integer;
 procedure cpu_set_syscall_retval(td:p_kthread;error:Integer);
 function  cpuset_setaffinity(td:p_kthread;new:Ptruint):Integer;
+function  cpuset_setproc(new:Ptruint):Integer;
+function  cpuset_getproc(var old:Ptruint):Integer;
 procedure cpu_set_user_tls(td:p_kthread;base:Pointer);
 function  cpu_set_priority(td:p_kthread;prio:Integer):Integer;
 function  cpu_getstack(td:p_kthread):QWORD;
@@ -171,6 +176,26 @@ begin
  Result:=NtSetInformationThread(td^.td_handle,ThreadAffinityMask,@new,SizeOf(Ptruint));
 end;
 
+function cpuset_setproc(new:Ptruint):Integer;
+begin
+ 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(PROCESS_BASIC_INFORMATION),
+                                   nil);
+ if (Result=0) then
+ begin
+  old:=info.AffinityMask;
+ end;
+end;
+
 procedure cpu_set_user_tls(td:p_kthread;base:Pointer); inline;
 begin
  td^.pcb_fsbase:=base;
@@ -434,6 +459,8 @@ begin
   PROC_UNLOCK;
 end;
 
+initialization
+ g_pid:=GetCurrentProcessId;
 
 end.
 

sys/pthread_md.pas

@@ -0,0 +1,60 @@
+unit pthread_md;
+
+{$mode ObjFPC}{$H+}
+{$CALLING SysV_ABI_CDecl}
+
+interface
+
+uses
+ kern_thread;
+
+const
+ KSE_STACKSIZE=16384;
+ DTV_OFFSET   =8;
+
+type
+ p_kcb=^kcb;
+ p_tcb=^tcb;
+
+ kcb=packed record
+  kcb_curtcb:p_tcb;
+  kcb_self  :p_kcb;
+  kcb_kse   :Pointer; //kse
+  //kcb_kmbx:kse_mailbox;
+ end;
+
+ tcb=packed record
+  tcb_self  :Pointer;
+  tcb_dtv   :Pointer;
+  tcb_thread:Pointer;
+  tcb_spare :Pointer;
+  //tcb_tmbx:kse_thr_mailbox
+ end;
+
+function _get_curthread:Pointer;
+
+implementation
+
+function _kcb_curtcb:p_tcb; assembler; nostackframe;
+asm
+ movqq %gs:teb.tcb,Result
+end;
+
+function _get_curthread:Pointer; inline;
+var
+ tcb:p_tcb;
+begin
+ tcb:=_kcb_curtcb;
+ if (tcb<>nil) then
+ begin
+  Result:=tcb^.tcb_thread;
+ end else
+ begin
+  Result:=nil;
+ end;
+end;
+
+
+
+end.
+

sys/sys_cpuset.pas

@@ -1,6 +1,7 @@
 unit sys_cpuset;
 
 {$mode ObjFPC}{$H+}
+{$CALLING SysV_ABI_CDecl}
 
 interface
 

sys/test/project1.lpi

@@ -141,6 +141,10 @@
         <Filename Value="..\sys_cpuset.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="..\pthread_md.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

sys/test/project1.lpr

@@ -18,6 +18,7 @@ uses
  trap,
  sys_sig,
  md_psl,
+ pthread_md,
  sysutils;
 
 var