CMUCL commit: src/code (stream.lisp sysmacs.lisp)

Raymond Toy rtoy at common-lisp.net
Mon Jul 5 05:40:02 CEST 2010


    Date: Sunday, July 4, 2010 @ 23:40:02
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code

Modified: stream.lisp sysmacs.lisp

Fix critical error in fast-read-char-string-refill where we didn't
stream the data correctly causing decoding errors.

code/sysmacs.lisp:
o Need to copy back the in-index that fast-read-char-string-refill
  updated. 

code/stream.lisp:
o Fix buffering issue when refilling the in-buffer with new data.
  Code was confused about the difference between in-length and
  in-buffer-length. 


--------------+
 stream.lisp  |   44 ++++++++++++++++++++++++++++++++++----------
 sysmacs.lisp |    3 ++-
 2 files changed, 36 insertions(+), 11 deletions(-)


Index: src/code/stream.lisp
diff -u src/code/stream.lisp:1.93 src/code/stream.lisp:1.94
--- src/code/stream.lisp:1.93	Thu Jul  1 22:50:35 2010
+++ src/code/stream.lisp	Sun Jul  4 23:40:02 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.93 2010-07-02 02:50:35 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.94 2010-07-05 03:40:02 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -723,21 +723,39 @@
   ;; Like fast-read-char-refill, but we don't need or want the
   ;; in-buffer-extra.
   (let* ((ibuf (lisp-stream-in-buffer stream))
-	 (index (lisp-stream-in-index stream)))
-    (declare (type (integer 0 #.in-buffer-length) index))
+	 (index (lisp-stream-in-index stream))
+	 (in-length (fd-stream-in-length stream)))
+    (declare (type (integer 0 #.in-buffer-length) index in-length))
+
+    #+(or debug-frc-sr)
+    (progn
+      (format t "index = ~A~%" index)
+      (format t "in-length = ~A~%" in-length)
+      (format t "ibuf before = ~A~%" ibuf))
 
     ;; Copy the stuff we haven't read from in-buffer to the beginning
     ;; of the buffer.
-    (replace ibuf ibuf
-	     :start1 0
-	     :start2 index :end2 in-buffer-length)
+    (if (< index in-length)
+	(replace ibuf ibuf
+		 :start1 0
+		 :start2 index :end2 in-length)
+	(setf index in-length))
+    (setf index (- in-length index))
+    
+    #+(or debug-frc-sr)
+    (format t "ibuf after  = ~A~%" ibuf)
     
     (let ((count (funcall (lisp-stream-n-bin stream) stream
-			  ibuf (- in-buffer-length index)
-			  index
+			  ibuf index
+			  (- in-buffer-length index)
 			  nil)))
       (declare (type (integer 0 #.in-buffer-length) count))
 
+      #+(or debug-frc-sr)
+      (progn
+	(format t "count = ~D~%" count)
+	(format t "new ibuf = ~A~%" ibuf))
+      
       (cond ((zerop count)
 	     ;; Nothing left in the stream, so update our pointers to
 	     ;; indicate we've read everything and call the stream-in
@@ -759,7 +777,9 @@
 	       ;; valid (in case end-of-file was reached), and what
 	       ;; the state was when originally converting the octets
 	       ;; to characters.
-	       (setf (fd-stream-in-length stream) (+ count (- in-buffer-length index)))
+	       (setf (fd-stream-in-length stream) (+ count index))
+	       #+(or debug-frc-sr)
+	       (format t "in-length = ~D~%" (fd-stream-in-length stream))
 	       (let ((state (fd-stream-oc-state stream)))
 		 (setf (fd-stream-saved-oc-state stream)
 		       (cons (car state)
@@ -768,6 +788,8 @@
 
 	       ;; Copy the last read character to the beginning of the
 	       ;; buffer to support unreading.
+	       #+(or)
+	       (format t "slen = ~A~%" slen)
 	       (when (plusp slen)
 		 (setf (schar sbuf 0) (schar sbuf (1- slen))))
 
@@ -777,7 +799,7 @@
 	       (multiple-value-bind (s char-count octet-count new-state)
 		   (octets-to-string ibuf
 				     :start 0
-				     :end (+ count (- in-buffer-length index))
+				     :end (fd-stream-in-length stream)
 				     :state (fd-stream-oc-state stream)
 				     :string sbuf
 				     :s-start 1
@@ -788,6 +810,8 @@
 		 (setf (lisp-stream-string-buffer-len stream) char-count)
 		 (setf (lisp-stream-string-index stream) 2)
 		 (setf (lisp-stream-in-index stream) octet-count)
+		 #+(or debug-frc-sr)
+		 (format t "new in-index = ~A~%" (lisp-stream-in-index stream))
 		 (schar sbuf 1))))))))
 
 ;;; FAST-READ-BYTE-REFILL  --  Interface
Index: src/code/sysmacs.lisp
diff -u src/code/sysmacs.lisp:1.33 src/code/sysmacs.lisp:1.34
--- src/code/sysmacs.lisp:1.33	Sun Apr 18 22:18:04 2010
+++ src/code/sysmacs.lisp	Sun Jul  4 23:40:02 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/sysmacs.lisp,v 1.33 2010-04-19 02:18:04 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/sysmacs.lisp,v 1.34 2010-07-05 03:40:02 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -188,6 +188,7 @@
      (%frc-string-buffer%
       (cond ((>= %frc-string-index% %frc-string-length%)
 	     (prog1 (fast-read-char-string-refill %frc-stream% ,eof-errorp ,eof-value)
+	       (setq %frc-index% (lisp-stream-in-index %frc-stream%))
 	       (setf %frc-string-index% (lisp-stream-string-index %frc-stream%))
 	       (setf %frc-string-length% (lisp-stream-string-buffer-len %frc-stream%))))
 	    (t



More information about the cmucl-commit mailing list