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

SCM Repository

[smlnj] Annotation of /MLRISC/releases/release-110.79/ra/cluster-partitioner.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.79/ra/cluster-partitioner.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4168 - (view) (download)

1 : leunga 641 (*
2 :     * Partition a cluster into multiple smaller clusters for region-based
3 :     * register allocation.
4 :     *)
5 :     functor ClusterPartitioner
6 :     (structure Flowgraph : FLOWGRAPH
7 :     structure InsnProps : INSN_PROPERTIES
8 :     sharing Flowgraph.I = InsnProps.I
9 :     ) : RA_FLOWGRAPH_PARTITIONER =
10 :     struct
11 :     structure F = Flowgraph
12 :     structure I = F.I
13 :     structure C = I.C
14 :     structure PQ = PriorityQueue
15 :     structure Liveness = Liveness(Flowgraph)
16 :     structure A = Array
17 :    
18 :     type flowgraph = F.cluster
19 :    
20 :     val debug = true
21 :    
22 :     fun error msg = MLRiscErrorMsg.error("ClusterPartitioner",msg)
23 :    
24 :     val maxSize = MLRiscControl.getInt "ra-max-region-size"
25 :     val _ = maxSize := 300
26 :    
27 :     fun numberOfBlocks(F.CLUSTER{blkCounter,...}) = !blkCounter
28 :    
29 :     (*
30 :     * Partition the cluster into a set of clusters so that each can
31 :     * be allocated independently.
32 :     *)
33 : leunga 744 fun partition(F.CLUSTER{blkCounter, blocks, entry, exit,
34 : leunga 641 annotations, ...})
35 :     cellkind processRegion =
36 :     (* Number of basic blocks *)
37 :     let val N = !blkCounter
38 :    
39 :     val _ = if debug then
40 :     print("[Region based register allocation: "^
41 :     Int.toString N^"]\n")
42 :     else ()
43 :     val maxSize = !maxSize
44 :    
45 :     (* Perform global liveness analysis first.
46 :     * Unfortunately, I know of no way of avoiding this step because
47 :     * we have to know which values are live across regions.
48 :     *)
49 : leunga 744 val _ = Liveness.liveness{blocks=blocks,
50 : leunga 641 defUse=InsnProps.defUse cellkind,
51 : george 901 getCell=C.getCellsByKind cellkind,
52 :     updateCell=C.updateCellsByKind cellkind
53 : leunga 641 }
54 :    
55 :     val F.ENTRY{succ=entrySucc, ...} = entry
56 :     val F.EXIT{pred=exitPred, ...} = exit
57 :     val initTrail = [(entrySucc,!entrySucc), (exitPred, !exitPred)]
58 :    
59 :     (* Priority queue of basic blocks in non-increasing order
60 :     * of execution frequency
61 :     *)
62 :     fun higherFreq(F.BBLOCK{freq=a,...}, F.BBLOCK{freq=b,...}) = !a > !b
63 :     | higherFreq _ = error "higherFreq"
64 :     val blocks = List.foldr (fn (b as F.BBLOCK _,l) => b::l | (_,l) => l)
65 :     [] blocks
66 :     val seedQueue = PQ.fromList higherFreq blocks
67 :    
68 :     (* Current region id *)
69 :     val regionCounter = ref 0
70 :     fun newRegionId() =
71 :     let val regionId = !regionCounter
72 :     in regionCounter := !regionCounter + 1; regionId end
73 :    
74 :     (* Has the block been included in any region?
75 :     * Non-negative means yes. The number is the region id in which
76 :     * the block belongs.
77 :     *)
78 :     val processed = A.array(N, ~1)
79 :    
80 :     fun hasBeenProcessed n = A.sub(processed,n) >= 0
81 :     fun markAsProcessed(n, regionId) = A.update(processed,n,regionId)
82 :    
83 :     (* Get an unprocessed seed block from the queue *)
84 :     fun getSeedBlock(regionId) =
85 :     case PQ.deleteMin seedQueue of
86 :     block as F.BBLOCK{blknum, insns, ...} =>
87 :     if hasBeenProcessed blknum then getSeedBlock(regionId)
88 :     else block
89 :     | _ => error "getSeedBlock"
90 :    
91 :     fun resetTrail [] = ()
92 :     | resetTrail((r,x)::trail) = (r := x; resetTrail trail)
93 :    
94 :     (*
95 :     * Grow a region. Currently, region growth is limited only by size.
96 :     * Note that we only select nodes with one out edges as possible
97 :     * region cut points. We also try not to make a region too small
98 :     * as it will waste initialization time. It's a delicate balance.
99 :     *)
100 :     fun growRegion() =
101 :     let val regionId = newRegionId()
102 :     fun add([], Q) = Q
103 :     | add((b as F.BBLOCK{blknum, ...},_)::bs, Q) =
104 :     if hasBeenProcessed blknum then add(bs, Q)
105 :     else add(bs, b::Q)
106 :     | add(_::bs, Q) = add(bs, Q)
107 :     fun grow((b as F.BBLOCK{blknum, succ, pred, insns, ...})::F, B,
108 :     size, blks, m) =
109 :     if hasBeenProcessed blknum
110 :     then grow(F, B, size, blks, m)
111 :     else
112 :     let val n = length(!insns)
113 :     val newSize = size + n
114 :     in if m > 0 andalso newSize > maxSize andalso length(!succ) = 1
115 :     then grow(F, B, size, blks, m)
116 :     else (markAsProcessed(blknum, regionId);
117 :     grow(F, add(!pred,add(!succ,B)), newSize,
118 :     b::blks, m+1)
119 :     )
120 :     end
121 :     | grow([], [], size, blks, m) = (size, blks, m)
122 :     | grow([], B, size, blks, m) = grow(rev B, [], size, blks, m)
123 :     | grow _ = error "grow"
124 :    
125 :     (* Find a seed block *)
126 :     val seed = getSeedBlock(regionId)
127 :    
128 :     (* Grow until we reach some limit *)
129 :     val (totalSize, blocks, blockCount) = grow([seed], [], 0, [], 0)
130 :    
131 :     (* Now create a cluster with only these blocks
132 :     * We have to update the edges so that region-entry edges
133 :     * are made into entry edges and region-exit edges are
134 :     * made into exit edges.
135 :     *)
136 :     fun makeSubgraph(blocks) =
137 :     let fun inSubgraph(y) = A.sub(processed,y) = regionId
138 :     fun processSucc(b,x,(e as (F.BBLOCK{blknum=y, ...},freq))::es,
139 :     es', exit, exitFreq) =
140 :     if inSubgraph(y) then
141 :     processSucc(b,x,es,e::es',exit,exitFreq)
142 :     else processSucc(b,x,es,es',true, exitFreq + !freq)
143 :     | processSucc(b,x,(e as (F.EXIT{blknum=y,...},freq))::es,es',
144 :     exit, exitFreq) =
145 :     processSucc(b,x,es,es', true, exitFreq + !freq)
146 :     | processSucc(b,x,[],es',true, exitFreq) =
147 :     let val w = ref exitFreq
148 :     in exitPred := (b,w) :: !exitPred;
149 :     ((exit,w)::es', true)
150 :     end
151 :     | processSucc(b,x,[],es', false, exitFreq) = (es', false)
152 :     | processSucc _ = error "processSucc"
153 :    
154 :     fun processPred(b,x,(e as (F.BBLOCK{blknum=y, ...},freq))::es,
155 :     es', entry, entryFreq) =
156 :     if inSubgraph(y) then
157 :     processPred(b,x,es,e::es',entry,entryFreq)
158 :     else processPred(b,x,es,es',true,entryFreq + !freq)
159 :     | processPred(b,x,(e as (F.ENTRY{blknum=y,...},freq))::es,es',
160 :     entry, entryFreq) =
161 :     processPred(b,x,es,es',true, entryFreq + !freq)
162 :     | processPred(b,x,[], es', true, entryFreq) =
163 :     let val w = ref entryFreq
164 :     in entrySucc := (b,w) :: !entrySucc;
165 :     ((entry,w)::es', true)
166 :     end
167 :     | processPred(b,x,[], es', false, entryFreq) = (es', false)
168 :     | processPred _ = error "processPred"
169 :    
170 :     fun processNodes([], trail) = trail
171 :     | processNodes(
172 :     (b as F.BBLOCK{blknum=n,liveIn,liveOut,succ,pred,...})
173 :     ::nodes, trail) =
174 :     let val (succ', exit) = processSucc(b,n,!succ,[],false,0)
175 :     val trail = if exit then (succ, !succ)::trail else trail
176 :     val (pred', entry) = processPred(b,n,!pred,[],false,0)
177 :     val trail = if entry then (pred, !pred)::trail else trail
178 :     in succ := succ';
179 :     pred := pred';
180 :     (* To save space, clear liveIn and
181 :     * liveOut information (if it is not an exit)
182 :     *)
183 : george 901 liveIn := CellsBasis.CellSet.empty;
184 :     if exit then () else liveOut := CellsBasis.CellSet.empty;
185 : leunga 641 processNodes(nodes, trail)
186 :     end
187 :     | processNodes _ = error "processNodes"
188 :    
189 :     val _ = entrySucc := []
190 :     val _ = exitPred := []
191 :     val trail = processNodes(blocks, initTrail)
192 :     in trail
193 :     end
194 :    
195 :     (* Make a subgraph with the appropriate edges *)
196 :     val trail = makeSubgraph(blocks)
197 :    
198 :     val region =
199 : leunga 744 F.CLUSTER{blkCounter = blkCounter,
200 : leunga 641 blocks = blocks,
201 :     entry = entry,
202 :     exit = exit,
203 :     annotations = annotations
204 :     }
205 :     in (regionId, region, trail, blockCount)
206 :     end
207 :    
208 :     (*
209 :     * Extract a new region to compile. Raises PQ.EmptyPriorityQueue if
210 :     * everything is finished.
211 :     *)
212 :     fun iterate() =
213 :     let val (id, region, trail, blockCount) = growRegion() (* get a region *)
214 :     in if debug then
215 :     print("[Region "^Int.toString id^" has "^Int.toString blockCount^
216 :     " blocks]\n")
217 :     else ();
218 :     processRegion region; (* allocate this region *)
219 :     resetTrail trail; (* reset the flowgraph *)
220 :     iterate() (* process next region *)
221 :     end
222 :    
223 :     in (* Repeat until the entire flowgraph has been processed *)
224 :     iterate() handle PQ.EmptyPriorityQueue => ();
225 :     if debug then print "[Region based register allocation done]\n" else ()
226 :     end
227 :    
228 :     end

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