wingo pushed a commit to branch wip-whippet
in repository guile.
commit f436e550eac344552957e0f199cf5a0c2258e3e0
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Mon Jun 16 09:22:48 2025 +0200
Pipes use finalizers instead of guardians
* module/ice-9/popen.scm (reap-pipe, open-pipe*): Instead of pumping a
guardian in the after-gc-hook, attach a finalizer. This will pump pipes
in a thread instead of needing to do it ourselves.
---
module/ice-9/popen.scm | 45 ++++++++++++++++++---------------------------
1 file changed, 18 insertions(+), 27 deletions(-)
diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm
index 43b5d2f62..e3c143e7e 100644
--- a/module/ice-9/popen.scm
+++ b/module/ice-9/popen.scm
@@ -20,11 +20,11 @@
(define-module (ice-9 popen)
#:use-module (ice-9 binary-ports)
- #:use-module (ice-9 guardians)
#:use-module (ice-9 threads)
#:use-module (ice-9 weak-tables)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
+ #:use-module (system finalizers)
#:export (open-pipe* open-pipe close-pipe open-input-pipe
open-output-pipe open-input-output-pipe pipeline))
@@ -76,10 +76,6 @@
rw-port)
-;; a guardian to ensure the cleanup is done correctly when
-;; an open pipe is gc'd or a close-port is used.
-(define pipe-guardian (make-guardian))
-
(define (pipe->fdes)
(let ((p (pipe)))
(cons (port->fdes (car p))
@@ -137,7 +133,7 @@ port to the process is created: it should be the value of
;; Guard the pipe-info instead of the port, so that we can still
;; call 'waitpid' even if 'close-port' is called (which clears
;; the port entry).
- (pipe-guardian pipe-info)
+ (add-finalizer! pipe-info reap-pipe)
(%set-port-property! port 'popen-pipe-info pipe-info)
port))))
@@ -171,27 +167,22 @@ information on how to interpret this value."
(set-pipe-info-pid! pipe-info #f)
(close-process p pid))))
-(define (reap-pipes)
- (let loop ()
- (let ((pipe-info (pipe-guardian)))
- (when pipe-info
- (let ((pid (pipe-info-pid pipe-info)))
- ;; maybe 'close-pipe' was already called.
- (when pid
- ;; clean up without reporting errors. also avoids blocking
- ;; the process: if the child isn't ready to be collected,
- ;; puts it back into the guardian's live list so it can be
- ;; tried again the next time the cleanup runs.
- (catch 'system-error
- (lambda ()
- (let ((pid/status (waitpid pid WNOHANG)))
- (if (zero? (car pid/status))
- (pipe-guardian pipe-info) ; not ready for collection
- (set-pipe-info-pid! pipe-info #f))))
- (lambda args #f))))
- (loop)))))
-
-(add-hook! after-gc-hook reap-pipes)
+(define (reap-pipe pipe-info)
+ (let ((pid (pipe-info-pid pipe-info)))
+ ;; Maybe 'close-pipe' was already called.
+ (when pid
+ ;; If the process is has exited, we need to waitpid() on it, to
+ ;; allow the OS to do the final process teardown. If it hasn't
+ ;; exited yet, keep the pipe-info alive and re-add reap-pipe as a
+ ;; finalizer so we can check again after the next GC.
+ (catch 'system-error
+ (lambda ()
+ (let ((pid/status (waitpid pid WNOHANG)))
+ (if (zero? (car pid/status))
+ ;; not ready for collection
+ (add-finalizer! pipe-info reap-pipe)
+ (set-pipe-info-pid! pipe-info #f))))
+ (lambda args #f)))))
(define (open-input-pipe command)
"Equivalent to @code{open-pipe} with mode @code{OPEN_READ}"
