Disentangle storage base initial size from growth increments

Before, an initial stack frame size of 8 meant that the stack frame
always grew in increments of 8. Not only is a large initial size bad
for GC (it leaves more dead references untouched), but a large increment
is even worse.

diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index 37fb1fb..98c4600 100644 (file)
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -27,7 +27,8 @@
 ;;;
 ;;; We enter the basic structure at meta-compile time, and then fill
 ;;; in the missing slots at load time.
-(defmacro define-storage-base (name kind &key size)
+(defmacro define-storage-base (name kind &key size (size-increment size)
+                                           (size-alignment 1))
 
   (declare (type symbol name))
   (declare (type (member :finite :unbounded :non-packed) kind))
@@ -39,11 +40,16 @@
        (error "A size specification is meaningless in a ~S SB." kind)))
     ((:finite :unbounded)
      (unless size (error "Size is not specified in a ~S SB." kind))
-     (aver (typep size 'unsigned-byte))))
+     (aver (typep size 'unsigned-byte))
+     (aver (= 1 (logcount size-alignment)))
+     (aver (not (logtest size (1- size-alignment))))
+     (aver (not (logtest size-increment (1- size-alignment))))))
 
   (let ((res (if (eq kind :non-packed)
                  (make-sb :name name :kind kind)
-                 (make-finite-sb :name name :kind kind :size size))))
+                 (make-finite-sb :name name :kind kind :size size
+                                 :size-increment size-increment
+                                 :size-alignment size-alignment))))
     `(progn
        (eval-when (:compile-toplevel :load-toplevel :execute)
          (/show0 "about to SETF GETHASH META-SB-NAMES in DEFINE-STORAGE-BASE")

diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index cdc2318..eeb8651 100644 (file)
--- a/src/compiler/pack.lisp
+++ b/src/compiler/pack.lisp
@@ -215,12 +215,13 @@
   (let* ((sb (sc-sb sc))
          (size (finite-sb-current-size sb))
          (align-mask (1- (sc-alignment sc)))
-         (inc (max (sb-size sb)
+         (inc (max (finite-sb-size-increment sb)
                    (+ (sc-element-size sc)
                       (- (logandc2 (+ size align-mask) align-mask)
                          size))
                    (- needed-size size)))
-         (new-size (+ size inc))
+         (new-size (let ((align-mask (1- (finite-sb-size-alignment sb))))
+                     (logandc2 (+  size inc align-mask) align-mask)))
          (conflicts (finite-sb-conflicts sb))
          (block-size (if (zerop (length conflicts))
                          (ir2-block-count *component-being-compiled*)

diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp
index 5e3504a..ae18a61 100644 (file)
--- a/src/compiler/vop.lisp
+++ b/src/compiler/vop.lisp
@@ -752,6 +752,12 @@
 ;;; A FINITE-SB holds information needed by the packing algorithm for
 ;;; finite SBs.
 (def!struct (finite-sb (:include sb))
+  ;; the minimum number of location by which to grow this SB
+  ;; if it is :unbounded
+  (size-increment 1 :type index)
+  ;; current-size must always be a multiple of this. It is assumed
+  ;; to be a power of two.
+  (size-alignment 1 :type index)
   ;; the number of locations currently allocated in this SB
   (current-size 0 :type index)
   ;; the last location packed in, used by pack to scatter TNs to
@@ -842,6 +848,7 @@
   ;; true if this SC or one of its alternates in in the NUMBER-STACK SB.
   (number-stack-p nil :type boolean)
   ;; alignment restriction. The offset must be an even multiple of this.
+  ;; this must be a power of two.
   (alignment 1 :type (and index (integer 1)))
   ;; a list of locations that we avoid packing in during normal
   ;; register allocation to ensure that these locations will be free