;;; descriptor. Attempt to write the data again. If it worked, remove
;;; the data from the OUTPUT-LATER list. If it didn't work, something
;;; is wrong.
-(defun do-output-later (stream)
+(defun frob-output-later (stream)
(let* ((stuff (pop (fd-stream-output-later stream)))
(base (car stuff))
(start (cadr stuff))
(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))
+ (frob-output-later stream)))))
(t
(nconc (fd-stream-output-later stream)
(list (list base start end reuse-sap)))))
;;; Output the given noise. Check to see whether there are any pending
;;; writes. If so, just queue this one. Otherwise, try to write it. If
;;; this would block, queue it.
-(defun do-output (stream base start end reuse-sap)
+(defun frob-output (stream base start end reuse-sap)
(declare (type fd-stream stream)
(type (or system-area-pointer (simple-array * (*))) base)
(type index start end))
(defun flush-output-buffer (stream)
(let ((length (fd-stream-obuf-tail stream)))
(unless (= length 0)
- (do-output stream (fd-stream-obuf-sap stream) 0 length t)
+ (frob-output stream (fd-stream-obuf-sap stream) 0 length t)
(setf (fd-stream-obuf-tail stream) 0))))
;;; Define output routines that output numbers SIZE bytes long for the
(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
(setf (fd-stream-obuf-tail fd-stream) bytes))
(t
(flush-output-buffer fd-stream)
- (do-output fd-stream thing start end nil))))))
+ (frob-output fd-stream thing start end nil))))))
;;; the routine to use to output a string. If the stream is
;;; unbuffered, slam the string down the file descriptor, otherwise
(when last-newline
(flush-output-buffer stream)))
(:none
- (do-output stream thing start end nil)))
+ (frob-output stream thing start end nil)))
(if last-newline
(setf (fd-stream-char-pos stream)
(- end last-newline 1))
((:line :full)
(output-raw-bytes stream thing start end))
(:none
- (do-output stream thing start end nil))))))
+ (frob-output stream thing start end nil))))))
;;; Find an output routine to use given the type and buffering. Return
;;; as multiple values the routine, the real type transfered, and the
;;; Fill the input buffer, and return the first character. Throw to
;;; EOF-INPUT-CATCHER if the eof was reached. Drop into SYSTEM:SERVER
;;; if necessary.
-(defun do-input (stream)
+(defun frob-input (stream)
(let ((fd (fd-stream-fd stream))
(ibuf-sap (fd-stream-ibuf-sap stream))
(buflen (fd-stream-ibuf-length stream))
#!+mp (sb!mp:process-wait-until-fd-usable
fd :input (fd-stream-timeout stream))
(error 'io-timeout :stream stream :direction :read))
- (do-input stream))
+ (frob-input stream))
(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))))))
;;; Make sure there are at least BYTES number of bytes in the input
-;;; buffer. Keep calling DO-INPUT until that condition is met.
+;;; buffer. Keep calling FROB-INPUT until that condition is met.
(defmacro input-at-least (stream bytes)
(let ((stream-var (gensym))
(bytes-var (gensym)))
(fd-stream-ibuf-head ,stream-var))
,bytes-var)
(return))
- (do-input ,stream-var)))))
+ (frob-input ,stream-var)))))
;;; a macro to wrap around all input routines to handle EOF-ERROR noise
(defmacro input-wrapper ((stream bytes eof-error eof-value) &body read-forms)
0
0))))
(cond ((eql count 1)
- (do-input fd-stream)
+ (frob-input fd-stream)
(setf (fd-stream-ibuf-head fd-stream) 0)
(setf (fd-stream-ibuf-tail fd-stream) 0))
(t
(cond ((fixnump posn)
;; Adjust for buffered output: If there is any output
;; buffered, the *real* file position will be larger
- ;; than reported by lseek because lseek obviously
+ ;; than reported by lseek() because lseek() obviously
;; cannot take into account output we have not sent
;; yet.
(dolist (later (fd-stream-output-later stream))
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))
;;; Rename NAMESTRING to ORIGINAL. First, check whether we have write
;;; access, since we don't want to trash unwritable files even if we
;;; technically can. We return true if we succeed in renaming.
-(defun do-old-rename (namestring original)
+(defun rename-the-old-one (namestring original)
(unless (sb!unix:unix-access namestring sb!unix:w_ok)
(error "~@<The file ~2I~_~S ~I~_is not writable.~:>" namestring))
(multiple-value-bind (okay err) (sb!unix:unix-rename namestring original)
(:io (values t t sb!unix:o_rdwr))
(:probe (values t nil sb!unix:o_rdonly)))
(declare (type index mask))
- (let* ((pathname (pathname filename))
+ (let* ((pathname (merge-pathnames filename))
(namestring
(cond ((unix-namestring pathname input))
((and input (eq if-does-not-exist :create))
namestring
err/dev)))))))
(unless (and exists
- (do-old-rename namestring original))
+ (rename-the-old-one namestring original))
(setf original nil)
(setf delete-original nil)
;; In order to use :SUPERSEDE instead, we have to make
projects / sbcl.git / blobdiff