ocarina-backends-asn1-deployment.adb 14.3 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--     O C A R I N A . B A C K E N D S . A S N 1 . D E P L O Y M E N T      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
--                   Copyright (C) 2010-2014 ESA & ISAE.                    --
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
--                                                                          --
-- Ocarina  is free software;  you  can  redistribute  it and/or  modify    --
-- it under terms of the GNU General Public License as published by the     --
-- Free Software Foundation; either version 2, or (at your option) any      --
-- later version. Ocarina is distributed  in  the  hope  that it will be    --
-- useful, but WITHOUT ANY WARRANTY;  without even the implied warranty of  --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details. You should have received  a copy of the --
-- GNU General Public License distributed with Ocarina; see file COPYING.   --
-- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02111-1301, USA.                                       --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable to be   --
-- covered  by the  GNU  General  Public  License. This exception does not  --
-- however invalidate  any other reasons why the executable file might be   --
-- covered by the GNU Public License.                                       --
--                                                                          --
jhugues's avatar
jhugues committed
29
30
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
31
32
33
--                                                                          --
------------------------------------------------------------------------------

34
with Ocarina.Namet; use Ocarina.Namet;
35
with Utils; use Utils;
36
37
38
39
40
with Ocarina.ME_AADL;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ocarina.ME_AADL.AADL_Instances.Entities;

41
with Ocarina.Backends.Utils;
42
43
with Ocarina.Backends.Properties;
with Ocarina.Backends.ASN1_Values;
julien.delange's avatar
julien.delange committed
44
with Ocarina.Backends.ASN1_Tree.Nutils;
45
with Ocarina.Backends.ASN1_Tree.Nodes;
julien.delange's avatar
julien.delange committed
46

47
48
49
50
51
52
package body Ocarina.Backends.ASN1.Deployment is

   use Ocarina.ME_AADL;
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
   use Ocarina.ME_AADL.AADL_Instances.Entities;

53
   use Ocarina.Backends.Utils;
54
   use Ocarina.Backends.Properties;
julien.delange's avatar
julien.delange committed
55
56
   use Ocarina.Backends.ASN1_Tree.Nutils;

57
   package ASN1V renames Ocarina.Backends.ASN1_Values;
58
   package ASN1N renames Ocarina.Backends.ASN1_Tree.Nodes;
59
   package ASN1U renames Ocarina.Backends.ASN1_Tree.Nutils;
60
61
62
63
64
65
66
67
68
69
   package AAU renames Ocarina.ME_AADL.AADL_Instances.Nutils;

   procedure Visit_Architecture_Instance (E : Node_Id);
   procedure Visit_Component_Instance (E : Node_Id);
   procedure Visit_System_Instance (E : Node_Id);
   procedure Visit_Process_Instance (E : Node_Id);
   procedure Visit_Device_Instance (E : Node_Id);
   procedure Visit_Thread_Instance (E : Node_Id);
   procedure Visit_Subprogram_Instance (E : Node_Id);

70
   Thread_Enumeration : List_Id;
julien.delange's avatar
julien.delange committed
71
72
73
74
   --   The Thread_Enumeration list contains the identifiers
   --   and the associated identifier value for each thread
   --   within the distributed system.

75
   Thread_Id : Unsigned_Long_Long := 0;
julien.delange's avatar
julien.delange committed
76
77
78
   --  The thread identifier, unique for each thread in the
   --  DISTRIBUTED system.

79
   Port_Enumeration : List_Id;
julien.delange's avatar
julien.delange committed
80
81
82
83
   --  The Port_Enumeration list contains the enumeration of all
   --  ports used in the distributed system. In fact, we add each
   --  port in an enumeration and associate a value to them.

84
85
86
87
88
89
   Packet_Type : Node_Id;
   --  The Packet_Type node contains the definition of a packet
   --  sent by a node. It consists of a sender-thread/port id, the
   --  receiver thread/port id, and a message that is expressed
   --  using an ASN1 CHOICE.

90
   Port_Id : Unsigned_Long_Long := 0;
julien.delange's avatar
julien.delange committed
91
92
   --  The port identifier. This is unique for each port.

93
94
   Msg_Choices : List_Id;

95
96
   Module_Node : Node_Id;

97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
   -----------
   -- Visit --
   -----------

   procedure Visit (E : Node_Id) is
   begin
      case Kind (E) is
         when K_Architecture_Instance =>
            Visit_Architecture_Instance (E);

         when K_Component_Instance =>
            Visit_Component_Instance (E);

         when others =>
            null;
      end case;
   end Visit;

   ---------------------------------
   -- Visit_Architecture_Instance --
   ---------------------------------

   procedure Visit_Architecture_Instance (E : Node_Id) is
   begin
121
122
123
      ASN1_Root :=
        Make_ASN1_File
          (Make_Defining_Identifier (Get_String_Name ("asn1_deployment")));
124
      ASN1N.Set_Name
125
        (ASN1N.Module_Node (ASN1_Root),
126
127
128
         Get_String_Name ("POHIC-DEPLOYMENT"));
      Module_Node := ASN1N.Module_Node (ASN1_Root);

129
130
131
      Thread_Enumeration := New_List (ASN1N.K_Enumerated_Value_List);
      Port_Enumeration   := New_List (ASN1N.K_Enumerated_Value_List);
      Msg_Choices        := New_List (ASN1N.K_Enumerated_Value_List);
132

133
      Visit (Root_System (E));
134
135
136

      if Length (Thread_Enumeration) > 0 then
         Append_Node_To_List
137
138
139
140
           (Make_Type_Definition
              (Get_String_Name ("Thread-id"),
               Make_Enumerated (Thread_Enumeration)),
            ASN1N.Definitions (Module_Node));
141
142
143
144
      end if;

      if Length (Thread_Enumeration) > 0 then
         Append_Node_To_List
145
146
147
148
           (Make_Type_Definition
              (Get_String_Name ("Port-id"),
               Make_Enumerated (Port_Enumeration)),
            ASN1N.Definitions (Module_Node));
149
150
      end if;

151
152
153
154
      declare
         Pkt_Contents : constant List_Id := ASN1U.New_List (ASN1N.K_List_Id);
      begin
         Append_Node_To_List
155
156
157
158
           (Make_Sequence_Member
              (Get_String_Name ("sender-thread"),
               Make_Defining_Identifier (Get_String_Name ("Thread-id"))),
            Pkt_Contents);
159
160

         Append_Node_To_List
161
162
163
164
           (Make_Sequence_Member
              (Get_String_Name ("sender-port"),
               Make_Defining_Identifier (Get_String_Name ("Port-id"))),
            Pkt_Contents);
165
166

         Append_Node_To_List
167
168
169
170
           (Make_Sequence_Member
              (Get_String_Name ("receiver-thread"),
               Make_Defining_Identifier (Get_String_Name ("Thread-id"))),
            Pkt_Contents);
171
172

         Append_Node_To_List
173
174
175
176
           (Make_Sequence_Member
              (Get_String_Name ("receiver-port"),
               Make_Defining_Identifier (Get_String_Name ("Port-id"))),
            Pkt_Contents);
177
178

         Append_Node_To_List
179
180
           (Make_Sequence_Member
              (Get_String_Name ("msg"),
181
               Make_Choice (Msg_Choices)),
182
            Pkt_Contents);
183
184

         Packet_Type :=
185
186
187
188
           Make_Type_Definition
             (Get_String_Name ("Pkt"),
              Make_Sequence (Pkt_Contents));
         Append_Node_To_List (Packet_Type, ASN1N.Definitions (Module_Node));
189
190
      end;

191
192
193
194
195
196
197
   end Visit_Architecture_Instance;

   ------------------------------
   -- Visit_Component_Instance --
   ------------------------------

   procedure Visit_Component_Instance (E : Node_Id) is
198
      Category : constant Component_Category := Get_Category_Of_Component (E);
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
   begin
      case Category is
         when CC_System =>
            Visit_System_Instance (E);

         when CC_Process =>
            Visit_Process_Instance (E);

         when CC_Thread =>
            Visit_Thread_Instance (E);

         when CC_Device =>
            Visit_Device_Instance (E);

         when CC_Subprogram =>
            Visit_Subprogram_Instance (E);

         when others =>
            null;
      end case;
   end Visit_Component_Instance;

   ----------------------------
   -- Visit_Process_Instance --
   ----------------------------

   procedure Visit_Process_Instance (E : Node_Id) is
226
      S : Node_Id;
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
   begin
      if not AAU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
            --  Visit the component instance corresponding to the
            --  subcomponent S.

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;
   end Visit_Process_Instance;

   ---------------------------
   -- Visit_System_Instance --
   ---------------------------

   procedure Visit_System_Instance (E : Node_Id) is
      S : Node_Id;
   begin
      --  Visit all the subcomponents of the system

      if not AAU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
            --  Visit the component instance corresponding to the
            --  subcomponent S.

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;
   end Visit_System_Instance;

   ---------------------------
   -- Visit_Thread_Instance --
   ---------------------------

   procedure Visit_Thread_Instance (E : Node_Id) is
266
267
268
269
270
271
272
      S           : Node_Id;
      F           : Node_Id;
      Call_Seq    : Node_Id;
      Spg_Call    : Node_Id;
      Thread_Name : Name_Id;
      Port_Name   : Name_Id;
      Parent_Name : Name_Id;
julien.delange's avatar
julien.delange committed
273
      --  Name of the containing process.
274
275
      Msg_Choice      : Node_Id;
      Msg_Name        : Name_Id;
276
      Msg_Constraints : Node_Id;
277
   begin
278
279

      Set_Str_To_Name_Buffer ("thread-");
280
281
282
283
284
      Parent_Name :=
        Display_Name
          (Identifier
             (Parent_Subcomponent
                (Parent_Component (Parent_Subcomponent (E)))));
285
286
287
      Get_Name_String_And_Append (Parent_Name);
      Add_Str_To_Name_Buffer ("-");
      Get_Name_String_And_Append
288
        (Display_Name (Identifier (Parent_Subcomponent (E))));
289
290
      Thread_Name := Name_Find;

291
      Thread_Name := To_Lower (Thread_Name);
292

julien.delange's avatar
julien.delange committed
293
294
295
296
      Thread_Name := Replace_Char (Thread_Name, '_', '-');
      --  We replace _ by - because ASN1 does not allow
      --  character _.

297
      Append_Node_To_List
298
        (Make_Enumerated_Value (Thread_Name, Thread_Id),
299
300
301
302
         Thread_Enumeration);

      Thread_Id := Thread_Id + 1;

julien.delange's avatar
julien.delange committed
303
304
305
306
307
308
      --  Here, we build the ASN1 name of the thread and add it to the
      --  Thread_Enumeration list that contains all threads of the
      --  distributed system. When we discover a thread, we increment
      --  the thread identifier so that we have a unique identifier
      --  for each thread.

309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
      if not AAU.Is_Empty (Subcomponents (E)) then
         S := First_Node (Subcomponents (E));
         while Present (S) loop
            --  Visit the component instance corresponding to the
            --  subcomponent S.

            Visit (Corresponding_Instance (S));
            S := Next_Node (S);
         end loop;
      end if;

      if not AAU.Is_Empty (Calls (E)) then
         Call_Seq := First_Node (Calls (E));

         while Present (Call_Seq) loop
            --  For each call sequence visit all the called
            --  subprograms.

            if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then
               Spg_Call := First_Node (Subprogram_Calls (Call_Seq));

               while Present (Spg_Call) loop
                  Visit (Corresponding_Instance (Spg_Call));

                  Spg_Call := Next_Node (Spg_Call);
               end loop;
            end if;

            Call_Seq := Next_Node (Call_Seq);
         end loop;
      end if;

341
342
343
344
      if Has_Ports (E) then
         F := First_Node (Features (E));

         while Present (F) loop
345
            if Kind (F) = K_Port_Spec_Instance and then Is_Data (F) then
346
347
348
               Set_Str_To_Name_Buffer ("port-");
               Get_Name_String_And_Append (Thread_Name);
               Add_Str_To_Name_Buffer ("-");
349
               Get_Name_String_And_Append (Display_Name (Identifier (F)));
350
               Port_Name := Name_Find;
351
               Port_Name := To_Lower (Port_Name);
352

353
               Port_Name := Replace_Char (Port_Name, '_', '-');
julien.delange's avatar
julien.delange committed
354
355
               --  We replace _ by - because ASN1 does not allow
               --  character _.
356

357
               Append_Node_To_List
358
359
                 (Make_Enumerated_Value (Port_Name, Port_Id),
                  Port_Enumeration);
360
361

               Port_Id := Port_Id + 1;
julien.delange's avatar
julien.delange committed
362
363
364
365
               --  Here, we build the port identifier (we increment it)
               --  each time a port is discovered in a thread and add
               --  it to the Port_Enumeration list that contains all
               --  port identifiers.
366

367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
               Msg_Name        := Port_Name;
               Msg_Constraints :=
                 Make_Type_Constraints
                   (Size_Down => ASN1V.New_Int_Value (0, 1, 10),
                    Size_Up   =>
                      ASN1V.New_Int_Value
                        (To_Bytes (Get_Data_Size (Corresponding_Instance (F))),
                         1,
                         10));
               Msg_Choice :=
                 Make_Choice_Member
                   (Msg_Name,
                    Make_Type_Designator
                      (Type_Name =>
                         Make_Defining_Identifier
382
                           (Get_String_Name ("OCTET STRING")),
383
                       Type_Constraints => Msg_Constraints));
384
385
386

               Append_Node_To_List (Msg_Choice, Msg_Choices);

387
388
389
390
            end if;
            F := Next_Node (F);
         end loop;
      end if;
391
392
393
394
395
396
397
398
399
400
401
402
   end Visit_Thread_Instance;

   -------------------------------
   -- Visit_Subprogram_Instance --
   -------------------------------

   procedure Visit_Subprogram_Instance (E : Node_Id) is
      pragma Unreferenced (E);
   begin
      null;
   end Visit_Subprogram_Instance;

403
404
405
   ---------------------------
   -- Visit_Device_Instance --
   ---------------------------
406
407
408
409
410
411
412
413

   procedure Visit_Device_Instance (E : Node_Id) is
      pragma Unreferenced (E);
   begin
      null;
   end Visit_Device_Instance;

end Ocarina.Backends.ASN1.Deployment;