Revision a38c681e src/scheduling.ml
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 indegree *) 
...  ...  
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