+

sys/kern/kern_cpuset.pas

@@ -15,8 +15,8 @@ const
  CPU_WHICH_TID   =1; // Specifies a thread id.
  CPU_WHICH_PID   =2; // Specifies a process id.
 
-function sys_cpuset_getaffinity(level,which:Integer;id,cpusetsize:QWORD;mask:p_cpuset_t):Integer;
-function sys_cpuset_setaffinity(level,which:Integer;id,cpusetsize:QWORD;mask:p_cpuset_t):Integer;
+function sys_cpuset_getaffinity(level,which,id:Integer;cpusetsize:QWORD;mask:p_cpuset_t):Integer;
+function sys_cpuset_setaffinity(level,which,id:Integer;cpusetsize:QWORD;mask:p_cpuset_t):Integer;
 
 implementation
 
@@ -28,7 +28,7 @@ uses
  md_thread,
  md_proc;
 
-function sys_cpuset_getaffinity(level,which:Integer;id,cpusetsize:QWORD;mask:p_cpuset_t):Integer;
+function sys_cpuset_getaffinity(level,which,id:Integer;cpusetsize:QWORD;mask:p_cpuset_t):Integer;
 var
  td:p_kthread;
  old:QWORD;
@@ -40,7 +40,7 @@ begin
  Case which of
   CPU_WHICH_TID:
     begin
-     if (Integer(id)=-1) then
+     if (id=-1) then
      begin
       td:=curkthread;
       thread_inc_ref(td);
@@ -57,7 +57,7 @@ begin
     end;
   CPU_WHICH_PID:
     begin
-     if (Integer(id)=-1) or (id=g_pid) then
+     if (id=-1) or (id=g_pid) then
      begin
       Result:=cpuset_getproc(old);
       if (Result<>0) then Exit(ESRCH);
@@ -73,7 +73,7 @@ begin
  Result:=copyout(@old,mask,SizeOf(QWORD));
 end;
 
-function sys_cpuset_setaffinity(level,which:Integer;id,cpusetsize:QWORD;mask:p_cpuset_t):Integer;
+function sys_cpuset_setaffinity(level,which,id:Integer;cpusetsize:QWORD;mask:p_cpuset_t):Integer;
 var
  td:p_kthread;
  new:QWORD;
@@ -88,7 +88,7 @@ begin
  Case which of
   CPU_WHICH_TID:
     begin
-     if (Integer(id)=-1) then
+     if (id=-1) then
      begin
       td:=curkthread;
       thread_inc_ref(td);
@@ -107,7 +107,7 @@ begin
   CPU_WHICH_PID:
     begin
      begin
-      if (Integer(id)=-1) or (id=g_pid) then
+      if (id=-1) or (id=g_pid) then
       begin
        Result:=cpuset_setproc(new);
        if (Result<>0) then Result:=ESRCH;

sys/kern/kern_ksched.pas

@@ -0,0 +1,327 @@
+unit kern_ksched;
+
+{$mode ObjFPC}{$H+}
+{$CALLING SysV_ABI_CDecl}
+
+interface
+
+uses
+ rtprio,
+ time;
+
+const
+ //POSIX scheduling policies
+ SCHED_FIFO =1;
+ SCHED_OTHER=2;
+ SCHED_RR   =3;
+
+type
+ p_sched_param=^t_sched_param;
+ t_sched_param=packed record
+  sched_priority:Integer;
+ end;
+
+ p_ksched=^t_ksched;
+ t_ksched=packed record
+  rr_interval:timespec;
+ end;
+
+function sys_sched_setparam(pid:Integer;param:p_sched_param):Integer;
+function sys_sched_getparam(pid:Integer;param:p_sched_param):Integer;
+function sys_sched_setscheduler(pid,policy:Integer;param:p_sched_param):Integer;
+function sys_sched_getscheduler(pid:Integer):Integer;
+function sys_sched_get_priority_max(policy:Integer):Integer;
+function sys_sched_get_priority_min(policy:Integer):Integer;
+function sys_sched_rr_get_interval(pid:Integer;interval:ptimespec):Integer;
+
+implementation
+
+uses
+ errno,
+ systm,
+ kern_thr,
+ kern_rtprio,
+ md_proc;
+
+const
+ sched_rr_interval=4;
+
+var
+ //Configured in kernel version:
+ ksched:t_ksched=(rr_interval:(tv_sec:0;tv_nsec:1000000000 div sched_rr_interval));
+
+function ksched_get_priority_max(ksched:p_ksched;policy:DWORD;prio:PInteger):Integer;
+begin
+ if ((policy or 2)=3) then //SCHED_FIFO,SCHED_RR
+ begin
+  prio^:=PRI_MAX_TIMESHARE;
+  Exit(0);
+ end;
+ Exit(EINVAL);
+end;
+
+function ksched_get_priority_min(ksched:p_ksched;policy:DWORD;prio:PInteger):Integer;
+begin
+ if ((policy or 2)=3) then //SCHED_FIFO,SCHED_RR
+ begin
+  prio^:=PRI_MIN_TIMESHARE;
+  Exit(0);
+ end;
+ Exit(EINVAL);
+end;
+
+function ksched_getparam(ksched:p_ksched;td:p_kthread;param:p_sched_param):Integer;
+var
+ rtp:t_rtprio;
+begin
+ pri_to_rtp(td,@rtp);
+ param^.sched_priority:=rtp._prio;
+ Exit(0);
+end;
+
+function ksched_getscheduler(ksched:p_ksched;td:p_kthread;policy:PDWORD):Integer;
+var
+ rtp:t_rtprio;
+ p:DWORD;
+begin
+ pri_to_rtp(td,@rtp);
+ p:=SCHED_FIFO;
+ if (rtp._type<>PRI_FIFO) then
+ begin
+  p:=ord(rtp._type=PRI_REALTIME) or 2; //SCHED_OTHER,SCHED_RR
+ end;
+ policy^:=p;
+ Exit(0);
+end;
+
+function ksched_rr_get_interval(ksched:p_ksched;td:p_kthread;time:Ptimespec):Integer;
+begin
+ time^:=ksched^.rr_interval;
+ Exit(0);
+end;
+
+function ksched_setparam(ksched:p_ksched;td:p_kthread;param:p_sched_param):Integer;
+var
+ rtp:t_rtprio;
+ policy:DWORD;
+begin
+ Result:=EPERM;
+ policy:=SCHED_FIFO;
+ pri_to_rtp(td,@rtp);
+ if (rtp._type<>PRI_FIFO) then
+ begin
+  if (rtp._type<>PRI_REALTIME) then
+  begin
+   Exit(EINVAL);
+  end;
+  policy:=SCHED_RR;
+ end;
+ if ((param^.sched_priority - PRI_MIN_TIMESHARE) < 512) then
+ begin
+  rtp._prio:=param^.sched_priority;
+  rtp._type:=ord(policy=SCHED_FIFO) * 8 + 2; //PRI_REALTIME,PRI_FIFO
+  rtp_to_pri(@rtp,td);
+  Result:=0;
+ end;
+end;
+
+function ksched_setscheduler(ksched:p_ksched;td:p_kthread;policy:DWORD;param:p_sched_param):Integer;
+var
+ rtp:t_rtprio;
+begin
+ if ((policy or 2)=3) then //SCHED_FIFO,SCHED_RR
+ begin
+  Result:=EPERM;
+  if ((param^.sched_priority - PRI_MIN_TIMESHARE) < 512) then
+  begin
+   rtp._prio:=param^.sched_priority;
+   rtp._type:=ord(policy=SCHED_FIFO) * 8 + 2; //PRI_REALTIME,PRI_FIFO
+   rtp_to_pri(@rtp,td);
+   Result:=0;
+  end;
+ end else
+ begin
+  Result:=EINVAL;
+ end;
+end;
+
+/////////
+
+function sys_sched_setparam(pid:Integer;param:p_sched_param):Integer;
+var
+ td:p_kthread;
+ e:Integer;
+ sched_param:t_sched_param;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(-1);
+
+ e:=copyin(param, @sched_param, sizeof(sched_param));
+ if (e<>0) then Exit(e);
+
+ if (pid=0) or (pid=g_pid) then
+ begin
+  //
+ end else
+ begin
+  Exit(ESRCH);
+ end;
+
+ PROC_LOCK();
+ e:=ksched_setparam(@ksched,td,@sched_param);
+ PROC_UNLOCK();
+
+ Exit(e);
+end;
+
+function sys_sched_getparam(pid:Integer;param:p_sched_param):Integer;
+var
+ td:p_kthread;
+ e:Integer;
+ sched_param:t_sched_param;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(-1);
+
+ if (pid=0) or (pid=g_pid) then
+ begin
+  //
+ end else
+ begin
+  Exit(ESRCH);
+ end;
+
+ PROC_LOCK();
+ e:=ksched_getparam(@ksched, td, @sched_param);
+ PROC_UNLOCK();
+
+ if (e=0) then
+  e:=copyout(@sched_param, param, sizeof(sched_param));
+
+ Exit(e);
+end;
+
+function sys_sched_setscheduler(pid,policy:Integer;param:p_sched_param):Integer;
+var
+ td:p_kthread;
+ e:Integer;
+ sched_param:t_sched_param;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(-1);
+
+ { Don't allow non root user to set a scheduler policy. }
+ //e:=priv_check(td, PRIV_SCHED_SET);
+ //if (e<>0) then Exit(e);
+
+ e:=copyin(param, @sched_param, sizeof(sched_param));
+ if (e<>0) then Exit(e);
+
+ if (pid=0) or (pid=g_pid) then
+ begin
+  //
+ end else
+ begin
+  Exit(ESRCH);
+ end;
+
+ PROC_LOCK();
+ e:=ksched_setscheduler(@ksched, td, policy, @sched_param);
+ PROC_UNLOCK();
+
+ Exit(e);
+end;
+
+function sys_sched_getscheduler(pid:Integer):Integer;
+var
+ td:p_kthread;
+ e,policy:Integer;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(-1);
+
+ if (pid=0) or (pid=g_pid) then
+ begin
+  //
+ end else
+ begin
+  Exit(ESRCH);
+ end;
+
+ PROC_LOCK();
+ e:=ksched_getscheduler(@ksched, td, @policy);
+ td^.td_retval[0]:=policy;
+ PROC_UNLOCK();
+
+ Exit(e);
+end;
+
+function sys_sched_get_priority_max(policy:Integer):Integer;
+var
+ td:p_kthread;
+ error,prio:Integer;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(-1);
+
+ error:=ksched_get_priority_max(@ksched, policy, @prio);
+
+ td^.td_retval[0]:=prio;
+ Exit(error);
+end;
+
+function sys_sched_get_priority_min(policy:Integer):Integer;
+var
+ td:p_kthread;
+ error,prio:Integer;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(-1);
+
+ error:=ksched_get_priority_min(@ksched, policy, @prio);
+
+ td^.td_retval[0]:=prio;
+ Exit(error);
+end;
+
+function kern_sched_rr_get_interval(td:p_kthread;pid:Integer;ts:ptimespec):Integer;
+var
+ e:Integer;
+begin
+
+ if (pid=0) or (pid=g_pid) then
+ begin
+  //
+ end else
+ begin
+  Exit(ESRCH);
+ end;
+
+ PROC_LOCK();
+ e:=ksched_rr_get_interval(@ksched, td, ts);
+ PROC_UNLOCK();
+
+ Exit(e);
+end;
+
+function sys_sched_rr_get_interval(pid:Integer;interval:ptimespec):Integer;
+var
+ td:p_kthread;
+ time:timespec;
+ error:Integer;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(-1);
+
+ error:=kern_sched_rr_get_interval(td, pid, @time);
+
+ if (error=0) then
+  error:=copyout(@time, interval, sizeof(time));
+
+ Exit(error);
+end;
+
+
+
+end.
+

sys/kern/kern_rtprio.pas

@@ -1,6 +1,7 @@
 unit kern_rtprio;
 
 {$mode ObjFPC}{$H+}
+{$CALLING SysV_ABI_CDecl}
 
 interface
 
@@ -65,9 +66,9 @@ begin
  thread_lock(td);
 
  case PRI_BASE(td^.td_pri_class) of
-  PRI_REALTIME,
+  RTP_PRIO_REALTIME,
   RTP_PRIO_NORMAL,
-  PRI_IDLE:
+  RTP_PRIO_IDLE:
     begin
      rtp^._prio:=td^.td_base_user_pri;
     end;

sys/test/project1.lpi

@@ -517,6 +517,10 @@
         <Filename Value="..\kern\md_proc.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="..\kern\kern_ksched.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

sys/test/project1.lpr

@@ -75,7 +75,8 @@ uses
  vmount,
  kern_prot,
  kern_resource,
- md_proc;
+ md_proc,
+ kern_ksched;
 
 var
  mtx:umutex;
@@ -322,7 +323,7 @@ begin
  Writeln('sys_rename=',sys_rename('/app0/new','/app0/renamed'));
  Writeln('sys_rmdir=',sys_rmdir('/app0/renamed'));
 
- //Writeln('sys_unlink=',sys_unlink('/app0/test.txt'));
+ Writeln('sys_unlink=',sys_unlink('/app0/test.txt'));
 
  Writeln('sys_rmdir=',sys_rmdir('/test'));