Added process-nonblocking which is like process but returns
nonblocking ports.
This commit is contained in:
parent
f69e82e6c5
commit
1389f239fe
|
@ -63,7 +63,7 @@
|
|||
reset-output-port!
|
||||
port-id
|
||||
input-port-byte-position
|
||||
process
|
||||
process process-nonblocking
|
||||
|
||||
tcp-connect tcp-connect-nonblocking
|
||||
udp-connect udp-connect-nonblocking
|
||||
|
@ -125,7 +125,7 @@
|
|||
reset-output-port!
|
||||
port-id
|
||||
input-port-byte-position
|
||||
process
|
||||
process process-nonblocking
|
||||
tcp-connect tcp-connect-nonblocking
|
||||
udp-connect udp-connect-nonblocking
|
||||
tcp-server-socket tcp-server-socket-nonblocking
|
||||
|
@ -2127,6 +2127,36 @@
|
|||
cmd input-file-buffer-size #f #t
|
||||
'process)))))
|
||||
|
||||
|
||||
(define (process-nonblocking cmd . args)
|
||||
(define who 'process-nonblocking)
|
||||
(unless (string? cmd)
|
||||
(die who "command is not a string" cmd))
|
||||
(unless (andmap string? args)
|
||||
(die who "all arguments must be strings"))
|
||||
(let ([r (foreign-call "ikrt_process"
|
||||
(make-vector 4)
|
||||
(string->utf8 cmd)
|
||||
(map string->utf8 (cons cmd args)))])
|
||||
(if (fixnum? r)
|
||||
(io-error who cmd r)
|
||||
(begin
|
||||
(set-fd-nonblocking (vector-ref r 1) who cmd)
|
||||
(set-fd-nonblocking (vector-ref r 2) who cmd)
|
||||
(set-fd-nonblocking (vector-ref r 3) who cmd)
|
||||
(values
|
||||
(vector-ref r 0) ; pid
|
||||
(fh->output-port (vector-ref r 1)
|
||||
cmd output-file-buffer-size #f #t
|
||||
'process)
|
||||
(fh->input-port (vector-ref r 2)
|
||||
cmd input-file-buffer-size #f #t
|
||||
'process)
|
||||
(fh->input-port (vector-ref r 3)
|
||||
cmd input-file-buffer-size #f #t
|
||||
'process))))))
|
||||
|
||||
|
||||
(define (set-fd-nonblocking fd who id)
|
||||
(let ([rv (foreign-call "ikrt_make_fd_nonblocking" fd)])
|
||||
(unless (eq? rv 0)
|
||||
|
|
|
@ -1 +1 @@
|
|||
1456
|
||||
1457
|
||||
|
|
|
@ -403,6 +403,7 @@
|
|||
[pointer-value i]
|
||||
[system i]
|
||||
[process i]
|
||||
[process-nonblocking i]
|
||||
[waitpid i]
|
||||
[installed-libraries i]
|
||||
[library-path i]
|
||||
|
|
Loading…
Reference in New Issue