/[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.85.4.1.2.2 by rtoy, Wed Jul 2 14:53:44 2008 UTC revision 1.85.4.1.2.3 by rtoy, Sat Jul 5 12:37:42 2008 UTC
# Line 468  Line 468 
468       (when (> (fd-stream-ibuf-tail stream)       (when (> (fd-stream-ibuf-tail stream)
469                (fd-stream-ibuf-head stream))                (fd-stream-ibuf-head stream))
470         (file-position stream (file-position stream)))         (file-position stream (file-position stream)))
471       (let* ((len (fd-stream-obuf-length stream))       (let* ((sap (fd-stream-obuf-sap stream))
472                (len (fd-stream-obuf-length stream))
473              (tail (fd-stream-obuf-tail stream)))              (tail (fd-stream-obuf-tail stream)))
474           (declare (type sys:system-area-pointer sap) (type index len tail))
475         ,(stream::char-to-octets extfmt         ,(stream::char-to-octets extfmt
476                                  char                                  char
477                                  (fd-stream-co-state stream)                                  (fd-stream-co-state stream)
478                                  (lambda (byte)                                  (lambda (byte)
479                                    (when (= tail len)                                    (when (= tail len)
480                                      (do-output stream                                      (do-output stream sap 0 tail t)
481                                        (fd-stream-obuf-sap stream) 0 tail t)                                      (setq sap (fd-stream-obuf-sap stream)
482                                      (setq tail 0))                                            tail 0))
483                                    (setf (bref (fd-stream-obuf-sap stream)                                    (setf (bref sap (1- (incf tail))) byte)))
                                               (1- (incf tail)))  
                                       byte)))  
484         (setf (fd-stream-obuf-tail stream) tail))))         (setf (fd-stream-obuf-tail stream) tail))))
485    
486  #+(and unicode extfmts)  #+(and unicode extfmts)
# Line 615  Line 615 
615       (declare (type fd-stream stream)       (declare (type fd-stream stream)
616                (type simple-string string)                (type simple-string string)
617                (type index start end)                (type index start end)
618                #|(optimize (speed 3) (space 0) (safety 0) (debug 0))|#)                (optimize (speed 3) (space 0) (safety 0) (debug 0)))
619       ;; If there is any input read from UNIX but not       ;; If there is any input read from UNIX but not
620       ;; supplied to the user of the stream, reposition       ;; supplied to the user of the stream, reposition
621       ;; to the real file position as seen from Lisp.       ;; to the real file position as seen from Lisp.
622         ;; (maybe the caller should do this?)
623       (when (> (fd-stream-ibuf-tail stream)       (when (> (fd-stream-ibuf-tail stream)
624                (fd-stream-ibuf-head stream))                (fd-stream-ibuf-head stream))
625         (file-position stream (file-position stream)))         (file-position stream (file-position stream)))
626       (let* ((len (fd-stream-obuf-length stream))       (let* ((sap (fd-stream-obuf-sap stream))
627                (len (fd-stream-obuf-length stream))
628              (tail (fd-stream-obuf-tail stream)))              (tail (fd-stream-obuf-tail stream)))
629           (declare (type sys:system-area-pointer sap) (type index len tail))
630         (dotimes (i (- end start))         (dotimes (i (- end start))
631           ,(stream::char-to-octets extfmt           ,(stream::char-to-octets extfmt
632                                    (schar string (+ i start))                                    (schar string (+ i start))
633                                    (fd-stream-co-state stream)                                    (fd-stream-co-state stream)
634                                    (lambda (byte)                                    (lambda (byte)
635                                      (when (= tail len)                                      (when (= tail len)
636                                        (flush-output-buffer stream)                                        (do-output stream sap 0 tail t)
637                                        (setq tail 0))                                        (setq sap (fd-stream-obuf-sap stream)
638                                      (setf (bref (fd-stream-obuf-sap stream)                                              tail 0))
639                                                  (1- (incf tail)))                                      (setf (bref sap (1- (incf tail))) byte))))
                                         byte))))  
640         (setf (fd-stream-obuf-tail stream) tail))))         (setf (fd-stream-obuf-tail stream) tail))))
641    
642  #+(and unicode extfmts)  #+(and unicode extfmts)
# Line 916  Line 918 
918    (let ((stream-var (gensym))    (let ((stream-var (gensym))
919          (element-var (gensym)))          (element-var (gensym)))
920      `(let ((,stream-var ,stream))      `(let ((,stream-var ,stream))
921         (if (fd-stream-unread ,stream-var)         (if (fd-stream-unread ,stream-var) ;;@@
922             (prog1             (prog1
923                 ,(if (eq type 'character)                 ,(if (eq type 'character)
924                      `(fd-stream-unread ,stream-var)                      `(fd-stream-unread ,stream-var)
# Line 1027  Line 1029 
1029                                              (bref (fd-stream-ibuf-sap stream)                                              (bref (fd-stream-ibuf-sap stream)
1030                                                    (1- (incf head))))                                                    (1- (incf head))))
1031                                            (lambda (n) (decf head n)))))                                            (lambda (n) (decf head n)))))
1032            (declare (type index head))
1033          (when ch          (when ch
1034            (incf (fd-stream-ibuf-head stream)            (incf (fd-stream-ibuf-head stream)
1035                  (fd-stream-last-char-read-size stream))                  (fd-stream-last-char-read-size stream))
# Line 1063  Line 1066 
1066                (type (or character null) char)                (type (or character null) char)
1067                (type index start end)                (type index start end)
1068                (optimize (speed 3) (space 0) (debug 0) (safety 0)))                (optimize (speed 3) (space 0) (debug 0) (safety 0)))
1069       (let ((head (fd-stream-ibuf-head stream))       (let ((sap (fd-stream-ibuf-sap stream))
1070               (head (fd-stream-ibuf-head stream))
1071               (tail (fd-stream-ibuf-tail stream))
1072             (curr start))             (curr start))
1073         (declare (type index head curr))         (declare (type sys:system-area-pointer sap)
1074                    (type index head tail curr))
1075         (loop         (loop
1076           (let ((ch (catch 'eof-input-catcher           ;;@@ Fix EOF handling
1077                       ,(stream::octets-to-char extfmt           (let* ((sz 0)
1078                                                (fd-stream-oc-state stream)                  (ch (catch 'eof-input-catcher
1079                                                (fd-stream-last-char-read-size                        ,(stream::octets-to-char extfmt
1080                                                 stream)                                                 (fd-stream-oc-state stream)
1081                                                ;;@@ EOF handling...                                                 sz
1082                                                (progn                                                 (progn
1083                                                  (when (= head                                                   (when (= head tail)
1084                                                           (fd-stream-ibuf-tail                                                     (do-input stream)
1085                                                            stream))                                                     (setq head
1086                                                    (do-input stream)                                                         (fd-stream-ibuf-head
1087                                                    (setf head                                                          stream)
1088                                                        (fd-stream-ibuf-head                                                         tail
1089                                                         stream)))                                                         (fd-stream-ibuf-tail
1090                                                  (bref (fd-stream-ibuf-sap stream)                                                          stream)))
1091                                                        (1- (incf head))))                                                   (bref sap (1- (incf head))))
1092                                                (lambda (n) (decf head n))))))                                                 (lambda (n) (decf head n))))))
1093               (declare (type index sz)
1094                        (type (or null character) ch))
1095             (when (null ch)             (when (null ch)
1096               (return (values (- curr start) :eof)))               (return (values (- curr start) :eof)))
1097             (incf (fd-stream-ibuf-head stream)             (setf (fd-stream-last-char-read-size stream) sz)
1098                   (fd-stream-last-char-read-size stream))             (incf (fd-stream-ibuf-head stream) sz)
1099             (when (and char (char= ch char))             (when (and char (char= ch char))
1100               (return (values (- curr start) t)))               (return (values (- curr start) t)))
1101             (setf (schar string (1- (incf curr))) ch)             (setf (schar string (1- (incf curr))) ch)
# Line 1231  Line 1239 
1239      ;;      ;;
1240      ;; If something has been unread, put that at buffer + start,      ;; If something has been unread, put that at buffer + start,
1241      ;; and read the rest to start + 1.      ;; and read the rest to start + 1.
1242      (when (fd-stream-unread stream)      (when (fd-stream-unread stream) ;;@@
1243        (etypecase buffer        (etypecase buffer
1244          (system-area-pointer          (system-area-pointer
1245           (assert (= 1 (fd-stream-element-size stream)))           (assert (= 1 (fd-stream-element-size stream)))
# Line 1505  Line 1513 
1513                                               0 0))                                               0 0))
1514                      1))))                      1))))
1515      (:unread      (:unread
1516       (setf (fd-stream-unread stream) arg1)       (if (zerop (fd-stream-last-char-read-size stream))
1517             (setf (fd-stream-unread stream) arg1)
1518             (decf (fd-stream-ibuf-head stream)
1519                   (fd-stream-last-char-read-size stream)))
1520       (setf (fd-stream-listen stream) t))       (setf (fd-stream-listen stream) t))
1521      (:close      (:close
1522       (cond (arg1       (cond (arg1
# Line 1532  Line 1543 
1543         (setf (fd-stream-ibuf-sap stream) nil))         (setf (fd-stream-ibuf-sap stream) nil))
1544       (lisp::set-closed-flame stream))       (lisp::set-closed-flame stream))
1545      (:clear-input      (:clear-input
1546       (setf (fd-stream-unread stream) nil)       (setf (fd-stream-unread stream) nil) ;;@@
1547         (setf (fd-stream-last-char-read-size stream) 0)
1548       (setf (fd-stream-ibuf-head stream) 0)       (setf (fd-stream-ibuf-head stream) 0)
1549       (setf (fd-stream-ibuf-tail stream) 0)       (setf (fd-stream-ibuf-tail stream) 0)
1550       (catch 'eof-input-catcher       (catch 'eof-input-catcher
# Line 1619  Line 1631 
1631                   ;; unread stuff is still available.                   ;; unread stuff is still available.
1632                   (decf posn (- (fd-stream-ibuf-tail stream)                   (decf posn (- (fd-stream-ibuf-tail stream)
1633                                 (fd-stream-ibuf-head stream)))                                 (fd-stream-ibuf-head stream)))
1634                   (when (fd-stream-unread stream)                   (when (fd-stream-unread stream) ;;@@
1635                     (decf posn))                     (decf posn))
1636                   ;; Divide bytes by element size.                   ;; Divide bytes by element size.
1637                   (truncate posn (fd-stream-element-size stream)))                   (truncate posn (fd-stream-element-size stream)))
# Line 1642  Line 1654 
1654            (system:serve-all-events))            (system:serve-all-events))
1655          ;; Clear out any pending input to force the next read to go to the          ;; Clear out any pending input to force the next read to go to the
1656          ;; disk.          ;; disk.
1657          (setf (fd-stream-unread stream) nil)          (setf (fd-stream-unread stream) nil) ;;@@
1658            (setf (fd-stream-last-char-read-size stream) 0)
1659          (setf (fd-stream-ibuf-head stream) 0)          (setf (fd-stream-ibuf-head stream) 0)
1660          (setf (fd-stream-ibuf-tail stream) 0)          (setf (fd-stream-ibuf-tail stream) 0)
1661          ;; Trash cached value for listen, so that we check next time.          ;; Trash cached value for listen, so that we check next time.

Legend:
Removed from v.1.85.4.1.2.2  
changed lines
  Added in v.1.85.4.1.2.3

  ViewVC Help
Powered by ViewVC 1.1.5