Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / scheduling.ml @ c1adf235

History | View | Annotate | Download (5.34 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
(* Topological sort with a priority for variables belonging in the same equation lhs.
34
   For variables still unrelated, standard compare is used to choose the minimal element.
35
   This priority is used since it helps a lot in factorizing generated code.
36
   In the following functions:
37
   - [eq_equiv] is the equivalence relation between vars of the same equation lhs
38
   - [g] the (imperative) graph to be topologically sorted
39
   - [pending] is the set of unsorted root variables so far, equivalent to the last sorted var
40
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
41
   - [sort] is the resulting topological order
42
*)
43
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
44
   then removes [v] from [g] 
45
*)
46
let add_successors eq_equiv g v pending frontier =
47
  let succs_v = IdentDepGraph.succ g v in
48
  begin
49
    IdentDepGraph.remove_vertex g v;
50
    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;
51
  end
52

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

    
80

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

    
101
let schedule_node n =
102
  try
103
    let eq_equiv = ExprDep.node_eq_equiv n in
104
    let eq_equiv v1 v2 =
105
      try
106
	Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2
107
      with Not_found -> false in
108
    let n', g = global_dependency n in
109
    Log.report ~level:5 (fun fmt -> Format.eprintf "dependency graph for node %s: %a" n'.node_id pp_dep_graph g);
110
    let gg = IdentDepGraph.copy g in
111
    let sort = topological_sort eq_equiv g in
112

    
113
    let death = Liveness.death_table n gg sort in
114
    Log.report ~level:5 (fun fmt -> Format.eprintf "death table for node %s: %a" n'.node_id Liveness.pp_death_table death);
115

    
116
    let disjoint = Disjunction.clock_disjoint_map (node_vars n) in
117
    Log.report ~level:5 (fun fmt -> Format.eprintf "clock disjoint map for node %s: %a" n'.node_id Disjunction.pp_disjoint_map disjoint);
118

    
119
    let reuse = Liveness.reuse_policy n sort death in
120
    Log.report ~level:5 (fun fmt -> Format.eprintf "reuse policy for node %s: %a" n'.node_id Liveness.pp_reuse_policy reuse);
121
 
122
    n', sort
123
(* let sorted = TopologicalDepGraph.fold (fun x res -> if ExprDep.is_instance_var x then res else x::res) g []*)
124
  with (Causality.Cycle v) as exc ->
125
    pp_error Format.err_formatter v;
126
    raise exc
127

    
128
let schedule_prog prog =
129
  List.fold_right (
130
    fun top_decl (accu_prog, sch_map)  ->
131
      match top_decl.top_decl_desc with
132
	| Node nd -> 
133
	  let nd', sch = schedule_node nd in
134
	  {top_decl with top_decl_desc = Node nd'}::accu_prog, (nd.node_id, sch)::sch_map
135
	| _ -> top_decl::accu_prog, sch_map
136
    ) 
137
    prog
138
    ([],[])
139

    
140

    
141
(* Local Variables: *)
142
(* compile-command:"make -C .." *)
143
(* End: *)