diff --git a/compiler/ir1util.lisp b/compiler/ir1util.lisp index 07f63ab8630e4bbac9d7484702e320e2f9bbec7d..fc6607ac8cff2d96c4104edf29071ad0fa66a5e6 100644 --- a/compiler/ir1util.lisp +++ b/compiler/ir1util.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.108 2004/12/06 17:03:56 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.109 2004/12/16 21:55:37 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -675,7 +675,8 @@ (declare (values component)) (let* ((head (make-block-key :start nil :component nil)) (tail (make-block-key :start nil :component nil)) - (res (make-component :head head :tail tail))) + (res (make-component :head head :tail tail + :outer-loop (make-loop :kind :outer :head head)))) (setf (block-flag head) t) (setf (block-flag tail) t) (setf (block-component head) res) diff --git a/compiler/main.lisp b/compiler/main.lisp index d36600ee2388ed7663246fa0e5ea3ca52eb39743..bbfb9ef6ad885a5cd759106ba95fce09d50cb480 100644 --- a/compiler/main.lisp +++ b/compiler/main.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.143 2004/10/26 13:31:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.144 2004/12/16 21:55:38 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -55,6 +55,10 @@ forms (evaluated at load-time) when the :BYTE-COMPILE argument is :MAYBE (the default.) When true, we decide to byte-compile.") +;;; Exported: +(defvar *loop-analyze* nil + "Whether loop analysis should be done or not.") + ;;; Value of the :byte-compile argument to the compiler. (defvar *byte-compile* :maybe) @@ -433,12 +437,13 @@ in the user USER-INFO slot of STREAM-SOURCE-LOCATIONs.") (ir1-phases component) - #| - (maybe-mumble "Dom ") - (find-dominators component) - (maybe-mumble "Loop ") - (loop-analyze component) - |# + (when *loop-analyze* + (dfo-as-needed component) + (maybe-mumble "Dom ") + (find-dominators component) + (maybe-mumble "Loop ") + (loop-analyze component)) + (maybe-mumble "Env ") (environment-analyze component) diff --git a/compiler/node.lisp b/compiler/node.lisp index f0914dea9ad1a1e133ced1f13c2748993ff47429..0ef18ef2b44581902daa236a0d1f4b622cbbd0f7 100644 --- a/compiler/node.lisp +++ b/compiler/node.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/node.lisp,v 1.45 2004/11/05 22:02:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/node.lisp,v 1.46 2004/12/16 21:55:38 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -522,7 +522,7 @@ ;; NEW-FUNCTIONS, this is not disjoint from COMPONENT-LAMBDAS. (reanalyze-functions nil :type list) ;; The default LOOP in the component - (outer-loop nil :type (or null cloop))) + (outer-loop (required-argument) :type cloop)) (defprinter component name diff --git a/compiler/represent.lisp b/compiler/represent.lisp index ef465c83b85ffacc7804d491d65634cc17f4c385..b14fb9d4309d9249456a8ef8afd64019f6e01ed0 100644 --- a/compiler/represent.lisp +++ b/compiler/represent.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/represent.lisp,v 1.36 2001/03/04 20:12:26 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/represent.lisp,v 1.37 2004/12/16 21:55:38 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -697,6 +697,38 @@ (note-number-stack-tn (tn-writes tn))) (undefined-value)) +;;; Iterate over the normal TNs, storing the depth of the deepest loop +;;; that the TN is used in TN-LOOP-DEPTH. +(defun assign-tn-depths (component) + (when *loop-analyze* + (do-ir2-blocks (block component) + (do ((vop (ir2-block-start-vop block) + (vop-next vop))) + ((null vop)) + (flet ((find-all-tns (head-fun) + (collect ((tns)) + (do ((ref (funcall head-fun vop) (tn-ref-across ref))) + ((null ref)) + (tns (tn-ref-tn ref))) + (tns)))) + (dolist (tn (nconc (find-all-tns #'vop-args) + (find-all-tns #'vop-results) + (find-all-tns #'vop-temps) + ;; What does "references in this VOP + ;; mean"? Probably something that isn't + ;; useful in this context, since these + ;; TN-REFs are linked with TN-REF-NEXT + ;; instead of TN-REF-ACROSS. --JES + ;; 2004-09-11 + ;; (find-all-tns #'vop-refs) + )) + (setf (tn-loop-depth tn) + (max (tn-loop-depth tn) + (let* ((ir1-block (ir2-block-block (vop-block vop))) + (loop (block-loop ir1-block))) + (if loop + (loop-depth loop) + 0)))))))))) ;;; SELECT-REPRESENTATIONS -- Interface ;;; diff --git a/compiler/vop.lisp b/compiler/vop.lisp index 893d5de17b4c7b10a1ae01f96b256c21521137b6..a99016e2e807f3ffdddbc627f8b73060813f1318 100644 --- a/compiler/vop.lisp +++ b/compiler/vop.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/vop.lisp,v 1.42 2004/11/05 22:02:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/vop.lisp,v 1.43 2004/12/16 21:55:38 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -1120,7 +1120,9 @@ ;; ;; If a :ENVIRONMENT or :DEBUG-ENVIRONMENT TN, this is the environment that ;; the TN is live throughout. - (environment nil :type (or environment null))) + (environment nil :type (or environment null)) + ;; The depth of the deepest loop that this TN is used in. + (loop-depth 0 :type fixnum)) (defun %print-tn (s stream d) (declare (ignore d))