tests/gc-search.impure.lisp

   1
   2 #-(and immobile-space x86-64) (invoke-restart 'run-tests::skip-file)
   3
   4 (defun make-page-full-of-fdefns ()
   5   ;; Make a bunch of fdefns until we're aligned at a page boundary.
   6   (let* ((page-size 4096)
   7          (n-per-page (floor page-size sb-vm:symbol-size))
   8          (fdefn)
   9          (page-base)
  10          (list)
  11          (retries 0))
  12     (tagbody
  13        try-again
  14        (format t "~&Try ~D~%" (1+ retries))
  15        (dotimes (i n-per-page)
  16          (setq fdefn (sb-vm::alloc-immobile-fdefn))
  17          (when (not (logtest (logandc2 (sb-kernel:get-lisp-obj-address fdefn)
  18                                        sb-vm:lowtag-mask)
  19                              (1- page-size)))
  20            ;; Yay! This fdefn is immobile-page-aligned
  21            (return)))
  22        (setq page-base (logandc2 (sb-kernel:get-lisp-obj-address fdefn)
  23                                  sb-vm:lowtag-mask))
  24        (setq list (list fdefn))
  25        ;; Now try to allocate enough more to fill up the page so that
  26        ;; it is assured that there are not other (older) random fdefns
  27        ;; on that page.
  28        (dotimes (i (1- n-per-page))
  29          (let* ((other-fdefn (sb-vm::alloc-immobile-fdefn))
  30                 (addr (logandc2 (sb-kernel:get-lisp-obj-address other-fdefn)
  31                                 sb-vm:lowtag-mask)))
  32            (cond ((= addr (+ page-base (* (1+ i) sb-vm:fdefn-size sb-vm:n-word-bytes)))
  33                   ;; (format t "Winner~%")
  34                   (push fdefn list)) ; ensure liveness
  35                  (t
  36                   ;; (format t "Oops~%")
  37                   (setq list nil)
  38                   (if (<= (incf retries) 10)
  39                       (go try-again)
  40                       (error "Test fails")))))))
  41     (format t "~&Made page of fdefns~%")
  42     (let ((wps (mapcar 'make-weak-pointer list)))
  43       (setq fdefn nil list nil)
  44       ;; Now we need to make one more fdefn (or anything really) so that it gets
  45       ;; a higher address than the "victim" page, so that the high-water-mark
  46       ;; of allocated pages is strictly higher than PAGE-BASE, thus ensuring that
  47       ;; after GC it looks like the page at PAGE-BASE could be in use.
  48       (let ((another (sb-vm::alloc-immobile-fdefn)))
  49         (assert (>= (sb-kernel:get-lisp-obj-address another)
  50                     (+ page-base page-size))))
  51       ;; And return page-base so we don't read any weak-pointer-value henceforth.
  52       (values wps page-base))))
  53
  54 ;;; This could get SIGFPE in search_immobile_space() with the following unfortunate result:
  55 ;;; UNEXPECTED-FAILURE :FIND-ON-EMPTY-FIXEDOBJ-PAGE
  56 ;;;     due to SB-KERNEL:FLOATING-POINT-EXCEPTION:
  57 ;;;         "An arithmetic error SB-KERNEL:FLOATING-POINT-EXCEPTION was signalled.
  58 ;;; No traps are enabled? How can this be?
  59 (with-test (:name :find-on-empty-fixedobj-page
  60             :skipped-on (not :sb-thread)) ;; fails intermittently
  61   (multiple-value-bind (wps page-base) (make-page-full-of-fdefns)
  62     (format t "~&Fdefn page base = ~x~%" page-base)
  63     (sb-sys:scrub-control-stack)
  64     (gc :full t)
  65     (dolist (wp wps) (assert (not (weak-pointer-value wp))))
  66     (assert (not (sb-di::code-header-from-pc
  67                   (logior page-base sb-vm:other-pointer-lowtag))))))