From 44fa19275c08a17b9d80d95102c1a8bc0da7a17e Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Thu, 27 Jun 2013 18:44:08 -0400 Subject: [PATCH] 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. --- src/compiler/meta-vmdef.lisp | 12 +++++++++--- src/compiler/pack.lisp | 5 +++-- src/compiler/vop.lisp | 7 +++++++ 3 files changed, 19 insertions(+), 5 deletions(-) diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 37fb1fb..98c4600 100644 --- 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 --- 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 --- 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 -- 1.7.10.4