From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Fri, 29 Oct 2004 00:43:15 +0000 (+0000)
Subject: 0.8.16.13:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1f724b3d4ea331dd05ace51a27a033831d83c85d;p=sbcl.git

0.8.16.13:
	Add FAST-READ-CHAR optimization, thanks to Teemu Kalvas
	... except for :io streams.

	This patch was brought to you by character_branch
---

diff --git a/CREDITS b/CREDITS
index 25f038a..59f39eb 100644
--- a/CREDITS
+++ b/CREDITS
@@ -579,7 +579,7 @@ Espen S Johnsen:
 
 Teemu Kalvas:
   He worked on Unicode support for SBCL, including parsing the Unicode
-  character database.
+  character database and restoring the FAST-READ-CHAR optimization.
 
 Frederik Kuivinen:
   He showed how to implement the DEBUG-RETURN functionality.
diff --git a/src/code/ansi-stream.lisp b/src/code/ansi-stream.lisp
index dc728e0..663869f 100644
--- a/src/code/ansi-stream.lisp
+++ b/src/code/ansi-stream.lisp
@@ -89,6 +89,9 @@
 (deftype ansi-stream-in-buffer ()
   `(simple-array (unsigned-byte 8) (,+ansi-stream-in-buffer-length+)))
 
+(deftype ansi-stream-cin-buffer ()
+  `(simple-array character (,+ansi-stream-in-buffer-length+)))
+
 ;;; base class for ANSI standard streams (as opposed to the Gray
 ;;; streams extension)
 (defstruct (ansi-stream (:constructor nil)
@@ -100,6 +103,7 @@
   ;; slot must must be NIL, and the IN-INDEX must be
   ;; +ANSI-STREAM-IN-BUFFER-LENGTH+.)
   (in-buffer nil :type (or ansi-stream-in-buffer null))
+  (cin-buffer nil :type (or ansi-stream-cin-buffer null))
   (in-index +ansi-stream-in-buffer-length+ :type index)
 
   ;; buffered input functions
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index d1632cb..fb2c9ff 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -747,18 +747,25 @@
 (defun refill-fd-stream-buffer (stream)
   ;; We don't have any logic to preserve leftover bytes in the buffer,
   ;; so we should only be called when the buffer is empty.
-  (aver (= (fd-stream-ibuf-head stream) (fd-stream-ibuf-tail stream)))
-  (multiple-value-bind (count err)
-      (sb!unix:unix-read (fd-stream-fd stream)
-			 (fd-stream-ibuf-sap stream)
-			 (fd-stream-ibuf-length stream))
-    (declare (type (or index null) count))
-    (when (null count)
-      (simple-stream-perror "couldn't read from ~S" stream err))
-    (setf (fd-stream-listen stream) nil
-	  (fd-stream-ibuf-head stream) 0
-	  (fd-stream-ibuf-tail stream) count)
-    count))
+  ;; FIXME: can have three bytes in buffer because of UTF-8
+  (let ((new-head 0)
+        (sap (fd-stream-ibuf-sap stream)))
+    (do ((head (fd-stream-ibuf-head stream) (1+ head))
+         (tail (fd-stream-ibuf-tail stream)))
+        ((= head tail))
+      (setf (sap-ref-8 sap new-head) (sap-ref-8 sap head))
+      (incf new-head))
+    (multiple-value-bind (count err)
+        (sb!unix:unix-read (fd-stream-fd stream)
+                           (sap+ sap new-head)
+                           (- (fd-stream-ibuf-length stream) new-head))
+      (declare (type (or index null) count))
+      (when (null count)
+        (simple-stream-perror "couldn't read from ~S" stream err))
+      (setf (fd-stream-listen stream) nil
+            (fd-stream-ibuf-head stream) new-head
+            (fd-stream-ibuf-tail stream) (+ count new-head))
+      count)))
 
 ;;;; utility functions (misc routines, etc)
 
@@ -776,7 +783,8 @@
 	(input-type nil)
 	(output-type nil)
 	(input-size nil)
-	(output-size nil))
+	(output-size nil)
+	(character-stream-p (subtypep type 'character)))
 
     (when (fd-stream-obuf-sap fd-stream)
       (push (fd-stream-obuf-sap fd-stream) *available-buffers*)
@@ -793,7 +801,7 @@
 	(setf (fd-stream-ibuf-sap fd-stream) (next-available-buffer))
 	(setf (fd-stream-ibuf-length fd-stream) bytes-per-buffer)
 	(setf (fd-stream-ibuf-tail fd-stream) 0)
-	(if (subtypep type 'character)
+	(if character-stream-p
 	    (setf (fd-stream-in fd-stream) routine
 		  (fd-stream-bin fd-stream) #'ill-bin)
 	    (setf (fd-stream-in fd-stream) #'ill-in
@@ -805,13 +813,19 @@
 		     ;; (unsigned-byte 8).  Because there's no buffer, the
 		     ;; other element-types will dispatch to the appropriate
 		     ;; input (output) routine in fast-read-byte.
-		     (equal target-type '(unsigned-byte 8))
-		     #+nil
+		     (or character-stream-p
+			 (equal target-type '(unsigned-byte 8)))
+		     (not output-p) ; temporary disable on :io streams
+		     #+(or)
 		     (or (eq type 'unsigned-byte)
 			 (eq type :default)))
-	    (setf (ansi-stream-in-buffer fd-stream)
-		  (make-array +ansi-stream-in-buffer-length+
-			      :element-type '(unsigned-byte 8)))))
+            (if character-stream-p
+                (setf (ansi-stream-cin-buffer fd-stream)
+                      (make-array +ansi-stream-in-buffer-length+
+                                  :element-type 'character))
+                (setf (ansi-stream-in-buffer fd-stream)
+                      (make-array +ansi-stream-in-buffer-length+
+                                  :element-type '(unsigned-byte 8))))))
 	(setf input-size size)
 	(setf input-type type)))
 
diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 6ff6a91..51c1911 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -276,11 +276,11 @@
 #!-sb-fluid (declaim (inline ansi-stream-unread-char))
 (defun ansi-stream-unread-char (character stream)
   (let ((index (1- (ansi-stream-in-index stream)))
-        (buffer (ansi-stream-in-buffer stream)))
+        (buffer (ansi-stream-cin-buffer stream)))
     (declare (fixnum index))
     (when (minusp index) (error "nothing to unread"))
     (cond (buffer
-           (setf (aref buffer index) (char-code character))
+           (setf (aref buffer index) character)
            (setf (ansi-stream-in-index stream) index))
           (t
            (funcall (ansi-stream-misc stream) stream
@@ -418,7 +418,7 @@
 ;;; the IN-BUFFER for text streams. There is definitely an IN-BUFFER,
 ;;; and hence must be an N-BIN method.
 (defun fast-read-char-refill (stream eof-error-p eof-value)
-  (let* ((ibuf (ansi-stream-in-buffer stream))
+  (let* ((ibuf (ansi-stream-cin-buffer stream))
 	 (count (funcall (ansi-stream-n-bin stream)
 			 stream
 			 ibuf
@@ -442,7 +442,7 @@
 				       sb!vm:n-word-bits))
 			    (* count sb!vm:n-byte-bits)))
 	   (setf (ansi-stream-in-index stream) (1+ start))
-	   (code-char (aref ibuf start))))))
+	   (aref ibuf start)))))
 
 ;;; This is similar to FAST-READ-CHAR-REFILL, but we don't have to
 ;;; leave room for unreading.
@@ -1742,8 +1742,7 @@
        (with-array-data ((data seq) (offset-start start) (offset-end end))
          (typecase data
 	   ((or (simple-array (unsigned-byte 8) (*))
-		(simple-array (signed-byte 8) (*))
-		simple-string)
+		(simple-array (signed-byte 8) (*)))
 	    (let* ((numbytes (- end start))
 		   (bytes-read (read-n-bytes stream data offset-start
 					     numbytes nil)))
diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp
index c4993f4..67e29dd 100644
--- a/src/code/sysmacs.lisp
+++ b/src/code/sysmacs.lisp
@@ -105,7 +105,7 @@
 (defmacro prepare-for-fast-read-char (stream &body forms)
   `(let* ((%frc-stream% ,stream)
 	  (%frc-method% (ansi-stream-in %frc-stream%))
-	  (%frc-buffer% (ansi-stream-in-buffer %frc-stream%))
+	  (%frc-buffer% (ansi-stream-cin-buffer %frc-stream%))
 	  (%frc-index% (ansi-stream-in-index %frc-stream%)))
      (declare (type index %frc-index%)
 	      (type ansi-stream %frc-stream%))
@@ -126,7 +126,7 @@
      (prog1 (fast-read-char-refill %frc-stream% ,eof-error-p ,eof-value)
 	    (setq %frc-index% (ansi-stream-in-index %frc-stream%))))
     (t
-     (prog1 (code-char (aref %frc-buffer% %frc-index%))
+     (prog1 (aref %frc-buffer% %frc-index%)
 	    (incf %frc-index%)))))
 
 ;;;; And these for the fasloader...
diff --git a/version.lisp-expr b/version.lisp-expr
index 48a03c1..c1f55ed 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.16.12"
+"0.8.16.13"