/[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.90 by rtoy, Wed Aug 26 16:25:41 2009 UTC revision 1.91 by rtoy, Wed Sep 9 15:51:27 2009 UTC
# Line 382  Line 382 
382       (let* ((tail (fd-stream-obuf-tail stream)))       (let* ((tail (fd-stream-obuf-tail stream)))
383         (declare (type index tail))         (declare (type index tail))
384         (cond         (cond
385           ((stream::ef-flush-state (stream::find-external-format ,extfmt))           ((stream::ef-flush-state ,(stream::find-external-format extfmt))
386            (stream::flush-state ,extfmt            (stream::flush-state ,extfmt
387                                 (fd-stream-co-state stream)                                 (fd-stream-co-state stream)
388                                 (lambda (byte)                                 (lambda (byte)
# Line 1372  Line 1372 
1372            ;; Support for n-byte operations on 8-, 16-, and 32-bit streams            ;; Support for n-byte operations on 8-, 16-, and 32-bit streams
1373            (setf (fd-stream-n-bin stream) #'fd-stream-read-n-bytes)            (setf (fd-stream-n-bin stream) #'fd-stream-read-n-bytes)
1374            (when (and buffer-p (eql size 1)            (when (and buffer-p (eql size 1)
1375                       (or (eq type 'unsigned-byte)                       (or
1376                           (eq type :default)))                        ;; FIXME: Do this better.  We want to check for
1377                          ;; (unsigned-byte 8).  The 8 is unnecessary
1378                          ;; since we already have size = 1.
1379                          (or (eq 'unsigned-byte (and (consp type) (car type)))
1380                              (eq type :default))
1381                          ;; Character streams with :iso8859-1
1382                          (and (eq type 'character)
1383                               #+unicode
1384                               (eql :iso8859-1 (fd-stream-external-format stream)))))
1385              ;; We only create this buffer for streams of type              ;; We only create this buffer for streams of type
1386              ;; (unsigned-byte 8).  Because there's no buffer, the              ;; (unsigned-byte 8) or character streams with an external
1387                ;; format of :iso8859-1.  Because there's no buffer, the
1388              ;; other element-types will dispatch to the appropriate              ;; other element-types will dispatch to the appropriate
1389              ;; input (output) routine in fast-read-byte.              ;; input (output) routine in fast-read-byte/fast-read-char.
1390              (setf (lisp-stream-in-buffer stream)              (setf (lisp-stream-in-buffer stream)
1391                    (make-array in-buffer-length                    (make-array in-buffer-length
1392                                :element-type '(unsigned-byte 8)))))                                :element-type '(unsigned-byte 8)))))
# Line 1405  Line 1414 
1414                      #'ill-out)                      #'ill-out)
1415                  (fd-stream-bout stream) routine))                  (fd-stream-bout stream) routine))
1416          (setf (fd-stream-sout stream)          (setf (fd-stream-sout stream)
1417                ;;#-unicode                (if (eql size 1) #'fd-sout #'ill-out))
               (if (eql size 1) #'fd-sout #'ill-out)  
               #|#+unicode  
               (if (eql size 1)  
                   #'fd-sout-each-character  
                   #'ill-out)|#)  
1418          (setf (fd-stream-char-pos stream) 0)          (setf (fd-stream-char-pos stream) 0)
1419          (setf output-size size)          (setf output-size size)
1420          (setf output-type type)))          (setf output-type type)))
# Line 1741  Line 1745 
1745                                       :pathname pathname                                       :pathname pathname
1746                                       :buffering buffering                                       :buffering buffering
1747                                       :timeout timeout))))                                       :timeout timeout))))
1748        ;; FIXME: setting the external format here should be better
1749        ;; integrated into set-routines.  We do it before so that
1750        ;; set-routines can create an in-buffer if appropriate.  But we
1751        ;; need to do it after to put the correct input routines for the
1752        ;; external format.
1753        ;;
1754        ;;#-unicode-bootstrap ; fails in stream-reinit otherwise
1755        #+(and unicode (not unicode-bootstrap))
1756        (setf (stream-external-format stream) external-format)
1757      (set-routines stream element-type input output input-buffer-p      (set-routines stream element-type input output input-buffer-p
1758                    :binary-stream-p binary-stream-p)                    :binary-stream-p binary-stream-p)
     ;;#-unicode-bootstrap ; fails in stream-reinit otherwise  
1759      #+(and unicode (not unicode-bootstrap))      #+(and unicode (not unicode-bootstrap))
1760      (setf (stream-external-format stream) external-format)      (setf (stream-external-format stream) external-format)
1761      (when (and auto-close (fboundp 'finalize))      (when (and auto-close (fboundp 'finalize))
# Line 2059  Line 2071 
2071                             class mapped input-handle output-handle                             class mapped input-handle output-handle
2072                        &allow-other-keys                        &allow-other-keys
2073                        &aux ; Squelch assignment warning.                        &aux ; Squelch assignment warning.
2074                          (options options)
2075                        (direction direction)                        (direction direction)
2076                        (if-does-not-exist if-does-not-exist)                        (if-does-not-exist if-does-not-exist)
2077                        (if-exists if-exists))                        (if-exists if-exists))
# Line 2230  Line 2243 
2243    
2244  #+unicode  #+unicode
2245  (stream::def-ef-macro ef-strlen (extfmt lisp stream::+ef-max+ stream::+ef-str+)  (stream::def-ef-macro ef-strlen (extfmt lisp stream::+ef-max+ stream::+ef-str+)
2246    (if (= (stream::ef-min-octets (stream::find-external-format extfmt))    ;; While it would be nice not to have to call CHAR-TO-OCTETS to
2247           (stream::ef-max-octets (stream::find-external-format extfmt)))    ;; figure out the length when the external format has fixed size
2248        `(lambda (stream object)    ;; outputs, we can't.  For example, utf16 will output a BOM, which
2249           (declare (ignore stream)    ;; wouldn't be reflected in the count if we don't call
2250                    (type (or character string) object)    ;; CHAR-TO-OCTETS.
2251                    (optimize (speed 3) (space 0) (safety 0)))    `(lambda (stream object &aux (count 0))
2252         (declare (type fd-stream stream)
2253                  (type (or character string) object)
2254                  (type (and fixnum unsigned-byte) count)
2255                  #|(optimize (speed 3) (space 0) (debug 0) (safety 0))|#)
2256         (labels ((efstate (state)
2257                    (stream::copy-state ,extfmt state))
2258                  (eflen (char)
2259                    (stream::char-to-octets ,extfmt char
2260                                            (fd-stream-co-state stream)
2261                                            (lambda (byte)
2262                                              (declare (ignore byte))
2263                                              (incf count)))))
2264           (let* ((co-state (fd-stream-co-state stream))
2265                  (old-ef-state (efstate (cdr (fd-stream-co-state stream))))
2266                  (old-state (cons (car co-state) old-ef-state)))
2267           (etypecase object           (etypecase object
2268             (character ,(stream::ef-min-octets (stream::find-external-format extfmt)))             (character (eflen object))
2269             (string (* ,(stream::ef-min-octets (stream::find-external-format extfmt))             (string (dovector (ch object) (eflen ch))))
2270                        (length object)))))           ;; Restore state
2271        `(lambda (stream object &aux (count 0))           (setf (fd-stream-co-state stream) old-state)
2272           (declare (type fd-stream stream)           count))))
                   (type (or character string) object)  
                   #|(optimize (speed 3) (space 0) (debug 0) (safety 0))|#)  
             `(labels ((eflen (char)  
                        (stream::char-to-octets ,extfmt char  
                                                ;;@@ FIXME: don't alter state!  
                                                (fd-stream-co-state stream)  
                                                (lambda (byte)  
                                                  (declare (ignore byte))  
                                                  (incf count)))))  
                (etypecase object  
                  (character (eflen object))  
                  (string (dovector (ch object) (eflen ch))))  
                count))))  
2273    
2274    
2275  (defun file-string-length (stream object)  (defun file-string-length (stream object)

Legend:
Removed from v.1.90  
changed lines
  Added in v.1.91

  ViewVC Help
Powered by ViewVC 1.1.5