master: Optimize read-from-c-string/utf-8/lf

stassats via Sbcl-commits <[email protected]> Wed, 17 Jun 2026 03:09:18 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  8db96a30b55277d6791d0dca0983d4a3595dbe3a (commit)
      from  d1eead8b25e5c53defc408f3f294a47340226e79 (commit)

- Log -----------------------------------------------------------------
commit 8db96a30b55277d6791d0dca0983d4a3595dbe3a
Author: Stas Boukarev <[email protected]>
Date:   Wed Jun 17 06:07:43 2026 +0300

    Optimize read-from-c-string/utf-8/lf
    
    With better portable functions with some SWAR.
    With a SIMD utf8 validator on arm64.
---
 src/code/arm64-simd.lisp                 | 192 +++++++++++++++++++++++++
 src/code/external-formats/enc-basic.lisp | 233 +++++++++++++++++++++++++++++++
 src/code/fd-stream.lisp                  | 107 +++++++-------
 3 files changed, 480 insertions(+), 52 deletions(-)

diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index cbed03450..3d970e087 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -1258,3 +1258,195 @@
       (inst sub found-bits vector vector*)
       (inst lsr res found-bits 1)
       DONE)))
+
+(defun simd-utf8-strlen (sap)
+  (declare (system-area-pointer sap)
+           (optimize speed (safety 0)))
+  (inline-vop
+      (((bytes        sap-reg t) sap)
+       ((ptr          sap-reg t))
+
+       ((total-bytes  signed-reg))
+       ((total-conts  unsigned-reg))
+       ((tmp          unsigned-reg))
+
+       ((tbl1         complex-double-reg))
+       ((tbl2         complex-double-reg))
+       ((tbl3         complex-double-reg))
+       ((tbl4         complex-double-reg))
+
+       ((nibble-mask  complex-double-reg))
+       ((twos         complex-double-reg))
+       ((indexes      complex-double-reg))
+
+       ((errors       complex-double-reg))
+       ((prev         complex-double-reg))
+       ((prev-len     complex-double-reg))
+
+       ((current      complex-double-reg))
+       ((tmp1         complex-double-reg))
+       ((tmp2         complex-double-reg))
+       ((tmp3         complex-double-reg))
+       ((tmp4         complex-double-reg)))
+
+      ((res descriptor-reg t :from :load)
+       (all-ascii descriptor-reg))
+    (flet ((validate ()
+             (assemble ()
+               ;; Skip an all-ASCII block
+               (inst orr tmp1 current prev :16b)
+               (inst umaxv tmp1 tmp1 :16b)
+               (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+               (inst tbz tmp 7 VALIDATED)
+
+               ;; The Keiser, Lemire algorithm
+               (inst ext tmp1 prev current 15 :16b)
+               (inst ushr tmp2 tmp1 4 :16b)
+               (inst and tmp3 tmp1 nibble-mask :16b)
+               (inst ushr tmp4 current 4 :16b)
+
+               (inst tbl tmp2 (list tbl1) tmp2 :16b)
+               (inst tbl tmp3 (list tbl2) tmp3 :16b)
+               (inst tbl tmp4 (list tbl3) tmp4 :16b)
+
+               (inst and tmp2 tmp2 tmp3 :16b)
+               (inst and tmp2 tmp2 tmp4 :16b)
+               (inst orr errors errors tmp2 :16b)
+
+               (inst ushr tmp1 current 4 :16b)
+               (inst tbl tmp1 (list tbl4) tmp1 :16b)
+
+               (inst ext tmp2 prev-len tmp1 15 :16b)
+               (inst ext tmp3 prev-len tmp1 14 :16b)
+               (inst ext tmp4 prev-len tmp1 13 :16b)
+
+               (inst ushr tmp2 tmp2 1 :16b)
+               (inst ushr tmp3 tmp3 2 :16b)
+               (inst ushr tmp4 tmp4 3 :16b)
+
+               (inst orr tmp2 tmp2 tmp3 :16b)
+               (inst orr tmp2 tmp2 tmp4 :16b)
+
+               (inst ushr tmp3 current 6 :16b)
+               (inst cmeq tmp3 tmp3 twos :16b)
+
+               (inst cmtst tmp4 tmp2 tmp2 :16b)
+
+               (inst eor tmp4 tmp3 tmp4 :16b)
+               (inst orr errors errors tmp4 :16b)
+
+               ;; Subtract continuations
+               (inst ushr tmp4 tmp3 7 :16b)
+               (inst addv tmp4 tmp4 :16b)
+               (inst fmov tmp (reg-in-sc tmp4 'single-reg))
+               (inst add total-conts total-conts tmp)
+               VALIDATED)))
+      (assemble ()
+        ;; Align the start and then mask off the extra bits
+        (inst and ptr bytes -16)
+        (inst sub total-bytes bytes ptr)
+
+        (inst ldr current (@ ptr))
+
+        (load-inline-constant indexes :oword #x0F0E0D0C0B0A09080706050403020100)
+
+        ;; Replace the aligned bits with ones, avoiding null termination
+        (inst dup tmp1 total-bytes :16b)
+        (inst cmhi tmp1 tmp1 indexes :16b)
+        (inst bic current current tmp1 :16b)
+        (inst sub current current tmp1 :16b)
+
+        ASCII
+        (inst uminv tmp1 current :16b)
+        (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+        (inst cbz tmp ASCII-TAIL)
+        (inst umaxv tmp1 current :16b)
+        (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+        (inst tbnz tmp 7 NON-ASCII)
+
+
+        (inst ldr current (@ ptr 16 :pre-index))
+        (inst b ASCII)
+
+        ASCII-TAIL
+
+        ;; Find the first zero
+        (inst cmtst tmp1 current current :16b)
+        (inst orr tmp1 tmp1 indexes :16b)
+        (inst uminv tmp1 tmp1 :16b)
+        (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+
+        ;; Zero out the bytes after the first zero
+        (inst dup tmp1 tmp :16b)
+        (inst cmhi tmp1 tmp1 indexes :16b)
+        (inst and current current tmp1 :16b)
+
+        (inst sminv tmp1 current :16b)
+        (inst fmov total-bytes (reg-in-sc tmp1 'single-reg))
+        (inst tbnz total-bytes 7 NON-ASCII)
+
+        (inst add ptr ptr tmp)
+        (inst sub total-bytes ptr bytes)
+        (load-symbol all-ascii t)
+        (inst b RETURN)
+
+        NON-ASCII
+        (inst mov res null-tn)
+        (inst movi nibble-mask #x0f :16b)
+        (inst movi twos 2 :16b)
+        (inst mov total-conts 0)
+
+        (load-inline-constant tbl1 :oword #x38060001000000000000000000000000)
+        (load-inline-constant tbl2 :oword #x2020242020202020202020100000010B)
+        (load-inline-constant tbl3 :oword #x202020203535332B2020202020202020)
+        (load-inline-constant tbl4 :oword #x08040202000000000000000000000000)
+
+        (inst movi errors   0 :16b)
+        (inst movi prev     0 :16b)
+        (inst movi prev-len 0 :16b)
+
+        (inst b START)
+
+        LOOP
+        (inst ldr current (@ ptr))
+
+        START
+        (inst uminv tmp1 current :16b)
+        (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+        (inst cbz tmp TAIL)
+
+        (validate)
+
+        (inst mov prev current :16b)
+        (inst mov prev-len tmp1 :16b)
+
+        (inst add ptr ptr 16)
+        (inst b LOOP)
+
+        TAIL
+        ;; Find the first zero
+        (inst cmtst tmp1 current current :16b)
+        (inst orr tmp1 tmp1 indexes :16b)
+        (inst uminv tmp1 tmp1 :16b)
+        (inst fmov tmp (reg-in-sc tmp1 'single-reg))
+
+        ;; Zero out the bytes after the first zero
+        (inst dup tmp1 tmp :16b)
+        (inst cmhi tmp1 tmp1 indexes :16b)
+        (inst and current current tmp1 :16b)
+        (inst add ptr ptr tmp)
+
+        (validate)
+
+        (inst sub total-bytes ptr bytes)
+        (inst mov all-ascii null-tn)
+
+        (inst umaxv errors errors :16b)
+        (inst fmov tmp (reg-in-sc errors 'single-reg))
+        (inst cbnz tmp DONE)
+
+        (inst sub total-bytes total-bytes total-conts)
+
+        RETURN
+        (inst lsl res total-bytes n-fixnum-tag-bits)
+        DONE))))
diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index 3d78353d9..cb369aebc 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -663,6 +663,44 @@
       (setf (buffer-head ibuf) head)
       (truly-the index (values (truncate string-offset 4))))))
 
+;;; No validations
+#+(and sb-unicode 64-bit little-endian)
+(defun sb-vm::simd-copy-utf8-sap-to-character-string (sap string length)
+  (declare (index length)
+           (simple-character-string string)
+           (optimize speed (safety 0)))
+  (with-pinned-objects (string)
+    (let* ((n (logand length (- sb-vm:n-word-bytes)))
+           (string-sap (vector-sap string))
+           (string-offset 0))
+      (declare (optimize sb-c::preserve-single-use-debug-variables
+                         sb-c::preserve-constants))
+      (loop for byte-offset below n by sb-vm:n-word-bytes
+            do
+            (let ((word (sap-ref-word sap byte-offset)))
+              (setf (sap-ref-word string-sap string-offset)
+                    (dpb (ldb (byte 8 8) word)
+                         (byte 8 32)
+                         (ldb (byte 8 0) word))
+                    (sap-ref-word string-sap (+ string-offset 8))
+                    (dpb (ldb (byte 8 24) word)
+                         (byte 8 32)
+                         (ldb (byte 8 16) word))
+                    (sap-ref-word string-sap (+ string-offset 16))
+                    (dpb (ldb (byte 8 40) word)
+                         (byte 8 32)
+                         (ldb (byte 8 32) word))
+                    (sap-ref-word string-sap (+ string-offset 24))
+                    (dpb (ldb (byte 8 56) word)
+                         (byte 8 32)
+                         (ldb (byte 8 48) word))))
+            (incf string-offset (* 4 sb-vm:n-word-bytes))
+            finally (let ((string-offset (truncate string-offset 4)))
+                      (loop for i from n below length
+                            do (setf (aref string string-offset)
+                                     (code-char (sap-ref-8 sap i)))
+                            (incf string-offset)))))))
+
 #+(and sb-unicode 64-bit little-endian)
 (defun sb-vm::simd-copy-utf8-crlf-to-character-string-with-size (start end string ibuf size-buffer)
   (declare (type index start end)
@@ -1157,6 +1195,7 @@
   :fd-stream-read-n-characters fd-stream-read-n-characters/utf-8
   :write-n-bytes-fun output-bytes/utf-8/lf
   :char-encodable-p (let ((bits (char-code |ch|))) (not (<= #xd800 bits #xdfff)))
+  :read-c-string-function read-from-c-string/utf-8/lf
   :handle-size nil)
 
 (define-external-format/variable-width (:utf-8) t
@@ -1386,3 +1425,197 @@
       (setf (buffer-head ibuf) head)
       (truly-the index (values (truncate string-offset 4))))))
 
+(defun find-bad-utf8 (sap)
+  (let* ((size 0) (head 0) (byte 0) (|ch| nil) (decode-break-reason nil))
+    (dotimes (count (1- array-dimension-limit) count)
+      (setf decode-break-reason
+            (block decode-break-reason
+              (setf byte (sap-ref-8 sap head)
+                    size
+                    (cond ((< byte 128) 1)
+                          ((< byte 194)
+                           (return-from decode-break-reason 1))
+                          ((< byte 224) 2) ((< byte 240) 3) (t 4))
+                    |ch|
+                    (code-char
+                     (ecase size
+                       (1 byte)
+                       (2
+                        (let ((byte2 (sap-ref-8 sap (1+ head))))
+                          (unless (<= 128 byte2 191)
+                            (return-from decode-break-reason 2))
+                          (dpb byte (byte 5 6) byte2)))
+                       (3
+                        (let ((byte2 (sap-ref-8 sap (1+ head)))
+                              (byte3 (sap-ref-8 sap (+ 2 head))))
+                          (unless
+                              (and (<= 128 byte2 191) (<= 128 byte3 191)
+                                   (or (/= byte 224) (<= 160 byte2 191))
+                                   (or (/= byte 237) (<= 128 byte2 159)))
+                            (return-from decode-break-reason 3))
+                          (dpb byte (byte 4 12)
+                               (dpb byte2 (byte 6 6) byte3))))
+                       (4
+                        (let ((byte2 (sap-ref-8 sap (1+ head)))
+                              (byte3 (sap-ref-8 sap (+ 2 head)))
+                              (byte4 (sap-ref-8 sap (+ 3 head))))
+                          (unless
+                              (and (<= 128 byte2 191) (<= 128 byte3 191)
+                                   (<= 128 byte4 191)
+                                   (or (/= byte 240) (<= 144 byte2 191))
+                                   (or (/= byte 244) (<= 128 byte2 143)))
+                            (return-from decode-break-reason 4))
+                          (dpb byte (byte 3 18)
+                               (dpb byte2 (byte 6 12)
+                                    (dpb byte3 (byte 6 6) byte4))))))))
+              (incf head size)
+              nil))
+      (when decode-break-reason
+        (c-string-decoding-error :utf-8 sap head decode-break-reason))
+      (when (zerop (char-code |ch|)) (return count)))))
+
+(declaim (inline word-has-zero-bytes))
+(defun word-has-zero-bytes (word)
+  (declare (word word)
+           (optimize speed))
+  (let* ((ones (ldb (byte sb-vm:n-word-bits 0) #x0101010101010101))
+         (high-bits (* ones #x80)))
+    (logtest (logandc2 (- word ones) word)
+             high-bits)))
+
+(declaim (inline word-has-zero-or-negative-bytes))
+(defun word-has-zero-or-negative-bytes (word)
+  (declare (word word)
+           (optimize speed))
+  (let* ((ones (ldb (byte sb-vm:n-word-bits 0) #x0101010101010101))
+         (high-bits (* ones #x80)))
+    (logtest (logior (logandc2 (- word ones) word) word)
+             high-bits)))
+
+(declaim (inline word-aligned-sap-p))
+(defun word-aligned-sap-p (sap)
+  (declare (system-area-pointer sap)
+           (optimize speed))
+  (zerop (rem (sap-int sap) sb-vm:n-word-bytes)))
+
+#-arm64
+(defun sb-vm::simd-utf8-strlen (sap)
+  (declare (type system-area-pointer sap)
+           (optimize speed (safety 0)))
+  (macrolet ((return-if-not-cont (x)
+               `(let ((x ,x))
+                  (unless (<= #x80 x #xBF)
+                    (return (values nil nil)))
+                  x)))
+    (let ((index 0))
+      (declare (fixnum index))
+      ;; SWAR for ASCII
+      (when (word-aligned-sap-p sap)
+        (loop until (word-has-zero-or-negative-bytes (sap-ref-word sap index))
+              do (incf index sb-vm:n-word-bytes)))
+      ;; Scalar loop for ASCII
+      (loop
+       (let ((b0 (sap-ref-8 sap index)))
+         (cond ((< b0 #x80)
+                (when (zerop b0)
+                  (return-from sb-vm::simd-utf8-strlen (values index t)))
+                (incf index 1))
+               (t
+                (return)))))
+      (let ((codepoints index))
+        (declare (fixnum codepoints))
+        (loop
+         (let ((b0 (sap-ref-8 sap index)))
+           (cond
+             ;; ASCII
+             ((< b0 #x80)
+              (when (zerop b0)
+                (return (values codepoints nil)))
+              (incf index 1))
+             ;; 2 bytes
+             ((<= #xC2 b0 #xDF)
+              (return-if-not-cont (sap-ref-8 sap (+ index 1)))
+              (incf index 2))
+
+             ;; 3 bytes
+             ((<= #xE0 b0 #xEF)
+              (let ((b1 (return-if-not-cont (sap-ref-8 sap (+ index 1))))
+                    (b2 (return-if-not-cont (sap-ref-8 sap (+ index 2)))))
+                (declare (ignore b2 ))
+                (unless (if (= b0 #xE0)
+                            (<= #xA0 b1 #xBF) ; Overlong
+                            (if (= b0 #xED)
+                                (<= #x80 b1 #x9F) ; Surrogate halves
+                                t))
+                  (return (values nil nil))))
+              (incf index 3))
+             ;; 4 bytes
+             ((<= #xF0 b0 #xF4)
+              (let ((b1 (return-if-not-cont (sap-ref-8 sap (+ index 1))))
+                    (b2 (return-if-not-cont (sap-ref-8 sap (+ index 2))))
+                    (b3 (return-if-not-cont (sap-ref-8 sap (+ index 3)))))
+                (declare (ignore b2 b3))
+                (unless (if (= b0 #xF0)
+                            (<= #x90 b1 #xBF) ; Overlong
+                            (if (= b0 #xF4)
+                                (<= #x80 b1 #x8F) ; Too Large
+                                t))
+                  (return (values nil nil))))
+              (incf index 4))
+             (t (return (values nil nil)))))
+         (incf codepoints))))))
+
+(defun read-from-c-string/utf-8/lf (sap element-type)
+  (declare (type system-area-pointer sap)
+           (optimize (sb-c:verify-arg-count 0)))
+  (locally
+      (declare (optimize (speed 3) (safety 0)))
+    (multiple-value-bind (length all-ascii) (sb-vm::simd-utf8-strlen sap)
+      (unless length
+        (find-bad-utf8 sap)
+        (error "~a modified while validating UTF-8" sap))
+      (let* ((string
+               (case element-type
+                 (base-char (make-string length :element-type 'base-char))
+                 (character (make-string length :element-type 'character))
+                 (t (make-string length :element-type element-type)))))
+        (if all-ascii
+            (cond #+(and sb-unicode 64-bit little-endian)
+                  ((typep string 'simple-character-string)
+                   (sb-vm::simd-copy-utf8-sap-to-character-string sap string length))
+                  (t
+                   (loop for i below length
+                         do (setf (aref string i) (code-char (sap-ref-8 sap i))))))
+            (let* ((byte-index 0)
+                   (char-index 0))
+              (declare (type fixnum byte-index char-index))
+              (loop while (< char-index length)
+                    do
+                    (let ((b0 (sap-ref-8 sap byte-index)))
+                      (cond
+                        ((< b0 #x80)
+                         (setf (schar string char-index) (code-char b0))
+                         (incf byte-index 1))
+                        ((< b0 #xE0)
+                         (let ((b1 (sap-ref-8 sap (+ byte-index 1))))
+                           (setf (schar string char-index)
+                                 (code-char (dpb b0 (byte 5 6) b1)))
+                           (incf byte-index 2)))
+                        ((< b0 #xF0)
+                         (let ((b1 (sap-ref-8 sap (+ byte-index 1)))
+                               (b2 (sap-ref-8 sap (+ byte-index 2))))
+                           (setf (schar string char-index)
+                                 (code-char (dpb b0 (byte 4 12)
+                                                 (dpb b1 (byte 6 6) b2))))
+                           (incf byte-index 3)))
+                        (t
+                         (let ((b1 (sap-ref-8 sap (+ byte-index 1)))
+                               (b2 (sap-ref-8 sap (+ byte-index 2)))
+                               (b3 (sap-ref-8 sap (+ byte-index 3))))
+                           (setf (schar string char-index)
+                                 (code-char (dpb b0 (byte 3 18)
+                                                 (dpb b1 (byte 6 12)
+                                                      (dpb b2 (byte 6 6) b3)))))
+                           (incf byte-index 4)))))
+                    (incf char-index))))
+        string))))
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 346d8da2c..b4a9423d7 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -1557,7 +1557,8 @@
           fd-stream-read-n-characters
           write-n-bytes-fun
           (newline-variant :lf)
-          (char-encodable-p t))
+          (char-encodable-p t)
+          (read-c-string-function nil custom-read-c-string-function-p))
   (let* ((name (first external-format))
          (suffix (symbolicate name '/ newline-variant))
          (out-function (or write-n-bytes-fun
@@ -1568,7 +1569,8 @@
          (in-char-function (symbolicate "INPUT-CHAR/" suffix))
          (resync-function (symbolicate "RESYNC/" suffix))
          (size-function (symbolicate "BYTES-FOR-CHAR/" suffix))
-         (read-c-string-function (symbolicate "READ-FROM-C-STRING/" suffix))
+         (read-c-string-function (or read-c-string-function
+                                     (symbolicate "READ-FROM-C-STRING/" suffix)))
          (output-c-string-function (symbolicate "OUTPUT-TO-C-STRING/" suffix))
          (n-buffer (gensym "BUFFER")))
     `(progn
@@ -1793,56 +1795,57 @@
                           ,in-expr)
                         nil)
                 (return))))))
-       (defun ,read-c-string-function (sap element-type)
-         (declare (type system-area-pointer sap)
-                  (optimize (sb-c:verify-arg-count 0)))
-         (locally
-             (declare (optimize (speed 3) (safety 0)))
-           (let* ((stream ,name)
-                  (size 0) (head 0) (tail (1- array-dimension-limit)) (byte 0) (|ch| nil)
-                  (decode-break-reason nil)
-                  (length (dotimes (count (1- array-dimension-limit) count)
-                            (setf decode-break-reason
-                                  (block decode-break-reason
-                                    (setf byte (sap-ref-8 sap head)
-                                          size ,(if (consp in-size-expr)
-                                                    (cadr in-size-expr)
-                                                    in-size-expr)
-                                          |ch| ,in-expr)
-                                    (incf head size)
-                                    nil))
-                            (when decode-break-reason
-                              (c-string-decoding-error
-                               ,name sap head decode-break-reason))
-                            (when (zerop (char-code |ch|))
-                              (return count))))
-                  (string (case element-type
-                            (base-char
-                             (make-string length :element-type 'base-char))
-                            (character
-                             (make-string length :element-type 'character))
-                            (t
-                             (make-string length :element-type element-type)))))
-             (declare (ignorable stream byte tail)
-                      (type index head length tail) ;; size
-                      (type (unsigned-byte 8) byte)
-                      (type (or null character) |ch|)
-                      (type string string))
-             (setf head 0)
-             (dotimes (index length string)
-               (setf decode-break-reason
-                     (block decode-break-reason
-                       (setf byte (sap-ref-8 sap head)
-                             size ,(if (consp in-size-expr)
-                                       (cadr in-size-expr)
-                                       in-size-expr)
-                             |ch| ,in-expr)
-                       (incf head size)
-                       nil))
-               (when decode-break-reason
-                 (c-string-decoding-error
-                  ,name sap head decode-break-reason))
-               (setf (aref string index) |ch|)))))
+       ,@(unless custom-read-c-string-function-p
+           `((defun ,read-c-string-function (sap element-type)
+               (declare (type system-area-pointer sap)
+                        (optimize (sb-c:verify-arg-count 0)))
+               (locally
+                   (declare (optimize (speed 3) (safety 0)))
+                 (let* ((stream ,name)
+                        (size 0) (head 0) (tail (1- array-dimension-limit)) (byte 0) (|ch| nil)
+                        (decode-break-reason nil)
+                        (length (dotimes (count (1- array-dimension-limit) count)
+                                  (setf decode-break-reason
+                                        (block decode-break-reason
+                                          (setf byte (sap-ref-8 sap head)
+                                                size ,(if (consp in-size-expr)
+                                                          (cadr in-size-expr)
+                                                          in-size-expr)
+                                                |ch| ,in-expr)
+                                          (incf head size)
+                                          nil))
+                                  (when decode-break-reason
+                                    (c-string-decoding-error
+                                     ,name sap head decode-break-reason))
+                                  (when (zerop (char-code |ch|))
+                                    (return count))))
+                        (string (case element-type
+                                  (base-char
+                                   (make-string length :element-type 'base-char))
+                                  (character
+                                   (make-string length :element-type 'character))
+                                  (t
+                                   (make-string length :element-type element-type)))))
+                   (declare (ignorable stream byte tail)
+                            (type index head length tail) ;; size
+                            (type (unsigned-byte 8) byte)
+                            (type (or null character) |ch|)
+                            (type string string))
+                   (setf head 0)
+                   (dotimes (index length string)
+                     (setf decode-break-reason
+                           (block decode-break-reason
+                             (setf byte (sap-ref-8 sap head)
+                                   size ,(if (consp in-size-expr)
+                                             (cadr in-size-expr)
+                                             in-size-expr)
+                                   |ch| ,in-expr)
+                             (incf head size)
+                             nil))
+                     (when decode-break-reason
+                       (c-string-decoding-error
+                        ,name sap head decode-break-reason))
+                     (setf (aref string index) |ch|)))))))
 
        (defun ,output-c-string-function (string)
          (declare (type simple-string string))

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


hooks/post-receive
-- 
SBCL