~ chicken-core (chicken-5) 9daf54537da4a22d581a8d5578166b9935dd9ddb
commit 9daf54537da4a22d581a8d5578166b9935dd9ddb Author: Peter Bex <peter@more-magic.net> AuthorDate: Thu Feb 6 16:19:34 2025 +0100 Commit: Peter Bex <peter@more-magic.net> CommitDate: Thu Feb 6 16:19:34 2025 +0100 Reify the current continuation before calling kill-other-threads Because kill-other-threads just *calls* the thunk and then exits, it must be a proper continuation, so we can't just pass a simple lambda which yields process-fork's return value (which is just #f). diff --git a/posixunix.scm b/posixunix.scm index 48c7a904..a9ca355e 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -1105,25 +1105,22 @@ static int set_file_mtime(C_word filename, C_word atime, C_word mtime) (lambda (#!optional thunk killothers) ;; flush all stdio streams before fork ((foreign-lambda int "C_fflush" c-pointer) #f) - (let ((pid (fork)) - (maybe-kill-others (lambda (thunk) - (if killothers - (##sys#kill-other-threads thunk) - (thunk))))) + (let ((pid (fork))) (cond ((fx= -1 pid) ; error (posix-error #:process-error 'process-fork "cannot create child process")) ((fx= 0 pid) ; child process (set! children '()) - (maybe-kill-others (if thunk - (lambda () - (##sys#call-with-cthulhu - (lambda () - (thunk) - ;; Make sure to run clean up tasks. - ;; NOTE: ##sys#call-with-cthulhu will invoke - ;; a more low-level runtime C_exit_runtime(0) - (exit 0)))) - (lambda () #f)))) + (when killothers + (call-with-current-continuation (lambda (continue) (##sys#kill-other-threads (lambda () (continue #f)))))) + (if thunk + (##sys#call-with-cthulhu + (lambda () + (thunk) + ;; Make sure to run clean up tasks. + ;; NOTE: ##sys#call-with-cthulhu will invoke + ;; a more low-level runtime C_exit_runtime(0) + (exit 0))) + #f)) (else ; parent process (register-pid pid)))))))Trap