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

Diff of /src/code/stream.lisp

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

revision 1.87 by rtoy, Mon Aug 10 16:47:41 2009 UTC revision 1.87.6.4 by rtoy, Fri Sep 25 18:13:11 2009 UTC
# Line 459  Line 459 
459        ;; simple-stream        ;; simple-stream
460        (stream::%unread-char stream character)        (stream::%unread-char stream character)
461        ;; lisp-stream        ;; lisp-stream
462          #-unicode
463        (let ((index (1- (lisp-stream-in-index stream)))        (let ((index (1- (lisp-stream-in-index stream)))
464              (buffer (lisp-stream-in-buffer stream)))              (buffer (lisp-stream-in-buffer stream)))
465          (declare (fixnum index))          (declare (fixnum index))
# Line 469  Line 470 
470                (t                (t
471                 (funcall (lisp-stream-misc stream) stream                 (funcall (lisp-stream-misc stream) stream
472                          :unread character))))                          :unread character))))
473          #+unicode
474          (let ((sbuf (lisp-stream-string-buffer stream))
475                (ibuf (lisp-stream-in-buffer stream)))
476            (cond (sbuf
477                   (let ((index (1- (lisp-stream-string-index stream))))
478                     (when (minusp index)
479                       (error "Nothing to unread."))
480                     (setf (aref sbuf index) character)
481                     (setf (lisp-stream-string-index stream) index)))
482                  (ibuf
483                   (let ((index (1- (lisp-stream-in-index stream))))
484                     (when (minusp index)
485                       (error "Nothing to unread."))
486                     ;; This only works for iso8859-1!
487                     (setf (aref ibuf index) (char-code character))
488                     (setf (lisp-stream-in-index stream) index)))
489                  (t
490                   (funcall (lisp-stream-misc stream) stream
491                            :unread character))))
492        ;; fundamental-stream        ;; fundamental-stream
493        (stream-unread-char stream character)))        (stream-unread-char stream character)))
494    nil)    nil)
# Line 703  Line 723 
723             (setf (lisp-stream-in-index stream) (1+ start))             (setf (lisp-stream-in-index stream) (1+ start))
724             (code-char (aref ibuf start))))))             (code-char (aref ibuf start))))))
725    
726    (defun fast-read-char-string-refill (stream eof-errorp eof-value)
727      #+debug-frcs
728      (progn
729        (format *debug-io* "fast-read-char-refill.  Stream before refill:~%")
730        (describe stream))
731    
732      ;; Like fast-read-char-refill, but we don't need or want the
733      ;; in-buffer-extra.
734      (let* ((ibuf (lisp-stream-in-buffer stream))
735             (index (lisp-stream-in-index stream)))
736        (declare (type index))
737        ;; Copy the stuff we haven't read to the beginning of the buffer.
738        (replace ibuf ibuf
739                 :start1 0
740                 :start2 index :end2 in-buffer-length)
741        (let ((count (funcall (lisp-stream-n-bin stream) stream
742                              ibuf (- in-buffer-length index)
743                              index
744                              nil)))
745          (declare (type index count))
746          #+nil
747          (format *debug-io* "### Refill.   index = ~D, count = ~D~%" index count)
748    
749          (cond ((zerop count)
750                 (setf (lisp-stream-in-index stream) in-buffer-length)
751                 (funcall (lisp-stream-in stream) stream eof-errorp eof-value))
752                (t
753                 #+debug-frcs
754                 (progn
755                   (format *debug-io* "~& Stream after refill:~%")
756                   (describe stream))
757    
758                 (setf (lisp-stream-in-index stream) 0)
759                 (let ((sbuf (lisp-stream-string-buffer stream))
760                       (slen (lisp-stream-string-buffer-len stream)))
761    
762                   ;; Copy the last read character to the beginning of the
763                   ;; buffer to support unreading.
764                   (when (plusp slen)
765                     (setf (schar sbuf 0) (schar sbuf (1- slen))))
766    
767                   ;; Convert all the octets, including the ones that we
768                   ;; haven't read and the ones we just read in.
769                   (multiple-value-bind (s char-count octet-count)
770                       (octets-to-string ibuf
771                                         :start 0
772                                         :end (+ count (- in-buffer-length index))
773                                         :string sbuf
774                                         :s-start 1
775                                         :external-format (fd-stream-external-format stream))
776                     (declare (ignore s))
777    
778                     (setf (lisp-stream-string-buffer-len stream) char-count)
779                     (setf (lisp-stream-string-index stream) 2)
780                     (incf (lisp-stream-in-index stream) octet-count)
781                     #+nil
782                     (progn
783                       (format *debug-io* "~& ### After refill, char-count, octet-count, string len = ~S ~S~%"
784                               char-count octet-count)
785                       (format *debug-io* "String = ~S~%" (subseq (lisp-stream-string-buffer stream)
786                                                                  1 char-count))
787                       (format *debug-io* "~& Stream after OS~%")
788                       (describe stream))
789                     (schar (lisp-stream-string-buffer stream) 1))))))))
790    
791    
792  ;;; FAST-READ-BYTE-REFILL  --  Interface  ;;; FAST-READ-BYTE-REFILL  --  Interface
793  ;;;  ;;;

Legend:
Removed from v.1.87  
changed lines
  Added in v.1.87.6.4

  ViewVC Help
Powered by ViewVC 1.1.5