Project

General

Profile

« Previous | Next » 

Revision ca7ff3f7

Added by LĂ©lio Brun 8 months ago

reformatting

View differences:

src/scheduling.ml
15 15
open Causality
16 16
open Scheduling_type
17 17

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

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

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

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

  
85

  
86
(* Topological sort of dependency graph [g], with priority.
87
 *)
70
(* Topological sort of dependency graph [g], with priority. *)
88 71
let topological_sort eq_equiv g =
89 72
  let roots = graph_roots g in
90 73
  assert (roots <> []);
......
92 75
  let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
93 76
  let pending = ref ISet.empty in
94 77
  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 call pending frontier;
102
    done;
103
    IdentDepGraph.clear g;
104
    !sorted
105
  end
78
  while not (ISet.is_empty !frontier && ISet.is_empty !pending) do
79
    (*Format.eprintf "frontier = {%a}, pending = {%a}@." (fun fmt -> ISet.iter
80
      (fun e -> Format.pp_print_string fmt e)) !frontier (fun fmt -> ISet.iter
81
      (fun e -> Format.pp_print_string fmt e)) !pending;*)
82
    next_element eq_equiv g sorted call pending frontier
83
  done;
84
  IdentDepGraph.clear g;
85
  !sorted
106 86

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

  
115
let eq_equiv eq_equiv_hash =
116
  fun v1 v2 ->
117
  try
118
    Hashtbl.find eq_equiv_hash v1 = Hashtbl.find eq_equiv_hash v2
99
let eq_equiv eq_equiv_hash v1 v2 =
100
  try Hashtbl.find eq_equiv_hash v1 = Hashtbl.find eq_equiv_hash v2
119 101
  with Not_found -> false
120 102

  
121 103
let schedule_node n =
122 104
  (* let node_vars = get_node_vars n in *)
123
  Log.report ~level:5 (fun fmt -> Format.fprintf fmt "scheduling node %s@ " n.node_id);
105
  Log.report ~level:5 (fun fmt ->
106
      Format.fprintf fmt "scheduling node %s@ " n.node_id);
124 107
  let eq_equiv = eq_equiv (ExprDep.node_eq_equiv n) in
125 108

  
126 109
  let node, 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 110

  
111
  (* TODO X: extend the graph with inputs (adapt the causality analysis to deal
112
     with inputs compute: coi predecessors of outputs warning (no modification)
113
     when memories are non used (do not impact output) or when inputs are not
114
     used (do not impact output) DONE ! *)
134 115
  let dep_graph = IdentDepGraph.copy g in
135 116
  let schedule = topological_sort eq_equiv g in
136 117
  let unused_vars = Liveness.compute_unused_variables n dep_graph in
......
143 124

  
144 125
let compute_node_reuse_table report =
145 126
  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

  
127
  let reuse =
128
    Liveness.compute_reuse_policy report.node report.schedule disjoint
129
      report.dep_graph
130
  in
131
  (* if !Options.print_reuse then begin Log.report ~level:0 (fun fmt ->
132
     Format.fprintf fmt "OPT:%B@." (try (Hashtbl.iter (fun s1 v2 -> if s1 =
133
     v2.var_id then raise Not_found) reuse; false) with Not_found -> true) );
134
     Log.report ~level:0 (fun fmt -> Format.fprintf fmt "OPT:clock disjoint map
135
     for node %s: %a" n'.node_id Disjunction.pp_disjoint_map disjoint );
136
     Log.report ~level:0 (fun fmt -> Format.fprintf fmt "OPT:reuse policy for
137
     node %s: %a" n'.node_id Liveness.pp_reuse_policy reuse ); end; *)
138
  reuse
174 139

  
175 140
let schedule_prog prog =
176
  List.fold_right (
177
    fun top_decl (accu_prog, sch_map)  ->
141
  List.fold_right
142
    (fun top_decl (accu_prog, sch_map) ->
178 143
      match top_decl.top_decl_desc with
179 144
      | Node nd ->
180 145
        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)
146
        ( { top_decl with top_decl_desc = Node report.node } :: accu_prog,
147
          IMap.add nd.node_id report sch_map )
148
      | _ ->
149
        top_decl :: accu_prog, sch_map)
150
    prog ([], IMap.empty)
187 151

  
152
let compute_prog_reuse_table report = IMap.map compute_node_reuse_table report
188 153

  
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 *)
154
(* removes inlined local variables from schedule report, which are now useless *)
194 155
let remove_node_inlined_locals locals report =
195 156
  let is_inlined v = IMap.exists (fun l _ -> v = l) locals in
196 157
  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
158
    List.fold_right
159
      (fun heads q ->
160
        let heads' = List.filter (fun v -> not (is_inlined v)) heads in
161
        if heads' = [] then q else heads' :: q)
162
      report.schedule []
163
  in
164
  IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals;
165
  IMap.iter
166
    (fun v _ ->
167
      let iv = ExprDep.mk_instance_var v in
168
      Liveness.replace_in_dep_graph v iv report.dep_graph)
169
    locals;
170
  { report with schedule = schedule' }
206 171

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

  
210 175
let pp_eq_schedule fmt vl =
211 176
  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
 
177
  | [] ->
178
    assert false
179
  | [ v ] ->
180
    Format.fprintf fmt "%s" v
181
  | _ ->
182
    Format.fprintf fmt "(%a)"
183
      (fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v))
184
      vl
185

  
216 186
let pp_schedule fmt node_schs =
217
 IMap.iter
218
   (fun nd report ->
219
     Format.(fprintf fmt "%s schedule: %a@ "
220
       nd
221
       (pp_print_list ~pp_sep:pp_print_semicolon pp_eq_schedule)
222
       report.schedule))
223
   node_schs
187
  IMap.iter
188
    (fun nd report ->
189
      Format.(
190
        fprintf fmt "%s schedule: %a@ " nd
191
          (pp_print_list ~pp_sep:pp_print_semicolon pp_eq_schedule)
192
          report.schedule))
193
    node_schs
224 194

  
225 195
let pp_fanin_table fmt node_schs =
226 196
  IMap.iter
......
231 201
let pp_dep_graph fmt node_schs =
232 202
  IMap.iter
233 203
    (fun nd report ->
234
      Format.fprintf fmt "%s dependency graph: %a@ " nd pp_dep_graph report.dep_graph)
204
      Format.fprintf fmt "%s dependency graph: %a@ " nd pp_dep_graph
205
        report.dep_graph)
235 206
    node_schs
236 207

  
237 208
let pp_warning_unused fmt node_schs =
238 209
  IMap.iter
239 210
    (fun nd report ->
240
       let unused = report.unused_vars in
241
       if not (ISet.is_empty unused)
242
       then
243
         let nd = match (Corelang.node_from_name nd).top_decl_desc with Node nd -> nd | _ -> assert false in
244
         ISet.iter
245
           (fun u ->
246
              let vu = get_node_var u nd in
247
              if vu.var_orig
248
              then Format.fprintf fmt "  Warning: variable '%s' seems unused@,  %a@,@," u Location.pp_loc vu.var_loc)
249
	       unused
250
    )
211
      let unused = report.unused_vars in
212
      if not (ISet.is_empty unused) then
213
        let nd =
214
          match (Corelang.node_from_name nd).top_decl_desc with
215
          | Node nd ->
216
            nd
217
          | _ ->
218
            assert false
219
        in
220
        ISet.iter
221
          (fun u ->
222
            let vu = get_node_var u nd in
223
            if vu.var_orig then
224
              Format.fprintf fmt
225
                "  Warning: variable '%s' seems unused@,  %a@,@," u
226
                Location.pp_loc vu.var_loc)
227
          unused)
251 228
    node_schs
252 229

  
253

  
254 230
(* Sort eqs according to schedule *)
255
(* Sort the set of equations of node [nd] according
256
   to the computed schedule [sch]
257
*)
231
(* Sort the set of equations of node [nd] according to the computed schedule
232
   [sch] *)
258 233
let sort_equations_from_schedule eqs sch =
259 234
  Log.report ~level:10 (fun fmt ->
260 235
      Format.fprintf fmt "schedule: %a@ "
261
        (Format.pp_print_list
262
           ~pp_sep:Format.pp_print_semicolon pp_eq_schedule) sch);
236
        (Format.pp_print_list ~pp_sep:Format.pp_print_semicolon pp_eq_schedule)
237
        sch);
263 238
  let split_eqs = Splitting.tuple_split_eq_list eqs in
264 239
  (* Flatten schedule *)
265
   let sch = List.fold_right (fun vl res -> (List.map (fun v -> [v]) vl)@res) sch [] in 
240
  let sch =
241
    List.fold_right (fun vl res -> List.map (fun v -> [ v ]) vl @ res) sch []
242
  in
266 243
  let eqs_rev, remainder =
267 244
    List.fold_left
268 245
      (fun (accu, node_eqs_remainder) vl ->
269 246
        (* For each variable in vl, there should exists the equations in accu *)
270
       if List.for_all (fun v -> List.exists (fun eq -> List.mem v eq.eq_lhs) accu) vl
271
       then
272
	 (accu, node_eqs_remainder)
273
       else
274
	 let eq_v, remainder = find_eq vl node_eqs_remainder in
275
	 eq_v::accu, remainder
276
      )
277
      ([], split_eqs)
278
      sch
247
        if
248
          List.for_all
249
            (fun v -> List.exists (fun eq -> List.mem v eq.eq_lhs) accu)
250
            vl
251
        then accu, node_eqs_remainder
252
        else
253
          let eq_v, remainder = find_eq vl node_eqs_remainder in
254
          eq_v :: accu, remainder)
255
      ([], split_eqs) sch
279 256
  in
280
  begin
281
    let eqs = List.rev eqs_rev in 
282
    let unused =
283
      if List.length remainder > 0 then (
284
        Log.report ~level:3 (fun fmt -> Format.fprintf fmt
285
                                       "[Warning] Equations not used are@ %a@ Full equation set is:@ %a@ "
286
		                       Printers.pp_node_eqs remainder
287
      		                     Printers.pp_node_eqs eqs
288
          );
289
        let vars = List.fold_left (fun accu eq -> eq.eq_lhs @ accu) [] remainder in
290
        Log.report ~level:1 (fun fmt -> Format.fprintf fmt
291
                                      "[Warning] Unused variables: %a@ "
292
                                      (fprintf_list ~sep:", " Format.pp_print_string)
293
                                  vars
294
          );
295
        vars
296
      )
297
      else
298
        []
299
    in
300
    eqs, unused
301
  end
257
  let eqs = List.rev eqs_rev in
258
  let unused =
259
    if List.length remainder > 0 then (
260
      Log.report ~level:3 (fun fmt ->
261
          Format.fprintf fmt
262
            "[Warning] Equations not used are@ %a@ Full equation set is:@ %a@ "
263
            Printers.pp_node_eqs remainder Printers.pp_node_eqs eqs);
264
      let vars =
265
        List.fold_left (fun accu eq -> eq.eq_lhs @ accu) [] remainder
266
      in
267
      Log.report ~level:1 (fun fmt ->
268
          Format.fprintf fmt "[Warning] Unused variables: %a@ "
269
            (fprintf_list ~sep:", " Format.pp_print_string)
270
            vars);
271
      vars)
272
    else []
273
  in
274
  eqs, unused
302 275

  
303 276
(* Local Variables: *)
304 277
(* compile-command:"make -C .." *)

Also available in: Unified diff