## lustrec / src / com_protocol.ml @ 22fe1c93

History | View | Annotate | Download (6.41 KB)

1 |
(* ---------------------------------------------------------------------------- |
---|---|

2 |
* SchedMCore - A MultiCore Scheduling Framework |

3 |
* Copyright (C) 2009-2011, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE |

4 |
* |

5 |
* This file is part of Prelude |

6 |
* |

7 |
* Prelude is free software; you can redistribute it and/or |

8 |
* modify it under the terms of the GNU Lesser General Public License |

9 |
* as published by the Free Software Foundation ; either version 2 of |

10 |
* the License, or (at your option) any later version. |

11 |
* |

12 |
* Prelude is distributed in the hope that it will be useful, but |

13 |
* WITHOUT ANY WARRANTY ; without even the implied warranty of |

14 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |

15 |
* Lesser General Public License for more details. |

16 |
* |

17 |
* You should have received a copy of the GNU Lesser General Public |

18 |
* License along with this program ; if not, write to the Free Software |

19 |
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 |

20 |
* USA |

21 |
*---------------------------------------------------------------------------- *) |

22 | |

23 |
(** Compute the communication protocols of a task graph. *) |

24 | |

25 |
open Deadlines |

26 |
open Precedence_functions |

27 |
open Corelang |

28 |
open Task_graph |

29 |
open Task_set |

30 |
open Format |

31 | |

32 |
(* Number of times instance [n] is consumed *) |

33 |
let conso_ops ops n = |

34 |
(gops ops (n+1)) - (gops ops n) |

35 | |

36 |
(* Lifespan of instance [n] *) |

37 |
let lifespan ti ops tj n = |

38 |
let span_start = abs_release ti n in |

39 |
if (conso_ops ops n) =0 then |

40 |
(span_start,span_start) |

41 |
else |

42 |
let first_conso_release = abs_release tj (gops ops n) in |

43 |
let span_end = first_conso_release + (conso_ops ops n) * tj.task_period in |

44 |
(span_start,span_end) |

45 | |

46 |
(* The number of cells of the buffer *) |

47 |
let nb_cells ti ops tj = |

48 |
let total_length = (pref_size ops) + (periodicity ops) in |

49 |
let max_intersects = ref 0 in |

50 |
for k = 0 to total_length -1 do |

51 |
let (sp_start,sp_end) = lifespan ti ops tj k in |

52 |
let sp_size = sp_end - sp_start in |

53 |
(* the following is an overapproximation *) |

54 |
let approx_intersect = |

55 |
int_of_float (ceil ((float_of_int sp_size) /. (float_of_int ti.task_period))) |

56 |
in |

57 |
if approx_intersect > !max_intersects then |

58 |
max_intersects := approx_intersect |

59 |
done; |

60 |
if contains_init ops then |

61 |
!max_intersects + 1 |

62 |
else |

63 |
!max_intersects |

64 | |

65 |
(* Pattern that the writer must follow. *) |

66 |
let write_pattern ti ops tj = |

67 |
let write_pref = Array.make (pref_size ops) true in |

68 |
for k = 0 to (pref_size ops) -1 do |

69 |
if (conso_ops ops k) >= 1 then |

70 |
write_pref.(k) <- true |

71 |
else |

72 |
write_pref.(k) <- false |

73 |
done; |

74 |
let write_pat = Array.make (periodicity ops) true in |

75 |
for k = 0 to (periodicity ops) -1 do |

76 |
if (conso_ops ops (k+(pref_size ops))) >= 1 then |

77 |
write_pat.(k) <- true |

78 |
else |

79 |
write_pat.(k) <- false |

80 |
done; |

81 |
write_pref,write_pat |

82 | |

83 |
(* Pattern that the reader must follow *) |

84 |
let read_pattern ti ops tj = |

85 |
(* TODO: concat operator ! *) |

86 |
let read_pattern_pref = ref [] in |

87 |
if (gops ops 0) > 0 then (* First reads the init of the fby/concat *) |

88 |
begin |

89 |
for k=0 to (gops ops 0)-2 do |

90 |
read_pattern_pref := false::!read_pattern_pref |

91 |
done; |

92 |
read_pattern_pref := true::!read_pattern_pref |

93 |
end; |

94 |
for k = 0 to (pref_size ops) - 1 do |

95 |
let dep_ij_k = (conso_ops ops k) in |

96 |
if dep_ij_k >= 1 then |

97 |
begin |

98 |
for k'=0 to dep_ij_k -2 do |

99 |
read_pattern_pref := false::!read_pattern_pref |

100 |
done; |

101 |
read_pattern_pref := true::!read_pattern_pref |

102 |
end |

103 |
done; |

104 |
let read_pattern_pat = ref [] in |

105 |
for k = 0 to (periodicity ops) - 1 do |

106 |
let dep_ij_k = (conso_ops ops (k+(pref_size ops))) in |

107 |
if dep_ij_k >= 1 then |

108 |
begin |

109 |
for k'=0 to dep_ij_k -2 do |

110 |
read_pattern_pat := false::!read_pattern_pat |

111 |
done; |

112 |
read_pattern_pat := true::!read_pattern_pat |

113 |
end |

114 |
done; |

115 |
(Array.of_list (List.rev !read_pattern_pref), |

116 |
Array.of_list (List.rev !read_pattern_pat)) |

117 | |

118 |
let vertex_of_vdecl t vdecl = |

119 |
match t.task_kind with |

120 |
| StdTask -> NodeVar (vdecl.var_id, t.task_id) |

121 |
| Sensor | Actuator -> Var vdecl.var_id |

122 | |

123 |
(* Returns the initial value of a precedence annotation (if any). Assumes the |

124 |
same init value is used for each fby/concat in annots *) |

125 |
let rec init_of_annots annots = |

126 |
match annots with |

127 |
| [] -> None |

128 |
| (Gfby cst)::_ -> Some cst |

129 |
| (Gconcat cst)::_ -> Some cst |

130 |
| _::rest -> init_of_annots rest |

131 | |

132 |
(* Computes the communication protocol of a task output *) |

133 |
let proto_output g task_set t vout = |

134 |
let vertex_out_id = vertex_of_vdecl t vout in |

135 |
let vertex_out = Hashtbl.find g.graph vertex_out_id in |

136 |
let succs = vertex_out.vertex_succs in |

137 |
Hashtbl.fold |

138 |
(fun succ_id annot protos -> |

139 |
let task_from = task_of_vertex task_set vertex_out_id in |

140 |
let task_to = task_of_vertex task_set succ_id in |

141 |
let bsize = nb_cells task_from annot task_to in |

142 |
let pref,pat = write_pattern task_from annot task_to in |

143 |
let init = init_of_annots annot in |

144 |
let proto = {wbuf_size = bsize; |

145 |
write_pref = pref; |

146 |
write_pat = pat; |

147 |
wbuf_init = init} in |

148 |
let succ_ref = vref_of_vertex_id succ_id in |

149 |
(succ_ref,proto)::protos) |

150 |
succs [] |

151 | |

152 |
(* Computes the communication protocol of a task input *) |

153 |
let proto_input g task_set t vin = |

154 |
let vertex_in_id = vertex_of_vdecl t vin in |

155 |
let vertex_in = Hashtbl.find g.graph vertex_in_id in |

156 |
let pred = vertex_in.vertex_pred in |

157 |
match pred with |

158 |
| None -> failwith "internal error" |

159 |
| Some (vpred,annot) -> |

160 |
let task_from = task_of_vertex task_set vpred in |

161 |
let task_to = task_of_vertex task_set vertex_in_id in |

162 |
let bsize = nb_cells task_from annot task_to in |

163 |
let pref,pat = read_pattern task_from annot task_to in |

164 |
let init = init_of_annots annot in |

165 |
let proto = {rbuf_size = bsize; |

166 |
change_pref = pref; |

167 |
change_pat = pat; |

168 |
rbuf_init = init} in |

169 |
let pred_ref = vref_of_vertex_id vpred in |

170 |
pred_ref, proto |

171 | |

172 |
(* Computes the communication protocols for each variable of a task *) |

173 |
let proto_task g task_set t = |

174 |
t.task_inputs <- |

175 |
List.map (fun (vdecl,_,_) -> |

176 |
let pred, proto = proto_input g task_set t vdecl in |

177 |
(vdecl, pred, proto)) t.task_inputs; |

178 |
t.task_outputs <- |

179 |
List.map (fun (vdecl,_) -> (vdecl,proto_output g task_set t vdecl)) t.task_outputs |

180 | |

181 |
(* Computes all the communication protocols of the task set *) |

182 |
let proto_prog g task_set = |

183 |
Hashtbl.iter (fun _ t -> proto_task g task_set t) task_set |

184 | |

185 |
(* Local Variables: *) |

186 |
(* compile-command:"make -C .." *) |

187 |
(* End: *) |