Annotation of /sml/branches/SMLNJ/src/compiler/OldCGen/cpsgen/spillNEW.sml

Parent Directory | Revision Log

---

Revision 67 - (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