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 /sml/trunk/compiler/CodeGen/cpscompile/spill-new.sml
ViewVC logotype

Annotation of /sml/trunk/compiler/CodeGen/cpscompile/spill-new.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1755 - (view) (download)
Original Path: sml/trunk/src/compiler/CodeGen/cpscompile/spill-new.sml

1 : leunga 1094 (* spill.sml
2 :     *
3 :     * Copyright 2002 by Bell Laboratories
4 :     *)
5 :    
6 :     (*
7 :     * This is a complete rewrite of the old Spill module.
8 :     * The old module suffers from some serious performance problem but
9 :     * I cannot decipher the old code fully, so instead of patching the problems up,
10 :     * I'm reimplementing it with a different algorithm. The new code is more
11 :     * modular, smaller when compiled, and substantially faster
12 :     * (O(n log n) time and O(n) space).
13 :     *
14 :     * As far as I can tell, the purpose of this module is to make sure the
15 :     * number of live variables at any program point (the bandwidth)
16 :     * does not exceed a certain limit, which is determined by the
17 :     * size of the spill area.
18 :     *
19 :     * When the bandwidth is too large, we decrease the register pressure by
20 :     * packing live variables into spill records. How we achieve this is
21 :     * completely different than what we did in the old code.
22 :     *
23 :     * First, there is something that MLRiscGen code generator does
24 :     * that we should be aware of:
25 :     *
26 :     * o MLRiscGen performs code motion!
27 :     *
28 :     * In particular, it will move floating point computations and
29 :     * address computations involving only the heap pointer to
30 :     * their use sites (if there is only a single use).
31 :     * What this means is that if we have a CPS record construction
32 :     * statement
33 :     *
34 :     * RECORD(k,vl,w,e)
35 :     *
36 :     * we should never count the new record address w as live if w
37 :     * has only one use (which is often the case).
38 :     *
39 :     * We should do something similar to floating point, but the transformation
40 :     * there is much more complex, so I won't deal with that.
41 :     *
42 :     * Secondly, there are now two new cps primops at our disposal:
43 :     *
44 :     * 1. rawrecord of record_kind option
45 :     * This pure operator allocates some uninitialized storage from the heap.
46 :     * There are two forms:
47 :     *
48 :     * rawrecord NONE [INT n] allocates a tagless record of length n
49 :     * rawrecord (SOME rk) [INT n] allocates a tagged record of length n
50 :     * and initializes the tag.
51 :     *
52 :     * 2. rawupdate of cty
53 :     * rawupdate cty (v,i,x)
54 :     * Assigns to x to the ith component of record v.
55 :     * The storelist is not updated.
56 :     *
57 :     * We use these new primops for both spilling and increment record construction.
58 :     *
59 :     * 1. Spilling.
60 :     *
61 :     * This is implemented with a linear scan algorithm (but generalized
62 :     * to trees). The algorithm will create a single spill record at the
63 :     * beginning of the cps function and use rawupdate to spill to it,
64 :     * and SELECT or SELp to reload from it. So both spills and reloads
65 :     * are fine-grain operations. In contrast, in the old algorithm
66 :     * "spills" have to be bundled together in records.
67 :     *
68 :     * Ideally, we should sink the spill record construction to where
69 :     * it is needed. We can even split the spill record into multiple ones
70 :     * at the places where they are needed. But CPS is not a good
71 :     * representation for global code motion, so I'll keep it simple and
72 :     * am not attempting this.
73 :     *
74 :     * 2. Incremental record construction (aka record splitting).
75 :     *
76 :     * Records with many values which are simulatenously live
77 :     * (recall that single use record addresses are not considered to
78 :     * be live) are constructed with rawrecord and rawupdate.
79 :     * We allocate space on the heap with rawrecord first, then gradually
80 :     * fill it in with rawupdate. This is the technique suggested to me
81 :     * by Matthias.
82 :     *
83 :     * Some restrictions on when this is applicable:
84 :     * 1. It is not a VECTOR record. The code generator currently
85 :     * does not handle this case. VECTOR record uses double
86 :     * indirection like arrays.
87 :     * 2. All the record component values are defined in the same "basic block"
88 :     * as the record constructor. This is to prevent speculative
89 :     * record construction.
90 :     *
91 :     * -- Allen
92 :     *)
93 :    
94 :     signature SPILL = sig
95 :     val spill : CPS.function list -> CPS.function list
96 :     end (* signature SPILL *)
97 :    
98 :     local
99 :    
100 :     val DEBUG = false
101 :     val MAX_BANDWIDTH = 100 (* Kick in spilling when this many values
102 :     * are live at the same time
103 :     *)
104 :     val SPLIT_LARGE_RECORDS = true (* True if record splitting is enabled *)
105 :     val MAX_RECORD_LEN = 16 (* Split record of this size or larger *)
106 :    
107 :     in
108 :    
109 :     functor SpillFn (MachSpec : MACH_SPEC) : SPILL =
110 :     struct
111 :    
112 :     structure CPS = CPS
113 :     structure P = CPS.P
114 :     structure LV = LambdaVar
115 :     structure H = IntHashTable (* For mapping from lvar *)
116 :    
117 : blume 1126 val debug_cps_spill = Control.MLRISC.mkFlag ("debug-cps-spill", "CPS spill debug mode")
118 :     val debug_cps_spill_info = Control.MLRISC.mkFlag ("debug-cps-spill-info",
119 :     "CPS spill info debug mode")
120 : leunga 1094
121 :     infix 6 \/
122 :     infix 7 /\
123 :     infix 5 --
124 :    
125 :     val error = ErrorMsg.impossible
126 :     val pr = Control.Print.say
127 :     val i2s = Int.toString
128 :    
129 :     val maxgpfree =
130 :     Int.min(MachSpec.spillAreaSz div (2 * MachSpec.valueSize),MAX_BANDWIDTH)
131 :     val maxfpfree =
132 :     Int.min(MachSpec.spillAreaSz div (2 * MachSpec.realSize),MAX_BANDWIDTH)
133 :    
134 :     (* Pretty printing *)
135 :     fun dump(title, cpsFun) =
136 :     if !debug_cps_spill
137 :     then (pr ("------------ "^title^" the spill phase ---------- \n");
138 :     PPCps.printcps0 cpsFun;
139 :     pr "--------------------------------------\n\n")
140 :     else ()
141 :    
142 :     (*
143 :     * The following data structure groups together type specific functions.
144 :     *)
145 :     datatype type_info =
146 :     TYPE_INFO of
147 :     { maxLive : int, (* max live values allowed *)
148 :     isVar : CPS.lvar -> bool, (* is variable a candidate for spilling? *)
149 :     itemSize : int (* number of words per item *)
150 :     }
151 :    
152 :     datatype spill_candidate =
153 :     SPILL_CANDIDATE of
154 :     { lvar : CPS.lvar,
155 :     cty : CPS.cty,
156 :     rank : int (* distance to next use *)
157 :     }
158 :    
159 :     (* Cheap set representation *)
160 :     structure SimpleSet =
161 :     struct
162 :     structure Set = IntRedBlackSet
163 :     val op \/ = Set.union
164 :     val op /\ = Set.intersection
165 :     val op -- = Set.difference
166 :     val O = Set.empty
167 :     val card = Set.numItems (* cardinality *)
168 :     fun rmv(S, x) = Set.delete(S, x) handle _ => S
169 :     end
170 :    
171 :     (* Spill candidates set representation; this one has to be ranked *)
172 :     structure RankedSet =
173 :     struct
174 :     structure Set = RedBlackSetFn
175 :     (type ord_key = spill_candidate
176 :     fun compare(SPILL_CANDIDATE{rank=r1,lvar=v1,...},
177 :     SPILL_CANDIDATE{rank=r2,lvar=v2,...}) =
178 :     case Int.compare(r1,r2) of
179 :     EQUAL => Int.compare(v1,v2)
180 :     | ord => ord
181 :     )
182 :     exception Item of Set.item
183 :     (* as priority queue *)
184 :     fun next S =
185 :     Set.foldr (fn (x,_) => raise Item x) NONE S
186 :     handle Item x => SOME(x, Set.delete(S, x))
187 :     (* Abbreviations for set operations *)
188 :     val op \/ = Set.union
189 :     val op /\ = Set.intersection
190 :     val op -- = Set.difference
191 :     val O = Set.empty
192 :     val card = Set.numItems (* cardinality *)
193 :     fun rmv(S, x) = Set.delete(S, x) handle _ => S
194 :     end
195 :    
196 :     fun rkToCty (CPS.RK_FCONT | CPS.RK_FBLOCK) = CPS.FLTt
197 :     | rkToCty _ = CPS.BOGt
198 :    
199 :     fun splittable CPS.RK_VECTOR = false (* not supported in backend (yet) *)
200 :     | splittable _ = true
201 :    
202 :     (*-------------------------------------------------------------------------
203 :     *
204 :     * All CPS functions can be independently processed.
205 :     *
206 :     * Some complexity assumptions:
207 :     * Hashing is O(1)
208 :     * N = max{number of lvars, size of cps function}
209 :     *
210 :     *-------------------------------------------------------------------------*)
211 :    
212 :     (*------------------------------------------------------------------------
213 :     * markFpAndRec
214 :     * =============
215 :     * Mark all floating point variables and return a hash table
216 :     *
217 :     * This is needed because we do spilling of integer and floating
218 :     * point stuff separately.
219 :     *
220 :     * This function takes O(N) time and space
221 :     *-----------------------------------------------------------------------*)
222 :     fun markFpAndRec cpsFun =
223 :     let val (funKind, f, args, argTypes, body) = cpsFun : CPS.function
224 :     open SimpleSet
225 :     exception FloatSet
226 :     val floatSet = H.mkTable(32,FloatSet)
227 :     val addToFloatSet = H.insert floatSet
228 :     fun fp(r,CPS.FLTt) = addToFloatSet(r,true)
229 :     | fp(r,_) = ()
230 :     exception RecordSet
231 :     val recordSet = H.mkTable(32,RecordSet)
232 :     val markrec = H.insert recordSet
233 :     val findrec = H.find recordSet
234 :    
235 :     (* Mark all record uses *)
236 :     val recUses =
237 :     app (fn (CPS.VAR v,_) =>
238 :     (case findrec v of
239 :     NONE => () (* not a record address *)
240 :     | SOME n => markrec(v, n+1)
241 :     )
242 :     | _ => ()
243 :     )
244 :    
245 :     fun markPure(p,w) =
246 :     case p of
247 :     (* these pure operators actually allocates storage! *)
248 :     (P.fwrap | P.iwrap | P.i32wrap | P.newarray0 |
249 :     P.makeref | P.mkspecial | P.rawrecord _
250 :     ) => markrec(w, 0)
251 :     | _ => ()
252 :    
253 :     fun markfp e =
254 :     case e of
255 :     CPS.APP _ => ()
256 :     | CPS.SWITCH(_,_,es) => app markfp es
257 :     | CPS.SELECT(_,_,w,t,e) => (fp(w,t); markfp e)
258 :     | CPS.RECORD(_,vl,w,e) => (recUses vl; markrec(w, 0); markfp e)
259 :     | CPS.OFFSET(_,_,_,e) => markfp e
260 :     | CPS.SETTER(_,_,e) => markfp e
261 :     | CPS.LOOKER(_,_,w,t,e) => (fp(w,t); markfp e)
262 :     | CPS.ARITH(_,_,w,t,e) => (fp(w,t); markfp e)
263 :     | CPS.PURE(p,_,w,t,e) => (markPure(p,w); fp(w,t); markfp e)
264 : mblume 1755 | CPS.RCC(_,_,_,_,wtl,e) => (app fp wtl; markfp e)
265 : leunga 1094 | CPS.BRANCH(_,_,_,e1,e2) => (markfp e1; markfp e2)
266 :     | CPS.FIX _ => error "FIX in Spill.markfp"
267 :    
268 :     val () = ListPair.app fp (args, argTypes) (* mark function parameters *)
269 :     val () = markfp body (* mark function body *)
270 :    
271 :     (* Filter out multiple uses of record values because these
272 :     * are not forward propagated by the backend.
273 :     *)
274 :     val () = if DEBUG then
275 :     H.appi (fn (v, n) =>
276 :     if n >= 2 then pr(LV.lvarName v^" uses="^i2s n^"\n") else ())
277 :     recordSet
278 :     else ()
279 :     val () = H.filter (fn n => n <= 1) recordSet
280 :     in (floatSet, recordSet)
281 :     end
282 :    
283 :     (*--------------------------------------------------------------------------
284 :     * needsSpilling
285 :     * =============
286 :     * This function checks whether we need to perform spilling for
287 :     * the current type, which is either gpr or fpr.
288 :     * Parameterized by type info. This is supposed to be a cheap check
289 :     * since most of the time this function should return false,
290 :     * so no information is saved.
291 :     *
292 :     * This function takes O(N log N) time and O(N) space.
293 :     *-------------------------------------------------------------------------*)
294 :     fun needsSpilling (TYPE_INFO{maxLive, isVar, ...}) cpsFun =
295 :     let val (funKind, f, args, argTypes, body) = cpsFun : CPS.function
296 :     open SimpleSet
297 :     exception TooMany
298 :    
299 :     val bandwidth = ref 0
300 :    
301 :     (* Make sure |S| is not too large.
302 :     * Note: card is a O(1) operation.
303 :     *)
304 :     fun check S =
305 :     let val n = card S
306 :     in if n > !bandwidth then bandwidth := n else ();
307 :     if n >= maxLive then raise TooMany else S
308 :     end
309 :    
310 :     (* This function inserts lvars of the current type into set S *)
311 :     fun uses(vs,S) =
312 :     let fun f((CPS.VAR x)::vs,S) =
313 :     f(vs, if isVar x then Set.add(S,x) else S)
314 :     | f(_::vs,S) = f(vs,S)
315 :     | f([],S) = check S
316 :     in f(vs,S)
317 :     end
318 :    
319 :     (* Remove w (a definition) from S. *)
320 :     fun def(w,S) = rmv(S,w)
321 :    
322 :     (* Union a list of sets S_1, ..., S_n
323 :     * Runs in O(m \log m) time and space
324 :     * where m = \sum_{i=1\ldots n} |S_i|
325 :     *)
326 :     val unions = List.foldr op\/ O
327 :    
328 :     (*
329 :     * Compute the set of free vars at each program point.
330 :     * Raise exception TooMany if the live set exceeds maxLive.
331 :     * This phase runs in total O(N log N) time and O(N) space.
332 :     *)
333 :     fun freevars e =
334 :     case e of
335 :     CPS.APP(v,args) => uses(v::args,O)
336 :     | CPS.SWITCH(v,c,l) => uses([v],unions(map freevars l))
337 :     | CPS.SELECT(_,v,w,t,e) => uses([v],def(w,freevars e))
338 :     | CPS.RECORD(_,l,w,e) => uses((map #1 l),def(w,freevars e))
339 :     | CPS.OFFSET(_,v,w,e) => uses([v],def(w,freevars e))
340 :     | CPS.SETTER(_,vl,e) => uses(vl,freevars e)
341 :     | CPS.LOOKER(_,vl,w,t,e) => uses(vl,def(w,freevars e))
342 :     | CPS.ARITH(_,vl,w,t,e) => uses(vl,def(w,freevars e))
343 :     | CPS.PURE(_,vl,w,t,e) => uses(vl,def(w,freevars e))
344 : mblume 1755 | CPS.RCC(_,_,_,vl,wtl,e) => uses(vl, foldl (fn((w,_),s) => def(w,s))
345 :     (freevars e) wtl)
346 : leunga 1094 | CPS.BRANCH(_,vl,c,e1,e2) => uses(vl,freevars e1 \/ freevars e2)
347 :     | CPS.FIX _ => error "FIX in Spill.freevars"
348 :    
349 :     val needsSpilling = (freevars body; false) handle TooMany => true
350 :     in {needsSpilling = needsSpilling,
351 :     bandwidth = !bandwidth
352 :     }
353 :     end (* needsSpilling *)
354 :    
355 :     (*--------------------------------------------------------------------------
356 :     * linearScan
357 :     * ==========
358 :     *
359 :     * Perform the actual spilling.
360 :     *
361 :     * The algorithm is derived from linear-scan RA algorithms.
362 :     * But since we are dealing with trees, (and because of immutable
363 :     * data structures), we'll do this in multiple passes rather than
364 :     * a single pass.
365 :     *
366 :     * What spilling means in CPS is transforming:
367 :     *
368 :     *
369 :     * v <- f(...) /* definition */
370 :     * ....
371 :     * ... <- g(... v ...) /* use */
372 :     *
373 :     * into:
374 :     *
375 :     * spilled <- rawrecord NONE m /* create an uninitialized spill record
376 :     * of length m */
377 :     * ....
378 :     * v <- f(...) /* definition */
379 :     * rawupdate(spilled, v_offset, v)
380 :     * ...
381 :     * ... <- g(... SELp(spilled,v_offset) ...) /* reload */
382 :     *
383 :     * Important notes:
384 :     * 1. The spill record is never live beyond the
385 :     * cps function, so we never even have to assign its
386 :     * record tag.
387 :     *
388 :     * 2. We spill all tagged/untagged values into a spill record,
389 :     * without segregating them by their types, so we are mixing
390 :     * 32-bit integers, 31-bit tagged ints, and pointers together.
391 :     * This is safe because of (1).
392 :     *
393 :     * This function takes a total of O(N log N) time and O(N) space.
394 :     *-------------------------------------------------------------------------*)
395 :     fun linearScan (TYPE_INFO{maxLive, isVar, itemSize, ...}) cpsFun =
396 :     let val (funKind, f, args, argTypes, body) = cpsFun : CPS.function
397 :     open RankedSet
398 :    
399 :     val () = dump("before", cpsFun)
400 :    
401 :     (* Information about each lvar *)
402 :     datatype lvar_info =
403 :     LVAR_INFO of
404 :     { useCount :int ref, (* number of uses in this function *)
405 :     defPoint :int, (* level of definition *)
406 :     defBlock :int, (* block of definition *)
407 :     cty :CPS.cty,
408 :     nearestUse :int ref (* min {level(x) | x in uses(v)} *)
409 :     }
410 :     exception LvarInfo
411 :    
412 : blume 1126 val () = if !debug_cps_spill_info
413 : leunga 1094 then pr "CPS Spill: linearScan\n" else ()
414 :    
415 :     val lvarInfo = H.mkTable(32,LvarInfo)
416 :     val lookupLvar = H.lookup lvarInfo
417 :    
418 :     fun spillCand v =
419 :     let val LVAR_INFO{nearestUse, useCount, defPoint, cty, ...} = lookupLvar v
420 :     val dist = !nearestUse - defPoint
421 :     val rank = dist (* for now *)
422 :     in SPILL_CANDIDATE{lvar=v, cty=cty, rank=rank}
423 :     end
424 :    
425 :     (*----------------------------------------------------------------------
426 :     * Gather information about each lvar
427 :     * We partition the cps function into blocks.
428 :     * A block is a continuous group of statements without
429 :     * controlflow or store updates.
430 :     * This phase runs in O(N) time and space.
431 :     *---------------------------------------------------------------------*)
432 :     local
433 :     val infinity = 10000000
434 :     val enterLvar = H.insert lvarInfo
435 :     fun def(v,t,b,n) =
436 :     enterLvar(v, LVAR_INFO{useCount=ref 0,
437 :     defPoint=n,
438 :     defBlock=b,
439 :     cty=t,
440 :     nearestUse=ref infinity
441 :     }
442 :     )
443 :    
444 :     fun use(CPS.VAR v, n) =
445 :     if isVar v then
446 :     let val LVAR_INFO{useCount, nearestUse, ...} = lookupLvar v
447 :     in useCount := !useCount + 1;
448 :     nearestUse := Int.min(!nearestUse, n)
449 :     end
450 :     else ()
451 :     | use _ = ()
452 :     fun uses([], n) = ()
453 :     | uses(v::vs, n) = (use(v, n); uses(vs, n))
454 :    
455 :     fun gather(e, b, n) =
456 :     let fun gathers([], b, n) = ()
457 :     | gathers(e::es,b,n) = (gather(e,b,n); gathers(es,b,n))
458 :     fun f0(vl, e) = (uses(vl, n); gather(e, b+1, n+1))
459 :     fun f1(v, w, t, e) = (use(v, n); def(w,t,b,n); gather(e,b,n+1))
460 :     fun fx(vl,w,t,e,b) = (uses(vl, n); def(w,t,b,n); gather(e,b,n+1))
461 :     in case e of
462 :     CPS.APP(v,args) => uses(v::args, n)
463 :     | CPS.SWITCH(v,c,l) => (use(v, n); gathers(l, b+1, n+1))
464 :     | CPS.SELECT(_,v,w,t,e) => f1(v, w, t, e)
465 :     | CPS.OFFSET(_,v,w,e) => f1(v, w, CPS.BOGt, e)
466 :     | CPS.RECORD(_,l,w,e) => fx(map #1 l, w, CPS.BOGt, e, b)
467 :     | CPS.SETTER(_,vl,e) => f0(vl, e)
468 :     | CPS.LOOKER(_,vl,w,t,e) => fx(vl, w, t, e, b)
469 :     | CPS.ARITH(_,vl,w,t,e) => fx(vl, w, t, e, b)
470 :     | CPS.PURE(_,vl,w,t,e) => fx(vl, w, t, e, b)
471 : mblume 1755 | CPS.RCC(_,_,_,vl,wtl,e)=>
472 :     let val b = b+1
473 :     in uses (vl, n);
474 :     app (fn (w, t) => def (w, t, b, n)) wtl;
475 :     gather (e, b, n+1)
476 :     end
477 : leunga 1094 | CPS.BRANCH(_,vl,c,x,y) => (uses(vl, n); gathers([x,y],b+1,n+1))
478 :     | CPS.FIX _ => error "FIX in Spill.gather"
479 :     end
480 :     in (* Always remember to define the arguments! *)
481 :     val () = ListPair.app (fn (v, t) => def(v, t, 0, 0)) (args, argTypes)
482 :     val () = gather(body, 1, 1)
483 :     end (* gather *)
484 :    
485 :     val () = if !debug_cps_spill then pr "CPS Spill: gather done\n" else ()
486 :    
487 :     (*-----------------------------------------------------------------
488 :     *
489 :     * Spill tables and utilities
490 :     *
491 :     *-----------------------------------------------------------------*)
492 :    
493 :     exception SpillTable
494 :     val spillTable = H.mkTable(32, SpillTable) :
495 :     (CPS.value * int * CPS.cty) H.hash_table
496 :     (* lvar -> spillRecord * spill offset * cty *)
497 :     val enterSpill = H.insert spillTable
498 :     val findSpill = H.find spillTable
499 :     val isSpilled = H.inDomain spillTable
500 :     val currentSpillRecord = ref (NONE : (CPS.lvar * CPS.value) option)
501 :    
502 :     (*
503 :     * Generate a new spill record variable
504 :     *)
505 :     fun genSpillRec() =
506 :     case !currentSpillRecord of
507 :     SOME x => x
508 :     | NONE =>
509 :     let val v = LV.namedLvar (Symbol.varSymbol "spillrec")
510 :     val e = CPS.VAR v
511 :     in currentSpillRecord := SOME(v,e); (v, e)
512 :     end
513 :    
514 :     (*
515 :     * This function finds up to m good spill candidates from the live set
516 :     *)
517 :     fun findGoodSpills(0, L, spOff) = (L, spOff)
518 :     | findGoodSpills(m, L, spOff) =
519 :     case next L of
520 :     (* no more spill candidates! *)
521 :     NONE => (L, spOff)
522 :     | SOME(SPILL_CANDIDATE{lvar, cty, rank, ...}, L) =>
523 :     let val offset = spOff (* should align when we have 64-bit values *)
524 :     val (_,spRecExp) = genSpillRec()
525 :     val () = enterSpill(lvar,(spRecExp,offset,cty))
526 :     fun inc(spOff,cty) = spOff + 1 (* should look at cty
527 :     * when we have 64-bit values
528 :     *)
529 :     in (* okay; it's actually live and hasn't been spilled! *)
530 :     if !debug_cps_spill then
531 :     pr("Spilling "^LV.lvarName lvar^" rank="^i2s rank^"\n")
532 :     else ();
533 :     findGoodSpills(m-1, L, inc(spOff, cty))
534 :     end
535 :    
536 :     (*
537 :     * Can and should the record be split?
538 :     * Split if,
539 :     * 1. we can handle the record type
540 :     * 2. if it has >= MAX_RECORD_LEN live lvars as arguments
541 :     * 3. All its arguments are defined in the same block as the record.
542 :     *)
543 :     fun shouldSplitRecord(rk,vl,b) =
544 :     SPLIT_LARGE_RECORDS andalso
545 :     let fun okPath(CPS.SELp(i,p)) = okPath p
546 :     | okPath(CPS.OFFp 0) = true
547 :     | okPath _ = false
548 :     fun f([], n) = n >= MAX_RECORD_LEN
549 :     | f((CPS.VAR v,p)::vl, n) =
550 :     let val LVAR_INFO{defBlock, ...} = lookupLvar v
551 :     in defBlock = b andalso okPath p andalso
552 :     (if isVar v andalso not(isSpilled v)
553 :     then f(vl, n+1)
554 :     else f(vl, n)
555 :     )
556 :     end
557 :     | f((_,CPS.OFFp 0)::vl, n) = f(vl, n)
558 :     | f _ = false
559 :     in splittable rk andalso f(vl, 0)
560 :     end
561 :    
562 :     (*
563 :     * Tables for splitting a record
564 :     *)
565 :     exception RecordTable
566 :     datatype split_record_item =
567 :     SPLIT_RECORD_ITEM of
568 :     { record : CPS.lvar,
569 :     kind : CPS.record_kind,
570 :     len : int,
571 :     offset : int,
572 :     path : CPS.accesspath,
573 :     numVars : int ref,
574 :     consts : (int * CPS.value) list
575 :     }
576 :    
577 :     val recordAllocTable = H.mkTable(16, RecordTable)
578 :     val enterRecordItem = H.insert recordAllocTable
579 :     val findRecordItem = H.find recordAllocTable
580 :     val splitRecordTable = H.mkTable(16, RecordTable)
581 :     val markSplitRecord = H.insert splitRecordTable
582 :     fun insertRecordItem(v, x) =
583 :     enterRecordItem(v, x::getOpt(findRecordItem v,[]))
584 :    
585 :     (*
586 :     * Mark record w as being split.
587 :     * Enter the appropriate info to all its arguments.
588 :     *)
589 :     fun splitRecordConstruction(rk, vl, w) =
590 :     let fun f(i, (CPS.VAR v,offp)::vl, vars, consts) =
591 :     f(i+1, vl, (i,v,offp)::vars, consts)
592 :     | f(i, (c,CPS.OFFp 0)::vl, vars, consts) =
593 :     f(i+1, vl, vars, (i,c)::consts)
594 :     | f(_, [], vars, consts) = (vars, consts)
595 :     | f _ = error "CPS Spill.splitRecordConstruction"
596 :     val (vars, consts) = f(0, vl, [], [])
597 :     val n = length vars
598 :     val _ = if n = 0 then
599 :     error "CPS Spill: splitting constant record" else ()
600 :     val _ = if !debug_cps_spill_info then
601 :     pr("Splitting record "^LV.lvarName w^" len="^i2s n^"\n")
602 :     else ()
603 :     val len = length vl
604 :     val numVars = ref n
605 :     fun enter(i, v, path) =
606 :     let val item = SPLIT_RECORD_ITEM
607 :     { record = w,
608 :     kind = rk,
609 :     len = len,
610 :     offset = i,
611 :     path = path,
612 :     numVars = numVars,
613 :     consts = consts
614 :     }
615 :     in insertRecordItem(v, item)
616 :     end
617 :     in app enter vars;
618 :     markSplitRecord(w,true)
619 :     end
620 :    
621 :     (*-----------------------------------------------------------------
622 :     * Linear scan spilling.
623 :     * This function marks all spill/reload sites.
624 :     *
625 :     * Parameters:
626 :     * e --- cps expression
627 :     * b --- current block
628 :     * spOff --- current available spill offset
629 :     *
630 :     * Return:
631 :     * L --- the set of live lvars in e
632 :     * spills --- the number of spills
633 :     *
634 :     * This phase takes O(N log N) time and O(N) space
635 :     *-----------------------------------------------------------------*)
636 :     fun scan(e, b, spOff) =
637 :     let
638 :     (* add uses to live set *)
639 :     fun addUses([], L) = L
640 :     | addUses(CPS.VAR v::vs, L) =
641 :     addUses(vs, if isVar v andalso not(isSpilled v) then
642 :     Set.add(L, spillCand v) else L)
643 :    
644 :     | addUses(_::vs, L) = addUses(vs, L)
645 :    
646 :     (* This function kills a definition *)
647 :     fun kill(w, L) = if isVar w then rmv(L, spillCand w) else L
648 :    
649 :     (* This function find things to spill *)
650 :     fun genSpills(L, spOff) =
651 :     let val toSpills = card L - maxLive
652 :     in if toSpills > 0 then findGoodSpills(toSpills, L, spOff)
653 :     else (L, spOff)
654 :     end
655 :    
656 :     (* This function visits a list of continuations and
657 :     * gathers up the info
658 :     *)
659 :     fun scanList es =
660 :     let val b = b + 1
661 :     fun f [] = (O, 0)
662 :     | f [e] = scan(e, b, spOff)
663 :     | f(e::es) =
664 :     let val (L1, spOff1) = scan(e, b, spOff)
665 :     val (L2, spOff2) = f es
666 :     in (L1 \/ L2, Int.max(spOff1, spOff2))
667 :     end
668 :     in f es end
669 :    
670 :     (* This function scans normal cps operators
671 :     * with one definition and one continuation
672 :     *
673 :     * w : t <- f vs; e
674 :     *)
675 :     fun scanOp(vs, w, e, b) =
676 :     let val (L,spOff) = scan(e,b,spOff) (* do continuation *)
677 :     val L = kill(w, L) (* remove definition *)
678 :     val L = addUses(vs, L) (* add uses *)
679 :     val (L,spOff) = genSpills(L, spOff) (* find spill *)
680 :     in (L, spOff)
681 :     end
682 :    
683 :     (* This function scans stmts with multiple continuations *)
684 :     fun scanStmt(vs, es) =
685 :     let val (L,spOff) = scanList es (* do continuation *)
686 :     val L = addUses(vs, L) (* add uses *)
687 :     val (L, spOff) = genSpills(L,spOff) (* find spills *)
688 :     in (L, spOff)
689 :     end
690 :    
691 :     (* This function scans record constructors *)
692 :     fun scanRec(rk, vl, w, e) =
693 :     let val (L,spOff) = scan(e,b,spOff) (* do continuation *)
694 :     val (L, spOff) =
695 :     if shouldSplitRecord(rk, vl, b) then
696 :     (splitRecordConstruction(rk, vl, w); (L,spOff))
697 :     else
698 :     let val L = kill(w, L)
699 :     val L = addUses(map #1 vl, L)
700 :     in genSpills(L, spOff)
701 :     end
702 :     in (L, spOff)
703 :     end
704 :    
705 :     val (L, numSpills) =
706 :     case e of
707 :     CPS.APP(v,args) => scanStmt(v::args, [])
708 :     | CPS.SWITCH(v,c,es) => scanStmt([v], es)
709 :     | CPS.SELECT(i,v,w,t,e) => scanOp([v], w, e, b)
710 :     | CPS.OFFSET(i,v,w,e) => scanOp([v], w, e, b)
711 :     | CPS.RECORD(rk,l,w,e) => scanRec(rk, l, w, e)
712 :     | CPS.SETTER(p,vl,e) => scanStmt(vl,[e])
713 :     | CPS.LOOKER(p,vl,w,t,e) => scanOp(vl, w, e, b)
714 :     | CPS.ARITH(p,vl,w,t,e) => scanOp(vl, w, e, b)
715 :     | CPS.PURE(p,vl,w,t,e) => scanOp(vl, w, e, b)
716 : mblume 1755 | CPS.RCC(k,l,p,vl,wtl,e)=>
717 :     let val b = b+1
718 :     val (L,spOff) = scan(e,b,spOff)
719 :     val L = foldl (fn ((w, _), L) => kill (w, L)) L wtl
720 :     val L = addUses (vl, L)
721 :     val (L, spOff) = genSpills (L, spOff)
722 :     in (L, spOff)
723 :     end
724 : leunga 1094 | CPS.BRANCH(p,vl,c,x,y) => scanStmt(vl,[x,y])
725 :     | CPS.FIX _ => error "FIX in Spill.scan"
726 :    
727 :     in (L, numSpills)
728 :     end
729 :    
730 :     (* Scan the body *)
731 :     val (L, numSpills) = scan(body, 1, 0)
732 :    
733 :     val () = if !debug_cps_spill then
734 :     pr("CPS Spill: scan done. Spilling "^i2s numSpills^"\n")
735 :     else ()
736 :     (*
737 :     * Generate reloads for a list of arguments.
738 :     * Returns:
739 :     * the rewritten list of arguments
740 :     * a function for inserting selects.
741 :     *)
742 :     fun emitReloads vs =
743 :     let fun g([], vs', f) = (rev vs', f)
744 :     | g((v as CPS.VAR x)::vs, vs', f) =
745 :     (case findSpill x of
746 :     NONE => g(vs, v::vs', f)
747 :     | SOME(spillRec, off, cty) =>
748 :     let val x' = LV.dupLvar x
749 :     val v' = CPS.VAR x'
750 :     fun f' e = CPS.SELECT(off,spillRec,x',cty, f e)
751 :     in g(vs, v'::vs', f')
752 :     end
753 :     )
754 :     | g(v::vs, vs', f) = g(vs, v::vs', f)
755 :     in g(vs, [], fn e => e)
756 :     end
757 :    
758 :     (*
759 :     * Generate reloads for record paths
760 :     * Returns:
761 :     * the rewritten list of record paths
762 :     *)
763 :     fun emitPathReloads vl =
764 :     let fun f([], vl') = rev vl'
765 :     | f((v as CPS.VAR x, p)::vl, vl') =
766 :     (case findSpill x of
767 :     NONE => f(vl, (v, p)::vl')
768 :     | SOME(spillRec, off, cty) =>
769 :     f(vl, (spillRec,CPS.SELp(off,p))::vl')
770 :     )
771 :     | f(v::vl, vl') = f(vl, v::vl')
772 :     in f(vl, [])
773 :     end
774 :    
775 :     (* This function generate spill code for variable w *)
776 :     fun emitSpill(w, e) =
777 :     case findSpill w of
778 :     NONE => e
779 :     | SOME(spillRecord, off, cty) =>
780 :     CPS.SETTER(P.rawupdate cty,
781 :     [spillRecord, CPS.INT off,CPS.VAR w], e)
782 :    
783 :     (*
784 :     * Emit spill record code
785 :     *)
786 :     fun createSpillRecord(0, e) = e
787 :     | createSpillRecord(numSpills, e) =
788 :     let val (spillRecLvar,_) = genSpillRec()
789 :     val m = numSpills * itemSize
790 :     val e = CPS.PURE(P.rawrecord NONE,[CPS.INT m],
791 :     spillRecLvar,CPS.BOGt,e)
792 :     in currentSpillRecord := NONE; (* clear *)
793 :     e
794 :     end
795 :    
796 :     val recordIsSplit = H.inDomain splitRecordTable
797 :     val findSplitRecordArg = H.find recordAllocTable
798 :    
799 :     (*
800 :     * proj(v, path, e) ==> w <- v.path ; e[w/v]
801 :     *)
802 :     fun proj(v, CPS.OFFp 0, e) = e v
803 :     | proj(v, CPS.SELp(i,p), e) =
804 :     let val v' = LV.mkLvar()
805 :     val e = e v'
806 :     in CPS.SELECT(i, CPS.VAR v, v', CPS.BOGt, e)
807 :     end
808 : mblume 1334 | proj _ = error "SpillFn: proj"
809 : leunga 1094
810 :     (*
811 :     * generate
812 :     * record.offset <- v.path ; e
813 :     *)
814 :     fun initRecordItem(record, rk, offset, v, path, e) =
815 :     proj(v, path,
816 :     fn x => CPS.SETTER(P.rawupdate(rkToCty rk),
817 :     [CPS.VAR record, CPS.INT offset, CPS.VAR x], e))
818 :    
819 :     (*
820 :     * Generate code to create a record.
821 :     *)
822 :     fun createRecord(record, rk, len, consts, e) =
823 :     let val e = emitSpill(record, e)
824 :     val p = P.rawupdate(rkToCty rk)
825 :     fun init((i, c),e) = CPS.SETTER(p,[CPS.VAR record, CPS.INT i, c], e)
826 :     val e = foldr init e consts
827 :     val e = CPS.PURE(P.rawrecord(SOME rk),[CPS.INT len],record,CPS.BOGt,e)
828 :     in e
829 :     end
830 :    
831 :     (*
832 :     * It is the definition of lvar v.
833 :     * Check to see if v is some component of split records.
834 :     * If so, generate code.
835 :     *
836 :     *)
837 :     fun assignToSplitRecord(v, e) =
838 :     case findSplitRecordArg v of
839 :     SOME inits =>
840 :     let fun gen(SPLIT_RECORD_ITEM
841 :     {record, kind, len, offset,
842 :     path, numVars, consts,...}, e) =
843 :     let val e = initRecordItem(record, kind, offset, v, path, e)
844 :     val n = !numVars - 1
845 :     in numVars := n;
846 :     if n = 0 then createRecord(record, kind, len, consts, e)
847 :     else e
848 :     end
849 :     in foldr gen e inits
850 :     end
851 :     | NONE => e
852 :    
853 :     (*-----------------------------------------------------------------
854 :     * Rebuild
855 :     *
856 :     * This function rewrites the cps expression and insert spill/reload
857 :     * code.
858 :     *
859 :     * This phase takes O(N) time and O(N) space
860 :     *-----------------------------------------------------------------*)
861 :    
862 :     fun rebuild e =
863 :     let
864 :    
865 :     fun rewriteStmt(vs, es, f) =
866 :     let val es = map rebuild es
867 :     val (vs, g) = emitReloads vs
868 :     in g(f(vs, es)) end
869 :    
870 :     fun rewrite(vs, w, e, f) =
871 :     let val e = rebuild e
872 :     val e = emitSpill(w, e)
873 :     val e = assignToSplitRecord(w, e)
874 :     val (vs, g) = emitReloads vs
875 :     in g(f(vs, w, e))
876 :     end
877 :    
878 : mblume 1755 fun rewrite'(vs,wl,e,f) =
879 :     let val e = rebuild e
880 :     val e = foldl emitSpill e wl
881 :     val e = foldl assignToSplitRecord e wl
882 :     val (vs, g) = emitReloads vs
883 :     in g (f (vs, wl, e))
884 :     end
885 :    
886 : leunga 1094 fun rewriteRec(vl, w, e, f) =
887 :     let val e = rebuild e
888 :     val e = emitSpill(w, e)
889 :     val e = assignToSplitRecord(w, e)
890 :     in if recordIsSplit w then e
891 :     else f(emitPathReloads vl, w, e)
892 :     end
893 :    
894 : mblume 1334 (* wrappers -- make the match compiler shut up *)
895 :     fun s1 f (v :: vs, es) = f (v, vs, es)
896 :     | s1 _ _ = error "Spill: s1"
897 :    
898 :     fun e1 f ([v], w, e) = f (v, w, e)
899 :     | e1 _ _ = error "Spill: e1"
900 :    
901 :     fun s'1 f (vs, [e]) = f (vs, e)
902 :     | s'1 _ _ = error "Spill: s'1"
903 :    
904 :     fun s'2 f (vs, [x, y]) = f (vs, x, y)
905 :     | s'2 _ _ = error "Spill: s'2"
906 :    
907 : leunga 1094 (*
908 :     * Rewrite the expression
909 :     *)
910 :     val e =
911 :     case e of
912 :     CPS.APP(v,args) =>
913 : mblume 1334 rewriteStmt(v::args, [], s1 (fn (v, args,_) => CPS.APP(v,args)))
914 : leunga 1094 | CPS.SWITCH(v,c,es) =>
915 : mblume 1334 rewriteStmt([v], es, s1 (fn (v, _, es) => CPS.SWITCH(v, c, es)))
916 : leunga 1094 | CPS.SELECT(i,v,w,t,e) =>
917 : mblume 1334 rewrite([v], w, e, e1 (fn (v,w,e) => CPS.SELECT(i,v,w,t,e)))
918 : leunga 1094 | CPS.OFFSET(i,v,w,e) =>
919 : mblume 1334 rewrite([v], w, e, e1 (fn (v,w,e) => CPS.OFFSET(i,v,w,e)))
920 : leunga 1094 | CPS.RECORD(k,l,w,e) =>
921 :     rewriteRec(l,w,e,fn (l,w,e) => CPS.RECORD(k, l, w, e))
922 :     | CPS.SETTER(p,vl,e) =>
923 : mblume 1334 rewriteStmt(vl, [e], s'1 (fn (vl,e) => CPS.SETTER(p,vl,e)))
924 : leunga 1094 | CPS.LOOKER(p,vl,w,t,e) =>
925 :     rewrite(vl,w,e, fn (vl,w,e) => CPS.LOOKER(p,vl,w,t,e))
926 :     | CPS.ARITH(p,vl,w,t,e) =>
927 :     rewrite(vl,w,e, fn (vl,w,e) => CPS.ARITH(p,vl,w,t,e))
928 :     | CPS.PURE(p,vl,w,t,e) =>
929 :     rewrite(vl,w,e,fn (vl,w,e) => CPS.PURE(p,vl,w,t,e))
930 : mblume 1755 | CPS.RCC(k,l,p,vl,wtl,e) =>
931 :     rewrite' (vl, map #1 wtl, e,
932 :     fn (vl, wl, e) => CPS.RCC (k, l, p, vl,
933 :     ListPair.map (fn (w, (_, t)) => (w, t)) (wl, wtl),
934 :     e))
935 : leunga 1094 | CPS.BRANCH(p,vl,c,x,y) =>
936 : mblume 1334 rewriteStmt(vl,[x,y],
937 :     s'2 (fn (vl,x,y) => CPS.BRANCH(p,vl,c,x,y)))
938 : leunga 1094 | CPS.FIX _ => error "FIX in Spill.rebuild"
939 :    
940 :     in e
941 :     end (* rebuild *)
942 :    
943 :     (* insert spill/reload code *)
944 :     val body = rebuild body
945 :     val body = foldr emitSpill body args (* spill code for arguments *)
946 :     (*
947 :     * Insert spill record creation code.
948 :     *)
949 :     val body = createSpillRecord(numSpills, body)
950 :    
951 : blume 1126 val () = if !debug_cps_spill_info
952 : leunga 1094 then pr("CPS Spill: linearScan done "^i2s numSpills^" spilled\n")
953 :     else ()
954 :    
955 :     val cpsFun = (funKind, f, args, argTypes, body)
956 :    
957 :     val () = dump("after", cpsFun)
958 :    
959 :     in cpsFun
960 :     end (* linearScan *)
961 :    
962 :     (*-------------------------------------------------------------------------
963 :     * spillOne
964 :     * ========
965 :     *
966 :     * This is the driver to process only one CPS function.
967 :     *
968 :     * This routine takes a total of O(N log N) time and O(N) space
969 :     *
970 :     *-------------------------------------------------------------------------*)
971 :     fun spillOne cpsFun =
972 :     let
973 :     (*
974 :     * Perform spilling.
975 :     *)
976 :    
977 :     fun spillIt type_info cpsFun =
978 :     let val {needsSpilling, bandwidth, ...} = needsSpilling type_info cpsFun
979 :     val () = if !debug_cps_spill_info then
980 :     pr("CPS Spill bandwidth="^i2s bandwidth^"\n")
981 :     else ()
982 :     in if needsSpilling then linearScan type_info cpsFun
983 :     else cpsFun
984 :     end
985 :     (*
986 :     * If we have unboxed floats then we have to distinguish between
987 :     * fpr and gpr registers.
988 :     *)
989 :    
990 :     val (fpTable,recordTable) = markFpAndRec cpsFun (* collect fp type info *)
991 :    
992 :     val isMoveableRec = H.inDomain recordTable
993 :    
994 :     val cpsFun =
995 :     if MachSpec.unboxedFloats then
996 :     let val isFP = H.inDomain fpTable
997 :     fun isGP r = not(isFP r) andalso not(isMoveableRec r)
998 :     val fp = TYPE_INFO{isVar=isFP, maxLive=maxfpfree, itemSize=2}
999 :     val gp = TYPE_INFO{isVar=isGP, maxLive=maxgpfree, itemSize=1}
1000 :     val cpsFun = spillIt fp cpsFun (* do fp spills first *)
1001 :     val cpsFun = spillIt gp cpsFun (* do gp spills *)
1002 :     in cpsFun
1003 :     end
1004 :     else
1005 :     let fun isGP r = not(isMoveableRec r)
1006 :     in spillIt (TYPE_INFO{isVar=isGP, maxLive=maxgpfree, itemSize=1})
1007 :     cpsFun
1008 :     end
1009 :     in cpsFun
1010 :     end (* spillOne *)
1011 :    
1012 :    
1013 :     (* Main entry point *)
1014 :     val spill = map spillOne
1015 :    
1016 :     end (* SpillFn *)
1017 :    
1018 :     end (* local *)

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