diff --git a/compiler/tn.lisp b/compiler/tn.lisp index 0bbc933ff2a3be23ac637a5d75f0edd55ab3de4b..8ae1c511203d49cdbbf3de456fcd5566845ad352 100644 --- a/compiler/tn.lisp +++ b/compiler/tn.lisp @@ -50,9 +50,10 @@ `(let ((prev nil)) (do ((tn ,name (tn-next tn))) ((null tn)) - (cond ((or (not (eq (tn-kind tn) :normal)) - (tn-reads tn) - (tn-writes tn)) + (cond ((or (tn-reads tn) + (tn-writes tn) + (member (tn-kind tn) + '(:component :specified-save))) (setq prev tn)) (t (if prev @@ -62,10 +63,10 @@ (let ((2comp (component-info component))) (frob (ir2-component-normal-tns 2comp)) (frob (ir2-component-restricted-tns 2comp)) - (frob (ir2-component-wired-tns 2comp)))) + (frob (ir2-component-wired-tns 2comp)) + (frob (ir2-component-alias-tns 2comp)))) (undefined-value)) - ;;;; TN Creation: @@ -129,17 +130,28 @@ res)) -;;; Environment-Live-TN -- Interface +;;; ENVIRONMENT-LIVE-TN, ENVIRONMENT-DEBUG-LIVE-TN -- Interface ;;; -;;; Make TN be live throughout environment. TN must be referenced only in -;;; Env. Return TN. +;;; Make TN be live throughout environment. Return TN. In the DEBUG case, +;;; the TN is treated normally in blocks in the environment which reference the +;;; TN, allowing targeting to/from the TN. This results in move efficient +;;; code, but may result in the TN sometimes not being live when you want it. ;;; (defun environment-live-tn (tn env) (declare (type tn tn) (type environment env)) (assert (eq (tn-kind tn) :normal)) (setf (tn-kind tn) :environment) + (setf (tn-environment tn) env) (push tn (ir2-environment-live-tns (environment-info env))) tn) +;;; +(defun environment-debug-live-tn (tn env) + (declare (type tn tn) (type environment env)) + (assert (eq (tn-kind tn) :normal)) + (setf (tn-kind tn) :debug-environment) + (setf (tn-environment tn) env) + (push tn (ir2-environment-debug-live-tns (environment-info env))) + tn) ;;; Component-Live-TN -- Interface @@ -154,6 +166,23 @@ tn) +;;; SPECIFY-SAVE-TN -- Interface +;;; +;;; Specify that Save be used as the save location for TN. TN is returned. +;;; +(defun specify-save-tn (tn save) + (declare (type tn tn save)) + (assert (eq (tn-kind save) :normal)) + (assert (and (not (tn-save-tn tn)) (not (tn-save-tn save)))) + (setf (tn-kind save) :specified-save) + (setf (tn-save-tn tn) save) + (setf (tn-save-tn save) tn) + (push save + (ir2-component-specified-save-tns + (component-info *compile-component*))) + tn) + + ;;; Make-Constant-TN -- Interface ;;; ;;; Create a constant TN. The implementation dependent @@ -175,6 +204,21 @@ res)) +;;; MAKE-ALIAS-TN -- Interface +;;; +;;; Make a TN that aliases TN for use in local call argument passing. +;;; +(defun make-alias-tn (tn) + (declare (type tn tn)) + (let* ((component (component-info *compile-component*)) + (res (make-tn (incf (ir2-component-global-tn-counter component)) + :alias (tn-primitive-type tn) nil))) + (setf (tn-save-tn res) tn) + (push-in tn-next res + (ir2-component-alias-tns component)) + res)) + + ;;; Make-Load-Time-Constant-TN -- Internal ;;; ;;; Return a load-time constant TN with the specified Kind and Info. If the