\f
;;;; pack interface
+;; Misc. utilities
+(declaim (inline unbounded-sc-p))
+(defun unbounded-sc-p (sc)
+ (eq (sb-kind (sc-sb sc)) :unbounded))
+
+(defun unbounded-tn-p (tn)
+ (unbounded-sc-p (tn-sc tn)))
+(declaim (notinline unbounded-sc-p))
+
;;; Attempt to pack TN in all possible SCs, first in the SC chosen by
;;; representation selection, then in the alternate SCs in the order
;;; they were specified in the SC definition. If the TN-COST is
(defun tn-lexical-depth (tn)
(let ((path t)) ; dummy initial value
(labels ((path (lambda)
- (nreverse (loop while lambda
- collect lambda
- do (setf lambda (lambda-parent lambda)))))
+ (do ((acc '())
+ (lambda lambda (lambda-parent lambda)))
+ ((null lambda) acc)
+ (push lambda acc)))
(register-scope (lambda)
(let ((new-path (path lambda)))
(setf path (if (eql path t)
0 (mismatch path new-path))))))
(walk-tn-refs (ref)
(do ((ref ref (tn-ref-next ref)))
- ((null ref))
- (binding* ((node (vop-node (tn-ref-vop ref))
- :exit-if-null))
- (register-scope (lexenv-lambda
- (node-lexenv node)))))))
+ ((or (null ref)
+ (null path)))
+ (awhen (vop-node (tn-ref-vop ref))
+ (register-scope (lexenv-lambda (node-lexenv it)))))))
(walk-tn-refs (tn-reads tn))
(walk-tn-refs (tn-writes tn))
(if (eql path t)