diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index a242ad9fe..d6de83dee 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -203,14 +203,27 @@ possible.") ;; And who knows what the host considers "simple". #-sb-xc-host (not simple-array))) +(defun hash-list-of-symbols (list) ; or "nonexternalizably-hash-..." + ;; We don't emulate sb-xc:sxhash thoroughly enough to hash compound names + ;; (lists are rejected) but it doesn't actually matter what the hash is + ;; for duplicate name detection. + #+sb-xc-host (cl:sxhash list) + ;; SXHASH requires symbols whose print-names are the same to hash the same. + ;; That's not a requirement of the fun-name-hashset, so use SYMBOL-HASH here + ;; which contains 10 pseudorandom bits if 64-bit word size, fewer if 32-bit. + ;; If someone using 32-bit SBCL complains, we can mix in PACKAGE-ID too. + #-sb-xc-host + (named-let recurse ((x list)) + (typecase x + (symbol (symbol-hash x)) + ;; sure this could be made iterative, but the lists in question are short + (cons (mix (recurse (car x)) (recurse (cdr x)))) + (t (sxhash x))))) ; nonstandard function name, oh well (string?) + (defun make-fun-name-hashset () (make-hashset 32 (lambda (a b) (or (eq a b) (and (consp a) (consp b) (equal a b)))) - ;; We don't emulate sb-xc:sxhash thoroughly enough to hash compound names - ;; (lists are rejected) but it doesn't actually matter what the hash is - ;; for duplicate name detection. - #+sb-xc-host #'cl:sxhash - #-sb-xc-host #'sxhash)) + #'hash-list-of-symbols)) (defstruct (compilation (:constructor make-compilation (&optional msan-unpoison diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index e88ae33b7..e1baf1be3 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -50,7 +50,8 @@ ;;; Used for interning parts of SLOT-NAME-LISTS, as part of ;;; PV-TABLE interning -- just to save space. -(define-load-time-global *slot-name-lists* (make-hashset 64 #'list-elts-eq #'sxhash)) +(define-load-time-global *slot-name-lists* + (make-hashset 64 #'list-elts-eq #'sb-c::hash-list-of-symbols)) ;;; Used for interning PV-TABLES, keyed by the SLOT-NAME-LISTS ;;; used. diff --git a/tests/hashset.impure.lisp b/tests/hashset.impure.lisp new file mode 100644 index 000000000..df95d30ab --- /dev/null +++ b/tests/hashset.impure.lisp @@ -0,0 +1,9 @@ +(with-test (:name :many-packages) ; was blowing up in fun-name-hashset + (with-scratch-file (sourcefile "lisp") + (with-open-file (out sourcefile :direction :output) + (dotimes (i 1200) + (format out "(defpackage #:pkg~d (:use #:cl)) +(in-package #:pkg~d) +(defun initme () ~d)~%" i i i))) + (with-scratch-file (fasl "fasl") + (compile-file sourcefile :output-file fasl))))