(define (cml-fork sig-ch thunk)
  (let* ((ch (cml-sync-ch/make-channel))
	 (res-ch (cml-sync-ch/make-channel))
	 (sig-rv (cml-sync-ch/receive-rv sig-ch))
	 (process (fork thunk))
	 (proc-done-rv (cml-sync-ch/receive-rv ch)))

    (spawn 
      (lambda ()
	(let lp ()
	  (cml-rv/select 
	   (cml-rv/wrap sig-rv
			(lambda (sig) (if (not (wait process wait/poll)) 
					  (begin (signal-process process sig)
						 (lp)))))
	   (cml-rv/wrap proc-done-rv
			(lambda (res) (cml-sync-ch/send res-ch res))))))
      (format #t "cml-fork: signals (for ~a)\n" (proc:pid process)))

    (spawn (lambda ()
	     (cml-sync-ch/send ch (wait process)))
	   (format #t "cml-fork: waiting (for ~a)\n" (proc:pid process)))

    (cml-sync-ch/receive-rv res-ch)))

(define (cml-fork-collecting fds sig-ch thunk)
  (let* ((ch (cml-sync-ch/make-channel))
	 (res-ch (cml-sync-ch/make-channel))
	 (sig-rv (cml-sync-ch/receive-rv sig-ch))
	 ;; from scsh-0.6.6/scsh/scsh.scm
	 (channels (map (lambda (ignore)
			  (call-with-values temp-file-channel cons))
			fds))
	 (read-ports (map car channels))
	 (write-ports (map cdr channels))
	 (process (fork (lambda () 
			  (for-each close-input-port read-ports)
			  (for-each move->fdes write-ports fds)
			  (apply exec-path (thunk)))))
	 (proc-done-rv (cml-sync-ch/receive-rv ch)))

    (spawn 
      (lambda ()
	(let ((exitno (wait process)))
	  (cml-sync-ch/send ch (append (list exitno) 
				       (map port->string read-ports))))) 
      (format #t "cml-fork-collecting: waiting (for ~a)\n" (proc:pid process))) 

    (spawn 
      (lambda ()
	(let loop ()
	  (cml-rv/select 
	   (cml-rv/wrap sig-rv
			(lambda (sig) (if (not (wait process wait/poll)) 
					  (begin (signal-process process sig)
						 (loop)))))
	   (cml-rv/wrap proc-done-rv 
			(lambda (res) (cml-sync-ch/send res-ch res))))))
      (format #t "cml-fork-collecting: signals (for ~a)\n" (proc:pid process)))

    (for-each close-output-port write-ports)
    (cml-sync-ch/receive-rv res-ch)))