From c40f7be15b8487dde83e69e662d87e9954c57548 Mon Sep 17 00:00:00 2001
From: Pavel <68122101+red-prig@users.noreply.github.com>
Date: Wed, 15 Feb 2023 23:37:13 +0300
Subject: [PATCH] +
---
rtl/gtailq.pas | 77 ++++++++++
sys/kern_sig.pas | 338 ++++++++++++++++++++++++++++++++++++++++++
sys/kern_thread.pas | 78 ++++++++--
sys/kern_umtx.pas | 10 +-
sys/signal.pas | 12 ++
sys/signalvar.pas | 176 ++++++++++++++++++++++
sys/systm.pas | 11 ++
sys/test/project1.lpi | 8 +
sys/test/project1.lpr | 7 +-
9 files changed, 698 insertions(+), 19 deletions(-)
create mode 100644 sys/kern_sig.pas
create mode 100644 sys/signalvar.pas
diff --git a/rtl/gtailq.pas b/rtl/gtailq.pas
index 9b7ef0b5..b0fd718c 100644
--- a/rtl/gtailq.pas
+++ b/rtl/gtailq.pas
@@ -25,8 +25,85 @@ type
procedure Remove(Node:PNODE);
end;
+procedure TAILQ_INIT (head:Pointer); inline;
+function TAILQ_FIRST (head:Pointer):Pointer; inline;
+function TAILQ_NEXT (elm,field:Pointer):Pointer; inline;
+procedure TAILQ_INSERT_HEAD(head,elm,field:Pointer); inline;
+procedure TAILQ_INSERT_TAIL(head,elm,field:Pointer); inline;
+procedure TAILQ_REMOVE (head,elm,field:Pointer); inline;
+
implementation
+type
+ p_tailq_list=^_tailq_list;
+ _tailq_list=packed record
+ pFirst,pLast:Pointer;
+ end;
+
+ p_tailq_entry=^_tailq_entry;
+ _tailq_entry=packed record
+ pNext,pPrev:Pointer;
+ end;
+
+procedure TAILQ_INIT(head:Pointer); inline;
+begin
+ p_tailq_list(head)^.pFirst:=nil;
+ p_tailq_list(head)^.pLast :=@p_tailq_list(head)^.pFirst;
+end;
+
+function TAILQ_FIRST(head:Pointer):Pointer; inline;
+begin
+ Result:=p_tailq_list(head)^.pFirst;
+end;
+
+function TAILQ_NEXT(elm,field:Pointer):Pointer; inline;
+begin
+ Result:=p_tailq_entry(field)^.pNext;
+end;
+
+procedure TAILQ_INSERT_HEAD(head,elm,field:Pointer); inline;
+var
+ offset:ptruint;
+begin
+ offset:=ptruint(field-elm);
+ if (p_tailq_entry(field)^.pNext=p_tailq_list(head)^.pFirst) and
+ (p_tailq_list(head)^.pFirst<>nil) then
+ begin
+ p_tailq_entry(p_tailq_list(head)^.pFirst+offset)^.pPrev:=@p_tailq_entry(field)^.pNext;
+ end else
+ begin
+ p_tailq_list(head)^.pLast:=@p_tailq_entry(field)^.pNext;
+ end;
+ p_tailq_list(head)^.pFirst:=elm;
+ p_tailq_entry(field)^.pPrev:=@p_tailq_list(head)^.pFirst;
+end;
+
+procedure TAILQ_INSERT_TAIL(head,elm,field:Pointer); inline;
+var
+ offset:ptruint;
+begin
+ offset:=ptruint(field-elm);
+ p_tailq_entry(field)^.pNext:=nil;
+ p_tailq_entry(field)^.pPrev:=p_tailq_list(head)^.pLast;
+ PPointer(p_tailq_list(head)^.pLast)^:=elm;
+ p_tailq_list(head)^.pLast:=@p_tailq_entry(field)^.pNext;
+end;
+
+procedure TAILQ_REMOVE(head,elm,field:Pointer); inline;
+var
+ offset:ptruint;
+begin
+ offset:=ptruint(field-elm);
+ if (p_tailq_entry(field)^.pNext<>nil) then
+ begin
+ p_tailq_entry(p_tailq_entry(field)^.pNext+offset)^.pPrev:=p_tailq_entry(field)^.pPrev;
+ end else
+ begin
+ p_tailq_list(head)^.pLast:=p_tailq_entry(field)^.pPrev;
+ end;
+ PPointer(p_tailq_entry(field)^.pPrev)^:=p_tailq_entry(field)^.pNext;
+end;
+
procedure TAILQ_HEAD.Insert_head(Node:PNODE);
begin
if (pHead=nil) then
diff --git a/sys/kern_sig.pas b/sys/kern_sig.pas
new file mode 100644
index 00000000..fd945e8d
--- /dev/null
+++ b/sys/kern_sig.pas
@@ -0,0 +1,338 @@
+unit kern_sig;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ gtailq,
+ sys_kernel,
+ signal,
+ signalvar;
+
+const
+ SA_KILL =$01; // terminates process by default
+ SA_CORE =$02; // ditto and coredumps
+ SA_STOP =$04; // suspend process
+ SA_TTYSTOP =$08; // ditto, from tty
+ SA_IGNORE =$10; // ignore by default
+ SA_CONT =$20; // continue if suspended
+ SA_CANTMASK=$40; // non-maskable, catchable
+ SA_PROC =$80; // deliverable to any thread
+
+ sigproptbl:array[0..30] of Integer=(
+ SA_KILL or SA_PROC, // SIGHUP
+ SA_KILL or SA_PROC, // SIGINT
+ SA_KILL or SA_CORE or SA_PROC, // SIGQUIT
+ SA_KILL or SA_CORE, // SIGILL
+ SA_KILL or SA_CORE, // SIGTRAP
+ SA_KILL or SA_CORE, // SIGABRT
+ SA_KILL or SA_CORE or SA_PROC, // SIGEMT
+ SA_KILL or SA_CORE, // SIGFPE
+ SA_KILL or SA_PROC, // SIGKILL
+ SA_KILL or SA_CORE, // SIGBUS
+ SA_KILL or SA_CORE, // SIGSEGV
+ SA_KILL or SA_CORE, // SIGSYS
+ SA_KILL or SA_PROC, // SIGPIPE
+ SA_KILL or SA_PROC, // SIGALRM
+ SA_KILL or SA_PROC, // SIGTERM
+ SA_IGNORE or SA_PROC, // SIGURG
+ SA_STOP or SA_PROC, // SIGSTOP
+ SA_STOP or SA_TTYSTOP or SA_PROC, // SIGTSTP
+ SA_IGNORE or SA_CONT or SA_PROC, // SIGCONT
+ SA_IGNORE or SA_PROC, // SIGCHLD
+ SA_STOP or SA_TTYSTOP or SA_PROC, // SIGTTIN
+ SA_STOP or SA_TTYSTOP or SA_PROC, // SIGTTOU
+ SA_IGNORE or SA_PROC, // SIGIO
+ SA_KILL, // SIGXCPU
+ SA_KILL, // SIGXFSZ
+ SA_KILL or SA_PROC, // SIGVTALRM
+ SA_KILL or SA_PROC, // SIGPROF
+ SA_IGNORE or SA_PROC, // SIGWINCH
+ SA_IGNORE or SA_PROC, // SIGINFO
+ SA_KILL or SA_PROC, // SIGUSR1
+ SA_KILL or SA_PROC // SIGUSR2
+);
+
+
+implementation
+
+const
+ max_pending_per_proc=128;
+
+var
+ p_pendingcnt :Integer=0;
+ signal_overflow :Integer=0;
+ signal_alloc_fail:Integer=0;
+
+function ksiginfo_alloc():p_ksiginfo;
+begin
+ Result:=AllocMem(SizeOf(ksiginfo_t));
+end;
+
+procedure ksiginfo_free(ksi:p_ksiginfo);
+begin
+ FreeMem(ksi);
+end;
+
+Function ksiginfo_tryfree(ksi:p_ksiginfo):Boolean;
+begin
+ Result:=False;
+ if ((ksi^.ksi_flags and KSI_EXT)=0) then
+ begin
+ FreeMem(ksi);
+ Result:=True;
+ end;
+end;
+
+procedure sigqueue_init(list:p_sigqueue);
+begin
+ SIGEMPTYSET(@list^.sq_signals);
+ SIGEMPTYSET(@list^.sq_kill);
+ TAILQ_INIT(@list^.sq_list);
+ list^.sq_flags:=SQ_INIT;
+end;
+
+Function sigqueue_get(sq:p_sigqueue;signo:Integer;si:p_ksiginfo):Integer;
+var
+ ksi:p_ksiginfo;
+ count:Integer;
+begin
+ count:=0;
+
+ Assert((sq^.sq_flags and SQ_INIT)<>0,'sigqueue not inited');
+
+ if not SIGISMEMBER(@sq^.sq_signals,signo) then Exit(0);
+
+ if SIGISMEMBER(@sq^.sq_kill,signo) then
+ begin
+ Inc(count);
+ SIGDELSET(@sq^.sq_kill,signo);
+ end;
+
+ ksi:=TAILQ_FIRST(@sq^.sq_list);
+ While (ksi<>nil) do
+ begin
+ if (ksi^.ksi_info.si_signo=signo) then
+ begin
+ if (count=0) then
+ begin
+ TAILQ_REMOVE(@sq^.sq_list,ksi,@ksi^.ksi_link);
+ ksi^.ksi_sigq:=nil;
+ ksiginfo_copy(ksi,si);
+ if ksiginfo_tryfree(ksi) then
+ begin
+ Dec(p_pendingcnt);
+ end;
+ end;
+ if (count>1) then
+ begin
+ Inc(count);
+ Break;
+ end else
+ begin
+ Inc(count);
+ end;
+ end;
+ ksi:=TAILQ_NEXT(ksi,@ksi^.ksi_link);
+ end;
+
+ if (count<=1) then
+ begin
+ SIGDELSET(@sq^.sq_signals,signo);
+ end;
+
+ si^.ksi_info.si_signo:=signo;
+ Result:=signo;
+end;
+
+procedure sigqueue_take(ksi:p_ksiginfo);
+var
+ kp:p_ksiginfo;
+ sq:p_sigqueue;
+begin
+ if (ksi=nil) or (ksi^.ksi_sigq=nil) then Exit;
+ sq:=ksi^.ksi_sigq;
+
+ TAILQ_REMOVE(@sq^.sq_list,ksi,@ksi^.ksi_link);
+
+ ksi^.ksi_sigq:=nil;
+ if ((ksi^.ksi_flags and KSI_EXT)=0)then
+ begin
+ Dec(p_pendingcnt);
+ end;
+
+ kp:=TAILQ_FIRST(@sq^.sq_list);
+ While (kp<>nil) do
+ begin
+ if (kp^.ksi_info.si_signo=ksi^.ksi_info.si_signo) then Break;
+ kp:=TAILQ_NEXT(kp,@kp^.ksi_link);
+ end;
+
+ if (kp=nil) and (not SIGISMEMBER(@sq^.sq_kill,ksi^.ksi_info.si_signo)) then
+ begin
+ SIGDELSET(@sq^.sq_signals,ksi^.ksi_info.si_signo);
+ end;
+end;
+
+Function sigqueue_add(sq:p_sigqueue;signo:Integer;si:p_ksiginfo):Integer;
+label
+ out_set_bit;
+var
+ ksi:p_ksiginfo;
+begin
+ Result:=0;
+
+ Assert((sq^.sq_flags and SQ_INIT)<>0,'sigqueue not inited');
+
+ if (signo=SIGKILL) or (signo=SIGSTOP) or (si=nil) then
+ begin
+ SIGADDSET(@sq^.sq_kill,signo);
+ goto out_set_bit;
+ end;
+
+ if ((si^.ksi_flags and KSI_INS)<>0) then
+ begin
+ if ((si^.ksi_flags and KSI_HEAD)<>0) then
+ TAILQ_INSERT_HEAD(@sq^.sq_list,si,@si^.ksi_link)
+ else
+ TAILQ_INSERT_TAIL(@sq^.sq_list,si,@si^.ksi_link);
+ si^.ksi_sigq:=sq;
+ goto out_set_bit;
+ end;
+
+ if (p_pendingcnt>=max_pending_per_proc) then
+ begin
+ Inc(signal_overflow);
+ Result:=EAGAIN;
+ end else
+ begin
+ ksi:=ksiginfo_alloc;
+ if (ksi=nil) then
+ begin
+ Inc(signal_alloc_fail);
+ Result:=EAGAIN;
+ end else
+ begin
+ Inc(p_pendingcnt);
+ ksiginfo_copy(si,ksi);
+ ksi^.ksi_info.si_signo:=signo;
+ if ((si^.ksi_flags and KSI_HEAD)<>0) then
+ TAILQ_INSERT_HEAD(@sq^.sq_list,ksi,@ksi^.ksi_link)
+ else
+ TAILQ_INSERT_TAIL(@sq^.sq_list,ksi,@ksi^.ksi_link);
+ ksi^.ksi_sigq:=sq;
+ end;
+ end;
+
+ if ((si^.ksi_flags and KSI_TRAP)<>0) or
+ ((si^.ksi_flags and KSI_SIGQ) =0) then
+ begin
+ if (Result<>0) then
+ begin
+ SIGADDSET(@sq^.sq_kill,signo);
+ end;
+ Result:=0;
+ goto out_set_bit;
+ end;
+
+ if (Result<>0) then Exit;
+
+ out_set_bit:
+ SIGADDSET(@sq^.sq_signals,signo);
+end;
+
+procedure sigqueue_flush(sq:p_sigqueue);
+var
+ ksi:p_ksiginfo;
+begin
+ Assert((sq^.sq_flags and SQ_INIT)<>0,'sigqueue not inited');
+
+ ksi:=TAILQ_FIRST(@sq^.sq_list);
+ while (ksi<>nil) do
+ begin
+ TAILQ_REMOVE(@sq^.sq_list,ksi,@ksi^.ksi_link);
+ ksi^.ksi_sigq:=nil;
+ if ksiginfo_tryfree(ksi) then
+ begin
+ Dec(p_pendingcnt);
+ end;
+ ksi:=TAILQ_NEXT(ksi,@ksi^.ksi_link);
+ end;
+
+ SIGEMPTYSET(@sq^.sq_signals);
+ SIGEMPTYSET(@sq^.sq_kill);
+end;
+
+procedure sigqueue_move_set(src,dst:p_sigqueue;_set:p_sigset_t);
+var
+ tmp:sigset_t;
+ ksi:p_ksiginfo;
+begin
+ Assert((src^.sq_flags and SQ_INIT)<>0,'sigqueue not inited');
+ Assert((dst^.sq_flags and SQ_INIT)<>0,'sigqueue not inited');
+
+ ksi:=TAILQ_FIRST(@src^.sq_list);
+ while (ksi<>nil) do
+ begin
+ if SIGISMEMBER(_set,ksi^.ksi_info.si_signo) then
+ begin
+ TAILQ_REMOVE(@src^.sq_list,ksi,@ksi^.ksi_link);
+ TAILQ_INSERT_TAIL(@dst^.sq_list,ksi,@ksi^.ksi_link);
+ ksi^.ksi_sigq:=dst;
+ end;
+
+ ksi:=TAILQ_NEXT(ksi,@ksi^.ksi_link);
+ end;
+
+ tmp:=src^.sq_kill;
+ SIGSETAND(@tmp,_set);
+ SIGSETOR(@dst^.sq_kill,@tmp);
+ SIGSETNAND(@src^.sq_kill,@tmp);
+
+ tmp:=src^.sq_signals;
+ SIGSETAND(@tmp,_set);
+ SIGSETOR(@dst^.sq_signals,@tmp);
+ SIGSETNAND(@src^.sq_signals,@tmp);
+end;
+
+procedure sigqueue_delete_set(sq:p_sigqueue;_set:p_sigset_t);
+var
+ ksi:p_ksiginfo;
+begin
+ Assert((sq^.sq_flags and SQ_INIT)<>0,'sigqueue not inited');
+
+ ksi:=TAILQ_FIRST(@sq^.sq_list);
+ while (ksi<>nil) do
+ begin
+ if SIGISMEMBER(_set,ksi^.ksi_info.si_signo) then
+ begin
+ TAILQ_REMOVE(@sq^.sq_list,ksi,@ksi^.ksi_link);
+ ksi^.ksi_sigq:=nil;
+ if ksiginfo_tryfree(ksi) then
+ begin
+ Dec(p_pendingcnt)
+ end;
+ end;
+
+ ksi:=TAILQ_NEXT(ksi,@ksi^.ksi_link);
+ end;
+
+ SIGSETNAND(@sq^.sq_kill,_set);
+ SIGSETNAND(@sq^.sq_signals,_set);
+end;
+
+procedure sigqueue_delete(sq:p_sigqueue;signo:Integer);
+var
+ _set:sigset_t;
+begin
+ SIGEMPTYSET(@_set);
+ SIGADDSET(@_set,signo);
+ sigqueue_delete_set(sq,@_set);
+end;
+
+
+
+
+end.
+
diff --git a/sys/kern_thread.pas b/sys/kern_thread.pas
index 9d256a29..2500bdbf 100644
--- a/sys/kern_thread.pas
+++ b/sys/kern_thread.pas
@@ -8,7 +8,9 @@ interface
uses
ntapi,
windows,
- sys_kernel;
+ sys_kernel,
+ signal,
+ signalvar;
const
PRI_ITHD =1; // Interrupt thread.
@@ -38,7 +40,7 @@ type
td_umtxq :Pointer; //p_umtx_q
td_handle :THandle; //nt thread
td_lock :Pointer;
- td_tid :DWORD;
+ td_tid :QWORD;
td_ref :Integer;
td_priority :Word;
td_pri_class :Word;
@@ -50,6 +52,8 @@ type
//
td_fsbase :Pointer;
td_cpuset :Ptruint;
+ td_sigmask :sigset_t;
+ td_sigqueue :sigqueue_t;
end;
p_rtprio=^rtprio;
@@ -66,8 +70,8 @@ type
stack_size:Ptruint;
tls_base :Pointer;
tls_size :Ptruint;
- child_tid :PDWORD;
- parent_tid:PDWORD;
+ child_tid :PQWORD;
+ parent_tid:PQWORD;
flags :Integer;
align :Integer;
rtp :p_rtprio;
@@ -92,14 +96,15 @@ function create_thread(td :p_kthread; //calling thread
stack_base:Pointer;
stack_size:QWORD;
tls_base :Pointer;
- child_tid :PDWORD;
- parent_tid:PDWORD;
+ child_tid :PQWORD;
+ parent_tid:PQWORD;
flags :Integer;
rtp :p_rtprio;
name :PChar
):Integer;
-function sys_thr_new(td:p_kthread;_param:p_thr_param;_size:Integer):Integer;
+function sys_thr_new(_param:p_thr_param;_size:Integer):Integer;
+function sys_thr_self(id:PQWORD):Integer;
procedure thread_exit;
@@ -112,6 +117,8 @@ function tdfind(tid:DWORD):p_kthread;
function curkthread:p_kthread; assembler;
procedure set_curkthread(td:p_kthread); assembler;
+function SIGPENDING(td:p_kthread):Boolean; inline;
+
implementation
{
@@ -159,6 +166,12 @@ asm
movqq td,%gs:(0x700)
end;
+function SIGPENDING(td:p_kthread):Boolean; inline;
+begin
+ Result:=SIGNOTEMPTY(@td^.td_sigqueue.sq_signals) and
+ sigsetmasked(@td^.td_sigqueue.sq_signals,@td^.td_sigmask);
+end;
+
procedure threadinit; inline;
begin
FillChar(tidhashtbl,SizeOf(tidhashtbl),0);
@@ -352,8 +365,8 @@ function create_thread(td :p_kthread; //calling thread
stack_base:Pointer;
stack_size:QWORD;
tls_base :Pointer;
- child_tid :PDWORD;
- parent_tid:PDWORD;
+ child_tid :PQWORD;
+ parent_tid:PQWORD;
flags :Integer;
rtp :p_rtprio;
name :PChar
@@ -455,17 +468,21 @@ begin
if (child_tid<>nil) then
begin
- n:=suword32(child_tid^,newtd^.td_tid);
+ n:=suword64(child_tid^,newtd^.td_tid);
if (n<>0) then Goto _term;
end;
if (parent_tid<>nil) then
begin
- n:=suword32(parent_tid^,newtd^.td_tid);
+ n:=suword64(parent_tid^,newtd^.td_tid);
if (n<>0) then Goto _term;
end;
- //newtd->td_sigmask = td->td_sigmask;
+ if (td<>nil) then
+ begin
+ newtd^.td_sigmask:=td^.td_sigmask;
+ end;
+
thread_link(newtd);
if (name<>nil) then
@@ -537,12 +554,16 @@ begin
@name);
end;
-function sys_thr_new(td:p_kthread;_param:p_thr_param;_size:Integer):Integer;
+function sys_thr_new(_param:p_thr_param;_size:Integer):Integer;
var
+ td:p_kthread;
param:thr_param;
begin
if (_size<0) or (_size>Sizeof(thr_param)) then Exit(EINVAL);
+ td:=curkthread;
+ if (td=nil) then Exit(EFAULT);
+
param:=Default(thr_param);
Result:=copyin(_param,@param,_size);
@@ -562,6 +583,9 @@ begin
//td^.td_state:=TDS_INACTIVE;
+ tidhash_remove(td);
+ thread_unlink(td);
+
umtx_thread_exit(td);
thread_dec_ref(td);
@@ -569,11 +593,39 @@ begin
RtlExitUserThread(0);
end;
+function sys_thr_self(id:PQWORD):Integer;
+var
+ td:p_kthread;
+begin
+ if (id=nil) then Exit(EINVAL);
+ td:=curkthread;
+ if (td=nil) then Exit(EFAULT);
+ Result:=suword64(id^,td^.td_tid);
+ if (Result<>0) then Exit(EFAULT);
+ Result:=0;
+end;
+function sys_thr_exit(state:PQWORD):Integer;
+var
+ td:p_kthread;
+begin
+ td:=curkthread;
+ if (td=nil) then Exit(EFAULT);
+
+ if (state<>nil) then
+ begin
+ kern_umtx_wake(td,Pointer(state),High(Integer),0);
+ end;
+
+ //tdsigcleanup(td);
+ //thread_stopped(p);
+ thread_exit();
+ // NOTREACHED
+end;
function rtp_to_pri(rtp:p_rtprio;td:p_kthread):Integer;
var
diff --git a/sys/kern_umtx.pas b/sys/kern_umtx.pas
index 27725311..2f5fa11a 100644
--- a/sys/kern_umtx.pas
+++ b/sys/kern_umtx.pas
@@ -25,6 +25,10 @@ function _sys_umtx_lock(mtx:p_umtx):Integer;
function _sys_umtx_unlock(mtx:p_umtx):Integer;
function _sys_umtx_op(obj:Pointer;op:Integer;val:QWORD;uaddr1,uaddr2:Pointer):Integer;
+//
+
+function kern_umtx_wake(td:p_kthread;umtx:p_umtx;n_wake,priv:Integer):Integer;
+
implementation
uses
@@ -2459,7 +2463,7 @@ var
begin
if (mtx=nil) then Exit(EINVAL);
td:=curkthread;
- if (td=nil) then Exit(EINVAL);
+ if (td=nil) then Exit(EFAULT);
Result:=_do_lock_umtx(td,mtx,td^.td_tid,0);
end;
@@ -2469,7 +2473,7 @@ var
begin
if (mtx=nil) then Exit(EINVAL);
td:=curkthread;
- if (td=nil) then Exit(EINVAL);
+ if (td=nil) then Exit(EFAULT);
Result:=do_unlock_umtx(td,mtx,td^.td_tid);
end;
@@ -2501,7 +2505,7 @@ var
begin
if (obj=nil) then Exit(EINVAL);
td:=curkthread;
- if (td=nil) then Exit(EINVAL);
+ if (td=nil) then Exit(EFAULT);
Case op of
UMTX_OP_LOCK :Result:=__umtx_op_lock_umtx (td,obj,val,uaddr1,uaddr2);
UMTX_OP_UNLOCK :Result:=__umtx_op_unlock_umtx (td,obj,val,uaddr1,uaddr2);
diff --git a/sys/signal.pas b/sys/signal.pas
index dd252463..ffcfd1f2 100644
--- a/sys/signal.pas
+++ b/sys/signal.pas
@@ -204,6 +204,8 @@ const
function _SIG_IDX(sig:Integer):DWORD; inline;
function _SIG_VALID(sig:Integer):Boolean; inline;
function _SIG_VALID_32(sig:Integer):Boolean; inline;
+function _SIG_WORD(sig:Integer):DWORD; inline;
+function _SIG_BIT(sig:Integer):DWORD; inline;
function _get_sig_str(signum:Integer):RawByteString;
@@ -224,6 +226,16 @@ begin
Result:=(sig<=32) and (sig>0);
end;
+function _SIG_WORD(sig:Integer):DWORD; inline;
+begin
+ Result:=_SIG_IDX(sig) shr 5;
+end;
+
+function _SIG_BIT(sig:Integer):DWORD; inline;
+begin
+ Result:=1 shl (_SIG_IDX(sig) and 31);
+end;
+
function _get_sig_str(signum:Integer):RawByteString;
begin
case signum of
diff --git a/sys/signalvar.pas b/sys/signalvar.pas
new file mode 100644
index 00000000..e3ce5be3
--- /dev/null
+++ b/sys/signalvar.pas
@@ -0,0 +1,176 @@
+unit signalvar;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ signal;
+
+type
+ p_sigacts=^sigacts;
+ sigacts=packed record
+ ps_sigact :array[0.._SIG_MAXSIG-1] of sig_t;
+ ps_catchmask :array[0.._SIG_MAXSIG-1] of sigset_t;
+ ps_sigonstack:sigset_t;
+ ps_sigintr :sigset_t;
+ ps_sigreset :sigset_t;
+ ps_signodefer:sigset_t;
+ ps_siginfo :sigset_t;
+ ps_sigignore :sigset_t;
+ ps_sigcatch :sigset_t;
+ end;
+
+const
+ PS_NOCLDWAIT=$0001; // No zombies if child dies
+ PS_NOCLDSTOP=$0002; // No SIGCHLD when children stop.
+ PS_CLDSIGIGN=$0004; // The SIGCHLD handler is SIG_IGN.
+
+ SIG_CATCH=2;
+
+type
+ p_ksiginfo=^ksiginfo_t;
+ p_sigqueue=^sigqueue_t;
+
+ ksiginfo_list=packed record
+ pFirst:p_ksiginfo;
+ pLast:^p_ksiginfo;
+ end;
+
+ ksiginfo_entry=packed record
+ pNext:p_ksiginfo;
+ pPrev:^p_ksiginfo;
+ end;
+
+ ksiginfo_t=packed record
+ ksi_link :ksiginfo_entry;
+ ksi_info :siginfo_t;
+ ksi_flags:Integer;
+ _align :Integer;
+ ksi_sigq :p_sigqueue;
+ end;
+
+ sigqueue_t=packed record
+ sq_signals:sigset_t;
+ sq_kill :sigset_t;
+ sq_list :ksiginfo_list;
+ sq_flags :Integer;
+ end;
+
+const
+ //bits for ksi_flags
+ KSI_TRAP =$01; // Generated by trap.
+ KSI_EXT =$02; // Externally managed ksi.
+ KSI_INS =$04; // Directly insert ksi, not the copy
+ KSI_SIGQ =$08; // Generated by sigqueue, might ret EGAIN.
+ KSI_HEAD =$10; // Insert into head, not tail.
+ KSI_COPYMASK=(KSI_TRAP or KSI_SIGQ);
+
+ // Flags for ksi_flags
+ SQ_INIT=$01;
+
+function SIGACTION (p:p_sigacts;sig:Integer):sig_t; inline;
+procedure SIGADDSET (p:p_sigset_t;signo:Integer); inline;
+procedure SIGDELSET (p:p_sigset_t;signo:Integer); inline;
+procedure SIGEMPTYSET(p:p_sigset_t); inline;
+procedure SIGFILLSET (p:p_sigset_t); inline;
+function SIGISMEMBER(p:p_sigset_t;signo:Integer):Boolean; inline;
+function SIGISEMPTY (p:p_sigset_t):Boolean; inline;
+function SIGNOTEMPTY(p:p_sigset_t):Boolean; inline;
+function SIGSETEQ (p1,p2:p_sigset_t):Boolean; inline;
+function SIGSETNEQ (p1,p2:p_sigset_t):Boolean; inline;
+procedure SIGSETOR (p1,p2:p_sigset_t); inline;
+procedure SIGSETAND (p1,p2:p_sigset_t); inline;
+procedure SIGSETNAND (p1,p2:p_sigset_t); inline;
+
+function sigsetmasked(p,mask:p_sigset_t):Boolean; inline;
+
+procedure ksiginfo_copy(src,dst:p_ksiginfo); inline;
+
+implementation
+
+function SIGACTION(p:p_sigacts;sig:Integer):sig_t; inline;
+begin
+ Result:=p^.ps_sigact[_SIG_IDX(sig)];
+end;
+
+procedure SIGADDSET(p:p_sigset_t;signo:Integer); inline;
+begin
+ p^.bits[_SIG_WORD(signo)]:=p^.bits[_SIG_WORD(signo)] or _SIG_BIT(signo);
+end;
+
+procedure SIGDELSET(p:p_sigset_t;signo:Integer); inline;
+begin
+ p^.bits[_SIG_WORD(signo)]:=p^.bits[_SIG_WORD(signo)] and (not _SIG_BIT(signo));
+end;
+
+procedure SIGEMPTYSET(p:p_sigset_t); inline;
+begin
+ p^.qwords[0]:=0;
+ p^.qwords[1]:=0;
+end;
+
+procedure SIGFILLSET(p:p_sigset_t); inline;
+begin
+ p^.qwords[0]:=QWORD(-1);
+ p^.qwords[1]:=QWORD(-1);
+end;
+
+function SIGISMEMBER(p:p_sigset_t;signo:Integer):Boolean; inline;
+begin
+ Result:=(p^.bits[_SIG_WORD(signo)] and _SIG_BIT(signo))<>0;
+end;
+
+function SIGISEMPTY(p:p_sigset_t):Boolean; inline;
+begin
+ Result:=(p^.qwords[0]=0) and (p^.qwords[1]=0)
+end;
+
+function SIGNOTEMPTY(p:p_sigset_t):Boolean; inline;
+begin
+ Result:=not SIGISEMPTY(P);
+end;
+
+function SIGSETEQ(p1,p2:p_sigset_t):Boolean; inline;
+begin
+ Result:=(p1^.qwords[0]=p2^.qwords[0]) and (p1^.qwords[1]=p2^.qwords[1]);
+end;
+
+function SIGSETNEQ(p1,p2:p_sigset_t):Boolean; inline;
+begin
+ Result:=not SIGSETEQ(p1,p2);
+end;
+
+procedure SIGSETOR(p1,p2:p_sigset_t); inline;
+begin
+ p1^.qwords[0]:=p1^.qwords[0] or p2^.qwords[0];
+ p1^.qwords[1]:=p1^.qwords[1] or p2^.qwords[1];
+end;
+
+procedure SIGSETAND(p1,p2:p_sigset_t); inline;
+begin
+ p1^.qwords[0]:=p1^.qwords[0] and p2^.qwords[0];
+ p1^.qwords[1]:=p1^.qwords[1] and p2^.qwords[1];
+end;
+
+procedure SIGSETNAND(p1,p2:p_sigset_t); inline;
+begin
+ p1^.qwords[0]:=p1^.qwords[0] and (not p2^.qwords[0]);
+ p1^.qwords[1]:=p1^.qwords[1] and (not p2^.qwords[1]);
+end;
+
+function sigsetmasked(p,mask:p_sigset_t):Boolean; inline;
+begin
+ Result:=((p^.qwords[0] and (not mask^.qwords[0]))<>0) or
+ ((p^.qwords[1] and (not mask^.qwords[1]))<>0);
+end;
+
+procedure ksiginfo_copy(src,dst:p_ksiginfo); inline;
+begin
+ dst^.ksi_info :=src^.ksi_info;
+ dst^.ksi_flags:=src^.ksi_flags and KSI_COPYMASK;
+end;
+
+
+end.
+
diff --git a/sys/systm.pas b/sys/systm.pas
index 80a733f3..73ae4fad 100644
--- a/sys/systm.pas
+++ b/sys/systm.pas
@@ -16,6 +16,7 @@ function fuword64(var base:QWORD):QWORD; inline;
function casuword32(var base:DWORD;oldval,newval:DWORD):DWORD; inline;
function casuword64(var base:QWORD;oldval,newval:QWORD):QWORD; inline;
function suword32(var base:DWORD;word:DWORD):DWORD; inline;
+function suword64(var base:QWORD;word:QWORD):DWORD; inline;
implementation
@@ -101,6 +102,16 @@ begin
end;
end;
+function suword64(var base:QWORD;word:QWORD):DWORD; inline;
+begin
+ if (NtWriteVirtualMemory(NtCurrentProcess,@base,@word,SizeOf(QWORD),nil)=0) then
+ begin
+ Result:=0;
+ end else
+ begin
+ Result:=DWORD(-1);
+ end;
+end;
end.
diff --git a/sys/test/project1.lpi b/sys/test/project1.lpi
index f2652b97..fe5d3801 100644
--- a/sys/test/project1.lpi
+++ b/sys/test/project1.lpi
@@ -69,6 +69,14 @@
+
+
+
+
+
+
+
+
diff --git a/sys/test/project1.lpr b/sys/test/project1.lpr
index 4fa34303..574d7cc4 100644
--- a/sys/test/project1.lpr
+++ b/sys/test/project1.lpr
@@ -14,6 +14,7 @@ uses
kern_lock,
kern_rwlock,
thr_private,
+ kern_sig,
sysutils,
vulkan,
vDevice;
@@ -515,7 +516,7 @@ var
prio:rtprio;
- tid:DWORD;
+ tid:QWORD;
ktd:p_kthread;
_time:Int64;
@@ -567,8 +568,8 @@ begin
ktd:=tdfind(tid);
- NtSuspendThread(ktd^.td_handle,nil);
- NtResumeThread(ktd^.td_handle,nil);
+ //NtSuspendThread(ktd^.td_handle,nil);
+ //NtResumeThread(ktd^.td_handle,nil);
kunlock(lock);