X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftn.lisp;h=3409a638c0b0f5ffafee7d8a5ead7d7cae6314de;hb=50305b602c3953440af716137a56f50cd204375d;hp=ee80ba8d385bb228d0a1466a8cd13530344b362b;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp index ee80ba8..3409a63 100644 --- a/src/compiler/tn.lisp +++ b/src/compiler/tn.lisp @@ -12,9 +12,6 @@ (in-package "SB!C") -(file-comment - "$Header$") - ;;; The component that is currently being compiled. TNs are allocated ;;; in this component. (defvar *component-being-compiled*) @@ -67,14 +64,14 @@ (case (tn-kind tn) (:environment (clear-live tn - #'ir2-environment-live-tns - #'(setf ir2-environment-live-tns))) + #'ir2-physenv-live-tns + #'(setf ir2-physenv-live-tns))) (:debug-environment (clear-live tn - #'ir2-environment-debug-live-tns - #'(setf ir2-environment-debug-live-tns))))) + #'ir2-physenv-debug-live-tns + #'(setf ir2-physenv-debug-live-tns))))) (clear-live (tn getter setter) - (let ((env (environment-info (tn-environment tn)))) + (let ((env (physenv-info (tn-physenv tn)))) (funcall setter (delete tn (funcall getter env)) env)))) (declare (inline used-p delete-some delete-1 clear-live)) (delete-some #'ir2-component-alias-tns @@ -139,29 +136,30 @@ (push-in tn-next res (ir2-component-restricted-tns component)) res)) -;;; 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)) +;;; 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 physenv-live-tn (tn env) + (declare (type tn tn) (type physenv env)) + (aver (eq (tn-kind tn) :normal)) (setf (tn-kind tn) :environment) - (setf (tn-environment tn) env) - (push tn (ir2-environment-live-tns (environment-info env))) + (setf (tn-physenv tn) env) + (push tn (ir2-physenv-live-tns (physenv-info env))) tn) -(defun environment-debug-live-tn (tn env) - (declare (type tn tn) (type environment env)) - (assert (eq (tn-kind tn) :normal)) +(defun physenv-debug-live-tn (tn env) + (declare (type tn tn) (type physenv env)) + (aver (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))) + (setf (tn-physenv tn) env) + (push tn (ir2-physenv-debug-live-tns (physenv-info env))) tn) ;;; Make TN be live throughout the current component. Return TN. (defun component-live-tn (tn) (declare (type tn tn)) - (assert (eq (tn-kind tn) :normal)) + (aver (eq (tn-kind tn) :normal)) (setf (tn-kind tn) :component) (push tn (ir2-component-component-tns (component-info *component-being-compiled*))) @@ -170,8 +168,8 @@ ;;; 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)))) + (aver (eq (tn-kind save) :normal)) + (aver (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) @@ -300,10 +298,11 @@ ;;;; miscellaneous utilities -;;; Emit a move-like template determined at run-time, with X as the argument -;;; and Y as the result. Useful for move, coerce and type-check templates. If -;;; supplied, then insert before VOP, otherwise insert at then end of the -;;; block. Returns the last VOP inserted. +;;; Emit a move-like template determined at run-time, with X as the +;;; argument and Y as the result. Useful for move, coerce and +;;; type-check templates. If supplied, then insert before VOP, +;;; otherwise insert at then end of the block. Returns the last VOP +;;; inserted. (defun emit-move-template (node block template x y &optional before) (declare (type node node) (type ir2-block block) (type template template) (type tn x y)) @@ -363,7 +362,7 @@ (defun drop-thru-p (node block) (declare (type node node) (type cblock block)) (let ((next-block (ir2-block-next (block-info (node-block node))))) - (assert (eq node (block-last (node-block node)))) + (aver (eq node (block-last (node-block node)))) (eq next-block (block-info block)))) ;;; Link a list of VOPs from First to Last into Block, Before the specified @@ -426,7 +425,7 @@ ;;; Return the value of an immediate constant TN. (defun tn-value (tn) (declare (type tn tn)) - (assert (member (tn-kind tn) '(:constant :cached-constant))) + (aver (member (tn-kind tn) '(:constant :cached-constant))) (constant-value (tn-leaf tn))) ;;; Force TN to be allocated in a SC that doesn't need to be saved: an