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/trunk/staged-alloc/allocator/staged-allocation-fn.sml
ViewVC logotype

Annotation of /MLRISC/trunk/staged-alloc/allocator/staged-allocation-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3218 - (view) (download)

1 : mrainey 3178 (* staged-allocation-fn.sml
2 : mrainey 3140 *
3 : mrainey 3178 * This code implements the Staged Allocation technique for calling conventions.
4 :     * You can find the POPL06 paper describing this technique at
5 :     * http://www.eecs.harvard.edu/~nr/pubs/staged-abstract.html
6 :     *
7 :     * Mike Rainey (mrainey@cs.uchicago.edu)
8 :     *
9 : mrainey 3140 *)
10 :    
11 : mrainey 3178 functor StagedAllocationFn (
12 :     type reg_id
13 :     type loc_kind
14 :     val memSize : int (* number of bytes addressable in the target machine *)
15 :     ) :> STAGED_ALLOCATION
16 :     where type loc_kind = loc_kind
17 :     where type reg_id = reg_id
18 :     =
19 : mrainey 3140 struct
20 :    
21 : mrainey 3178 exception StagedAlloc of string
22 : mrainey 3140
23 : mrainey 3178 type loc_kind = loc_kind
24 :     type width = int
25 : mrainey 3140
26 : mrainey 3178 type req = (width * loc_kind * int)
27 : mrainey 3140
28 : mrainey 3178 (* locations consist of machine registers, offsets in to overflow blocks, combinations of
29 :     * locations, and narrowed locations (Figure 3).
30 : mrainey 3140 *)
31 : mrainey 3178 type reg_id = reg_id
32 :     type reg = (int * loc_kind * reg_id)
33 : mrainey 3140 datatype loc
34 : mrainey 3178 = REG of reg
35 :     | BLOCK_OFFSET of (width * loc_kind * int)
36 :     | COMBINE of (loc * loc)
37 :     | NARROW of (loc * width * loc_kind) (* specifies a coercion to the given width and kind *)
38 : mrainey 3140
39 : mrainey 3178 (* the store
40 :     * the store keeps three pieces of information
41 :     * - a map from counters to their values
42 :     * - the overflow block
43 :     * - the list of allocated registers
44 :     *)
45 :     type counter = int
46 :     structure Store = IntBinaryMap
47 :     type store = (int Store.map * loc option * loc list)
48 :     fun insert ((store, ob, regs), c, n) = (Store.insert (store, c, n), ob, regs)
49 :     fun init cs = List.foldl (fn (c, store) => insert(store, c, 0)) (Store.empty, NONE, []) cs
50 :     fun find ((store, _, _), c) = (case Store.find (store, c)
51 :     of SOME v => v
52 :     | NONE => raise StagedAlloc "missing store location"
53 :     (* end case *))
54 :     fun setOverflowBlock ((store, _, regs), ob) = (store, SOME ob, regs)
55 :     fun addReg ((store, ob, regs), reg) = (store, ob, reg :: regs)
56 : mrainey 3140
57 : mrainey 3178 datatype block_direction = UP | DOWN
58 :    
59 :     (* language for specifying calling conventions (Figure 7) *)
60 :     datatype stage
61 :     = OVERFLOW of { (* overflow block (usually corresponds to a runtime stack) *)
62 :     counter : counter,
63 :     blockDirection : block_direction,
64 :     maxAlign : int
65 :     }
66 :     | WIDEN of (width -> width)
67 :     | CHOICE of ( (req -> bool) * stage) list (* choose the first stage whose corresponding
68 :     * predicate is true. *)
69 :     | REGS_BY_ARGS of (counter * reg list) (* the first n arguments go into the first n
70 :     * registers *)
71 :     | ARGCOUNTER of counter
72 :     | REGS_BY_BITS of (counter * reg list) (* the first n bits arguments go into the first
73 :     * n bits of registers *)
74 :     | BITCOUNTER of counter
75 :     | SEQ of stage list (* sequence of stages *)
76 :     | PAD of counter (* specifies an alignment (this rule applies even
77 :     * for registers) *)
78 :     | ALIGN_TO of (width -> width) (* specifies an alignment *)
79 : mrainey 3140
80 : mrainey 3178 (* source for globally unique counter values *)
81 : mrainey 3140 local
82 : mrainey 3178 val globalCounter = ref 0
83 : mrainey 3140 in
84 : mrainey 3178 fun freshCounter () = let
85 :     val c = !globalCounter
86 :     in
87 :     globalCounter := c + 1;
88 :     c
89 :     end
90 : mrainey 3140 end (* local *)
91 :    
92 : mrainey 3178 (* bit width of a machine location *)
93 :     fun width (REG (w, _, _)) = w
94 :     | width (BLOCK_OFFSET (w, _, _)) = w
95 :     | width (COMBINE (l1, l2)) = width l1 + width l2
96 :     | width (NARROW (_, w, _)) = w
97 : mrainey 3173
98 : mrainey 3178 fun useRegs rs = let
99 :     val c = freshCounter ()
100 :     in
101 :     (c, SEQ [BITCOUNTER c, REGS_BY_BITS (c, rs)])
102 :     end
103 : mrainey 3140
104 : mrainey 3178 fun divides (x, y) = Int.mod (x, y) = 0
105 :     fun toMemSize sz = sz div memSize
106 :     val roundUp = Int.max
107 : mrainey 3140
108 : mrainey 3178 (* Figure 8 *)
109 :     fun dropBits (0, rs) = rs
110 :     | dropBits (n, []) = []
111 :     | dropBits (n, r as (w, _, _) :: rs) = if (n >= w)
112 :     then dropBits (n - w, rs)
113 :     else rs
114 : mrainey 3140
115 : mrainey 3178 (* Figure 8 *)
116 :     fun drop (0, rs) = rs
117 :     | drop (n, []) = []
118 :     | drop (n, r :: rs) = drop (n - 1, rs)
119 : mrainey 3140
120 : mrainey 3178 (* Figure 6: allocator machine *)
121 :     fun step stages ((w, k, al), store) = (case stages
122 :     of [] => (NONE, store)
123 :     (* allocate upwards on the overflow block *)
124 :     | OVERFLOW{counter, blockDirection=UP, maxAlign} :: stages =>
125 :     if (divides(maxAlign, al) andalso divides(w, memSize))
126 :     then let
127 :     val n = find(store, counter)
128 :     val n' = roundUp(n, al)
129 :     val store = insert(store, counter, n + toMemSize w)
130 :     val ob = BLOCK_OFFSET (w, k, n)
131 :     val store = setOverflowBlock(store, ob)
132 :     in
133 :     (SOME ob, store)
134 :     end
135 :     else raise StagedAlloc "overflow up"
136 :     (* allocate downwards on the overflow block *)
137 :     | OVERFLOW{counter, blockDirection=DOWN, maxAlign} :: stages =>
138 :     if (divides(maxAlign, al) andalso divides(w, memSize))
139 :     then let
140 :     val n = find(store, counter)
141 :     val n' = roundUp(n, al) + w div memSize
142 :     val store = insert(store, counter, n')
143 :     val ob = BLOCK_OFFSET (w, k, n)
144 :     val store = setOverflowBlock(store, ob)
145 :     in
146 :     (SOME ob, store)
147 :     end
148 :     else raise StagedAlloc "overflow down"
149 :     (* widen a location *)
150 :     | WIDEN f :: stages =>
151 :     if (w <= f w)
152 :     then let
153 :     val (SOME loc, store') = step stages ((f w, k, al), store)
154 :     val loc' = if w = f w
155 :     then loc (* eliminate unnecessary narrowed locations *)
156 :     else NARROW(loc, w, k)
157 :     in
158 :     (SOME loc', store')
159 :     end
160 :     else raise StagedAlloc "widen"
161 :     (* choose the first stage whose corresponding predicate is true. *)
162 :     | CHOICE choices :: stages => let
163 :     fun choose [] = raise StagedAlloc "choose"
164 :     | choose ((p, c) :: choices) = if (p (w, k, al))
165 :     then c
166 :     else choose choices
167 :     val choice = choose choices
168 :     in
169 :     step (choice :: stages) ((w, k, al), store)
170 :     end
171 :     (* the first n arguments go into the first n registers *)
172 :     | REGS_BY_ARGS (c, rs) :: stages => let
173 :     val n = find(store, c)
174 :     val rs' = drop(n, rs)
175 :     in
176 :     case rs'
177 :     of [] => step stages ((w, k, al), store)
178 :     | (r as (w', _, _)) :: _ => if (w' = w)
179 :     then let
180 :     val loc = REG r
181 :     val store = addReg(store, loc)
182 :     in
183 :     (SOME loc, store)
184 :     end
185 :     else raise StagedAlloc "regs by args"
186 :     end
187 :     (* increment the argument counter *)
188 :     | ARGCOUNTER c :: stages => let
189 :     val (SOME loc, store) = step stages ((w, k, al), store)
190 :     val n = find(store, c)
191 :     val store = insert(store, c, n + 1)
192 :     in
193 :     (SOME loc, store)
194 :     end
195 :     (* the first n bits arguments go into the first n bits of registers *)
196 :     | REGS_BY_BITS (c, rs) :: stages => let
197 :     val n = find(store, c)
198 :     val rs' = dropBits(n, rs)
199 :     in
200 :     case rs'
201 :     of [] => (* insufficient bits *)
202 :     step stages ((w, k, al), store)
203 :     | (r as (w', _, _)) :: _ => if (w' = w)
204 :     then let (* the arg fits into the regs *)
205 :     val loc = REG r
206 :     val store = addReg(store, loc)
207 :     in
208 :     (SOME loc, store)
209 :     end
210 : mrainey 3218 else if w' < w
211 :     then let (* some of the arg's bits fit into the regs *)
212 :     val store = insert (store, c, n + w')
213 :     val loc = REG r
214 :     val store = addReg(store, loc)
215 :     val (SOME loc', store) =
216 :     step (REGS_BY_BITS (c, rs) :: stages) ((w - w', k, al), store)
217 :     val store = addReg(store, loc')
218 :     val loc'' = COMBINE (loc, loc')
219 :     val n' = find(store, c)
220 :     val store = insert(store, c, n' - w')
221 :     in
222 :     (SOME loc'', store)
223 :     end
224 :     else raise Fail "incorrect number of bits"
225 : mrainey 3178 end
226 :     | BITCOUNTER c :: stages => let
227 :     val (SOME loc, store) = step stages ((w, k, al), store)
228 :     val n = find(store, c)
229 :     val store = insert(store, c, n + w)
230 :     in
231 :     (SOME loc, store)
232 :     end
233 :     | SEQ ss :: stages => step (ss @ stages) ((w, k, al), store)
234 :     | PAD c :: stages => let
235 :     val n = find(store, c)
236 :     val n' = roundUp(n, al * memSize)
237 :     val store = insert(store, c, n')
238 :     val (SOME loc, store) = step stages ((w, k, al), store)
239 :     in
240 :     (SOME loc, store)
241 :     end
242 :     | ALIGN_TO f :: stages => step stages ((w, k, f al), store)
243 :     (* end case *))
244 : mrainey 3140
245 : mrainey 3178 fun allocate stages (req, store) = let
246 :     val (SOME loc, store) = step stages (req, store)
247 : mrainey 3140 in
248 : mrainey 3178 (loc, store)
249 : mrainey 3140 end
250 : mrainey 3178 handle Match => raise StagedAlloc "failed to allocate"
251 : mrainey 3140
252 : mrainey 3178 fun allocate' stages (req, (locs, store)) = let
253 :     val (loc, store) = allocate stages (req, store)
254 :     in
255 :     (loc :: locs, store)
256 : mrainey 3140 end
257 :    
258 : mrainey 3178 fun allocateSeq stages (reqs, store) = let
259 :     val (locs, store') = List.foldl (allocate' stages) ([], store) reqs
260 : mrainey 3140 in
261 : mrainey 3178 (List.rev locs, store')
262 :     end
263 : mrainey 3140
264 : mrainey 3178 fun allocateSeqs stages (reqss, store) = let
265 :     fun alloc (reqs, (locss, store)) = let
266 :     val (locs, store) = allocateSeq stages (reqs, store)
267 : mrainey 3140 in
268 : mrainey 3178 (locs :: locss, store)
269 : mrainey 3140 end
270 : mrainey 3178 val (locss, store') = List.foldl alloc ([], store) reqss
271 : mrainey 3140 in
272 : mrainey 3178 (List.rev locss, store')
273 : mrainey 3140 end
274 :    
275 : mrainey 3178 fun freeze (stages, (_, ob, regs)) =
276 :     {overflowBlock=ob, allocatedRegs=regs}
277 :    
278 :     (* extract the kind of a location *)
279 :     fun kindOfLoc (REG(_, k, _)) = k
280 :     | kindOfLoc (BLOCK_OFFSET(_, k, _)) = k
281 :     | kindOfLoc (COMBINE(l1, l2)) = kindOfLoc l1
282 :     | kindOfLoc (NARROW(_, _, k)) = k
283 :    
284 :     end (* StagedAllocationFn *)

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