common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Make sb-int:misc-index foldable, flushable

Browse source
This commit is contained in:
Stas Boukarev 2026-06-29 17:14:19 +03:00
parent ab6fa91796
commit ca75aca96a
4 changed files with 7 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/code/target-char.lisp
View file

@ -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)

2
src/compiler/generic/genesis.lisp
View file

@ -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)