Project

General

Profile

Revision a38c681e src/scheduling.ml

View differences:

src/scheduling.ml
32 32
type schedule_report =
33 33
{
34 34
  (* a schedule computed wrt the dependency graph *)
35
  schedule : ident list;
35
  schedule : ident list list;
36 36
  (* the set of unused variables (no output or mem depends on them) *)
37 37
  unused_vars : ISet.t;
38 38
  (* the table mapping each local var to its in-degree *)
......
51 51
   - [frontier] is the set of unsorted root variables so far, not belonging in [pending]
52 52
   - [sort] is the resulting topological order
53 53
*)
54

  
55
(* Checks whether the currently scheduled variable [choice]
56
   is an output of a call, possibly among others *)
57
let is_call_output choice g =
58
  List.for_all ExprDep.is_instance_var (IdentDepGraph.succ g choice)
59

  
54 60
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt [eq_equiv],
55 61
   then removes [v] from [g] 
56 62
*)
......
71 77
(* Chooses the next var to be sorted, taking priority into account.
72 78
   Modifies [pending] and [frontier] accordingly.
73 79
*)
74
let next_element eq_equiv g sort pending frontier =
80
let next_element eq_equiv g sort call pending frontier =
75 81
  begin
76 82
    if ISet.is_empty !pending
77 83
    then
......
82 88
	let (p, f) = ISet.partition (eq_equiv choice) !frontier in
83 89
	pending := p;
84 90
	frontier := f;
91
	call := is_call_output choice g;
85 92
	add_successors eq_equiv g choice pending frontier;
86
	if not (ExprDep.is_ghost_var choice) then sort := choice :: !sort
93
	if not (ExprDep.is_ghost_var choice)
94
	then sort := [choice] :: !sort
87 95
      end
88 96
    else
89 97
      begin
......
91 99
      (*Format.eprintf "-2-> %s@." choice;*)
92 100
	pending := ISet.remove choice !pending;
93 101
	add_successors eq_equiv g choice pending frontier;
94
	if not (ExprDep.is_ghost_var choice) then sort := choice :: !sort
102
	if not (ExprDep.is_ghost_var choice)
103
	then sort := (if !call
104
		      then (choice :: List.hd !sort) :: List.tl !sort
105
		      else [choice] :: !sort)
95 106
      end
96 107
  end
97 108

  
......
101 112
let topological_sort eq_equiv g =
102 113
  let roots = graph_roots g in
103 114
  assert (roots <> []);
115
  let call = ref false in
104 116
  let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
105 117
  let pending = ref ISet.empty in
106 118
  let sorted = ref [] in
......
110 122
      (*Format.eprintf "frontier = {%a}, pending = {%a}@."
111 123
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !frontier
112 124
	(fun fmt -> ISet.iter (fun e -> Format.pp_print_string fmt e)) !pending;*)
113
      next_element eq_equiv g sorted pending frontier;
125
      next_element eq_equiv g sorted call pending frontier;
114 126
    done;
115 127
    IdentDepGraph.clear g;
116 128
    !sorted
......
146 158

  
147 159
    let disjoint = Disjunction.clock_disjoint_map (get_node_vars n) in
148 160
    
149
    Log.report ~level:5 
161
    Log.report ~level:2 
150 162
      (fun fmt -> 
151 163
	Format.fprintf fmt
152 164
	  "clock disjoint map for node %s: %a" 
......
154 166
	  Disjunction.pp_disjoint_map disjoint
155 167
      );
156 168

  
157
    let reuse = Liveness.compute_reuse_policy n sort disjoint gg in
158
    Log.report ~level:5 
169
    let reuse = Hashtbl.create 23 (*Liveness.compute_reuse_policy n sort disjoint gg*) in
170
    Log.report ~level:2 
159 171
      (fun fmt -> 
160 172
	Format.fprintf fmt
161 173
	  "reuse policy for node %s: %a" 
......
181 193
    prog
182 194
    ([],IMap.empty)
183 195

  
196
let pp_eq_schedule fmt vl =
197
  match vl with
198
  | []  -> assert false
199
  | [v] -> Format.fprintf fmt "%s" v
200
  | _   -> Format.fprintf fmt "(%a)" (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v)) vl
201
 
184 202
let pp_schedule fmt node_schs =
185 203
 IMap.iter
186 204
   (fun nd report ->
187 205
     Format.fprintf fmt "%s schedule: %a@."
188 206
       nd
189
       (fprintf_list ~sep:" ; " (fun fmt v -> Format.fprintf fmt "%s" v)) report.schedule)
207
       (fprintf_list ~sep:" ; " pp_eq_schedule) report.schedule)
190 208
   node_schs
191 209

  
192 210
let pp_fanin_table fmt node_schs =

Also available in: Unified diff