Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / liveness.ml @ 3c48346d

History | View | Annotate | Download (5.65 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
(* 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
(* compile-command:"make -C .." *)
158
(* End: *)