[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/06: syscalls: Adjust 'clone' to Guile 2.2.
From: |
Ludovic Courtès |
Subject: |
03/06: syscalls: Adjust 'clone' to Guile 2.2. |
Date: |
Wed, 15 Mar 2017 10:26:23 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 70dfdd501af46b0db138f3e289523e2d43c8e76d
Author: Ludovic Courtès <address@hidden>
Date: Wed Mar 15 13:41:18 2017 +0100
syscalls: Adjust 'clone' to Guile 2.2.
Before that, something like:
(call-with-container
(lambda ()
(match (primitive-fork)
…)))
would hang in 'primitive-fork' as the child process (the one started in
the container) would try to pthread_join the finalization thread in
'stop_finalization_thread' in libguile, not knowing that this thread is
nonexistent.
* guix/build/syscalls.scm (%set-automatic-finalization-enabled?!): New
procedure.
(without-automatic-finalization): New macro.
(clone): Wrap PROC call in 'without-automatic-finalization'.
---
guix/build/syscalls.scm | 45 +++++++++++++++++++++++++++++++++++++++++----
1 file changed, 41 insertions(+), 4 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 58c23f2..5aae153 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -656,6 +656,36 @@ mounted at FILE."
(define CLONE_NEWPID #x20000000)
(define CLONE_NEWNET #x40000000)
+(cond-expand
+ (guile-2.2
+ (define %set-automatic-finalization-enabled?!
+ (let ((proc (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 (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)))
+
;; The libc interface to sys_clone is not useful for Scheme programs, so the
;; low-level system call is wrapped instead. The 'syscall' function is
;; declared in <unistd.h> as a variadic function; in practice, it expects 6
@@ -678,10 +708,17 @@ mounted at FILE."
Unlike the fork system call, clone accepts FLAGS that specify which resources
are shared between the parent and child processes."
(let-values (((ret err)
- (proc syscall-id flags
- %null-pointer ;child stack
- %null-pointer %null-pointer ;ptid & ctid
- %null-pointer))) ;unused
+ ;; Guile 2.2 runs a finalization thread. 'primitive-fork'
+ ;; takes care of shutting it down before forking, and we
+ ;; must do the same here. Failing to do that, if the
+ ;; child process calls 'primitive-fork', it will hang
+ ;; while trying to pthread_join the finalization thread
+ ;; since that thread does not exist.
+ (without-automatic-finalization
+ (proc syscall-id flags
+ %null-pointer ;child stack
+ %null-pointer %null-pointer ;ptid & ctid
+ %null-pointer)))) ;unused
(if (= ret -1)
(throw 'system-error "clone" "~d: ~A"
(list flags (strerror err))
- branch master updated (bd10215 -> 608e42e), Ludovic Courtès, 2017/03/15
- 02/06: zlib: Don't rely on EBADF being ignored by 'fport_close'., Ludovic Courtès, 2017/03/15
- 04/06: store: Adjust UTF-8 test to Guile 2.2., Ludovic Courtès, 2017/03/15
- 06/06: build: Prefer Guile 2.2 over 2.0., Ludovic Courtès, 2017/03/15
- 05/06: tests: Expect less accurate location info in 2.2.0., Ludovic Courtès, 2017/03/15
- 03/06: syscalls: Adjust 'clone' to Guile 2.2.,
Ludovic Courtès <=
- 01/06: maint: Mention address@hidden in 'HACKING'., Ludovic Courtès, 2017/03/15