aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/emacs-lisp/comp.el28
1 files changed, 14 insertions, 14 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 340846bf70a..ab3763f5edf 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -627,7 +627,7 @@ This is typically for top-level forms other than defun.")
627 :documentation "List of incoming edges.") 627 :documentation "List of incoming edges.")
628 (out-edges () :type list 628 (out-edges () :type list
629 :documentation "List of out-coming edges.") 629 :documentation "List of out-coming edges.")
630 (dom nil :type (or null comp-block) 630 (idom nil :type (or null comp-block)
631 :documentation "Immediate dominator.") 631 :documentation "Immediate dominator.")
632 (df (make-hash-table) :type (or null hash-table) 632 (df (make-hash-table) :type (or null hash-table)
633 :documentation "Dominance frontier set. Block-name -> block") 633 :documentation "Dominance frontier set. Block-name -> block")
@@ -2568,7 +2568,7 @@ blocks."
2568 for b being each hash-value of (comp-func-blocks f) 2568 for b being each hash-value of (comp-func-blocks f)
2569 do (setf (comp-block-in-edges b) () 2569 do (setf (comp-block-in-edges b) ()
2570 (comp-block-out-edges b) () 2570 (comp-block-out-edges b) ()
2571 (comp-block-dom b) nil 2571 (comp-block-idom b) nil
2572 (comp-block-df b) (make-hash-table) 2572 (comp-block-df b) (make-hash-table)
2573 (comp-block-post-num b) nil 2573 (comp-block-post-num b) nil
2574 (comp-block-final-frame b) nil 2574 (comp-block-final-frame b) nil
@@ -2637,14 +2637,14 @@ blocks."
2637 (finger2 (comp-block-post-num b2))) 2637 (finger2 (comp-block-post-num b2)))
2638 (while (not (= finger1 finger2)) 2638 (while (not (= finger1 finger2))
2639 (while (< finger1 finger2) 2639 (while (< finger1 finger2)
2640 (setf b1 (comp-block-dom b1) 2640 (setf b1 (comp-block-idom b1)
2641 finger1 (comp-block-post-num b1))) 2641 finger1 (comp-block-post-num b1)))
2642 (while (< finger2 finger1) 2642 (while (< finger2 finger1)
2643 (setf b2 (comp-block-dom b2) 2643 (setf b2 (comp-block-idom b2)
2644 finger2 (comp-block-post-num b2)))) 2644 finger2 (comp-block-post-num b2))))
2645 b1)) 2645 b1))
2646 (first-processed (l) 2646 (first-processed (l)
2647 (if-let ((p (cl-find-if (lambda (p) (comp-block-dom p)) l))) 2647 (if-let ((p (cl-find-if (lambda (p) (comp-block-idom p)) l)))
2648 p 2648 p
2649 (signal 'native-ice "cant't find first preprocessed")))) 2649 (signal 'native-ice "cant't find first preprocessed"))))
2650 2650
@@ -2658,7 +2658,7 @@ blocks."
2658 while changed 2658 while changed
2659 initially (progn 2659 initially (progn
2660 (comp-log "Computing dominator tree...\n" 2) 2660 (comp-log "Computing dominator tree...\n" 2)
2661 (setf (comp-block-dom entry) entry) 2661 (setf (comp-block-idom entry) entry)
2662 ;; Set the post order number. 2662 ;; Set the post order number.
2663 (cl-loop for name in (reverse rev-bb-list) 2663 (cl-loop for name in (reverse rev-bb-list)
2664 for b = (gethash name blocks) 2664 for b = (gethash name blocks)
@@ -2671,10 +2671,10 @@ blocks."
2671 for new-idom = (first-processed preds) 2671 for new-idom = (first-processed preds)
2672 initially (setf changed nil) 2672 initially (setf changed nil)
2673 do (cl-loop for p in (delq new-idom preds) 2673 do (cl-loop for p in (delq new-idom preds)
2674 when (comp-block-dom p) 2674 when (comp-block-idom p)
2675 do (setf new-idom (intersect p new-idom))) 2675 do (setf new-idom (intersect p new-idom)))
2676 unless (eq (comp-block-dom b) new-idom) 2676 unless (eq (comp-block-idom b) new-idom)
2677 do (setf (comp-block-dom b) (unless (and (comp-block-lap-p new-idom) 2677 do (setf (comp-block-idom b) (unless (and (comp-block-lap-p new-idom)
2678 (comp-block-lap-no-ret 2678 (comp-block-lap-no-ret
2679 new-idom)) 2679 new-idom))
2680 new-idom) 2680 new-idom)
@@ -2691,14 +2691,14 @@ blocks."
2691 when (>= (length preds) 2) ; All joins 2691 when (>= (length preds) 2) ; All joins
2692 do (cl-loop for p in preds 2692 do (cl-loop for p in preds
2693 for runner = p 2693 for runner = p
2694 do (while (not (eq runner (comp-block-dom b))) 2694 do (while (not (eq runner (comp-block-idom b)))
2695 (puthash b-name b (comp-block-df runner)) 2695 (puthash b-name b (comp-block-df runner))
2696 (setf runner (comp-block-dom runner)))))) 2696 (setf runner (comp-block-idom runner))))))
2697 2697
2698(defun comp-log-block-info () 2698(defun comp-log-block-info ()
2699 "Log basic blocks info for the current function." 2699 "Log basic blocks info for the current function."
2700 (maphash (lambda (name bb) 2700 (maphash (lambda (name bb)
2701 (let ((dom (comp-block-dom bb)) 2701 (let ((dom (comp-block-idom bb))
2702 (df (comp-block-df bb))) 2702 (df (comp-block-df bb)))
2703 (comp-log (format "block: %s idom: %s DF %s\n" 2703 (comp-log (format "block: %s idom: %s DF %s\n"
2704 name 2704 name
@@ -2756,7 +2756,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil."
2756 (when-let ((out-edges (comp-block-out-edges bb))) 2756 (when-let ((out-edges (comp-block-out-edges bb)))
2757 (cl-loop for ed in out-edges 2757 (cl-loop for ed in out-edges
2758 for child = (comp-edge-dst ed) 2758 for child = (comp-edge-dst ed)
2759 when (eq bb (comp-block-dom child)) 2759 when (eq bb (comp-block-idom child))
2760 ;; Current block is the immediate dominator then recur. 2760 ;; Current block is the immediate dominator then recur.
2761 do (comp-dom-tree-walker child pre-lambda post-lambda))) 2761 do (comp-dom-tree-walker child pre-lambda post-lambda)))
2762 (when post-lambda 2762 (when post-lambda
@@ -2840,7 +2840,7 @@ Return t when one or more block was removed, nil otherwise."
2840 for bb being each hash-value of (comp-func-blocks comp-func) 2840 for bb being each hash-value of (comp-func-blocks comp-func)
2841 for bb-name = (comp-block-name bb) 2841 for bb-name = (comp-block-name bb)
2842 when (and (not (eq 'entry bb-name)) 2842 when (and (not (eq 'entry bb-name))
2843 (null (comp-block-dom bb))) 2843 (null (comp-block-idom bb)))
2844 do 2844 do
2845 (comp-log (format "Removing block: %s" bb-name) 1) 2845 (comp-log (format "Removing block: %s" bb-name) 1)
2846 (remhash bb-name (comp-func-blocks comp-func)) 2846 (remhash bb-name (comp-func-blocks comp-func))