Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 6cf31814

History | View | Annotate | Download (6.37 KB)

1
(* ----------------------------------------------------------------------------
2
 * SchedMCore - A MultiCore Scheduling Framework
3
 * Copyright (C) 2009-2013, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE
4
 * Copyright (C) 2012-2013, INPT, Toulouse, FRANCE
5
 *
6
 * This file is part of Prelude
7
 *
8
 * Prelude is free software; you can redistribute it and/or
9
 * modify it under the terms of the GNU Lesser General Public License
10
 * as published by the Free Software Foundation ; either version 2 of
11
 * the License, or (at your option) any later version.
12
 *
13
 * Prelude is distributed in the hope that it will be useful, but
14
 * WITHOUT ANY WARRANTY ; without even the implied warranty of
15
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16
 * Lesser General Public License for more details.
17
 *
18
 * You should have received a copy of the GNU Lesser General Public
19
 * License along with this program ; if not, write to the Free Software
20
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
21
 * USA
22
 *---------------------------------------------------------------------------- *)
23

    
24
(* This module is used for the lustre to C compiler *)
25

    
26
open Utils
27
open LustreSpec
28
open Corelang
29
open Graph
30
open Causality
31

    
32

    
33
(* Tests whether [v] is a root of graph [g], i.e. a source *)
34
let is_graph_root v g =
35
 IdentDepGraph.in_degree g v = 0
36

    
37
(* Computes the set of graph roots, i.e. the sources of acyclic graph [g] *)
38
let graph_roots g =
39
 IdentDepGraph.fold_vertex
40
   (fun v roots -> if is_graph_root v g then v::roots else roots)
41
   g []
42

    
43
(* Topological sort with a priority for variables belonging in the same equation lhs.
44
   For variables still unrelated, standard compare is used to choose the minimal element.
45
   This priority is used since it helps a lot in factorizing generated code.
46
   In the following functions:
47
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
48
   - [g] the (imperative) graph to be topologically sorted
49
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
50
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
51
   - [sort] is the resulting topological order
52
*)
53
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
54
   then removes [v] from [g] 
55
*)
56
let add_successors eq_equiv g v pending frontier =
57
  let succs_v = IdentDepGraph.succ g v in
58
  begin
59
    IdentDepGraph.remove_vertex g v;
60
    List.iter (fun v' -> if is_graph_root v' g then (if eq_equiv v v' then pending := ISet.add v' !pending else frontier := ISet.add v' !frontier)) succs_v;
61
  end
62

    
63
(* Chooses the next var to be sorted, taking priority into account.
64
   Modifies [pending] and [frontier] accordingly.
65
*)
66
let next_element eq_equiv g sort pending frontier =
67
  begin
68
    if ISet.is_empty !pending
69
    then
70
      begin
71
	let choice = ISet.min_elt !frontier in
72
      (*Format.eprintf "-1-> %s@." choice;*)
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
83
      (*Format.eprintf "-2-> %s@." choice;*)
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

    
90

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

    
149
let schedule_node n  =
150
  try
151
    let eq_equiv = ExprDep.node_eq_equiv n in
152
    let eq_equiv v1 v2 =
153
      try
154
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
155
      with Not_found -> false in
156
    let n', g = global_dependency n in
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
163
(* let sorted = TopologicalDepGraph.fold (fun x res -> if ExprDep.is_instance_var x then res else x::res) g []*)
164
  with (Causality.Cycle v) as exc ->
165
    pp_error Format.err_formatter v;
166
    raise exc
167

    
168

    
169
(* Local Variables: *)
170
(* compile-command:"make -C .." *)
171
(* End: *)