From 7325ab8ad855880e88c351ea1cfc6b20d980282e Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Sat, 18 May 2013 01:26:24 +0100 Subject: [PATCH] do-blocks-{forward,backward] checks if reverse post-order information is available --- experimental/compiler.lisp | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/experimental/compiler.lisp b/experimental/compiler.lisp index 3ddb441..aa5e593 100644 --- a/experimental/compiler.lisp +++ b/experimental/compiler.lisp @@ -221,6 +221,9 @@ entry exit functions + ;; TODO: Replace with a flags slot for indicate what + ;; analysis/transformations have been carried out. + reverse-post-order-p blocks) ;;; The current component. @@ -766,17 +769,28 @@ (flet ((add-block-to-list (block) (push block output))) (map-postorder-blocks #'add-block-to-list component)) + (setf (component-reverse-post-order-p component) t) (setf (component-blocks component) output))) ;;; Iterate across blocks in COMPONENT in reverse post order. (defmacro do-blocks-forward ((block component &optional result) &body body) - `(dolist (,block (component-blocks ,component) ,result) - ,@body)) + (with-gensyms (g!component) + `(let ((,g!component ,component)) + (dolist (,block (if (component-reverse-post-order-p ,g!component) + (component-blocks ,g!component) + (error "reverse post order was not computed yet.")) + ,result) + ,@body)))) + ;;; Iterate across blocks in COMPONENT in post order. (defmacro do-blocks-backward ((block component &optional result) &body body) - `(dolist (,block (reverse (component-blocks ,component)) ,result) - ,@body)) - + (with-gensyms (g!component) + `(let ((,g!component ,component)) + (dolist (,block (if (component-reverse-post-order-p ,g!component) + (reverse (component-blocks ,g!component)) + (error "reverse post order was not computed yet.")) + ,result) + ,@body)))) (defun compute-dominators (component) ;; Initialize the dominators of the entry to the component to be @@ -797,11 +811,12 @@ ((not changes)) (setf changes nil) (do-blocks-forward (block component) - (let ((new (reduce #'bit-and (mapcar #'block-dominators% (block-pred block))))) - (format t "Dominators for ~a is ~S~%" (block-id block) new) - (setf (aref new i) 1) - (setf changes (or changes (not (equal new (block-dominators% block))))) - (setf (block-dominators% block) new) + (let* ((predecessors (block-pred block))) + (bit-and (block-dominators% block) (block-dominators% (first predecessors)) t) + (dolist (pred (rest predecessors)) + (bit-and (block-dominators% block) (block-dominators% pred) t)) + (setf (aref (block-dominators% block) i) 1) + (setf changes (or changes (not (equal (block-dominators% block) (block-dominators% block))))) (incf i))))) -- 1.7.10.4