projects
/
jscl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
New function: dominate-p
[jscl.git]
/
experimental
/
compiler.lisp
diff --git
a/experimental/compiler.lisp
b/experimental/compiler.lisp
index
9122f3c
..
49ed56e
100644
(file)
--- a/
experimental/compiler.lisp
+++ b/
experimental/compiler.lisp
@@
-156,6
+156,8
@@
entry exit
;; The component where the basic block belongs to.
component
entry exit
;; The component where the basic block belongs to.
component
+ ;; The order in the reverse post ordering of the blocks.
+ order
;; A bit-vector representing the set of dominators. See the function
;; `compute-dominators' to know how to use it properly.
dominators%
;; A bit-vector representing the set of dominators. See the function
;; `compute-dominators' to know how to use it properly.
dominators%
@@
-765,9
+767,11
@@
;;;; abstractions to use this information.
(defun compute-reverse-post-order (component)
;;;; abstractions to use this information.
(defun compute-reverse-post-order (component)
- (let ((output nil))
+ (let ((output nil)
+ (count 0))
(flet ((add-block-to-list (block)
(flet ((add-block-to-list (block)
- (push block output)))
+ (push block output)
+ (setf (block-order block) (incf count))))
(map-postorder-blocks #'add-block-to-list component))
(setf (component-reverse-post-order-p component) t)
(setf (component-blocks component) output)))
(map-postorder-blocks #'add-block-to-list component))
(setf (component-reverse-post-order-p component) t)
(setf (component-blocks component) output)))
@@
-819,6
+823,11
@@
(setf changes (or changes (not (equal (block-dominators% block) (block-dominators% block)))))
(incf i)))))
(setf changes (or changes (not (equal (block-dominators% block) (block-dominators% block)))))
(incf i)))))
+;;; Return T if BLOCK1 dominates BLOCK2, else return NIL.
+(defun dominate-p (block1 block2)
+ (let ((order (block-order block1)))
+ (= 1 (aref (block-dominators% block2) order))))
+
;;;; IR Debugging
;;;;
;;;; IR Debugging
;;;;