master: Make sb-int:misc-index foldable, flushable

stassats via Sbcl-commits <[email protected]> Mon, 29 Jun 2026 14:16:10 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  ca75aca96aed5e9fe016b20758ffa9e5df6b56fe (commit)
      from  ab6fa917964ce12db804b746ccba8ad7a9067e05 (commit)

- Log -----------------------------------------------------------------
commit ca75aca96aed5e9fe016b20758ffa9e5df6b56fe
Author: Stas Boukarev <[email protected]>
Date:   Mon Jun 29 17:14:19 2026 +0300

    Make sb-int:misc-index foldable, flushable
---
 doc/manual/beyond-ansi.texinfo    | 2 +-
 doc/manual/compiler.texinfo       | 2 +-
 src/code/target-char.lisp         | 8 ++++----
 src/compiler/generic/genesis.lisp | 2 +-
 4 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo
index 8f2d8466f..4f21d2fa2 100644
--- a/doc/manual/beyond-ansi.texinfo
+++ b/doc/manual/beyond-ansi.texinfo
@@ -664,7 +664,7 @@ For structures:
 
 @item @code{slot-value} and @code{slot-boundp} function as expected, including (for
   @code{slot-value}) calling and respecting the return value of
-  @code{slot-unbound} if the slot is unbound; 
+  @code{slot-unbound} if the slot is unbound;
 
 @item @code{(setf slot-value)} functions as expected, including performing
   type checks to verify that the new value is of an appropriate type
diff --git a/doc/manual/compiler.texinfo b/doc/manual/compiler.texinfo
index e3afe66ef..0ab8479b0 100644
--- a/doc/manual/compiler.texinfo
+++ b/doc/manual/compiler.texinfo
@@ -393,7 +393,7 @@ Note that @code{do} appears in the processing path. This is because
 @cindex macroexpansion
 @cindex source transform
 The rest of the processing path results from the macroexpansion of
-@code{do}: 
+@code{do}:
 
 @example
 (block nil
diff --git a/src/code/target-char.lisp b/src/code/target-char.lisp
index cbe7532ff..ebf092389 100644
--- a/src/code/target-char.lisp
+++ b/src/code/target-char.lisp
@@ -214,16 +214,16 @@
 ;;; Primary composition information is stored in a hash table local to
 ;;; PRIMARY-COMPOSITION, with (+ (ash codepoint1 21) codepoint2) as
 ;;; keys and the composition as the value
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (sb-c:defknown misc-index (character) (integer 0 #.(- (length sb-unicode::+character-misc-database+) +misc-width+))
+      (sb-c:foldable sb-c:flushable sb-c::no-verify-arg-count)
+    :overwrite-fndb-silently t))
 
 (defun misc-index (char)
   (misc-index-from-char-code (char-code char)
                              sb-unicode::+character-high-pages+
                              sb-unicode::+character-low-pages+))
 
-(aver (csubtypep (global-ftype 'misc-index)
-                 (specifier-type '(sfunction (t) (unsigned-byte 16)))))
-(proclaim `(ftype ,(type-specifier (global-ftype 'misc-index)) misc-index))
-
 (declaim (ftype (sfunction (t) (unsigned-byte 8)) ucd-general-category)
          (inline ucd-general-category))
 (defun ucd-general-category (char)
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index bbe38acfe..fc18e88b9 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -2236,7 +2236,7 @@ core and return a descriptor to it."
                 (if (symbolp name) (cold-intern name) name))))
     (let ((existing (read-wordindexed fdefn sb-vm:fdefn-fun-slot)))
       (unless (or (cold-null existing) (descriptor= existing function))
-        (error "Function multiply defined: ~S. Was ~x is ~x" name
+        (cerror "Overwrite" "Function multiply defined: ~S. Was ~x is ~x" name
                  (descriptor-bits existing)
                  (descriptor-bits function))))
     (write-wordindexed fdefn sb-vm:fdefn-fun-slot function)

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


hooks/post-receive
-- 
SBCL