/[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.90.2.4 by rtoy, Fri Aug 28 02:26:56 2009 UTC
# 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.
1390              (setf (lisp-stream-in-buffer stream)              (setf (lisp-stream-in-buffer stream)
# 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))))
     (set-routines stream element-type input output input-buffer-p  
                   :binary-stream-p binary-stream-p)  
1748      ;;#-unicode-bootstrap ; fails in stream-reinit otherwise      ;;#-unicode-bootstrap ; fails in stream-reinit otherwise
1749      #+(and unicode (not unicode-bootstrap))      #+(and unicode (not unicode-bootstrap))
1750      (setf (stream-external-format stream) external-format)      (setf (stream-external-format stream) external-format)
1751        (set-routines stream element-type input output input-buffer-p
1752                      :binary-stream-p binary-stream-p)
1753      (when (and auto-close (fboundp 'finalize))      (when (and auto-close (fboundp 'finalize))
1754        (finalize stream        (finalize stream
1755                  #'(lambda ()                  #'(lambda ()
# Line 2059  Line 2063 
2063                             class mapped input-handle output-handle                             class mapped input-handle output-handle
2064                        &allow-other-keys                        &allow-other-keys
2065                        &aux ; Squelch assignment warning.                        &aux ; Squelch assignment warning.
2066                          (options options)
2067                        (direction direction)                        (direction direction)
2068                        (if-does-not-exist if-does-not-exist)                        (if-does-not-exist if-does-not-exist)
2069                        (if-exists if-exists))                        (if-exists if-exists))
# Line 2230  Line 2235 
2235    
2236  #+unicode  #+unicode
2237  (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+)
2238    (if (= (stream::ef-min-octets (stream::find-external-format extfmt))    ;; While it would be nice not to have to call CHAR-TO-OCTETS to
2239           (stream::ef-max-octets (stream::find-external-format extfmt)))    ;; figure out the length when the external format has fixed size
2240        `(lambda (stream object)    ;; outputs, we can't.  For example, utf16 will output a BOM, which
2241           (declare (ignore stream)    ;; wouldn't be reflected in the count if we don't call
2242                    (type (or character string) object)    ;; CHAR-TO-OCTETS.
2243                    (optimize (speed 3) (space 0) (safety 0)))    `(lambda (stream object &aux (count 0))
2244         (declare (type fd-stream stream)
2245                  (type (or character string) object)
2246                  (type (and fixnum unsigned-byte) count)
2247                  #|(optimize (speed 3) (space 0) (debug 0) (safety 0))|#)
2248         (labels ((efstate (state)
2249                    (stream::copy-state ,extfmt state))
2250                  (eflen (char)
2251                    (stream::char-to-octets ,extfmt char
2252                                            (fd-stream-co-state stream)
2253                                            (lambda (byte)
2254                                              (declare (ignore byte))
2255                                              (incf count)))))
2256           (let* ((co-state (fd-stream-co-state stream))
2257                  (old-ef-state (efstate (cdr (fd-stream-co-state stream))))
2258                  (old-state (cons (car co-state) old-ef-state)))
2259           (etypecase object           (etypecase object
2260             (character ,(stream::ef-min-octets (stream::find-external-format extfmt)))             (character (eflen object))
2261             (string (* ,(stream::ef-min-octets (stream::find-external-format extfmt))             (string (dovector (ch object) (eflen ch))))
2262                        (length object)))))           ;; Restore state
2263        `(lambda (stream object &aux (count 0))           (setf (fd-stream-co-state stream) old-state)
2264           (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))))  
2265    
2266    
2267  (defun file-string-length (stream object)  (defun file-string-length (stream object)

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

  ViewVC Help
Powered by ViewVC 1.1.5