Project

General

Profile

Revision 8ea13d96

View differences:

src/corelang.mli
61 61
| Expr_ite   of expr * expr * expr
62 62
| Expr_arrow of expr * expr
63 63
| Expr_fby of expr * expr
64
(*
65
| Expr_struct of (label * expr) list
66
| Expr_field of expr * label
67
| Expr_update of expr * (label * expr)
68
*)
64 69
| Expr_array of expr list
65 70
| Expr_access of expr * Dimension.dim_expr (* acces(e,i) is the i-th element 
66 71
					      of array epxression e *)
src/machine_code.ml
405 405

  
406 406
let translate_decl nd =
407 407
  (*Log.report ~level:1 (fun fmt -> Printers.pp_node fmt nd);*)
408
  let nd, sch = Scheduling.schedule_node nd in
408
  let nd, sch, _ = Scheduling.schedule_node nd in
409 409
  let split_eqs = Splitting.tuple_split_eq_list nd.node_eqs in
410 410
  let eqs_rev, remainder = 
411 411
    List.fold_left 
src/scheduling.ml
24 24
(* This module is used for the lustre to C compiler *)
25 25

  
26 26
open Utils
27
open LustreSpec
27 28
open Corelang
28 29
open Graph
29 30
open Causality
......
63 64
   Modifies [pending] and [frontier] accordingly.
64 65
*)
65 66
let next_element eq_equiv g sort pending frontier =
66
  if ISet.is_empty !pending
67
  then
68
    begin
69
      let choice = ISet.min_elt !frontier in
67
  begin
68
    if ISet.is_empty !pending
69
    then
70
      begin
71
	let choice = ISet.min_elt !frontier in
70 72
      (*Format.eprintf "-1-> %s@." choice;*)
71
      frontier := ISet.remove choice !frontier;
72
      let (p, f) = ISet.partition (eq_equiv choice) !frontier in
73
      pending := p;
74
      frontier := f;
75
      add_successors eq_equiv g choice pending frontier;
76
      if not (ExprDep.is_instance_var choice) then sort := choice :: !sort;
77
    end
78
  else
79
    begin
80
      let choice = ISet.min_elt !pending in
73
	frontier := ISet.remove choice !frontier;
74
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
75
	pending := p;
76
	frontier := f;
77
	add_successors eq_equiv g choice pending frontier;
78
	if not (ExprDep.is_instance_var choice) then sort := choice :: !sort
79
      end
80
    else
81
      begin
82
	let choice = ISet.min_elt !pending in
81 83
      (*Format.eprintf "-2-> %s@." choice;*)
82
      pending := ISet.remove choice !pending;
83
      add_successors eq_equiv g choice pending frontier;
84
      if not (ExprDep.is_instance_var choice) then sort := choice :: !sort;
85
    end
84
	pending := ISet.remove choice !pending;
85
	add_successors eq_equiv g choice pending frontier;
86
	if not (ExprDep.is_instance_var choice) then sort := choice :: !sort
87
      end
88
  end
89

  
86 90

  
87 91
(* Topological sort of dependency graph [g], with priority.
88 92
 *)
......
100 104
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
101 105
      next_element eq_equiv g sorted pending frontier;
102 106
    done;
107
    IdentDepGraph.clear g;
103 108
    !sorted
104 109
  end
105 110

  
111
(* Computes the last dependency
112
*)
113

  
114
(* Computes the death table of [node] wrt dep graph [g] and topological [sort].
115
   The death table is a mapping: ident -> Set(ident) such that:
116
   death x is the set of local variables which get dead (i.e. unused) 
117
   after x is evaluated, but were until live.
118
*)
119
let death_table node g sort =
120
  let death = Hashtbl.create 23 in
121
  let sort  = ref (List.rev sort) in
122
  let buried  = ref ISet.empty in
123
  begin
124
    buried := ExprDep.node_memory_variables node;
125
    buried := List.fold_left (fun dead (v : var_decl) -> ISet.add v.var_id dead) !buried node.node_outputs;
126
    (* We could also try to reuse input variables, due to C parameter copying semantics *)
127
    buried := List.fold_left (fun dead (v : var_decl) -> ISet.add v.var_id dead) !buried node.node_inputs;
128
    while (!sort <> [])
129
    do
130
      let head = List.hd !sort in
131
      let dead = IdentDepGraph.fold_succ
132
	(fun tgt dead -> if not (ExprDep.is_instance_var tgt || ISet.mem tgt !buried) then ISet.add tgt dead else dead)
133
	g head ISet.empty in
134
      buried := ISet.union !buried dead;
135
      Hashtbl.add death head dead;
136
      sort := List.tl !sort
137
    done;
138
    IdentDepGraph.clear g;
139
    death
140
  end
141

  
142
let pp_death_table fmt death =
143
  begin
144
    Format.fprintf fmt "{ /* death table */@.";
145
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> { %a }@." s (Utils.fprintf_list ~sep:", " Format.pp_print_string) (ISet.elements t)) death;
146
    Format.fprintf fmt "}@."
147
  end
148

  
106 149
let schedule_node n  =
107 150
  try
108 151
    let eq_equiv = ExprDep.node_eq_equiv n in
......
111 154
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
112 155
      with Not_found -> false in
113 156
    let n', g = global_dependency n in
114
    n', topological_sort eq_equiv g
157
    Log.report ~level:5 (fun fmt -> Format.eprintf "dependency graph for node %s: %a" n'.node_id pp_dep_graph g);
158
    let gg = IdentDepGraph.copy g in
159
    let sort = topological_sort eq_equiv g in
160
    let death = death_table n gg sort in
161
    Log.report ~level:5 (fun fmt -> Format.eprintf "death table for node %s: %a" n'.node_id pp_death_table death);
162
    n', sort, death
115 163
(* let sorted = TopologicalDepGraph.fold (fun x res -> if ExprDep.is_instance_var x then res else x::res) g []*)
116 164
  with (Causality.Cycle v) as exc ->
117 165
    pp_error Format.err_formatter v;
test/test-compile.sh
5 5
declare c i w h a v
6 6
declare -a files
7 7

  
8
SRC_PREFIX="../.."
9
# SRC_PREFIX=`svn info --xml | grep wcroot | sed "s/<[^>]*>//g"`/lustre_compiler
8
#SRC_PREFIX="../.."
9
SRC_PREFIX=`svn info --xml | grep wcroot | sed "s/<[^>]*>//g"`/lustre_compiler
10 10
NOW=`date "+%y%m%d%H%M"`
11 11
report=`pwd`/report-$NOW
12 12
#LUSTREC="../../_build/src/lustrec"

Also available in: Unified diff