add WITH-THESE-OPEN-VOLUMES macro property combinator

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

1 files changed, 27 insertions, 0 deletions

diff --git a/src/util.lisp b/src/util.lisp
index 2d024ca..a1523d0 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -264,3 +264,30 @@ previous output."
              (t
               (push c result)))
         finally (return (coerce (nreverse result) 'string))))
+
+
+;;;; Forking utilities
+
+(define-condition in-child-process () ())
+
+(defmacro unwind-protect-in-parent (protected &body cleanup)
+  "Like UNWIND-PROTECT, but with a mechanism to cancel the execution of CLEANUP
+in child processes resulting from calls to fork(2) during the execution of
+PROTECTED.  This means that CLEANUP won't get executed on both sides of the
+fork, but only in the parent.
+
+For this to work, after fork(2), the child process must call
+CANCEL-UNWIND-PROTECT-IN-PARENT-CLEANUP, which will affect all enclosing uses
+of this macro."
+  (with-gensyms (cancelled)
+    `(let (,cancelled)
+       (unwind-protect
+            (handler-bind ((in-child-process
+                             (lambda (c) (setq ,cancelled t) (signal c))))
+              ,protected)
+         (unless ,cancelled ,@cleanup)))))
+
+(defun cancel-unwind-protect-in-parent-cleanup ()
+  "Cancel the CLEANUP forms in all enclosing uses of UNWIND-PROTECT-IN-PARENT.
+Should be called soon after fork(2) in child processes."
+  (signal 'in-child-process))