/[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.7 by rtoy, Wed Sep 30 20:50:22 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            (dotimes (k sindex)
325              (multiple-value-bind (s pos count)
326                  (octets-to-string ibuf
327                                    :start index
328                                    :external-format old-format
329                                    :string sbuf)
330                (declare (ignore s pos))
331                (incf index count)))
332            ;; We now know the last octet that was used.  Now convert the
333            ;; rest of the octets.
334            (multiple-value-bind (s pos count)
335                (octets-to-string ibuf
336                                  :start index
337                                  :external-format (fd-stream-external-format stream)
338                                  :string (lisp-stream-string-buffer stream)
339                                  :s-start 1)
340              (declare (ignore s))
341              (setf (lisp-stream-string-index stream) 1)
342              (setf (lisp-stream-string-buffer-len stream) pos)
343              (setf (lisp-stream-in-index stream) (+ index count)))))
344        extfmt))
345    
346  ;; This is only used while building; it's reimplemented in  ;; This is only used while building; it's reimplemented in
347  ;; fd-stream-extfmt.lisp  ;; fd-stream-extfmt.lisp
# Line 459  Line 490 
490        ;; simple-stream        ;; simple-stream
491        (stream::%unread-char stream character)        (stream::%unread-char stream character)
492        ;; lisp-stream        ;; lisp-stream
493          #-unicode
494        (let ((index (1- (lisp-stream-in-index stream)))        (let ((index (1- (lisp-stream-in-index stream)))
495              (buffer (lisp-stream-in-buffer stream)))              (buffer (lisp-stream-in-buffer stream)))
496          (declare (fixnum index))          (declare (fixnum index))
# Line 469  Line 501 
501                (t                (t
502                 (funcall (lisp-stream-misc stream) stream                 (funcall (lisp-stream-misc stream) stream
503                          :unread character))))                          :unread character))))
504          #+unicode
505          (let ((sbuf (lisp-stream-string-buffer stream))
506                (ibuf (lisp-stream-in-buffer stream)))
507            (cond (sbuf
508                   (let ((index (1- (lisp-stream-string-index stream))))
509                     (when (minusp index)
510                       (error "Nothing to unread."))
511                     (setf (aref sbuf index) character)
512                     (setf (lisp-stream-string-index stream) index)))
513                  (ibuf
514                   (let ((index (1- (lisp-stream-in-index stream))))
515                     (when (minusp index)
516                       (error "Nothing to unread."))
517                     ;; This only works for iso8859-1!
518                     (setf (aref ibuf index) (char-code character))
519                     (setf (lisp-stream-in-index stream) index)))
520                  (t
521                   (funcall (lisp-stream-misc stream) stream
522                            :unread character))))
523        ;; fundamental-stream        ;; fundamental-stream
524        (stream-unread-char stream character)))        (stream-unread-char stream character)))
525    nil)    nil)
# Line 703  Line 754 
754             (setf (lisp-stream-in-index stream) (1+ start))             (setf (lisp-stream-in-index stream) (1+ start))
755             (code-char (aref ibuf start))))))             (code-char (aref ibuf start))))))
756    
757    (defun fast-read-char-string-refill (stream eof-errorp eof-value)
758      ;; Like fast-read-char-refill, but we don't need or want the
759      ;; in-buffer-extra.
760      (let* ((ibuf (lisp-stream-in-buffer stream))
761             (index (lisp-stream-in-index stream)))
762        (declare (type index))
763    
764        ;; Copy the stuff we haven't read from in-buffer to the beginning
765        ;; of the buffer.
766        (replace ibuf ibuf
767                 :start1 0
768                 :start2 index :end2 in-buffer-length)
769    
770        (let ((count (funcall (lisp-stream-n-bin stream) stream
771                              ibuf (- in-buffer-length index)
772                              index
773                              nil)))
774          (declare (type index count))
775    
776          (cond ((zerop count)
777                 ;; Nothing left in the stream, so update our pointers to
778                 ;; indicate we've read everything and call the stream-in
779                 ;; function so that we do the right thing for eof.
780                 (setf (lisp-stream-in-index stream) in-buffer-length)
781                 (setf (lisp-stream-string-index stream)
782                       (lisp-stream-string-buffer-len stream))
783                 (funcall (lisp-stream-in stream) stream eof-errorp eof-value))
784                (t
785                 (let ((sbuf (lisp-stream-string-buffer stream))
786                       (slen (lisp-stream-string-buffer-len stream)))
787    
788                   ;; Copy the last read character to the beginning of the
789                   ;; buffer to support unreading.
790                   (when (plusp slen)
791                     (setf (schar sbuf 0) (schar sbuf (1- slen))))
792    
793                   ;; Convert all the octets, including the ones that we
794                   ;; haven't read and the ones we just read in.
795                   (multiple-value-bind (s char-count octet-count)
796                       (octets-to-string ibuf
797                                         :start 0
798                                         :end (+ count (- in-buffer-length index))
799                                         :string sbuf
800                                         :s-start 1
801                                         :external-format (fd-stream-external-format stream))
802                     (declare (ignore s))
803    
804                     (setf (lisp-stream-string-buffer-len stream) char-count)
805                     (setf (lisp-stream-string-index stream) 2)
806                     (setf (lisp-stream-in-index stream) octet-count)
807                     (schar (lisp-stream-string-buffer stream) 1))))))))
808    
809    
810  ;;; FAST-READ-BYTE-REFILL  --  Interface  ;;; FAST-READ-BYTE-REFILL  --  Interface
811  ;;;  ;;;

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

  ViewVC Help
Powered by ViewVC 1.1.5