Re: master: Expose a much simplified utf8-to-string decoder

Stas Boukarev <[email protected]> Sun, 5 Apr 2026 05:12:50 +0300
Newsgroups gmane.lisp.steel-bank.cvs,gmane.lisp.steel-bank.devel
Message-ID <CAF63=103waQyfr+5C6otmzJYxzxqFN9t8KxqFrR2-er0d2G4jg@mail.gmail.com>
Can't octets-to-string use that?

On Sun, Apr 5, 2026 at 4:44 AM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  b3478e055b85c589cd08c1369bfd598a48b49db8 (commit)
>       from  0758784246a107603a04cff0628fbfdfdeebb845 (commit)
>
> - Log -----------------------------------------------------------------
> commit b3478e055b85c589cd08c1369bfd598a48b49db8
> Author: Douglas Katzman <[email protected]>
> Date:   Sat Apr 4 20:57:15 2026 -0400
>
>     Expose a much simplified utf8-to-string decoder
>
>     It comes in two-and-a-half variations: accepting a SAP or ub8 vector,
>     and if a SAP then either counted or null-terminated. In the case where
>     it returns base-string as determined by a pre-scan of the input, it runs
>     nearly twice as fast as octets-to-string
> ---
>  benchmarks/utf8-to-string.lisp | 124 +++++++++++++++++++++++++++++
>  src/code/misc-aliens.lisp      |   8 ++
>  src/code/target-unicode.lisp   | 176 ++++++++++++++++++++++++++++++++++++++++-
>  tests/utf-8.pure.lisp          |  34 ++++++++
>  4 files changed, 341 insertions(+), 1 deletion(-)
>
> diff --git a/benchmarks/utf8-to-string.lisp b/benchmarks/utf8-to-string.lisp
> new file mode 100644
> index 000000000..ad0f1112d
> --- /dev/null
> +++ b/benchmarks/utf8-to-string.lisp
> @@ -0,0 +1,124 @@
> +(defun calc-et (from-sec from-ns to-sec to-ns)
> +  (let ((from (floor (+ (* 1000000000 from-sec) from-ns) 1000))
> +        (to   (floor (+ (* 1000000000 to-sec)   to-ns)   1000)))
> +    (- to from)))
> +
> +(defmacro my-timing (form)
> +  (let ((clockid #+linux sb-unix:clock-thread-cputime-id
> +                 #+darwin sb-unix:clock-process-cputime-id))
> +    `(sb-int:binding* (((sec-before nsec-before) (sb-unix:clock-gettime ,clockid))
> +                       (nil ,form)
> +                       ((sec-after nsec-after)  (sb-unix:clock-gettime ,clockid)))
> +       (calc-et sec-before nsec-before sec-after nsec-after))))
> +
> +(defparameter *validate* nil)
> +(defun compare (testcases &optional (validate *validate*))
> +  (declare (simple-vector testcases))
> +  (declare (optimize speed))
> +  (declare (notinline sb-ext:octets-to-string)) ; because unsafely flushable
> +  (when validate ; make sure they agree
> +    (sb-int:dovector (x testcases)
> +      (let ((way1 (sb-unicode:utf8-decode-from-octets x))
> +            (way2 (sb-ext:octets-to-string x)))
> +        (assert (string= way1 way2)))))
> +  ;; These tests cons a lot and can be easily skewed by having very random
> +  ;; places at which they GC.  We get fairly consistent results when both the
> +  ;; baseline and experiment have a manual GC done beforehand.
> +  (gc)
> +  ;; run the new way first to give the benefit-of-doubt to the old way
> +  ;; in terms of bringing memory into L1 cache
> +  (let ((et-new (my-timing
> +                 (sb-int:dovector (x testcases) (sb-unicode:utf8-decode-from-octets x)))))
> +    (gc)
> +    (let ((et-old (my-timing
> +                   (sb-int:dovector (x testcases) (sb-ext:octets-to-string x)))))
> +      (format t "~D ~D (~f%)~%" et-old et-new (* 100 (/ (- et-new et-old) et-old))))))
> +
> +(defun random-string (stringlen percent-ascii &aux (unicode (- 100 percent-ascii)))
> +  (let ((s (make-string stringlen)))
> +    (dotimes (i stringlen s)
> +      (setf (char s i)
> +            (code-char (if (< (random 100.0) unicode)
> +                           (max #xE000 (random char-code-limit))
> +                           (max 1 (random 128))))))))
> +
> +(defun bench ()
> +  (dolist  (stringlen '(5 100 1000 10000 1000000))
> +    (dolist (percent-ascii '(100 99 98 97 96 95 90 80 70 60 50 40))
> +      (let ((n-trials (ceiling 10000000 stringlen)))
> +        (format t "~&~3D% ASCII, length=~d [~d iterations]: " percent-ascii stringlen n-trials)
> +        (force-output)
> +        (let ((testcases
> +               (coerce
> +                (loop repeat n-trials
> +                      collect
> +                      (string-to-octets (random-string stringlen percent-ascii)))
> +                'vector)))
> +          (compare testcases))))))
> +
> +#|
> +My results on an x86-64 macbook (negative percent diff means new is is better)
> +and the deltas are either very similar or show slightly less of an improvement
> +for arm64 macbook, but still always an improvement over the baseline.
> +
> +100% ASCII, length=5 [2000000 iterations]: 426481 89626 (-78.984764%)
> + 99% ASCII, length=5 [2000000 iterations]: 469787 60676 (-87.08436%)
> + 98% ASCII, length=5 [2000000 iterations]: 471085 65415 (-86.11397%)
> + 97% ASCII, length=5 [2000000 iterations]: 488598 68924 (-85.89352%)
> + 96% ASCII, length=5 [2000000 iterations]: 482445 74787 (-84.49834%)
> + 95% ASCII, length=5 [2000000 iterations]: 481117 77478 (-83.896225%)
> + 90% ASCII, length=5 [2000000 iterations]: 491657 87709 (-82.16053%)
> + 80% ASCII, length=5 [2000000 iterations]: 515252 103540 (-79.904976%)
> + 70% ASCII, length=5 [2000000 iterations]: 539165 116004 (-78.484505%)
> + 60% ASCII, length=5 [2000000 iterations]: 569675 136532 (-76.033356%)
> + 50% ASCII, length=5 [2000000 iterations]: 589356 143996 (-75.56723%)
> + 40% ASCII, length=5 [2000000 iterations]: 613356 144063 (-76.51234%)
> +100% ASCII, length=100 [100000 iterations]: 140443 3974 (-97.17038%)
> + 99% ASCII, length=100 [100000 iterations]: 149191 50945 (-65.8525%)
> + 98% ASCII, length=100 [100000 iterations]: 139345 77090 (-44.67688%)
> + 97% ASCII, length=100 [100000 iterations]: 154108 74434 (-51.700108%)
> + 96% ASCII, length=100 [100000 iterations]: 144111 87651 (-39.178135%)
> + 95% ASCII, length=100 [100000 iterations]: 162271 79519 (-50.996174%)
> + 90% ASCII, length=100 [100000 iterations]: 157988 92868 (-41.21832%)
> + 80% ASCII, length=100 [100000 iterations]: 196840 91016 (-53.76143%)
> + 70% ASCII, length=100 [100000 iterations]: 209938 108707 (-48.219475%)
> + 60% ASCII, length=100 [100000 iterations]: 248108 109260 (-55.962727%)
> + 50% ASCII, length=100 [100000 iterations]: 254467 121921 (-52.087696%)
> + 40% ASCII, length=100 [100000 iterations]: 285208 114461 (-59.867535%)
> +100% ASCII, length=1000 [10000 iterations]: 105570 1546 (-98.53557%)
> + 99% ASCII, length=1000 [10000 iterations]: 112052 87494 (-21.91661%)
> + 98% ASCII, length=1000 [10000 iterations]: 120597 77042 (-36.116154%)
> + 97% ASCII, length=1000 [10000 iterations]: 133759 75267 (-43.729393%)
> + 96% ASCII, length=1000 [10000 iterations]: 124279 76452 (-38.483574%)
> + 95% ASCII, length=1000 [10000 iterations]: 145278 76784 (-47.14685%)
> + 90% ASCII, length=1000 [10000 iterations]: 141478 81126 (-42.658222%)
> + 80% ASCII, length=1000 [10000 iterations]: 177988 89134 (-49.921345%)
> + 70% ASCII, length=1000 [10000 iterations]: 190698 99088 (-48.039307%)
> + 60% ASCII, length=1000 [10000 iterations]: 240096 108468 (-54.82307%)
> + 50% ASCII, length=1000 [10000 iterations]: 241091 113381 (-52.9717%)
> + 40% ASCII, length=1000 [10000 iterations]: 274307 113896 (-58.478638%)
> +100% ASCII, length=10000 [1000 iterations]: 116469 1521 (-98.69408%)
> + 99% ASCII, length=10000 [1000 iterations]: 122827 84726 (-31.020052%)
> + 98% ASCII, length=10000 [1000 iterations]: 125854 85905 (-31.742336%)
> + 97% ASCII, length=10000 [1000 iterations]: 144160 76104 (-47.208656%)
> + 96% ASCII, length=10000 [1000 iterations]: 149835 76644 (-48.847733%)
> + 95% ASCII, length=10000 [1000 iterations]: 149988 79170 (-47.21578%)
> + 90% ASCII, length=10000 [1000 iterations]: 143812 98798 (-31.300587%)
> + 80% ASCII, length=10000 [1000 iterations]: 188148 89944 (-52.19508%)
> + 70% ASCII, length=10000 [1000 iterations]: 214511 129084 (-39.824066%)
> + 60% ASCII, length=10000 [1000 iterations]: 240322 110871 (-53.865646%)
> + 50% ASCII, length=10000 [1000 iterations]: 237560 122167 (-48.574253%)
> + 40% ASCII, length=10000 [1000 iterations]: 272658 114349 (-58.061382%)
> +100% ASCII, length=1000000 [10 iterations]: 122355 3950 (-96.77169%)
> + 99% ASCII, length=1000000 [10 iterations]: 127108 70778 (-44.316643%)
> + 98% ASCII, length=1000000 [10 iterations]: 135022 80389 (-40.462296%)
> + 97% ASCII, length=1000000 [10 iterations]: 126778 72913 (-42.487656%)
> + 96% ASCII, length=1000000 [10 iterations]: 144430 74448 (-48.453922%)
> + 95% ASCII, length=1000000 [10 iterations]: 138535 78872 (-43.067097%)
> + 90% ASCII, length=1000000 [10 iterations]: 145037 77884 (-46.3006%)
> + 80% ASCII, length=1000000 [10 iterations]: 190233 89723 (-52.83521%)
> + 70% ASCII, length=1000000 [10 iterations]: 197363 95052 (-51.838997%)
> + 60% ASCII, length=1000000 [10 iterations]: 216470 115180 (-46.791702%)
> + 50% ASCII, length=1000000 [10 iterations]: 244138 108852 (-55.413742%)
> + 40% ASCII, length=1000000 [10 iterations]: 247799 123019 (-50.355328%)
> +|#
> diff --git a/src/code/misc-aliens.lisp b/src/code/misc-aliens.lisp
> index 985371e04..a1684d2b1 100644
> --- a/src/code/misc-aliens.lisp
> +++ b/src/code/misc-aliens.lisp
> @@ -69,6 +69,14 @@
>    (dest system-area-pointer)
>    (src system-area-pointer)
>    (n sb-unix::size-t))
> +;;; The overhead of Lisp may make the distinction between memmove() and memcpy()
> +;;; irrelevant, but we may as well promise that the ranges don't overlap when one
> +;;; of them is a freshly consed string, for example.
> +(declaim (inline memcpy))
> +(define-alien-routine ("memcpy" memcpy) system-area-pointer
> +  (dest system-area-pointer)
> +  (src system-area-pointer)
> +  (n sb-unix::size-t))
>
>  (defun copy-ub8-to-system-area (src src-offset dst dst-offset length)
>    (with-pinned-objects (src)
> diff --git a/src/code/target-unicode.lisp b/src/code/target-unicode.lisp
> index d7abd61fb..9ae0c833d 100644
> --- a/src/code/target-unicode.lisp
> +++ b/src/code/target-unicode.lisp
> @@ -21,7 +21,8 @@
>     grapheme-break-class word-break-class sentence-break-class graphemes
>     words sentences lines
>     unicode= unicode-equal unicode< unicode<= unicode> unicode>=
> -   confusable-p))
> +   confusable-p scalar-p
> +   utf8-decode-from-sap utf8-decode-from-octets))
>
>  (eval-when (:compile-toplevel :execute)
>    (defun lisp-expr-file-pathname (namestring)
> @@ -2005,6 +2006,179 @@ according to the IDNA confusableSummary.txt table"
>
>  (clear-info :function :compiler-macro-function 'proplist-p)
>
> +;;; Given the surprisingly large number of places the integers #xD800 and #xDFFF
> +;;; are expressed as literals I would have thought by now someone would have abstracted
> +;;; it out into surrogate-p or similar.  Maybe I'm just blind and we do have it?
> +;;; Anyway this is the opposite of a hypothetical surrogate-p predicate.
> +;;; Note that scalars -include- the characters which are NONCHARACTER but not surrogates.
> +(defun scalar-p (c) (or (< c #xD800) (and (>= c #xE000) (<= c #x10FFFF))))
> +
> +;;; A branch-free table to decide how long a utf8-encoded codepoint is in octets
> +;;; given its first octet. Because the 32-bit codegen requires untagged words here,
> +;;; it amusingly produces better assembly code than 64-bit which excessively shifts.
> +(declaim (inline utf8-encoded-len-from-leading-byte))
> +(defun utf8-encoded-len-from-leading-byte (octet)
> +  (declare (type (unsigned-byte 8) octet)
> +           (optimize (safety 0)))
> +  (macrolet ((magic (&aux (result 0))
> +               (dotimes (i 16 result)
> +                 (let ((bits (1- (aref #(1 1 1 1 1 1 1 1 1 1 1 1 2 2 3 4) i))))
> +                   (setq result (logior result (ash bits (* i 2))))))))
> +    (let ((high4 (ash octet -4)))
> +      (1+ (logand (ash (magic) (- (ash high4 1))) #b11)))))
> +
> +;;; To decode a 0-terminated UTF8 array of unknown length returning a Lisp string
> +;;; with maximal speed, preferring a result type of BASE-STRING when possible,
> +;;; and requiring there to be no decoding errors, this is the the way to do it.
> +;;; When processing data from external sources it wouldn't be the worst thing to use
> +;;; OCTETS-TO-STRING for its error checking, but when dealing with C APIs within
> +;;; your system, checking for decoding errors at each function call can
> +;;; cause a lot of unnecessary CPU cycles to be burnt.
> +;;; I didn't see an efficient technique to construct anything exactly equivalent
> +;;; to this function using other pre-existing functions.
> +(labels
> +    ((copy-to-char-string (sap length-in-octets nchars)
> +       (declare (sb-sys:system-area-pointer sap) (index length-in-octets nchars))
> +       (macrolet
> +           ;; This character decoder is taken from (one of several) UTF8->STRING
> +           ;; functions in enc-basic without any of the CRLF conversions.
> +           ;; The best solution - at least for #+(or arm64 x86-64) - would be to cons
> +           ;; a DX file buffer and call SIMD-COPY-UTF8-TO-CHARACTER-STRING on it.
> +           ((cref (n) `(sb-sys:sap-ref-8 sap ,n))
> +            (utf8-char@sap (bytes)
> +              `(ecase ,bytes
> +                 (1 (cref 0))
> +                 (2 (logior (ash (ldb (byte 5 0) (cref 0)) 6)
> +                            (ldb (byte 6 0) (cref 1))))
> +                 (3 (logior (ash (ldb (byte 4 0) (cref 0)) 12)
> +                            (ash (ldb (byte 6 0) (cref 1)) 6)
> +                            (ldb (byte 6 0) (cref 2))))
> +                 (4 (logior (ash (ldb (byte 3 0) (cref 0)) 18)
> +                            (ash (ldb (byte 6 0) (cref 1)) 12)
> +                            (ash (ldb (byte 6 0) (cref 2)) 6)
> +                            (ldb (byte 6 0) (cref 3)))))))
> +         (let ((string (make-array nchars :element-type 'character))
> +               (end-sap (sb-sys:sap+ sap length-in-octets))
> +               (char-index -1))
> +           (declare (sb-kernel:index-or-minus-1 char-index))
> +           (loop
> +            (let ((n (utf8-encoded-len-from-leading-byte (sb-sys:sap-ref-8 sap 0))))
> +              (setf (char string (incf char-index)) (code-char (utf8-char@sap n)))
> +              (when (sb-sys:sap>= (setf sap (sb-sys:sap+ sap n)) end-sap)
> +                (return string)))))))
> +     (copy-to-base-string (sap nchars)
> +       (if (= nchars 0)
> +           #.(coerce "" 'simple-base-string)
> +           (let ((string (make-array nchars :element-type 'base-char)))
> +             (sb-sys:with-pinned-objects (string)
> +               (sb-impl::memcpy (sb-sys:vector-sap string) sap nchars))
> +             string)))
> +     (any-extended-char-p (sap limit)
> +       ;; TODO: instead of looping over bytes, this should read exactly one word
> +       ;; and mask off the irrelevant bytes. Then compare to the mask of high bits.
> +       ;; To be pedantic there is the question of whether it is legal to read
> +       ;; the entire word preceding SAP and entire word following LIMIT.
> +       ;; The way to do it strictly observing the specified bounds is to purposely
> +       ;; do an unaligned read so that you gather a word of octets not to exceed
> +       ;; the stated bounds, as long as the CPU has no unaligned penalty. e.g.
> +       ;;  b | b | b | b | b | b | b | b | b | b
> +       ;;        |
> +       ;;        ^ aligned word boundary
> +       ;;    ^ specified start byte
> +       ;; An unaligned load which gathers up a word at the specified start is ok
> +       ;; provided that the specified end accomodates the entire word.
> +       ;; Looping takes less brain power to get right, so let's just do that.
> +       (declare (sb-sys:system-area-pointer sap limit))
> +       (loop
> +        (when (sb-sys:sap>= sap limit) (return nil))
> +        (when (logtest (sb-sys:sap-ref-8 sap 0) #x80) (return t))
> +        (setf sap (sb-sys:sap+ sap 1))))
> +     (any-extended-char-p/word (sap limit)
> +       (declare (sb-sys:system-area-pointer sap limit))
> +       (loop
> +        (when (sb-sys:sap>= sap limit) (return nil))
> +        (when (logtest (sb-sys:sap-ref-word sap 0)
> +                       #+64-bit #x8080808080808080 #-64-bit #x80808080)
> +          (return t))
> +        (setf sap (sb-sys:sap+ sap sb-vm:n-word-bytes))))
> +     (scan-between (sap limit &aux (length-in-chars 0) (start sap))
> +       (declare (sb-sys:system-area-pointer sap limit) (index length-in-chars))
> +       ;; Decode octets starting at SAP up to LIMIT. If an encoding sequence does not end
> +       ;; exactly at LIMIT, this is an error on the part of the caller. The returned string
> +       ;; will not contain the character involved in the overrun in that case.
> +       ;; But first, do a quick pass to test for presence of any non-BASE-CHAR.
> +       (flet ((sap-align-down (x)
> +                (sb-sys:int-sap (logandc2 (sb-sys:sap-int x) (1- sb-vm:n-word-bytes)))))
> +         (declare (inline sap-align-down))
> +         ;; When trying to use SB-INT:ALIGN-UP here, the compiler doesn't know that
> +         ;; the expression (+ value mask) should be treated modularly, and so it inserts
> +         ;; possible bignum arithmetic. Performing SAP+ avoids that.
> +         (let ((aligned-start (sap-align-down (sb-sys:sap+ sap (1- sb-vm:n-word-bytes))))
> +               (aligned-end (sap-align-down limit)))
> +           (unless (or (any-extended-char-p/word aligned-start aligned-end)
> +                       (any-extended-char-p sap aligned-start)
> +                       (any-extended-char-p aligned-end limit))
> +             (return-from scan-between
> +               (copy-to-base-string sap (sb-sys:sap- limit sap))))))
> +       (loop
> +        (let* ((n (utf8-encoded-len-from-leading-byte (sb-sys:sap-ref-8 sap 0)))
> +               (next (sb-sys:sap+ sap n)))
> +          (when (sb-sys:sap>= next limit)
> +            (when (sb-sys:sap= next limit) (incf length-in-chars) (setq sap next))
> +            (return))
> +          (incf length-in-chars)
> +          (setq sap next)))
> +       (copy-to-char-string start (sb-sys:sap- sap start) length-in-chars)))
> +
> +  (defun utf8-decode-from-sap (sap &optional (count nil count-supplied)
> +                               &aux (length-in-chars 0) (start sap))
> +    (declare (sb-sys:system-area-pointer sap) (index length-in-chars))
> +    (if count-supplied
> +        ;; The counted mode of operation allows embedded #\nul
> +        (if (zerop (the index count))
> +            #.(coerce "" 'simple-base-string)
> +            (scan-between sap (sb-sys:sap+ sap count)))
> +        ;; The uncounted mode of operation decodes until reaching a #\nul
> +        (loop
> +         (let ((octet (sb-sys:sap-ref-8 sap 0)))
> +           (when (= octet 0)
> +             (let ((bytes (sb-sys:sap- sap start)))
> +               (return (if (> bytes length-in-chars)
> +                           (copy-to-char-string start bytes length-in-chars)
> +                           (copy-to-base-string start length-in-chars)))))
> +           (setq sap (sb-sys:sap+ sap (utf8-encoded-len-from-leading-byte octet)))
> +           (incf length-in-chars)))))
> +
> +  (defun utf8-decode-from-octets (ub8-vector)
> +    ;; possibly use with-array-data here to allow non-simple array?
> +    (declare ((simple-array (unsigned-byte 8) 1) ub8-vector))
> +    (sb-sys:with-pinned-objects (ub8-vector)
> +      (let ((sap (sb-sys:vector-sap ub8-vector)))
> +        (scan-between sap (sb-sys:sap+ sap (length ub8-vector)))))))
> +
> +;; Compare UTF8-ENCODED-LEN-FROM-LEADING-BYTE to SB-IMPL::BYTES-FOR-CHAR/UTF-8/LF
> +;; the former one getting shaken out of the resulting core file.
> +#+sb-unicode
> +(let ((s (make-string 1))
> +      (replacement #.(coerce '(0) '(simple-array (unsigned-byte 8) (*)))))
> +  (dotimes (c char-code-limit)
> +    ;; An octet array of just 1 null looks to utf8-decode-from-sap like the empty string,
> +    ;; as it should. It would need to be a counted octet string to decode as codepoint 0.
> +    (when (and (scalar-p c) (> c 0))
> +      (setf (char s 0) (code-char c))
> +      (let* ((result (sb-impl::string->utf8 s 0 1 0 replacement))
> +             (firstbyte (aref result 0))
> +             (octet-len-expected (sb-impl::bytes-for-char/utf-8/lf (code-char c)))
> +             (octet-len (utf8-encoded-len-from-leading-byte firstbyte)))
> +        (when (or (/= octet-len octet-len-expected) (/= octet-len (length result)))
> +          (error "~S is messed up at ~x" 'utf8-encoded-len-from-leading-byte c))
> +        (let ((terminated-result (sb-impl::string->utf8 s 0 1 1 replacement)))
> +          (aver (= (length terminated-result) (1+ octet-len)))
> +          (let ((decoded (sb-sys:with-pinned-objects (terminated-result)
> +                           (utf8-decode-from-sap (sb-sys:vector-sap terminated-result)))))
> +            (aver (string= decoded s))
> +            (when (< c 128) (aver (sb-kernel:simple-base-string-p decoded)))))))))
> +
>  #|
>  ;;; For offline use.
>  ;;; This could insert a call to MIX if it found nothing that worked.
> diff --git a/tests/utf-8.pure.lisp b/tests/utf-8.pure.lisp
> index 98be11f0e..c250e60b1 100644
> --- a/tests/utf-8.pure.lisp
> +++ b/tests/utf-8.pure.lisp
> @@ -428,3 +428,37 @@
>                               else if (= i 24) do (incf pos 2)
>                               else do (incf pos 1))))))))
>  (delete-file *test-path*)
> +
> +#+sb-unicode
> +(defun random-string (stringlen percent-ascii &aux (unicode (- 100 percent-ascii)))
> +  (let ((s (make-string stringlen)))
> +    (dotimes (i stringlen s)
> +      (setf (char s i)
> +            (code-char (if (< (random 100.0) unicode)
> +                           (max #xE000 (random char-code-limit))
> +                           (max 1 (random 128))))))))
> +
> +(with-test (:name :optimized-utf8-decoder
> +                  :skipped-on (:not :sb-unicode))
> +  ;; some tests need 100% ascii so that it hits the special case for base-string
> +  (dolist (percent-ascii '(100 50 10))
> +    (dotimes (i 1000)
> +      (let* ((string (random-string (random 1000) percent-ascii))
> +             (octets (string-to-octets string :null-terminate t))
> +             (readback1
> +              (sb-ext:octets-to-string octets :end (1- (length octets))))
> +             (readback2
> +              (sb-sys:with-pinned-objects (octets)
> +                (sb-unicode:utf8-decode-from-sap (sb-sys:vector-sap octets))))
> +             (readback3
> +              ;; doesn't take END or a displaaced string. It could, but if you need
> +              ;; such capability, the SAP interface will do.
> +              (sb-unicode:utf8-decode-from-octets
> +               (subseq octets 0 (1- (length octets))))))
> +        (when (= percent-ascii 100)
> +          (assert (not (sb-kernel:simple-base-string-p readback1)))
> +          (assert (sb-kernel:simple-base-string-p readback2))
> +          (assert (sb-kernel:simple-base-string-p readback3)))
> +        (assert (string= string readback1))
> +        (assert (string= string readback2))
> +        (assert (string= string readback3))))))
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits


_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits