(defstruct (fd-stream
(:constructor %make-fd-stream)
- (:include lisp-stream
+ (:include ansi-stream
(misc #'fd-stream-misc-routine))
(:copier nil))
(setf (fd-stream-handler stream)
(sb!sys:add-fd-handler (fd-stream-fd stream)
:output
- #'(lambda (fd)
- (declare (ignore fd))
- (do-output-later stream)))))
+ (lambda (fd)
+ (declare (ignore fd))
+ (do-output-later stream)))))
(t
(nconc (fd-stream-output-later stream)
(list (list base start end reuse-sap)))))
(declare (optimize (speed 1)))
(cons 'progn
(mapcar
- #'(lambda (buffering)
- (let ((function
- (intern (let ((*print-case* :upcase))
- (format nil name-fmt (car buffering))))))
- `(progn
- (defun ,function (stream byte)
- ,(unless (eq (car buffering) :none)
- `(when (< (fd-stream-obuf-length stream)
- (+ (fd-stream-obuf-tail stream)
- ,size))
- (flush-output-buffer stream)))
- ,@body
- (incf (fd-stream-obuf-tail stream) ,size)
- ,(ecase (car buffering)
- (:none
- `(flush-output-buffer stream))
- (:line
- `(when (eq (char-code byte) (char-code #\Newline))
- (flush-output-buffer stream)))
- (:full
- ))
- (values))
- (setf *output-routines*
- (nconc *output-routines*
- ',(mapcar
- #'(lambda (type)
- (list type
- (car buffering)
- function
- size))
- (cdr buffering)))))))
- bufferings)))
+ (lambda (buffering)
+ (let ((function
+ (intern (let ((*print-case* :upcase))
+ (format nil name-fmt (car buffering))))))
+ `(progn
+ (defun ,function (stream byte)
+ ,(unless (eq (car buffering) :none)
+ `(when (< (fd-stream-obuf-length stream)
+ (+ (fd-stream-obuf-tail stream)
+ ,size))
+ (flush-output-buffer stream)))
+ ,@body
+ (incf (fd-stream-obuf-tail stream) ,size)
+ ,(ecase (car buffering)
+ (:none
+ `(flush-output-buffer stream))
+ (:line
+ `(when (eq (char-code byte) (char-code #\Newline))
+ (flush-output-buffer stream)))
+ (:full
+ ))
+ (values))
+ (setf *output-routines*
+ (nconc *output-routines*
+ ',(mapcar
+ (lambda (type)
+ (list type
+ (car buffering)
+ function
+ size))
+ (cdr buffering)))))))
+ bufferings)))
(def-output-routines ("OUTPUT-CHAR-~A-BUFFERED"
1
((<= bytes space)
(if (system-area-pointer-p thing)
(system-area-copy thing
- (* start sb!vm:byte-bits)
+ (* start sb!vm:n-byte-bits)
(fd-stream-obuf-sap fd-stream)
- (* tail sb!vm:byte-bits)
- (* bytes sb!vm:byte-bits))
+ (* tail sb!vm:n-byte-bits)
+ (* bytes sb!vm:n-byte-bits))
;; FIXME: There should be some type checking somewhere to
;; verify that THING here is a vector, not just <not a SAP>.
(copy-to-system-area thing
- (+ (* start sb!vm:byte-bits)
+ (+ (* start sb!vm:n-byte-bits)
(* sb!vm:vector-data-offset
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
(fd-stream-obuf-sap fd-stream)
- (* tail sb!vm:byte-bits)
- (* bytes sb!vm:byte-bits)))
+ (* tail sb!vm:n-byte-bits)
+ (* bytes sb!vm:n-byte-bits)))
(setf (fd-stream-obuf-tail fd-stream) newtail))
((<= bytes len)
(flush-output-buffer fd-stream)
(if (system-area-pointer-p thing)
(system-area-copy thing
- (* start sb!vm:byte-bits)
+ (* start sb!vm:n-byte-bits)
(fd-stream-obuf-sap fd-stream)
0
- (* bytes sb!vm:byte-bits))
+ (* bytes sb!vm:n-byte-bits))
;; FIXME: There should be some type checking somewhere to
;; verify that THING here is a vector, not just <not a SAP>.
(copy-to-system-area thing
- (+ (* start sb!vm:byte-bits)
+ (+ (* start sb!vm:n-byte-bits)
(* sb!vm:vector-data-offset
- sb!vm:word-bits))
+ sb!vm:n-word-bits))
(fd-stream-obuf-sap fd-stream)
0
- (* bytes sb!vm:byte-bits)))
+ (* bytes sb!vm:n-byte-bits)))
(setf (fd-stream-obuf-tail fd-stream) bytes))
(t
(flush-output-buffer fd-stream)
(setf (fd-stream-ibuf-tail stream) 0))
(t
(decf tail head)
- (system-area-copy ibuf-sap (* head sb!vm:byte-bits)
- ibuf-sap 0 (* tail sb!vm:byte-bits))
+ (system-area-copy ibuf-sap (* head sb!vm:n-byte-bits)
+ ibuf-sap 0 (* tail sb!vm:n-byte-bits))
(setf head 0)
(setf (fd-stream-ibuf-head stream) 0)
(setf (fd-stream-ibuf-tail stream) tail))))
(simple-stream-perror "couldn't read from ~S" stream errno)))
((zerop count)
(setf (fd-stream-listen stream) :eof)
+ (/show0 "THROWing EOF-INPUT-CATCHER")
(throw 'eof-input-catcher nil))
(t
(incf (fd-stream-ibuf-tail stream) count))))))
(declare (type index start end))
(let* ((length (- end start))
(string (make-string length)))
- (copy-from-system-area sap (* start sb!vm:byte-bits)
- string (* sb!vm:vector-data-offset sb!vm:word-bits)
- (* length sb!vm:byte-bits))
+ (copy-from-system-area sap (* start sb!vm:n-byte-bits)
+ string (* sb!vm:vector-data-offset
+ sb!vm:n-word-bits)
+ (* length sb!vm:n-byte-bits))
string))
;;; the N-BIN method for FD-STREAMs
(when (eql size 1)
(setf (fd-stream-n-bin fd-stream) #'fd-stream-read-n-bytes)
(when buffer-p
- (setf (lisp-stream-in-buffer fd-stream)
- (make-array +in-buffer-length+
+ (setf (ansi-stream-in-buffer fd-stream)
+ (make-array +ansi-stream-in-buffer-length+
:element-type '(unsigned-byte 8)))))
(setf input-size size)
(setf input-type type)))
input-buffer-p
(name (if file
(format nil "file ~S" file)
- (format nil "descriptor ~D" fd)))
+ (format nil "descriptor ~W" fd)))
auto-close)
(declare (type index fd) (type (or index null) timeout)
(type (member :none :line :full) buffering))
(lambda ()
(sb!unix:unix-close fd)
#!+sb-show
- (format *terminal-io* "** closed file descriptor ~D **~%"
+ (format *terminal-io* "** closed file descriptor ~W **~%"
fd))))
stream))
projects / sbcl.git / blobdiff