Skip to content
Snippets Groups Projects
Commit be26c9f9 authored by rtoy's avatar rtoy
Browse files

Enable loop analysis code. But the default is loop analysis is not

done, because we don't do anything with the loop results.

ir1util.lisp:
	o Make sure component initializes the outer-loop slot of the
	  component.

main.lisp:
	o Add defvar *loop-analyze*, defaulting to NIL.
	o Run loop analysis code when *loop-analyze* is T.

node.lisp:
	o Make the outer-loop slot of a component a required arg and
	  adjust the declared type appropriately.

represent.lisp:
	o Add ASSIGN-TN-DEPTHS function to assign loop depths to TNs.

vop.lisp:
	o Forgot to add the loop-depth slot for TNs.
parent 6a496763
No related branches found
No related tags found
No related merge requests found
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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
;;;
......
......@@ -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))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment