;;; This file is impure NOT because of its effects, but because of effects upon it
;;; from other tests- I don't want the type caches to have many extra lines
;;; in them at the start of the test.

(import '(sb-impl::hashset-storage
          sb-impl::hashset-hash-function
          sb-impl::hashset-test-function
          sb-impl::hss-cells
          sb-impl::hss-hash-vector
          sb-impl::hss-psl-vector))

(defun hs-cells-mask (v) (- (length v) 4))
(defun hs-chain-terminator-p (x) (eq x 0))

(defun hashset-probing-sequence (hashset key)
  (let* ((storage (hashset-storage hashset))
         (cells (hss-cells storage))
         (mask (hs-cells-mask cells))
         (index (logand (funcall (hashset-hash-function hashset) key) mask))
         (interval 1)
         (sequence))
    (loop
     (push index sequence)
     (let ((probed-key (aref cells index)))
       (assert (not (hs-chain-terminator-p probed-key)))
       (when (and probed-key (funcall (hashset-test-function hashset) probed-key key))
         (return (nreverse sequence)))
       (setq index (logand (+ index interval) mask))
       (incf interval)))))

(defun compute-max-psl (hashset)
  (reduce #'max (hss-psl-vector (hashset-storage hashset))))

(defun debug-probing (hashset &optional (detail t))
  (let* ((storage (hashset-storage hashset))
         (cells (hss-cells storage))
         (psl (hss-psl-vector storage))
         (mask (hs-cells-mask cells))
         (histo (make-array 12 :initial-element 0)) ; should be enough for anyone
         (n-elts 0)
         (sum-psl 0)
         (*print-pretty* nil))
    (format t "Mask=~X, maxPSL=~D~%" mask (compute-max-psl hashset))
    (dotimes (i (1+ mask))
      (let ((key (aref cells i)))
        (unless (or (null key) (hs-chain-terminator-p key))
          (let* ((seq (hashset-probing-sequence hashset key))
                 (actual (length seq)))
            (assert (= actual (aref psl i)))
            (when detail (format t "~45a ~s~%" seq (sb-kernel:type-specifier key)))
            (incf (aref histo (1- actual)))
            (incf n-elts)
            (incf sum-psl actual)))))
    (format t "Histogram:")
    (dotimes (i 12 (terpri)) (format t "~5d" (1+ i)))
    (format t "          ")
    (dotimes (i 12 (terpri)) (format t "~5d" (aref histo i)))
    (format t "Avg=~F~%" (/ sum-psl n-elts))))

(with-test (:name :exactly-one-null-type-instance)
  (let ((null-instances))
    (dolist (x (sb-vm:list-allocated-objects :all :test #'sb-kernel:member-type-p))
      (let ((m (sb-kernel:member-type-members x)))
        (when (and (sb-int:singleton-p m)
                   (eq nil (car m)))
          (push x null-instances))))
    (assert (sb-int:singleton-p null-instances))))

(defparameter *allstrings*
  (map 'vector #'string
       (remove 0 (sb-impl::symtbl-cells
                  (sb-impl::package-internal-symbols
                   (find-package "SB-C"))))))

(with-test (:name :member-type-hash-mixer)
  ;; not really a test of the mixer, just that we don't try
  ;; to hash-cons and then blow up on MEMBER types that contain
  ;; other than numbers and symbols.
  (let ((nstrings (length *allstrings*))
        (foo 0))
    (dotimes (i 10000)
      (let ((n (+ 2 (random 10)))
            (strings))
        (dotimes (i n)
          (push (elt *allstrings* (random nstrings)) strings))
        (let ((spec `(member ,@strings)))
          (when (typep (elt *allstrings* (random nstrings)) spec)
            (incf foo)))))))

(defvar *specifiers* '(
(ARRAY * (0 0 0 0 0 0 0 0))
(SIMPLE-BIT-VECTOR 16)
(ARRAY * (0 0 0 0 0))
(SIMPLE-BIT-VECTOR 5)
(BIT-VECTOR 0)
(SIMPLE-ARRAY (UNSIGNED-BYTE 7) (10))
(SIMPLE-ARRAY (UNSIGNED-BYTE 32) (10))
(SIMPLE-VECTOR 25)
(ARRAY * (0 0 0 0 * 0 0 0))
(VECTOR T 0)
(SIMPLE-ARRAY (UNSIGNED-BYTE 16) (6))
(ARRAY T (0 0 *))
(SIMPLE-ARRAY SINGLE-FLOAT (5))
(ARRAY * (0 0 0 0 0 * 0 0))
(VECTOR * 0)
(SIMPLE-ARRAY (UNSIGNED-BYTE 31) (4))
(SIMPLE-ARRAY FIXNUM (2))
(ARRAY T (2 2 2))
(ARRAY * (0 0 0 0 0 0 * 0))
(ARRAY T (0 * 0 0))
(ARRAY T (2 2))
(SIMPLE-ARRAY * (* 3))
(ARRAY T (0 * 0))
(ARRAY * (0 0 0 0 0 0 0 *))
(VECTOR SYMBOL 5)
(SIMPLE-ARRAY NIL (0))
(SIMPLE-ARRAY SYMBOL (*))
(SIMPLE-ARRAY T (0 0 0))
(SIMPLE-ARRAY FIXNUM NIL)
(VECTOR * 10)
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2 2 2 2 2))
(SIMPLE-ARRAY BIT NIL)
(SIMPLE-ARRAY T (3 4))
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2 2 2 2 2 2))
(VECTOR T 4)
(ARRAY * (0 0 0 0 0 0 0 0 0))
(SIMPLE-ARRAY CHARACTER (95))
(ARRAY * (* 0 0 0))
(ARRAY T (* * * *))
(ARRAY * (0 0 0 0 * 0 0 0 0))
(SIMPLE-ARRAY (SIGNED-BYTE 8) NIL)
(VECTOR T 3)
(ARRAY * (* 2))
(SIMPLE-ARRAY FIXNUM (2 2 2 2 2 2 2))
(ARRAY T (* *))
(ARRAY * (0 0 0 0 0 * 0 0 0))
(SIMPLE-ARRAY T (0 0))
(ARRAY * (* *))
(SIMPLE-ARRAY * (* 2))
(SIMPLE-VECTOR 512)
(SIMPLE-ARRAY CHARACTER (0))
(BIT-VECTOR 5)
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2))
(SIMPLE-VECTOR 256)
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2 2))
(ARRAY * (0 0 0 0 0 0 * 0 0))
(SIMPLE-ARRAY T (0 0 0 0 0 0))
(VECTOR * 8)
(ARRAY T (* 0))
(SIMPLE-ARRAY T (0 0 0 0 0 0 0))
(SIMPLE-ARRAY T (0 0 0 0 0 0 0 0))
(SIMPLE-VECTOR 2)
(ARRAY * (0 0 0 0 0 0 0 * 0))
(SIMPLE-ARRAY T (0 0 0 0 0))
(SIMPLE-ARRAY (UNSIGNED-BYTE 4) (10))
(SIMPLE-ARRAY (SIGNED-BYTE 64) (10))
(SIMPLE-ARRAY FIXNUM (10))
(SIMPLE-ARRAY BIT (2 2 2))
(ARRAY T (* 3))
(ARRAY * (0 0 0 0 0 0 0 0 *))
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2 2 2))
(SIMPLE-ARRAY T (4 10))
(ARRAY T (2 3))
(SIMPLE-ARRAY (UNSIGNED-BYTE 15) (10))
(SIMPLE-ARRAY T (* *))
(ARRAY * (0 * 0 0))
(ARRAY T (0 0))
(SIMPLE-ARRAY * (3))
(SIMPLE-ARRAY (SIGNED-BYTE 8) (10))
(SIMPLE-ARRAY T (0 0 0 0))
(SIMPLE-ARRAY T (2 2 2 2))
(SIMPLE-ARRAY CHARACTER (5))
(SIMPLE-ARRAY * NIL)
(SIMPLE-ARRAY (UNSIGNED-BYTE 16) (10))
(SIMPLE-ARRAY T (2 2 2 2 2))
(SIMPLE-BASE-STRING 3)
(SIMPLE-ARRAY T (3 *))
(SIMPLE-ARRAY (UNSIGNED-BYTE 32) (4))
(SIMPLE-BIT-VECTOR 0)
(VECTOR CHARACTER 4)
(ARRAY * (0 0 * 0 0))
(ARRAY * (0 0 * 0 0 0))
(SIMPLE-ARRAY CHARACTER (1))
(ARRAY * (0 0 * 0 0 0 0))
(ARRAY T (0 * 0 0 0))
(ARRAY * (0 0 * 0 0 0 0 0))
(ARRAY T (0 * 0 0 0 0 0))
(ARRAY * (0 0 * 0 0 0 0 0 0))
(ARRAY T (0 * 0 0 0 0 0 0))
(ARRAY T (0 0 * 0))
(SIMPLE-ARRAY (UNSIGNED-BYTE 64) (10))
(ARRAY T (0 * 0 0 0 0))
(SIMPLE-ARRAY CHARACTER (2 2))
(SIMPLE-BASE-STRING 10)
(SIMPLE-ARRAY T (* * * *))
(ARRAY T (0 * 0 0 0 0 0 0 0))
(SIMPLE-ARRAY * (5))
(SIMPLE-BIT-VECTOR 128)
(SIMPLE-ARRAY CHARACTER NIL)
(ARRAY * (3 4))
(SIMPLE-ARRAY (UNSIGNED-BYTE 62) (1))
(ARRAY * (2 *))
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2))
(ARRAY T (3 2))
(ARRAY T (0 0 0 0))
(SIMPLE-ARRAY CHARACTER (4))
(SIMPLE-VECTOR 28)
(ARRAY * (0 0 0 0))
(SIMPLE-ARRAY T (* 2))
(SIMPLE-ARRAY SYMBOL (5))
(ARRAY SYMBOL)
(SIMPLE-ARRAY FIXNUM (2 2 2 2))
(ARRAY * NIL)
(SIMPLE-ARRAY * (0 0 0))
(SIMPLE-ARRAY T (2 *))
(ARRAY * (3 *))
(ARRAY T (* * *))
(SIMPLE-BIT-VECTOR 2)
(ARRAY * (3 2))
(SIMPLE-ARRAY BASE-CHAR NIL)
(ARRAY T (3 *))
(ARRAY * (* 0))
(ARRAY T (0 0 0 0 0))
(ARRAY T (0 0 0 0 *))
(ARRAY T (0 0 0 0 0 0))
(ARRAY T (0 0 0 0 * 0))
(ARRAY T (0 0 0 0 0 *))
(ARRAY T (0 0 0 0 0 0 0))
(SIMPLE-ARRAY CHARACTER (2 2 2 2 2 2 2))
(SIMPLE-ARRAY BIT (2 2 2 2 2))
(SIMPLE-ARRAY BIT (2 2 2 2 2 2 2))
(SIMPLE-BIT-VECTOR 10)
(ARRAY T (0 0 0 0 * 0 0))
(ARRAY BIT NIL)
(SIMPLE-ARRAY (UNSIGNED-BYTE 2) (128))
(SIMPLE-ARRAY * (0 0))
(SIMPLE-ARRAY * (1))
(SIMPLE-ARRAY CHARACTER (100000))
(ARRAY T (0 0 0 0 0 * 0))
(SIMPLE-ARRAY CHARACTER (256))
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2 2 2 2 2 2))
(SIMPLE-ARRAY BIT (2 2 2 2))
(SIMPLE-VECTOR 6)
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2 2 2 2))
(SIMPLE-ARRAY CHARACTER (10))
(ARRAY * (0 0 0 *))
(ARRAY T (0 0 0 0 0 0 *))
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2 2 2 2 2))
(SIMPLE-VECTOR 1)
(VECTOR T 1)
(BASE-STRING 10)
(AND ARRAY (NOT SIMPLE-ARRAY))
(ARRAY * (0 0 0 * 0 0))
(ARRAY T (0 0 0 0 0 0 0 0))
(SIMPLE-ARRAY * (0 0 0 0 0))
(ARRAY * (0 0 0 * 0))
(SIMPLE-ARRAY * (0 0 0 0 0 0))
(SIMPLE-ARRAY BASE-CHAR (2 2 2 2 2))
(ARRAY * (0 0 0 * 0 0 0))
(SIMPLE-ARRAY * (0 0 0 0 0 0 0))
(SIMPLE-ARRAY BASE-CHAR (2 2 2 2 2 2))
(ARRAY T (0 0 0 0 * 0 0 0))
(ARRAY * (0 0 0 * 0 0 0 0))
(SIMPLE-ARRAY T (* * *))
(ARRAY * (* 0 0))
(SIMPLE-ARRAY BASE-CHAR (2 2 2 2 2 2 2))
(SIMPLE-ARRAY * (0 0 0 0 0 0 0 0))
(ARRAY * (0 0 0 * 0 0 0 0 0))
(ARRAY * (0 * 0))
(ARRAY T (0 0 0 0 0 * 0 0))
(SIMPLE-VECTOR 3)
(SIMPLE-ARRAY (SIGNED-BYTE 16) (10))
(ARRAY T (* 4))
(SIMPLE-ARRAY * (0))
(ARRAY * (0 0 *))
(VECTOR SYMBOL)
(VECTOR * 5)
(SIMPLE-ARRAY CHARACTER (6))
(ARRAY T (* 0 0 0 0))
(ARRAY T (0 *))
(ARRAY T (0 0 0 0 0 0 * 0))
(ARRAY T (* * * * *))
(ARRAY T (* * * * * *))
(ARRAY T (* 0 0 0 0 0 0))
(ARRAY T (* * * * * * *))
(SIMPLE-ARRAY SYMBOL)
(ARRAY T (* 0 0 0 0 0 0 0))
(ARRAY T (* 0 0 0))
(SIMPLE-ARRAY * (3 2))
(ARRAY T (* * * * * * * *))
(ARRAY T (* 0 0 0 0 0))
(ARRAY T (0 0 0 0 0 0 0 *))
(SIMPLE-BASE-STRING 2)
(SIMPLE-VECTOR 64)
(ARRAY T (* * * * * * * * *))
(SIMPLE-ARRAY * (0 0 0 0))
(ARRAY T (* 0 0 0 0 0 0 0 0))
(VECTOR CHARACTER 10)
(SIMPLE-ARRAY T (3 2))
(SIMPLE-ARRAY * (* *))
(BIT-VECTOR 10)
(SIMPLE-ARRAY BASE-CHAR (2 2 2))
(ARRAY T (0 0 0 0 0 0 0 0 0))
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2))
(ARRAY T (0 0 * 0 0))
(ARRAY T (0 0 * 0 0 0))
(VECTOR * 3)
(ARRAY T (0 0 * 0 0 0 0))
(ARRAY * (0 0))
(ARRAY * (* 0 0 0 0 0))
(ARRAY T (0 0 * 0 0 0 0 0))
(ARRAY * (* 0 0 0 0))
(SIMPLE-ARRAY * (2 *))
(SIMPLE-ARRAY * (3 4))
(ARRAY T (0 0 * 0 0 0 0 0 0))
(SIMPLE-ARRAY FIXNUM (2 2))
(ARRAY T (0 0 0 0 * 0 0 0 0))
(ARRAY * (* 0 0 0 0 0 0 0))
(SIMPLE-ARRAY * (2))
(SIMPLE-ARRAY T (* * * * *))
(SIMPLE-ARRAY FUNCTION (256))
(ARRAY * (2 3))
(ARRAY * (* 0 0 0 0 0 0 0 0))
(ARRAY * (0 *))
(ARRAY T NIL)
(SIMPLE-ARRAY T (* * * * * *))
(SIMPLE-VECTOR 1024)
(ARRAY * (* 0 0 0 0 0 0))
(SIMPLE-VECTOR 37)
(SIMPLE-VECTOR 4)
(SIMPLE-ARRAY T (* * * * * * * *))
(ARRAY T (0 0 0 0 0 * 0 0 0))
(ARRAY T (0 0 0 *))
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) NIL)
(SIMPLE-ARRAY CHARACTER (2))
(SIMPLE-ARRAY T (* * * * * * *))
(VECTOR T 2)
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2 2 2))
(SIMPLE-ARRAY * (10))
(VECTOR T 10)
(SIMPLE-ARRAY (UNSIGNED-BYTE 63) (10))
(ARRAY T (3 4))
(SIMPLE-VECTOR 32)
(SIMPLE-ARRAY * (8))
(ARRAY * (0 * 0 0 0))
(ARRAY T (* 0 0))
(ARRAY T (0 0 0 0 0 0 * 0 0))
(SIMPLE-BIT-VECTOR 64)
(ARRAY * (0 * 0 0 0 0 0))
(ARRAY * (* 3))
(SIMPLE-ARRAY (UNSIGNED-BYTE 62) (10))
(SIMPLE-ARRAY T (* 3))
(ARRAY * (0 * 0 0 0 0 0 0))
(SIMPLE-ARRAY * (2 3))
(SIMPLE-VECTOR 0)
(ARRAY T (0 0 0 * 0))
(SIMPLE-VECTOR 128)
(ARRAY * (0 * 0 0 0 0 0 0 0))
(ARRAY * (0 0 * 0))
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (8))
(SIMPLE-ARRAY (SIGNED-BYTE 32) (10))
(ARRAY T (0 0 0 * 0 0))
(ARRAY T (2 2 2 2 2 2 2))
(ARRAY T (0 0 0 0 0 0 0 * 0))
(SIMPLE-ARRAY DOUBLE-FLOAT (5))
(ARRAY T (2 2 2 2 2 2))
(SIMPLE-ARRAY CHARACTER (3))
(ARRAY T (0 0 0 * 0 0 0))
(ARRAY T (* 2))
(ARRAY * (0 * 0 0 0 0))
(SIMPLE-ARRAY (UNSIGNED-BYTE 31) (10))
(SIMPLE-VECTOR 2048)
(SIMPLE-ARRAY T NIL)
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2))
(ARRAY T (0 0 0 * 0 0 0 0))
(VECTOR * 1)
(ARRAY T (0 0 0))
(SIMPLE-ARRAY (UNSIGNED-BYTE 2) (10))
(ARRAY * (0 0 0 0 *))
(ARRAY * (0 0 0 0 0 0))
(ARRAY T (0 0 0 * 0 0 0 0 0))
(ARRAY * (0 0 0 0 * 0))
(SIMPLE-ARRAY * (4))
(VECTOR (UNSIGNED-BYTE 8) 8)
(ARRAY * (0 0 0 0 0 *))
(ARRAY * (0 0 0 0 0 0 0))
(SIMPLE-ARRAY T (2 3))
(VECTOR * 2)
(ARRAY * (0 0 0))
(ARRAY * (0 0 0 0 * 0 0))
(SIMPLE-ARRAY * (3 *))
(ARRAY * (* 4))
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (10))
(ARRAY * (0 0 0 0 0 * 0))
(ARRAY T (2 *))
(SIMPLE-VECTOR 10)
(VECTOR * 4)
(ARRAY * (0 0 0 0 0 0 *))
(SIMPLE-VECTOR 62)
))

(with-test (:name :array-type-hash-mixer
            :skipped-on :gc-stress)
  (let* ((hs sb-kernel::*array-type-hashset*)
         (pre (compute-max-psl hs)))
    (assert (<= pre 9))
    (dolist (spec *specifiers*)
      (test-util:opaque-identity (sb-kernel:specifier-type spec)))
    (let ((post (compute-max-psl hs)))
      (assert (<= (- post pre) 3)))))

(defun slurp-samples (pathname)
  (with-open-file (f pathname)
   (loop
    (let ((line (read-line f nil)))
      (unless line (return))
      (sb-int:binding* (((nil end1) (read-from-string line))
                        ((form2) (read-from-string line nil nil :start end1)))
        (sb-kernel:specifier-type form2)))))) ; for effect (not flushable)

;; Slurping in the data posted to the "NUMERIC-TYPE-HASH-MIXER failures" discussion thread
;; in sbcl-devel gave me different probe sequences. I think this test is overly sensitive
;; to which cells get clobbered by GC.
;; (debug-probing sb-kernel::*numeric-type-hashset* nil)
;; Histogram:    1    2    3    4    5    6    7    8    9   10   11   12
;;             314  172   57   24   14    6    1    0    0    0    0    0
;; Avg=1.7653061
(with-test (:name :numeric-type-hash-mixer
            :skipped-on :gc-stress)
  (let* ((hs sb-kernel::*numeric-union-type-hashset*)
         ;; Theoretically we should be more concerned with the _average_
         ;; number of probes assuming all keys are sought equally (which is seldom true),
         ;; but we do also want to constrain the worst-case number of probes.
         ;; Accept a pretty high number, though not ideal, to avoid test failure.
         (acceptable-initial-max-psl 9)
         (pre (compute-max-psl hs)))
    (when (> pre acceptable-initial-max-psl)
      (format t "~&Dumping ~S~%" 'sb-kernel::*numeric-union-type-hashset*)
      (debug-probing hs))
    (assert (<= pre acceptable-initial-max-psl))
    (loop for i = 1 then (ash i 1)
          for tp = `(real ,(- i) 0)
          repeat 200
          unless (and (not (typep (- -1 i) tp)) (typep (- i) tp)
                        (typep -1 tp) (typep 0 tp) (not (typep 1 tp))
                        (not (typep i tp)) (not (typep (1+ i) tp)))
          collect (list i tp))
    (let ((post (compute-max-psl hs)))
      ;; It should only be allowed to get worse by some small tolerance, but I'm
      ;; unsure what to constrain this to. Maybe compute a percentage change in
      ;; average number of probes before and after inserting synthetic entries?
      ;; And/or strongly reference all elements to hide effects of weak object smashing.
      (assert (<= (- post pre) 2)))))

(defvar a "foo")
(defvar b '(nil t))
(defvar c #*101)
(with-test (:name :hash-cons-member-type)
  (assert (eq (sb-kernel:specifier-type `(member ,a ,b ,c))
              (sb-kernel:specifier-type `(member ,c ,a ,b))))
  (assert (eq (sb-kernel:specifier-type `(member ,a ,b ,c))
              (sb-kernel:specifier-type `(member ,b ,c ,a)))))

(with-test (:name :hash-cons-member-type-large)
  (let ((numbers ; force the XSET to be represented as a hash-table
         (loop for i below 30 collect (complex (coerce i 'single-float) i)))
        (list '(thing)))
    (assert (hash-table-p
             (sb-kernel::xset-data
              (sb-kernel::member-type-xset
               (sb-kernel:specifier-type `(member ,@numbers))))))
    (assert (eq (sb-kernel:specifier-type `(member ,a ,@numbers ,list))
                (sb-kernel:specifier-type `(member ,list ,a ,@numbers))))))

(defvar *pre-gc-xset-stable-hash-count*
  (hash-table-count sb-kernel::*xset-stable-hashes*))
;;; The fix for lp#2029306 significantly simplified the logic of scan_finalizers
;;; by avoiding use of weak pointers for objects in the live-and-moved state.
;;; This is not so bad, because an object being live means that adding another
;;; ref does not per se cause liveness to be preserved. However, the action of the
;;; finalizer thread is not immediate - it has move the to-be-rehashed items back
;;; into the weak table, and then another GC cycle is required to discover that the
;;; cons cells which held the rehash list became dead. Futhermore, to ensure that
;;; finalizers are run in time for this test to examine the expected state,
;;; we can "help" the finalizer thread by calling RUN-PENDING-FINALIZERS.
;;; This sequence yields a count of zero in the xset stable ID table for x86-64,
;;; but I have not tried the others, so I'm not asserting that it's zero.
(gc :full t)
(sb-kernel:run-pending-finalizers)
(gc :full t)
(sb-kernel:run-pending-finalizers)
#+sb-thread (sb-kernel:run-pending-finalizers)
(with-test (:name :xset-stable-hash-weakness)
  ;; After running the :MEMBER-TYPE-HASH-MIXER test, there were >5000 entries
  ;; in the *XSET-STABLE-HASHES* table for me.
  ;; The preceding GC should have had some effect.
  (let ((count (hash-table-count sb-kernel::*xset-stable-hashes*)))
    (format t "::: NOTE: hash-table-count = ~D~%" count)
    (assert (< count (/ *pre-gc-xset-stable-hash-count* 2)))))
