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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1347 - (view) (download)
Original Path: sml/trunk/src/compiler/CodeGen/cpscompile/limit.sml

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 : blume 733 val m : fun_kind IntHashTable.hash_table = IntHashTable.mkTable(32,Limit)
24 :     val _ = app (fn (k,f,_,_,_) => IntHashTable.insert m (f,k)) fl
25 :     val escapes = IntHashTable.lookup m
26 : monnier 245 in {escapes = escapes,
27 : blume 733 check = fn f => case escapes f of
28 :     KNOWN => IntHashTable.insert m (f,KNOWN_CHECK)
29 :     | _ => ()}
30 : monnier 245 end
31 :    
32 :     (* path now counts instructions as well as allocations, for polling *)
33 :     fun path escapes fl =
34 :     let exception Limit'
35 : blume 733 val b : cexp IntHashTable.hash_table = IntHashTable.mkTable(32,Limit')
36 :     val _ = app (IntHashTable.insert b o (fn (_,f,_,_,body) => (f,body))) fl
37 :     val body = IntHashTable.lookup b
38 : monnier 245
39 : blume 733 val m : {known: fun_kind, alloc: int, instrs: int}
40 :     IntHashTable.hash_table =
41 :     IntHashTable.mkTable(32,Limit')
42 :     val look = IntHashTable.lookup m
43 : monnier 245 val storeListSz = 2 (* size of store list entry *)
44 :     fun g(d, RECORD(RK_FBLOCK,vl,_,e)) = g(d + (length(vl) * 2) + 2,e)
45 :     | g(d, RECORD(RK_FCONT,vl,_,e)) = g(d + (length(vl) * 2) + 2,e)
46 :     | g(d, RECORD(RK_VECTOR,vl,_,e)) = g(d + length(vl) + 4, e)
47 :     | g(d, RECORD(_,vl,_,e)) = g(d+length(vl)+1, e)
48 :     | g(d, SELECT(_,_,_,_,e)) = g(d, e)
49 :     | g(d, OFFSET(_,_,_,e)) = g(d, e)
50 :     | g(d, SWITCH(_,_,el)) = foldr Int.max 0 (map (fn e => g(d,e)) el)
51 : monnier 284 | g(d, SETTER(P.assign, _, e)) = g(d+storeListSz, e)
52 : monnier 245 | g(d, SETTER(P.update,_,e)) = g(d+storeListSz, e)
53 :     | g(d, SETTER(P.boxedupdate,_,e)) = g(d+storeListSz, e)
54 :     (*** should be +0 when unboxedfloat is turned on ***)
55 :     | g(d, ARITH(P.arith{kind=P.FLOAT 64,...},_,_,_,e)) = g(d+3, e)
56 :     | g(d, ARITH(P.arith{kind=P.INT _,...},_,_,_,e)) = g(d+1, e)
57 :     | g(d, ARITH(P.testu _, _, _, _, e)) = g(d+1, e)
58 :     | g(d, ARITH(P.test _, _, _, _, e)) = g(d+1, e)
59 : mblume 1347 | g(d, ARITH(P.test_inf _, _, _, _, e)) =
60 :     error "9827489 test_inf in limit"
61 : monnier 284 | g(d, ARITH(_,_,_,_,e)) = g(d,e)
62 : monnier 245 | g(d, PURE(P.pure_arith{kind=P.FLOAT 64,...},_,_,_,e)) = g(d+3, e)
63 :     | g(d, PURE(P.real{tokind=P.FLOAT 64,...},_,_,_,e)) = g(d+3, e)
64 : monnier 284 | g(d, PURE(P.fwrap,_,_,_,e)) = g(d+4, e)
65 : monnier 245 | g(d, PURE(P.iwrap,_,_,_,e)) = g(d+2, e)
66 :     | g(d, PURE(P.i32wrap,_,_,_,e)) = g(d+2, e)
67 :     | g(d, PURE(P.newarray0,_,_,_,e)) = g(d+5, e)
68 : monnier 284 | g(d, PURE(P.makeref, _, _, _, e)) = g(d+2, e)
69 :     | g(d, PURE(P.mkspecial, _, _, _, e)) = g(d+2, e)
70 : leunga 1094 | g(d, PURE(P.rawrecord tag,[INT n],_,_,e)) =
71 :     g(d+n+(case tag of SOME _ => 1 | NONE => 0), e)
72 : mblume 1347 | g(d, PURE((P.trunc_inf _ | P.extend_inf _ | P.copy_inf _),
73 :     _, _, _, e)) =
74 :     error "23487978 *_inf in limit"
75 : monnier 245 | g(d, LOOKER(P.numsubscript{kind=P.FLOAT 64},_,_,_,e)) = g(d+3, e)
76 :     | g(d, SETTER(_,_,e)) = g(d,e)
77 :     | g(d, LOOKER(_,_,_,_,e)) = g(d,e)
78 :     | g(d, PURE(_,_,_,_,e)) = g(d,e)
79 : leunga 1174 | g(d, RCC(_,_,_,_,_,_,e)) = g(d, e)
80 : monnier 245 | g(d, BRANCH(_,_,_,a,b)) = Int.max(g(d,a), g(d,b))
81 :     | g(d, APP(LABEL w, _)) =
82 :     (case maxpath w
83 :     of {known=KNOWN, alloc=n, instrs=i} =>
84 :     if d+n > MAX_ALLOC
85 : blume 733 then (IntHashTable.insert m (w,{known=KNOWN_CHECK,
86 :     alloc=n,
87 :     instrs=i});
88 : monnier 245 d)
89 :     else d+n
90 :     | _ => d)
91 :     | g(d, APP(_, _)) = d
92 :     (* | g(d, RECORD(RK_SPILL,vl,_,e)) = g(d + (length(vl) * 4) + 1,e) *)
93 :     | g(d, FIX _) = error "8932 in limit"
94 :    
95 :     and h(d, RECORD(_,_,_,e)) = h(d+1, e)
96 :     | h(d, SELECT(_,_,_,_,e)) = h(d+1, e)
97 :     | h(d, OFFSET(_,_,_,e)) = h(d+1, e)
98 :     | h(d, SWITCH(_,_,el)) = foldr Int.max 1 (map (fn e => g(d,e)) el)
99 :     | h(d, SETTER(_,_,e)) = h(d+1, e)
100 :     | h(d, ARITH(_,_,_,_,e)) = h(d+1, e)
101 :     | h(d, PURE(_,_,_,_,e)) = h(d+1, e)
102 :     | h(d, LOOKER(_,_,_,_,e)) = h(d+1, e)
103 : leunga 1174 | h(d, RCC(_,_,_,_,_,_,e)) = h(d+1, e)
104 : monnier 245 | h(d, BRANCH(_,_,_,a,b)) = Int.max(h(d,a), h(d,b)) + 1
105 :     | h(d, APP(LABEL w, _)) =
106 :     (case maxpath w of
107 :     {known=KNOWN, alloc, instrs=i} => d+i
108 :     | _ => d)
109 :     | h(d, APP(_, _)) = d
110 :     | h(d, FIX _) = error "8932.1 in limit"
111 :    
112 :     and maxpath w = look w handle Limit' =>
113 : monnier 284 (* Note that the heap may need to be aligned so g is
114 :     * called with g(1, bod). Be conservative.
115 :     *)
116 : monnier 245 (case escapes w
117 :     of KNOWN => let val bod = body w
118 : monnier 284 val n = g(1, bod)
119 : monnier 245 val i = h(0, bod)
120 :     val z = if n>MAX_ALLOC
121 :     then {known=KNOWN_CHECK,alloc=n,instrs=i}
122 :     else {known=KNOWN,alloc=n,instrs=i}
123 : blume 733 in IntHashTable.insert m (w,z);
124 : monnier 245 z
125 :     end
126 :     | kind => let val bod = body w
127 : blume 733 val z = (IntHashTable.insert m (w,{known=kind,
128 :     alloc=0,
129 :     instrs=0});
130 : monnier 245 {known=kind,
131 : monnier 284 alloc=g(1,bod),
132 : monnier 245 instrs=h(0,bod)})
133 : blume 733 in IntHashTable.insert m (w,z); z
134 : monnier 245 end)
135 :    
136 :     val _ = app (fn (_, x, _, _, _) => (maxpath x; ())) fl;
137 :     val nfl = map (fn (fk,v,args,cl,ce) => (#known(look v),v,args,cl,ce)) fl
138 :     in (nfl, fn x => (let val f = look x in (#alloc f,#instrs f) end))
139 :     end
140 :    
141 :     fun nolimit fl =
142 :     let val {escapes, check} = findescapes fl
143 :     fun makenode (_,f,vl,_,body) =
144 :     let fun edges (RECORD(_,_,_,e)) = edges e
145 :     | edges (SELECT(_,_,_,_,e)) = edges e
146 :     | edges (OFFSET(_,_,_,e)) = edges e
147 :     | edges (SWITCH(_,_,el)) = List.concat (map edges el)
148 :     | edges (SETTER(_,_,e)) = edges e
149 :     | edges (LOOKER(_,_,_,_,e)) = edges e
150 :     | edges (ARITH(_,_,_,_,e)) = edges e
151 :     | edges (PURE(_,_,_,_,e)) = edges e
152 : leunga 1174 | edges (RCC(_,_,_,_,_,_,e)) = edges e
153 : monnier 245 | edges (BRANCH(_,_,_,a,b)) = edges a @ edges b
154 :     | edges (APP(LABEL w, _)) = (case escapes w of KNOWN => [w]
155 :     | _ => nil)
156 :     | edges (APP _) = nil
157 :     | edges (FIX _) = error "8933 in limit"
158 :     in (f, edges body)
159 :     end
160 :     in if !CGoptions.printit
161 :     then (say "Starting feedback..."; Control.Print.flush()) else ();
162 :     app check (Feedback.feedback (map makenode fl));
163 :     if !CGoptions.printit
164 :     then (say "Finished\n"; Control.Print.flush()) else ();
165 :     path escapes fl
166 :     end
167 :    
168 :     val nolimit = fn fl =>
169 :     if !CGoptions.printit
170 :     then let val info as (newfl,limits) = nolimit fl
171 :     fun showinfo (k,f,_,_,_) =
172 :     let val (alloc,instrs) = limits f
173 :     val s = Int.toString alloc
174 :     val i = Int.toString instrs
175 :     val _ = (say (LambdaVar.lvarName f); say "\t")
176 :     val _ = case k
177 :     of KNOWN => say "K "
178 :     | KNOWN_CHECK => say "H "
179 :     | ESCAPE => say "E "
180 :     | CONT => say "C "
181 :     | _ => error "nolimit 323 in limit.sml"
182 :     in (say s; say "\t"; say i; say "\n")
183 :     end
184 :    
185 :     in app showinfo newfl;
186 :     info
187 :     end
188 :     else nolimit fl
189 :    
190 :     end (* local *)
191 :     end (* structure Limit *)
192 :    

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