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