/[cmucl]/src/code/fd-stream.lisp
ViewVC logotype

Diff of /src/code/fd-stream.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by ram, Sat May 18 19:06:01 1991 UTC revision 1.13 by ram, Tue May 21 18:37:34 1991 UTC
# Line 643  Line 643 
643               eof-value))               eof-value))
644       eof)))       eof)))
645    
646    #|
647    This version waits using server.  I changed to the non-server version because
648    it allows this method to be used by CLX w/o confusing serve-event.  The
649    non-server method is also significantly more efficient for large reads.
650      -- Ram
651    
652  ;;; FD-STREAM-READ-N-BYTES -- internal  ;;; FD-STREAM-READ-N-BYTES -- internal
653  ;;;  ;;;
# Line 685  Line 690 
690                    (- requested (/ bytes elsize))                    (- requested (/ bytes elsize))
691                    (* elsize 8)                    (* elsize 8)
692                    requested)))))                    requested)))))
693    |#
694    
695    
696    ;;; FD-STREAM-READ-N-BYTES -- internal
697    ;;;
698    ;;;    The N-Bin method for FD-STREAMs.  This doesn't using SERVER; it blocks
699    ;;; in UNIX-READ.  This allows the method to be used to implementing reading
700    ;;; for CLX.  It is generally used where there is a definite amount of reading
701    ;;; to be done, so it blocking isn't too problematical.
702    ;;;
703    ;;;    We copy buffered data into the buffer.  If there is enough, just return.
704    ;;; Otherwise, we see if the amount of additional data needed will fit in the
705    ;;; stream buffer.  If not, inhibit GCing (so we can have a SAP into the Buffer
706    ;;; argument), and read directly into the user supplied buffer.  Otherwise,
707    ;;; read a buffer-full into the stream buffer and then copy the amount we need
708    ;;; out.
709    ;;;
710    ;;;    We loop doing the reads until we either get enough bytes or hit EOF.  We
711    ;;; must loop because some streams (like pipes) may return a partial amount
712    ;;; without hitting EOF.
713    ;;;
714    (defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p)
715      (declare (type stream stream) (type index start requested))
716      (let* ((sap (fd-stream-ibuf-sap stream))
717             (elsize (fd-stream-element-size stream))
718             (offset (* elsize start))
719             (requested-bytes (* elsize requested))
720             (head (fd-stream-ibuf-head stream))
721             (tail (fd-stream-ibuf-tail stream))
722             (available (- tail head))
723             (copy (min requested-bytes available)))
724        (declare (type index elsize offset requested-bytes head tail available
725                       copy))
726        (unless (zerop copy)
727          (if (typep buffer 'system-area-pointer)
728              (system-area-copy sap (* head vm:byte-bits)
729                                buffer (* offset vm:byte-bits)
730                                (* copy vm:byte-bits))
731              (copy-from-system-area sap (* head vm:byte-bits)
732                                     buffer (+ (* offset vm:byte-bits)
733                                               (* vm:vector-data-offset
734                                                  vm:word-bits))
735                                     (* copy vm:byte-bits)))
736          (incf (fd-stream-ibuf-head stream) copy))
737        (cond
738         ((> requested-bytes available)
739          (setf (fd-stream-ibuf-head stream) 0)
740          (setf (fd-stream-ibuf-tail stream) 0)
741          (setf (fd-stream-listen stream) nil)
742          (let ((now-needed (- requested-bytes copy))
743                (len (fd-stream-ibuf-length stream)))
744            (declare (type index now-needed len))
745            (cond
746             ((> now-needed len)
747              (system:without-gcing
748                (loop
749                  (multiple-value-bind
750                      (count err)
751                      (mach:unix-read (fd-stream-fd stream)
752                                      (sap+ (if (typep buffer 'system-area-pointer)
753                                                buffer
754                                                (vector-sap buffer))
755                                            (+ offset copy))
756                                      now-needed)
757                    (declare (type (or index null) count))
758                    (unless count
759                      (error "Error reading ~S: ~A" stream
760                             (mach:get-unix-error-msg err)))
761                    (when (zerop count)
762                      (if eof-error-p
763                          (error "Unexpected eof on ~S." stream)
764                          (return (- requested (/ now-needed elsize)))))
765                    (decf now-needed count)
766                    (when (zerop now-needed) (return requested))
767                    (incf offset count)))))
768             (t
769              (loop
770                (multiple-value-bind
771                    (count err)
772                    (mach:unix-read (fd-stream-fd stream) sap len)
773                  (declare (type (or index null) count))
774                  (unless count
775                    (error "Error reading ~S: ~A" stream
776                           (mach:get-unix-error-msg err)))
777                  (incf (fd-stream-ibuf-tail stream) count)
778                  (when (zerop count)
779                    (if eof-error-p
780                        (error "Unexpected eof on ~S." stream)
781                        (return (- requested (/ now-needed elsize)))))
782                  (let* ((copy (min now-needed count))
783                         (copy-bits (* copy vm:byte-bits))
784                         (buffer-start-bits
785                          (* (+ offset available) vm:byte-bits)))
786                    (declare (type index copy copy-bits buffer-start-bits))
787                    (if (typep buffer 'system-area-pointer)
788                        (system-area-copy sap 0
789                                          buffer buffer-start-bits
790                                          copy-bits)
791                        (copy-from-system-area sap 0
792                                               buffer (+ buffer-start-bits
793                                                         (* vm:vector-data-offset
794                                                            vm:word-bits))
795                                               copy-bits))
796                    (incf (fd-stream-ibuf-head stream) copy)
797                    (decf now-needed copy)
798                    (when (zerop now-needed) (return requested))
799                    (incf offset copy))))))))
800         (t
801          requested))))
802    
803    
804  ;;;; Utility functions (misc routines, etc)  ;;;; Utility functions (misc routines, etc)
# Line 793  Line 907 
907                     (fd-stream-ibuf-tail stream)))                     (fd-stream-ibuf-tail stream)))
908           (fd-stream-listen stream)           (fd-stream-listen stream)
909           (setf (fd-stream-listen stream)           (setf (fd-stream-listen stream)
910                 (not (zerop (mach:unix-select (1+ (fd-stream-fd stream))                 (eql (mach:unix-select (1+ (fd-stream-fd stream))
911                                               (ash 1 (fd-stream-fd stream))                                        (ash 1 (fd-stream-fd stream))
912                                               0                                        0
913                                               0                                        0
914                                               0))))))                                        0)
915                        1))))
916      (:unread      (:unread
917       (setf (fd-stream-unread stream) arg1)       (setf (fd-stream-unread stream) arg1)
918       (setf (fd-stream-listen stream) t))       (setf (fd-stream-listen stream) t))
# Line 854  Line 969 
969       (setf (fd-stream-ibuf-head stream) 0)       (setf (fd-stream-ibuf-head stream) 0)
970       (setf (fd-stream-ibuf-tail stream) 0)       (setf (fd-stream-ibuf-tail stream) 0)
971       (loop       (loop
972         (multiple-value-bind         (let ((count (mach:unix-select (1+ (fd-stream-fd stream))
973             (count errno)                                        (ash 1 (fd-stream-fd stream))
974             (mach:unix-select (1+ (fd-stream-fd stream))                                        0 0 0)))
                              (ash 1 (fd-stream-fd stream))  
                              0 0 0)  
975           (cond ((eql count 1)           (cond ((eql count 1)
976                  (do-input stream)                  (do-input stream)
977                  (setf (fd-stream-ibuf-head stream) 0)                  (setf (fd-stream-ibuf-head stream) 0)

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

  ViewVC Help
Powered by ViewVC 1.1.5