Grow regalloc datastructures geometrically for unbounded SCs

diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index eeb8651..51ebd36 100644 (file)
--- a/src/compiler/pack.lisp
+++ b/src/compiler/pack.lisp
@@ -225,15 +225,16 @@
          (conflicts (finite-sb-conflicts sb))
          (block-size (if (zerop (length conflicts))
                          (ir2-block-count *component-being-compiled*)
-                         (length (the simple-vector (svref conflicts 0))))))
-    (declare (type index inc new-size))
+                         (length (the simple-vector (svref conflicts 0)))))
+         (padded-size (ash 1 (integer-length (1- new-size)))))
+    (declare (type index inc new-size padded-size))
     (aver (eq (sb-kind sb) :unbounded))
 
-    (when (> new-size (length conflicts))
-      (let ((new-conf (make-array new-size)))
+    (when (> padded-size (length conflicts))
+      (let ((new-conf (make-array padded-size)))
         (replace new-conf conflicts)
         (do ((i size (1+ i)))
-            ((= i new-size))
+            ((= i padded-size))
           (declare (type index i))
           (let ((loc-confs (make-array block-size)))
             (dotimes (j block-size)
@@ -244,23 +245,23 @@
             (setf (svref new-conf i) loc-confs)))
         (setf (finite-sb-conflicts sb) new-conf))
 
-      (let ((new-live (make-array new-size)))
+      (let ((new-live (make-array padded-size)))
         (replace new-live (finite-sb-always-live sb))
         (do ((i size (1+ i)))
-            ((= i new-size))
+            ((= i padded-size))
           (setf (svref new-live i)
                 (make-array block-size
                             :initial-element 0
                             :element-type 'bit)))
         (setf (finite-sb-always-live sb) new-live))
 
-      (let ((new-live-count (make-array new-size)))
+      (let ((new-live-count (make-array padded-size)))
         (declare (optimize speed)) ;; FILL deftransform
         (replace new-live-count (finite-sb-always-live-count sb))
         (fill new-live-count 0 :start size)
         (setf (finite-sb-always-live-count sb) new-live-count))
 
-      (let ((new-tns (make-array new-size :initial-element nil)))
+      (let ((new-tns (make-array padded-size :initial-element nil)))
         (replace new-tns (finite-sb-live-tns sb))
         (fill (finite-sb-live-tns sb) nil)
         (setf (finite-sb-live-tns sb) new-tns)))