(defstruct (fd-stream
(:constructor %make-fd-stream)
- (:include lisp-stream
+ (:include ansi-stream
(misc #'fd-stream-misc-routine))
(:copier nil))
:format-control "~@<~?: ~2I~_~A~:>"
:format-arguments (list note-format (list stream) (strerror errno))))
(defun simple-file-perror (note-format pathname errno)
- (error 'simple-stream-error
+ (error 'simple-file-error
:pathname pathname
:format-control "~@<~?: ~2I~_~A~:>"
:format-arguments
((<= 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))))
(car entry)
(caddr entry))))))
-;;; Returns a string constructed from the sap, start, and end.
+;;; Return a string constructed from SAP, START, and END.
(defun string-from-sap (sap start end)
(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. This blocks in UNIX-READ. It is
-;;; generally used where there is a definite amount of reading to be
-;;; done, so blocking isn't too problematical.
+;;; the N-BIN method for FD-STREAMs
+;;;
+;;; Note that this blocks in UNIX-READ. It is generally used where
+;;; there is a definite amount of reading to be done, so blocking
+;;; isn't too problematical.
(defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p)
(declare (type fd-stream stream))
(declare (type index start requested))
(head (fd-stream-ibuf-head stream))
(tail (fd-stream-ibuf-tail stream))
(available (- tail head))
- (this-copy (min remaining-request available))
+ (n-this-copy (min remaining-request available))
(this-start (+ start total-copied))
+ (this-end (+ this-start n-this-copy))
(sap (fd-stream-ibuf-sap stream)))
(declare (type index remaining-request head tail available))
- (declare (type index this-copy))
+ (declare (type index n-this-copy))
;; Copy data from stream buffer into user's buffer.
- (if (typep buffer 'system-area-pointer)
- (system-area-copy sap (* head sb!vm:byte-bits)
- buffer (* this-start sb!vm:byte-bits)
- (* this-copy sb!vm:byte-bits))
- (copy-from-system-area sap (* head sb!vm:byte-bits)
- buffer (+ (* this-start sb!vm:byte-bits)
- (* sb!vm:vector-data-offset
- sb!vm:word-bits))
- (* this-copy sb!vm:byte-bits)))
- (incf (fd-stream-ibuf-head stream) this-copy)
- (incf total-copied this-copy)
+ (%byte-blt sap head buffer this-start this-end)
+ (incf (fd-stream-ibuf-head stream) n-this-copy)
+ (incf total-copied n-this-copy)
;; Maybe we need to refill the stream buffer.
(cond (;; If there were enough data in the stream buffer, we're done.
(= total-copied requested)
(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)))
(:charpos
(fd-stream-char-pos fd-stream))
(:file-length
+ (unless (fd-stream-file fd-stream)
+ ;; This is a TYPE-ERROR because ANSI's species FILE-LENGTH
+ ;; "should signal an error of type TYPE-ERROR if stream is not
+ ;; a stream associated with a file". Too bad there's no very
+ ;; appropriate value for the EXPECTED-TYPE slot..
+ (error 'simple-type-error
+ :datum fd-stream
+ :expected-type 'file-stream
+ :format-control "~S is not a stream associated with a file."
+ :format-arguments (list fd-stream)))
(multiple-value-bind (okay dev ino mode nlink uid gid rdev size
atime mtime ctime blksize blocks)
(sb!unix:unix-fstat (fd-stream-fd fd-stream))
(type (or index (member nil :start :end)) newpos))
(if (null newpos)
(sb!sys:without-interrupts
- ;; First, find the position of the UNIX file descriptor in the
- ;; file.
+ ;; First, find the position of the UNIX file descriptor in the file.
(multiple-value-bind (posn errno)
(sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr)
(declare (type (or index null) posn))
(delete-original (eq if-exists :rename-and-delete))
(mode #o666))
(when original
- ;; We are doing a :RENAME or :RENAME-AND-DELETE.
- ;; Determine whether the file already exists, make sure the original
+ ;; We are doing a :RENAME or :RENAME-AND-DELETE. Determine
+ ;; whether the file already exists, make sure the original
;; file is not a directory, and keep the mode.
(let ((exists
(and namestring
(do-old-rename namestring original))
(setf original nil)
(setf delete-original nil)
- ;; In order to use :SUPERSEDE instead, we have to make sure
- ;; SB!UNIX:O_CREAT corresponds to IF-DOES-NOT-EXIST.
- ;; SB!UNIX:O_CREAT was set before because of IF-EXISTS being
- ;; :RENAME.
+ ;; In order to use :SUPERSEDE instead, we have to make
+ ;; sure SB!UNIX:O_CREAT corresponds to
+ ;; IF-DOES-NOT-EXIST. SB!UNIX:O_CREAT was set before
+ ;; because of IF-EXISTS being :RENAME.
(unless (eq if-does-not-exist :create)
(setf mask
(logior (logandc2 mask sb!unix:o_creat)
;;; This is kind of like FILE-POSITION, but is an internal hack used
;;; by the filesys stuff to get and set the file name.
+;;;
+;;; FIXME: misleading name, screwy interface
(defun file-name (stream &optional new-name)
(when (typep stream 'fd-stream)
(cond (new-name