diff options
| author | Andrea Corallo | 2021-01-02 11:30:10 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2021-01-02 12:36:40 +0100 |
| commit | 03be03d36636626d4c45acd76e2f2d36be02ec8c (patch) | |
| tree | 4bcdd64ef2df9d5ce9741d36d4ee7e300c111e02 | |
| parent | 5db5064395c251a822e429e19ddecb74a974b6ef (diff) | |
| download | emacs-03be03d36636626d4c45acd76e2f2d36be02ec8c.tar.gz emacs-03be03d36636626d4c45acd76e2f2d36be02ec8c.zip | |
* Rename `dom' slot into `idom' in `comp-block' struct
* lisp/emacs-lisp/comp.el (comp-block): Rename dom `slot' into
`idom'.
(comp-clean-ssa, comp-compute-dominator-tree)
(comp-compute-dominator-frontiers, comp-dom-tree-walker)
(comp-remove-unreachable-blocks): Update accordingly.
| -rw-r--r-- | lisp/emacs-lisp/comp.el | 28 |
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)) |