+

sys/kern_sig.pas

@@ -101,11 +101,11 @@ implementation
 uses
  ntapi,
  systm,
- _umtx,
  kern_mtx,
  kern_time,
  vm_machdep,
- machdep;
+ machdep,
+ trap;
 
 const
  max_pending_per_proc=128;
@@ -779,6 +779,27 @@ begin
  Result:=copyout(@pending,oset,sizeof(sigset_t));
 end;
 
+function ntw2px(n:Integer):Integer;
+begin
+ Case DWORD(n) of
+  STATUS_SUCCESS         :Result:=0;
+  STATUS_ABANDONED       :Result:=EPERM;
+  STATUS_ALERTED         :Result:=EINTR;
+  STATUS_USER_APC        :Result:=EINTR;
+  STATUS_TIMEOUT         :Result:=ETIMEDOUT;
+  STATUS_ACCESS_VIOLATION:Result:=EFAULT;
+  else
+                   Result:=EINVAL;
+ end;
+end;
+
+function msleep(timo:Int64):Integer; inline;
+begin
+ sig_set_alterable;
+ Result:=ntw2px(NtDelayExecution(True,@timo));
+ sig_reset_alterable;
+end;
+
 Function kern_sigtimedwait(td:p_kthread;
                            waitset:sigset_t;
                            ksi:p_ksiginfo;
@@ -849,7 +870,9 @@ begin
    tv:=NT_INFINITE;
   end;
 
-  //Result:=msleep(ps, &p^.p_mtx, PPAUSE|PCATCH, "sigwait", -tv);
+  PROC_UNLOCK; //
+  Result:=msleep(tvtohz(tv));
+  PROC_LOCK;  //
 
   if (timeout<>nil) then
   begin
@@ -989,7 +1012,9 @@ begin
  has_sig:=0;
  While (has_sig=0) do
  begin
-  //while (msleep(&p->p_sigacts, &p->p_mtx, PPAUSE|PCATCH, "pause",0) == 0)
+  PROC_UNLOCK; //
+  while (msleep(T_INFINITE)=0) do;
+  PROC_LOCK;   //
 
   //thread_suspend_check(0);
 

sys/kern_thread.pas

@@ -12,6 +12,8 @@ uses
  ucontext,
  signal,
  signalvar,
+ time,
+ kern_time,
  hamt;
 
 const
@@ -181,6 +183,7 @@ function  sys_thr_new(_param:p_thr_param;_size:Integer):Integer;
 function  sys_thr_self(id:PQWORD):Integer;
 procedure sys_thr_exit(state:PQWORD);
 function  sys_thr_kill(id:QWORD;sig:Integer):Integer;
+function  sys_thr_suspend(timeout:ptimespec):Integer;
 
 procedure thread_inc_ref(td:p_kthread);
 procedure thread_dec_ref(td:p_kthread);
@@ -227,7 +230,8 @@ uses
  kern_rwlock,
  kern_mtx,
  kern_umtx,
- kern_sig;
+ kern_sig,
+ trap;
 
 var
  p_mtx:Pointer=nil;
@@ -268,7 +272,7 @@ end;
 
 procedure PROC_UNLOCK;
 begin
- mtx_lock(@p_mtx);
+ mtx_unlock(@p_mtx);
 end;
 
 procedure threadinit; inline;
@@ -809,6 +813,105 @@ begin
  end;
 end;
 
+function ntw2px(n:Integer):Integer;
+begin
+ Case DWORD(n) of
+  STATUS_SUCCESS         :Result:=0;
+  STATUS_ABANDONED       :Result:=EPERM;
+  STATUS_ALERTED         :Result:=EINTR;
+  STATUS_USER_APC        :Result:=EINTR;
+  STATUS_TIMEOUT         :Result:=ETIMEDOUT;
+  STATUS_ACCESS_VIOLATION:Result:=EFAULT;
+  else
+                   Result:=EINVAL;
+ end;
+end;
+
+function msleep(timo:Int64):Integer; inline;
+begin
+ sig_set_alterable;
+ Result:=ntw2px(NtDelayExecution(True,@timo));
+ sig_reset_alterable;
+end;
+
+function kern_thr_suspend(td:p_kthread;tsp:ptimespec):Integer;
+var
+ tv:Int64;
+begin
+ if ((td^.td_pflags and TDP_WAKEUP)<>0) then
+ begin
+  td^.td_pflags:=td^.td_pflags and (not TDP_WAKEUP);
+  Exit(0);
+ end;
+
+ tv:=T_INFINITE;
+ if (tsp<>nil) then
+ begin
+  if (tsp^.tv_sec=0) and (tsp^.tv_nsec=0) then
+  begin
+   Result:=EWOULDBLOCK;
+  end else
+  begin
+   tv:=TIMESPEC_TO_UNIT(tsp);
+   tv:=tvtohz(tv);
+  end;
+ end;
+
+ PROC_LOCK;
+
+ if (Result=0) and ((td^.td_flags and TDF_THRWAKEUP)=0) then
+ begin
+  PROC_UNLOCK; //
+  Result:=msleep(tv);
+  PROC_LOCK;   //
+ end;
+
+ if ((td^.td_flags and TDF_THRWAKEUP)=0) then
+ begin
+  thread_lock(td);
+  td^.td_flags:=td^.td_flags and (not TDF_THRWAKEUP);
+  thread_unlock(td);
+  PROC_UNLOCK;
+  Exit(0);
+ end;
+
+ PROC_UNLOCK;
+
+ if (Result=EWOULDBLOCK) then
+ begin
+  Result:=ETIMEDOUT;
+ end else
+ if (Result=ERESTART) then
+ begin
+  if (tv<>T_INFINITE) then
+  begin
+   Result:=EINTR;
+  end;
+ end;
+end;
+
+function sys_thr_suspend(timeout:ptimespec):Integer;
+var
+ td:p_kthread;
+ ts:timespec;
+ tsp:ptimespec;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(-1);
+
+ tsp:=nil;
+ if (timeout<>nil) then
+ begin
+  Result:=umtx_copyin_timeout(timeout,@ts);
+  if (Result<>0) then Exit;
+  tsp:=@ts;
+ end;
+
+ Result:=kern_thr_suspend(td,tsp);
+end;
+
+
+
 
 function rtp_to_pri(rtp:p_rtprio;td:p_kthread):Integer;
 var

sys/kern_time.pas

@@ -7,8 +7,13 @@ interface
 
 uses
  sys_kernel,
+ windows,
+ ntapi,
  time;
 
+const
+ T_INFINITE=NT_INFINITE;
+
 function get_unit_uptime:Int64;
 function kern_clock_gettime_unit(clock_id:Integer;time:PInt64):Integer;
 function kern_clock_gettime(clock_id:Integer;tp:Ptimespec):Integer;
@@ -16,10 +21,6 @@ function kern_clock_getres(clock_id:Integer;tp:Ptimespec):Integer;
 
 implementation
 
-uses
- windows,
- ntapi;
-
 Const
  UNIT_PER_SEC         =10000000;
  DELTA_EPOCH_IN_UNIT  =116444736000000000;

sys/kern_umtx.pas

@@ -29,6 +29,8 @@ function  _sys_umtx_op(obj:Pointer;op:Integer;val:QWORD;uaddr1,uaddr2:Pointer):I
 
 function kern_umtx_wake(td:p_kthread;umtx:p_umtx;n_wake,priv:Integer):Integer;
 
+function umtx_copyin_timeout(addr:Pointer;tsp:ptimespec):Integer;
+
 implementation
 
 uses
@@ -513,7 +515,7 @@ begin
 
  if (timeout=nil) then
  begin
-  Result:=_do_lock_umtx(td,umtx,id,NT_INFINITE);
+  Result:=_do_lock_umtx(td,umtx,id,T_INFINITE);
   if (Result=EINTR) then
   begin
    Result:=ERESTART;
@@ -525,7 +527,7 @@ begin
   ts:=ts+tv;
 
   repeat
-   Result:=_do_lock_umtx(td,umtx,id,-tv);
+   Result:=_do_lock_umtx(td,umtx,id,tvtohz(tv));
    if (Result<>ETIMEDOUT) then Break;
 
    ts2:=get_unit_uptime;
@@ -636,7 +638,7 @@ begin
  end else
  if (timeout=nil) then
  begin
-  umtxq_sleep(uq,NT_INFINITE);
+  umtxq_sleep(uq,T_INFINITE);
 
   umtxq_lock(uq^.uq_key);
   umtxq_remove(uq);
@@ -648,7 +650,7 @@ begin
   ts:=ts+tv;
 
   repeat
-   Result:=umtxq_sleep(uq,-tv);
+   Result:=umtxq_sleep(uq,tvtohz(tv));
 
    if ((uq^.uq_flags and UQF_UMTXQ)=0) then
    begin
@@ -1465,7 +1467,7 @@ begin
 
  if (timeout=nil) then
  begin
-  Result:=_do_lock_umutex(td,m,flags,NT_INFINITE,mode);
+  Result:=_do_lock_umutex(td,m,flags,T_INFINITE,mode);
   if (Result=EINTR) and (mode<>_UMUTEX_WAIT) then
   begin
    Result:=ERESTART;
@@ -1477,7 +1479,7 @@ begin
   ts:=ts+tv;
 
   repeat
-   Result:=_do_lock_umutex(td,m,flags,-tv,mode);
+   Result:=_do_lock_umutex(td,m,flags,tvtohz(tv),mode);
    if (Result<>ETIMEDOUT) then Break;
 
    ts2:=get_unit_uptime;
@@ -1565,7 +1567,7 @@ begin
  begin
   if (timeout=nil) then
   begin
-   Result:=umtxq_sleep(uq,NT_INFINITE);
+   Result:=umtxq_sleep(uq,T_INFINITE);
   end else
   begin
    if ((wflags and CVWAIT_ABSTIME)=0) then
@@ -1589,7 +1591,7 @@ begin
 
    tv:=tts;
    repeat
-    Result:=umtxq_sleep(uq,-tv);
+    Result:=umtxq_sleep(uq,tvtohz(tv));
     if (Result<>ETIMEDOUT) then Break;
 
     kern_clock_gettime_unit(clockid,@cts);
@@ -1826,7 +1828,7 @@ begin
  tv:=ts;
 
  repeat
-  Result:=do_rw_rdlock(td,rwlock,fflag,-tv);
+  Result:=do_rw_rdlock(td,rwlock,fflag,tvtohz(tv));
 
   if (Result<>ETIMEDOUT) then Break;
 
@@ -1993,7 +1995,7 @@ begin
  tv:=ts;
 
  repeat
-  Result:=do_rw_wrlock(td,rwlock,fflag,-tv);
+  Result:=do_rw_wrlock(td,rwlock,fflag,tvtohz(tv));
 
   if (Result<>ETIMEDOUT) then Break;
 
@@ -2166,7 +2168,7 @@ begin
 
  if (timeout=nil) then
  begin
-  Result:=umtxq_sleep(uq,NT_INFINITE);
+  Result:=umtxq_sleep(uq,T_INFINITE);
  end else
  begin
   ets:=get_unit_uptime;
@@ -2174,7 +2176,7 @@ begin
   ets:=ets+tv;
 
   repeat
-   Result:=umtxq_sleep(uq,-tv);
+   Result:=umtxq_sleep(uq,tvtohz(tv));
    if (Result<>ETIMEDOUT) then Break;
 
    cts:=get_unit_uptime;
@@ -2450,7 +2452,7 @@ begin
 
  if (uaddr2=nil) then
  begin
-  Result:=do_rw_rdlock(td,obj,val,NT_INFINITE);
+  Result:=do_rw_rdlock(td,obj,val,T_INFINITE);
  end else
  begin
   Result:=umtx_copyin_timeout(uaddr2,@timeout);
@@ -2467,7 +2469,7 @@ begin
 
  if (uaddr2=nil) then
  begin
-  Result:=do_rw_wrlock(td,obj,val,NT_INFINITE);
+  Result:=do_rw_wrlock(td,obj,val,T_INFINITE);
  end else
  begin
   Result:=umtx_copyin_timeout(uaddr2,@timeout);

sys/sys_sig.pas

@@ -0,0 +1,93 @@
+unit sys_sig;
+
+{$mode ObjFPC}{$H+}
+{$CALLING SysV_ABI_CDecl}
+
+interface
+
+uses
+ time,
+ signal,
+ kern_sig;
+
+Function  sigaction(sig:Integer;
+                    act,oact:p_sigaction_t;
+                    flags:Integer):Integer;
+
+Function  sigprocmask(how:Integer;
+                      _set:p_sigset_t;
+                      oset:p_sigset_t;
+                      flags:Integer):Integer;
+
+Function  sigpending(oset:p_sigset_t):Integer;
+
+Function  sigwait(oset:p_sigset_t;sig:PInteger):Integer;
+Function  sigtimedwait(oset:p_sigset_t;info:p_siginfo_t;timeout:ptimespec):Integer;
+Function  sigwaitinfo(oset:p_sigset_t;info:p_siginfo_t):Integer;
+
+Function  sigsuspend(sigmask:p_sigset_t):Integer;
+
+Function  sigaltstack(ss:p_stack_t;oss:p_stack_t):Integer;
+
+implementation
+
+uses
+ trap;
+
+Function sigaction(sig:Integer;
+                   act,oact:p_sigaction_t;
+                   flags:Integer):Integer; assembler; nostackframe;
+asm
+ movq  sys_sigaction,%rax
+ call  fast_syscall
+end;
+
+Function sigprocmask(how:Integer;
+                     _set:p_sigset_t;
+                     oset:p_sigset_t;
+                     flags:Integer):Integer; assembler; nostackframe;
+asm
+ movq  sys_sigprocmask,%rax
+ call  fast_syscall
+end;
+
+Function sigpending(oset:p_sigset_t):Integer; assembler; nostackframe;
+asm
+ movq  sys_sigpending,%rax
+ call  fast_syscall
+end;
+
+Function sigwait(oset:p_sigset_t;sig:PInteger):Integer; assembler; nostackframe;
+asm
+ movq  sys_sigwait,%rax
+ call  fast_syscall
+end;
+
+Function sigtimedwait(oset:p_sigset_t;info:p_siginfo_t;timeout:ptimespec):Integer; assembler; nostackframe;
+asm
+ movq  sys_sigtimedwait,%rax
+ call  fast_syscall
+end;
+
+Function sigwaitinfo(oset:p_sigset_t;info:p_siginfo_t):Integer; assembler; nostackframe;
+asm
+ movq  sys_sigwaitinfo,%rax
+ call  fast_syscall
+end;
+
+Function sigsuspend(sigmask:p_sigset_t):Integer; assembler; nostackframe;
+asm
+ movq  sys_sigsuspend,%rax
+ call  fast_syscall
+end;
+
+Function sigaltstack(ss:p_stack_t;oss:p_stack_t):Integer; assembler; nostackframe;
+asm
+ movq  sys_sigaltstack,%rax
+ call  fast_syscall
+end;
+
+
+end.
+
+

sys/test/project1.lpi

@@ -101,6 +101,10 @@
         <Filename Value="..\kern_mtx.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="..\sys_sig.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

sys/test/project1.lpr

@@ -15,8 +15,8 @@ uses
  kern_lock,
  kern_rwlock,
  thr_private,
- kern_sig,
  trap,
+ sys_sig,
  md_psl,
  sysutils,
  vulkan,
@@ -159,6 +159,8 @@ procedure test_thread; sysv_abi_default;
 var
  rax:qword;
  act:sigaction_t;
+ _sig:Integer;
+ oset:sigset_t;
 begin
 
  //SetTlsBase(Pointer(qword(1)));
@@ -169,11 +171,19 @@ begin
   act.u.sa_handler:=sa_handler(@__ex_handler);
   act.sa_flags:=SA_RESTART;
 
-  sys_sigaction(SIGUSR1,@act,nil,0);
+  sigaction(SIGUSR1,@act,nil,0);
 
-  sys_thr_kill(tid,SIGUSR1);
+  thr_kill(tid,SIGUSR1);
  end else
  begin
+  Writeln('thr_suspend:',thr_suspend(nil));
+  {
+  oset.qwords[0]:=QWORD(-1);
+  oset.qwords[1]:=QWORD(-1);
+  Writeln('sigwait:',sigwait(@oset,@_sig));
+  Writeln('intr:',_sig);
+  }
+  {
   Writeln('before: sptr:',HexStr(sptr));
   repeat
    asm
@@ -182,6 +192,7 @@ begin
   until (intr<>0);
   Writeln('intr');
   Writeln('after: sptr:',HexStr(sptr));
+  }
  end;
 
  sig_lock;

sys/thr.pas

@@ -6,6 +6,7 @@ unit thr;
 interface
 
 uses
+ time,
  kern_thread;
 
 type
@@ -15,14 +16,12 @@ type
 function  thr_new(param:p_thr_param;param_size:Integer):Integer;
 function  thr_self(id:PQWORD):Integer;
 procedure thr_exit(state:PQWORD);
+function  thr_kill(id:QWORD;sig:Integer):Integer;
+function  thr_suspend(timeout:ptimespec):Integer;
 
 //int  thr_create(ucontext_t *ctx, long *id, int flags);
-//int  thr_new(struct thr_param *param, int param_size);
-//int  thr_self(long *id);
-//void thr_exit(long *state);
-//int  thr_kill(long id, int sig);
+
 //int  thr_kill2(pid_t pid, long id, int sig);
-//int  thr_suspend(const struct timespec *timeout);
 //int  thr_wake(long id);
 //int  thr_set_name(long id, const char *name);
 
@@ -55,5 +54,20 @@ asm
  call  fast_syscall
 end;
 
+function thr_kill(id:QWORD;sig:Integer):Integer; assembler; nostackframe;
+asm
+ movq  sys_thr_kill,%rax
+ call  fast_syscall
+end;
+
+function thr_suspend(timeout:ptimespec):Integer; assembler; nostackframe;
+asm
+ movq  sys_thr_suspend,%rax
+ call  fast_syscall
+end;
+
+
 end.
 
+
+

sys/time.pas

@@ -55,6 +55,7 @@ type
  end;
 
 function TIMESPEC_TO_UNIT(ts:ptimespec):Int64; inline; //Unit
+function tvtohz(time:Int64):Int64; inline;
 
 implementation
 
@@ -63,5 +64,10 @@ begin
  Result:=(QWORD(ts^.tv_sec)*10000000)+(QWORD(ts^.tv_nsec) div 100);
 end;
 
+function tvtohz(time:Int64):Int64; inline;
+begin
+ Result:=-time;
+end;
+
 end.