Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/ir-archive/loop-structure.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/ir-archive/loop-structure.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1538, Tue Jul 13 19:04:05 2004 UTC revision 1539, Tue Jul 13 19:05:30 2004 UTC
# Line 1  Line 1 
1  (*  (*
2   * This module is responsible for locating loop structures (intervals).   * This module is responsible for locating loop structures (intervals).
3   * All loops have only one single entry (via the header) but   * All loops have only one single entry (via the header) but
4   * potentially multiple exits, i.e. the header dominates all nodes   * potentially multiple exits, i.e. the header dominates all nodes.
5   * within the loop.   Other definitions are used for ``loops'' and ``headers''   * Basically this is Tarjan's algorithm.
  * in the literature.  We choose a structural definition that has nicer  
  * properties.  
6   *   *
7   * I haven't seen this algorithm described in the literature but I'm   * The old version is broken as reported by William Chen.
8   * quite sure that it works in linear time, given that the dominator tree   * This is a rewrite.
  * has already been computed.  
  *  
  * -- Allen  
9   *)   *)
10    
11  functor LoopStructure (structure GraphImpl : GRAPH_IMPLEMENTATION  functor LoopStructure (structure GraphImpl : GRAPH_IMPLEMENTATION
# Line 22  Line 17 
17     structure GI  = GraphImpl     structure GI  = GraphImpl
18     structure Dom = Dom     structure Dom = Dom
19     structure A   = Array     structure A   = Array
20       structure U   = URef
21    
22     datatype ('n,'e,'g) loop =     datatype ('n,'e,'g) loop =
23        LOOP of { nesting    : int,        LOOP of { nesting    : int,
# Line 39  Line 35 
35    
36     fun dom(G.GRAPH{graph_info=INFO{dom,...},...}) = dom     fun dom(G.GRAPH{graph_info=INFO{dom,...},...}) = dom
37    
38     fun loop_structure DOM = let     fun loop_structure DOM =
39       let
40       val info               = INFO{ dom = DOM }       val info               = INFO{ dom = DOM }
41       val G.GRAPH cfg        = Dom.cfg DOM       val G.GRAPH cfg        = Dom.cfg DOM
42       val G.GRAPH dom        = DOM       val G.GRAPH dom        = DOM
# Line 49  Line 46 
46       val ENTRY              = case #entries cfg () of       val ENTRY              = case #entries cfg () of
47                                  [ENTRY] => ENTRY                                  [ENTRY] => ENTRY
48                                | _ => raise Graph.NotSingleEntry                                | _ => raise Graph.NotSingleEntry
49       val headers            = A.array(N,~1) (* header forest *)  
50           (* mapping from node id -> header *)
51           val headers = A.array(N, ~1)
52    
53           (* mapping from header -> previous header in the loop *)
54           val lastHeaders = A.array(N, ~1)
55    
56           (* mark all visited nodes during construction *)
57       val visited            = A.array(N,~1)       val visited            = A.array(N,~1)
58    
59       fun find_loops (header,level) i = let         (* mapping from nodes id -> collapsed header during construction *)
60         val backedges = List.filter (fn (j,i,_) => dominates(i,j)) (#in_edges cfg i)         val P       = A.tabulate(N, U.uRef)
61         val is_header = case backedges of [] => i = ENTRY | _  => true  
62           (* walk the dominator tree and return a list of loops *)
63           fun walk (X, loops) =
64           let
65               (* Look for backedges *)
66               val backedges = List.filter
67                   (fn (Y, X, _) => dominates(X, Y)) (#in_edges cfg X)
68               (* X is a header iff it has backedges or X is the ENTRY *)
69               val is_header = case backedges of [] => X = ENTRY | _ => true
70    
71               (* Walk the dominator tree first *)
72               val loops = List.foldr walk loops (#succ dom X)
73       in       in
74         if not(is_header) then             (* If X is a header node then collaspe all the nodes within
75           app (find_loops (header,level)) (#succ dom i)              * the loop into the header.  The entry node has to be
76         else let (* i is now the new loop header *)              * treated specially, unfortunately.
77                  (* find all nested loops first *)              *)
78              val _ = app (find_loops (i,level+1)) (#succ dom i)             if is_header then
79              (* locate all loop nodes *)                let val L = mark(X, X, [])
80              fun find_loop_nodes([],nodes) = nodes                    val L = if X = ENTRY then find_entry_loop_nodes [] else L
81                | find_loop_nodes((j,_,_)::es,nodes) =                    val () = collapse(X, L)
82                  if i = j then find_loop_nodes(es,nodes)                    val exits = find_exits(L, [])
83                  else find_loop_nodes(es,do_node(j,nodes))                in  (* Create a new loop node *)
84              and do_node(j,nodes) =  (* j is not the header i *)                    (X, backedges, L, exits)::loops
                 let val v = A.sub(visited,j)  
                 in  if v = ~1 then (* j is a new loop node *)  
                      (A.update(headers,j,i);  
                       A.update(visited,j,i);  
                       find_loop_nodes(#in_edges cfg j,j::nodes))  
                     else chase_header(v,j,nodes)  
85                  end                  end
             and chase_header(v,j,nodes) =  
                 if v = i then nodes (* j has been visited before *)  
86                  else                  else
87                     (* j is in a nested loop *)                loops
88                  let val _ = A.update(visited,j,i) (* mark j as visited *)         end
89                      val h = A.sub(headers,j)  
90                  in  if h = i then  
91                         (* j is a header immediately nested under i *)            (* mark all the nodes that are within the loop identified
92                         find_loop_nodes(#in_edges cfg j,nodes)             * by the header.  Return a list of loop nodes.
93                      else (A.update(headers,j,i); (* path compression *)             *)
94                            chase_header(A.sub(visited,h),h,nodes))         and mark(X, header, L) =
95                  end            if A.sub(visited, X) <> header then
96              let
97              fun find_entry_loop_nodes() =                (* mark X as visited *)
98                 map #1 (List.filter (fn (i,n) => A.sub(headers,i) = ~1)                val _ = A.update(visited, X, header)
99                           (#nodes cfg ()))  
100                  (* header of X *)
101              fun find_exits(header,[],exits) = exits                val H_X = A.sub(headers, X)
102                | find_exits(header,i::is,exits) =  
103                  let fun f((e as (i,j,_))::es,exits) =                val L = if H_X = ~1 then (* X has no header yet *)
104                        if A.sub(headers,j) = ~1                            X::L
105                        then f(es,e::exits) else f(es,exits)                        else if H_X = X andalso A.sub(lastHeaders, X) = ~1 then
106                              (* Add loop edge *)
107                              (A.update(lastHeaders, X, header);
108                               #add_edge ls (header, X, ());
109                               L
110                              )
111                          else L
112              in  List.foldr (fn ((Y, _, _), L) =>
113                    let val Y = U.!! (A.sub(P, Y))
114                    in  if dominates(header, Y) then mark(Y, header, L) else L
115                    end) L (#in_edges cfg X)
116              end
117              else L
118    
119              (* collapse all nodes in L to the header H *)
120           and collapse(H, L) =
121               let val h = A.sub(P, H)
122               in  List.app (fn X =>
123                      (U.link (A.sub(P, X), h);
124                       if A.sub(headers, X) = ~1 then
125                          A.update(headers, X, H)
126                       else ())) L
127               end
128    
129              (* find all nodes that are not part of any loops *)
130           and find_entry_loop_nodes L =
131               List.foldr (fn ((X, _), L) =>
132                     if A.sub(headers, X) = ~1 then
133                         X::L
134                     else if X <> ENTRY andalso
135                          A.sub(headers, X) = X andalso
136                          A.sub(lastHeaders, X) = ~1 then
137                          (#add_edge ls (ENTRY, X, ());
138                           A.update(lastHeaders, X, ENTRY);
139                           L
140                          )
141                     else
142                         L
143                     ) L (#nodes cfg ())
144    
145    
146               (* find all edges that can exit from the loop H *)
147           and find_exits([],exits) = exits
148             | find_exits(X::Xs,exits) =
149               let fun f((e as (X,Y,_))::es,exits) =
150                       if A.sub(headers,Y) = ~1
151                       then f(es,e::exits)
152                       else f(es,exits)
153                        | f([], exits) = exits                        | f([], exits) = exits
154                  in  find_exits(header,is,f(#out_edges cfg i,exits)) end             in  find_exits(Xs, f(#out_edges cfg X, exits))
155               end
156    
157              val _     = A.update(headers,i,header)         (* walk tree and create edges *)
158              val _     = A.update(visited,i,i)         val loops = walk (ENTRY, [])
159    
160              val nodes =         (* create nodes *)
161                if i = ENTRY then find_entry_loop_nodes()         val () = List.app (fn (H, backedges, loop_nodes, exits) =>
162                else find_loop_nodes(backedges,[])               let val last = A.sub(lastHeaders, H)
163              val exits =                   val nesting = if last = ~1 then 0
164                if i = ENTRY then [] else find_exits(i,i::nodes,[])                                 else
165                                      let val LOOP{nesting, ...} =
166              val loop  =                                            #node_info ls last
167                LOOP { nesting    = level,                                    in  nesting+1 end
168                       header     = i,               in  #add_node ls (H, LOOP{nesting    = nesting,
169                                           header     = H,
170                       backedges  = backedges,                       backedges  = backedges,
171                       loop_nodes = nodes,                                         loop_nodes = loop_nodes,
172                       exits      = exits                                         exits      = exits})
173                      }               end) loops
174           in           in
            #add_node ls (i,loop);  
            if i = ENTRY then () else #add_edge ls (header,i,())  
          end  
       end (* find_loops *)  
    in  find_loops (ENTRY,0) ENTRY;  
        #set_entries ls [ENTRY];  
175         LS         LS
176     end (* loop_structure *)     end
177    
178     fun nesting_level(G.GRAPH L) = let     fun nesting_level(G.GRAPH L) = let
179       val INFO{dom=G.GRAPH dom,...} = #graph_info L       val INFO{dom=G.GRAPH dom,...} = #graph_info L
# Line 147  Line 197 
197       #forall_nodes L tabulate;   headers       #forall_nodes L tabulate;   headers
198     end     end
199    
   
   
200     fun entryEdges(Loop as G.GRAPH L) = let     fun entryEdges(Loop as G.GRAPH L) = let
201       val dom = dom Loop       val dom = dom Loop
202       val G.GRAPH cfg = Dom.cfg dom       val G.GRAPH cfg = Dom.cfg dom

Legend:
Removed from v.1538  
changed lines
  Added in v.1539

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0