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


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

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

186

(* End: *)
