Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 25320f03

History | View | Annotate | Download (10.1 KB)

1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
open Utils
13
open Lustre_types
14
open Corelang
15
open Graph
16
open Causality
17
open Scheduling_type
18

    
19
(* Topological sort with a priority for variables belonging in the same equation lhs.
20
   For variables still unrelated, standard compare is used to choose the minimal element.
21
   This priority is used since it helps a lot in factorizing generated code.
22
   Moreover, the dependency graph is browsed in a depth-first manner whenever possible,
23
   to improve the behavior of optimization algorithms applied in forthcoming compilation steps. 
24
   In the following functions:
25
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
26
   - [g] the (imperative) graph to be topologically sorted
27
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
28
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
29
   - [sort] is the resulting topological order
30
*)
31

    
32
(* Checks whether the currently scheduled variable [choice]
33
   is an output of a call, possibly among others *)
34
let is_call_output choice g =
35
 List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice)
36

    
37
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
38
   then removes [v] from [g] 
39
*)
40
let add_successors eq_equiv g v pending frontier =
41
  let succs_v = IdentDepGraph.succ g v in
42
  begin
43
    IdentDepGraph.remove_vertex g v;
44
    List.iter 
45
      (fun v' -> 
46
	if is_graph_root v' g then 
47
	  (if eq_equiv v v' then 
48
	      pending := ISet.add v' !pending 
49
	   else
50
	      frontier := ISet.add v' !frontier)
51
      ) succs_v;
52
  end
53

    
54
(* Chooses the next var to be sorted, taking priority into account.
55
   Modifies [pending] and [frontier] accordingly.
56
*)
57
let next_element eq_equiv g sort call pending frontier =
58
  begin
59
    if ISet.is_empty !pending
60
    then
61
      begin
62
	let choice = ISet.min_elt !frontier in
63
      (*Format.eprintf "-1-> %s@." choice;*)
64
	frontier := ISet.remove choice !frontier;
65
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
66
	pending := p;
67
	frontier := f;
68
	call := is_call_output choice g;
69
	add_successors eq_equiv g choice pending frontier;
70
	if not (ExprDep.is_ghost_var choice)
71
	then sort := [choice] :: !sort
72
      end
73
    else
74
      begin
75
	let choice = ISet.min_elt !pending in
76
      (*Format.eprintf "-2-> %s@." choice;*)
77
	pending := ISet.remove choice !pending;
78
	add_successors eq_equiv g choice pending frontier;
79
	if not (ExprDep.is_ghost_var choice)
80
	then sort := (if !call
81
		      then (choice :: List.hd !sort) :: List.tl !sort
82
		      else [choice] :: !sort)
83
      end
84
  end
85

    
86

    
87
(* Topological sort of dependency graph [g], with priority.
88
 *)
89
let topological_sort eq_equiv g =
90
  let roots = graph_roots g in
91
  assert (roots <> []);
92
  let call = ref false in
93
  let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
94
  let pending = ref ISet.empty in
95
  let sorted = ref [] in
96
  begin
97
    while not (ISet.is_empty !frontier && ISet.is_empty !pending)
98
    do
99
      (*Format.eprintf "frontier = {%a}, pending = {%a}@."
100
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier
101
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
102
      next_element eq_equiv g sorted call pending frontier;
103
    done;
104
    IdentDepGraph.clear g;
105
    !sorted
106
  end
107

    
108
(* Filters out normalization variables and renames instance variables to keep things readable,
109
   in a case of a dependency error *)
110
let filter_original n vl =
111
 List.fold_right (fun v res ->
112
   if ExprDep.is_instance_var v then Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res else
113
   let vdecl = get_node_var v n in
114
   if vdecl.var_orig then v :: res else res) vl []
115

    
116
let eq_equiv eq_equiv_hash =
117
  fun v1 v2 ->
118
  try
119
    Hashtbl.find eq_equiv_hash v1 = Hashtbl.find eq_equiv_hash v2
120
  with Not_found -> false
121

    
122
let schedule_node n =
123
  (* let node_vars = get_node_vars n in *)
124
  let eq_equiv = eq_equiv (ExprDep.node_eq_equiv n) in
125

    
126
  let n', g = global_dependency n in
127
  
128
  (* TODO X: extend the graph with inputs (adapt the causality analysis to deal with inputs
129
     compute: coi predecessors of outputs
130
     warning (no modification) when memories are non used (do not impact output) or when inputs are not used (do not impact output)
131
     DONE !
132
  *)
133

    
134
  let gg = IdentDepGraph.copy g in
135
  let sort = topological_sort eq_equiv g in
136
  let unused = Liveness.compute_unused_variables n gg in
137
  let fanin = Liveness.compute_fanin n gg in
138
  { node = n'; schedule = sort; unused_vars = unused; fanin_table = fanin; dep_graph = gg; }
139

    
140
(* let schedule_eqs eqs =
141
 *   let eq_equiv = eq_equiv (ExprDep.eqs_eq_equiv eqs) in
142
 *   assert false (\* TODO: continue to implement scheduling of eqs for spec *\) *)
143

    
144
let compute_node_reuse_table report =
145
  let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in
146
  let reuse = Liveness.compute_reuse_policy report.node report.schedule disjoint report.dep_graph in
147
(*
148
    if !Options.print_reuse
149
    then
150
      begin
151
	Log.report ~level:0 
152
	  (fun fmt -> 
153
	    Format.fprintf fmt
154
	      "OPT:%B@." (try (Hashtbl.iter (fun s1 v2 -> if s1 = v2.var_id then raise Not_found) reuse; false) with Not_found -> true)
155
	  );
156
	Log.report ~level:0 
157
	  (fun fmt -> 
158
	    Format.fprintf fmt
159
	      "OPT:clock disjoint map for node %s: %a" 
160
	      n'.node_id
161
	      Disjunction.pp_disjoint_map disjoint
162
	  );
163
	Log.report ~level:0 
164
	  (fun fmt -> 
165
	    Format.fprintf fmt
166
	      "OPT:reuse policy for node %s: %a" 
167
	      n'.node_id
168
	      Liveness.pp_reuse_policy reuse
169
	  );
170
      end;
171
*)
172
    reuse
173

    
174

    
175
let schedule_prog prog =
176
  List.fold_right (
177
    fun top_decl (accu_prog, sch_map)  ->
178
      match top_decl.top_decl_desc with
179
      | Node nd ->
180
	let report = schedule_node nd in
181
	{top_decl with top_decl_desc = Node report.node}::accu_prog, 
182
	IMap.add nd.node_id report sch_map
183
	| _ -> top_decl::accu_prog, sch_map
184
    ) 
185
    prog
186
    ([],IMap.empty)
187
  
188

    
189
let compute_prog_reuse_table report =
190
  IMap.map compute_node_reuse_table report
191

    
192
(* removes inlined local variables from schedule report, 
193
   which are now useless *)
194
let remove_node_inlined_locals locals report =
195
  let is_inlined v = IMap.exists (fun l _ -> v = l) locals in
196
  let schedule' =
197
    List.fold_right (fun heads q -> let heads' = List.filter (fun v -> not (is_inlined v)) heads
198
				    in if heads' = [] then q else heads'::q)
199
      report.schedule [] in
200
  begin
201
    IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals;
202
    IMap.iter (fun v _ -> let iv = ExprDep.mk_instance_var v
203
			  in Liveness.replace_in_dep_graph v iv report.dep_graph) locals;
204
    { report with schedule = schedule' }
205
  end
206

    
207
let remove_prog_inlined_locals removed reuse =
208
  IMap.mapi (fun id -> remove_node_inlined_locals (IMap.find id removed)) reuse
209

    
210
let pp_eq_schedule fmt vl =
211
  match vl with
212
  | []  -> assert false
213
  | [v] -> Format.fprintf fmt "%s" v
214
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
215
 
216
let pp_schedule fmt node_schs =
217
 IMap.iter
218
   (fun nd report ->
219
     Format.fprintf fmt "%s schedule: %a@."
220
       nd
221
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
222
   node_schs
223

    
224
let pp_fanin_table fmt node_schs =
225
  IMap.iter
226
    (fun nd report ->
227
      Format.fprintf fmt "%s: %a" nd Liveness.pp_fanin report.fanin_table)
228
    node_schs
229

    
230
let pp_dep_graph fmt node_schs =
231
  IMap.iter
232
    (fun nd report ->
233
      Format.fprintf fmt "%s dependency graph: %a" nd pp_dep_graph report.dep_graph)
234
    node_schs
235

    
236
let pp_warning_unused fmt node_schs =
237
 IMap.iter
238
   (fun nd report ->
239
     let unused = report.unused_vars in
240
     if not (ISet.is_empty unused)
241
     then
242
       let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
243
       ISet.iter
244
	 (fun u ->
245
	   let vu = get_node_var u nd in
246
	   if vu.var_orig
247
	   then Format.fprintf fmt "  Warning: variable '%s' seems unused@,  %a@,@," u Location.pp_loc vu.var_loc)
248
	 unused
249
   )
250
   node_schs
251

    
252

    
253
(* Sort eqs according to schedule *)
254
(* Sort the set of equations of node [nd] according
255
   to the computed schedule [sch]
256
*)
257
let sort_equations_from_schedule eqs sch =
258
  (* Format.eprintf "%s schedule: %a@." *)
259
  (* 		 nd.node_id *)
260
  (* 		 (Utils.fprintf_list ~sep:" ; " Scheduling.pp_eq_schedule) sch; *)
261
  let split_eqs = Splitting.tuple_split_eq_list eqs in
262
  let eqs_rev, remainder =
263
    List.fold_left
264
      (fun (accu, node_eqs_remainder) vl ->
265
       if List.exists (fun eq -> List.exists (fun v -> List.mem v eq.eq_lhs) vl) accu
266
       then
267
	 (accu, node_eqs_remainder)
268
       else
269
	 let eq_v, remainder = find_eq vl node_eqs_remainder in
270
	 eq_v::accu, remainder
271
      )
272
      ([], split_eqs)
273
      sch
274
  in
275
  begin
276
    let eqs = List.rev eqs_rev in 
277
    let unused =
278
      if List.length remainder > 0 then (
279
        Log.report ~level:3 (fun fmt -> Format.fprintf fmt
280
                                       "[Warning] Equations not used are@ %a@ Full equation set is:@ %a@ "
281
		                       Printers.pp_node_eqs remainder
282
      		                     Printers.pp_node_eqs eqs
283
          );
284
        let vars = List.fold_left (fun accu eq -> eq.eq_lhs @ accu) [] remainder in
285
        Log.report ~level:1 (fun fmt -> Format.fprintf fmt
286
                                      "[Warning] Unused variables: %a@ "
287
                                      (fprintf_list ~sep:", " Format.pp_print_string)
288
                                  vars
289
          );
290
        vars
291
      )
292
      else
293
        []
294
    in
295
    eqs, unused
296
  end
297

    
298
(* Local Variables: *)
299
(* compile-command:"make -C .." *)
300
(* End: *)