(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
+ (setf (sap-ref-32 string-sap size) 0)
;; 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))
#+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)
(cond ((eq object t)
;; No new descriptor is needed.
(values -1 nil))
- ((eq object nil)
+ ((or (eq object nil)
+ (and (typep object 'broadcast-stream)
+ (not (broadcast-stream-streams object))))
;; Use /dev/null.
(multiple-value-bind
(fd errno)
(loop with buf = (make-array 256 :element-type '(unsigned-byte 8))
for p = (read-sequence buf object)
until (zerop p)
- do (sb-unix:unix-write fd buf 0 p))))
+ do (sb-unix:unix-write fd buf 0 p)))
+ (t
+ (error "Don't know how to copy from stream of element-type ~S"
+ et)))
(sb-unix:unix-lseek fd 0 sb-unix:l_set)
(push fd *close-in-parent*)
(return (values fd nil)))))