[shepherd] 01/02: system: Add 'without-automatic-finalization'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 92aa627a3fb26221d9d95d8afa721748f2e98fd6
Author: Ludovic Courtès <address@hidden>
AuthorDate: Sun Apr 19 22:31:21 2020 +0200

    system: Add 'without-automatic-finalization'.
    
    * modules/shepherd/system.scm.in (%set-automatic-finalization-enabled?!):
    New procedure.
    (without-automatic-finalization): New macro.
---
 modules/shepherd/system.scm.in | 42 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 41 insertions(+), 1 deletion(-)

diff --git a/modules/shepherd/system.scm.in b/modules/shepherd/system.scm.in
index ab049f5..64e4502 100644
--- a/modules/shepherd/system.scm.in
+++ b/modules/shepherd/system.scm.in
@@ -29,7 +29,8 @@
             max-file-descriptors
             prctl
             PR_SET_CHILD_SUBREAPER
-            getpgid))
+            getpgid
+            without-automatic-finalization))
 
 ;; The <sys/reboot.h> constants.
 (define RB_AUTOBOOT @RB_AUTOBOOT@)
@@ -177,3 +178,42 @@ ctrlaltdel(8) and see kernel/reboot.c in Linux."
                    (list (strerror err))
                    (list err))
             result)))))
+
+
+;;;
+;;; Guile shenanigans.
+;;;
+
+(cond-expand
+  (guile-2.2
+   (define %set-automatic-finalization-enabled?!
+     ;; When using a statically-linked Guile, for instance in the initrd, we
+     ;; cannot resolve this symbol, but most of the time we don't need it
+     ;; anyway.  Thus, delay it.
+     (let ((proc (delay
+                   (pointer->procedure int
+                                       (dynamic-func
+                                        
"scm_set_automatic_finalization_enabled"
+                                        (dynamic-link))
+                                       (list int)))))
+       (lambda (enabled?)
+         "Switch on or off automatic finalization in a separate thread.
+Turning finalization off shuts down the finalization thread as a side effect."
+         (->bool ((force proc) (if enabled? 1 0))))))
+
+   (define-syntax-rule (without-automatic-finalization exp ...)
+     "Turn off automatic finalization within the dynamic extent of EXP."
+     (let ((enabled? #t))
+       (dynamic-wind
+         (lambda ()
+           (set! enabled? (%set-automatic-finalization-enabled?! #f)))
+         (lambda ()
+           exp ...)
+         (lambda ()
+           (%set-automatic-finalization-enabled?! enabled?))))))
+
+  (else
+   (define-syntax-rule (without-automatic-finalization exp)
+     ;; Nothing to do here: Guile 2.0 does not have a separate finalization
+     ;; thread.
+     exp)))