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/OldCGen/cpsgen/spillNEW.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/OldCGen/cpsgen/spillNEW.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 66 - (view) (download)

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

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