~ chicken-core (chicken-5) e59919cd78db66978f22b1e1083049088b243b4a
commit e59919cd78db66978f22b1e1083049088b243b4a
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Mon Apr 30 17:25:49 2018 +0200
Commit: Kooda <kooda@upyum.com>
CommitDate: Tue May 1 11:25:07 2018 +0200
Refactor chicken.process so it no longer refers to chicken.posix
Again, similar to the previous commit.
Several small changes:
- Renamed ##sys#process-wait (which holds the actual implementation of
waiting for a process; common API uses this) to process-wait-impl.
- Moved pip/buf, {open,close}-{input,output}-pipe,
with-{input-from,output-to}-pipe and call-with-{input,output}-pipe
to posix-common.scm as their implementations were identical in both
posixwin.scm and posixunix.scm.
- In preparation of potentially moving the "common" part of the
process/process* implementations to posix-common.scm, unified the
##sys#shell-command interface so that it accepts a location in both
posixunix (which ignores this argument) and posixwin (which uses it
when raising an exception). Also dropped the ##sys# prefix on both
it and ##sys#shell-command-arguments
Signed-off-by: Kooda <kooda@upyum.com>
diff --git a/posix-common.scm b/posix-common.scm
index 3218d06d..af338db4 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -598,16 +598,17 @@ EOF
(define current-process-id (foreign-lambda int "C_getpid"))
-(define (process-sleep n)
- (##sys#check-fixnum n 'process-sleep)
- (##core#inline "C_i_process_sleep" n))
+(set! chicken.process#process-sleep
+ (lambda (n)
+ (##sys#check-fixnum n 'process-sleep)
+ (##core#inline "C_i_process_sleep" n)))
-(define process-wait
+(set! chicken.process#process-wait
(lambda args
- (let-optionals* args ([pid #f] [nohang #f])
- (let ([pid (or pid -1)])
+ (let-optionals* args ((pid #f) (nohang #f))
+ (let ((pid (or pid -1)))
(##sys#check-fixnum pid 'process-wait)
- (receive [epid enorm ecode] (##sys#process-wait pid nohang)
+ (receive (epid enorm ecode) (process-wait-impl pid nohang)
(if (fx= epid -1)
(posix-error #:process-error 'process-wait "waiting for child process failed" pid)
(values epid enorm ecode) ) ) ) ) ) )
@@ -687,3 +688,90 @@ EOF
nop loc)))
(proc (##sys#make-c-string filename loc) argbuf envbuf))))))
+
+;; Pipes:
+
+(define-foreign-variable _pipe_buf int "PIPE_BUF")
+(set! chicken.process#pipe/buf _pipe_buf)
+
+(let ()
+ (define (mode arg) (if (pair? arg) (##sys#slot arg 0) '###text))
+ (define (badmode m) (##sys#error "illegal input/output mode specifier" m))
+ (define (check loc cmd inp r)
+ (if (##sys#null-pointer? r)
+ (posix-error #:file-error loc "cannot open pipe" cmd)
+ (let ((port (##sys#make-port (if inp 1 2) ##sys#stream-port-class "(pipe)" 'stream)))
+ (##core#inline "C_set_file_ptr" port r)
+ port) ) )
+ (set! chicken.process#open-input-pipe
+ (lambda (cmd . m)
+ (##sys#check-string cmd 'open-input-pipe)
+ (let ([m (mode m)])
+ (check
+ 'open-input-pipe
+ cmd #t
+ (case m
+ ((#:text) (##core#inline_allocate ("open_text_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
+ ((#:binary) (##core#inline_allocate ("open_binary_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
+ (else (badmode m)) ) ) ) ) )
+ (set! chicken.process#open-output-pipe
+ (lambda (cmd . m)
+ (##sys#check-string cmd 'open-output-pipe)
+ (let ((m (mode m)))
+ (check
+ 'open-output-pipe
+ cmd #f
+ (case m
+ ((#:text) (##core#inline_allocate ("open_text_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
+ ((#:binary) (##core#inline_allocate ("open_binary_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
+ (else (badmode m)) ) ) ) ) )
+ (set! chicken.process#close-input-pipe
+ (lambda (port)
+ (##sys#check-input-port port #t 'close-input-pipe)
+ (let ((r (##core#inline "close_pipe" port)))
+ (when (eq? -1 r)
+ (posix-error #:file-error 'close-input-pipe "error while closing pipe" port))
+ r) ) )
+ (set! chicken.process#close-output-pipe
+ (lambda (port)
+ (##sys#check-output-port port #t 'close-output-pipe)
+ (let ((r (##core#inline "close_pipe" port)))
+ (when (eq? -1 r)
+ (posix-error #:file-error 'close-output-pipe "error while closing pipe" port))
+ r) ) ))
+
+(set! chicken.process#with-input-from-pipe
+ (lambda (cmd thunk . mode)
+ (let ((p (apply chicken.process#open-input-pipe cmd mode)))
+ (fluid-let ((##sys#standard-input p))
+ (call-with-values thunk
+ (lambda results
+ (chicken.process#close-input-pipe p)
+ (apply values results) ) ) ) ) ) )
+
+(set! chicken.process#call-with-output-pipe
+ (lambda (cmd proc . mode)
+ (let ((p (apply chicken.process#open-output-pipe cmd mode)))
+ (call-with-values
+ (lambda () (proc p))
+ (lambda results
+ (chicken.process#close-output-pipe p)
+ (apply values results) ) ) ) ) )
+
+(set! chicken.process#call-with-input-pipe
+ (lambda (cmd proc . mode)
+ (let ([p (apply chicken.process#open-input-pipe cmd mode)])
+ (call-with-values
+ (lambda () (proc p))
+ (lambda results
+ (chicken.process#close-input-pipe p)
+ (apply values results) ) ) ) ) )
+
+(set! chicken.process#with-output-to-pipe
+ (lambda (cmd thunk . mode)
+ (let ((p (apply chicken.process#open-output-pipe cmd mode)))
+ (fluid-let ((##sys#standard-output p))
+ (call-with-values thunk
+ (lambda results
+ (chicken.process#close-output-pipe p)
+ (apply values results) ) ) ) ) ) )
diff --git a/posix.scm b/posix.scm
index e58b6247..89bb0aff 100644
--- a/posix.scm
+++ b/posix.scm
@@ -182,21 +182,95 @@
) ; chicken.time.posix
+(module chicken.process
+ (qs system system* process-execute process-fork process-run
+ process-signal process-spawn process-wait call-with-input-pipe
+ call-with-output-pipe close-input-pipe close-output-pipe create-pipe
+ open-input-pipe open-output-pipe with-input-from-pipe
+ with-output-to-pipe process process* process-sleep pipe/buf
+ spawn/overlay spawn/wait spawn/nowait spawn/nowaito spawn/detach)
+
+(import scheme chicken.base chicken.fixnum chicken.platform)
+
+
+;;; Execute a shell command:
+
+(define (system cmd)
+ (##sys#check-string cmd 'system)
+ (let ((r (##core#inline "C_execute_shell_command" cmd)))
+ (cond ((fx< r 0)
+ (##sys#update-errno)
+ (##sys#signal-hook #:process-error 'system "`system' invocation failed" cmd))
+ (else r))))
+
+;;; Like `system', but bombs on nonzero return code:
+
+(define (system* str)
+ (let ((n (system str)))
+ (unless (zero? n)
+ (##sys#error "shell invocation failed with non-zero return status" str n))))
+
+
+;;; Quote string for shell:
+
+(define (qs str #!optional (platform (software-version)))
+ (let* ((delim (if (eq? platform 'mingw32) #\" #\'))
+ (escaped (if (eq? platform 'mingw32) "\"\"" "'\\''"))
+ (escaped-parts
+ (map (lambda (c)
+ (cond
+ ((char=? c delim) escaped)
+ ((char=? c #\nul)
+ (error 'qs "NUL character can not be represented in shell string" str))
+ (else (string c))))
+ (string->list str))))
+ (string-append
+ (string delim)
+ (apply string-append escaped-parts)
+ (string delim))))
+
+
+;; These are all set! inside the posix module
+(define process-execute)
+(define process-fork)
+(define process-run)
+(define process-signal)
+(define process-spawn)
+(define process-wait)
+
+(define call-with-input-pipe)
+(define call-with-output-pipe)
+(define close-input-pipe)
+(define close-output-pipe)
+(define create-pipe)
+(define open-input-pipe)
+(define open-output-pipe)
+(define with-input-from-pipe)
+(define with-output-to-pipe)
+
+(define process)
+(define process*)
+(define process-sleep)
+
+(define pipe/buf)
+
+(define spawn/overlay)
+(define spawn/wait)
+(define spawn/nowait)
+(define spawn/nowaito)
+(define spawn/detach)
+) ; chicken.process
+
+
;; This module really does nothing. It is used to keep all the posix
;; stuff in one place, in a clean namespace. The included file will
;; set! values from the modules defined above.
(module chicken.posix
- (call-with-input-pipe call-with-output-pipe
- change-directory* close-input-pipe
- close-output-pipe create-pipe create-session
+ (change-directory* create-session
current-effective-group-id current-effective-user-id
current-effective-user-name current-group-id current-process-id
current-user-id current-user-name
- open-input-pipe open-output-pipe
- parent-process-id
- process process* process-execute process-fork
- process-group-id process-run process-signal process-sleep
- process-spawn process-wait
+ parent-process-id process-group-id
set-alarm! set-root-directory! set-signal-handler! set-signal-mask!
signal-handler signal-mask signal-mask! signal-masked? signal-unmask!
signal/abrt signal/alrm signal/break signal/bus signal/chld
@@ -204,9 +278,7 @@
signal/kill signal/pipe signal/prof signal/quit signal/segv
signal/stop signal/term signal/trap signal/tstp signal/urg
signal/usr1 signal/usr2 signal/vtalrm signal/winch signal/xcpu
- signal/xfsz signals-list spawn/detach spawn/nowait
- spawn/nowaito spawn/overlay spawn/wait user-information
- with-input-from-pipe with-output-to-pipe)
+ signal/xfsz signals-list)
(import scheme
chicken.base
@@ -274,83 +346,6 @@
) ; chicken.errno
-(module chicken.process
- (qs system system* process-execute process-fork process-run
- process-signal process-spawn process-wait call-with-input-pipe
- call-with-output-pipe close-input-pipe close-output-pipe create-pipe
- open-input-pipe open-output-pipe with-input-from-pipe
- with-output-to-pipe process process* process-sleep pipe/buf
- spawn/overlay spawn/wait spawn/nowait spawn/nowaito spawn/detach)
-
-(import scheme chicken.base chicken.fixnum chicken.platform)
-
-
-;;; Execute a shell command:
-
-(define (system cmd)
- (##sys#check-string cmd 'system)
- (let ((r (##core#inline "C_execute_shell_command" cmd)))
- (cond ((fx< r 0)
- (##sys#update-errno)
- (##sys#signal-hook #:process-error 'system "`system' invocation failed" cmd))
- (else r))))
-
-;;; Like `system', but bombs on nonzero return code:
-
-(define (system* str)
- (let ((n (system str)))
- (unless (zero? n)
- (##sys#error "shell invocation failed with non-zero return status" str n))))
-
-
-;;; Quote string for shell:
-
-(define (qs str #!optional (platform (software-version)))
- (let* ((delim (if (eq? platform 'mingw32) #\" #\'))
- (escaped (if (eq? platform 'mingw32) "\"\"" "'\\''"))
- (escaped-parts
- (map (lambda (c)
- (cond
- ((char=? c delim) escaped)
- ((char=? c #\nul)
- (error 'qs "NUL character can not be represented in shell string" str))
- (else (string c))))
- (string->list str))))
- (string-append
- (string delim)
- (apply string-append escaped-parts)
- (string delim))))
-
-(define process-execute chicken.posix#process-execute)
-(define process-fork chicken.posix#process-fork)
-(define process-run chicken.posix#process-run)
-(define process-signal chicken.posix#process-signal)
-(define process-spawn chicken.posix#process-spawn)
-(define process-wait chicken.posix#process-wait)
-
-(define call-with-input-pipe chicken.posix#call-with-input-pipe)
-(define call-with-output-pipe chicken.posix#call-with-output-pipe)
-(define close-input-pipe chicken.posix#close-input-pipe)
-(define close-output-pipe chicken.posix#close-output-pipe)
-(define create-pipe chicken.posix#create-pipe)
-(define open-input-pipe chicken.posix#open-input-pipe)
-(define open-output-pipe chicken.posix#open-output-pipe)
-(define with-input-from-pipe chicken.posix#with-input-from-pipe)
-(define with-output-to-pipe chicken.posix#with-output-to-pipe)
-
-(define process chicken.posix#process)
-(define process* chicken.posix#process*)
-(define process-sleep chicken.posix#process-sleep)
-
-(define pipe/buf chicken.posix#pipe/buf)
-
-(define spawn/overlay chicken.posix#spawn/overlay)
-(define spawn/wait chicken.posix#spawn/wait)
-(define spawn/nowait chicken.posix#spawn/nowait)
-(define spawn/nowaito chicken.posix#spawn/nowaito)
-(define spawn/detach chicken.posix#spawn/detach)
-) ; chicken.process
-
(module chicken.process.signal
(set-signal-handler! set-signal-mask! signal-handler signal-mask
signal-mask! signal-masked? signal-unmask! signal/abrt signal/alrm
diff --git a/posixunix.scm b/posixunix.scm
index 29cfab7e..2daade46 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -296,10 +296,6 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; Lo-level I/O:
-(define-foreign-variable _pipe_buf int "PIPE_BUF")
-
-(define pipe/buf _pipe_buf)
-
(define-foreign-variable _f_dupfd int "F_DUPFD")
(define-foreign-variable _f_getfd int "F_GETFD")
(define-foreign-variable _f_setfd int "F_SETFD")
@@ -324,11 +320,11 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;; Windows-only definitions
(set! chicken.file.posix#open/noinherit 0)
-(define spawn/overlay 0)
-(define spawn/wait 0)
-(define spawn/nowait 0)
-(define spawn/nowaito 0)
-(define spawn/detach 0)
+(set! chicken.process#spawn/overlay 0)
+(set! chicken.process#spawn/wait 0)
+(set! chicken.process#spawn/nowait 0)
+(set! chicken.process#spawn/nowaito 0)
+(set! chicken.process#spawn/detach 0)
(define-foreign-variable _s_isuid int "S_ISUID")
(define-foreign-variable _s_isgid int "S_ISGID")
@@ -462,101 +458,16 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(and fdsw (if (fixnum? fdsw) (and (memq fdsw wl) fdsw) wl))))))))))
-;;; Pipes:
-
-(define open-input-pipe)
-(define open-output-pipe)
-(define close-input-pipe)
-(define close-output-pipe)
-
-(let ()
- (define (mode arg) (if (pair? arg) (##sys#slot arg 0) '###text))
- (define (badmode m) (##sys#error "illegal input/output mode specifier" m))
- (define (check loc cmd inp r)
- (if (##sys#null-pointer? r)
- (posix-error #:file-error loc "cannot open pipe" cmd)
- (let ((port (##sys#make-port (if inp 1 2) ##sys#stream-port-class "(pipe)" 'stream)))
- (##core#inline "C_set_file_ptr" port r)
- port) ) )
- (set! open-input-pipe
- (lambda (cmd . m)
- (##sys#check-string cmd 'open-input-pipe)
- (let ([m (mode m)])
- (check
- 'open-input-pipe
- cmd #t
- (case m
- ((#:text) (##core#inline_allocate ("open_text_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
- ((#:binary) (##core#inline_allocate ("open_binary_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
- (else (badmode m)) ) ) ) ) )
- (set! open-output-pipe
- (lambda (cmd . m)
- (##sys#check-string cmd 'open-output-pipe)
- (let ((m (mode m)))
- (check
- 'open-output-pipe
- cmd #f
- (case m
- ((#:text) (##core#inline_allocate ("open_text_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
- ((#:binary) (##core#inline_allocate ("open_binary_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
- (else (badmode m)) ) ) ) ) )
- (set! close-input-pipe
- (lambda (port)
- (##sys#check-input-port port #t 'close-input-pipe)
- (let ((r (##core#inline "close_pipe" port)))
- (when (eq? -1 r)
- (posix-error #:file-error 'close-input-pipe "error while closing pipe" port))
- r) ) )
- (set! close-output-pipe
- (lambda (port)
- (##sys#check-output-port port #t 'close-output-pipe)
- (let ((r (##core#inline "close_pipe" port)))
- (when (eq? -1 r)
- (posix-error #:file-error 'close-output-pipe "error while closing pipe" port))
- r) ) ))
-
-(define call-with-input-pipe
- (lambda (cmd proc . mode)
- (let ([p (apply open-input-pipe cmd mode)])
- (##sys#call-with-values
- (lambda () (proc p))
- (lambda results
- (close-input-pipe p)
- (apply values results) ) ) ) ) )
-
-(define call-with-output-pipe
- (lambda (cmd proc . mode)
- (let ([p (apply open-output-pipe cmd mode)])
- (##sys#call-with-values
- (lambda () (proc p))
- (lambda results
- (close-output-pipe p)
- (apply values results) ) ) ) ) )
-
-(define with-input-from-pipe
- (lambda (cmd thunk . mode)
- (let ([p (apply open-input-pipe cmd mode)])
- (fluid-let ((##sys#standard-input p))
- (##sys#call-with-values thunk
- (lambda results
- (close-input-pipe p)
- (apply values results) ) ) ) ) ) )
-(define with-output-to-pipe
- (lambda (cmd thunk . mode)
- (let ([p (apply open-output-pipe cmd mode)])
- (fluid-let ((##sys#standard-output p))
- (##sys#call-with-values thunk
- (lambda results
- (close-output-pipe p)
- (apply values results) ) ) ) ) ) )
+;;; Pipe primitive:
(define-foreign-variable _pipefd0 int "C_pipefds[ 0 ]")
(define-foreign-variable _pipefd1 int "C_pipefds[ 1 ]")
-(define (create-pipe #!optional mode)
- (when (fx< (##core#inline "C_pipe" #f) 0)
- (posix-error #:file-error 'create-pipe "cannot create pipe") )
- (values _pipefd0 _pipefd1) )
+(set! chicken.process#create-pipe
+ (lambda (#!optional mode)
+ (when (fx< (##core#inline "C_pipe" #f) 0)
+ (posix-error #:file-error 'create-pipe "cannot create pipe") )
+ (values _pipefd0 _pipefd1)) )
;;; Signal processing:
@@ -1137,7 +1048,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; Process handling:
-(define process-fork
+(set! chicken.process#process-fork
(let ((fork (foreign-lambda int "C_fork")))
(lambda (#!optional thunk killothers)
;; flush all stdio streams before fork
@@ -1156,61 +1067,64 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(exit 0)))))
pid)))))
-(define (process-execute filename #!optional (arglist '()) envlist exactf)
- (call-with-exec-args
- 'process-execute filename (lambda (x) x) arglist envlist
- (lambda (prg argbuf envbuf)
- (let ((r (if envbuf
- (##core#inline "C_u_i_execve" prg argbuf envbuf)
- (##core#inline "C_u_i_execvp" prg argbuf))))
- (when (fx= r -1)
- (posix-error #:process-error 'process-execute "cannot execute process" filename))))))
+(set! chicken.process#process-execute
+ (lambda (filename #!optional (arglist '()) envlist exactf)
+ (call-with-exec-args
+ 'process-execute filename (lambda (x) x) arglist envlist
+ (lambda (prg argbuf envbuf)
+ (let ((r (if envbuf
+ (##core#inline "C_u_i_execve" prg argbuf envbuf)
+ (##core#inline "C_u_i_execvp" prg argbuf))))
+ (when (fx= r -1)
+ (posix-error #:process-error 'process-execute "cannot execute process" filename)))))))
(define-foreign-variable _wnohang int "WNOHANG")
(define-foreign-variable _wait-status int "C_wait_status")
-(define (##sys#process-wait pid nohang)
- (let* ([res (##core#inline "C_waitpid" pid (if nohang _wnohang 0))]
- [norm (##core#inline "C_WIFEXITED" _wait-status)] )
+(define (process-wait-impl pid nohang)
+ (let* ((res (##core#inline "C_waitpid" pid (if nohang _wnohang 0)))
+ (norm (##core#inline "C_WIFEXITED" _wait-status)) )
(if (and (fx= res -1) (fx= _errno _eintr))
(##sys#dispatch-interrupt
- (lambda () (##sys#process-wait pid nohang)))
+ (lambda () (process-wait-impl pid nohang)))
(values
res
norm
- (cond [norm (##core#inline "C_WEXITSTATUS" _wait-status)]
- [(##core#inline "C_WIFSIGNALED" _wait-status)
- (##core#inline "C_WTERMSIG" _wait-status)]
- [else (##core#inline "C_WSTOPSIG" _wait-status)] ) )) ) )
+ (cond (norm (##core#inline "C_WEXITSTATUS" _wait-status))
+ ((##core#inline "C_WIFSIGNALED" _wait-status)
+ (##core#inline "C_WTERMSIG" _wait-status))
+ (else (##core#inline "C_WSTOPSIG" _wait-status)) ) )) ) )
(define parent-process-id (foreign-lambda int "C_getppid"))
-(define process-signal
+(set! chicken.process#process-signal
(lambda (id . sig)
- (let ([sig (if (pair? sig) (car sig) _sigterm)])
+ (let ((sig (if (pair? sig) (car sig) _sigterm)))
(##sys#check-fixnum id 'process-signal)
(##sys#check-fixnum sig 'process-signal)
- (let ([r (##core#inline "C_kill" id sig)])
+ (let ((r (##core#inline "C_kill" id sig)))
(when (fx= r -1) (posix-error #:process-error 'process-signal "could not send signal to process" id sig) ) ) ) ) )
-(define (##sys#shell-command)
+(define (shell-command loc)
(or (get-environment-variable "SHELL") "/bin/sh") )
-(define (##sys#shell-command-arguments cmdlin)
+(define (shell-command-arguments cmdlin)
(list "-c" cmdlin) )
-(define process-run
+(set! chicken.process#process-run
(lambda (f . args)
- (let ([args (if (pair? args) (car args) #f)]
- [pid (process-fork)] )
- (cond [(not (eq? 0 pid)) pid]
- [args (process-execute f args)]
- [else
- (process-execute (##sys#shell-command) (##sys#shell-command-arguments f)) ] ) ) ) )
+ (let ((args (if (pair? args) (car args) #f))
+ (pid (chicken.process#process-fork)) )
+ (cond ((not (eq? 0 pid)) pid)
+ (args (chicken.process#process-execute f args))
+ (else
+ (chicken.process#process-execute
+ (shell-command 'process-run)
+ (shell-command-arguments f)) ) ) ) ) )
;;; Run subprocess connected with pipes:
-;; ##sys#process
+;; process-impl
; loc caller procedure symbol
; cmd pathname or commandline
; args string-list or '()
@@ -1227,26 +1141,26 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;FIXME process-execute, process-fork don't show parent caller
-(define ##sys#process
+(define process-impl
(let ((replace-fd
(lambda (loc fd stdfd)
(unless (fx= stdfd fd)
(chicken.file.posix#duplicate-fileno fd stdfd)
(chicken.file.posix#file-close fd) ) )) )
- (let (
- [make-on-close
- (lambda (loc pid clsvec idx idxa idxb)
- (lambda ()
- (vector-set! clsvec idx #t)
- (when (and (vector-ref clsvec idxa) (vector-ref clsvec idxb))
- (receive [_ flg cod] (##sys#process-wait pid #f)
- (unless flg
- (##sys#signal-hook #:process-error loc
- "abnormal process exit" pid cod)) ) ) ) )]
- [needed-pipe
- (lambda (loc port)
- (and port
- (receive [i o] (create-pipe) (cons i o))) )]
+ (let ((make-on-close
+ (lambda (loc pid clsvec idx idxa idxb)
+ (lambda ()
+ (vector-set! clsvec idx #t)
+ (when (and (vector-ref clsvec idxa) (vector-ref clsvec idxb))
+ (receive (_ flg cod) (process-wait-impl pid #f)
+ (unless flg
+ (##sys#signal-hook #:process-error loc
+ "abnormal process exit" pid cod)) ) ) ) ))
+ (needed-pipe
+ (lambda (loc port)
+ (and port
+ (receive (i o) (chicken.process#create-pipe)
+ (cons i o))) ))
[connect-parent
(lambda (loc pipe port fd)
(and port
@@ -1271,12 +1185,12 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
[epipe (needed-pipe loc stderrf)])
(values
ipipe (swapped-ends opipe) epipe
- (process-fork
+ (chicken.process#process-fork
(lambda ()
(connect-child loc opipe stdinf chicken.file.posix#fileno/stdin)
(connect-child loc (swapped-ends ipipe) stdoutf chicken.file.posix#fileno/stdout)
(connect-child loc (swapped-ends epipe) stderrf chicken.file.posix#fileno/stderr)
- (process-execute cmd args env)))) ) ) ))
+ (chicken.process#process-execute cmd args env)))) ) ) ))
[input-port
(lambda (loc pid cmd pipe stdf stdfd on-close)
(and-let* ([fd (connect-parent loc pipe stdf stdfd)])
@@ -1306,31 +1220,29 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; Run subprocess connected with pipes:
-(define process)
-(define process*)
-
+;; TODO: See if this can be moved to posix-common
(let ((%process
(lambda (loc err? cmd args env k)
- (let ([chkstrlst
- (lambda (lst)
- (##sys#check-list lst loc)
- (for-each (cut ##sys#check-string <> loc) lst) )])
+ (let ((chkstrlst
+ (lambda (lst)
+ (##sys#check-list lst loc)
+ (for-each (cut ##sys#check-string <> loc) lst) )))
(##sys#check-string cmd loc)
(if args
(chkstrlst args)
(begin
- (set! args (##sys#shell-command-arguments cmd))
- (set! cmd (##sys#shell-command)) ) )
+ (set! args (shell-command-arguments cmd))
+ (set! cmd (shell-command loc)) ) )
(when env (check-environment-list env loc))
(##sys#call-with-values
- (lambda () (##sys#process loc cmd args env #t #t err?))
+ (lambda () (process-impl loc cmd args env #t #t err?))
k)))))
- (set! process
+ (set! chicken.process#process
(lambda (cmd #!optional args env exactf)
(%process
'process #f cmd args env
(lambda (i o p e) (values i o p)))))
- (set! process*
+ (set! chicken.process#process*
(lambda (cmd #!optional args env exactf)
(%process
'process* #t cmd args env
@@ -1348,4 +1260,4 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; unimplemented stuff:
-(define-unimplemented process-spawn)
+(set!-unimplemented chicken.process#process-spawn)
diff --git a/posixwin.scm b/posixwin.scm
index 382d8f77..caaa3e06 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -513,10 +513,6 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
;;; Lo-level I/O:
-(define-foreign-variable _pipe_buf int "PIPE_BUF")
-
-(define pipe/buf _pipe_buf)
-
(define-foreign-variable _o_noinherit int "O_NOINHERIT")
(set! chicken.file.posix#open/noinherit _o_noinherit)
@@ -607,109 +603,18 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(posix-error #:file-error 'file-mkstemp "cannot create temporary file" template))
(values fd tmpl)))))))
-;;; Pipes:
-
-(define open-input-pipe)
-(define open-output-pipe)
-(define close-input-pipe)
-(define close-output-pipe)
-
-(let ()
- (define (mode arg) (if (pair? arg) (##sys#slot arg 0) '###text))
- (define (badmode m) (##sys#error "illegal input/output mode specifier" m))
- (define (check cmd inp r)
- (##sys#update-errno)
- (if (##sys#null-pointer? r)
- (##sys#signal-hook #:file-error "cannot open pipe" cmd)
- (let ((port (##sys#make-port (if inp 1 2) ##sys#stream-port-class "(pipe)" 'stream)))
- (##core#inline "C_set_file_ptr" port r)
- port) ) )
- (set! open-input-pipe
- (lambda (cmd . m)
- (##sys#check-string cmd 'open-input-pipe)
- (let ([m (mode m)])
- (check
- cmd #t
- (case m
- ((###text) (##core#inline_allocate ("open_text_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
- ((###binary) (##core#inline_allocate ("open_binary_input_pipe" 2) (##sys#make-c-string cmd 'open-input-pipe)))
- (else (badmode m)) ) ) ) ) )
- (set! open-output-pipe
- (lambda (cmd . m)
- (##sys#check-string cmd 'open-output-pipe)
- (let ((m (mode m)))
- (check
- cmd #f
- (case m
- ((###text) (##core#inline_allocate ("open_text_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
- ((###binary) (##core#inline_allocate ("open_binary_output_pipe" 2) (##sys#make-c-string cmd 'open-output-pipe)))
- (else (badmode m)) ) ) ) ) )
- (set! close-input-pipe
- (lambda (port)
- (##sys#check-input-port port #t 'close-input-pipe)
- (let ((r (##core#inline "close_pipe" port)))
- (##sys#update-errno)
- (when (eq? -1 r)
- (##sys#signal-hook #:file-error 'close-input-pipe "error while closing pipe" port) )
- r)))
- (set! close-output-pipe
- (lambda (port)
- (##sys#check-output-port port #t 'close-output-pipe)
- (let ((r (##core#inline "close_pipe" port)))
- (##sys#update-errno)
- (when (eq? -1 r)
- (##sys#signal-hook #:file-error 'close-output-pipe "error while closing pipe" port) )
- r))))
-
-(define call-with-input-pipe
- (lambda (cmd proc . mode)
- (let ([p (apply open-input-pipe cmd mode)])
- (##sys#call-with-values
- (lambda () (proc p))
- (lambda results
- (close-input-pipe p)
- (apply values results) ) ) ) ) )
-
-(define call-with-output-pipe
- (lambda (cmd proc . mode)
- (let ([p (apply open-output-pipe cmd mode)])
- (##sys#call-with-values
- (lambda () (proc p))
- (lambda results
- (close-output-pipe p)
- (apply values results) ) ) ) ) )
-
-(define with-input-from-pipe
- (lambda (cmd thunk . mode)
- (let ([p (apply open-input-pipe cmd mode)])
- (fluid-let ((##sys#standard-input p))
- (##sys#call-with-values
- thunk
- (lambda results
- (close-input-pipe p)
- (apply values results) ) ) ) ) ) )
-
-(define with-output-to-pipe
- (lambda (cmd thunk . mode)
- (let ([p (apply open-output-pipe cmd mode)])
- (fluid-let ((##sys#standard-output p))
- (##sys#call-with-values
- thunk
- (lambda results
- (close-output-pipe p)
- (apply values results) ) ) ) ) ) )
-
-
;;; Pipe primitive:
(define-foreign-variable _pipefd0 int "C_pipefds[ 0 ]")
(define-foreign-variable _pipefd1 int "C_pipefds[ 1 ]")
-(define (create-pipe #!optional (mode (fxior chicken.file.posix#open/binary chicken.file.posix#open/noinherit)))
- (when (fx< (##core#inline "C_pipe" #f mode) 0)
- (##sys#update-errno)
- (##sys#signal-hook #:file-error 'create-pipe "cannot create pipe") )
- (values _pipefd0 _pipefd1) )
+(set! chicken.process#create-pipe
+ (lambda (#!optional (mode (fxior chicken.file.posix#open/binary
+ chicken.file.posix#open/noinherit)))
+ (when (fx< (##core#inline "C_pipe" #f mode) 0)
+ (##sys#update-errno)
+ (##sys#signal-hook #:file-error 'create-pipe "cannot create pipe") )
+ (values _pipefd0 _pipefd1) ) )
;;; Signal processing:
@@ -788,11 +693,11 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(define-foreign-variable _p_nowaito int "P_NOWAITO")
(define-foreign-variable _p_detach int "P_DETACH")
-(define spawn/overlay _p_overlay)
-(define spawn/wait _p_wait)
-(define spawn/nowait _p_nowait)
-(define spawn/nowaito _p_nowaito)
-(define spawn/detach _p_detach)
+(set! chicken.process#spawn/overlay _p_overlay)
+(set! chicken.process#spawn/wait _p_wait)
+(set! chicken.process#spawn/nowait _p_nowait)
+(set! chicken.process#spawn/nowaito _p_nowaito)
+(set! chicken.process#spawn/detach _p_detach)
; Windows uses a commandline style for process arguments. Thus any
; arguments with embedded whitespace will parse incorrectly. Must
@@ -811,51 +716,57 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(lambda (str)
(if (needs-quoting? str) (string-append "\"" str "\"") str))))
-(define (process-execute filename #!optional (arglist '()) envlist exactf)
- (let ((argconv (if exactf (lambda (x) x) quote-arg-string)))
- (call-with-exec-args
- 'process-execute filename argconv arglist envlist
- (lambda (prg argbuf envbuf)
- (##core#inline "C_flushall")
- (let ((r (if envbuf
- (##core#inline "C_u_i_execve" prg argbuf envbuf)
- (##core#inline "C_u_i_execvp" prg argbuf))))
- (when (fx= r -1)
- (posix-error #:process-error 'process-execute "cannot execute process" filename)))))))
-
-(define (process-spawn mode filename #!optional (arglist '()) envlist exactf)
- (let ((argconv (if exactf (lambda (x) x) quote-arg-string)))
- (##sys#check-fixnum mode 'process-spawn)
- (call-with-exec-args
- 'process-spawn filename argconv arglist envlist
- (lambda (prg argbuf envbuf)
- (##core#inline "C_flushall")
- (let ((r (if envbuf
- (##core#inline "C_u_i_spawnvpe" mode prg argbuf envbuf)
- (##core#inline "C_u_i_spawnvp" mode prg argbuf))))
- (when (fx= r -1)
- (posix-error #:process-error 'process-spawn "cannot spawn process" filename))
- r)))))
+(set! chicken.process#process-execute
+ (lambda (filename #!optional (arglist '()) envlist exactf)
+ (let ((argconv (if exactf (lambda (x) x) quote-arg-string)))
+ (call-with-exec-args
+ 'process-execute filename argconv arglist envlist
+ (lambda (prg argbuf envbuf)
+ (##core#inline "C_flushall")
+ (let ((r (if envbuf
+ (##core#inline "C_u_i_execve" prg argbuf envbuf)
+ (##core#inline "C_u_i_execvp" prg argbuf))))
+ (when (fx= r -1)
+ (posix-error #:process-error 'process-execute "cannot execute process" filename))))))))
+
+(set! chicken.process#process-spawn
+ (lambda (mode filename #!optional (arglist '()) envlist exactf)
+ (let ((argconv (if exactf (lambda (x) x) quote-arg-string)))
+ (##sys#check-fixnum mode 'process-spawn)
+ (call-with-exec-args
+ 'process-spawn filename argconv arglist envlist
+ (lambda (prg argbuf envbuf)
+ (##core#inline "C_flushall")
+ (let ((r (if envbuf
+ (##core#inline "C_u_i_spawnvpe" mode prg argbuf envbuf)
+ (##core#inline "C_u_i_spawnvp" mode prg argbuf))))
+ (when (fx= r -1)
+ (posix-error #:process-error 'process-spawn "cannot spawn process" filename))
+ r))))))
(define-foreign-variable _shlcmd c-string "C_shlcmd")
-(define (##sys#shell-command)
+(define (shell-command loc)
(or (get-environment-variable "COMSPEC")
(if (##core#inline "C_get_shlcmd")
_shlcmd
(begin
(##sys#update-errno)
- (##sys#error '##sys#shell-command "cannot retrieve system directory") ) ) ) )
+ (##sys#error loc "cannot retrieve system directory") ) ) ) )
-(define (##sys#shell-command-arguments cmdlin)
+(define (shell-command-arguments cmdlin)
(list "/c" cmdlin) )
-(define process-run
+(set! chicken.process#process-run
(lambda (f . args)
- (let ([args (if (pair? args) (car args) #f)])
+ (let ((args (if (pair? args) (car args) #f)))
(if args
- (process-spawn spawn/nowait f args)
- (process-spawn spawn/nowait (##sys#shell-command) (##sys#shell-command-arguments f)) ) ) ) )
+ (chicken.process#process-spawn
+ chicken.process#spawn/nowait f args)
+ (chicken.process#process-spawn
+ chicken.process#spawn/nowait
+ (shell-command 'process-run)
+ (shell-command-arguments f)) ) ) ) )
;;; Run subprocess connected with pipes:
(define-foreign-variable _rdbuf char "C_rdbuf")
@@ -863,7 +774,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(define-foreign-variable _rd1 int "C_rd1_")
; from original by Mejedi
-;; ##sys#process
+;; process-impl
; loc caller procedure symbol
; cmd pathname or commandline
; args string-list or '()
@@ -875,7 +786,7 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
; (values stdin-input-port? stdout-output-port? pid stderr-input-port?)
; where stdin-input-port?, etc. is a port or #f, indicating no port created.
-(define ##sys#process
+(define process-impl
;; XXX TODO: When environment is implemented, check for embedded NUL bytes!
(let ([c-process
(foreign-lambda bool "C_process" c-string c-string c-pointer
@@ -909,37 +820,36 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(##sys#update-errno)
(##sys#signal-hook #:process-error loc "cannot execute process" cmdlin))) ) ) ) ) ) )
-(define process)
-(define process*)
-
-(let ([%process
+;; TODO: See if this can be moved to posix-common
+(let ((%process
(lambda (loc err? cmd args env exactf)
- (let ([chkstrlst
+ (let ((chkstrlst
(lambda (lst)
(##sys#check-list lst loc)
- (for-each (cut ##sys#check-string <> loc) lst) )])
+ (for-each (cut ##sys#check-string <> loc) lst) )))
(##sys#check-string cmd loc)
(if args
(chkstrlst args)
(begin
(set! exactf #t)
- (set! args (##sys#shell-command-arguments cmd))
- (set! cmd (##sys#shell-command)) ) )
+ (set! args (shell-command-arguments cmd))
+ (set! cmd (shell-command loc)) ) )
(when env (check-environment-list env loc))
- (receive [in out pid err] (##sys#process loc cmd args env #t #t err? exactf)
+ (receive (in out pid err)
+ (process-impl loc cmd args env #t #t err? exactf)
(if err?
(values in out pid err)
- (values in out pid) ) ) ) )] )
- (set! process
+ (values in out pid) ) ) ) )) )
+ (set! chicken.process#process
(lambda (cmd #!optional args env exactf)
(%process 'process #f cmd args env exactf) ))
- (set! process*
+ (set! chicken.process#process*
(lambda (cmd #!optional args env exactf)
(%process 'process* #t cmd args env exactf) )) )
(define-foreign-variable _exstatus int "C_exstatus")
-(define (##sys#process-wait pid nohang)
+(define (process-wait-impl pid nohang)
(if (##core#inline "C_process_wait" pid nohang)
(values pid #t _exstatus)
(values -1 #f #f) ) )
@@ -977,9 +887,9 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime)
(set!-unimplemented chicken.file.posix#file-truncate)
(set!-unimplemented chicken.file.posix#file-unlock)
(define-unimplemented parent-process-id)
-(define-unimplemented process-fork)
+(set!-unimplemented chicken.process#process-fork)
(define-unimplemented process-group-id)
-(define-unimplemented process-signal)
+(set!-unimplemented chicken.process#process-signal)
(set!-unimplemented chicken.file.posix#read-symbolic-link)
(define-unimplemented set-alarm!)
(define-unimplemented set-group-id!)
diff --git a/types.db b/types.db
index 79044d7a..ff18fa4f 100644
--- a/types.db
+++ b/types.db
@@ -2035,12 +2035,7 @@
;; posix
-(chicken.posix#call-with-input-pipe (#(procedure #:enforce) chicken.posix#call-with-input-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
-(chicken.posix#call-with-output-pipe (#(procedure #:enforce) chicken.posix#call-with-output-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
(chicken.posix#change-directory* (#(procedure #:clean #:enforce) chicken.posix#change-directory* (fixnum) fixnum))
-(chicken.posix#close-input-pipe (#(procedure #:clean #:enforce) chicken.posix#close-input-pipe (input-port) fixnum))
-(chicken.posix#close-output-pipe (#(procedure #:clean #:enforce) chicken.posix#close-output-pipe (output-port) fixnum))
-(chicken.posix#create-pipe (procedure chicken.posix#create-pipe (#!optional fixnum) fixnum fixnum))
(chicken.posix#create-session (#(procedure #:clean) chicken.posix#create-session () fixnum))
(chicken.posix#current-effective-group-id (#(procedure #:clean) chicken.posix#current-effective-group-id () fixnum))
@@ -2050,24 +2045,9 @@
(chicken.posix#current-process-id (#(procedure #:clean) chicken.posix#current-process-id () fixnum))
(chicken.posix#current-user-id (#(procedure #:clean) chicken.posix#current-user-id () fixnum))
(chicken.posix#current-user-name (#(procedure #:clean) chicken.posix#current-user-name () string))
-(chicken.posix#open-input-pipe (#(procedure #:clean #:enforce) chicken.posix#open-input-pipe (string #!optional symbol) input-port))
-(chicken.posix#open-output-pipe (#(procedure #:clean #:enforce) chicken.posix#open-output-pipe (string #!optional symbol) output-port))
(chicken.posix#parent-process-id (#(procedure #:clean) chicken.posix#parent-process-id () fixnum))
-(chicken.posix#pipe/buf fixnum)
-(chicken.posix#process (#(procedure #:clean #:enforce) chicken.posix#process (string #!optional (list-of string) (list-of (pair string string)) boolean) input-port output-port fixnum))
-(chicken.posix#process* (#(procedure #:clean #:enforce) chicken.posix#process* (string #!optional (list-of string) (list-of (pair string string)) boolean) input-port output-port fixnum *))
-
-(chicken.posix#process-execute
- (#(procedure #:clean #:enforce) chicken.posix#process-execute (string #!optional (list-of string) (list-of (pair string string)) fixnum) noreturn))
-
-(chicken.posix#process-fork (#(procedure #:enforce) chicken.posix#process-fork (#!optional (or (procedure () . *) false) *) fixnum))
(chicken.posix#process-group-id (#(procedure #:clean #:enforce) chicken.posix#process-group-id () fixnum))
-(chicken.posix#process-run (#(procedure #:clean #:enforce) chicken.posix#process-run (string #!optional (list-of string)) fixnum))
-(chicken.posix#process-signal (#(procedure #:clean #:enforce) chicken.posix#process-signal (fixnum #!optional fixnum) undefined))
-(chicken.posix#process-spawn
- (#(procedure #:clean #:enforce) chicken.posix#process-spawn (fixnum string #!optional (list-of string) (list-of (pair string string)) boolean) fixnum))
-(chicken.posix#process-wait (#(procedure #:clean #:enforce) chicken.posix#process-wait (#!optional fixnum *) fixnum fixnum fixnum))
(chicken.posix#set-alarm! (#(procedure #:clean #:enforce) chicken.posix#set-alarm! (integer) integer))
(chicken.posix#set-root-directory! (#(procedure #:clean #:enforce) chicken.posix#set-root-directory! (string) undefined))
(chicken.posix#set-signal-handler! (#(procedure #:clean #:enforce) chicken.posix#set-signal-handler! (fixnum (or false (procedure (fixnum) . *))) undefined))
@@ -2104,21 +2084,40 @@
(chicken.posix#signal/xcpu fixnum)
(chicken.posix#signal/xfsz fixnum)
(chicken.posix#signals-list list)
-(chicken.posix#spawn/overlay fixnum)
-(chicken.posix#spawn/wait fixnum)
-(chicken.posix#spawn/nowait fixnum)
-(chicken.posix#spawn/nowaito fixnum)
-(chicken.posix#spawn/detach fixnum)
-(chicken.posix#process-sleep (#(procedure #:clean #:enforce) chicken.posix#process-sleep (fixnum) fixnum))
(chicken.posix#user-information (#(procedure #:clean #:enforce) chicken.posix#user-information ((or string fixnum) #!optional *) *))
-(chicken.posix#with-input-from-pipe (#(procedure #:enforce) chicken.posix#with-input-from-pipe (string (procedure () . *) #!optional symbol) . *))
-(chicken.posix#with-output-to-pipe (#(procedure #:enforce) chicken.posix#with-output-to-pipe (string (procedure () . *) #!optional symbol) . *))
;; process
+(chicken.process#process-execute
+ (#(procedure #:clean #:enforce) chicken.process#process-execute (string #!optional (list-of string) (list-of (pair string string)) fixnum) noreturn))
+(chicken.process#process-fork (#(procedure #:enforce) chicken.process#process-fork (#!optional (or (procedure () . *) false) *) fixnum))
+(chicken.process#qs (#(procedure #:clean #:enforce) chicken.process#qs (string) string))
+(chicken.process#process-run (#(procedure #:clean #:enforce) chicken.process#process-run (string #!optional (list-of string)) fixnum))
+(chicken.process#process-signal (#(procedure #:clean #:enforce) chicken.process#process-signal (fixnum #!optional fixnum) undefined))
+(chicken.process#process-spawn
+ (#(procedure #:clean #:enforce) chicken.process#process-spawn (fixnum string #!optional (list-of string) (list-of (pair string string)) boolean) fixnum))
(chicken.process#system (#(procedure #:clean #:enforce) chicken.process#system (string) fixnum))
(chicken.process#system* (#(procedure #:clean #:enforce) chicken.process#system* (string #!rest) undefined))
-(chicken.process#qs (#(procedure #:clean #:enforce) chicken.process#qs (string) string))
+(chicken.process#process (#(procedure #:clean #:enforce) chicken.process#process (string #!optional (list-of string) (list-of (pair string string)) boolean) input-port output-port fixnum))
+(chicken.process#process* (#(procedure #:clean #:enforce) chicken.process#process* (string #!optional (list-of string) (list-of (pair string string)) boolean) input-port output-port fixnum *))
+(chicken.process#process-wait (#(procedure #:clean #:enforce) chicken.process#process-wait (#!optional fixnum *) fixnum fixnum fixnum))
+(chicken.process#process-sleep (#(procedure #:clean #:enforce) chicken.process#process-sleep (fixnum) fixnum))
+(chicken.process#call-with-input-pipe (#(procedure #:enforce) chicken.process#call-with-input-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
+(chicken.process#call-with-output-pipe (#(procedure #:enforce) chicken.process#call-with-output-pipe (string (procedure (input-port) . *) #!optional symbol) . *))
+(chicken.process#close-input-pipe (#(procedure #:clean #:enforce) chicken.process#close-input-pipe (input-port) fixnum))
+(chicken.process#close-output-pipe (#(procedure #:clean #:enforce) chicken.process#close-output-pipe (output-port) fixnum))
+(chicken.process#create-pipe (procedure chicken.process#create-pipe (#!optional fixnum) fixnum fixnum))
+(chicken.process#open-input-pipe (#(procedure #:clean #:enforce) chicken.process#open-input-pipe (string #!optional symbol) input-port))
+(chicken.process#open-output-pipe (#(procedure #:clean #:enforce) chicken.process#open-output-pipe (string #!optional symbol) output-port))
+(chicken.process#with-input-from-pipe (#(procedure #:enforce) chicken.process#with-input-from-pipe (string (procedure () . *) #!optional symbol) . *))
+(chicken.process#with-output-to-pipe (#(procedure #:enforce) chicken.process#with-output-to-pipe (string (procedure () . *) #!optional symbol) . *))
+
+(chicken.process#pipe/buf fixnum)
+(chicken.process#spawn/overlay fixnum)
+(chicken.process#spawn/wait fixnum)
+(chicken.process#spawn/nowait fixnum)
+(chicken.process#spawn/nowaito fixnum)
+(chicken.process#spawn/detach fixnum)
;; sort
Trap