master: Fix interpreted calls to c-string-to-string

stassats via Sbcl-commits <[email protected]> Wed, 17 Jun 2026 20:42:10 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  7ee71e8a92f54be5767ccb4a5331effa18ac5f19 (commit)
      from  ff7e3a1ca6c945b467d8f6854d8ec92dd6330257 (commit)

- Log -----------------------------------------------------------------
commit 7ee71e8a92f54be5767ccb4a5331effa18ac5f19
Author: Stas Boukarev <[email protected]>
Date:   Wed Jun 17 18:35:12 2026 +0300

    Fix interpreted calls to c-string-to-string
---
 src/code/c-call.lisp      |  4 +++-
 src/code/fd-stream.lisp   |  3 +++
 src/compiler/ir1util.lisp |  4 +++-
 tests/alien.impure.lisp   | 14 +++++++-------
 4 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/src/code/c-call.lisp b/src/code/c-call.lisp
index 67c130576..df135166d 100644
--- a/src/code/c-call.lisp
+++ b/src/code/c-call.lisp
@@ -99,7 +99,9 @@
        ;; If we need to check for non-ascii data in the input, we
        ;; might as well go through the usual external-format machinery
        ;; instead of rewriting another version of it.
-       ,(let ((conv `(c-string-to-string
+       ,(let ((conv `(,(if (sb-c::compiling-p)
+                           'c-string-to-string
+                           'c-string-to-string-boxed-sap)
                       ,alien
                       (c-string-external-format ,type)
                       ',(alien-c-string-type-element-type type))))
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index ba912e8e2..7616f3d03 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -934,6 +934,9 @@
         (let ((external-format (get-external-format-or-lose external-format)))
           (funcall (ef-read-c-string-fun external-format) sap element-type)))))
 
+(defun sb-alien::c-string-to-string-boxed-sap (sap external-format element-type)
+  (sb-alien::c-string-to-string sap external-format element-type))
+
 (defun get-external-format-or-lose (external-format)
   (or (get-external-format external-format)
       (error "Undefined external-format: ~S" external-format)))
diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index a19c6d913..d1803df15 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -4054,7 +4054,9 @@ is :ANY, the function name is not checked."
                 *lexenv*)))
     t))
 
-(defun compiling-p (environment)
+(defun compiling-p (&optional (environment
+                               (and (boundp '*lexenv*)
+                                    (symbol-value '*lexenv*))))
   (and (boundp 'sb-c:*compilation*)
        environment
        #+sb-fasteval
diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index c431ae522..d227021be 100644
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -373,8 +373,8 @@
            (let ((c-string (coerce #(70 111 195 182 0)
                                    '(vector (unsigned-byte 8)))))
              (sb-sys:with-pinned-objects (c-string)
-               (sb-alien::c-string-to-string (sb-sys:vector-sap c-string)
-                                             :ascii 'character)))
+               (sb-alien::c-string-to-string-boxed-sap (sb-sys:vector-sap c-string)
+                                                       :ascii 'character)))
          (sb-int:c-string-decoding-error (e)
            (assert (equalp #(195) (sb-int:character-decoding-error-octets e)))
            :unibyte))))
@@ -390,8 +390,8 @@
            (let ((c-string (coerce #(70 111 246 0 0 0)
                                    '(vector (unsigned-byte 8)))))
              (sb-sys:with-pinned-objects (c-string)
-               (sb-alien::c-string-to-string (sb-sys:vector-sap c-string)
-                                             :utf-8 'character)))
+               (sb-alien::c-string-to-string-boxed-sap (sb-sys:vector-sap c-string)
+                                                       :utf-8 'character)))
          (sb-int:c-string-decoding-error (e)
            (assert (equalp #(246 0 0 0)
                            (sb-int:character-decoding-error-octets e)))
@@ -401,8 +401,8 @@
        (handler-case
            (let ((c-string (coerce #(70 195 1 182 195 182 0) '(vector (unsigned-byte 8)))))
              (sb-sys:with-pinned-objects (c-string)
-               (sb-alien::c-string-to-string (sb-sys:vector-sap c-string)
-                                             :utf-8 'character)))
+               (sb-alien::c-string-to-string-boxed-sap (sb-sys:vector-sap c-string)
+                                                       :utf-8 'character)))
          (sb-int:c-string-decoding-error (e)
            (assert (equalp #(195 1)
                            (sb-int:character-decoding-error-octets e)))
@@ -427,7 +427,7 @@
                                      (let ((c-string (coerce #(70 195 1 182 195 182 0)
                                                              '(vector (unsigned-byte 8)))))
                                        (sb-sys:with-pinned-objects (c-string)
-                                         (sb-alien::c-string-to-string
+                                         (sb-alien::c-string-to-string-boxed-sap
                                           (sb-sys:vector-sap c-string)
                                           :utf-8 'character)))))))
                   (let ((namestring (scratch-file-name)))

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


hooks/post-receive
-- 
SBCL