Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

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: *)