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

Parent Directory | Revision Log

---

Revision 285 - (view) (download)

1 :	monnier	245	(* Copyright 1996 by Bell Laboratories *)
2 :			(* limit.sml *)
3 :
4 :			signature LIMIT = sig
5 :			val nolimit : CPS.function list ->
6 :			CPS.function list * (CPS.lvar -> (int * int))
7 :			end (* signature LIMIT *)
8 :
9 :			structure Limit : LIMIT = struct
10 :
11 :			local
12 :			open CPS
13 :			in
14 :
15 :			val say = Control.Print.say
16 :			val error = ErrorMsg.impossible
17 :			structure CGoptions = Control.CG
18 :
19 :			val MAX_ALLOC = 1023 (* maximum number of words to allocate per check *)
20 :
21 :			fun findescapes fl =
22 :			let exception Limit
23 :			val m : fun_kind Intmap.intmap = Intmap.new(32,Limit)
24 :			val _ = app (fn (k,f,_,_,_) => Intmap.add m (f,k)) fl
25 :			val escapes = Intmap.map m
26 :			in {escapes = escapes,
27 :			check = fn f => case escapes f of KNOWN => Intmap.add m (f,KNOWN_CHECK)
28 :			| _ => ()}
29 :			end
30 :
31 :			(* path now counts instructions as well as allocations, for polling *)
32 :			fun path escapes fl =
33 :			let exception Limit'
34 :			val b : cexp Intmap.intmap = Intmap.new(32,Limit')
35 :			val _ = app (Intmap.add b o (fn (_,f,_,_,body) => (f,body))) fl
36 :			val body = Intmap.map b
37 :
38 :			val m : {known: fun_kind, alloc: int, instrs: int} Intmap.intmap =
39 :			Intmap.new(32,Limit')
40 :			val look = Intmap.map m
41 :			val storeListSz = 2 (* size of store list entry *)
42 :			fun g(d, RECORD(RK_FBLOCK,vl,_,e)) = g(d + (length(vl) * 2) + 2,e)
43 :			| g(d, RECORD(RK_FCONT,vl,_,e)) = g(d + (length(vl) * 2) + 2,e)
44 :			| g(d, RECORD(RK_VECTOR,vl,_,e)) = g(d + length(vl) + 4, e)
45 :			| g(d, RECORD(_,vl,_,e)) = g(d+length(vl)+1, e)
46 :			| g(d, SELECT(_,_,_,_,e)) = g(d, e)
47 :			| g(d, OFFSET(_,_,_,e)) = g(d, e)
48 :			| g(d, SWITCH(_,_,el)) = foldr Int.max 0 (map (fn e => g(d,e)) el)
49 :	monnier	284	| g(d, SETTER(P.assign, _, e)) = g(d+storeListSz, e)
50 :	monnier	245	| g(d, SETTER(P.update,_,e)) = g(d+storeListSz, e)
51 :			| g(d, SETTER(P.boxedupdate,_,e)) = g(d+storeListSz, e)
52 :			(*** should be +0 when unboxedfloat is turned on ***)
53 :			| g(d, ARITH(P.arith{kind=P.FLOAT 64,...},_,_,_,e)) = g(d+3, e)
54 :			| g(d, ARITH(P.arith{kind=P.INT _,...},_,_,_,e)) = g(d+1, e)
55 :			| g(d, ARITH(P.testu _, _, _, _, e)) = g(d+1, e)
56 :			| g(d, ARITH(P.test _, _, _, _, e)) = g(d+1, e)
57 :	monnier	284	| g(d, ARITH(_,_,_,_,e)) = g(d,e)
58 :	monnier	245	| g(d, PURE(P.pure_arith{kind=P.FLOAT 64,...},_,_,_,e)) = g(d+3, e)
59 :			| g(d, PURE(P.real{tokind=P.FLOAT 64,...},_,_,_,e)) = g(d+3, e)
60 :	monnier	284	| g(d, PURE(P.fwrap,_,_,_,e)) = g(d+4, e)
61 :	monnier	245	| g(d, PURE(P.iwrap,_,_,_,e)) = g(d+2, e)
62 :			| g(d, PURE(P.i32wrap,_,_,_,e)) = g(d+2, e)
63 :			| g(d, PURE(P.newarray0,_,_,_,e)) = g(d+5, e)
64 :	monnier	284	| g(d, PURE(P.makeref, _, _, _, e)) = g(d+2, e)
65 :			| g(d, PURE(P.mkspecial, _, _, _, e)) = g(d+2, e)
66 :	monnier	245	| g(d, LOOKER(P.numsubscript{kind=P.FLOAT 64},_,_,_,e)) = g(d+3, e)
67 :			| g(d, SETTER(_,_,e)) = g(d,e)
68 :			| g(d, LOOKER(_,_,_,_,e)) = g(d,e)
69 :			| g(d, PURE(_,_,_,_,e)) = g(d,e)
70 :			| g(d, BRANCH(_,_,_,a,b)) = Int.max(g(d,a), g(d,b))
71 :			| g(d, APP(LABEL w, _)) =
72 :			(case maxpath w
73 :			of {known=KNOWN, alloc=n, instrs=i} =>
74 :			if d+n > MAX_ALLOC
75 :			then (Intmap.add m (w,{known=KNOWN_CHECK,
76 :			alloc=n,
77 :			instrs=i});
78 :			d)
79 :			else d+n
80 :			| _ => d)
81 :			| g(d, APP(_, _)) = d
82 :			(* | g(d, RECORD(RK_SPILL,vl,_,e)) = g(d + (length(vl) * 4) + 1,e) *)
83 :			| g(d, FIX _) = error "8932 in limit"
84 :
85 :			and h(d, RECORD(_,_,_,e)) = h(d+1, e)
86 :			| h(d, SELECT(_,_,_,_,e)) = h(d+1, e)
87 :			| h(d, OFFSET(_,_,_,e)) = h(d+1, e)
88 :			| h(d, SWITCH(_,_,el)) = foldr Int.max 1 (map (fn e => g(d,e)) el)
89 :			| h(d, SETTER(_,_,e)) = h(d+1, e)
90 :			| h(d, ARITH(_,_,_,_,e)) = h(d+1, e)
91 :			| h(d, PURE(_,_,_,_,e)) = h(d+1, e)
92 :			| h(d, LOOKER(_,_,_,_,e)) = h(d+1, e)
93 :			| h(d, BRANCH(_,_,_,a,b)) = Int.max(h(d,a), h(d,b)) + 1
94 :			| h(d, APP(LABEL w, _)) =
95 :			(case maxpath w of
96 :			{known=KNOWN, alloc, instrs=i} => d+i
97 :			| _ => d)
98 :			| h(d, APP(_, _)) = d
99 :			| h(d, FIX _) = error "8932.1 in limit"
100 :
101 :			and maxpath w = look w handle Limit' =>
102 :	monnier	284	(* Note that the heap may need to be aligned so g is
103 :			* called with g(1, bod). Be conservative.
104 :			*)
105 :	monnier	245	(case escapes w
106 :			of KNOWN => let val bod = body w
107 :	monnier	284	val n = g(1, bod)
108 :	monnier	245	val i = h(0, bod)
109 :			val z = if n>MAX_ALLOC
110 :			then {known=KNOWN_CHECK,alloc=n,instrs=i}
111 :			else {known=KNOWN,alloc=n,instrs=i}
112 :			in Intmap.add m (w,z);
113 :			z
114 :			end
115 :			| kind => let val bod = body w
116 :			val z = (Intmap.add m (w,{known=kind,
117 :			alloc=0,
118 :			instrs=0});
119 :			{known=kind,
120 :	monnier	284	alloc=g(1,bod),
121 :	monnier	245	instrs=h(0,bod)})
122 :			in Intmap.add m (w,z); z
123 :			end)
124 :
125 :			val _ = app (fn (_, x, _, _, _) => (maxpath x; ())) fl;
126 :			val nfl = map (fn (fk,v,args,cl,ce) => (#known(look v),v,args,cl,ce)) fl
127 :			in (nfl, fn x => (let val f = look x in (#alloc f,#instrs f) end))
128 :			end
129 :
130 :			fun nolimit fl =
131 :			let val {escapes, check} = findescapes fl
132 :			fun makenode (_,f,vl,_,body) =
133 :			let fun edges (RECORD(_,_,_,e)) = edges e
134 :			| edges (SELECT(_,_,_,_,e)) = edges e
135 :			| edges (OFFSET(_,_,_,e)) = edges e
136 :			| edges (SWITCH(_,_,el)) = List.concat (map edges el)
137 :			| edges (SETTER(_,_,e)) = edges e
138 :			| edges (LOOKER(_,_,_,_,e)) = edges e
139 :			| edges (ARITH(_,_,_,_,e)) = edges e
140 :			| edges (PURE(_,_,_,_,e)) = edges e
141 :			| edges (BRANCH(_,_,_,a,b)) = edges a @ edges b
142 :			| edges (APP(LABEL w, _)) = (case escapes w of KNOWN => [w]
143 :			| _ => nil)
144 :			| edges (APP _) = nil
145 :			| edges (FIX _) = error "8933 in limit"
146 :			in (f, edges body)
147 :			end
148 :			in if !CGoptions.printit
149 :			then (say "Starting feedback..."; Control.Print.flush()) else ();
150 :			app check (Feedback.feedback (map makenode fl));
151 :			if !CGoptions.printit
152 :			then (say "Finished\n"; Control.Print.flush()) else ();
153 :			path escapes fl
154 :			end
155 :
156 :			val nolimit = fn fl =>
157 :			if !CGoptions.printit
158 :			then let val info as (newfl,limits) = nolimit fl
159 :			fun showinfo (k,f,_,_,_) =
160 :			let val (alloc,instrs) = limits f
161 :			val s = Int.toString alloc
162 :			val i = Int.toString instrs
163 :			val _ = (say (LambdaVar.lvarName f); say "\t")
164 :			val _ = case k
165 :			of KNOWN => say "K "
166 :			| KNOWN_CHECK => say "H "
167 :			| ESCAPE => say "E "
168 :			| CONT => say "C "
169 :			| _ => error "nolimit 323 in limit.sml"
170 :			in (say s; say "\t"; say i; say "\n")
171 :			end
172 :
173 :			in app showinfo newfl;
174 :			info
175 :			end
176 :			else nolimit fl
177 :
178 :			end (* local *)
179 :			end (* structure Limit *)
180 :
181 :			(*
182 :			* $Log: limit.sml,v $
183 :	monnier	284	* Revision 1.1 1998/10/28 18:20:39 jhr
184 :			* Removed code generator support for STRING/REAL constants.
185 :			*
186 :	monnier	245	* Revision 1.1.1.1 1998/04/08 18:39:53 george
187 :			* Version 110.5
188 :			*
189 :			*)

---

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