PreviousUpNext

15.4.762  src/lib/graph/dominator-tree-g.pkg

# dominator-tree-g.pkg 
# Computation of the dominator tree representation from the
# control flow graph.  I'm using the old algorithm by Lengauer and Tarjan.
#
# Note: to deal with machcode_controlflow_graph with endless loops,
# by default we assume instructions are postdominated by STOP. 
#
# -- Allen Leung

# Compiled by:
#     src/lib/graph/graphs.lib


###                    "God could not be everywhere, and
###                     therefore he made mothers."
###
###                                   -- Rudyard Kipling      


stipulate
    package odg = oop_digraph;                                  # oop_digraph   is from   src/lib/graph/oop-digraph.pkg
    package rev = reversed_graph_view;                          # reversed_graph_view   is from   src/lib/graph/revgraph.pkg
    package rwv = rw_vector;                                    # rw_vector             is from   src/lib/std/src/rw-vector.pkg
#   package node_set = bit_set;                                 # bit_set               is from   src/lib/graph/bit-set.pkg
herein

    # We get invoked from:
    #
    #     src/lib/compiler/back/low/frequencies/guess-machcode-loop-probabilities-g.pkg
    #
    generic package   dominator_tree_g   (
        #             ================
        #
        meg:  Make_Empty_Graph                                  # Make_Empty_Graph      is from   src/lib/graph/make-empty-graph.api
    )
    : (weak)  Dominator_Tree                                    # Dominator_Tree        is from   src/lib/graph/dominator-tree.api
    {
        # Export to client packages:
        #
        package meg = meg;

        exception DOMINATOR;

        fun single_entry_of (odg::DIGRAPH g)
            =
            case (g.entries ())
                #         
                [e] => e;
               _ => raise exception DOMINATOR;
            esac;

        Node = odg::Node_Id;

        Dom_Info (N, E, G)
            = 
            INFO 
            { mcg:         odg::Digraph( N, E, G ),  
              edge_label:  String,
              levels_map:  rw_vector::Rw_Vector( Int ),
              preorder:    Ref( Null_Or( rw_vector::Rw_Vector( Int ) ) ),
              postorder:   Ref( Null_Or( rw_vector::Rw_Vector( Int ) ) ),
              entry_pos:   Ref( Null_Or( rw_vector::Rw_Vector( Int ) ) ),
              max_levels:  Ref( Int )
            };

        Dominator_Tree     (N,E,G) =  odg::Digraph (N, Void, Dom_Info(N,E,G));
        Postdominator_Tree (N,E,G) =  odg::Digraph (N, Void, Dom_Info(N,E,G));

        fun graph_info (odg::DIGRAPH dom) :  Dom_Info( N, E, G )
            =
            dom.graph_info; 

        fun mcg (odg::DIGRAPH dom)
            =
            {   dom.graph_info ->   INFO { mcg, ... };
                mcg;
            };

        fun max_levels (odg::DIGRAPH dom)
            = 
            {   dom.graph_info ->   INFO { max_levels, ... };
                #
                *max_levels;
            };


        # This is the main Lengauer/Tarjan algorithm
        #
        fun tarjan_lengauer (name, edge_label) (orig_cfg, mcg'' as (odg::DIGRAPH mcg))
            =
            {   nnn         = mcg.order ();
                mmm         = mcg.capacity ();
                r           = single_entry_of mcg'';
                in_edges    = mcg.in_edges;
                next        = mcg.next;
                dfnum       = rwv::make_rw_vector (mmm, -1);
                vertex      = rwv::make_rw_vector (nnn, -1); 
                parent      = rwv::make_rw_vector (mmm, -1);  
                bucket      = rwv::make_rw_vector (mmm, []) : Rw_Vector(  List(  Node ) );
                semi        = rwv::make_rw_vector (mmm, r);  
                ancestor    = rwv::make_rw_vector (mmm, -1); 
                idom        = rwv::make_rw_vector (mmm, r); 
                samedom     = rwv::make_rw_vector (mmm, -1);
                best        = rwv::make_rw_vector (mmm, -1);
                max_levels  = REF 0;
                levels_map   = rwv::make_rw_vector (mmm,-1000000);
                dom_info    = INFO { mcg        => orig_cfg, 
                                        edge_label,
                                        levels_map,
                                        preorder   => REF NULL,
                                        postorder  => REF NULL,
                                        entry_pos   => REF NULL,
                                        max_levels 
                                      };

                my  dom as odg::DIGRAPH domtree
                    =
                    meg::make_empty_graph
                      {
                        graph_name          =>  name,                   # Arbitrary client name for graph, for human-display purposes.
                        graph_info          =>  dom_info,               # Arbitrary client value to associate with graph.
                        expected_node_count  => nnn                     # Hint for initial sizing of internal graph vectors. This is not a hard limit.
                      };

                # step 1 
                # Initialize semi dominators and parent map

                fun dfs (p, n, nnn)
                    =
                    if (rwv::get (dfnum, n) == -1)
                        #                    
                        rwv::set (dfnum, n, nnn);
                        rwv::set (vertex, nnn, n);
                        rwv::set (parent, n, p);
                        dfs_succ (n, next n, nnn+1);
                    else
                        nnn;
                    fi

                also
                fun dfs_succ (p,[], nnn)
                        =>
                        nnn;

                    dfs_succ (p, n ! ns, nnn)
                        =>
                        dfs_succ (p, ns, dfs (p, n, nnn));
                end 

                also
                fun dfs_all (n ! ns, nnn)
                        =>
                        dfs_all (ns, dfs(-1, n, nnn));

                    dfs_all([], nnn)
                        =>
                        ();
                end;

                non_roots
                    =
                    list::fold_backward 
                        (\\ ((r', _), l)
                            =
                            if   (r != r'   )   r' ! l;
                                           else        l;   fi)
                        []
                        (mcg.nodes ());

                dfs_all (non_roots, dfs(-1, r, 0));


         #       fun pr s = print (s + "\n")
         #       fun dumpArray title a = 
         #          pr (title + ": " +
         #                      string::cat (rwv::fold_backward 
         #                         (\\ (i, s) => int::to_string i ::( ) ! s) [] a))
         #
         #       pr("root = " + int::to_string r)
         #       dumpArray "vertex" vertex
         #       dumpArray "dfnum" dfnum
         #       dumpArray "parent" parent
         #       Msg::printMessages (\\ _ => machcode_controlflow_graph::G.printGraph *msg::out_stream mcg)


                fun link (p, n)
                    =
                    {   rwv::set (ancestor, n, p);
                        rwv::set (best, n, n);
                    };

                fun ancestor_with_lowest_semi v
                    =
                    {   a = rwv::get (ancestor, v);

                        if (a != -1   and   rwv::get (ancestor, a) != -1)
                            #                        
                            b =  ancestor_with_lowest_semi a;

                            rwv::set (ancestor, v, rwv::get (ancestor, a));


                            if  (rwv::get (dfnum, rwv::get (semi, b))
                                 <
                                 rwv::get (dfnum, rwv::get (semi, rwv::get (best, v)))
                            )
                                 rwv::set (best, v, b);
                            fi;
                        fi;

                        u = rwv::get (best, v); 

                        u == -1   ??   v
                                  ::   u;
                    };

                # steps 2 and 3
                # Compute vertex, bucket and semi maps 
                #       
                fun compute 0
                        =>
                        ();

                    compute i
                        => 
                        {   n =  rwv::get (vertex, i);

                            p =  rwv::get (parent, n);

                            fun compute_semi ((v, n, _) ! rest, s)
                                    =>
                                    if   (v == n)

                                         compute_semi (rest, s);
                                    else
                                         s'  =
                                             if  (rwv::get (dfnum, v)
                                                  <
                                                  rwv::get (dfnum, n)
                                             )
                                                 v;
                                             else
                                                 rwv::get (semi, ancestor_with_lowest_semi v);
                                             fi;

                                         s   =
                                             if  (rwv::get (dfnum, s')
                                                  < 
                                                  rwv::get (dfnum, s)
                                             )
                                                  s';
                                             else s;
                                             fi;

                                        compute_semi (rest, s); 
                                    fi;

                                compute_semi ([], s)
                                    =>
                                    s;
                            end;

                            if (p != -1)
                                #
                                s = compute_semi (in_edges n, p);
                                rwv::set (semi, n, s);
                                rwv::set (bucket, s, n ! rwv::get (bucket, s));
                                link (p, n);

                                apply
                                    (\\ v
                                        = 
                                        {   y = ancestor_with_lowest_semi v;

                                            if  (rwv::get (semi, y)
                                                 ==
                                                 rwv::get (semi, v)
                                            )
                                                 rwv::set (idom,    v, p);
                                            else rwv::set (samedom, v, y);
                                            fi;
                                        })
                                    (rwv::get (bucket, p));

                                rwv::set (bucket, p,[]);
                            fi;
                            compute (i - 1);
                        };
                end;                            # fun compute

                compute (nnn - 1);


    #       dumpArray "semi" idom
    #       dumpArray "idom" idom


                # Step 4:  Update dominators:
                # 
                fun update_idoms i
                    = 
                    if (i < nnn)
                        #                    
                        n = rwv::get (vertex, i);

                        if (rwv::get (samedom, n) != -1) 
                            #
                            rwv::set (idom, n, rwv::get (idom, rwv::get (samedom, n)));
                        fi;

                        update_idoms (i+1);   
                    fi;

                update_idoms 1;


    #       dumpArray "idom" idom


                # Create the nodes/edges
                # of the dominator tree:
                #
                fun build_graph (i, max_level)
                    =
                    if (i < nnn)
                        #                    
                        v = rwv::get (vertex, i);

                        domtree.add_node (v, mcg.node_info v);

                        if (v != r)
                            #                           
                            w = rwv::get (idom, v);
                            l = rwv::get (levels_map, w)+1;

                            rwv::set (levels_map, v, l);
                            domtree.add_edge (w, v, ());

                            build_graph
                              (
                                i+1,
                                l >= max_level  ??  l
                                                ::  max_level
                              );  
                        else 
                            rwv::set (levels_map, v, 0);
                            build_graph (i+1, max_level);
                        fi;

                    else
                         max_level;
                    fi;

                max = build_graph (0, 1);

                max_levels := max+1;

                domtree.set_entries [r];

                #  Msg::printMessages (\\ _ =  odg::printGraph *msg::out_stream domtree); 

                dom;
            };


        #  The algorithm specialized to making dominators and postdominators 

        fun make_dominator mcg
            =
            tarjan_lengauer("Dom", "dom") (mcg, mcg);

        fun make_postdominator mcg
            = 
            tarjan_lengauer("PDom", "pdom") (mcg, rev::rev_view mcg);

        #  Methods 

        # Does i immediately dominate j? 
        #
        fun immediately_dominates (odg::DIGRAPH d) (i, j)
            =
            case (d.in_edges j)

                 (k, _, _) ! _ =>  i == k;
                 _             =>  FALSE;
            esac;

        # Immediate dominator of n:
        #
        fun idom (odg::DIGRAPH d) n
            = 
            case (d.in_edges n)

                 (n, _, _) ! _ =>   n;
                 _             =>  -1;
            esac;

        # Nodes that n immediately dominates:
        #
        fun idoms (odg::DIGRAPH d)
            =
            d.next;

        # Nodes that n dominates:
        #
        fun doms (odg::DIGRAPH d)
            = 
            \\ n =  subtree ([n], [])
            where
                fun subtree (    [], s) =>  s;
                    subtree (n ! ns, s) =>  subtree (d.next n, subtree (ns, n ! s));
                end;
            end;


        fun pre_post_orders (g as odg::DIGRAPH dom)
            =
            {   my INFO { preorder, postorder, ... }
                    =
                    dom.graph_info;

                # Compute the preorder/postorder numbers 
                #
                fun compute_them ()
                    =
                    {   nnn   =  dom.capacity ();

                        r =  single_entry_of g;

                        pre  =  rwv::make_rw_vector (nnn,-1000000);
                        post =  rwv::make_rw_vector (nnn,-1000000);

                        fun compute_numbering (preorder, postorder, n)
                            = 
                            {   rwv::set (pre, n, preorder);

                                my (preorder', postorder')
                                    =
                                    compute_numbering'(preorder+1, postorder, dom.out_edges n);

                                rwv::set (post, n, postorder');

                                (preorder', postorder'+1);
                            }

                        also
                        fun compute_numbering'(preorder, postorder,[])
                                =>
                                (preorder, postorder);

                            compute_numbering'(preorder, postorder, (_, n, _) ! es)
                                =>
                                {   my (preorder', postorder')
                                        = 
                                        compute_numbering (preorder, postorder, n);

                                    my (preorder', postorder')
                                        =
                                        compute_numbering'(preorder', postorder', es);

                                    (preorder', postorder');
                                };
                        end;

                        compute_numbering (0, 0, r) ;

                        preorder  :=  THE pre;
                        postorder :=  THE post;

                        (pre, post);
                    };

                case (*preorder, *postorder)

                     (THE pre, THE post) =>  (pre, post);
                     _                   =>  compute_them();
                esac;
            };

        # Level 
        #
        fun level (odg::DIGRAPH d)
            = 
            {   my INFO { levels_map, ... }
                    =
                    d.graph_info;

                \\ i =  rwv::get (levels_map, i);
            };


        # Entry position:
        #
        fun entry_pos (g as odg::DIGRAPH d)
            =
            {   my INFO { entry_pos, ... } = d.graph_info;

                case *entry_pos
                    #         
                    THE t => t;

                    NULL
                        => 
                        {   entry =  single_entry_of g;
                            nnn   =  d.capacity ();
                            t     =  rwv::make_rw_vector (nnn, entry);

                            fun init (x, y)
                                = 
                                {   rwv::set (t, x, y);

                                    apply
                                        (\\ z =  init (z, y))
                                        (d.next x);
                                };

                            entry_pos := THE t;

                            apply
                                (\\ z =  init (z, z))
                                (d.next entry);
                            t;
                        };
                esac;
            };

        # Least common ancestor 
        #
        fun lca (dom as odg::DIGRAPH d) (a, b)
            =
            {   l_a =  level dom a; 
                l_b =  level dom b;

                fun idom i
                    =
                    case (d.in_edges i)

                         (j, _, _) ! _
                             =>
                             j;

                         []  =>
                             raise exception DIE "dominator_tree: lca: idom: []";
                    esac;

                fun up_a (a, l_a) =  if  (l_a > l_b  )  up_a (idom a, l_a - 1);  else  a;   fi;
                fun up_b (b, l_b) =  if  (l_b > l_a  )  up_b (idom b, l_b - 1);  else  b;   fi;

                a =  up_a (a, l_a);
                b =  up_b (b, l_b);

                fun up_both (a, b)
                    =
                    if   (a == b)

                         a;
                    else
                         up_both (idom a, idom b);
                    fi;

                up_both (a, b);
            };

        # is x and ancestor of y in d?
        # This is true iff PREORDER x <= PREORDER y and
        #                  POSTORDER x >= POSTORDER y
        #
        fun dominates dom
            =
            {   my (pre, post)
                    =
                    pre_post_orders  dom;

                \\ (x, y)
                    =
                    {   a =  rwv::get (pre, x);
                        b =  rwv::get (post, x);
                        c =  rwv::get (pre, y);
                        d =  rwv::get (post, y);

                        a <= c  and  b >= d;
                    };
            };

        fun strictly_dominates dom
            = 
            {   my (pre, post)
                    =
                    pre_post_orders dom;

                \\ (x, y)
                    =
                    {   a =  rwv::get (pre,  x);
                        b =  rwv::get (post, x);
                        c =  rwv::get (pre,  y);
                        d =  rwv::get (post, y);

                        a < c  and  b > d;
                    };
            };

        fun control_equivalent (dom, pdom)
            =
            {   dom  =  dominates dom;
                pdom =  dominates pdom;

                \\ (x, y)
                    =
                    dom (x, y) and pdom (y, x) or dom (y, x) and pdom (x, y);
            };

        # control equivalent partitions 
        # two nodes a and b are control equivalent iff
        #    a dominates b and b postdominates a (or vice versa) 
        # We use the following property of dominators to avoid wasteful work:
        #    If i dom j dom k and j not pdom i then
        #          k not pdom i
        # This algorithm runs in O (n)  
        #
        fun control_equivalent_partitions (odg::DIGRAPH d, pdom)
            =
            {   postdominates = dominates pdom;

                fun walk_dom ([], s)
                        =>
                        s;

                    walk_dom (n ! waiting, s)
                        =>
                        {   my (waiting, s, s')
                                = 
                                find_equiv (n, d.out_edges n, waiting, s,[n]);

                            walk_dom (waiting, s' ! s);
                        };
                end 

                also
                fun find_equiv (i,[], waiting, s, s')
                        =>
                        (waiting, s, s');

                    find_equiv (i, (_, j, _) ! es, waiting, s, s')
                        =>
                        if (postdominates (j, i))
                            # 
                            my (waiting, s, s')
                                =
                               find_equiv (i, es, waiting, s, j ! s');

                            find_equiv (i, d.out_edges j, waiting, s, s');
                        else
                            find_equiv (i, es, j ! waiting, s, s');
                        fi;
                end;

                equiv_sets = walk_dom (d.entries (),[]);

                equiv_sets;
            };


        fun levels_map (odg::DIGRAPH dom)
            =
            {   my INFO { levels_map, ... }
                    =
                    dom.graph_info;

                levels_map;
            };


        fun idoms_map (odg::DIGRAPH dom)
            =
            {   idoms =  rwv::make_rw_vector (dom.capacity (),-1);

                dom.forall_edges
                    (\\ (i, j, _) =  rwv::set (idoms, j, i));

                idoms;
            };
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext