/[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.120 by rtoy, Wed Sep 15 11:32:49 2010 UTC revision 1.121 by rtoy, Tue Oct 12 21:52:44 2010 UTC
# Line 1402  Line 1402 
1402          (setf (fd-stream-ibuf-sap stream) (next-available-buffer))          (setf (fd-stream-ibuf-sap stream) (next-available-buffer))
1403          (setf (fd-stream-ibuf-length stream) bytes-per-buffer)          (setf (fd-stream-ibuf-length stream) bytes-per-buffer)
1404          (setf (fd-stream-ibuf-tail stream) 0)          (setf (fd-stream-ibuf-tail stream) 0)
1405    
1406            ;; Set the in and bin methods.  Normally put an illegal input
1407            ;; function in, but if we have a binary text stream, pick an
1408            ;; appropriate input routine.
1409          (if (subtypep type 'character)          (if (subtypep type 'character)
1410              (setf (fd-stream-in stream) routine              (setf (fd-stream-in stream) routine
1411                    (fd-stream-bin stream) #'ill-bin)                    (fd-stream-bin stream) (if (and binary-stream-p
1412                                                      (eql size 1))
1413                                                 (pick-input-routine '(unsigned-byte 8))
1414                                                 #'ill-bin))
1415              (setf (fd-stream-in stream) (if (and binary-stream-p              (setf (fd-stream-in stream) (if (and binary-stream-p
1416                                                   (eql size 1))                                                   (eql size 1))
1417                                              (pick-input-routine 'character)                                              (pick-input-routine 'character)
# Line 1423  Line 1430 
1430                        (or (eq 'unsigned-byte (and (consp type) (car type)))                        (or (eq 'unsigned-byte (and (consp type) (car type)))
1431                            (eq type :default))                            (eq type :default))
1432                        (eq type 'character)))                        (eq type 'character)))
             ;; We only create this buffer for streams of type  
             ;; (unsigned-byte 8) or character streams with an external  
             ;; format of :iso8859-1.  Because there's no buffer, the  
             ;; other element-types will dispatch to the appropriate  
             ;; input (output) routine in fast-read-byte/fast-read-char.  
1433              (when *enable-stream-buffer-p*              (when *enable-stream-buffer-p*
1434                (setf (lisp-stream-in-buffer stream)                (when (and (not binary-stream-p)
1435                      (make-array in-buffer-length                           (eq type 'character))
1436                                  :element-type '(unsigned-byte 8)))                  ;; Create the in-buffer for any character (only)
1437                    ;; stream.  Don't want one for binary-text-streams!
1438                    (setf (lisp-stream-in-buffer stream)
1439                          (make-array in-buffer-length
1440                                      :element-type '(unsigned-byte 8))))
1441                #+unicode                #+unicode
1442                (when (and (eq type 'character)                (when (and (not binary-stream-p)
1443                             (eq type 'character)
1444                           (not (eq :iso8859-1 (fd-stream-external-format stream))))                           (not (eq :iso8859-1 (fd-stream-external-format stream))))
1445                  ;; For character streams, we create the string-buffer so                  ;; For character streams, we create the string-buffer so
1446                  ;; we can convert all available octets at once instead                  ;; we can convert all available octets at once instead
# Line 1444  Line 1451 
1451                  ;; For ISO8859-1, we don't want this because it's very                  ;; For ISO8859-1, we don't want this because it's very
1452                  ;; easy and quick to convert octets to iso8859-1.  (See                  ;; easy and quick to convert octets to iso8859-1.  (See
1453                  ;; FAST-READ-CHAR.)                  ;; FAST-READ-CHAR.)
1454    
1455                  (setf (lisp-stream-string-buffer stream)                  (setf (lisp-stream-string-buffer stream)
1456                        (make-string (1+ in-buffer-length)))                        (make-string (1+ in-buffer-length)))
1457                  (setf (fd-stream-octet-count stream)                  (setf (fd-stream-octet-count stream)
# Line 1464  Line 1472 
1472          (setf (fd-stream-obuf-sap stream) (next-available-buffer))          (setf (fd-stream-obuf-sap stream) (next-available-buffer))
1473          (setf (fd-stream-obuf-length stream) bytes-per-buffer)          (setf (fd-stream-obuf-length stream) bytes-per-buffer)
1474          (setf (fd-stream-obuf-tail stream) 0)          (setf (fd-stream-obuf-tail stream) 0)
1475            ;; Normally signal errors for reading from a stream with the
1476            ;; wrong element type, but allow binary-text-streams to read
1477            ;; from either.
1478          (if (subtypep type 'character)          (if (subtypep type 'character)
1479            (setf (fd-stream-out stream) routine              (setf (fd-stream-out stream) routine
1480                  (fd-stream-bout stream) #'ill-bout)                    (fd-stream-bout stream)
1481            (setf (fd-stream-out stream)                      (if (and binary-stream-p
1482                  (or (if (eql size 1)                               (eql size 1))
1483                            (pick-output-routine '(unsigned-byte 8)
1484                                                 (fd-stream-buffering stream))
1485                            #'ill-bout))
1486                (setf (fd-stream-out stream)
1487                      (if (and binary-stream-p (eql size 1))
1488                        (pick-output-routine 'base-char                        (pick-output-routine 'base-char
1489                                             (fd-stream-buffering stream)))                                             (fd-stream-buffering stream))
1490                      #'ill-out)                        #'ill-out)
1491                  (fd-stream-bout stream) routine))                    (fd-stream-bout stream) routine))
1492          (setf (fd-stream-sout stream)          (setf (fd-stream-sout stream)
1493                (if (eql size 1) #'fd-sout #'ill-out))                (if (eql size 1) #'fd-sout #'ill-out))
1494          (setf (fd-stream-char-pos stream) 0)          (setf (fd-stream-char-pos stream) 0)
# Line 1880  Line 1896 
1896                                         :timeout timeout                                         :timeout timeout
1897                                         :char-to-octets-error e                                         :char-to-octets-error e
1898                                         :octets-to-char-error d)))))                                         :octets-to-char-error d)))))
1899        ;; Set the lisp-stream flags appropriately for the kind of stream
1900        ;; we have (character, binary, binary-text-stream).
1901        (cond ((typep stream 'binary-text-stream)
1902               (setf (fd-stream-flags stream) #b100))
1903              ((subtypep element-type 'character)
1904               (setf (fd-stream-flags stream) #b001))
1905              (t
1906               (setf (fd-stream-flags stream) #b010)))
1907    
1908      ;; FIXME: setting the external format here should be better      ;; FIXME: setting the external format here should be better
1909      ;; integrated into set-routines.  We do it before so that      ;; integrated into set-routines.  We do it before so that
1910      ;; set-routines can create an in-buffer if appropriate.  But we      ;; set-routines can create an in-buffer if appropriate.  But we

Legend:
Removed from v.1.120  
changed lines
  Added in v.1.121

  ViewVC Help
Powered by ViewVC 1.1.5