master: Move some code to the caller of external-format-char-size

The branch "master" has been updated in SBCL:
       via  b2a1d003f4d1ecfcbed7b22aede5ea8ecdd598a0 (commit)
      from  cb64b7018a8abe6ad4db5c49c5b7894f15d3a3e0 (commit)

- Log -----------------------------------------------------------------
commit b2a1d003f4d1ecfcbed7b22aede5ea8ecdd598a0
Author: Stas Boukarev <[email protected]>
Date:   Fri Aug 7 19:49:30 2026 +0300

    Move some code to the caller of external-format-char-size
---
 src/code/external-formats/enc-basic.lisp | 66 ++++++++++++++------------------
 src/code/stream.lisp                     | 18 ++++++++-
 2 files changed, 45 insertions(+), 39 deletions(-)

diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index bd96c69df..a8508141e 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -829,44 +829,34 @@
      (setf (buffer-head ibuf) head)))
 
 (make-defs (($newline || -crlf))
- (defun count-utf8$newline-byte-to-chars (stream)
-   (declare (optimize speed))
-   (let* ((ibuf (fd-stream-ibuf stream))
-          (sap (buffer-sap ibuf))
-          (index (ansi-stream-char-buffer-byte-position stream))
-          (codepoint (ansi-stream-char-buffer-byte-position-at stream))
-          (target-codepoint (ansi-stream-in-index stream)))
-     (declare (index index codepoint))
-     (when (<= (ansi-stream-in-index stream)
-               (ansi-stream-char-buffer-start stream)) ;; reading from "instead"
-       (return-from count-utf8$newline-byte-to-chars
-         (ansi-stream-char-buffer-byte-position-start stream)))
-     (when (< target-codepoint codepoint) ;; unread-char happened
-       ;; start from scratch
-       (setf index (ansi-stream-char-buffer-byte-position-start stream)
-             codepoint (ansi-stream-char-buffer-start stream)))
-     (loop
-      (when (>= codepoint target-codepoint)
-        (setf (ansi-stream-char-buffer-byte-position-at stream) (ansi-stream-in-index stream)
-              (ansi-stream-char-buffer-byte-position stream) index)
-        (return index))
-      (let ((byte (sap-ref-8 sap index))
-            ($when (eq '$newline '-crlf)
-                   (tail (buffer-tail ibuf))))
-        (cond ((< byte #x80)
-              (incf index)
-              ($when (eq '$newline '-crlf)
-                     (when (and (= byte 13)
-                                (< index tail)
-                                (= (sap-ref-8 sap index) 10))
-                       (incf index))))
-             ((< byte #xe0)
-              (incf index 2))
-             ((< byte #xf0)
-              (incf index 3))
-             (t
-              (incf index 4))))
-      (incf codepoint)))))
+  (defun count-utf8$newline-byte-to-chars (stream)
+    (declare (optimize speed))
+    (let* ((ibuf (fd-stream-ibuf stream))
+           (sap (buffer-sap ibuf))
+           (index (ansi-stream-char-buffer-byte-position stream))
+           (codepoint (ansi-stream-char-buffer-byte-position-at stream))
+           (target-codepoint (ansi-stream-in-index stream)))
+      (declare (index index codepoint))
+      (loop
+       (when (>= codepoint target-codepoint)
+         (return index))
+       (let ((byte (sap-ref-8 sap index))
+             ($when (eq '$newline '-crlf)
+                    (tail (buffer-tail ibuf))))
+         (cond ((< byte #x80)
+                (incf index)
+                ($when (eq '$newline '-crlf)
+                       (when (and (= byte 13)
+                                  (< index tail)
+                                  (= (sap-ref-8 sap index) 10))
+                         (incf index))))
+               ((< byte #xe0)
+                (incf index 2))
+               ((< byte #xf0)
+                (incf index 3))
+               (t
+                (incf index 4))))
+       (incf codepoint)))))
 
 (defun fd-stream-read-n-characters/utf-8 (stream string size-buffer start end &aux (index start))
   (declare (ignore size-buffer))
diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 71ee8b1d9..763f8ab61 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -226,7 +226,23 @@
                      (+
                       (- res
                          (buffer-head (fd-stream-ibuf stream)))
-                      (funcall char-size stream)))))))))))
+                      (let ((codepoint (ansi-stream-char-buffer-byte-position-at stream))
+                            (target-codepoint (ansi-stream-in-index stream)))
+                        (cond ((<= (ansi-stream-in-index stream)
+                                   (ansi-stream-char-buffer-start stream))
+                               ;; reading from "instead"
+                               (ansi-stream-char-buffer-byte-position-start stream))
+                              (t
+                               (when (< target-codepoint codepoint) ;; unread-char happened
+                                 ;; start from scratch
+                                 (setf (ansi-stream-char-buffer-byte-position stream)
+                                       (ansi-stream-char-buffer-byte-position-start stream)
+                                       (ansi-stream-char-buffer-byte-position-at stream)
+                                       (ansi-stream-char-buffer-start stream)))
+                               (let ((byte (funcall char-size stream)))
+                                 (setf (ansi-stream-char-buffer-byte-position-at stream) (ansi-stream-in-index stream)
+                                       (ansi-stream-char-buffer-byte-position stream) byte)
+                                 byte))))))))))))))
 
 ;;; You're not allowed to specify NIL for the position but we were permitting
 ;;; it, which made it impossible to test for a bad call that tries to assign

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


hooks/post-receive
-- 
SBCL