:documentation "List of incoming edges.")
(out-edges () :type list
:documentation "List of out-coming edges.")
- (dom nil :type (or null comp-block)
+ (idom nil :type (or null comp-block)
:documentation "Immediate dominator.")
(df (make-hash-table) :type (or null hash-table)
:documentation "Dominance frontier set. Block-name -> block")
for b being each hash-value of (comp-func-blocks f)
do (setf (comp-block-in-edges b) ()
(comp-block-out-edges b) ()
- (comp-block-dom b) nil
+ (comp-block-idom b) nil
(comp-block-df b) (make-hash-table)
(comp-block-post-num b) nil
(comp-block-final-frame b) nil
(finger2 (comp-block-post-num b2)))
(while (not (= finger1 finger2))
(while (< finger1 finger2)
- (setf b1 (comp-block-dom b1)
+ (setf b1 (comp-block-idom b1)
finger1 (comp-block-post-num b1)))
(while (< finger2 finger1)
- (setf b2 (comp-block-dom b2)
+ (setf b2 (comp-block-idom b2)
finger2 (comp-block-post-num b2))))
b1))
(first-processed (l)
- (if-let ((p (cl-find-if (lambda (p) (comp-block-dom p)) l)))
+ (if-let ((p (cl-find-if (lambda (p) (comp-block-idom p)) l)))
p
(signal 'native-ice "cant't find first preprocessed"))))
while changed
initially (progn
(comp-log "Computing dominator tree...\n" 2)
- (setf (comp-block-dom entry) entry)
+ (setf (comp-block-idom entry) entry)
;; Set the post order number.
(cl-loop for name in (reverse rev-bb-list)
for b = (gethash name blocks)
for new-idom = (first-processed preds)
initially (setf changed nil)
do (cl-loop for p in (delq new-idom preds)
- when (comp-block-dom p)
+ when (comp-block-idom p)
do (setf new-idom (intersect p new-idom)))
- unless (eq (comp-block-dom b) new-idom)
- do (setf (comp-block-dom b) (unless (and (comp-block-lap-p new-idom)
+ unless (eq (comp-block-idom b) new-idom)
+ do (setf (comp-block-idom b) (unless (and (comp-block-lap-p new-idom)
(comp-block-lap-no-ret
new-idom))
new-idom)
when (>= (length preds) 2) ; All joins
do (cl-loop for p in preds
for runner = p
- do (while (not (eq runner (comp-block-dom b)))
+ do (while (not (eq runner (comp-block-idom b)))
(puthash b-name b (comp-block-df runner))
- (setf runner (comp-block-dom runner))))))
+ (setf runner (comp-block-idom runner))))))
(defun comp-log-block-info ()
"Log basic blocks info for the current function."
(maphash (lambda (name bb)
- (let ((dom (comp-block-dom bb))
+ (let ((dom (comp-block-idom bb))
(df (comp-block-df bb)))
(comp-log (format "block: %s idom: %s DF %s\n"
name
(when-let ((out-edges (comp-block-out-edges bb)))
(cl-loop for ed in out-edges
for child = (comp-edge-dst ed)
- when (eq bb (comp-block-dom child))
+ when (eq bb (comp-block-idom child))
;; Current block is the immediate dominator then recur.
do (comp-dom-tree-walker child pre-lambda post-lambda)))
(when post-lambda
for bb being each hash-value of (comp-func-blocks comp-func)
for bb-name = (comp-block-name bb)
when (and (not (eq 'entry bb-name))
- (null (comp-block-dom bb)))
+ (null (comp-block-idom bb)))
do
(comp-log (format "Removing block: %s" bb-name) 1)
(remhash bb-name (comp-func-blocks comp-func))