lustrec / src / liveness.ml @ 3c48346d
History  View  Annotate  Download (5.65 KB)
1 
(*  

2 
* SchedMCore  A MultiCore Scheduling Framework 
3 
* Copyright (C) 20092013, ONERA, Toulouse, FRANCE  LIFL, Lille, FRANCE 
4 
* Copyright (C) 20122013, 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 021111307 
21 
* USA 
22 
* *) 
23  
24 
open Utils 
25 
open LustreSpec 
26 
open Corelang 
27 
open Causality 
28  
29 
(* Computes the last dependency 
30 
*) 
31  
32 
(* Computes the death table of [node] wrt dep graph [g] and topological [sort]. 
33 
The death table is a mapping: ident > Set(ident) such that: 
34 
death x is the set of local variables which get dead (i.e. unused) 
35 
after x is evaluated, but were until live. 
36 
let death_table node g sort = 
37 
let death = Hashtbl.create 23 in 
38 
let sort = ref (List.rev sort) in 
39 
let buried = ref ISet.empty in 
40 
begin 
41 
buried := ExprDep.node_memory_variables node; 
42 
buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_outputs; 
43 
(* We could also try to reuse input variables, due to C parameter copying semantics *) 
44 
buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_inputs; 
45 
while (!sort <> []) 
46 
do 
47 
let head = List.hd !sort in 
48 
let dead = IdentDepGraph.fold_succ 
49 
(fun tgt dead > if not (ExprDep.is_instance_var tgt  ISet.mem tgt !buried) then ISet.add tgt dead else dead) 
50 
g head ISet.empty in 
51 
buried := ISet.union !buried dead; 
52 
Hashtbl.add death head dead; 
53 
sort := List.tl !sort 
54 
done; 
55 
IdentDepGraph.clear g; 
56 
death 
57 
end 
58 
*) 
59  
60 
(* Computes the set of (input and) output and mem variables of [node]. 
61 
We try to reuse input variables, due to C parameter copying semantics. *) 
62 
let node_non_locals node = 
63 
List.fold_left (fun non_loc v > ISet.add v.var_id non_loc) (ExprDep.node_memory_variables node) node.node_outputs 
64  
65 
(* Recursively removes useless local variables, 
66 
i.e. variables in [non_locals] that are current roots of the dep graph [g] *) 
67 
let remove_local_roots non_locals g = 
68 
let rem = ref true in 
69 
let roots = ref ISet.empty in 
70 
while !rem 
71 
do 
72 
rem := false; 
73 
let local_roots = List.filter (fun v > not (ISet.mem v non_locals)) (graph_roots g) in 
74 
if local_roots <> [] then 
75 
begin 
76 
rem := true; 
77 
List.iter (IdentDepGraph.remove_vertex g) local_roots; 
78 
roots := List.fold_left (fun roots v > if ExprDep.is_instance_var v then roots else ISet.add v roots) !roots local_roots 
79 
end 
80 
done; 
81 
!roots 
82  
83 
(* Computes the death table of [node] wrt dep graph [g] and topological [sort]. 
84 
The death table is a mapping: ident > Set(ident) such that: 
85 
death x is the set of local variables which get dead (i.e. unused) 
86 
before x is evaluated, but were until live. 
87 
If death x is not defined, then x is useless. 
88 
*) 
89 
let death_table node g sort = 
90 
let non_locals = node_non_locals node in 
91 
let death = Hashtbl.create 23 in 
92 
let sort = ref sort in 
93 
begin 
94 
while (!sort <> []) 
95 
do 
96 
let head = List.hd !sort in 
97 
(* If current var is not already dead, i.e. useless *) 
98 
if IdentDepGraph.mem_vertex g head then 
99 
begin 
100 
IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g head) g head; 
101 
let dead = remove_local_roots non_locals g in 
102 
Hashtbl.add death head dead 
103 
end; 
104 
sort := List.tl !sort 
105 
done; 
106 
IdentDepGraph.clear g; 
107 
death 
108 
end 
109  
110 
let pp_death_table fmt death = 
111 
begin 
112 
Format.fprintf fmt "{ /* death table */@."; 
113 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > { %a }@." s (Utils.fprintf_list ~sep:", " Format.pp_print_string) (ISet.elements t)) death; 
114 
Format.fprintf fmt "}@." 
115 
end 
116  
117 
(* Replaces [v] by [v'] in set [s] *) 
118 
let replace_in_set s v v' = 
119 
if ISet.mem v s then ISet.add v' (ISet.remove v s) else s 
120  
121 
(* Replaces [v] by [v'] in death table [death] *) 
122 
let replace_in_death_table death v v' = 
123 
Hashtbl.iter (fun k dead > Hashtbl.replace death k (replace_in_set dead v v')) death 
124  
125 
let find_compatible_local node var dead = 
126 
Format.eprintf "find_compatible_local %s %s@." node.node_id var; 
127 
let typ = (Corelang.node_var var node).var_type in 
128 
try 
129 
Some ((List.find (fun v > ISet.mem v.var_id dead && Typing.eq_ground typ v.var_type) node.node_locals).var_id) 
130 
with Not_found > None 
131  
132 
let reuse_policy node sort death = 
133 
let dead = ref ISet.empty in 
134 
let policy = Hashtbl.create 23 in 
135 
let sort = ref sort in 
136 
while !sort <> [] 
137 
do 
138 
let head = List.hd !sort in 
139 
if Hashtbl.mem death head then 
140 
begin 
141 
dead := ISet.union (Hashtbl.find death head) !dead; 
142 
end; 
143 
(match find_compatible_local node head !dead with 
144 
 None > () 
145 
 Some l > replace_in_death_table death head l; Hashtbl.add policy head l); 
146 
sort := List.tl !sort; 
147 
done; 
148 
policy 
149 

150 
let pp_reuse_policy fmt policy = 
151 
begin 
152 
Format.fprintf fmt "{ /* reuse policy */@."; 
153 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %s@." s t) policy; 
154 
Format.fprintf fmt "}@." 
155 
end 
156 
(* Local Variables: *) 
157 
(* compilecommand:"make C .." *) 
158 
(* End: *) 