X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ffd-stream.lisp;h=2bf7810d42ff20c68969110e5bbc597004f4ce41;hb=89eb73c035f05ae53b1148ef8a83e1d4030b2dd8;hp=6df3f9f8de1796cda6442c4b4f4a2e5c7e3502d3;hpb=aa2dc9529460ea0d9c99998dc87283fc1a43e808;p=sbcl.git diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 6df3f9f..2bf7810 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -107,7 +107,7 @@ :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 @@ -316,37 +316,37 @@ ((<= 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 . (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 . (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) @@ -429,8 +429,8 @@ (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)))) @@ -575,19 +575,22 @@ (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)) @@ -598,23 +601,16 @@ (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) @@ -858,6 +854,16 @@ (: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))