/[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.9 by rtoy, Wed Oct 7 03:37:44 2009 UTC
# Line 298  Line 298 
298      ;; fundamental-stream      ;; fundamental-stream
299      :default))      :default))
300    
301  (defun %set-fd-stream-external-format (stream extfmt)  (defun %set-fd-stream-external-format (stream extfmt &optional (updatep t))
302    (declare (type fd-stream stream))    (declare (type fd-stream stream))
303    (setf (fd-stream-external-format stream)    (let ((old-format (fd-stream-external-format stream)))
304        (stream::ef-name (stream::find-external-format extfmt))      (setf (fd-stream-external-format stream)
305          (fd-stream-oc-state stream) nil            (stream::ef-name (stream::find-external-format extfmt))
306          (fd-stream-co-state stream) nil)            (fd-stream-oc-state stream) nil
307    (when (fd-stream-ibuf-sap stream) ; input stream            (fd-stream-co-state stream) nil)
308      (setf (fd-stream-in stream) (ef-cin extfmt)))      (when (fd-stream-ibuf-sap stream)   ; input stream
309    (when (fd-stream-obuf-sap stream) ; output stream        (setf (fd-stream-in stream) (ef-cin extfmt)))
310      (setf (fd-stream-out stream) (ef-cout extfmt)      (when (fd-stream-obuf-sap stream)   ; output stream
311            ;;@@ (fd-stream-sout stream) (ef-sout extfmt)        (setf (fd-stream-out stream) (ef-cout extfmt)
312            ))              ;;@@ (fd-stream-sout stream) (ef-sout extfmt)
313    extfmt)              ))
314        (when (and lisp::*enable-stream-buffer-p* updatep
315                   (lisp-stream-string-buffer stream))
316          ;; We want to reconvert any octets that haven't been converted
317          ;; yet.  So, we need to figure out which octet to start with.
318          ;; This is done by converting (the previously converted) octets
319          ;; until we've converted the right number of characters.
320          (let ((sbuf (make-string 1))
321                (ibuf (lisp-stream-in-buffer stream))
322                (sindex (1- (lisp-stream-string-index stream)))
323                (index 0)
324                (state (fd-stream-saved-oc-state stream)))
325            (dotimes (k sindex)
326              (multiple-value-bind (s pos count)
327                  (octets-to-string ibuf
328                                    :start index
329                                    :external-format old-format
330                                    :string sbuf
331                                    :state state)
332                (declare (ignore s pos))
333                (incf index count)))
334            ;; We now know the last octet that was used.  Now convert the
335            ;; rest of the octets using the new format
336            (multiple-value-bind (s pos count)
337                (octets-to-string ibuf
338                                  :start index
339                                  :end (fd-stream-in-length stream)
340                                  :external-format (fd-stream-external-format stream)
341                                  :string (lisp-stream-string-buffer stream)
342                                  :s-start 1)
343              (declare (ignore s))
344              (setf (lisp-stream-string-index stream) 1)
345              (setf (lisp-stream-string-buffer-len stream) pos)
346              (setf (lisp-stream-in-index stream) (+ index count)))))
347        extfmt))
348    
349  ;; This is only used while building; it's reimplemented in  ;; This is only used while building; it's reimplemented in
350  ;; fd-stream-extfmt.lisp  ;; fd-stream-extfmt.lisp
# Line 459  Line 493 
493        ;; simple-stream        ;; simple-stream
494        (stream::%unread-char stream character)        (stream::%unread-char stream character)
495        ;; lisp-stream        ;; lisp-stream
496          #-unicode
497        (let ((index (1- (lisp-stream-in-index stream)))        (let ((index (1- (lisp-stream-in-index stream)))
498              (buffer (lisp-stream-in-buffer stream)))              (buffer (lisp-stream-in-buffer stream)))
499          (declare (fixnum index))          (declare (fixnum index))
# Line 469  Line 504 
504                (t                (t
505                 (funcall (lisp-stream-misc stream) stream                 (funcall (lisp-stream-misc stream) stream
506                          :unread character))))                          :unread character))))
507          #+unicode
508          (let ((sbuf (lisp-stream-string-buffer stream))
509                (ibuf (lisp-stream-in-buffer stream)))
510            (cond (sbuf
511                   (let ((index (1- (lisp-stream-string-index stream))))
512                     (when (minusp index)
513                       (error "Nothing to unread."))
514                     (setf (aref sbuf index) character)
515                     (setf (lisp-stream-string-index stream) index)))
516                  (ibuf
517                   (let ((index (1- (lisp-stream-in-index stream))))
518                     (when (minusp index)
519                       (error "Nothing to unread."))
520                     ;; This only works for iso8859-1!
521                     (setf (aref ibuf index) (char-code character))
522                     (setf (lisp-stream-in-index stream) index)))
523                  (t
524                   (funcall (lisp-stream-misc stream) stream
525                            :unread character))))
526        ;; fundamental-stream        ;; fundamental-stream
527        (stream-unread-char stream character)))        (stream-unread-char stream character)))
528    nil)    nil)
# Line 703  Line 757 
757             (setf (lisp-stream-in-index stream) (1+ start))             (setf (lisp-stream-in-index stream) (1+ start))
758             (code-char (aref ibuf start))))))             (code-char (aref ibuf start))))))
759    
760    (defun fast-read-char-string-refill (stream eof-errorp eof-value)
761      ;; Like fast-read-char-refill, but we don't need or want the
762      ;; in-buffer-extra.
763      (let* ((ibuf (lisp-stream-in-buffer stream))
764             (index (lisp-stream-in-index stream)))
765        (declare (type (integer 0 #.in-buffer-length) index))
766    
767        ;; Copy the stuff we haven't read from in-buffer to the beginning
768        ;; of the buffer.
769        (replace ibuf ibuf
770                 :start1 0
771                 :start2 index :end2 in-buffer-length)
772    
773        (let ((count (funcall (lisp-stream-n-bin stream) stream
774                              ibuf (- in-buffer-length index)
775                              index
776                              nil)))
777          (declare (type (integer 0 #.in-buffer-length) count))
778    
779          (cond ((zerop count)
780                 ;; Nothing left in the stream, so update our pointers to
781                 ;; indicate we've read everything and call the stream-in
782                 ;; function so that we do the right thing for eof.
783                 (setf (lisp-stream-in-index stream) in-buffer-length)
784                 (setf (lisp-stream-string-index stream)
785                       (lisp-stream-string-buffer-len stream))
786                 (funcall (lisp-stream-in stream) stream eof-errorp eof-value))
787                (t
788                 (let ((sbuf (lisp-stream-string-buffer stream))
789                       (slen (lisp-stream-string-buffer-len stream)))
790                   (declare (simple-string sbuf)
791                            (type (integer 0 #.(1+ in-buffer-length)) slen)
792                            (optimize (speed 3)))
793    
794                   (setf (fd-stream-in-length stream) (+ count (- in-buffer-length index)))
795                   ;; Copy the last read character to the beginning of the
796                   ;; buffer to support unreading.
797                   (when (plusp slen)
798                     (setf (schar sbuf 0) (schar sbuf (1- slen))))
799    
800                   (setf (fd-stream-saved-oc-state stream)
801                         (copy-list (fd-stream-oc-state stream)))
802    
803                   #+debug-frcs
804                   (format *debug-io* "~&### count = ~D, end = ~D~%" count
805                           (+ count (- in-buffer-length index)))
806    
807                   ;; Convert all the octets, including the ones that we
808                   ;; haven't read and the ones we just read in.
809                   (multiple-value-bind (s char-count octet-count new-state)
810                       (octets-to-string ibuf
811                                         :start 0
812                                         :end (+ count (- in-buffer-length index))
813                                         :state (fd-stream-oc-state stream)
814                                         :string sbuf
815                                         :s-start 1
816                                         :external-format (fd-stream-external-format stream))
817                     (declare (ignore s))
818                     (setf (fd-stream-oc-state stream) new-state)
819                     (setf (lisp-stream-string-buffer-len stream) char-count)
820                     (setf (lisp-stream-string-index stream) 2)
821                     (setf (lisp-stream-in-index stream) octet-count)
822                     (schar sbuf 1))))))))
823    
824    
825  ;;; FAST-READ-BYTE-REFILL  --  Interface  ;;; FAST-READ-BYTE-REFILL  --  Interface
826  ;;;  ;;;

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

  ViewVC Help
Powered by ViewVC 1.1.5