CMUCL commit: RELEASE-20B-BRANCH src/code (stream.lisp)

Raymond Toy rtoy at common-lisp.net
Sun Sep 5 13:45:39 CEST 2010


    Date: Sunday, September 5, 2010 @ 07:45:39
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code
     Tag: RELEASE-20B-BRANCH

Modified: stream.lisp

Somve restructuring of FAST-READ-CHAR-STRING-REFILL.  Move the code
that handles eof and reading into the octet buffer into local
functions.  Makes it a little easier to read.


-------------+
 stream.lisp |  230 ++++++++++++++++++++++++++++------------------------------
 1 file changed, 113 insertions(+), 117 deletions(-)


Index: src/code/stream.lisp
diff -u src/code/stream.lisp:1.94.4.5 src/code/stream.lisp:1.94.4.6
--- src/code/stream.lisp:1.94.4.5	Fri Sep  3 12:32:38 2010
+++ src/code/stream.lisp	Sun Sep  5 07:45:38 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.94.4.5 2010-09-03 16:32:38 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.94.4.6 2010-09-05 11:45:38 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -763,126 +763,122 @@
     
     #+(or debug-frc-sr)
     (format t "ibuf after  = ~A~%" ibuf)
-    
-    (let ((count (funcall (lisp-stream-n-bin stream) stream
-			  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))
+    (flet
+	((get-octets (start)
+	   (funcall (lisp-stream-n-bin stream) stream
+		    ibuf start
+		    (- in-buffer-length start)
+		    nil))
+	 (handle-eof ()
+	   ;; Nothing left in the stream, so update our pointers to
+	   ;; indicate we've read everything and call the stream-in
+	   ;; function so that we do the right thing for eof.
+	   (setf (lisp-stream-in-index stream) in-buffer-length)
+	   (setf (lisp-stream-string-index stream)
+		 (lisp-stream-string-buffer-len stream))
+	   (funcall (lisp-stream-in stream) stream eof-errorp eof-value)))
+      (let ((count (get-octets index)))
+	(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
-	     ;; function so that we do the right thing for eof.
-	     (setf (lisp-stream-in-index stream) in-buffer-length)
-	     (setf (lisp-stream-string-index stream)
-		   (lisp-stream-string-buffer-len stream))
-	     (funcall (lisp-stream-in stream) stream eof-errorp eof-value))
-	    (t
-	     (let ((sbuf (lisp-stream-string-buffer stream))
-		   (slen (lisp-stream-string-buffer-len stream)))
-	       (declare (simple-string sbuf)
-			(type (integer 0 #.(1+ in-buffer-length)) slen)
-			(optimize (speed 3)))
-
-	       ;; Update in-length and saved-oc-state.  These are
-	       ;; needed if we change the external-format of the
-	       ;; stream because we need to know how many octets are
-	       ;; 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 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)
-			     (funcall (ef-copy-state (fd-stream-external-format stream))
-				      (cdr state)))))
-
-	       #+(or debug-frc-sr)
-	       (format t "slen = ~A~%" slen)
-
-	       ;; Copy the last read character to the beginning of the
-	       ;; buffer to support unreading.
-	       (when (plusp slen)
-		 (setf (schar sbuf 0) (schar sbuf (1- slen))))
-
-	       #+(or debug-frc-sr)
-	       (progn
-		 (format t "sbuf[0] = ~S~%" (schar sbuf 0))
-		 (format t "index = ~S~%" index))
-
-
-	       ;; Convert all the octets, including the ones that we
-	       ;; haven't processed yet and the ones we just read in.
-	       (flet
-		   ((convert-buffer ()
-		      (multiple-value-bind (s char-count octet-count new-state)
-			  (stream::octets-to-string-counted
-			   ibuf
-			   (fd-stream-octet-count stream)
-			   :start 0
-			   :end (fd-stream-in-length stream)
-			   :state (fd-stream-oc-state stream)
-			   :string sbuf
-			   :s-start 1
-			   :external-format (fd-stream-external-format stream)
-			   :error (fd-stream-octets-to-char-error stream))
-			(declare (ignore s)
-				 (type (integer 0 #.in-buffer-length) char-count octet-count))
-			#+(or debug-frc-sr)
-			(progn
-			  (format t "char-count = ~A~%" char-count)
-			  (format t "octet-count = ~A~%" octet-count)
-			  (format t "in-index = ~A~%" (lisp-stream-in-index stream)))
-			(when (> char-count 0)
-			  (setf (fd-stream-oc-state stream) new-state)
-			  (setf (lisp-stream-string-buffer-len stream) (1+ char-count))
-			  (setf (lisp-stream-string-index stream) 2)
-			  (setf (lisp-stream-in-index stream) octet-count)
+	(cond ((zerop count)
+	       (handle-eof))
+	      (t
+	       (let ((sbuf (lisp-stream-string-buffer stream))
+		     (slen (lisp-stream-string-buffer-len stream)))
+		 (declare (simple-string sbuf)
+			  (type (integer 0 #.(1+ in-buffer-length)) slen)
+			  (optimize (speed 3)))
+
+		 ;; Update in-length and saved-oc-state.  These are
+		 ;; needed if we change the external-format of the
+		 ;; stream because we need to know how many octets are
+		 ;; 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 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)
+			       (funcall (ef-copy-state (fd-stream-external-format stream))
+					(cdr state)))))
+
+		 #+(or debug-frc-sr)
+		 (format t "slen = ~A~%" slen)
+
+		 ;; Copy the last read character to the beginning of the
+		 ;; buffer to support unreading.
+		 (when (plusp slen)
+		   (setf (schar sbuf 0) (schar sbuf (1- slen))))
+
+		 #+(or debug-frc-sr)
+		 (progn
+		   (format t "sbuf[0] = ~S~%" (schar sbuf 0))
+		   (format t "index = ~S~%" index))
+
+
+		 ;; Convert all the octets, including the ones that we
+		 ;; haven't processed yet and the ones we just read in.
+		 (flet
+		     ((convert-buffer ()
+			(multiple-value-bind (s char-count octet-count new-state)
+			    (stream::octets-to-string-counted
+			     ibuf
+			     (fd-stream-octet-count stream)
+			     :start 0
+			     :end (fd-stream-in-length stream)
+			     :state (fd-stream-oc-state stream)
+			     :string sbuf
+			     :s-start 1
+			     :external-format (fd-stream-external-format stream)
+			     :error (fd-stream-octets-to-char-error stream))
+			  (declare (ignore s)
+				   (type (integer 0 #.in-buffer-length) char-count octet-count))
 			  #+(or debug-frc-sr)
 			  (progn
-			    (format t "new in-index = ~A~%" (lisp-stream-in-index stream))
-			    (format t "new sbuf = ~S~%" 
-				    (subseq sbuf 0 (1+ char-count))))
-			  (schar sbuf 1)))))
-		 (let ((out (convert-buffer)))
-		   (or out
-		       ;; There weren't enough octets to convert at
-		       ;; least one character.  Try to read some more
-		       ;; octets and try again.  (If we still fail,
-		       ;; what should we do then?  Currently, just
-		       ;; just return NIL and let other parts of Lisp
-		       ;; catch that.)
-		       ;;
-		       ;; The in buffer holds unread octets up to
-		       ;; index in-length.  So start reading octets there.
-		       (let* ((index (fd-stream-in-length stream))
-			      (count (funcall (lisp-stream-n-bin stream) stream
-					     ibuf index
-					     (- in-buffer-length index)
-					     nil)))
-			 (declare (type (integer 0 #.in-buffer-length) count index))
-			 (cond ((zerop count)
-				;; Nothing left in the stream, so update our pointers to
-				;; indicate we've read everything and call the stream-in
-				;; function so that we do the right thing for eof.
-				(setf (lisp-stream-in-index stream) in-buffer-length)
-				(setf (lisp-stream-string-index stream)
-				      (lisp-stream-string-buffer-len stream))
-				(funcall (lisp-stream-in stream) stream eof-errorp eof-value))
-			       (t
-				;; Adjust in-length to the total
-				;; number of octets that are now in
-				;; the buffer.
-				(setf (fd-stream-in-length stream) (+ count index))
-				(convert-buffer)))))))))))))
+			    (format t "char-count = ~A~%" char-count)
+			    (format t "octet-count = ~A~%" octet-count)
+			    (format t "in-index = ~A~%" (lisp-stream-in-index stream)))
+			  (when (> char-count 0)
+			    (setf (fd-stream-oc-state stream) new-state)
+			    (setf (lisp-stream-string-buffer-len stream) (1+ char-count))
+			    (setf (lisp-stream-string-index stream) 2)
+			    (setf (lisp-stream-in-index stream) octet-count)
+			    #+(or debug-frc-sr)
+			    (progn
+			      (format t "new in-index = ~A~%" (lisp-stream-in-index stream))
+			      (format t "new sbuf = ~S~%" 
+				      (subseq sbuf 0 (1+ char-count))))
+			    (schar sbuf 1)))))
+		   (let ((out (convert-buffer)))
+		     (or out
+			 ;; There weren't enough octets to convert at
+			 ;; least one character.  Try to read some more
+			 ;; octets and try again.  (If we still fail,
+			 ;; what should we do then?  Currently, just
+			 ;; just return NIL and let other parts of Lisp
+			 ;; catch that.)
+			 ;;
+			 ;; The in buffer holds unread octets up to
+			 ;; index in-length.  So start reading octets there.
+			 (let* ((index (fd-stream-in-length stream))
+				(count (get-octets index)))
+			   (declare (type (integer 0 #.in-buffer-length) count index))
+			   (cond ((zerop count)
+				  (handle-eof))
+				 (t
+				  ;; Adjust in-length to the total
+				  ;; number of octets that are now in
+				  ;; the buffer.
+				  (setf (fd-stream-in-length stream) (+ count index))
+				  (convert-buffer))))))))))))))
 
 ;;; FAST-READ-BYTE-REFILL  --  Interface
 ;;;



More information about the cmucl-commit mailing list