Project

General

Profile

Revision 45c13277 src/liveness.ml

View differences:

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

  
18
(* Computes the last dependency
19
*)
20

  
21
(* Computes the death table of [node] wrt dep graph [g] and topological [sort].
22
   The death table is a mapping: ident -> Set(ident) such that:
23
   death x is the set of local variables which get dead (i.e. unused) 
24
   after x is evaluated, but were until live.
25
let death_table node g sort =
26
  let death = Hashtbl.create 23 in
27
  let sort  = ref (List.rev sort) in
28
  let buried  = ref ISet.empty in
29
  begin
30
    buried := ExprDep.node_memory_variables node;
31
    buried := List.fold_left (fun dead (v : var_decl) -> ISet.add v.var_id dead) !buried node.node_outputs;
32
    (* We could also try to reuse input variables, due to C parameter copying semantics *)
33
    buried := List.fold_left (fun dead (v : var_decl) -> ISet.add v.var_id dead) !buried node.node_inputs;
34
    while (!sort <> [])
35
    do
36
      let head = List.hd !sort in
37
      let dead = IdentDepGraph.fold_succ
38
	(fun tgt dead -> if not (ExprDep.is_instance_var tgt || ISet.mem tgt !buried) then ISet.add tgt dead else dead)
39
	g head ISet.empty in
40
      buried := ISet.union !buried dead;
41
      Hashtbl.add death head dead;
42
      sort := List.tl !sort
43
    done;
44
    IdentDepGraph.clear g;
45
    death
46
  end
47
*)
48

  
49 18
(* computes the in-degree for each local variable of node [n], according to dep graph [g].
50 19
*)
51 20
let compute_fanin n g =
......
88 57
    (ISet.union outputs mems)
89 58
    (ISet.union inputs mems)
90 59

  
60
(* checks whether a variable is aliasable,
61
   depending on its (address) type *)
62
let is_aliasable var =
63
 Types.is_address_type var.var_type
64

  
91 65
(* computes the set of potentially reusable variables.
92 66
   We don't reuse input variables, due to possible aliasing *)
93 67
let node_reusable_variables node =
......
100 74

  
101 75
(* Recursively removes useless variables,
102 76
   i.e. variables that are current roots of the dep graph [g]
103
   and returns [locals] and [evaluated] such roots *)
77
   and returns [locals] and [evaluated] such roots
78
   - [locals] is the set of potentially reusable variables
79
   - [evaluated] is the set of already evaluated variables,
80
     wrt the scheduling
81
*)
104 82
let remove_local_roots locals evaluated g =
105 83
  let rem = ref true in
106 84
  let roots = ref Disjunction.CISet.empty in
......
117 95
      end
118 96
  done;
119 97
  !roots
120

  
121
(* checks whether a variable is aliasable,
122
   depending on its (address) type *)
123
let is_aliasable var =
124
 Types.is_address_type var.var_type
125 98
 
126 99
(* checks whether a variable [v] is an input of the [var] equation, with an address type.
127 100
   if so, [var] could not safely reuse/alias [v], should [v] be dead in the caller node,
......
132 105
    match NodeDep.get_callee eq_var.eq_rhs with
133 106
    | None           -> []
134 107
    | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in
135
  fun v -> Types.is_address_type v.var_type && List.mem v.var_id inputs_var
108
  fun v -> is_aliasable v && List.mem v.var_id inputs_var
136 109

  
137
(* merges two variables [v] and [v'] of graph [g].
138
   [v] is replaced by [v']
110
(* replace variable [v] by [v'] in graph [g].
111
   [v'] is a dead variable
139 112
*)
140
let merge_in_dep_graph v v' g =
113
let replace_in_dep_graph v v' g =
141 114
  begin
142 115
    IdentDepGraph.add_vertex g v';
143 116
    IdentDepGraph.iter_succ (fun s -> IdentDepGraph.add_edge g v' s) g v;
......
145 118
    IdentDepGraph.remove_vertex g v
146 119
  end
147 120

  
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
let pp_reuse_policy fmt policy =
131
  begin
132
    Format.fprintf fmt "{ /* reuse policy */@.";
133
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t.var_id) policy;
134
    Format.fprintf fmt "}@."
135
  end
136

  
137
let pp_context fmt ctx =
138
  begin
139
    Format.fprintf fmt "{ /*BEGIN context */@.";
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;
143
    Format.fprintf fmt "disjoint=%a;@." Disjunction.pp_disjoint_map ctx.disjoint;
144
    Format.fprintf fmt "policy=%a;@." pp_reuse_policy ctx.policy;
145
    Format.fprintf fmt "/* END context */ }@.";
146
  end
147

  
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

  
148 166
(* computes the reusable dependencies of variable [var] in graph [g],
149 167
   once [var] has been evaluated
150
   [dead] is the set of evaluated and dead variables
151
   [eval] is the set of evaluated variables
168
   - [locals] is the set of potentially reusable variables
169
   - [evaluated] is the set of evaluated variables
170
   - [quasi] is the set of quasi-reusable variables
171
   - [reusable] is the set of dead/reusable dependencies of [var] in graph [g]
172
   - [policy] is the reuse map (which domain is [evaluated])
152 173
*)
153
let compute_reusable_dependencies locals evaluated reusable var g =
174
let compute_dependencies locals heads ctx g =
175
  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;
180
  end
181

  
182
let compute_evaluated heads ctx =
154 183
  begin
155
    Log.report ~level:2 (fun fmt -> Format.fprintf fmt "compute_reusable_dependencies %a %a %a %a %a@." Disjunction.pp_ciset locals Disjunction.pp_ciset !evaluated Disjunction.pp_ciset !reusable Printers.pp_var_name var pp_dep_graph g);
156
    evaluated := Disjunction.CISet.add var !evaluated;
157
    IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g var.var_id) g var.var_id;
158
    reusable := Disjunction.CISet.union (remove_local_roots locals !evaluated g) !reusable;
184
    List.iter (fun head -> ctx.evaluated <- Disjunction.CISet.add head ctx.evaluated) heads;
159 185
  end
160 186

  
187
let compute_reuse node var ctx g =
188
  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
190
  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
195
    begin
196
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
197
      Hashtbl.add ctx.policy var.var_id reuse;
198
    end
199
  with Not_found ->
200
  try
201
    let reuse = Hashtbl.find ctx.policy (Disjunction.CISet.choose (Disjunction.CISet.filter (fun v -> eligible v) ctx.reusable)).var_id in
202
    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;
208
    end
209
      with Not_found ->
210
    begin
211
      ctx.evaluated <- Disjunction.CISet.add var ctx.evaluated;
212
      Hashtbl.add ctx.policy var.var_id var;
213
    end
214

  
161 215
let compute_reuse_policy node schedule disjoint g =
162 216
  let locals = node_reusable_variables node in
163 217
  let sort = ref schedule in
164
  let evaluated = ref Disjunction.CISet.empty in
165
  let reusable = ref Disjunction.CISet.empty in
166
  let policy = Hashtbl.create 23 in
218
  let ctx = { evaluated = Disjunction.CISet.empty;
219
	      quasi     = Disjunction.CISet.empty;
220
	      reusable  = Disjunction.CISet.empty;
221
	      disjoint  = disjoint;
222
	      policy    = Hashtbl.create 23; } in
167 223
  while !sort <> []
168 224
  do
169
    let head = get_node_var (List.hd !sort) node in
170
    compute_reusable_dependencies locals evaluated reusable head g;
171
    let aliasable = is_aliasable_input node head.var_id in
172
    let eligible v = Typing.eq_ground head.var_type v.var_type && not (aliasable v) in
173
    let reuse =
174
      try
175
	let disj = Hashtbl.find disjoint head.var_id in
176
	Disjunction.CISet.max_elt (Disjunction.CISet.filter (fun v -> (eligible v) && (Disjunction.CISet.mem v !evaluated) && not (Disjunction.CISet.mem v !reusable)) disj)
177
      with Not_found ->
178
      try
179
	Disjunction.CISet.choose (Disjunction.CISet.filter (fun v -> eligible v) !reusable)
180
      with Not_found -> head in
181
    reusable := Disjunction.CISet.remove reuse !reusable;
182
    Disjunction.replace_in_disjoint_map disjoint head reuse;
183
    merge_in_dep_graph head.var_id reuse.var_id g;
184
    Hashtbl.add policy head.var_id reuse;
185
    Log.report ~level:2 (fun fmt -> Format.fprintf fmt "reuse %s instead of %s@." reuse.var_id head.var_id);
186
    Log.report ~level:1 (fun fmt -> Format.fprintf fmt "new disjoint:%a@." Disjunction.pp_disjoint_map disjoint);
187
    Log.report ~level:2 
225
    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
    let heads = List.map (fun v -> get_node_var v node) (List.hd !sort) in
229
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "NEW HEADS:");
230
    List.iter (fun head -> Log.report ~level:2 (fun fmt -> Format.fprintf fmt "%s " head.var_id)) heads;
231
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "@.");
232
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_DEPENDENCIES@.");
233
    compute_dependencies locals heads ctx g;
234
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new context:%a@." pp_context ctx);
235
    Log.report ~level:6 
188 236
      (fun fmt -> Format.fprintf fmt "new dependency graph:%a@." pp_dep_graph g);
237
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "COMPUTE_REUSE@.");
238
    List.iter (fun head -> compute_reuse node head ctx g) heads;
239
    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;
189 240
    sort := List.tl !sort;
190 241
  done;
191 242
  IdentDepGraph.clear g;
192
  policy
243
  ctx.policy
193 244

  
194 245
(* Reuse policy:
195 246
   - could reuse variables with the same type exactly only (simple).
......
221 272
    - not aliasable (i.e. address type)
222 273
*)
223 274

  
224
let pp_reuse_policy fmt policy =
225
  begin
226
    Format.fprintf fmt "{ /* reuse policy */@.";
227
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t.var_id) policy;
228
    Format.fprintf fmt "}@."
229
  end
230 275
(* Local Variables: *)
231 276
(* compile-command:"make -C .." *)
232 277
(* End: *)

Also available in: Unified diff