Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ b1a97ade

History | View | Annotate | Download (6.95 KB)

1 695d6f2f xthirioux
(* ----------------------------------------------------------------------------
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 a5784e75 xthirioux
   If death x is not defined, then x is useless.
88 695d6f2f xthirioux
*)
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 a5784e75 xthirioux
      (* If current var is not already dead, i.e. useless *)
98
      if IdentDepGraph.mem_vertex g head then
99 695d6f2f xthirioux
	begin
100
	  IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g head) g head;
101 a5784e75 xthirioux
	  let dead = remove_local_roots non_locals g in
102
	  Hashtbl.add death head dead
103
	end;
104 695d6f2f xthirioux
      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 7afcba5a xthirioux
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 695d6f2f xthirioux
(* 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 a5784e75 xthirioux
 Hashtbl.iter (fun k dead -> Hashtbl.replace death k (replace_in_set dead v v')) death
143 695d6f2f xthirioux
144
let find_compatible_local node var dead =
145 7afcba5a xthirioux
 (*Format.eprintf "find_compatible_local %s %s@." node.node_id var;*)
146 695d6f2f xthirioux
  let typ = (Corelang.node_var var node).var_type in
147 7afcba5a xthirioux
  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 695d6f2f xthirioux
  try
157 7afcba5a xthirioux
    Some ((List.find filter node.node_locals).var_id)
158 695d6f2f xthirioux
  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 a5784e75 xthirioux
    if Hashtbl.mem death head then
168
      begin
169
	dead := ISet.union (Hashtbl.find death head) !dead;
170
      end;
171 695d6f2f xthirioux
    (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: *)