tests/allocator.pure.lisp

   1 (progn
   2 (defun on-large-page-p (x)
   3   (and (eq (sb-ext:heap-allocated-p x) :dynamic)
   4        (let ((flags
   5               (sb-sys:with-pinned-objects (x)
   6                 (sb-alien:slot (sb-alien:deref sb-vm::page-table
   7                                                (sb-vm:find-page-index
   8                                                 (sb-kernel:get-lisp-obj-address x)))
   9                                'sb-vm::flags))))
  10          (logbitp 4 flags)))) ; SINGLE_OBJECT_FLAG
  11 (compile 'on-large-page-p)
  12
  13 ;;; Pseudo-static large objects should retain the single-object flag
  14
  15 ;;; Prior to change 3b137be67217 ("speed up trans_list"),
  16 ;;; gc_general_alloc() would always test whether it was allocating a large
  17 ;;; object via "if (nbytes >= LARGE_OBJECT_SIZE)" and in that case it would
  18 ;;; call gc_alloc_large(). It was not overwhelmingly necessary to perform the
  19 ;;; size test - which is an extra branch for almost no reason - because large
  20 ;;; objects should end up in the slow path by default. (So we only make the
  21 ;;; slow path a little slower, and speed up the fast path)
  22 ;;; However, 32-bit machines with small page size (4Kb) have a sufficiently small
  23 ;;; "large" object size that many more objects ought to be characterized as large.
  24 ;;; In conjunction with the fact that code allocation always opens allocations
  25 ;;; regions of at least 64k (= 16 pages), we find that code blobs end up in the
  26 ;;; open region by accident. This doesn't happen for the 32-bit architectures
  27 ;;; where the GENCGC-PAGE-BYTES is defined as 64KB because the minimum
  28 ;;; of 64KB is only 1 page, but a "large" object is 4 pages or more.
  29 ;;; So the fix is for trans_code() to do the size test, and then we don't
  30 ;;; slow down the general case of gc_general_alloc.
  31
  32 ;;; With #+mark-region-gc there is a range of "large-ish" objects (between
  33 ;;; 3/4 and 1 page large) where we try to allocate in a small page if
  34 ;;; possible, but claim a fresh large page instead of wasting the small
  35 ;;; page, so these tests don't work.
  36 (with-test (:name :pseudostatic-large-objects :skipped-on :mark-region-gc)
  37   (sb-vm:map-allocated-objects
  38    (lambda (obj type size)
  39      (declare (ignore type size))
  40      (when (>= (sb-ext:primitive-object-size obj) sb-vm:large-object-size)
  41        (let* ((addr (sb-kernel:get-lisp-obj-address obj))
  42               (pte (deref sb-vm:page-table (sb-vm:find-page-index addr))))
  43          (when (eq (slot pte 'sb-vm::gen) sb-vm:+pseudo-static-generation+)
  44            (assert (on-large-page-p obj))))))
  45    :dynamic))
  46
  47 (eval-when (:compile-toplevel :load-toplevel :execute)
  48   (defparameter large-n-words (/ sb-vm:large-object-size sb-vm:n-word-bytes))
  49   (defparameter large-n-conses (/ large-n-words 2))))
  50
  51 (with-test (:name :large-object-pages :skipped-on (:or :mark-region-gc (:not :gencgc)))
  52   ;; adding in a 2-word vector header makes it at least large-object-size.
  53   ;; The threshold in the allocator is exact equality for that.
  54   (let ((definitely-large-vector (make-array (- large-n-words 2)))
  55         ;; Decreasing by 1 word isn't enough, because of padding, so decrease by 2 words
  56         (not-large-vector (make-array (- large-n-words 4))))
  57     ;; Verify the edge case for LARGE-OBJECT-P
  58     (assert (on-large-page-p definitely-large-vector))
  59     (assert (not (on-large-page-p not-large-vector)))
  60     (assert (not (on-large-page-p (list 1 2))))))
  61 (with-test (:name :no-&rest-on-large-object-pages :skipped-on (:not :gencgc))
  62   (let ((fun (checked-compile '(lambda (&rest params) params))))
  63     (assert (not (on-large-page-p (apply fun (make-list large-n-conses)))))))
  64
  65 ;;; MIPS either: (1) runs for 10 minutes just in COMPILE and then croaks in the assembler
  66 ;;; due to an overly large displacement in an instruction, (2) crashes with heap exhaustion.
  67 ;;; I don't really care enough to fix it.  A flat profile shows the following top hot spots:
  68 ;;;
  69 ;;;            Self        Total        Cumul
  70 ;;;   Nr  Count     %  Count     %  Count     %    Calls  Function
  71 ;;; ------------------------------------------------------------------------
  72 ;;;    1    813 677.5    813 677.5    813 677.5        -  SB-REGALLOC::CONFLICTS-IN-SC
  73 ;;;    2    208 173.3    208 173.3   1021 850.8        -  SB-C::COALESCE-MORE-LTN-NUMBERS
  74 ;;;    3    118  98.3    118  98.3   1139 949.2        -  NTH
  75 ;;;    4     63  52.5    878 731.7   1202 1001.7        -  (LABELS SB-REGALLOC::ATTEMPT-LOCATION :IN SB-REGALLOC::SELECT-LOCATION)
  76 ;;;
  77 ;;; (And I don't know much about math, but I don't think that's how percentages work)
  78 ;;;
  79 ;;; I don't remember what the problem is with PPC.
  80 (with-test (:name :no-list-on-large-object-pages
  81                   :skipped-on (:or :mips :ppc :ppc64))
  82   (let* ((fun (checked-compile
  83                '(lambda ()
  84                  (macrolet ((expand (n) `(list ,@(loop for i from 1 to n collect i))))
  85                    (expand #.large-n-conses)))))
  86          (list (funcall fun)))
  87     (assert (not (on-large-page-p list)))))