Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ 22fe1c93

History | View | Annotate | Download (4.6 KB)

1 22fe1c93 ploc
(* ----------------------------------------------------------------------------
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 Corelang
28
open Graph
29
open Causality
30
31
32
(* Tests whether [v] is a root of graph [g], i.e. a source *)
33
let is_graph_root v g =
34
 IdentDepGraph.in_degree g v = 0
35
36
(* Computes the set of graph roots, i.e. the sources of acyclic graph [g] *)
37
let graph_roots g =
38
 IdentDepGraph.fold_vertex
39
   (fun v roots -> if is_graph_root v g then v::roots else roots)
40
   g []
41
42
(* Topological sort with a priority for variables belonging in the same equation lhs.
43
   For variables still unrelated, standard compare is used to choose the minimal element.
44
   This priority is used since it helps a lot in factorizing generated code.
45
   In the following functions:
46
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
47
   - [g] the (imperative) graph to be topologically sorted
48
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
49
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
50
   - [sort] is the resulting topological order
51
*)
52
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
53
   then removes [v] from [g] 
54
*)
55
let add_successors eq_equiv g v pending frontier =
56
  let succs_v = IdentDepGraph.succ g v in
57
  begin
58
    IdentDepGraph.remove_vertex g v;
59
    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;
60
  end
61
62
(* Chooses the next var to be sorted, taking priority into account.
63
   Modifies [pending] and [frontier] accordingly.
64
*)
65
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
70
      (*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
81
      (*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
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 frontier = ref (List.fold_right ISet.add roots ISet.empty) in
93
  let pending = ref ISet.empty in
94
  let sorted = ref [] in
95
  begin
96
    while not (ISet.is_empty !frontier && ISet.is_empty !pending)
97
    do
98
      (*Format.eprintf "frontier = {%a}, pending = {%a}@."
99
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier
100
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
101
      next_element eq_equiv g sorted pending frontier;
102
    done;
103
    !sorted
104
  end
105
106
let schedule_node n  =
107
  try
108
    let eq_equiv = ExprDep.node_eq_equiv n in
109
    let eq_equiv v1 v2 =
110
      try
111
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
112
      with Not_found -> false in
113
    let n', g = global_dependency n in
114
    n', topological_sort eq_equiv g
115
(* let sorted = TopologicalDepGraph.fold (fun x res -> if ExprDep.is_instance_var x then res else x::res) g []*)
116
  with (Causality.Cycle v) as exc ->
117
    pp_error Format.err_formatter v;
118
    raise exc
119
120
121
(* Local Variables: *)
122
(* compile-command:"make -C .." *)
123
(* End: *)