From 211e24b54de2c8b6af5e63729486daa21a64ea1b Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Mon, 5 Mar 1990 12:20:40 +0000 Subject: [PATCH] Changed iterations over the save set to use DO-LIVE-TNS. Changed save TNs to *not* copy the conflict info from the saved TN. Instead, we detect save TNs and defer to the original TN for conflict info. This allows :ENVIRONMENT TNs to have save TNs. --- compiler/pack.lisp | 33 ++++++++++++++++++++++++--------- 1 file changed, 24 insertions(+), 9 deletions(-) diff --git a/compiler/pack.lisp b/compiler/pack.lisp index cf0fc2b49..a7af596c3 100644 --- a/compiler/pack.lisp +++ b/compiler/pack.lisp @@ -300,7 +300,7 @@ ((null vop)) (let ((info (vop-info vop))) (when (eq (vop-info-save-p info) t) - (dolist (tn (first (vop-codegen-info vop))) + (do-live-tns (tn (vop-save-set vop) block) (add-cost-vector tn *save-costs*) (add-cost-vector tn *restore-costs*))) @@ -318,6 +318,24 @@ ;;;; Register saving: +;;; Orignal-TN -- Internal +;;; +;;; If a save TN, return the saved TN, otherwise return TN. Useful for +;;; getting the conflicts of a TN that might be a save TN. +;;; +(defun original-tn (tn) + (declare (type tn tn)) + (if (member (tn-kind tn) '(:save :save-once)) + (tn-save-tn tn) + tn)) + +#| + (setf (tn-local res) (tn-local tn)) + (bit-vector-replace (tn-local-conflicts res) (tn-local-conflicts tn)) + (setf (tn-local-number res) (tn-local-number tn)) + (setf (tn-global-conflicts res) (tn-global-conflicts tn)) +|# + ;;; Pack-Save-TN -- Internal ;;; ;;; Make a save TN for TN, pack it, and return it. We copy various conflict @@ -330,10 +348,6 @@ (setf (tn-save-tn tn) res) (setf (tn-save-tn res) tn) (setf (svref (tn-costs res) (sc-number sc)) 0) - (setf (tn-local res) (tn-local tn)) - (bit-vector-replace (tn-local-conflicts res) (tn-local-conflicts tn)) - (setf (tn-local-number res) (tn-local-number tn)) - (setf (tn-global-conflicts res) (tn-global-conflicts tn)) (pack-tn res) res)) @@ -394,7 +408,7 @@ (do ((vop (ir2-block-start-vop block) (vop-next vop))) ((null vop)) (when (eq (vop-info-save-p (vop-info vop)) t) - (dolist (tn (first (vop-codegen-info vop))) + (do-live-tns (tn (vop-save-set vop) block) (when (svref *save-scs* (sc-number (tn-sc tn))) (let ((writes (tn-writes tn)) (save (tn-save-tn tn))) @@ -939,10 +953,11 @@ (declare (type tn tn)) (loop (let* ((fsc (find-best-sc tn)) - (loc (or (find-ok-target-offset tn fsc) - (select-location tn fsc)))) + (original (original-tn tn)) + (loc (or (find-ok-target-offset original fsc) + (select-location original fsc)))) (cond (loc - (add-location-conflicts tn fsc loc) + (add-location-conflicts original fsc loc) (setf (tn-sc tn) fsc) (setf (tn-offset tn) loc) (return)) -- GitLab