Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ b1a97ade

History | View | Annotate | Download (6.95 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
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

    
118
(* Reuse policy:
119
   - could reuse variables with the same type exactly only (simple).
120
   - reusing variables with different types would involve:
121
     - either dirty castings
122
     - or complex inclusion expression (for instance: array <-> array cell, struct <-> struct field) to be able to reuse only some parts of structured data.
123
     ... it seems too complex and potentially unsafe
124
   - for node instance calls: output variables could NOT reuse input variables, 
125
     even if inputs become dead, because the correctness would depend on the scheduling
126
     of the callee (so, the compiling strategy could NOT be modular anymore).
127
   - once a policy is set, we need to:
128
     - replace each variable by its reuse alias.
129
     - simplify resulting equations, as we may now have:
130
        x = x;                     --> ;           for scalar vars
131
       or:
132
        x = &{ f1 = x->f1; f2 = t; } --> x->f2 = t;   for struct vars
133
     - such simplifications are, until now, only expressible at the C source level...
134
 *)
135

    
136
(* Replaces [v] by [v'] in set [s] *)
137
let replace_in_set s v v' =
138
  if ISet.mem v s then ISet.add v' (ISet.remove v s) else s
139

    
140
(* Replaces [v] by [v'] in death table [death] *)
141
let replace_in_death_table death v v' =
142
 Hashtbl.iter (fun k dead -> Hashtbl.replace death k (replace_in_set dead v v')) death
143

    
144
let find_compatible_local node var dead =
145
 (*Format.eprintf "find_compatible_local %s %s@." node.node_id var;*)
146
  let typ = (Corelang.node_var var node).var_type in
147
  let eq_var = node_eq var node in
148
  let inputs =
149
    match NodeDep.get_callee eq_var.eq_rhs with
150
    | None           -> []
151
    | Some (_, args) -> List.fold_right (fun e r -> match e.expr_desc with Expr_ident id -> id::r | _ -> r) args [] in
152
  let filter v =
153
       ISet.mem v.var_id dead
154
    && Typing.eq_ground typ v.var_type
155
    && not (List.mem v.var_id inputs) in
156
  try
157
    Some ((List.find filter node.node_locals).var_id)
158
  with Not_found -> None
159

    
160
let reuse_policy node sort death =
161
  let dead = ref ISet.empty in
162
  let policy = Hashtbl.create 23 in
163
  let sort = ref sort in
164
  while !sort <> []
165
  do
166
    let head = List.hd !sort in
167
    if Hashtbl.mem death head then
168
      begin
169
	dead := ISet.union (Hashtbl.find death head) !dead;
170
      end;
171
    (match find_compatible_local node head !dead with
172
    | None   -> ()
173
    | Some l -> replace_in_death_table death head l; Hashtbl.add policy head l);
174
    sort := List.tl !sort;
175
  done;
176
  policy
177
 
178
let pp_reuse_policy fmt policy =
179
  begin
180
    Format.fprintf fmt "{ /* reuse policy */@.";
181
    Hashtbl.iter (fun s t -> Format.fprintf fmt "%s -> %s@." s t) policy;
182
    Format.fprintf fmt "}@."
183
  end
184
(* Local Variables: *)
185
(* compile-command:"make -C .." *)
186
(* End: *)