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

Annotation of /sml/trunk/src/compiler/CodeGen/cpscompile/spill.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 733 - (view) (download)

1 : monnier 245 (* spill.sml
2 :     *
3 :     * Copyright 1996 by Bell Laboratories
4 :     *)
5 :    
6 :     signature SPILL = sig
7 :     val spill : CPS.function list -> CPS.function list
8 :     end (* signature SPILL *)
9 :    
10 :     functor SpillFn (MachSpec : MACH_SPEC) : SPILL = struct
11 :    
12 :     local
13 :     open CPS
14 :     structure LV = LambdaVar
15 :     val error = ErrorMsg.impossible
16 :     val pr = Control.Print.say
17 :     val maxgpfree = MachSpec.spillAreaSz div (2 * MachSpec.valueSize)
18 :     val maxfpfree = MachSpec.spillAreaSz div (2 * MachSpec.realSize)
19 :     val spillname = Symbol.varSymbol "spillrec"
20 : monnier 411 fun sortp x = ListMergeSort.sort (fn ((i:int,_),(j,_)) => i>j) x
21 : monnier 245 val app2 = ListPair.app
22 :     val unboxedfloat = MachSpec.unboxedFloats
23 :     structure CGoptions = Control.CG
24 :    
25 :     in
26 :    
27 :     (*****************************************************************************
28 :     * MISC AND UTILITY FUNCTIONS *
29 :     *****************************************************************************)
30 :     fun enter(new:int,l) =
31 :     let fun f [] = [new]
32 :     | f (l as h::t) = if new<h then new::l else if new>h then h::f t else l
33 :     in f l
34 :     end
35 :    
36 :     fun uniq l =
37 :     let fun loop([],acc) = acc
38 :     | loop(a::r,acc) = loop(r,enter(a,acc))
39 :     in loop(l,[])
40 :     end
41 :    
42 :     fun merge(a,[]) = a
43 :     | merge([],a) = a
44 :     | merge(l as (i:int)::a, m as j::b) =
45 :     if j<i then j::merge(l,b) else i::merge(a,if i<j then m else b)
46 :    
47 :     local fun loop (a::b::rest) = loop(merge(a,b)::loop rest)
48 :     | loop l = l
49 :     in fun foldmerge l = hd(loop l) handle Hd => []
50 :     end
51 :    
52 :     fun rmv (x : int,l) =
53 :     let fun loop nil = nil
54 :     | loop (a::b) = if x=a then b else a::loop b
55 :     in loop l
56 :     end
57 :    
58 :     fun member l (e:int) =
59 :     let fun f [] = false
60 :     | f (h::t) = if h<e then f t else e=h
61 :     in f l
62 :     end
63 :    
64 :     fun intersect(nil,_) = nil
65 :     | intersect(_,nil) = nil
66 :     | intersect(l as (a:int)::b,r as c::d) =
67 :     if a=c then a::intersect(b,d)
68 :     else if a<c then intersect(b,r)
69 :     else intersect(l,d)
70 :    
71 :     nonfix before
72 :     val \/ = merge and /\ = intersect
73 :     infix 6 \/ infix 7 /\
74 :    
75 :     fun enterV(VAR v,l) = enter(v,l)
76 :     | enterV(_,l) = l
77 :    
78 :     fun unzip l =
79 :     let fun h((a,b)::l,r1,r2) = h(l,a::r1,b::r2)
80 :     | h([],r1,r2) = (rev r1,rev r2)
81 :     in h(l,[],[])
82 :     end
83 :    
84 :     fun sublist test =
85 :     let fun subl(a::r) = if test a then a::(subl r) else subl r
86 :     | subl [] = []
87 :     in subl
88 :     end
89 :    
90 :     fun spillLvar() = LV.namedLvar spillname
91 :    
92 :     val ilist = PrintUtil.prIntPath
93 :    
94 :     fun sayv(VAR v) = pr(LV.lvarName v)
95 :     | sayv(LABEL v) = pr("(L)" ^ LV.lvarName v)
96 :     | sayv(INT i) = pr(Int.toString i)
97 :     | sayv(REAL r) = pr r
98 :     | sayv(STRING s) = (pr "\""; pr s; pr "\"")
99 :     | sayv _ = error "sayv in spill.sml"
100 :    
101 :     val vallist = PrintUtil.printClosedSequence("[",",","]") sayv
102 :    
103 :     fun cut(0,_) = []
104 :     | cut(i,a::x) = a::cut(i-1,x)
105 :     | cut(_,[]) = []
106 :    
107 :     fun nextuse x =
108 :     let val infinity = 1000000
109 :     fun xin[] = false | xin(VAR y::r) = x=y orelse xin r | xin(_::r) = xin r
110 :     fun g(level,a) =
111 :     let val rec f =
112 :     fn ([],[]) => infinity
113 :     | ([],next) => g(level+1,next)
114 :     | (SWITCH(v,c,l)::r,next) => if xin[v] then level else f(r,l@next)
115 :     | (RECORD(_,l,w,c)::r,next) =>
116 :     if xin(map #1 l) then level else f(r,c::next)
117 :     | (SELECT(i,v,w,_,c)::r,next) => if xin[v] then level else f(r,c::next)
118 :     | (OFFSET(i,v,w,c)::r,next) => if xin[v] then level else f(r,c::next)
119 :     | (SETTER(i,a,c)::r,next) => if xin a then level else f(r,c::next)
120 :     | (LOOKER(i,a,w,_,c)::r,next) => if xin a then level else f(r,c::next)
121 :     | (ARITH(i,a,w,_,c)::r,next) => if xin a then level else f(r,c::next)
122 :     | (PURE(i,a,w,_,c)::r,next) => if xin a then level else f(r,c::next)
123 :     | (BRANCH(i,a,c,e1,e2)::r,next) =>
124 :     if xin a then level else f(r,e1::e2::next)
125 :     | (APP(v,vl)::r,next) => if xin(v::vl) then level else f(r,next)
126 :     | _ => error "next use in spill.sml"
127 :     in f(a,[])
128 :     end
129 :     fun h y = g(0,[y])
130 :     in h
131 :     end
132 :    
133 :     fun sortdups(cexp,dups) =
134 :     map #2 (sortp (map (fn dup as (v,w) => (nextuse v cexp, dup)) dups))
135 :    
136 :     fun next_n_dups(0,cexp,dups) = []
137 :     | next_n_dups(n,cexp,dups) =
138 :     if (n >= length dups) then dups else cut(n,sortdups(cexp,dups))
139 :    
140 :     fun clean l =
141 :     let fun vars(l, VAR x :: rest) = vars(enter(x,l), rest)
142 :     | vars(l, _::rest) = vars(l,rest)
143 :     | vars(l, nil) = l
144 :     in vars([], l)
145 :     end
146 :    
147 :     fun partition f l =
148 :     foldr (fn (e,(a,b)) => if f e then (e::a,b) else (a,e::b)) ([], []) l
149 :    
150 :    
151 :     (***************************************************************************
152 :     * MAIN FUNCTION spillit : CPS.function -> CPS.function *
153 :     ***************************************************************************)
154 :    
155 :     exception SpillCtyMap
156 : blume 733 val ctymap : cty IntHashTable.hash_table = IntHashTable.mkTable(32,SpillCtyMap)
157 :     fun clearCtyMap() = IntHashTable.clear ctymap
158 :     fun getty v = getOpt (IntHashTable.find ctymap v, BOGt)
159 :     val addty = IntHashTable.insert ctymap
160 : monnier 245 fun copyLvar v = let val p = (LV.dupLvar v, getty v) in addty p; p end
161 :     fun floatP v = case (getty v) of FLTt => true | _ => false
162 :    
163 :     datatype spillkind = GPRSPILL | FPRSPILL
164 :     type spillinfo = (lvar list * value) option
165 :    
166 :     fun spillit (fkind,func,vl,cl,body,skind) = let
167 :    
168 :     val (varsP, nvarP, varLen, rkind, sregN) =
169 :     case skind
170 :     of FPRSPILL => (sublist floatP, not o floatP, maxfpfree, RK_FBLOCK, 0)
171 :     | GPRSPILL =>
172 :     (if unboxedfloat then
173 :     (sublist (not o floatP), floatP, maxgpfree, RK_SPILL, 1)
174 :     else (fn x => x, fn _ => false, maxgpfree, RK_SPILL, 1))
175 :    
176 :     val _ = clearCtyMap()
177 :     val _ = app2 addty (vl,cl)
178 :     val freevars =
179 :     let exception SpillFreemap
180 : blume 733 val m = IntHashTable.mkTable(32, SpillFreemap)
181 :     : lvar list IntHashTable.hash_table
182 :     val _ = FreeMap.freemap (IntHashTable.insert m) body
183 :     in fn x => ((IntHashTable.lookup m x) handle SpillFreemap =>
184 : monnier 245 (pr "compiler bugs in spill.sml: ";
185 :     (pr o Int.toString) x; pr " \n";
186 :     raise SpillFreemap))
187 :     end
188 :    
189 :     (* INVARIANT: results, uniques have already been sifted through varsP *)
190 :     fun f(results : lvar list, uniques : lvar list, dups : (lvar*lvar) list,
191 :     spill : spillinfo, cexp : cexp) =
192 :     let val (before,after) = (* variables free in this operation, and after
193 :     not including the newly-bound variables *)
194 :     let val rec free =
195 :     fn SWITCH(v,_,l) => foldmerge(clean[v] :: map free l)
196 :     | RECORD(_,l,w,c) => clean (map #1 l) \/ freevars w
197 :     | SELECT(i,v,w,_,c) => clean[v] \/ freevars w
198 :     | OFFSET(i,v,w,c) => clean[v] \/ freevars w
199 :     | SETTER(i,vl,c) => clean vl \/ free c
200 :     | LOOKER(i,vl,w,_,c) => clean vl \/ freevars w
201 :     | ARITH(i,vl,w,_,c) => clean vl \/ freevars w
202 :     | PURE(i,vl,w,_,c) => clean vl \/ freevars w
203 :     | BRANCH(i,vl,c,c1,c2) => clean vl \/ free c1 \/ free c2
204 :     | APP(f,vl) => clean(f::vl)
205 :     | _ => error "free in spill 232"
206 :     in case cexp
207 :     of SWITCH(v,_,l) => (clean[v], foldmerge(map free l))
208 :     | RECORD(_,l,w,c) => (clean(map #1 l), freevars w)
209 :     | SELECT(i,v,w,_,c) => (clean[v], freevars w)
210 :     | OFFSET(i,v,w,c) => (clean[v], freevars w)
211 :     | SETTER(i,vl,c) => (clean vl, free c)
212 :     | LOOKER(i,vl,w,_,c) => (clean vl, freevars w)
213 :     | ARITH(i,vl,w,_,c) => (clean vl, freevars w)
214 :     | PURE(i,vl,w,_,c) => (clean vl, freevars w)
215 :     | BRANCH(i,vl,c,c1,c2) => (clean vl, free c1 \/ free c2)
216 :     | APP(f,vl) => (clean(f::vl), [])
217 :     | _ => error "free in spill 233"
218 :     end
219 :    
220 :     val (before,after) = (varsP before, varsP after)
221 :     val uniques = uniques \/ results (* is this line necessary? *)
222 :     val uniques_after = uniques /\ after
223 :     val uniques_before = (uniques /\ before) \/ uniques_after
224 :     val spill_after =
225 :     (case spill
226 :     of NONE => NONE
227 :     | SOME(contents,_) =>
228 :     (case (uniq contents) /\ after of [] => NONE
229 :     | _ => spill))
230 :    
231 :     val maxfree' = case spill of NONE => varLen
232 :     | _ => varLen-sregN
233 :     val avail = maxfree' - length(uniques_before \/ results)
234 :     val dups = next_n_dups(avail,cexp,dups)
235 :    
236 :     val maxfreeafter = case spill_after of NONE => varLen
237 :     | SOME _ => varLen-sregN
238 :    
239 :     fun getpath (VAR v) =
240 :     if (member uniques_before v) orelse (nvarP v) then (VAR v, OFFp 0)
241 :     else let fun find(i,w::l,sv) =
242 :     if (v=w) then (sv, SELp(i,OFFp 0))
243 :     else find(i+1,l,sv)
244 :     | find _ = error "not found in spill 001"
245 :    
246 :     fun try((w,x)::l) = if v=w then (VAR x, OFFp 0) else try l
247 :     | try [] = (case spill
248 :     of SOME(l,sv) => find(0,l,sv)
249 :     | _ => error "not found in spill 002")
250 :    
251 :     in try dups
252 :     end
253 :     | getpath x = (x, OFFp 0)
254 :    
255 :     fun makeSpillRec args = (* args are already sift-ed *)
256 :     let val contents = args \/ after
257 :     val spillrec = map (getpath o VAR) contents
258 :     val sv = spillLvar()
259 :     val spinfo = SOME(contents,VAR sv)
260 :     val dups' = map (fn x => (x,x)) uniques_before @ dups
261 :     val _ = CGoptions.spillGen := !CGoptions.spillGen + 1;
262 :     val header = fn ce => RECORD(rkind,spillrec,sv,ce)
263 :     val nce = f([],[],dups',spinfo,cexp)
264 :     in header(if not(!CGoptions.allocprof) then nce
265 :     else AllocProf.profSpill (length contents) nce)
266 :     end
267 :    
268 :     (* here args and res are not sifted yet *)
269 :     fun g(args,res,conts,temps,gen) =
270 :     let val nargs = varsP (clean args)
271 :     val nres = varsP (uniq res)
272 :     val allargs = nargs \/ uniques_after
273 :     in if ((length(allargs) + temps > maxfreeafter) orelse
274 :     (length nres + length uniques_after + temps > maxfreeafter))
275 :     then makeSpillRec nargs
276 :     else let val paths =
277 :     map (fn x => (x, getpath (VAR x))) nargs
278 :     fun fetchit (_,(_,OFFp 0)) = false | fetchit _ = true
279 :     in case (sublist fetchit paths)
280 :     of (v,(w,SELp(i,OFFp 0)))::r =>
281 :     let val (x,ct) = copyLvar v
282 :     val aftervars = case r of [] => spill_after
283 :     | _ => spill
284 :     in (* pr "Fetching "; (pr o Int.toString) v;
285 :     pr "\n"; *)
286 :     SELECT(i,w,x,ct,
287 :     f([],uniques_before,(v,x)::dups,
288 :     aftervars,cexp))
289 :     end
290 :     | _::r => error "unexpected access in g in spill"
291 :     | [] => let fun f' cexp = f(nres,uniques_after,
292 :     dups,spill_after,cexp)
293 :     in gen(map (#1 o getpath) args,
294 :     res,map f' conts)
295 :     end
296 :     end
297 :     end
298 :    
299 :     in case cexp
300 :     of SWITCH(v,c,l) => g([v],[],l,0,fn([v],[],l)=>SWITCH(v,c,l))
301 :     | RECORD(k,l,w,c) =>
302 :     if (sregN + length uniques_after > maxfreeafter)
303 :     then makeSpillRec(varsP(clean(map #1 l)))
304 :     else let val paths = map (fn (v,p) =>
305 :     let val (v',p') = getpath v
306 :     in (v', combinepaths(p',p))
307 :     end) l
308 :     in RECORD(k,paths,w,
309 :     f(varsP [w],uniques_after,dups,spill_after,c))
310 :     end
311 :     | SELECT(i,v,w,t,c) =>
312 :     (addty(w,t); g([v],[w],[c],0,fn([v],[w],[c])=>SELECT(i,v,w,t,c)))
313 :     | OFFSET(i,v,w,c) => g([v],[w],[c],0,fn([v],[w],[c])=>OFFSET(i,v,w,c))
314 :     | SETTER(i,vl,c) => g(vl,[],[c],0,fn(vl,_,[c])=>SETTER(i,vl,c))
315 :     | LOOKER(i,vl,w,t,c) =>
316 :     (addty(w,t); g(vl,[w],[c],0, fn(vl,[w],[c])=>LOOKER(i,vl,w,t,c)))
317 :     | ARITH(i,vl,w,t,c) =>
318 :     (addty(w,t); g(vl,[w],[c],0, fn(vl,[w],[c])=>ARITH(i,vl,w,t,c)))
319 :     | PURE(i,vl,w,t,c) =>
320 :     (addty(w,t); g(vl,[w],[c],0, fn(vl,[w],[c])=>PURE(i,vl,w,t,c)))
321 :     | BRANCH(i as P.streq,vl,c,c1,c2) =>
322 :     g(vl,[],[c1,c2],sregN, fn(vl,_,[c1,c2])=>BRANCH(i,vl,c,c1,c2))
323 :     | BRANCH(i as P.strneq,vl,c,c1,c2) =>
324 :     g(vl,[],[c1,c2],sregN, fn(vl,_,[c1,c2])=>BRANCH(i,vl,c,c1,c2))
325 :     | BRANCH(i,vl,c,c1,c2) =>
326 :     g(vl,[],[c1,c2],0, fn(vl,_,[c1,c2])=>BRANCH(i,vl,c,c1,c2))
327 :     | APP(f,vl) => g(f::vl,[],[],0,fn(f::vl,[],[])=>APP(f,vl))
328 :     | _ => error "spill 2394892"
329 :     end
330 :    
331 :     in (fkind,func,vl,cl,f([],varsP(uniq vl),[],NONE,body))
332 :     end
333 :    
334 :    
335 :     (*****************************************************************************
336 :     * CHECK IF SPILLING IS NECESSARY *
337 :     *****************************************************************************)
338 :     local
339 :     exception TooMany
340 :     exception FloatSet
341 : blume 733 val floatset : bool IntHashTable.hash_table =
342 :     IntHashTable.mkTable(32,FloatSet)
343 :     fun fltM(v,FLTt) = IntHashTable.insert floatset (v,true)
344 : monnier 245 | fltM _ = ()
345 : blume 733 fun fltP v = getOpt (IntHashTable.find floatset v, false)
346 :     fun clearSet() = IntHashTable.clear floatset
347 : monnier 245 val dummyM = fn _ => ()
348 :     val dummyP = fn _ => true
349 :     in
350 :    
351 :     fun check((_,f,args,cl,body),skind) =
352 :     let val (varM, varP, varLen) =
353 :     (case skind
354 :     of FPRSPILL => (fltM, fltP, maxfpfree)
355 :     | GPRSPILL => if unboxedfloat then (fltM, not o fltP, maxgpfree)
356 :     else (dummyM, dummyP, maxgpfree))
357 :     val _ = clearSet()
358 :     val _ = app2 varM (args,cl)
359 :    
360 :     fun sift(l,vl) =
361 :     let fun h((VAR x)::r,vl) =
362 :     if varP x then h(r,enter(x,vl)) else h(r,vl)
363 :     | h(_::r,vl) = h(r,vl)
364 :     | h([],vl) = vl
365 :     in h(l,vl)
366 :     end
367 :    
368 :     fun verify (w,vl) =
369 :     let val nvl = rmv(w,vl)
370 :     in if (length(nvl) >= varLen) then raise TooMany else nvl
371 :     end
372 :    
373 :     val rec freevars =
374 :     fn APP(v,args) => sift(v::args,[])
375 :     | SWITCH(v,c,l) => sift([v],foldmerge(map freevars l))
376 :     | SELECT(_,v,w,t,e) => (varM(w,t); sift([v],verify(w,freevars e)))
377 :     | RECORD(_,l,w,e) => (sift((map #1 l),verify(w,freevars e)))
378 :     | OFFSET(_,v,w,e) => (sift([v],verify(w,freevars e)))
379 :     | SETTER(_,vl,e) => sift(vl,freevars e)
380 :     | LOOKER(_,vl,w,t,e) => (varM(w,t); sift(vl,verify(w,freevars e)))
381 :     | ARITH(_,vl,w,t,e) => (varM(w,t); sift(vl,verify(w,freevars e)))
382 :     | PURE(_,vl,w,t,e) => (varM(w,t); sift(vl,verify(w,freevars e)))
383 :     | BRANCH(_,vl,c,e1,e2) => sift(vl,merge(freevars e1,freevars e2))
384 :     | FIX _ => error "FIX in Freemap.freemap"
385 :    
386 :     in (freevars body; true) handle TooMany => false
387 :     end
388 :    
389 :     end (* local dec for the "check" function *)
390 :    
391 :     (*****************************************************************************
392 :     * IMPROVE THE REGISTER USAGE BY SIMPLE RENAMING OF RECORD FIELDS *
393 :     * (this procedure can be improved by reordering the cps expressions *
394 :     * based on the lifetime of each variables; by doing this, we can avoid *
395 :     * most of the big cluster of simultaneously live variables. --zsh) *
396 :     *****************************************************************************)
397 :     fun improve cexp =
398 :     let exception Spillmap
399 : blume 733 val m : (int ref*int*value) IntHashTable.hash_table =
400 :     IntHashTable.mkTable(32,Spillmap)
401 :     val enter = IntHashTable.insert m
402 :     val lookup = IntHashTable.lookup m
403 : monnier 429 fun get(VAR x) = (SOME(lookup x) handle Spillmap => NONE)
404 : monnier 245 | get _ = NONE
405 : blume 733 fun kill(VAR v) = (ignore (IntHashTable.remove m v) handle _ => ())
406 : monnier 245 | kill _ = ()
407 :     fun use v = case get v of SOME(r as ref 0,i,w) => r := 1
408 :     | SOME _ => kill v
409 :     | NONE => ()
410 :     val rec pass1 =
411 :     fn SELECT(i,v,w,_,e) => (kill v; enter(w,(ref 0,i,v)); pass1 e)
412 :     | OFFSET(i,v,w,e) => (kill v; pass1 e)
413 :     (* | RECORD(RK_FBLOCK,vl,w,e) => (app (kill o #1) vl; pass1 e) *)
414 :     | RECORD(_,vl,w,e) => (app (use o #1) vl; pass1 e)
415 :     | APP(v,vl) => (kill v; app kill vl)
416 :     | FIX(l,e) => error "33832 in spill"
417 :     | SWITCH(v,_,el) => (kill v; app pass1 el)
418 :     | BRANCH(i,vl,c,e1,e2) => (app kill vl; pass1 e1; pass1 e2)
419 :     | SETTER(i,vl,e) => (app kill vl; pass1 e)
420 :     | LOOKER(i,vl,w,_,e) => (app kill vl; pass1 e)
421 :     | ARITH(i,vl,w,_,e) => (app kill vl; pass1 e)
422 :     | PURE(i,vl,w,_,e) => (app kill vl; pass1 e)
423 :    
424 :     fun ren(v,p) = case get v of SOME(_,i,w) => (w,SELp(i,p))
425 :     | NONE => (v,p)
426 :    
427 :     val rec g =
428 :     fn SELECT(i,v,w,t,e) =>
429 :     (case get(VAR w) of SOME _ => g e
430 :     | NONE => SELECT(i,v,w,t,g e))
431 :     | OFFSET(i,v,w,e) => OFFSET(i,v,w, g e)
432 :     (* | RECORD(k as RK_FBLOCK,vl,w,e) => RECORD(k,vl,w,g e) *)
433 :     | RECORD(k,vl,w,e) => RECORD(k,map ren vl, w, g e)
434 :     | e as APP(v,vl) => e
435 :     | FIX(l,e) => error "33832 in spill"
436 :     | SWITCH(v,c,el) => SWITCH(v,c,map g el)
437 :     | BRANCH(i,vl,c,e1,e2) => BRANCH(i,vl,c, g e1, g e2)
438 :     | SETTER(i,vl,e) => SETTER(i,vl, g e)
439 :     | LOOKER(i,vl,w,t,e) => LOOKER(i,vl,w,t,g e)
440 :     | ARITH(i,vl,w,t,e) => ARITH(i,vl,w,t,g e)
441 :     | PURE(i,vl,w,t,e) => PURE(i,vl,w,t,g e)
442 :    
443 : blume 733 val count = (pass1 cexp; IntHashTable.numItems m)
444 : monnier 245
445 :     val _ = if (!CGoptions.debugcps) then
446 :     (pr "count="; (pr o Int.toString) count; pr "\n")
447 :     else ()
448 :     in if count>0 then SOME(g cexp) else NONE
449 :     end
450 :    
451 :     (*****************************************************************************
452 :     * THE EXPORTED "SPILL" FUNCTION *
453 :     *****************************************************************************)
454 :     fun spillone arg =
455 :     let val _ = (if (!CGoptions.printit)
456 :     then (pr "^^^^^within the spill phase^^^^^^^^ \n";
457 :     PPCps.printcps0 arg;
458 :     pr "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ \n")
459 :     else ())
460 :    
461 :     fun spillgpr (arg as (fkind,func,vl,cl,body)) =
462 :     if check(arg,GPRSPILL) then arg
463 :     else (if (!CGoptions.printit)
464 :     then (pr "^^^^ need go through more rounds ^^^^ \n")
465 :     else ();
466 :     case improve body
467 :     of SOME body' => spillgpr(fkind,func,vl,cl,body')
468 :     | NONE => spillit(fkind,func,vl,cl,body,GPRSPILL))
469 :    
470 :     fun spillfpr (arg as (fkind,func,vl,cl,body)) =
471 :     if check(arg,FPRSPILL) then spillgpr arg
472 :     else (if (!CGoptions.printit)
473 :     then (pr "^^^^ need go through more rounds ^^^^ \n")
474 :     else ();
475 :     case improve body
476 :     of SOME body' => spillfpr(fkind,func,vl,cl,body')
477 :     | NONE => spillgpr(spillit(fkind,func,vl,cl,body,FPRSPILL)))
478 :    
479 :     in if unboxedfloat then spillfpr arg
480 :     else spillgpr arg
481 :     end
482 :    
483 :     val spill = map spillone
484 :    
485 :     end (* local *)
486 :     end (* functor Spill *)
487 :    

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