From 4692cc7bd36a1d198d1a806ba9881d0ba12fd1f4 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 21 May 1991 18:37:34 +0000 Subject: [PATCH] Changed FD-STREAM-READ-N-BYTES to block in unix-read rather than select so that it is usable as the CLX BUFFER-READ function (and is also more tense.) Fixed a couple warnings in the misc method. --- code/fd-stream.lisp | 135 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 124 insertions(+), 11 deletions(-) diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index 8d43fbb7c..b424a8d01 100644 --- a/code/fd-stream.lisp +++ b/code/fd-stream.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.12 1991/05/18 19:06:01 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.13 1991/05/21 18:37:34 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -643,6 +643,11 @@ eof-value)) eof))) +#| +This version waits using server. I changed to the non-server version because +it allows this method to be used by CLX w/o confusing serve-event. The +non-server method is also significantly more efficient for large reads. + -- Ram ;;; FD-STREAM-READ-N-BYTES -- internal ;;; @@ -685,6 +690,115 @@ (- requested (/ bytes elsize)) (* elsize 8) requested))))) +|# + + +;;; FD-STREAM-READ-N-BYTES -- internal +;;; +;;; The N-Bin method for FD-STREAMs. This doesn't using SERVER; it blocks +;;; in UNIX-READ. This allows the method to be used to implementing reading +;;; for CLX. It is generally used where there is a definite amount of reading +;;; to be done, so it blocking isn't too problematical. +;;; +;;; We copy buffered data into the buffer. If there is enough, just return. +;;; Otherwise, we see if the amount of additional data needed will fit in the +;;; stream buffer. If not, inhibit GCing (so we can have a SAP into the Buffer +;;; argument), and read directly into the user supplied buffer. Otherwise, +;;; read a buffer-full into the stream buffer and then copy the amount we need +;;; out. +;;; +;;; We loop doing the reads until we either get enough bytes or hit EOF. We +;;; must loop because some streams (like pipes) may return a partial amount +;;; without hitting EOF. +;;; +(defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p) + (declare (type stream stream) (type index start requested)) + (let* ((sap (fd-stream-ibuf-sap stream)) + (elsize (fd-stream-element-size stream)) + (offset (* elsize start)) + (requested-bytes (* elsize requested)) + (head (fd-stream-ibuf-head stream)) + (tail (fd-stream-ibuf-tail stream)) + (available (- tail head)) + (copy (min requested-bytes available))) + (declare (type index elsize offset requested-bytes head tail available + copy)) + (unless (zerop copy) + (if (typep buffer 'system-area-pointer) + (system-area-copy sap (* head vm:byte-bits) + buffer (* offset vm:byte-bits) + (* copy vm:byte-bits)) + (copy-from-system-area sap (* head vm:byte-bits) + buffer (+ (* offset vm:byte-bits) + (* vm:vector-data-offset + vm:word-bits)) + (* copy vm:byte-bits))) + (incf (fd-stream-ibuf-head stream) copy)) + (cond + ((> requested-bytes available) + (setf (fd-stream-ibuf-head stream) 0) + (setf (fd-stream-ibuf-tail stream) 0) + (setf (fd-stream-listen stream) nil) + (let ((now-needed (- requested-bytes copy)) + (len (fd-stream-ibuf-length stream))) + (declare (type index now-needed len)) + (cond + ((> now-needed len) + (system:without-gcing + (loop + (multiple-value-bind + (count err) + (mach:unix-read (fd-stream-fd stream) + (sap+ (if (typep buffer 'system-area-pointer) + buffer + (vector-sap buffer)) + (+ offset copy)) + now-needed) + (declare (type (or index null) count)) + (unless count + (error "Error reading ~S: ~A" stream + (mach:get-unix-error-msg err))) + (when (zerop count) + (if eof-error-p + (error "Unexpected eof on ~S." stream) + (return (- requested (/ now-needed elsize))))) + (decf now-needed count) + (when (zerop now-needed) (return requested)) + (incf offset count))))) + (t + (loop + (multiple-value-bind + (count err) + (mach:unix-read (fd-stream-fd stream) sap len) + (declare (type (or index null) count)) + (unless count + (error "Error reading ~S: ~A" stream + (mach:get-unix-error-msg err))) + (incf (fd-stream-ibuf-tail stream) count) + (when (zerop count) + (if eof-error-p + (error "Unexpected eof on ~S." stream) + (return (- requested (/ now-needed elsize))))) + (let* ((copy (min now-needed count)) + (copy-bits (* copy vm:byte-bits)) + (buffer-start-bits + (* (+ offset available) vm:byte-bits))) + (declare (type index copy copy-bits buffer-start-bits)) + (if (typep buffer 'system-area-pointer) + (system-area-copy sap 0 + buffer buffer-start-bits + copy-bits) + (copy-from-system-area sap 0 + buffer (+ buffer-start-bits + (* vm:vector-data-offset + vm:word-bits)) + copy-bits)) + (incf (fd-stream-ibuf-head stream) copy) + (decf now-needed copy) + (when (zerop now-needed) (return requested)) + (incf offset copy)))))))) + (t + requested)))) ;;;; Utility functions (misc routines, etc) @@ -793,11 +907,12 @@ (fd-stream-ibuf-tail stream))) (fd-stream-listen stream) (setf (fd-stream-listen stream) - (not (zerop (mach:unix-select (1+ (fd-stream-fd stream)) - (ash 1 (fd-stream-fd stream)) - 0 - 0 - 0)))))) + (eql (mach:unix-select (1+ (fd-stream-fd stream)) + (ash 1 (fd-stream-fd stream)) + 0 + 0 + 0) + 1)))) (:unread (setf (fd-stream-unread stream) arg1) (setf (fd-stream-listen stream) t)) @@ -854,11 +969,9 @@ (setf (fd-stream-ibuf-head stream) 0) (setf (fd-stream-ibuf-tail stream) 0) (loop - (multiple-value-bind - (count errno) - (mach:unix-select (1+ (fd-stream-fd stream)) - (ash 1 (fd-stream-fd stream)) - 0 0 0) + (let ((count (mach:unix-select (1+ (fd-stream-fd stream)) + (ash 1 (fd-stream-fd stream)) + 0 0 0))) (cond ((eql count 1) (do-input stream) (setf (fd-stream-ibuf-head stream) 0) -- GitLab