/[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.23 by ram, Wed Feb 17 16:30:39 1993 UTC revision 1.23.1.1 by ram, Tue Feb 23 16:08:20 1993 UTC
# Line 736  non-server method is also significantly Line 736  non-server method is also significantly
736  ;;; out.  ;;; out.
737  ;;;  ;;;
738  ;;;    We loop doing the reads until we either get enough bytes or hit EOF.  We  ;;;    We loop doing the reads until we either get enough bytes or hit EOF.  We
739  ;;; must loop because some streams (like pipes) may return a partial amount  ;;; must loop when eof-errorp is T because some streams (like pipes) may return
740  ;;; without hitting EOF.  ;;; a partial amount without hitting EOF.
741  ;;;  ;;;
742  (defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p)  (defun fd-stream-read-n-bytes (stream buffer start requested eof-error-p)
743    (declare (type stream stream) (type index start requested))    (declare (type stream stream) (type index start requested))
744    (let* ((sap (fd-stream-ibuf-sap stream))    (let* ((sap (fd-stream-ibuf-sap stream))
# Line 786  non-server method is also significantly Line 786  non-server method is also significantly
786                  (unless count                  (unless count
787                    (error "Error reading ~S: ~A" stream                    (error "Error reading ~S: ~A" stream
788                           (unix:get-unix-error-msg err)))                           (unix:get-unix-error-msg err)))
789                  (when (zerop count)                  (when (< count now-needed)
790                    (if eof-error-p                    (if eof-error-p
791                        (error "Unexpected eof on ~S." stream)                        (when (zerop count)
792                            (error "Unexpected eof on ~S." stream))
793                        (return (- requested (truncate now-needed elsize)))))                        (return (- requested (truncate now-needed elsize)))))
794                  (decf now-needed count)                  (decf now-needed count)
795                  (when (zerop now-needed) (return requested))                  (when (zerop now-needed) (return requested))
# Line 803  non-server method is also significantly Line 804  non-server method is also significantly
804                  (error "Error reading ~S: ~A" stream                  (error "Error reading ~S: ~A" stream
805                         (unix:get-unix-error-msg err)))                         (unix:get-unix-error-msg err)))
806                (incf (fd-stream-ibuf-tail stream) count)                (incf (fd-stream-ibuf-tail stream) count)
807                (when (zerop count)                (when (< count now-needed)
808                  (if eof-error-p                  (if eof-error-p
809                      (error "Unexpected eof on ~S." stream)                      (when (zerop count)
810                          (error "Unexpected eof on ~S." stream))
811                      (return (- requested (truncate now-needed elsize)))))                      (return (- requested (truncate now-needed elsize)))))
812                (let* ((copy (min now-needed count))                (let* ((copy (min now-needed count))
813                       (copy-bits (* copy vm:byte-bits))                       (copy-bits (* copy vm:byte-bits))
# Line 833  non-server method is also significantly Line 835  non-server method is also significantly
835    
836  ;;; SET-ROUTINES -- internal  ;;; SET-ROUTINES -- internal
837  ;;;  ;;;
838  ;;;   Fill in the various routine slots for the given type. Input-p and output-p  ;;;   Fill in the various routine slots for the given type. Input-p and
839  ;;; indicate what slots to fill. The buffering slot must be set prior to  ;;; output-p indicate what slots to fill. The buffering slot must be set prior
840  ;;; calling this routine.  ;;; to calling this routine.
841  ;;;  ;;;
842  (defun set-routines (stream type input-p output-p)  (defun set-routines (stream type input-p output-p)
843    (let ((target-type (case type    (let ((target-type (case type
# Line 868  non-server method is also significantly Line 870  non-server method is also significantly
870          (setf (fd-stream-ibuf-tail stream) 0)          (setf (fd-stream-ibuf-tail stream) 0)
871          (if (subtypep type 'character)          (if (subtypep type 'character)
872              (setf (fd-stream-in stream) routine              (setf (fd-stream-in stream) routine
873                    (fd-stream-bin stream) #'ill-bin                    (fd-stream-bin stream) #'ill-bin)
                   (fd-stream-n-bin stream) #'ill-bin)  
874              (setf (fd-stream-in stream) #'ill-in              (setf (fd-stream-in stream) #'ill-in
875                    (fd-stream-bin stream) routine                    (fd-stream-bin stream) routine))
876                    (fd-stream-n-bin stream) #'fd-stream-read-n-bytes))          (when (eql size 1)
877              (setf (fd-stream-n-bin stream) #'fd-stream-read-n-bytes)
878              (setf (stream-in-buffer stream)
879                    (make-array in-buffer-length
880                                :element-type '(unsigned-byte 8))))
881          (setf input-size size)          (setf input-size size)
882          (setf input-type type)))          (setf input-type type)))
883    
# Line 1473  non-server method is also significantly Line 1478  non-server method is also significantly
1478    (funcall *beep-function* stream))    (funcall *beep-function* stream))
1479    
1480    
 ;;;; File position and file length.  
   
 ;;; File-Position  --  Public  
 ;;;  
 ;;;    Call the misc method with the :file-position operation.  
 ;;;  
 (defun file-position (stream &optional position)  
   "With one argument returns the current position within the file  
   File-Stream is open to.  If the second argument is supplied, then  
   this becomes the new file position.  The second argument may also  
   be :start or :end for the start and end of the file, respectively."  
   (unless (streamp stream)  
     (error "Argument ~S is not a stream." stream))  
   (funcall (stream-misc stream) stream :file-position position))  
   
 ;;; File-Length  --  Public  
 ;;;  
 ;;;    Like File-Position, only use :file-length.  
 ;;;  
 (defun file-length (stream)  
   "This function returns the length of the file that File-Stream is open to."  
   (unless (streamp stream)  
     (error "Argument ~S is not a stream." stream))  
   (funcall (stream-misc stream) stream :file-length))  
   
1481  ;;; File-Name  --  internal interface  ;;; File-Name  --  internal interface
1482  ;;;  ;;;
1483  ;;;    Kind of like File-Position, but is an internal hack used by the filesys  ;;;    Kind of like File-Position, but is an internal hack used by the filesys

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.23.1.1

  ViewVC Help
Powered by ViewVC 1.1.5