Project

General

Profile

Revision 7cd31331

View differences:

src/liveness.ml
164 164
     - either dirty castings
165 165
     - or complex inclusion expression (for instance: array <-> array cell, struct <-> struct field) to be able to reuse only some parts of structured data.
166 166
     ... it seems too complex and potentially unsafe
167
   - for node instance calls: output variables could NOT reuse input variables, 
167
   - for node instance calls: output variables could NOT reuse aliasable input variables, 
168 168
     even if inputs become dead, because the correctness would depend on the scheduling
169 169
     of the callee (so, the compiling strategy could NOT be modular anymore).
170 170
   - once a policy is set, we need to:
......
182 182

  
183 183
(* Replaces [v] by [v'] in death table [death] *)
184 184
let replace_in_death_table death v v' =
185
 Hashtbl.iter (fun k dead -> Hashtbl.replace death k (replace_in_set dead v v')) death
185
  begin
186
    Hashtbl.remove death v;
187
    Hashtbl.iter (fun k dead -> Hashtbl.replace death k (replace_in_set dead v v')) death
188
  end
189

  
190
let reuse_by_disjoint var reuse death disjoint =
191
  begin
192
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "reuse %s by disjoint %s@." var reuse.var_id);
193
    Disjunction.replace_in_disjoint_map disjoint var reuse.var_id;
194
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new disjoint:%a@." Disjunction.pp_disjoint_map disjoint);
195
  end
186 196

  
187
let find_compatible_local node var dead death disjoint policy =
197

  
198
let reuse_by_dead var reuse death disjoint =
199
  begin
200
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "reuse %s by dead %s@." var reuse.var_id);
201
    replace_in_death_table death var reuse.var_id;
202
    Log.report ~level:6 (fun fmt -> Format.fprintf fmt "new death:%a@." pp_death_table death);
203
  end
204

  
205
(* the set of really dead variables is a subset of dead vars by the death table.
206
   indeed, as variables may be aliased to other variables,
207
   a variable is dead only if all its disjoint-from-evaluated-var aliases are dead *)
208
let dead_aliased_variables var reuse dead =
209
 dead
210

  
211
let find_compatible_local node var dead death disjoint =
188 212
 (*Format.eprintf "find_compatible_local %s %s %a@." node.node_id var pp_iset dead;*)
189 213
  let typ = (get_node_var var node).var_type in
190 214
  let eq_var = get_node_eq var node in
......
202 226
      (*Format.eprintf "filter %a = %s@." Printers.pp_var_name v (if res then "true" else "false");*)
203 227
      res
204 228
    end in
205
(*Format.eprintf "reuse %s@." var;*)
229
Log.report ~level:6 (fun fmt -> Format.fprintf fmt "reuse %s@." var);
206 230
  try
207 231
    let disj = Hashtbl.find disjoint var in
208 232
    let reuse = List.find (filter (fun v -> ISet.mem v.var_id disj && not (ISet.mem v.var_id dead))) locals in
209
(*Format.eprintf "reuse %s by %s@." var reuse.var_id;*)
210
    Disjunction.replace_in_disjoint_map disjoint var reuse.var_id;
211
(*Format.eprintf "new disjoint:%a@." Disjunction.pp_disjoint_map disjoint;*)
212
    Hashtbl.add policy var reuse.var_id
233
    reuse_by_disjoint var reuse death disjoint;
234
    Some reuse
213 235
  with Not_found ->
214 236
  try
215 237
    let reuse = List.find (filter (fun v -> ISet.mem v.var_id dead)) locals in
216
(*Format.eprintf "reuse %s by %s@." var reuse.var_id;*)
217
    replace_in_death_table death var reuse.var_id;
218
(*Format.eprintf "new death:%a@." pp_death_table death;*)
219
    Hashtbl.add policy var reuse.var_id
220
  with Not_found -> ()
238
    reuse_by_dead var reuse death disjoint;
239
    Some reuse
240
  with Not_found -> None
221 241

  
222 242
(* the reuse policy seeks to use less local variables
223 243
   by replacing local variables, applying the rules
......
231 251
*)
232 252
let reuse_policy node sort death disjoint =
233 253
  let dead = ref ISet.empty in
254
  let real_dead = ref ISet.empty in
234 255
  let policy = Hashtbl.create 23 in
235
  let sort = ref sort in
256
  let sort = ref [] (*sort*) in
257
  let aux_vars = ExprDep.node_auxiliary_variables node in
236 258
  while !sort <> []
237 259
  do
238 260
    let head = List.hd !sort in
239
    if Hashtbl.mem death head then
261
    if ISet.mem head aux_vars then
240 262
      begin
241
	dead := ISet.union (Hashtbl.find death head) !dead;
242
      end;
243
    find_compatible_local node head !dead death disjoint policy;
244
    sort := List.tl !sort;
263
	if Hashtbl.mem death head then
264
	  begin
265
	    dead := ISet.union (Hashtbl.find death head) !dead;
266
	  end;
267
	real_dead := ISet.empty;
268
	(match find_compatible_local node head !real_dead death disjoint with
269
	| Some reuse -> Hashtbl.add policy head reuse
270
	| None -> ());
271
	sort := List.tl !sort;
272
      end
245 273
  done;
246 274
  policy
247 275
 
248 276
let pp_reuse_policy fmt policy =
249 277
  begin
250 278
    Format.fprintf fmt "{ /* reuse policy */@.";
251
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t) policy;
279
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t.var_id) policy;
252 280
    Format.fprintf fmt "}@."
253 281
  end
254 282
(* Local Variables: *)
src/machine_code.ml
524 524
and instrs_are_skip instrs =
525 525
  List.for_all instr_is_skip instrs
526 526

  
527
let instr_cons instr cont =
528
 if instr_is_skip instr then cont else instr::cont
529

  
527 530
let rec instr_remove_skip instr cont =
528 531
  match instr with
529 532
  | MLocalAssign (i, LocalVar v) when i = v -> cont
......
544 547
  | Access (t, i) -> Access(value_replace_var fvar t, i)
545 548
  | Power (v, n) -> Power(value_replace_var fvar v, n)
546 549

  
547
let rec instr_replace_var fvar instr =
550
let rec instr_replace_var fvar instr cont =
548 551
  match instr with
549
  | MLocalAssign (i, v) -> MLocalAssign (fvar i, value_replace_var fvar v)
550
  | MStateAssign (i, v) -> MStateAssign (i, value_replace_var fvar v)
551
  | MReset i            -> instr
552
  | MStep (il, i, vl)   -> MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)
553
  | MBranch (g, hl)     -> MBranch (value_replace_var fvar g, List.map (fun (h, il) -> (h, instrs_replace_var fvar il)) hl)
552
  | MLocalAssign (i, v) -> instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont
553
  | MStateAssign (i, v) -> instr_cons (MStateAssign (i, value_replace_var fvar v)) cont
554
  | MReset i            -> instr_cons instr cont
555
  | MStep (il, i, vl)   -> instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont
556
  | MBranch (g, hl)     -> instr_cons (MBranch (value_replace_var fvar g, List.map (fun (h, il) -> (h, instrs_replace_var fvar il [])) hl)) cont
554 557

  
555
and instrs_replace_var fvar instrs =
556
  List.map (instr_replace_var fvar) instrs
558
and instrs_replace_var fvar instrs cont =
559
  List.fold_right (instr_replace_var fvar) instrs cont
557 560

  
558 561
let step_replace_var fvar step =
559 562
  { step with
560 563
    step_checks = List.map (fun (l, v) -> (l, value_replace_var fvar v)) step.step_checks;
561 564
    step_locals = Utils.remove_duplicates (List.map fvar step.step_locals);
562
    step_instrs = instrs_replace_var fvar step.step_instrs;
565
    step_instrs = instrs_replace_var fvar step.step_instrs [];
563 566
}
564 567

  
565 568
let rec machine_replace_var fvar m =
......
568 571
  }
569 572

  
570 573
let machine_reuse_var m reuse =
571
  let reuse_vdecl = Hashtbl.create 23 in
572
  begin
573
    Hashtbl.iter (fun v v' -> Hashtbl.add reuse_vdecl (get_node_var v m.mname) (get_node_var v' m.mname)) reuse;
574
    let fvar v =
575
      try
576
	Hashtbl.find reuse_vdecl v
577
      with Not_found -> v in
578
    machine_replace_var fvar m
579
  end
574
  let fvar v =
575
    try
576
      Hashtbl.find reuse v.var_id
577
    with Not_found -> v in
578
  machine_replace_var fvar m
580 579

  
581 580
let prog_reuse_var prog node_schs =
582 581
  List.map 
src/main_lustre_compiler.ml
292 292
  (* DFS with modular code generation *)
293 293
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines generation@,");
294 294
  let machine_code = Machine_code.translate_prog prog node_schs in
295
 (* experimental
296
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization@,");
297
  let machine_code = Machine_code.prog_reuse_var machine_code node_schs in
298
  *)
295 299
  Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@,"
296 300
    (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine)
297 301
    machine_code);
298 302

  
299
  (* experimental
300
  let machine_code = Machine_code.prog_reuse_var machine_code node_schs in
301
  *)
303
 
302 304
  (* Optimize machine code *)
303 305
  let machine_code = 
304 306
    if !Options.optimization >= 2 then
src/parser_lustre.mly
332 332
{ [] }
333 333
| ASSUMES qexpr SCOL assumes { $2::$4 } 
334 334

  
335
/* WARNING: UNUSED RULES */
335 336
tuple_qexpr:
336 337
| qexpr COMMA qexpr {[$3;$1]}
337 338
| tuple_qexpr COMMA qexpr {$3::$1}
src/scheduling.ml
38 38
  (* the table mapping each local var to its in-degree *)
39 39
  fanin_table : (ident, int) Hashtbl.t;
40 40
  (* the table mapping each assignment to a reusable variable *)
41
  reuse_table : (ident, ident) Hashtbl.t
41
  reuse_table : (ident, var_decl) Hashtbl.t
42 42
}
43 43

  
44 44
(* Topological sort with a priority for variables belonging in the same equation lhs.

Also available in: Unified diff