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

Annotation of /sml/branches/SMLNJ/src/compiler/CodeGen/cpscompile/spill.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (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 :     fun sortp x = Sort.sort (fn ((i:int,_),(j,_)) => i>j) x
21 :     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 :     val ctymap : cty Intmap.intmap = Intmap.new(32,SpillCtyMap)
157 :     fun clearCtyMap() = Intmap.clear ctymap
158 :     fun getty v = (Intmap.map ctymap v) handle _ => BOGt
159 :     val addty = Intmap.add ctymap
160 :     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 :     val m = Intmap.new(32, SpillFreemap) : lvar list Intmap.intmap
181 :     val _ = FreeMap.freemap (Intmap.add m) body
182 :     in fn x => ((Intmap.map m x) handle SpillFreemap =>
183 :     (pr "compiler bugs in spill.sml: ";
184 :     (pr o Int.toString) x; pr " \n";
185 :     raise SpillFreemap))
186 :     end
187 :    
188 :     (* INVARIANT: results, uniques have already been sifted through varsP *)
189 :     fun f(results : lvar list, uniques : lvar list, dups : (lvar*lvar) list,
190 :     spill : spillinfo, cexp : cexp) =
191 :     let val (before,after) = (* variables free in this operation, and after
192 :     not including the newly-bound variables *)
193 :     let val rec free =
194 :     fn SWITCH(v,_,l) => foldmerge(clean[v] :: map free l)
195 :     | RECORD(_,l,w,c) => clean (map #1 l) \/ freevars w
196 :     | SELECT(i,v,w,_,c) => clean[v] \/ freevars w
197 :     | OFFSET(i,v,w,c) => clean[v] \/ freevars w
198 :     | SETTER(i,vl,c) => clean vl \/ free c
199 :     | LOOKER(i,vl,w,_,c) => clean vl \/ freevars w
200 :     | ARITH(i,vl,w,_,c) => clean vl \/ freevars w
201 :     | PURE(i,vl,w,_,c) => clean vl \/ freevars w
202 :     | BRANCH(i,vl,c,c1,c2) => clean vl \/ free c1 \/ free c2
203 :     | APP(f,vl) => clean(f::vl)
204 :     | _ => error "free in spill 232"
205 :     in case cexp
206 :     of SWITCH(v,_,l) => (clean[v], foldmerge(map free l))
207 :     | RECORD(_,l,w,c) => (clean(map #1 l), freevars w)
208 :     | SELECT(i,v,w,_,c) => (clean[v], freevars w)
209 :     | OFFSET(i,v,w,c) => (clean[v], freevars w)
210 :     | SETTER(i,vl,c) => (clean vl, free c)
211 :     | LOOKER(i,vl,w,_,c) => (clean vl, freevars w)
212 :     | ARITH(i,vl,w,_,c) => (clean vl, freevars w)
213 :     | PURE(i,vl,w,_,c) => (clean vl, freevars w)
214 :     | BRANCH(i,vl,c,c1,c2) => (clean vl, free c1 \/ free c2)
215 :     | APP(f,vl) => (clean(f::vl), [])
216 :     | _ => error "free in spill 233"
217 :     end
218 :    
219 :     val (before,after) = (varsP before, varsP after)
220 :     val uniques = uniques \/ results (* is this line necessary? *)
221 :     val uniques_after = uniques /\ after
222 :     val uniques_before = (uniques /\ before) \/ uniques_after
223 :     val spill_after =
224 :     (case spill
225 :     of NONE => NONE
226 :     | SOME(contents,_) =>
227 :     (case (uniq contents) /\ after of [] => NONE
228 :     | _ => spill))
229 :    
230 :     val maxfree' = case spill of NONE => varLen
231 :     | _ => varLen-sregN
232 :     val avail = maxfree' - length(uniques_before \/ results)
233 :     val dups = next_n_dups(avail,cexp,dups)
234 :    
235 :     val maxfreeafter = case spill_after of NONE => varLen
236 :     | SOME _ => varLen-sregN
237 :    
238 :     fun getpath (VAR v) =
239 :     if (member uniques_before v) orelse (nvarP v) then (VAR v, OFFp 0)
240 :     else let fun find(i,w::l,sv) =
241 :     if (v=w) then (sv, SELp(i,OFFp 0))
242 :     else find(i+1,l,sv)
243 :     | find _ = error "not found in spill 001"
244 :    
245 :     fun try((w,x)::l) = if v=w then (VAR x, OFFp 0) else try l
246 :     | try [] = (case spill
247 :     of SOME(l,sv) => find(0,l,sv)
248 :     | _ => error "not found in spill 002")
249 :    
250 :     in try dups
251 :     end
252 :     | getpath x = (x, OFFp 0)
253 :    
254 :     fun makeSpillRec args = (* args are already sift-ed *)
255 :     let val contents = args \/ after
256 :     val spillrec = map (getpath o VAR) contents
257 :     val sv = spillLvar()
258 :     val spinfo = SOME(contents,VAR sv)
259 :     val dups' = map (fn x => (x,x)) uniques_before @ dups
260 :     val _ = CGoptions.spillGen := !CGoptions.spillGen + 1;
261 :     val header = fn ce => RECORD(rkind,spillrec,sv,ce)
262 :     val nce = f([],[],dups',spinfo,cexp)
263 :     in header(if not(!CGoptions.allocprof) then nce
264 :     else AllocProf.profSpill (length contents) nce)
265 :     end
266 :    
267 :     (* here args and res are not sifted yet *)
268 :     fun g(args,res,conts,temps,gen) =
269 :     let val nargs = varsP (clean args)
270 :     val nres = varsP (uniq res)
271 :     val allargs = nargs \/ uniques_after
272 :     in if ((length(allargs) + temps > maxfreeafter) orelse
273 :     (length nres + length uniques_after + temps > maxfreeafter))
274 :     then makeSpillRec nargs
275 :     else let val paths =
276 :     map (fn x => (x, getpath (VAR x))) nargs
277 :     fun fetchit (_,(_,OFFp 0)) = false | fetchit _ = true
278 :     in case (sublist fetchit paths)
279 :     of (v,(w,SELp(i,OFFp 0)))::r =>
280 :     let val (x,ct) = copyLvar v
281 :     val aftervars = case r of [] => spill_after
282 :     | _ => spill
283 :     in (* pr "Fetching "; (pr o Int.toString) v;
284 :     pr "\n"; *)
285 :     SELECT(i,w,x,ct,
286 :     f([],uniques_before,(v,x)::dups,
287 :     aftervars,cexp))
288 :     end
289 :     | _::r => error "unexpected access in g in spill"
290 :     | [] => let fun f' cexp = f(nres,uniques_after,
291 :     dups,spill_after,cexp)
292 :     in gen(map (#1 o getpath) args,
293 :     res,map f' conts)
294 :     end
295 :     end
296 :     end
297 :    
298 :     in case cexp
299 :     of SWITCH(v,c,l) => g([v],[],l,0,fn([v],[],l)=>SWITCH(v,c,l))
300 :     | RECORD(k,l,w,c) =>
301 :     if (sregN + length uniques_after > maxfreeafter)
302 :     then makeSpillRec(varsP(clean(map #1 l)))
303 :     else let val paths = map (fn (v,p) =>
304 :     let val (v',p') = getpath v
305 :     in (v', combinepaths(p',p))
306 :     end) l
307 :     in RECORD(k,paths,w,
308 :     f(varsP [w],uniques_after,dups,spill_after,c))
309 :     end
310 :     | SELECT(i,v,w,t,c) =>
311 :     (addty(w,t); g([v],[w],[c],0,fn([v],[w],[c])=>SELECT(i,v,w,t,c)))
312 :     | OFFSET(i,v,w,c) => g([v],[w],[c],0,fn([v],[w],[c])=>OFFSET(i,v,w,c))
313 :     | SETTER(i,vl,c) => g(vl,[],[c],0,fn(vl,_,[c])=>SETTER(i,vl,c))
314 :     | LOOKER(i,vl,w,t,c) =>
315 :     (addty(w,t); g(vl,[w],[c],0, fn(vl,[w],[c])=>LOOKER(i,vl,w,t,c)))
316 :     | ARITH(i,vl,w,t,c) =>
317 :     (addty(w,t); g(vl,[w],[c],0, fn(vl,[w],[c])=>ARITH(i,vl,w,t,c)))
318 :     | PURE(i,vl,w,t,c) =>
319 :     (addty(w,t); g(vl,[w],[c],0, fn(vl,[w],[c])=>PURE(i,vl,w,t,c)))
320 :     | BRANCH(i as P.streq,vl,c,c1,c2) =>
321 :     g(vl,[],[c1,c2],sregN, fn(vl,_,[c1,c2])=>BRANCH(i,vl,c,c1,c2))
322 :     | BRANCH(i as P.strneq,vl,c,c1,c2) =>
323 :     g(vl,[],[c1,c2],sregN, fn(vl,_,[c1,c2])=>BRANCH(i,vl,c,c1,c2))
324 :     | BRANCH(i,vl,c,c1,c2) =>
325 :     g(vl,[],[c1,c2],0, fn(vl,_,[c1,c2])=>BRANCH(i,vl,c,c1,c2))
326 :     | APP(f,vl) => g(f::vl,[],[],0,fn(f::vl,[],[])=>APP(f,vl))
327 :     | _ => error "spill 2394892"
328 :     end
329 :    
330 :     in (fkind,func,vl,cl,f([],varsP(uniq vl),[],NONE,body))
331 :     end
332 :    
333 :    
334 :     (*****************************************************************************
335 :     * CHECK IF SPILLING IS NECESSARY *
336 :     *****************************************************************************)
337 :     local
338 :     exception TooMany
339 :     exception FloatSet
340 :     val floatset : bool Intmap.intmap = Intmap.new(32,FloatSet)
341 :     fun fltM(v,FLTt) = Intmap.add floatset (v,true)
342 :     | fltM _ = ()
343 :     fun fltP v = (Intmap.map floatset v) handle _ => false
344 :     fun clearSet() = Intmap.clear floatset
345 :     val dummyM = fn _ => ()
346 :     val dummyP = fn _ => true
347 :     in
348 :    
349 :     fun check((_,f,args,cl,body),skind) =
350 :     let val (varM, varP, varLen) =
351 :     (case skind
352 :     of FPRSPILL => (fltM, fltP, maxfpfree)
353 :     | GPRSPILL => if unboxedfloat then (fltM, not o fltP, maxgpfree)
354 :     else (dummyM, dummyP, maxgpfree))
355 :     val _ = clearSet()
356 :     val _ = app2 varM (args,cl)
357 :    
358 :     fun sift(l,vl) =
359 :     let fun h((VAR x)::r,vl) =
360 :     if varP x then h(r,enter(x,vl)) else h(r,vl)
361 :     | h(_::r,vl) = h(r,vl)
362 :     | h([],vl) = vl
363 :     in h(l,vl)
364 :     end
365 :    
366 :     fun verify (w,vl) =
367 :     let val nvl = rmv(w,vl)
368 :     in if (length(nvl) >= varLen) then raise TooMany else nvl
369 :     end
370 :    
371 :     val rec freevars =
372 :     fn APP(v,args) => sift(v::args,[])
373 :     | SWITCH(v,c,l) => sift([v],foldmerge(map freevars l))
374 :     | SELECT(_,v,w,t,e) => (varM(w,t); sift([v],verify(w,freevars e)))
375 :     | RECORD(_,l,w,e) => (sift((map #1 l),verify(w,freevars e)))
376 :     | OFFSET(_,v,w,e) => (sift([v],verify(w,freevars e)))
377 :     | SETTER(_,vl,e) => sift(vl,freevars e)
378 :     | LOOKER(_,vl,w,t,e) => (varM(w,t); sift(vl,verify(w,freevars e)))
379 :     | ARITH(_,vl,w,t,e) => (varM(w,t); sift(vl,verify(w,freevars e)))
380 :     | PURE(_,vl,w,t,e) => (varM(w,t); sift(vl,verify(w,freevars e)))
381 :     | BRANCH(_,vl,c,e1,e2) => sift(vl,merge(freevars e1,freevars e2))
382 :     | FIX _ => error "FIX in Freemap.freemap"
383 :    
384 :     in (freevars body; true) handle TooMany => false
385 :     end
386 :    
387 :     end (* local dec for the "check" function *)
388 :    
389 :     (*****************************************************************************
390 :     * IMPROVE THE REGISTER USAGE BY SIMPLE RENAMING OF RECORD FIELDS *
391 :     * (this procedure can be improved by reordering the cps expressions *
392 :     * based on the lifetime of each variables; by doing this, we can avoid *
393 :     * most of the big cluster of simultaneously live variables. --zsh) *
394 :     *****************************************************************************)
395 :     fun improve cexp =
396 :     let exception Spillmap
397 :     val m : (int ref*int*value) Intmap.intmap = Intmap.new(32,Spillmap)
398 :     val enter = Intmap.add m
399 :     fun get(VAR x) = (SOME(Intmap.map m x) handle Spillmap => NONE)
400 :     | get _ = NONE
401 :     fun kill(VAR v) = Intmap.rmv m v
402 :     | kill _ = ()
403 :     fun use v = case get v of SOME(r as ref 0,i,w) => r := 1
404 :     | SOME _ => kill v
405 :     | NONE => ()
406 :     val rec pass1 =
407 :     fn SELECT(i,v,w,_,e) => (kill v; enter(w,(ref 0,i,v)); pass1 e)
408 :     | OFFSET(i,v,w,e) => (kill v; pass1 e)
409 :     (* | RECORD(RK_FBLOCK,vl,w,e) => (app (kill o #1) vl; pass1 e) *)
410 :     | RECORD(_,vl,w,e) => (app (use o #1) vl; pass1 e)
411 :     | APP(v,vl) => (kill v; app kill vl)
412 :     | FIX(l,e) => error "33832 in spill"
413 :     | SWITCH(v,_,el) => (kill v; app pass1 el)
414 :     | BRANCH(i,vl,c,e1,e2) => (app kill vl; pass1 e1; pass1 e2)
415 :     | SETTER(i,vl,e) => (app kill vl; pass1 e)
416 :     | LOOKER(i,vl,w,_,e) => (app kill vl; pass1 e)
417 :     | ARITH(i,vl,w,_,e) => (app kill vl; pass1 e)
418 :     | PURE(i,vl,w,_,e) => (app kill vl; pass1 e)
419 :    
420 :     fun ren(v,p) = case get v of SOME(_,i,w) => (w,SELp(i,p))
421 :     | NONE => (v,p)
422 :    
423 :     val rec g =
424 :     fn SELECT(i,v,w,t,e) =>
425 :     (case get(VAR w) of SOME _ => g e
426 :     | NONE => SELECT(i,v,w,t,g e))
427 :     | OFFSET(i,v,w,e) => OFFSET(i,v,w, g e)
428 :     (* | RECORD(k as RK_FBLOCK,vl,w,e) => RECORD(k,vl,w,g e) *)
429 :     | RECORD(k,vl,w,e) => RECORD(k,map ren vl, w, g e)
430 :     | e as APP(v,vl) => e
431 :     | FIX(l,e) => error "33832 in spill"
432 :     | SWITCH(v,c,el) => SWITCH(v,c,map g el)
433 :     | BRANCH(i,vl,c,e1,e2) => BRANCH(i,vl,c, g e1, g e2)
434 :     | SETTER(i,vl,e) => SETTER(i,vl, g e)
435 :     | LOOKER(i,vl,w,t,e) => LOOKER(i,vl,w,t,g e)
436 :     | ARITH(i,vl,w,t,e) => ARITH(i,vl,w,t,g e)
437 :     | PURE(i,vl,w,t,e) => PURE(i,vl,w,t,g e)
438 :    
439 :     val count = (pass1 cexp; length(Intmap.intMapToList m))
440 :    
441 :     val _ = if (!CGoptions.debugcps) then
442 :     (pr "count="; (pr o Int.toString) count; pr "\n")
443 :     else ()
444 :     in if count>0 then SOME(g cexp) else NONE
445 :     end
446 :    
447 :     (*****************************************************************************
448 :     * THE EXPORTED "SPILL" FUNCTION *
449 :     *****************************************************************************)
450 :     fun spillone arg =
451 :     let val _ = (if (!CGoptions.printit)
452 :     then (pr "^^^^^within the spill phase^^^^^^^^ \n";
453 :     PPCps.printcps0 arg;
454 :     pr "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ \n")
455 :     else ())
456 :    
457 :     fun spillgpr (arg as (fkind,func,vl,cl,body)) =
458 :     if check(arg,GPRSPILL) then arg
459 :     else (if (!CGoptions.printit)
460 :     then (pr "^^^^ need go through more rounds ^^^^ \n")
461 :     else ();
462 :     case improve body
463 :     of SOME body' => spillgpr(fkind,func,vl,cl,body')
464 :     | NONE => spillit(fkind,func,vl,cl,body,GPRSPILL))
465 :    
466 :     fun spillfpr (arg as (fkind,func,vl,cl,body)) =
467 :     if check(arg,FPRSPILL) then spillgpr arg
468 :     else (if (!CGoptions.printit)
469 :     then (pr "^^^^ need go through more rounds ^^^^ \n")
470 :     else ();
471 :     case improve body
472 :     of SOME body' => spillfpr(fkind,func,vl,cl,body')
473 :     | NONE => spillgpr(spillit(fkind,func,vl,cl,body,FPRSPILL)))
474 :    
475 :     in if unboxedfloat then spillfpr arg
476 :     else spillgpr arg
477 :     end
478 :    
479 :     val spill = map spillone
480 :    
481 :     end (* local *)
482 :     end (* functor Spill *)
483 :    
484 :     (*
485 :     * $Log$
486 :     *)

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