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 Graph

28

open Causality

29


30

(* Computes the last dependency

31

*)

32


33

(* Computes the death table of [node] wrt dep graph [g] and topological [sort].

34

The death table is a mapping: ident > Set(ident) such that:

35

death x is the set of local variables which get dead (i.e. unused)

36

after x is evaluated, but were until live.

37

let death_table node g sort =

38

let death = Hashtbl.create 23 in

39

let sort = ref (List.rev sort) in

40

let buried = ref ISet.empty in

41

begin

42

buried := ExprDep.node_memory_variables node;

43

buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_outputs;

44

(* We could also try to reuse input variables, due to C parameter copying semantics *)

45

buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_inputs;

46

while (!sort <> [])

47

do

48

let head = List.hd !sort in

49

let dead = IdentDepGraph.fold_succ

50

(fun tgt dead > if not (ExprDep.is_instance_var tgt  ISet.mem tgt !buried) then ISet.add tgt dead else dead)

51

g head ISet.empty in

52

buried := ISet.union !buried dead;

53

Hashtbl.add death head dead;

54

sort := List.tl !sort

55

done;

56

IdentDepGraph.clear g;

57

death

58

end

59

*)

60


61


62

(* computes the cone of influence of a given [var] wrt a dependency graph [g].

63

*)

64

let cone_of_influence g var =

65

(*Format.printf "coi: %s@." var;*)

66

let frontier = ref (ISet.add var ISet.empty) in

67

let coi = ref ISet.empty in

68

while not (ISet.is_empty !frontier)

69

do

70

let head = ISet.min_elt !frontier in

71

(*Format.printf "head: %s@." head;*)

72

frontier := ISet.remove head !frontier;

73

if ExprDep.is_read_var head then coi := ISet.add (ExprDep.undo_read_var head) !coi;

74

List.iter (fun s > frontier := ISet.add s !frontier) (IdentDepGraph.succ g head);

75

done;

76

!coi

77


78

let compute_unused n g =

79

let inputs = ExprDep.node_input_variables n in

80

let mems = ExprDep.node_memory_variables n in

81

let outputs = ExprDep.node_output_variables n in

82

ISet.fold

83

(fun var unused > ISet.diff unused (cone_of_influence g var))

84

(ISet.union outputs mems)

85

(ISet.union inputs mems)

86


87

(* Computes the set of (input and) output and mem variables of [node].

88

We try to reuse input variables, due to C parameter copying semantics. *)

89

let node_non_locals node =

90

List.fold_left (fun non_loc v > ISet.add v.var_id non_loc) (ExprDep.node_memory_variables node) node.node_outputs

91


92

(* Recursively removes useless local variables,

93

i.e. variables in [non_locals] that are current roots of the dep graph [g] *)

94

let remove_local_roots non_locals g =

95

let rem = ref true in

96

let roots = ref ISet.empty in

97

while !rem

98

do

99

rem := false;

100

let local_roots = List.filter (fun v > not (ISet.mem v non_locals)) (graph_roots g) in

101

if local_roots <> [] then

102

begin

103

rem := true;

104

List.iter (IdentDepGraph.remove_vertex g) local_roots;

105

roots := List.fold_left (fun roots v > if ExprDep.is_instance_var v then roots else ISet.add v roots) !roots local_roots

106

end

107

done;

108

!roots

109


110

(* Computes the death table of [node] wrt dep graph [g] and topological [sort].

111

The death table is a mapping: ident > Set(ident) such that:

112

death x is the set of local variables which get dead (i.e. unused)

113

before x is evaluated, but were until live.

114

If death x is not defined, then x is useless.

115

*)

116

let death_table node g sort =

117

let non_locals = node_non_locals node in

118

let death = Hashtbl.create 23 in

119

let sort = ref sort in

120

begin

121

while (!sort <> [])

122

do

123

let head = List.hd !sort in

124

(* If current var is not already dead, i.e. useless *)

125

if IdentDepGraph.mem_vertex g head then

126

begin

127

IdentDepGraph.iter_succ (IdentDepGraph.remove_edge g head) g head;

128

let dead = remove_local_roots non_locals g in

129

Hashtbl.add death head dead

130

end;

131

sort := List.tl !sort

132

done;

133

IdentDepGraph.clear g;

134

death

135

end

136


137

let pp_death_table fmt death =

138

begin

139

Format.fprintf fmt "{ /* death table */@.";

140

Hashtbl.iter (fun s t > Format.fprintf fmt "%s > { %a }@." s (Utils.fprintf_list ~sep:", " Format.pp_print_string) (ISet.elements t)) death;

141

Format.fprintf fmt "}@."

142

end

143


144


145

(* Reuse policy:

146

 could reuse variables with the same type exactly only (simple).

147

 reusing variables with different types would involve:

148

 either dirty castings

149

 or complex inclusion expression (for instance: array <> array cell, struct <> struct field) to be able to reuse only some parts of structured data.

150

... it seems too complex and potentially unsafe

151

 for node instance calls: output variables could NOT reuse input variables,

152

even if inputs become dead, because the correctness would depend on the scheduling

153

of the callee (so, the compiling strategy could NOT be modular anymore).

154

 once a policy is set, we need to:

155

 replace each variable by its reuse alias.

156

 simplify resulting equations, as we may now have:

157

x = x; > ; for scalar vars

158

or:

159

x = &{ f1 = x>f1; f2 = t; } > x>f2 = t; for struct vars

160

 such simplifications are, until now, only expressible at the C source level...

161

*)

162


163

(* Replaces [v] by [v'] in set [s] *)

164

let replace_in_set s v v' =

165

if ISet.mem v s then ISet.add v' (ISet.remove v s) else s

166


167

(* Replaces [v] by [v'] in death table [death] *)

168

let replace_in_death_table death v v' =

169

Hashtbl.iter (fun k dead > Hashtbl.replace death k (replace_in_set dead v v')) death

170


171

let find_compatible_local node var dead =

172

(*Format.eprintf "find_compatible_local %s %s@." node.node_id var;*)

173

let typ = (Corelang.node_var var node).var_type in

174

let eq_var = node_eq var node in

175

let inputs =

176

match NodeDep.get_callee eq_var.eq_rhs with

177

 None > []

178

 Some (_, args) > List.fold_right (fun e r > match e.expr_desc with Expr_ident id > id::r  _ > r) args [] in

179

let filter v =

180

ISet.mem v.var_id dead

181

&& Typing.eq_ground typ v.var_type

182

&& not (List.mem v.var_id inputs) in

183

try

184

Some ((List.find filter node.node_locals).var_id)

185

with Not_found > None

186


187

let reuse_policy node sort death =

188

let dead = ref ISet.empty in

189

let policy = Hashtbl.create 23 in

190

let sort = ref sort in

191

while !sort <> []

192

do

193

let head = List.hd !sort in

194

if Hashtbl.mem death head then

195

begin

196

dead := ISet.union (Hashtbl.find death head) !dead;

197

end;

198

(match find_compatible_local node head !dead with

199

 None > ()

200

 Some l > replace_in_death_table death head l; Hashtbl.add policy head l);

201

sort := List.tl !sort;

202

done;

203

policy

204


205

let pp_reuse_policy fmt policy =

206

begin

207

Format.fprintf fmt "{ /* reuse policy */@.";

208

Hashtbl.iter (fun s t > Format.fprintf fmt "%s > %s@." s t) policy;

209

Format.fprintf fmt "}@."

210

end

211

(* Local Variables: *)

212

(* compilecommand:"make C .." *)

213

(* End: *)
