1.0.46.11: faster slot-accesses in the presence of SLOT-VALUE-USING-CLASS &co

[sbcl.git] / src / code / stream.lisp

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 7eb78ac..3065d16 100644 (file)
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -1460,6 +1460,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
 
 (defun string-out-misc (stream operation &optional arg1 arg2)
   (declare (ignore arg2))
+  (declare (optimize speed))
   (case operation
     (:charpos
      ;; Keeping this first is a silly micro-optimization: FRESH-LINE
@@ -1469,8 +1470,10 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
             (buffer (string-output-stream-buffer stream))
             (prev (string-output-stream-prev stream))
             (base 0))
+        (declare (type (or null (simple-array character (*))) buffer))
       :next
-      (let ((pos (position #\newline buffer :from-end t :end pointer)))
+      (let ((pos (when buffer
+                   (position #\newline buffer :from-end t :end pointer))))
         (when (or pos (not buffer))
           ;; If newline is at index I, and pointer at index I+N, charpos
           ;; is N-1. If there is no newline, and pointer is at index N,
@@ -1568,9 +1571,14 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
 
 ;;; FIXME: need to support (VECTOR NIL), ideally without destroying all hope
 ;;; of efficiency.
+(declaim (inline vector-with-fill-pointer))
+(defun vector-with-fill-pointer-p (x)
+  (and (vectorp x)
+       (array-has-fill-pointer-p x)))
+
 (deftype string-with-fill-pointer ()
-  '(and (or (vector character) (vector base-char))
-        (satisfies array-has-fill-pointer-p)))
+  `(and (or (vector character) (vector base-char))
+        (satisfies vector-with-fill-pointer-p)))
 
 (defstruct (fill-pointer-output-stream
             (:include ansi-stream