Project

General

Profile

Revision b13a7d5f

View differences:

src/liveness.ml
15 15
open Graph
16 16
open Causality
17 17

  
18
type context =
19
{
20
  mutable evaluated : Disjunction.CISet.t;
21
  dep_graph : IdentDepGraph.t;
22
  disjoint : (ident, Disjunction.CISet.t) Hashtbl.t;
23
  policy : (ident, var_decl) Hashtbl.t;
24
}
25

  
18 26
(* computes the in-degree for each local variable of node [n], according to dep graph [g].
19 27
*)
20 28
let compute_fanin n g =
......
72 80
    Disjunction.CISet.empty
73 81
    node.node_locals
74 82

  
83
let kill_root ctx head =
84
  IdentDepGraph.iter_succ (IdentDepGraph.remove_edge ctx.dep_graph head.var_id) ctx.dep_graph head.var_id
85

  
75 86
(* Recursively removes useless variables,
76
   i.e. variables that are current roots of the dep graph [g]
77
   and returns [locals] and [evaluated] such roots
78
   - [locals] is the set of potentially reusable variables
87
   i.e. [ctx.evaluated] variables that are current roots of the dep graph [ctx.dep_graph]
79 88
   - [evaluated] is the set of already evaluated variables,
80 89
     wrt the scheduling
90
   - does only remove edges, not variables themselves
81 91
*)
82
let remove_local_roots locals evaluated g =
92
let remove_roots ctx =
83 93
  let rem = ref true in
84
  let roots = ref Disjunction.CISet.empty in
94
  let remaining = ref ctx.evaluated in
85 95
  while !rem
86 96
  do
87 97
    rem := false;
88
    let new_roots = graph_roots g in
89
    let reusable_roots = Disjunction.CISet.filter (fun v -> (List.mem v.var_id new_roots) && (Disjunction.CISet.mem v locals)) evaluated in
90
    if not (Disjunction.CISet.is_empty reusable_roots) then
98
    let all_roots = graph_roots ctx.dep_graph in
99
    let frontier_roots = Disjunction.CISet.filter (fun v -> List.mem v.var_id all_roots) !remaining in
100
    if not (Disjunction.CISet.is_empty frontier_roots) then
91 101
      begin
92 102
	rem := true;
93
	Disjunction.CISet.iter (fun v -> IdentDepGraph.remove_vertex g v.var_id) reusable_roots;
94
	roots := Disjunction.CISet.union reusable_roots !roots
103
	Disjunction.CISet.iter (kill_root ctx) frontier_roots;
104
	remaining := Disjunction.CISet.diff !remaining frontier_roots
95 105
      end
96
  done;
97
  !roots
106
  done
98 107
 
99 108
(* checks whether a variable [v] is an input of the [var] equation, with an address type.
100 109
   if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node,
......
118 127
    IdentDepGraph.remove_vertex g v
119 128
  end
120 129

  
121
type context =
122
{
123
  mutable evaluated : Disjunction.CISet.t;
124
  mutable quasi : Disjunction.CISet.t;
125
  mutable reusable : Disjunction.CISet.t;
126
  disjoint : (ident, Disjunction.CISet.t) Hashtbl.t;
127
  policy : (ident, var_decl) Hashtbl.t;
128
}
129

  
130 130
let pp_reuse_policy fmt policy =
131 131
  begin
132 132
    Format.fprintf fmt "{ /* reuse policy */@.";
......
138 138
  begin
139 139
    Format.fprintf fmt "{ /*BEGIN context */@.";
140 140
    Format.fprintf fmt "eval=%a;@." Disjunction.pp_ciset ctx.evaluated;
141
    Format.fprintf fmt "quasi=%a;@." Disjunction.pp_ciset ctx.quasi;
142
    Format.fprintf fmt "reusable=%a;@." Disjunction.pp_ciset ctx.reusable;
141
    Format.fprintf fmt "graph=%a;@." pp_dep_graph ctx.dep_graph;
143 142
    Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint;
144 143
    Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy;
145 144
    Format.fprintf fmt "/* END context */ }@.";
146 145
  end
147 146

  
148
let is_reusable_quasi var ctx q =
149
  (*Log.report ~level:6 (fun fmt -> Format.fprintf fmt "is_reusable_quasi@ var=%s %a q=%s@." var.var_id pp_context ctx q.var_id);*)
150
  let disjoint = Hashtbl.find ctx.disjoint var.var_id in
151
  let q = Hashtbl.find ctx.policy q.var_id in
152
  Disjunction.CISet.for_all
153
    (fun v -> (Hashtbl.find ctx.policy v.var_id = q) <= (Disjunction.CISet.mem v disjoint || Disjunction.CISet.mem v ctx.quasi))
154
    ctx.evaluated
155

  
156
let compute_reusable heads var ctx =
157
  let (reusable', quasi') = Disjunction.CISet.partition (fun q -> (not (List.mem q heads)) && is_reusable_quasi var ctx q) ctx.quasi
158
  in
159
  begin
160
    ctx.quasi <- quasi';
161
    ctx.reusable <- Disjunction.CISet.fold (fun r' -> Disjunction.CISet.add (Hashtbl.find ctx.policy r'.var_id)) reusable' ctx.reusable;
162
    ctx.quasi <- Disjunction.CISet.diff ctx.quasi reusable';
163
    ctx.evaluated <- Disjunction.CISet.diff ctx.evaluated reusable';
164
  end
165

  
166 147
(* computes the reusable dependencies of variable [var] in graph [g],
167 148
   once [var] has been evaluated
168 149
   - [locals] is the set of potentially reusable variables
......
171 152
   - [reusable] is the set of dead/reusable dependencies of [var] in graph [g]
172 153
   - [policy] is the reuse map (which domain is [evaluated])
173 154
*)
174
let compute_dependencies locals heads ctx g =
155
let compute_dependencies heads ctx =
175 156
  begin
176
    (*Log.report ~level:6 (fun fmt -> Format.fprintf fmt "compute_reusable_dependencies %a %a %a %a@." Disjunction.pp_ciset locals Printers.pp_var_name var pp_context ctx pp_dep_graph g);*)
177
    List.iter (fun head -> IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g head.var_id) g head.var_id) heads;
178
    ctx.quasi <- Disjunction.CISet.union (remove_local_roots locals ctx.evaluated g) ctx.quasi;
179
    List.iter (fun head -> compute_reusable heads head ctx) heads;
157
    (*Log.report ~level:6 (fun fmt -> Format.fprintf fmt "compute_reusable_dependencies %a %a %a@." Disjunction.pp_ciset locals Printers.pp_var_name var pp_context ctx);*)
158
    List.iter (kill_root ctx) heads;
159
    remove_roots ctx;
180 160
  end
181 161

  
182 162
let compute_evaluated heads ctx =
......
184 164
    List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads;
185 165
  end
186 166

  
187
let compute_reuse node var ctx g =
167
let compute_reuse node ctx var =
188 168
  let aliasable = is_aliasable_input node var.var_id in
189
  let eligible v = Typing.eq_ground var.var_type v.var_type && not (aliasable v) in
169
  let disjoint = Hashtbl.find ctx.disjoint var.var_id in
170
  let eligible v =
171
       Typing.eq_ground var.var_type v.var_type
172
    && not (aliasable v) in
173
  let locally_reusable v =
174
    IdentDepGraph.fold_pred (fun p r -> r && Disjunction.CISet.exists (fun d -> p = d.var_id) disjoint) ctx.dep_graph v.var_id true in
175
  let eligibles = Disjunction.CISet.filter eligible ctx.evaluated in
176
  let dead, live = Disjunction.CISet.partition locally_reusable eligibles in
190 177
  try
191
    let disj = Hashtbl.find ctx.disjoint var.var_id in
192
    let reuse =
193
      Hashtbl.find ctx.policy
194
	(Disjunction.CISet.max_elt (Disjunction.CISet.filter (fun v -> (eligible v) && (Disjunction.CISet.mem v ctx.evaluated) && not (Disjunction.CISet.mem v ctx.reusable)) disj)).var_id in
178
    let disjoint_live = Disjunction.CISet.inter disjoint live in
179
    let reuse = Disjunction.CISet.max_elt disjoint_live in
195 180
    begin
196
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
197
      Hashtbl.add ctx.policy var.var_id reuse;
181
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
182
      Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);
198 183
    end
199 184
  with Not_found ->
200 185
  try
201
    let reuse = Hashtbl.find ctx.policy (Disjunction.CISet.choose (Disjunction.CISet.filter (fun v -> eligible v) ctx.reusable)).var_id in
186
    let reuse = Disjunction.CISet.choose dead in
202 187
    begin
203
      replace_in_dep_graph var.var_id reuse.var_id g;
204
      Disjunction.replace_in_disjoint_map ctx.disjoint var reuse;
205
      ctx.evaluated <- Disjunction.CISet.add reuse ctx.evaluated;
206
      ctx.reusable <- Disjunction.CISet.remove reuse ctx.reusable;
207
      Hashtbl.add ctx.policy var.var_id reuse;
188
      IdentDepGraph.add_edge ctx.dep_graph var.var_id reuse.var_id;
189
      Hashtbl.add ctx.policy var.var_id (Hashtbl.find ctx.policy reuse.var_id);
208 190
    end
209 191
      with Not_found ->
210 192
    begin
211
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
212 193
      Hashtbl.add ctx.policy var.var_id var;
213 194
    end
214 195

  
215 196
let compute_reuse_policy node schedule disjoint g =
216
  let locals = node_reusable_variables node in
217 197
  let sort = ref schedule in
218 198
  let ctx = { evaluated = Disjunction.CISet.empty;
219
	      quasi     = Disjunction.CISet.empty;
220
	      reusable  = Disjunction.CISet.empty;
199
	      dep_graph = g;
221 200
	      disjoint  = disjoint;
222 201
	      policy    = Hashtbl.create 23; } in
223 202
  while !sort <> []
224 203
  do
225 204
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
226
    Log.report ~level:6 
227
      (fun fmt -> Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g);
228 205
    let heads = List.map (fun v -> get_node_var v node) (List.hd !sort) in
229 206
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "NEW HEADS:");
230 207
    List.iter (fun head -> Log.report ~level:2 (fun fmt -> Format.fprintf fmt "%s " head.var_id)) heads;
231 208
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "@.");
232 209
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_DEPENDENCIES@.");
233
    compute_dependencies locals heads ctx g;
210
    compute_dependencies heads ctx;
234 211
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
235
    Log.report ~level:6 
236
      (fun fmt -> Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g);
237 212
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_REUSE@.");
238
    List.iter (fun head -> compute_reuse node head ctx g) heads;
213
    List.iter (compute_reuse node ctx) heads;
214
    compute_evaluated heads ctx;
239 215
    List.iter (fun head -> Log.report ~level:6 (fun fmt -> Format.fprintf fmt "reuse %s instead of %s@." (Hashtbl.find ctx.policy head.var_id).var_id head.var_id)) heads;
240 216
    sort := List.tl !sort;
241 217
  done;
242
  IdentDepGraph.clear g;
218
  IdentDepGraph.clear ctx.dep_graph;
243 219
  ctx.policy
244 220

  
245 221
(* Reuse policy:
......
257 233
        x = x;                     --> ;           for scalar vars
258 234
       or:
259 235
        x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t;   for struct vars
260
     - such simplifications are, until now, only expressible at the C source level...
261 236
 *)
262 237

  
263 238

  

Also available in: Unified diff