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 5199 - (view) (download)

1 : jhr 5199 (* limit.sml
2 :     *
3 :     * COPYRIGHT (c) 2019 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 :     *)
6 : monnier 245
7 :     signature LIMIT = sig
8 : jhr 4446 val nolimit : CPS.function list ->
9 : monnier 245 CPS.function list * (CPS.lvar -> (int * int))
10 :     end (* signature LIMIT *)
11 :    
12 :     structure Limit : LIMIT = struct
13 :    
14 :     local
15 :     open CPS
16 :     in
17 :    
18 :     val say = Control.Print.say
19 :     val error = ErrorMsg.impossible
20 :     structure CGoptions = Control.CG
21 :    
22 :     val MAX_ALLOC = 1023 (* maximum number of words to allocate per check *)
23 :    
24 :     fun findescapes fl =
25 :     let exception Limit
26 : blume 733 val m : fun_kind IntHashTable.hash_table = IntHashTable.mkTable(32,Limit)
27 :     val _ = app (fn (k,f,_,_,_) => IntHashTable.insert m (f,k)) fl
28 : jhr 4446 val escapes = IntHashTable.lookup m
29 : monnier 245 in {escapes = escapes,
30 : blume 733 check = fn f => case escapes f of
31 :     KNOWN => IntHashTable.insert m (f,KNOWN_CHECK)
32 :     | _ => ()}
33 : monnier 245 end
34 :    
35 :     (* path now counts instructions as well as allocations, for polling *)
36 : jhr 4446 fun path escapes fl =
37 : monnier 245 let exception Limit'
38 : blume 733 val b : cexp IntHashTable.hash_table = IntHashTable.mkTable(32,Limit')
39 :     val _ = app (IntHashTable.insert b o (fn (_,f,_,_,body) => (f,body))) fl
40 :     val body = IntHashTable.lookup b
41 : monnier 245
42 : blume 733 val m : {known: fun_kind, alloc: int, instrs: int}
43 : jhr 4446 IntHashTable.hash_table =
44 : blume 733 IntHashTable.mkTable(32,Limit')
45 :     val look = IntHashTable.lookup m
46 : monnier 245 val storeListSz = 2 (* size of store list entry *)
47 : jhr 5015 fun g(d, RECORD(RK_RAW64BLOCK,vl,_,e)) = g(d + (length(vl) * 2) + 2,e)
48 : monnier 245 | g(d, RECORD(RK_FCONT,vl,_,e)) = g(d + (length(vl) * 2) + 2,e)
49 :     | g(d, RECORD(RK_VECTOR,vl,_,e)) = g(d + length(vl) + 4, e)
50 :     | g(d, RECORD(_,vl,_,e)) = g(d+length(vl)+1, e)
51 :     | g(d, SELECT(_,_,_,_,e)) = g(d, e)
52 :     | g(d, OFFSET(_,_,_,e)) = g(d, e)
53 :     | g(d, SWITCH(_,_,el)) = foldr Int.max 0 (map (fn e => g(d,e)) el)
54 : jhr 4964 | g(d, SETTER(P.ASSIGN, _, e)) = g(d+storeListSz, e)
55 :     | g(d, SETTER(P.UPDATE,_,e)) = g(d+storeListSz, e)
56 : jhr 4446 (*** should be +0 when unboxedfloat is turned on ***)
57 : jhr 5022 | g(d, ARITH(P.IARITH _,_,_,_,e)) = g(d+1, e) (* QUESTION: why is this +1? *)
58 : jhr 4964 | g(d, ARITH(P.TESTU _, _, _, _, e)) = g(d+1, e)
59 :     | g(d, ARITH(P.TEST _, _, _, _, e)) = g(d+1, e)
60 :     | g(d, ARITH(P.TEST_INF _, _, _, _, e)) =
61 : mblume 1347 error "9827489 test_inf in limit"
62 : monnier 284 | g(d, ARITH(_,_,_,_,e)) = g(d,e)
63 : jhr 4964 | g(d, PURE(P.PURE_ARITH{kind=P.FLOAT 64,...},_,_,_,e)) = g(d+3, e)
64 : jhr 4986 | g(d, PURE(P.INT_TO_REAL{to=64,...},_,_,_,e)) = g(d+3, e)
65 : jhr 4964 | g(d, PURE(P.WRAP(P.INT sz), _, _, _, e)) =
66 : jhr 4842 if (sz = Target.mlValueSz)
67 :     then g(d + 2, e)
68 :     else if (sz <= Target.defaultIntSz)
69 :     then error "unexpected tagged int wrap"
70 :     else g(d + 2 + sz div Target.mlValueSz, e) (* include word for alignment *)
71 : jhr 4964 | g(d, PURE(P.WRAP(P.FLOAT sz), _, _, _, e)) =
72 : jhr 4842 if (sz > Target.mlValueSz)
73 :     then g(d+4, e) (* assume we need alignment word *)
74 :     else g(d+2, e)
75 : jhr 4964 | g(d, PURE(P.NEWARRAY0,_,_,_,e)) = g(d+5, e)
76 :     | g(d, PURE(P.MAKEREF, _, _, _, e)) = g(d+2, e)
77 :     | g(d, PURE(P.MKSPECIAL, _, _, _, e)) = g(d+2, e)
78 :     | g(d, PURE(P.RAWRECORD tag, [NUM{ty={tag=true, ...}, ival}],_,_,e)) =
79 : jhr 4560 g (d+(IntInf.toInt ival)+(case tag of SOME _ => 1 | NONE => 0), e)
80 : jhr 4964 | g(d, PURE((P.TRUNC_INF _ | P.EXTEND_INF _ | P.COPY_INF _), _, _, _, e)) =
81 : mblume 1347 error "23487978 *_inf in limit"
82 : jhr 4964 | g(d, LOOKER(P.NUMSUBSCRIPT{kind=P.FLOAT 64},_,_,_,e)) = g(d+3, e)
83 : monnier 245 | g(d, SETTER(_,_,e)) = g(d,e)
84 :     | g(d, LOOKER(_,_,_,_,e)) = g(d,e)
85 :     | g(d, PURE(_,_,_,_,e)) = g(d,e)
86 : mblume 1755 | g(d, RCC(_,_,_,_,_,e)) = g(d, e)
87 : monnier 245 | g(d, BRANCH(_,_,_,a,b)) = Int.max(g(d,a), g(d,b))
88 : jhr 4446 | g(d, APP(LABEL w, _)) =
89 : monnier 245 (case maxpath w
90 : jhr 4446 of {known=KNOWN, alloc=n, instrs=i} =>
91 : monnier 245 if d+n > MAX_ALLOC
92 : blume 733 then (IntHashTable.insert m (w,{known=KNOWN_CHECK,
93 :     alloc=n,
94 :     instrs=i});
95 : monnier 245 d)
96 :     else d+n
97 :     | _ => d)
98 :     | g(d, APP(_, _)) = d
99 :     | g(d, FIX _) = error "8932 in limit"
100 :    
101 :     and h(d, RECORD(_,_,_,e)) = h(d+1, e)
102 :     | h(d, SELECT(_,_,_,_,e)) = h(d+1, e)
103 :     | h(d, OFFSET(_,_,_,e)) = h(d+1, e)
104 :     | h(d, SWITCH(_,_,el)) = foldr Int.max 1 (map (fn e => g(d,e)) el)
105 :     | h(d, SETTER(_,_,e)) = h(d+1, e)
106 : jhr 4446 | h(d, ARITH(_,_,_,_,e)) = h(d+1, e)
107 :     | h(d, PURE(_,_,_,_,e)) = h(d+1, e)
108 : monnier 245 | h(d, LOOKER(_,_,_,_,e)) = h(d+1, e)
109 : mblume 1755 | h(d, RCC(_,_,_,_,_,e)) = h(d+1, e)
110 : monnier 245 | h(d, BRANCH(_,_,_,a,b)) = Int.max(h(d,a), h(d,b)) + 1
111 : jhr 4446 | h(d, APP(LABEL w, _)) =
112 :     (case maxpath w of
113 : monnier 245 {known=KNOWN, alloc, instrs=i} => d+i
114 :     | _ => d)
115 :     | h(d, APP(_, _)) = d
116 :     | h(d, FIX _) = error "8932.1 in limit"
117 :    
118 :     and maxpath w = look w handle Limit' =>
119 : monnier 284 (* Note that the heap may need to be aligned so g is
120 :     * called with g(1, bod). Be conservative.
121 :     *)
122 : monnier 245 (case escapes w
123 :     of KNOWN => let val bod = body w
124 : monnier 284 val n = g(1, bod)
125 : monnier 245 val i = h(0, bod)
126 :     val z = if n>MAX_ALLOC
127 :     then {known=KNOWN_CHECK,alloc=n,instrs=i}
128 :     else {known=KNOWN,alloc=n,instrs=i}
129 : blume 733 in IntHashTable.insert m (w,z);
130 : monnier 245 z
131 :     end
132 :     | kind => let val bod = body w
133 : blume 733 val z = (IntHashTable.insert m (w,{known=kind,
134 :     alloc=0,
135 :     instrs=0});
136 : monnier 245 {known=kind,
137 : monnier 284 alloc=g(1,bod),
138 : monnier 245 instrs=h(0,bod)})
139 : blume 733 in IntHashTable.insert m (w,z); z
140 : monnier 245 end)
141 :    
142 :     val _ = app (fn (_, x, _, _, _) => (maxpath x; ())) fl;
143 :     val nfl = map (fn (fk,v,args,cl,ce) => (#known(look v),v,args,cl,ce)) fl
144 :     in (nfl, fn x => (let val f = look x in (#alloc f,#instrs f) end))
145 :     end
146 : jhr 4446
147 : monnier 245 fun nolimit fl =
148 :     let val {escapes, check} = findescapes fl
149 :     fun makenode (_,f,vl,_,body) =
150 :     let fun edges (RECORD(_,_,_,e)) = edges e
151 :     | edges (SELECT(_,_,_,_,e)) = edges e
152 :     | edges (OFFSET(_,_,_,e)) = edges e
153 :     | edges (SWITCH(_,_,el)) = List.concat (map edges el)
154 :     | edges (SETTER(_,_,e)) = edges e
155 :     | edges (LOOKER(_,_,_,_,e)) = edges e
156 :     | edges (ARITH(_,_,_,_,e)) = edges e
157 :     | edges (PURE(_,_,_,_,e)) = edges e
158 : mblume 1755 | edges (RCC(_,_,_,_,_,e)) = edges e
159 : monnier 245 | edges (BRANCH(_,_,_,a,b)) = edges a @ edges b
160 : jhr 4446 | edges (APP(LABEL w, _)) = (case escapes w of KNOWN => [w]
161 : monnier 245 | _ => nil)
162 :     | edges (APP _) = nil
163 :     | edges (FIX _) = error "8933 in limit"
164 :     in (f, edges body)
165 :     end
166 :     in if !CGoptions.printit
167 :     then (say "Starting feedback..."; Control.Print.flush()) else ();
168 :     app check (Feedback.feedback (map makenode fl));
169 :     if !CGoptions.printit
170 :     then (say "Finished\n"; Control.Print.flush()) else ();
171 :     path escapes fl
172 :     end
173 :    
174 :     val nolimit = fn fl =>
175 :     if !CGoptions.printit
176 :     then let val info as (newfl,limits) = nolimit fl
177 : jhr 4446 fun showinfo (k,f,_,_,_) =
178 : monnier 245 let val (alloc,instrs) = limits f
179 :     val s = Int.toString alloc
180 :     val i = Int.toString instrs
181 :     val _ = (say (LambdaVar.lvarName f); say "\t")
182 :     val _ = case k
183 :     of KNOWN => say "K "
184 :     | KNOWN_CHECK => say "H "
185 :     | ESCAPE => say "E "
186 :     | CONT => say "C "
187 :     | _ => error "nolimit 323 in limit.sml"
188 :     in (say s; say "\t"; say i; say "\n")
189 :     end
190 :    
191 :     in app showinfo newfl;
192 :     info
193 :     end
194 :     else nolimit fl
195 :    
196 :     end (* local *)
197 :     end (* structure Limit *)

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