(copy-descriptor-to-stream new-fd pty cookie external-format)))
(values name
(sb-sys:make-fd-stream master :input t :output t
+ :external-format external-format
:element-type :default
:dual-channel-p t)))))
-(defmacro round-bytes-to-words (n)
+;; Null terminate strings only C-side: otherwise we can run into
+;; A-T-S-L even for simple encodings like ASCII. Multibyte encodings
+;; may need more than a single byte of zeros; assume 4 byte is enough
+;; for everyone.
+(defmacro round-null-terminated-bytes-to-words (n)
(let ((bytes-per-word (/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits)))
- `(logandc2 (the fixnum (+ (the fixnum ,n)
- (1- ,bytes-per-word))) (1- ,bytes-per-word))))
+ `(logandc2 (the sb-vm:signed-word (+ (the fixnum ,n)
+ 4 (1- ,bytes-per-word)))
+ (1- ,bytes-per-word))))
(defun string-list-to-c-strvec (string-list)
(let* ((bytes-per-word (/ sb-vm:n-machine-word-bits sb-vm:n-byte-bits))
;; clobbers argv[-1].
(vec-bytes (* bytes-per-word (+ (length string-list) 2)))
(octet-vector-list (mapcar (lambda (s)
- (string-to-octets s :null-terminate t))
+ (string-to-octets s))
string-list))
(string-bytes (reduce #'+ octet-vector-list
:key (lambda (s)
- (round-bytes-to-words (length s)))))
+ (round-null-terminated-bytes-to-words
+ (length s)))))
(total-bytes (+ string-bytes vec-bytes))
;; Memory to hold the vector of pointers and all the strings.
(vec-sap (sb-sys:allocate-system-memory total-bytes))
(string-sap (sap+ vec-sap vec-bytes))
;; Index starts from [1]!
(vec-index-offset bytes-per-word))
- (declare (index string-bytes vec-bytes total-bytes)
+ (declare (sb-vm:signed-word vec-bytes)
+ (sb-vm:word string-bytes total-bytes)
(sb-sys:system-area-pointer vec-sap string-sap))
(dolist (octets octet-vector-list)
(declare (type (simple-array (unsigned-byte 8) (*)) octets))
(let ((size (length octets)))
;; Copy string.
(sb-kernel:copy-ub8-to-system-area octets 0 string-sap 0 size)
+ ;; NULL-terminate it
+ (sb-kernel:system-area-ub8-fill 0 string-sap size 4)
;; Put the pointer in the vector.
(setf (sap-ref-sap vec-sap vec-index-offset) string-sap)
;; Advance string-sap for the next string.
- (setf string-sap (sap+ string-sap (round-bytes-to-words size)))
+ (setf string-sap (sap+ string-sap
+ (round-null-terminated-bytes-to-words size)))
(incf vec-index-offset bytes-per-word)))
;; Final null pointer.
(setf (sap-ref-sap vec-sap vec-index-offset) (int-sap 0))
;; hard-coded symbols here.
(values stdout output-stream)
(get-descriptor-for ,@args))))
+ (unless ,fd
+ (return-from run-program))
,@body))
(with-open-pty (((pty-name pty-stream) (pty cookie))
&body body)
#+win32 `(declare (ignore ,pty ,cookie))
#+win32 `(let (,pty-name ,pty-stream) ,@body)
#-win32 `(multiple-value-bind (,pty-name ,pty-stream)
- (open-pty ,pty ,cookie)
+ (open-pty ,pty ,cookie :external-format external-format)
,@body))
(with-args-vec ((vec args) &body body)
`(with-c-strvec (,vec ,args)
(if search 1 0)
environment-vec pty-name
(if wait 1 0))))
- (unless (= child -1)
+ (unless (minusp child)
(setf proc
(apply
#'make-process
(list :%status :running))))
(push proc *active-processes*)))))
;; Report the error outside the lock.
- (when (= child -1)
- (error "couldn't fork child process: ~A"
- (strerror)))))))))
+ #+win32
+ (when (minusp child)
+ (error "Couldn't execute ~S: ~A" progname (strerror)))
+ #-win32
+ (case child
+ (-2
+ (error "Couldn't execute ~S: ~A" progname (strerror)))
+ (-1
+ (error "Couldn't fork child process: ~A" (strerror))))))))))
(dolist (fd *close-in-parent*)
(sb-unix:unix-close fd))
(unless proc
(dolist (fd *close-on-error*)
(sb-unix:unix-close fd))
- ;; FIXME: nothing seems to set this.
#-win32
(dolist (handler *handlers-installed*)
- (sb-sys:remove-fd-handler handler))))
- #-win32
- (when (and wait proc)
- (process-wait proc))
+ (sb-sys:remove-fd-handler handler)))
+ #-win32
+ (when (and wait proc)
+ (unwind-protect
+ (process-wait proc)
+ (dolist (handler *handlers-installed*)
+ (sb-sys:remove-fd-handler handler)))))
proc)))
;;; Install a handler for any input that shows up on the file
(strerror errno)))
(t
(incf read-end count)
- (funcall copy-fun))))))))))
+ (funcall copy-fun))))))))
+ #-win32
+ (push handler *handlers-installed*)))
;;; FIXME: something very like this is done in SB-POSIX to treat
;;; streams as file descriptor designators; maybe we can combine these
;; validation there.
(with-open-stream (file (apply #'open object :allow-other-keys t
keys))
- (multiple-value-bind
- (fd errno)
- (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
- (cond (fd
- (push fd *close-in-parent*)
- (values fd nil))
- (t
- (error "couldn't duplicate file descriptor: ~A"
- (strerror errno)))))))
+ (when file
+ (multiple-value-bind
+ (fd errno)
+ (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
+ (cond (fd
+ (push fd *close-in-parent*)
+ (values fd nil))
+ (t
+ (error "couldn't duplicate file descriptor: ~A"
+ (strerror errno))))))))
((streamp object)
(ecase direction
(:input
projects / sbcl.git / blobdiff