master: Micro-optimize GET-OUTPUT-STREAM-STRING

The branch "master" has been updated in SBCL:
       via  30cbf6b31bde53f6c96c6e78c2f3b79c1ef2c052 (commit)
      from  f2ce4b2cf59cf93675b8a1dda76e228795d64bb4 (commit)

- Log -----------------------------------------------------------------
commit 30cbf6b31bde53f6c96c6e78c2f3b79c1ef2c052
Author: Gabor Melis <[email protected]>
Date:   Mon Jul 27 11:45:43 2026 +0200

    Micro-optimize GET-OUTPUT-STREAM-STRING
    
    It's smaller now, and it does not do a full call to ASH.
---
 src/code/stream.lisp | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 8613ec589..eef4680bc 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -1762,7 +1762,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING."
   (declare (type string-output-stream stream))
   (let* ((length (max (string-output-stream-index stream)
                       (string-output-stream-index-cache stream)))
-         (prev (nreverse (string-output-stream-prev stream)))
+         (prev (string-output-stream-prev stream))
          (this (string-output-stream-buffer stream))
          (next (string-output-stream-next stream))
          (base-string-p (neq (string-output-stream-unicode-p stream) t))
@@ -1800,7 +1800,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING."
     (flet ((copy (fun scale)
              (let ((start 0)) ; index into RESULT
                (declare (index start))
-               (dolist (buffer prev)
+               (dolist (buffer (nreverse prev))
                  ;; It doesn't look as though we should have to pass RESULT
                  ;; in to FUN to avoid closure consing, but indeed we do.
                  (funcall fun result buffer start scale)
@@ -1810,6 +1810,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING."
                (dolist (buffer next)
                  (funcall fun result buffer start scale)
                  (incf start (length buffer))))))
+      (declare (inline copy))
       (if (and (eq (string-output-stream-element-type stream) '*)
                base-string-p)
           ;; This is the most common case, arising from WRITE-TO-STRING,
@@ -1828,7 +1829,9 @@ benefit of the function GET-OUTPUT-STREAM-STRING."
                                            system-area-pointer system-area-pointer unsigned)
                                  :extern))
               (copy (lambda (result source start scale)
-                      (declare (index start))
+                      (declare (optimize speed)
+                               (index start)
+                               (simple-string source))
                       (let* ((nchars (min (- length start) (length source)))
                              (nbytes (the index (ash (the index nchars) scale))))
                         (with-pinned-objects (source)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL