From 05751ccd3e219380480aa99acbad46c6c2a8db4b Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 19 Apr 1990 14:58:34 +0000 Subject: [PATCH] Changed INIT-SB-VECTORS and GROW-SC to work when a SB has no locations allocated (initial size of 0). --- compiler/pack.lisp | 61 ++++++++++++++++++++++++++++------------------ 1 file changed, 37 insertions(+), 24 deletions(-) diff --git a/compiler/pack.lisp b/compiler/pack.lisp index 5cbf04b0c..36c1d1329 100644 --- a/compiler/pack.lisp +++ b/compiler/pack.lisp @@ -146,6 +146,18 @@ (bit-ior (svref loc-confs num) (tn-local-conflicts tn) t)))))))) +;;; IR2-BLOCK-COUNT -- Internal +;;; +;;; Return the total number of IR2 blocks in Component. +;;; +(defun ir2-block-count (component) + (declare (type component component)) + (1+ (ir2-block-number + (block-info + (block-next + (component-head component)))))) + + ;;; Init-SB-Vectors -- Internal ;;; ;;; Ensure that the conflicts vectors for each :Finite SB are large enough @@ -153,31 +165,30 @@ ;;; the current size to the initial size. ;;; (defun init-sb-vectors (component) - (let ((nblocks (1+ (ir2-block-number - (block-info - (block-next - (component-head component))))))) + (let ((nblocks (ir2-block-count component))) (dolist (sb *sb-list*) (unless (eq (sb-kind sb) :non-packed) - (let* ((conflicts (finite-sb-conflicts sb)) - (always-live (finite-sb-always-live sb)) - (current-size (length (svref conflicts 0)))) - (when (> nblocks current-size) - (let ((new-size (max nblocks (* current-size 2)))) - (dotimes (i (length conflicts)) - (let ((new-vec (make-array new-size))) - (dotimes (j new-size) - (setf (svref new-vec j) - (make-array local-tn-limit :element-type 'bit))) - (setf (svref conflicts i) new-vec)) - (setf (svref always-live i) - (make-array new-size :element-type 'bit))))) - - (dotimes (i (length conflicts)) - (let ((conf (svref conflicts i))) - (dotimes (j (length conf)) - (clear-bit-vector (svref conf j)))) - (clear-bit-vector (svref always-live i)))) + (let ((conflicts (finite-sb-conflicts sb)) + (always-live (finite-sb-always-live sb)) + (max-locs (length conflicts))) + (unless (zerop max-locs) + (let ((current-size (length (svref conflicts 0)))) + (when (> nblocks current-size) + (let ((new-size (max nblocks (* current-size 2)))) + (dotimes (i (length conflicts)) + (let ((new-vec (make-array new-size))) + (dotimes (j new-size) + (setf (svref new-vec j) + (make-array local-tn-limit :element-type 'bit))) + (setf (svref conflicts i) new-vec)) + (setf (svref always-live i) + (make-array new-size :element-type 'bit)))))) + + (dotimes (i (length conflicts)) + (let ((conf (svref conflicts i))) + (dotimes (j (length conf)) + (clear-bit-vector (svref conf j)))) + (clear-bit-vector (svref always-live i))))) (setf (finite-sb-current-size sb) (sb-size sb)) (setf (finite-sb-last-offset sb) 0))))) @@ -196,7 +207,9 @@ (inc (max (sb-size sb) (sc-element-size sc) (- needed-size size))) (new-size (+ size inc)) (conflicts (finite-sb-conflicts sb)) - (block-size (length (svref conflicts 0)))) + (block-size (if (zerop (length conflicts)) + (ir2-block-count *compile-component*) + (length (svref conflicts 0))))) (assert (eq (sb-kind sb) :unbounded)) (when (> new-size (length conflicts)) -- GitLab