Function: comp--compute-dominator-tree

comp--compute-dominator-tree is a byte-compiled function defined in comp.el.gz.

Signature

(comp--compute-dominator-tree)

Documentation

Compute immediate dominators for each basic block in current function.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/comp.el.gz
(defun comp--compute-dominator-tree ()
  "Compute immediate dominators for each basic block in current function."
  ;; Originally based on: "A Simple, Fast Dominance Algorithm"
  ;; Cooper, Keith D.; Harvey, Timothy J.; Kennedy, Ken (2001).
  (cl-flet ((intersect (b1 b2)
              (let ((finger1 (comp-block-post-num b1))
                    (finger2 (comp-block-post-num b2)))
                (while (not (= finger1 finger2))
                  (while (< finger1 finger2)
                    (setf b1 (comp-block-idom b1)
                          finger1 (comp-block-post-num b1)))
                  (while (< finger2 finger1)
                    (setf b2 (comp-block-idom b2)
                          finger2 (comp-block-post-num b2))))
                b1))
            (first-processed (l)
              (if-let* ((p (cl-find-if #'comp-block-idom l)))
                  p
                (signal 'native-ice '("can't find first preprocessed")))))

    (when-let* ((blocks (comp-func-blocks comp-func))
                (entry (gethash 'entry blocks))
                ;; No point to go on if the only bb is 'entry'.
                (bb0 (gethash 'bb_0 blocks)))
      (cl-loop
       with rev-bb-list = (comp--collect-rev-post-order entry)
       with changed = t
       while changed
       initially (progn
                   (comp-log "Computing dominator tree...\n" 2)
                   (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 i from 0
                            do (setf (comp-block-post-num b) i)))
       do (cl-loop
           for name in (cdr rev-bb-list)
           for b = (gethash name blocks)
           for preds = (comp--block-preds b)
           for new-idom = (first-processed preds)
           initially (setf changed nil)
           do (cl-loop for p in (delq new-idom preds)
                       when (comp-block-idom p)
                       do (setf new-idom (intersect 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)
                    changed t))))))