- ;; Assign costs to normal TNs so we know which ones should
- ;; always be packed on the stack.
- (when *pack-assign-costs*
- (assign-tn-costs component)
- (assign-tn-depths component))
-
- ;; Allocate normal TNs, starting with the TNs that are used
- ;; in deep loops. Only allocate in finite SCs (i.e. not on
- ;; the stack).
- (collect ((tns))
- (do-ir2-blocks (block component)
- (let ((ltns (ir2-block-local-tns block)))
- (do ((i (1- (ir2-block-local-tn-count block)) (1- i)))
- ((minusp i))
- (declare (fixnum i))
- (let ((tn (svref ltns i)))
- (unless (or (null tn)
- (eq tn :more)
- (tn-offset tn))
- ;; If loop analysis has been disabled we might as
- ;; well revert to the old behaviour of just
- ;; packing TNs linearly as they appear.
- (unless *loop-analyze*
- (pack-tn tn nil optimize :allow-unbounded-sc nil))
- (tns tn))))))
- (dolist (tn (stable-sort (tns)
- (lambda (a b)
- (cond
- ((> (tn-loop-depth a)
- (tn-loop-depth b))
- t)
- ((= (tn-loop-depth a)
- (tn-loop-depth b))
- (> (tn-cost a) (tn-cost b)))
- (t nil)))))
- (unless (tn-offset tn)
- (pack-tn tn nil optimize :allow-unbounded-sc nil))))
-
- ;; Pack any leftover normal TNs that could not be allocated
- ;; to finite SCs, or TNs that do not appear in any local TN
- ;; map (e.g. :MORE TNs). Since we'll likely be allocating
- ;; on the stack, first allocate TNs that are associated with
- ;; code at shallow lexical depths: this will allocate long
- ;; live ranges (i.e. TNs with more conflicts) first, and
- ;; hopefully minimise stack fragmentation.
- ;;
- ;; Collect in reverse order to give priority to older TNs.
- (let ((contiguous-tns '())
+ (cond (*loop-analyze*
+ ;; Allocate normal TNs, starting with the TNs that are used
+ ;; in deep loops. Only allocate in finite SCs (i.e. not on
+ ;; the stack).
+ (when *pack-assign-costs*
+ (assign-tn-depths component))
+ (collect ((tns))
+ (do ((tn (ir2-component-normal-tns 2comp) (tn-next tn)))
+ ((null tn))
+ (unless (or (tn-offset tn)
+ (eq (tn-kind tn) :more)
+ (unbounded-tn-p tn))
+ (tns tn)))
+ (dolist (tn (stable-sort (tns) #'tn-loop-depth-cost->))
+ (unless (tn-offset tn)
+ (pack-tn tn nil optimize :allow-unbounded-sc nil)))))
+ (t
+ ;; If loop analysis has been disabled we might as well revert
+ ;; to the old behaviour of just packing TNs linearly as they
+ ;; appear.
+ (do-ir2-blocks (block component)
+ (let ((ltns (ir2-block-local-tns block)))
+ (do ((i (1- (ir2-block-local-tn-count block)) (1- i)))
+ ((minusp i))
+ (declare (fixnum i))
+ (let ((tn (svref ltns i)))
+ (unless (or (null tn)
+ (eq tn :more)
+ (tn-offset tn)
+ (unbounded-tn-p tn))
+ (pack-tn tn nil optimize :allow-unbounded-sc nil))))))))
+
+ ;; Pack any leftover normal/restricted TN that is not already
+ ;; allocated to a finite SC, or TNs that do not appear in any
+ ;; local TN map (e.g. :MORE TNs). Since we'll likely be
+ ;; allocating on the stack, first allocate TNs that are
+ ;; associated with code at shallow lexical depths: this will
+ ;; allocate long live ranges (i.e. TNs with more conflicts)
+ ;; first, and hopefully minimise stack fragmentation.
+ ;; Component TNs are a degenerate case: they are always live.
+ (let ((component-tns '())
+ (contiguous-tns '())