~ chicken-core (chicken-5) 61caf8a1c8cd50f7654f614d81c3225e5f72bc0a

commit 61caf8a1c8cd50f7654f614d81c3225e5f72bc0a
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Jul 28 13:12:31 2023 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Jul 28 13:12:31 2023 +0200

    Provide new thread-safe API for POSIX signals and deprecate old one

diff --git a/DEPRECATED b/DEPRECATED
index 6c2a009e..c8d19bd1 100644
--- a/DEPRECATED
+++ b/DEPRECATED
@@ -5,6 +5,9 @@ Deprecated functions and variables
 - read/source-info from the internal, undocumented module
   (chicken compiler support) is deprecated.  Instead, use
   read-with-source-info from (chicken syntax).
+- "set-signal-handler!" and "signal-handler" have been deprecated
+  in favor of "make-signal-handler" and "ignore-signal" which are
+  better suited in a multithreaded environment.
 
 5.2.1
 - current-milliseconds and its C implementations C_milliseconds and
diff --git a/NEWS b/NEWS
index 19d2f30e..19686e11 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,8 @@
     the first non-runtime option or after "-:", whichever comes first.
 
 - Core libraries
+  - Added new thread-safe API for POSIX signals ("make-signal-handler", 
+    "signal-ignore" and "signal-default") and deprecated the existing one.
   - Added "make-finalizer" to execute finalizers in a thread-safe
     manner.
   - Added weak pairs to (chicken base), with similar behaviour to Chez Scheme.
diff --git a/manual/Module (chicken process signal) b/manual/Module (chicken process signal)
index 8e40cfdc..a640f165 100644
--- a/manual/Module (chicken process signal)	
+++ b/manual/Module (chicken process signal)	
@@ -19,34 +19,41 @@ that's the case, the description contains a note.
 
 Sets an internal timer to raise the {{signal/alrm}}
 after {{SECONDS}} are elapsed.  You can use the
-{{set-signal-handler!}} procedure to write a handler for this signal.
+{{make-signal-handler}} procedure to write a handler for this signal.
 
 '''NOTE''': On native Windows builds (all except cygwin), this
 procedure is unimplemented and will raise an error.
 
-=== signal-handler
-=== set-signal-handler!
+=== make-signal-handler
 
-<procedure>(signal-handler SIGNUM)</procedure>
+<procedure>(make-signal-handler SIGNUM ...)</procedure>
 
-Returns the signal handler for the code {{SIGNUM}} or {{#f}}.
+Establishes a handler for the POSIX signals with the numbers {{SIGNUM ...}} and returns
+a procedure of zero or one argument. Should one of the given signals be raised, then it will be stored in a
+queue. Invoking the procedure returned by {{make-signal-handler}} with zero arguments or
+with the argument {{#f}} will remove the oldest
+entry in the queue and return it to the caller. Invoking the procedure with argument {{#t}} when no signal was
+raised since the creation of the signal handler or the most recent call to the handler
+will result in suspending the execution until one of the signals given in {{SIGNUM ...}}
+occurs.
 
-<procedure>(set-signal-handler! SIGNUM PROC)</procedure>
+Notes:
 
-Establishes the procedure of one argument {{PROC}} as the handler
-for the signal with the code {{SIGNUM}}. {{PROC}} is called
-with the signal number as its sole argument. If the argument {{PROC}} is {{#f}}
-then any signal handler will be removed, and the corresponding signal set to {{SIG_IGN}}.
+* when signals arrive in quick succession (specifically, before the handler for a signal has been started), then signals will be queued (up to a certain limit); the order in which the queued signals will be handled is not specified
 
-Notes
+* Any signal handlers for the signals {{signal/segv}}, {{signal/bus}}, {{signal/fpe}} and {{signal/ill}} will be ignored and these signals will always trigger an exception, unless the executable was started with the {{-:S}} runtime option. This feature is only available on platforms that support the {{sigprocmask(3)}} POSIX API function.
 
-* it is unspecified in which thread of execution the signal handler will be invoked.
+=== signal-ignore
 
-* when signals arrive in quick succession (specifically, before the handler for a signal has been started), then signals will be queued (up to a certain limit); the order in which the queued signals will be handled is not specified
+<procedure>(signal-ignore SIGNUM)</procedure>
 
-* {{(set! (signal-handler SIG) PROC)}} can be used as an alternative to {{(set-signal-handler! SIG PROC)}}
+Ignores any future occurrences if the signal {{SIGNUM}} by setting its disposition to {{SIG_IGN}}.
 
-* Any signal handlers for the signals {{signal/segv}}, {{signal/bus}}, {{signal/fpe}} and {{signal/ill}} will be ignored and these signals will always trigger an exception, unless the executable was started with the {{-:S}} runtime option. This feature is only available on platforms that support the {{sigprocmask(3)}} POSIX API function.
+=== signal-default
+
+<procedure>(signal-default SIGNUM)</procedure>
+
+Sets the default disposition for the signal {{SIGNUM}} by setting its disposition to {{SIG_DFL}}.
 
 === set-signal-mask!
 
diff --git a/posix-common.scm b/posix-common.scm
index 8ee394c0..6f7028c3 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -625,19 +625,46 @@ EOF
 
 ;;; Signals
 
-(set! chicken.process.signal#set-signal-handler!
+(set! chicken.process.signal#set-signal-handler!   ; DEPRECATED
   (lambda (sig proc)
     (##sys#check-fixnum sig 'set-signal-handler!)
     (##core#inline "C_establish_signal_handler" sig (and proc sig))
     (vector-set! ##sys#signal-vector sig proc) ) )
 
-(set! chicken.process.signal#signal-handler
+(set! chicken.process.signal#signal-handler   ; DEPRECATED
   (getter-with-setter
    (lambda (sig)
      (##sys#check-fixnum sig 'signal-handler)
      (##sys#slot ##sys#signal-vector sig) )
    chicken.process.signal#set-signal-handler!
    "(chicken.process.signal#signal-handler sig)"))
+                        
+(set! chicken.process.signal#make-signal-handler
+  (lambda sigs
+    (let ((q (##sys#make-event-queue)))
+      (for-each
+        (lambda (sig)
+          (##sys#check-fixnum sig 'make-signal-handler)
+          (##core#inline "C_establish_signal_handler" sig sig)
+          (vector-set! ##sys#signal-vector sig 
+                       (lambda (sig) (##sys#add-event-to-queue! q sig))))
+        sigs)
+      (lambda (#!optional wait) 
+        (if wait
+            (##sys#wait-for-next-event q)
+            (##sys#get-next-event q))))))
+                        
+(set! chicken.process.signal#signal-ignore
+  (lambda (sig)
+    (##sys#check-fixnum sig 'signal-ignore)
+    (##core#inline "C_establish_signal_handler" sig #f)
+    (vector-set! ##sys#signal-vector sig #f)))
+
+(set! chicken.process.signal#signal-default
+  (lambda (sig)
+    (##sys#check-fixnum sig 'signal-default)
+    (##core#inline "C_establish_signal_handler" sig #t)
+    (vector-set! ##sys#signal-vector sig #f)))
 
 
 ;;; Processes
diff --git a/posix.scm b/posix.scm
index b28f21b1..a082f054 100644
--- a/posix.scm
+++ b/posix.scm
@@ -263,8 +263,10 @@
 
 
 (module chicken.process.signal
-  (set-alarm! set-signal-handler! set-signal-mask!
-   signal-handler signal-mask signal-mask! signal-masked? signal-unmask!
+  (set-alarm! set-signal-mask!
+   make-signal-handler signal-ignore signal-default
+   set-signal-handler! signal-handler ; DEPRECATED
+   signal-mask signal-mask! signal-masked? signal-unmask!
    signal/abrt signal/alrm signal/break signal/bus signal/chld
    signal/cont signal/fpe signal/hup signal/ill signal/int signal/io
    signal/kill signal/pipe signal/prof signal/quit signal/segv
@@ -276,9 +278,12 @@
 
 ;; These are all set! inside the posix module
 (define set-alarm!)
-(define set-signal-handler!)
+(define set-signal-handler!) ; DEPRECATED
 (define set-signal-mask!)
-(define signal-handler)
+(define signal-handler) ; DEPRECATED
+(define make-signal-handler)
+(define signal-ignore)
+(define signal-default)
 
 (define signal-mask)
 (define signal-mask!)
diff --git a/runtime.c b/runtime.c
index 6fdd7fca..9becd2aa 100644
--- a/runtime.c
+++ b/runtime.c
@@ -4942,6 +4942,7 @@ C_regparm C_word C_fcall C_establish_signal_handler(C_word signum, C_word reason
 #endif
 
   if(reason == C_SCHEME_FALSE) C_signal(sig, SIG_IGN);
+  else if(reason == C_SCHEME_TRUE) C_signal(sig, SIG_DFL);
   else {
     signal_mapping_table[ sig ] = C_unfix(reason);
 #if defined(HAVE_SIGACTION)
diff --git a/types.db b/types.db
index 62d98126..ad4f547f 100644
--- a/types.db
+++ b/types.db
@@ -2111,9 +2111,10 @@
 ;; process.signal
 
 (chicken.process.signal#set-alarm! (#(procedure #:clean #:enforce) chicken.process#set-alarm! (integer) integer))
-(chicken.process.signal#set-signal-handler! (#(procedure #:clean #:enforce) chicken.process.signal#set-signal-handler! (fixnum (or false (procedure (fixnum) . *))) undefined))
+(chicken.process.signal#make-signal-handler (#(procedure #:clean #:enforce) chicken.process.signal#make-signal-handler (#!rest fixnum) (procedure () fixnum)))
 (chicken.process.signal#set-signal-mask! (#(procedure #:clean #:enforce) chicken.process.signal#set-signal-mask! ((list-of fixnum)) undefined))
-(chicken.process.signal#signal-handler (#(procedure #:clean #:enforce) chicken.process.signal#signal-handler (fixnum) (or false (procedure (fixnum) . *))))
+(chicken.process.signal#signal-ignore (#(procedure #:clean #:enforce) chicken.process.signal#signal-ignore (fixnum) undefined))
+(chicken.process.signal#signal-default (#(procedure #:clean #:enforce) chicken.process.signal#signal-default (fixnum) undefined))
 (chicken.process.signal#signal-mask (#(procedure #:clean) chicken.process.signal#signal-mask () fixnum))
 (chicken.process.signal#signal-mask! (#(procedure #:clean #:enforce) chicken.process.signal#signal-mask! (fixnum) undefined))
 (chicken.process.signal#signal-masked? (#(procedure #:clean #:enforce) chicken.process.signal#signal-masked? (fixnum) boolean))