OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--                  OCARINA.BACKENDS.PO_HI_ADA.DEPLOYMENT                   --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--               Copyright (C) 2006-2009 Telecom ParisTech,                 --
10
--                 2010-2019 ESA & ISAE, 2019-2020 OpenAADL                 --
11
--                                                                          --
12
-- Ocarina  is free software; you can redistribute it and/or modify under   --
13
-- terms of the  GNU General Public License as published  by the Free Soft- --
14
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
16
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
17
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
--                    Ocarina is maintained by OpenAADL team                --
29
--                              (info@openaadl.org)                         --
30
--                                                                          --
31
------------------------------------------------------------------------------
32

33
with Ocarina.Namet;
34

35
with Ocarina.ME_AADL;
36
with Ocarina.ME_AADL.AADL_Instances.Nodes;
37
with Ocarina.ME_AADL.AADL_Instances.Nutils;
38
with Ocarina.ME_AADL.AADL_Instances.Entities;
39

40
with Ocarina.Backends.Utils;
41
with Ocarina.Backends.Messages;
42
with Ocarina.Backends.Properties;
43
with Ocarina.Backends.Ada_Values;
44
with Ocarina.Backends.Ada_Tree.Nutils;
45
with Ocarina.Backends.Ada_Tree.Nodes;
46
with Ocarina.Backends.PO_HI_Ada.Mapping;
47
with Ocarina.Backends.PO_HI_Ada.Runtime;
48

49 1
package body Ocarina.Backends.PO_HI_Ada.Deployment is
50

51
   use Ocarina.Namet;
52
   use Ocarina.ME_AADL;
53
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
54
   use Ocarina.ME_AADL.AADL_Instances.Entities;
55
   use Ocarina.Backends.Utils;
56
   use Ocarina.Backends.Messages;
57
   use Ocarina.Backends.Properties;
58
   use Ocarina.Backends.Ada_Values;
59
   use Ocarina.Backends.Ada_Tree.Nutils;
60
   use Ocarina.Backends.PO_HI_Ada.Mapping;
61
   use Ocarina.Backends.PO_HI_Ada.Runtime;
62

63
   package AAN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
64
   package AAU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
65
   package ADN renames Ocarina.Backends.Ada_Tree.Nodes;
66

67
   ------------------
68
   -- Package_Spec --
69
   ------------------
70

71
   package body Package_Spec is
72
      procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
73

74
      procedure Visit_Architecture_Instance (E : Node_Id);
75
      procedure Visit_Component_Instance (E : Node_Id);
76
      procedure Visit_System_Instance (E : Node_Id);
77
      procedure Visit_Process_Instance (E : Node_Id);
78
      procedure Visit_Thread_Instance (E : Node_Id);
79
      procedure Visit_Data_Instance (E : Node_Id);
80
      procedure Visit_Device_Instance (E : Node_Id);
81

82
      Last_Node_Enum_Pos   : Nat := 1;
83
      Last_Thread_Enum_Pos : Nat := 1;
84
      Last_Port_Enum_Pos   : Nat := 1;
85
      --  Global variables for the representation clauses of the
86
      --  generated enumerator types. They point to the next free
87
      --  position in the corresponding enumeration type. We start by
88
      --  1 because 0 is the value to indicate that no position has
89
      --  been assigned to the enumerator yet.
90

91
      function Get_Node_Enum_Pos (Name : Name_Id) return Nat;
92
      function Get_Thread_Enum_Pos (Name : Name_Id) return Nat;
93
      function Get_Port_Enum_Pos (Name : Name_Id) return Nat;
94
      --  Return the position corresponding to the enumerator. If no
95
      --  position has been computed for the given enumerator, compute
96
      --  a new one.
97

98
      function Added_Internal_Name (P : Node_Id; E : Node_Id) return Name_Id;
99
      function Is_Added (P : Node_Id; E : Node_Id) return Boolean;
100
      procedure Set_Added (P : Node_Id; E : Node_Id);
101
      --  Used to ensure that the enumerator for Process P and all the
102
      --  enumerator corresponding to its threads are added only once
103
      --  to the deployment package of node E.
104

105
      type Get_Enum_Pos_Access is access function (Name : Name_Id) return Nat;
106
      procedure Insert_Node_In_List
107
        (N            : Node_Id;
108
         L            : List_Id;
109
         Get_Enum_Pos : Get_Enum_Pos_Access);
110
      --  Insert the node N into list L. N is assumed to be an
111
      --  enumerator or an element association relative to an
112
      --  enumerator. The insertion is done so that the positions of
113
      --  all the enumerators in the list are ordered
114
      --  incresingly. This is necessary in Ada since the enumerator
115
      --  position order must respect their declaration order.
116

117
      function Max_Payload_Size_Declaration (E : Node_Id) return Node_Id;
118
      --  Builds the Max_Payload_Size constant declaration
119
      --  corresponding to node E.
120

121 1
      Max_Payload    : Unsigned_Long_Long;
122
      Max_Payload_Of : Name_Id := No_Name;
123
      --  Value of Max_Payload_Size
124

125
      function Max_Node_Image_Size_Declaration (E : Node_Id) return Node_Id;
126
      --  Builds the Max_Node_Image_Size constant declaration
127
      --  corresponding to node E.
128

129
      Max_Node_Image_Size : Unsigned_Long_Long := 1;
130
      --  Value of Max_Node_Image_Size
131

132
      function Max_Entity_Image_Size_Declaration (E : Node_Id) return Node_Id;
133
      --  Builds the Max_Entity_Image_Size constant declaration
134
      --  corresponding to node E.
135

136
      Max_Entity_Image_Size : Unsigned_Long_Long := 1;
137
      --  Value of Max_Entity_Image_Size
138

139
      function Max_Port_Image_Size_Declaration (E : Node_Id) return Node_Id;
140
      --  Builds the Max_Port_Image_Size constant declaration
141
      --  corresponding to node E.
142

143
      Max_Port_Image_Size : Unsigned_Long_Long := 1;
144
      --  Value of Max_Port_Image_Size
145

146
      ------------------
147
      -- Global Lists --
148
      ------------------
149

150
      --  The lists below are global and initialized at the beginning
151
      --  of visit of each process instance. This does not cause a
152
      --  consistency nor a concurrency problem since the visits of
153
      --  processes are done sequentially and the visit of one process
154
      --  is performed entirely before beginning the visit of another
155
      --  one.
156

157 1
      Node_Enumerator_List : List_Id;
158
      --  Global list for all the distributed application nodes
159
      --  enumeration type.
160

161 1
      Node_Enumerator_Pos_List : List_Id;
162
      --  Global list to store the representation clause of the node
163
      --  enumeration type.
164

165 1
      Node_Image_List : List_Id;
166
      --  Global list that associates each node of the distributed
167
      --  application to its String image.
168

169 1
      Thread_Enumerator_List : List_Id;
170
      --  Global list for all the distributed application threads
171
      --  enumeration types.
172

173 1
      Thread_Enumerator_Pos_List : List_Id;
174
      --  Global list to store the representation clause of the thread
175
      --  enumeration type.
176

177 1
      Entity_Table_List : List_Id;
178
      --  Global list that associates each thread of the distributed
179
      --  application to its containing process. Concretly, this is a
180
      --  list of associations that contain for each enumerator of the
181
      --  Entity_Type type the corresponding enumerator of the
182
      --  Node_Type type.
183

184 1
      Entity_Image_List : List_Id;
185
      --  Global list that associates each thread of the distributed
186
      --  application to its String image.
187

188 1
      Port_Enumerator_List : List_Id;
189
      --  Global list for all the distributed application thread port
190
      --  enumeration types.
191

192 1
      Port_Enumerator_Pos_List : List_Id;
193
      --  Global list to store the representation clause of the thread
194
      --  port enumeration type.
195

196 1
      Port_Table_List : List_Id;
197
      --  Global list that associates each port of the distributed
198
      --  application to its containing thread. Concretly, this is a
199
      --  list of associations that contain for each enumerator of the
200
      --  Port_Type type the corresponding enumerator of the
201
      --  Entity_Type type.
202

203 1
      Port_Image_List : List_Id;
204
      --  Global list that associates each port of the distributed
205
      --  application to its image.
206

207
      -----------------------
208
      -- Get_Node_Enum_Pos --
209
      -----------------------
210

211 1
      function Get_Node_Enum_Pos (Name : Name_Id) return Nat is
212 1
         I_Name   : Name_Id;
213 1
         Position : Nat;
214
      begin
215 1
         Set_Str_To_Name_Buffer ("%node_enum_pos%");
216 1
         Get_Name_String (Name);
217 1
         I_Name := Name_Find;
218

219
         --  Check whether a value has been computed for the current
220
         --  enumerator. Otherwise, compute a new one.
221

222 1
         Position := Get_Name_Table_Info (I_Name);
223

224 1
         if Position = 0 then
225
            --  Get the next free position
226

227 1
            Position := Last_Node_Enum_Pos;
228

229
            --  Link it to the enumerator for future use
230

231 1
            Set_Name_Table_Info (I_Name, Position);
232

233
            --  Increment the next free position
234

235 1
            Last_Node_Enum_Pos := Last_Node_Enum_Pos + 1;
236
         end if;
237

238 1
         return Position;
239
      end Get_Node_Enum_Pos;
240

241
      -------------------------
242
      -- Get_Thread_Enum_Pos --
243
      -------------------------
244

245 1
      function Get_Thread_Enum_Pos (Name : Name_Id) return Nat is
246 1
         I_Name   : Name_Id;
247 1
         Position : Nat;
248
      begin
249 1
         Set_Str_To_Name_Buffer ("%thread_enum_pos%");
250 1
         Get_Name_String (Name);
251 1
         I_Name := Name_Find;
252

253
         --  Check whether a value has been computed for the current
254
         --  enumerator. Otherwise, compute a new one.
255

256 1
         Position := Get_Name_Table_Info (I_Name);
257

258 1
         if Position = 0 then
259
            --  Get the next free position
260

261 1
            Position := Last_Thread_Enum_Pos;
262

263
            --  Link it to the enumerator for future use
264

265 1
            Set_Name_Table_Info (I_Name, Position);
266

267
            --  Increment the next free position
268

269 1
            Last_Thread_Enum_Pos := Last_Thread_Enum_Pos + 1;
270
         end if;
271

272 1
         return Position;
273
      end Get_Thread_Enum_Pos;
274

275
      -----------------------
276
      -- Get_Port_Enum_Pos --
277
      -----------------------
278

279 1
      function Get_Port_Enum_Pos (Name : Name_Id) return Nat is
280 1
         I_Name   : Name_Id;
281 1
         Position : Nat;
282
      begin
283 1
         Set_Str_To_Name_Buffer ("%port_enum_pos%");
284 1
         Get_Name_String (Name);
285 1
         I_Name := Name_Find;
286

287
         --  Check whether a value has been computed for the current
288
         --  enumerator. Otherwise, compute a new one.
289

290 1
         Position := Get_Name_Table_Info (I_Name);
291

292 1
         if Position = 0 then
293
            --  Get the next free position
294

295 1
            Position := Last_Port_Enum_Pos;
296

297
            --  Link it to the enumerator for future use
298

299 1
            Set_Name_Table_Info (I_Name, Position);
300

301
            --  Increment the next free position
302

303 1
            Last_Port_Enum_Pos := Last_Port_Enum_Pos + 1;
304
         end if;
305

306 1
         return Position;
307
      end Get_Port_Enum_Pos;
308

309
      -------------------------
310
      -- Added_Internal_Name --
311
      -------------------------
312

313 1
      function Added_Internal_Name (P : Node_Id; E : Node_Id) return Name_Id is
314
      begin
315 1
         Set_Str_To_Name_Buffer ("%add%enumerator%");
316 1
         Add_Nat_To_Name_Buffer (Nat (P));
317 1
         Add_Char_To_Name_Buffer ('%');
318 1
         Add_Nat_To_Name_Buffer (Nat (E));
319

320 1
         return Name_Find;
321
      end Added_Internal_Name;
322

323
      --------------
324
      -- Is_Added --
325
      --------------
326

327 1
      function Is_Added (P : Node_Id; E : Node_Id) return Boolean is
328 1
         I_Name : constant Name_Id := Added_Internal_Name (P, E);
329
      begin
330 1
         return Get_Name_Table_Byte (I_Name) = 1;
331
      end Is_Added;
332

333
      ---------------
334
      -- Set_Added --
335
      ---------------
336

337 1
      procedure Set_Added (P : Node_Id; E : Node_Id) is
338 1
         I_Name : constant Name_Id := Added_Internal_Name (P, E);
339
      begin
340 1
         Set_Name_Table_Byte (I_Name, 1);
341 1
      end Set_Added;
342

343
      -------------------------
344
      -- Insert_Node_In_List --
345
      -------------------------
346

347 1
      procedure Insert_Node_In_List
348
        (N            : Node_Id;
349
         L            : List_Id;
350
         Get_Enum_Pos : Get_Enum_Pos_Access)
351
      is
352
         use ADN;
353

354 1
         M          : Node_Id;
355 1
         Position_N : Nat;
356 1
         Position_M : Nat;
357
      begin
358
         pragma Assert
359 1
           (Kind (N) = K_Defining_Identifier
360 1
            or else Kind (N) = K_Element_Association);
361

362 1
         case ADN.Kind (N) is
363 1
            when ADN.K_Defining_Identifier =>
364 1
               Position_N := Get_Enum_Pos (ADN.Name (N));
365 1
            when ADN.K_Element_Association =>
366 1
               Position_N := Get_Enum_Pos (ADN.Name (Index (N)));
367 0
            when others =>
368 0
               raise Program_Error with "Inconsistency in Insert_Node_In_List";
369 1
         end case;
370

371 1
         if Is_Empty (L) then
372 1
            Append_Node_To_List (N, L);
373
         else
374 1
            M := ADN.First_Node (L);
375

376 1
            while Present (M) loop
377 1
               case ADN.Kind (M) is
378 1
                  when ADN.K_Defining_Identifier =>
379 1
                     Position_M := Get_Enum_Pos (ADN.Name (M));
380 1
                  when ADN.K_Element_Association =>
381 1
                     Position_M := Get_Enum_Pos (ADN.Name (Index (M)));
382 0
                  when others =>
383 0
                     raise Program_Error
384
                       with "Inconsistency in Insert_Node_In_List";
385 1
               end case;
386

387 1
               if Position_N < Position_M then
388 1
                  Insert_Before_Node (N, M, L);
389

390 1
                  return; --  IMPORTANT
391
               end if;
392

393 1
               M := ADN.Next_Node (M);
394 1
            end loop;
395

396 1
            Append_Node_To_List (N, L);
397
         end if;
398
      end Insert_Node_In_List;
399

400
      ----------------------------------
401
      -- Max_Payload_Size_Declaration --
402
      ----------------------------------
403

404 1
      function Max_Payload_Size_Declaration (E : Node_Id) return Node_Id is
405
         pragma Unreferenced (E);
406

407 1
         N : Node_Id;
408
      begin
409
         --  The structure of a message payload is as follows:
410
         --  1 - A destination port (of type Deployment.Port_Type)
411
         --  2 - An optional time stamp (of type Ada.Real_Time.Time)
412
         --  3 - A data (of one of the marshallable types declared in
413
         --      the currently being generated package)
414

415
         --  Size corresponding to (3) has been built incrementally
416
         --  during the visiting of AADL data component instance. Add
417
         --  the size corresponding to (2) and (1)
418

419 1
         Max_Payload := Max_Payload + 64 + Port_Type_Size;
420
         --  64 is the size of Ada.Real_Time.Time. We cannot afford
421
         --  doing a Ada.Real_Time.Time'Size because 'Size for private
422
         --  Ada types is not a static expression.
423

424
         N :=
425 1
           Make_Object_Declaration
426
             (Defining_Identifier =>
427 1
                Make_Defining_Identifier (PN (P_Max_Payload_Size)),
428
              Constant_Present  => True,
429 1
              Object_Definition => RE (RE_Integer),
430
              Expression        =>
431 1
                Make_Literal (New_Integer_Value (Max_Payload, 1, 10)));
432

433 1
         return N;
434
      end Max_Payload_Size_Declaration;
435

436
      -------------------------------------
437
      -- Max_Node_Image_Size_Declaration --
438
      -------------------------------------
439

440 1
      function Max_Node_Image_Size_Declaration (E : Node_Id) return Node_Id is
441
         pragma Unreferenced (E);
442

443 1
         N : Node_Id;
444
      begin
445
         N :=
446 1
           Make_Object_Declaration
447
             (Defining_Identifier =>
448 1
                Make_Defining_Identifier (PN (P_Max_Node_Image_Size)),
449
              Constant_Present  => True,
450 1
              Object_Definition => RE (RE_Integer),
451
              Expression        =>
452 1
                Make_Literal (New_Integer_Value (Max_Node_Image_Size, 1, 10)));
453 1
         return N;
454
      end Max_Node_Image_Size_Declaration;
455

456
      ---------------------------------------
457
      -- Max_Entity_Image_Size_Declaration --
458
      ---------------------------------------
459

460 1
      function Max_Entity_Image_Size_Declaration
461
        (E : Node_Id) return Node_Id
462
      is
463
         pragma Unreferenced (E);
464

465 1
         N : Node_Id;
466
      begin
467
         N :=
468 1
           Make_Object_Declaration
469
             (Defining_Identifier =>
470 1
                Make_Defining_Identifier (PN (P_Max_Entity_Image_Size)),
471
              Constant_Present  => True,
472 1
              Object_Definition => RE (RE_Integer),
473
              Expression        =>
474 1
                Make_Literal
475 1
                  (New_Integer_Value (Max_Entity_Image_Size, 1, 10)));
476 1
         return N;
477
      end Max_Entity_Image_Size_Declaration;
478

479
      -------------------------------------
480
      -- Max_Port_Image_Size_Declaration --
481
      -------------------------------------
482

483 1
      function Max_Port_Image_Size_Declaration (E : Node_Id) return Node_Id is
484
         pragma Unreferenced (E);
485

486 1
         N : Node_Id;
487
      begin
488
         N :=
489 1
           Make_Object_Declaration
490
             (Defining_Identifier =>
491 1
                Make_Defining_Identifier (PN (P_Max_Port_Image_Size)),
492
              Constant_Present  => True,
493 1
              Object_Definition => RE (RE_Integer),
494
              Expression        =>
495 1
                Make_Literal (New_Integer_Value (Max_Port_Image_Size, 1, 10)));
496 1
         return N;
497
      end Max_Port_Image_Size_Declaration;
498

499
      -----------
500
      -- Visit --
501
      -----------
502

503 1
      procedure Visit (E : Node_Id) is
504
      begin
505 1
         case Kind (E) is
506 1
            when K_Architecture_Instance =>
507 1
               Visit_Architecture_Instance (E);
508

509 1
            when K_Component_Instance =>
510 1
               Visit_Component_Instance (E);
511

512 0
            when others =>
513 0
               null;
514 1
         end case;
515 1
      end Visit;
516

517
      ---------------------------------
518
      -- Visit_Architecture_Instance --
519
      ---------------------------------
520

521 1
      procedure Visit_Architecture_Instance (E : Node_Id) is
522
      begin
523 1
         Visit (Root_System (E));
524 1
      end Visit_Architecture_Instance;
525

526
      ------------------------------
527
      -- Visit_Component_Instance --
528
      ------------------------------
529

530 1
      procedure Visit_Component_Instance (E : Node_Id) is
531
         Category : constant Component_Category :=
532 1
           Get_Category_Of_Component (E);
533
      begin
534 1
         case Category is
535 1
            when CC_System =>
536 1
               Visit_System_Instance (E);
537

538 1
            when CC_Process =>
539 1
               Visit_Process_Instance (E);
540

541 1
            when CC_Thread =>
542 1
               Visit_Thread_Instance (E);
543

544 1
            when CC_Data =>
545 1
               Visit_Data_Instance (E);
546

547 1
            when others =>
548 1
               null;
549 1
         end case;
550 1
      end Visit_Component_Instance;
551

552
      -------------------------
553
      -- Visit_Data_Instance --
554
      -------------------------
555

556 1
      procedure Visit_Data_Instance (E : Node_Id) is
557
      begin
558
         --  Do not generate Ada type more than once
559

560 1
         if No (Get_Handling (E, By_Name, H_Ada_Deployment_Spec)) then
561
            --  Threads and processes cannot have opaque types in
562
            --  their features because this prevents the static
563
            --  computation of the buffer sizes.
564

565 1
            if Get_Source_Language (E) = Language_Ada_95 then
566 0
               Display_Located_Error
567 0
                 (Loc (E),
568
                  "This data type cannot be used in thread or process" &
569
                  " features",
570
                  Fatal => True);
571
            end if;
572

573
            --  If the type is sendable through network, we take into
574
            --  account its size when calculating the maximal message
575
            --  payload size.
576

577 1
            if Get_Data_Representation (E) /= Data_With_Accessors then
578
               declare
579 1
                  Data_Size : Unsigned_Long_Long;
580
               begin
581 1
                  if Get_Data_Size (E) /= Null_Size then
582 1
                     Data_Size := To_Bits (Get_Data_Size (E));
583
                  else
584 1
                     Data_Size := Estimate_Data_Size (E);
585
                  end if;
586

587 1
                  if Data_Size > Max_Payload then
588 1
                     Max_Payload    := Data_Size;
589 1
                     Max_Payload_Of := To_Ada_Name (Name (Identifier (E)));
590
                  end if;
591 1
               end;
592

593 1
               Set_Handling (E, By_Name, H_Ada_Deployment_Spec, E);
594
            end if;
595
         end if;
596 1
      end Visit_Data_Instance;
597

598
      ---------------------------
599
      -- Visit_Device_Instance --
600
      ---------------------------
601

602 1
      procedure Visit_Device_Instance (E : Node_Id) is
603 1
         Implementation : constant Node_Id := Get_Implementation (E);
604 1
         N              : Node_Id;
605
      begin
606 1
         if Implementation /= No_Node then
607 1
            if not AAU.Is_Empty (AAN.Subcomponents (Implementation)) then
608 1
               N := First_Node (Subcomponents (Implementation));
609 1
               while Present (N) loop
610 1
                  Visit_Component_Instance (Corresponding_Instance (N));
611 1
                  N := Next_Node (N);
612 1
               end loop;
613
            end if;
614
         end if;
615 1
      end Visit_Device_Instance;
616

617
      ----------------------------
618
      -- Visit_Process_Instance --
619
      ----------------------------
620

621 1
      procedure Visit_Process_Instance (E : Node_Id) is
622 1
         P       : constant Node_Id   := Map_HI_Node (E);
623 1
         U       : Node_Id;
624 1
         S       : constant Node_Id   := Parent_Subcomponent (E);
625 1
         Img_Len : Unsigned_Long_Long :=
626 1
           Get_Name_String (Map_Ada_Enumerator_Name (S))'Length;
627 1
         N          : Node_Id;
628 1
         C          : Node_Id;
629 1
         F          : Node_Id;
630 1
         Src        : Node_Id;
631 1
         Dst        : Node_Id;
632 1
         Parent     : Node_Id;
633 1
         S_Parent   : Node_Id;
634
         The_System : constant Node_Id :=
635 1
           Parent_Component (Parent_Subcomponent (E));
636
      begin
637 1
         Push_Entity (P);
638

639
         --  It is important that we push P at the top of the entity
640
         --  stack before generating the package unit.
641

642 1
         U := Map_HI_Unit (E);
643 1
         Push_Entity (U);
644 1
         Set_Deployment_Spec;
645

646
         --  Start recording the handling since they have to be reset
647
         --  for each node.
648

649 1
         Start_Recording_Handlings;
650

651
         --  Initialize Max_Payload
652

653 1
         if Need_Deliver (E) or else Need_Send (E) then
654 1
            Max_Payload := 0;
655
         end if;
656

657
         --  Create the lists
658

659 1
         Node_Enumerator_List       := New_List (ADN.K_Enumeration_Literals);
660 1
         Node_Enumerator_Pos_List   := New_List (ADN.K_Element_List);
661 1
         Node_Image_List            := New_List (ADN.K_Element_List);
662 1
         Thread_Enumerator_List     := New_List (ADN.K_Enumeration_Literals);
663 1
         Thread_Enumerator_Pos_List := New_List (ADN.K_Element_List);
664 1
         Entity_Table_List          := New_List (ADN.K_Element_List);
665 1
         Entity_Image_List          := New_List (ADN.K_Element_List);
666 1
         Port_Enumerator_List       := New_List (ADN.K_Enumeration_Literals);
667 1
         Port_Enumerator_Pos_List   := New_List (ADN.K_Element_List);
668 1
         Port_Table_List            := New_List (ADN.K_Element_List);
669 1
         Port_Image_List            := New_List (ADN.K_Element_List);
670

671
         --  The Deployment package must be preelaborated
672

673 1
         N := Make_Pragma_Statement (Pragma_Preelaborate, No_List);
674 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
675

676
         --  Build the enumerator corresponding to the distributed
677
         --  application node.
678

679 1
         N := Make_Defining_Identifier (Map_Ada_Enumerator_Name (S));
680 1
         Append_Node_To_List (N, Node_Enumerator_List);
681 1
         Bind_AADL_To_Enumerator (Identifier (S), N);
682

683
         --  Build the representation clause of the enumerator
684

685
         N :=
686 1
           Make_Element_Association
687 1
             (Make_Defining_Identifier (Map_Ada_Enumerator_Name (S)),
688 1
              Make_Literal
689 1
                (New_Integer_Value
690
                   (Unsigned_Long_Long
691 1
                      (Get_Node_Enum_Pos (Map_Ada_Enumerator_Name (S))),
692
                    1,
693
                    10)));
694 1
         Insert_Node_In_List
695
           (N,
696
            Node_Enumerator_Pos_List,
697
            Get_Node_Enum_Pos'Access);
698

699 1
         if Max_Node_Image_Size < Img_Len then
700 1
            Max_Node_Image_Size := Img_Len;
701
         end if;
702

703
         N :=
704 1
           Make_Element_Association
705 1
             (Make_Defining_Identifier (Map_Ada_Enumerator_Name (S)),
706 1
              Make_Literal (New_String_Value (Map_Ada_Enumerator_Name (S))));
707

708 1
         Insert_Node_In_List (N, Node_Image_List, Get_Node_Enum_Pos'Access);
709

710
         --  Visit all the subcomponents of the process
711

712 1
         if not AAU.Is_Empty (Subcomponents (E)) then
713 1
            C := First_Node (Subcomponents (E));
714

715 1
            while Present (C) loop
716 1
               Visit (Corresponding_Instance (C));
717

718 1
               C := Next_Node (C);
719 1
            end loop;
720
         end if;
721

722
         --  Visit all devices attached to the parent system that
723
         --  share the same processor as process E.
724

725 1
         if not AAU.Is_Empty (Subcomponents (The_System)) then
726 1
            C := First_Node (Subcomponents (The_System));
727 1
            while Present (C) loop
728 1
               if AAU.Is_Device (Corresponding_Instance (C))
729
                 and then
730 1
                   Get_Bound_Processor (Corresponding_Instance (C)) =
731 1
                   Get_Bound_Processor (E)
732
               then
733
                  --  Build the enumerator corresponding to the device
734
                  --  Note: we reuse the process name XXX
735

736 1
                  N := Make_Defining_Identifier (Map_Ada_Enumerator_Name (S));
737 1
                  Bind_AADL_To_Enumerator
738 1
                    (Identifier (Corresponding_Instance (C)),
739
                     N);
740

741 1
                  Visit_Device_Instance (Corresponding_Instance (C));
742
               end if;
743 1
               C := Next_Node (C);
744 1
            end loop;
745
         end if;
746

747
         --  For each of the processes P connected to E, (1) we add an
748
         --  enumerator corresponding to P and (2) for each one of the
749
         --  threads of P, we add an enumerator.
750

751 1
         if not AAU.Is_Empty (Features (E)) then
752 1
            F := First_Node (Features (E));
753

754 1
            while Present (F) loop
755
               --  The sources of F
756

757 1
               if not AAU.Is_Empty (Sources (F)) then
758 1
                  Src := First_Node (Sources (F));
759

760 1
                  while Present (Src) loop
761

762 1
                     Parent := Parent_Component (Item (Src));
763

764 1
                     if AAU.Is_Process (Parent)
765 1
                       and then Parent /= E
766 1
                       and then not Is_Added (Parent, E)
767
                     then
768
                        --  Add the process to the deployment
769
                        --  enumerators of E.
770

771 1
                        S_Parent := Parent_Subcomponent (Parent);
772 1
                        Img_Len  :=
773 1
                          Get_Name_String (Map_Ada_Enumerator_Name (S_Parent))'
774
                            Length;
775
                        N :=
776 1
                          Make_Defining_Identifier
777 1
                            (Map_Ada_Enumerator_Name (S_Parent));
778 1
                        Insert_Node_In_List
779
                          (N,
780
                           Node_Enumerator_List,
781
                           Get_Node_Enum_Pos'Access);
782

783
                        --  Add a representation clause for the
784
                        --  enumerator corresponding to Parent.
785

786
                        N :=
787 1
                          Make_Element_Association
788 1
                            (Make_Defining_Identifier
789 1
                               (Map_Ada_Enumerator_Name (S_Parent)),
790 1
                             Make_Literal
791 1
                               (New_Integer_Value
792
                                  (Unsigned_Long_Long
793 1
                                     (Get_Node_Enum_Pos
794 1
                                        (Map_Ada_Enumerator_Name (S_Parent))),
795
                                   1,
796
                                   10)));
797 1
                        Insert_Node_In_List
798
                          (N,
799
                           Node_Enumerator_Pos_List,
800
                           Get_Node_Enum_Pos'Access);
801

802 1
                        if Max_Node_Image_Size < Img_Len then
803 1
                           Max_Node_Image_Size := Img_Len;
804
                        end if;
805

806
                        N :=
807 1
                          Make_Element_Association
808 1
                            (Make_Defining_Identifier
809 1
                               (Map_Ada_Enumerator_Name (S_Parent)),
810 1
                             Make_Literal
811 1
                               (New_String_Value
812 1
                                  (Map_Ada_Enumerator_Name (S_Parent))));
813

814 1
                        Insert_Node_In_List
815
                          (N,
816
                           Node_Image_List,
817
                           Get_Node_Enum_Pos'Access);
818

819
                        --  Traverse all the subcomponents of Parent
820

821 1
                        if not AAU.Is_Empty (Subcomponents (Parent)) then
822 1
                           C := First_Node (Subcomponents (Parent));
823

824 1
                           while Present (C) loop
825 1
                              Visit (Corresponding_Instance (C));
826

827 1
                              C := Next_Node (C);
828 1
                           end loop;
829
                        end if;
830

831
                        --  Mark P as being Added
832

833 1
                        Set_Added (Parent, E);
834
                     end if;
835

836 1
                     Src := Next_Node (Src);
837 1
                  end loop;
838
               end if;
839

840
               --  The destinations of F
841

842 1
               if not AAU.Is_Empty (Destinations (F)) then
843 1
                  Dst := First_Node (Destinations (F));
844

845 1
                  while Present (Dst) loop
846 1
                     Parent := Parent_Component (Item (Dst));
847

848 1
                     if AAU.Is_Process (Parent)
849 1
                       and then Parent /= E
850 1
                       and then not Is_Added (Parent, E)
851
                     then
852
                        --  Add the process to the deployment
853
                        --  enumerators of E.
854

855 1
                        S_Parent := Parent_Subcomponent (Parent);
856 1
                        Img_Len  :=
857 1
                          Get_Name_String (Map_Ada_Enumerator_Name (S_Parent))'
858
                            Length;
859
                        N :=
860 1
                          Make_Defining_Identifier
861 1
                            (Map_Ada_Enumerator_Name (S_Parent));
862 1
                        Insert_Node_In_List
863
                          (N,
864
                           Node_Enumerator_List,
865
                           Get_Node_Enum_Pos'Access);
866

867
                        --  Add a representation clause for the
868
                        --  enumerator corresponding to P.
869

870
                        N :=
871 1
                          Make_Element_Association
872 1
                            (Make_Defining_Identifier
873 1
                               (Map_Ada_Enumerator_Name (S_Parent)),
874 1
                             Make_Literal
875 1
                               (New_Integer_Value
876
                                  (Unsigned_Long_Long
877 1
                                     (Get_Node_Enum_Pos
878 1
                                        (Map_Ada_Enumerator_Name (S_Parent))),
879
                                   1,
880
                                   10)));
881 1
                        Insert_Node_In_List
882
                          (N,
883
                           Node_Enumerator_Pos_List,
884
                           Get_Node_Enum_Pos'Access);
885

886 1
                        if Max_Node_Image_Size < Img_Len then
887 1
                           Max_Node_Image_Size := Img_Len;
888
                        end if;
889

890
                        N :=
891 1
                          Make_Element_Association
892 1
                            (Make_Defining_Identifier
893 1
                               (Map_Ada_Enumerator_Name (S_Parent)),
894 1
                             Make_Literal
895 1
                               (New_String_Value
896 1
                                  (Map_Ada_Enumerator_Name (S_Parent))));
897

898 1
                        Insert_Node_In_List
899
                          (N,
900
                           Node_Image_List,
901
                           Get_Node_Enum_Pos'Access);
902

903
                        --  Traverse all the subcomponensts of P
904

905 1
                        if not AAU.Is_Empty (Subcomponents (Parent)) then
906 1
                           C := First_Node (Subcomponents (Parent));
907

908 1
                           while Present (C) loop
909 1
                              Visit (Corresponding_Instance (C));
910

911 1
                              C := Next_Node (C);
912 1
                           end loop;
913
                        end if;
914

915
                        --  Mark P as being Added
916

917 1
                        Set_Added (Parent, E);
918
                     end if;
919

920 1
                     Dst := Next_Node (Dst);
921 1
                  end loop;
922
               end if;
923

924 1
               F := Next_Node (F);
925 1
            end loop;
926
         end if;
927

928
         --  Create the node enumeration type declaration. Note that
929
         --  the type creation is possible even the enumeration list
930
         --  is incomplete. We can do this in the first traversal
931
         --  since we are sure that the enumerator list is not empty.
932

933
         N :=
934 1
           Message_Comment
935
             ("For each node in the distributed" &
936
              " application add an enumerator");
937 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
938

939
         N :=
940 1
           Make_Full_Type_Declaration
941
             (Defining_Identifier =>
942 1
                Make_Defining_Identifier (TN (T_Node_Type)),
943
              Type_Definition =>
944 1
                Make_Enumeration_Type_Definition (Node_Enumerator_List));
945 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
946

947
         --  Create the enumeration representation clause so that all
948
         --  the enumerators in all the generated deployment packages
949
         --  have coherent position.
950

951
         N :=
952 1
           Message_Comment
953
             ("Representation clause to have consistent" &
954
              " positions for enumerators");
955 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
956

957
         N :=
958 1
           Make_Enumeration_Representation_Clause
959
             (Defining_Identifier =>
960 1
                Make_Defining_Identifier (TN (T_Node_Type)),
961
              Array_Aggregate =>
962 1
                Make_Array_Aggregate (Node_Enumerator_Pos_List));
963 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
964

965
         --  Fix the size of type Node_Type to Node_Type_Size bits
966
         --  because the message stream allocates one byte for it for
967
         --  now. This implies a maximum value of 256 nodes per
968
         --  application.
969

970
         N :=
971 1
           Message_Comment
972
             ("Size of Node_Type fixed to" &
973 1
              Integer'Image (Node_Type_Size) &
974
              " bits");
975 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
976

977
         N :=
978 1
           Make_Attribute_Definition_Clause
979
             (Defining_Identifier =>
980 1
                Make_Defining_Identifier (TN (T_Node_Type)),
981
              Attribute_Designator => A_Size,
982
              Expression           =>
983 1
                Make_Literal (New_Integer_Value (Node_Type_Size, 1, 10)));
984 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
985

986 1
         N := Max_Node_Image_Size_Declaration (E);
987 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
988

989 1
         N := Message_Comment ("Maximal Node_Image size for this" & " node");
990 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
991

992 1
         N := Message_Comment ("Node Image");
993 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
994

995
         N :=
996 1
           Make_Array_Type_Definition
997
             (Range_Constraints =>
998 1
                Make_List_Id
999 1
                  (Make_Range_Constraint
1000
                     (No_Node,
1001
                      No_Node,
1002 1
                      Make_Attribute_Designator
1003 1
                        (Make_Designator (TN (T_Node_Type)),
1004
                         A_Range))),
1005
              Component_Definition =>
1006 1
                Make_Indexed_Component
1007 1
                  (RE (RE_String),
1008 1
                   Make_List_Id
1009 1
                     (Make_Range_Constraint
1010 1
                        (Make_Literal (New_Integer_Value (1, 0, 10)),
1011 1
                         Make_Defining_Identifier
1012
                           (PN (P_Max_Node_Image_Size))))));
1013

1014
         --  Normalize Node image strings to fit in the Node_Image
1015
         --  array constraint (Max_Node_Image_Size)
1016

1017
         declare
1018 1
            Cur : Node_Id := ADN.First_Node (Node_Image_List);
1019
         begin
1020 1
            for J in 1 .. Length (Node_Image_List) loop
1021 1
               declare
1022 1
                  Str : constant String :=
1023 1
                    Image (ADN.Value (ADN.Expression (Cur)));
1024 1
                  Res : String (1 .. Integer (Max_Node_Image_Size));
1025
               begin
1026
                  --  Get the string without the quotes
1027 1
                  Res (1 .. Str'Last - 2) := Str (2 .. Str'Last - 1);
1028
                  --  Fill the end with spaces
1029 1
                  for I in Str'Last - 1 .. Integer (Max_Node_Image_Size) loop
1030 1
                     Res (I) := ' ';
1031 1
                  end loop;
1032 1
                  ADN.Set_Value
1033 1
                    (ADN.Expression (Cur),
1034 1
                     New_String_Value (Get_String_Name (Res)));
1035 1
               end;
1036 1
               Cur := ADN.Next_Node (Cur);
1037 1
            end loop;
1038
         end;
1039

1040
         N :=
1041 1
           Make_Object_Declaration
1042
             (Defining_Identifier =>
1043 1
                Make_Defining_Identifier (PN (P_Node_Image)),
1044
              Constant_Present  => True,
1045
              Object_Definition => N,
1046 1
              Expression        => Make_Array_Aggregate (Node_Image_List));
1047 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1048

1049
         --  Declare the constant that represents the current node
1050

1051
         N :=
1052 1
           Make_Object_Declaration
1053 1
             (Defining_Identifier => Make_Defining_Identifier (PN (P_My_Node)),
1054
              Constant_Present    => True,
1055 1
              Object_Definition   => Make_Designator (TN (T_Node_Type)),
1056
              Expression          =>
1057 1
                Make_Defining_Identifier (Map_Ada_Enumerator_Name (S)));
1058 1
         Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1059

1060
         --  Create the thread enumeration type declaration. Note that
1061
         --  the type creation is possible even the enumeration list
1062
         --  is incomplete.
1063

1064 1
         if not Is_Empty (Thread_Enumerator_List) then
1065
            N :=
1066 1
              Message_Comment
1067
                ("For each thread in the distributed" &
1068
                 " application nodes, add an" &
1069
                 " enumerator");
1070 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1071

1072
            N :=
1073 1
              Make_Full_Type_Declaration
1074
                (Defining_Identifier =>
1075 1
                   Make_Defining_Identifier (TN (T_Entity_Type)),
1076
                 Type_Definition =>
1077 1
                   Make_Enumeration_Type_Definition (Thread_Enumerator_List));
1078 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1079

1080
            --  Create the enumeration representation clause so that
1081
            --  all the enumerators in all the generated deployment
1082
            --  packages have coherent position.
1083

1084
            N :=
1085 1
              Message_Comment
1086
                ("Representation clause to have consistent" &
1087
                 " positions for enumerators");
1088 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1089

1090
            N :=
1091 1
              Make_Enumeration_Representation_Clause
1092
                (Defining_Identifier =>
1093 1
                   Make_Defining_Identifier (TN (T_Entity_Type)),
1094
                 Array_Aggregate =>
1095 1
                   Make_Array_Aggregate (Thread_Enumerator_Pos_List));
1096 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1097

1098
            --  Fix the size of type Entity_Type to Entity_Type_Size
1099
            --  bit because the message stream allocates one byte for
1100
            --  it for now. This implies a maximum value of 256 nodes
1101
            --  per application.
1102

1103
            N :=
1104 1
              Message_Comment
1105
                ("Size of Entity_Type fixed to" &
1106 1
                 Integer'Image (Entity_Type_Size) &
1107
                 " bits");
1108 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1109

1110
            N :=
1111 1
              Make_Attribute_Definition_Clause
1112
                (Defining_Identifier =>
1113 1
                   Make_Defining_Identifier (TN (T_Entity_Type)),
1114
                 Attribute_Designator => A_Size,
1115
                 Expression           =>
1116 1
                   Make_Literal (New_Integer_Value (Entity_Type_Size, 1, 10)));
1117 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1118
         end if;
1119

1120
         --  Declare the Entity Table when necessary
1121

1122 1
         if not Is_Empty (Entity_Table_List) then
1123 1
            N := Message_Comment ("Entity Table");
1124 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1125

1126
            N :=
1127 1
              Make_Array_Type_Definition
1128
                (Range_Constraints =>
1129 1
                   Make_List_Id
1130 1
                     (Make_Range_Constraint
1131
                        (No_Node,
1132
                         No_Node,
1133 1
                         Make_Attribute_Designator
1134 1
                           (Make_Designator (TN (T_Entity_Type)),
1135
                            A_Range))),
1136
                 Component_Definition =>
1137 1
                   Make_Defining_Identifier (TN (T_Node_Type)));
1138

1139
            N :=
1140 1
              Make_Object_Declaration
1141
                (Defining_Identifier =>
1142 1
                   Make_Defining_Identifier (PN (P_Entity_Table)),
1143
                 Constant_Present  => True,
1144
                 Object_Definition => N,
1145 1
                 Expression => Make_Array_Aggregate (Entity_Table_List));
1146 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1147

1148 1
            N := Max_Entity_Image_Size_Declaration (E);
1149 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1150

1151
            N :=
1152 1
              Message_Comment ("Maximal Entity_Image size for this" & " node");
1153 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1154

1155 1
            N := Message_Comment ("Entity Image");
1156 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1157

1158
            N :=
1159 1
              Make_Array_Type_Definition
1160
                (Range_Constraints =>
1161 1
                   Make_List_Id
1162 1
                     (Make_Range_Constraint
1163
                        (No_Node,
1164
                         No_Node,
1165 1
                         Make_Attribute_Designator
1166 1
                           (Make_Designator (TN (T_Entity_Type)),
1167
                            A_Range))),
1168
                 Component_Definition =>
1169 1
                   Make_Indexed_Component
1170 1
                     (RE (RE_String),
1171 1
                      Make_List_Id
1172 1
                        (Make_Range_Constraint
1173 1
                           (Make_Literal (New_Integer_Value (1, 0, 10)),
1174 1
                            Make_Defining_Identifier
1175
                              (PN (P_Max_Entity_Image_Size))))));
1176

1177
            --  Normalize Entity image strings to fit in the Entity_Image
1178
            --  array constraint (Max_Entity_Image_Size)
1179

1180
            declare
1181 1
               Cur : Node_Id := ADN.First_Node (Entity_Image_List);
1182
            begin
1183 1
               for J in 1 .. Length (Entity_Image_List) loop
1184 1
                  declare
1185 1
                     Str : constant String :=
1186 1
                       Image (ADN.Value (ADN.Expression (Cur)));
1187 1
                     Res : String (1 .. Integer (Max_Entity_Image_Size));
1188
                  begin
1189
                     --  Get the string without the quotes
1190 1
                     Res (1 .. Str'Last - 2) := Str (2 .. Str'Last - 1);
1191
                     --  Fill the end with spaces
1192 1
                     for I in Str'Last - 1 .. Integer (Max_Entity_Image_Size)
1193
                     loop
1194 1
                        Res (I) := ' ';
1195 1
                     end loop;
1196 1
                     ADN.Set_Value
1197 1
                       (ADN.Expression (Cur),
1198 1
                        New_String_Value (Get_String_Name (Res)));
1199 1
                  end;
1200 1
                  Cur := ADN.Next_Node (Cur);
1201 1
               end loop;
1202
            end;
1203

1204
            N :=
1205 1
              Make_Object_Declaration
1206
                (Defining_Identifier =>
1207 1
                   Make_Defining_Identifier (PN (P_Entity_Image)),
1208
                 Constant_Present  => True,
1209
                 Object_Definition => N,
1210 1
                 Expression => Make_Array_Aggregate (Entity_Image_List));
1211 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1212
         end if;
1213

1214
         --  Create the port enumeration type declaration. Note that
1215
         --  the type creation is possible even the enumeration list
1216
         --  is incomplete.
1217

1218 1
         if not Is_Empty (Port_Enumerator_List) then
1219
            N :=
1220 1
              Message_Comment
1221
                ("For each thread port in the distributed" &
1222
                 " application nodes, add an" &
1223
                 " enumerator");
1224 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1225

1226
            N :=
1227 1
              Make_Full_Type_Declaration
1228
                (Defining_Identifier =>
1229 1
                   Make_Defining_Identifier (TN (T_Port_Type)),
1230
                 Type_Definition =>
1231 1
                   Make_Enumeration_Type_Definition (Port_Enumerator_List));
1232 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1233

1234
            --  Create the enumeration representation clause so that
1235
            --  all the enumerators in all the generated deployment
1236
            --  packages have coherent position.
1237

1238
            N :=
1239 1
              Message_Comment
1240
                ("Representation clause to have consistent" &
1241
                 " positions for enumerators");
1242 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1243

1244
            N :=
1245 1
              Make_Enumeration_Representation_Clause
1246
                (Defining_Identifier =>
1247 1
                   Make_Defining_Identifier (TN (T_Port_Type)),
1248
                 Array_Aggregate =>
1249 1
                   Make_Array_Aggregate (Port_Enumerator_Pos_List));
1250 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1251

1252
            --  Fix the size of type Port_Type to Port_Type_Size bits
1253
            --  to be able to instanciate a Marshallers_G for it.
1254

1255
            N :=
1256 1
              Message_Comment
1257
                ("Size of Port_Type fixed to" &
1258 1
                 Integer'Image (Port_Type_Size) &
1259
                 " bits");
1260 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1261

1262
            N :=
1263 1
              Make_Attribute_Definition_Clause
1264
                (Defining_Identifier =>
1265 1
                   Make_Defining_Identifier (TN (T_Port_Type)),
1266
                 Attribute_Designator => A_Size,
1267
                 Expression           =>
1268 1
                   Make_Literal (New_Integer_Value (Port_Type_Size, 1, 10)));
1269 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1270
         end if;
1271

1272
         --  Declare the Port Table when necessary
1273

1274 1
         if not Is_Empty (Port_Table_List) then
1275 1
            N := Message_Comment ("Port Table");
1276 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1277

1278
            N :=
1279 1
              Make_Array_Type_Definition
1280
                (Range_Constraints =>
1281 1
                   Make_List_Id
1282 1
                     (Make_Range_Constraint
1283
                        (No_Node,
1284
                         No_Node,
1285 1
                         Make_Attribute_Designator
1286 1
                           (Make_Designator (TN (T_Port_Type)),
1287
                            A_Range))),
1288
                 Component_Definition =>
1289 1
                   Make_Defining_Identifier (TN (T_Entity_Type)));
1290

1291
            N :=
1292 1
              Make_Object_Declaration
1293
                (Defining_Identifier =>
1294 1
                   Make_Defining_Identifier (PN (P_Port_Table)),
1295
                 Constant_Present  => True,
1296
                 Object_Definition => N,
1297 1
                 Expression        => Make_Array_Aggregate (Port_Table_List));
1298 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1299

1300 1
            N := Max_Port_Image_Size_Declaration (E);
1301 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1302

1303
            N :=
1304 1
              Message_Comment ("Maximal Port_Image size for this" & " node");
1305 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1306

1307
            N :=
1308 1
              Message_Comment
1309
                ("A String subtype with Port_Image_Size" & " constraint");
1310
            N :=
1311 1
              Make_Full_Type_Declaration
1312 1
                (Make_Defining_Identifier (PN (P_Port_Sized_String)),
1313 1
                 Make_Indexed_Component
1314 1
                   (RE (RE_String),
1315 1
                    Make_List_Id
1316 1
                      (Make_Range_Constraint
1317 1
                         (Make_Literal (New_Integer_Value (1, 0, 10)),
1318 1
                          RE (RE_Max_Port_Image_Size)))),
1319
                 Is_Subtype => True);
1320 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1321

1322 1
            N := Message_Comment ("Port Image");
1323 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1324

1325
            --  Normalize Port image strings to fit in the Port_Image
1326
            --  array constraint (Max_Port_Image_Size)
1327

1328
            declare
1329 1
               Cur : Node_Id := ADN.First_Node (Port_Image_List);
1330
            begin
1331 1
               for J in 1 .. Length (Port_Image_List) loop
1332 1
                  declare
1333 1
                     Str : constant String :=
1334 1
                       Image (ADN.Value (ADN.Expression (Cur)));
1335 1
                     Res : String (1 .. Integer (Max_Port_Image_Size));
1336
                  begin
1337
                     --  Get the string without the quotes
1338 1
                     Res (1 .. Str'Last - 2) := Str (2 .. Str'Last - 1);
1339
                     --  Fill the end with spaces
1340 1
                     for I in Str'Last - 1 .. Integer (Max_Port_Image_Size)
1341
                     loop
1342 1
                        Res (I) := ' ';
1343 1
                     end loop;
1344 1
                     ADN.Set_Value
1345 1
                       (ADN.Expression (Cur),
1346 1
                        New_String_Value (Get_String_Name (Res)));
1347 1
                  end;
1348 1
                  Cur := ADN.Next_Node (Cur);
1349 1
               end loop;
1350
            end;
1351

1352
            N :=
1353 1
              Make_Array_Type_Definition
1354
                (Range_Constraints =>
1355 1
                   Make_List_Id
1356 1
                     (Make_Range_Constraint
1357
                        (No_Node,
1358
                         No_Node,
1359 1
                         Make_Attribute_Designator
1360 1
                           (Make_Designator (TN (T_Port_Type)),
1361
                            A_Range))),
1362
                 Component_Definition =>
1363 1
                   Make_Defining_Identifier (PN (P_Port_Sized_String)));
1364

1365
            N :=
1366 1
              Make_Object_Declaration
1367
                (Defining_Identifier =>
1368 1
                   Make_Defining_Identifier (PN (P_Port_Image)),
1369
                 Constant_Present  => True,
1370
                 Object_Definition => N,
1371 1
                 Expression        => Make_Array_Aggregate (Port_Image_List));
1372 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1373
         end if;
1374

1375
         --  Generate the Max_Payload_Size constant declaration only
1376
         --  if there is a real communication between threads or
1377
         --  nodes.
1378

1379 1
         if Need_Deliver (E) or else Need_Send (E) then
1380
            N :=
1381 1
              Message_Comment
1382
                ("Maximal message payload size for this" & " node (in bits)");
1383 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1384

1385 1
            N := Max_Payload_Size_Declaration (E);
1386 1
            Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1387

1388
            --  Indicate to which type corresonds the maximal size
1389

1390
            --  Is not relevant if the system does not handle data
1391
            --  or event data communication between threads or nodes
1392

1393 1
            if Max_Payload_Of /= No_Name then
1394 0
               N :=
1395 1
                 Message_Comment
1396 1
                   ("Biggest type: " & Get_Name_String (Max_Payload_Of));
1397 1
               Append_Node_To_List (N, ADN.Visible_Part (Current_Package));
1398
            end if;
1399
         end if;
1400

1401
         --  Unmark all the marked types
1402

1403 1
         Reset_Handlings;
1404

1405 1
         Pop_Entity; -- U
1406 1
         Pop_Entity; -- P
1407 1
      end Visit_Process_Instance;
1408

1409
      ---------------------------
1410
      -- Visit_System_Instance --
1411
      ---------------------------
1412

1413 1
      procedure Visit_System_Instance (E : Node_Id) is
1414 1
         A : constant Node_Id := Map_Distributed_Application (E);
1415

1416
      begin
1417 1
         Push_Entity (A);
1418

1419 1
         Visit_Subcomponents_Of (E);
1420

1421 1
         Pop_Entity; --  A
1422 1
      end Visit_System_Instance;
1423

1424
      ---------------------------
1425
      -- Visit_Thread_Instance --
1426
      ---------------------------
1427

1428 1
      procedure Visit_Thread_Instance (E : Node_Id) is
1429 1
         N          : Node_Id;
1430 1
         P          : Node_Id;
1431 1
         F          : Node_Id;
1432 1
         S          : constant Node_Id            := Parent_Subcomponent (E);
1433 1
         Img_Length : constant Unsigned_Long_Long :=
1434 1
           Get_Name_String (Map_Ada_Enumerator_Name (S))'Length;
1435
      begin
1436
         --  Build the enumerator corresponding to the thread
1437

1438 1
         N := Make_Defining_Identifier (Map_Ada_Enumerator_Name (S));
1439 1
         Insert_Node_In_List
1440
           (N,
1441
            Thread_Enumerator_List,
1442
            Get_Thread_Enum_Pos'Access);
1443 1
         Bind_AADL_To_Enumerator (Identifier (S), N);
1444

1445
         --  Build the representation clause for the enumerator
1446

1447
         N :=
1448 1
           Make_Element_Association
1449 1
             (Make_Defining_Identifier (Map_Ada_Enumerator_Name (S)),
1450 1
              Make_Literal
1451 1
                (New_Integer_Value
1452
                   (Unsigned_Long_Long
1453 1
                      (Get_Thread_Enum_Pos (Map_Ada_Enumerator_Name (S))),
1454
                    1,
1455
                    10)));
1456 1
         Insert_Node_In_List
1457
           (N,
1458
            Thread_Enumerator_Pos_List,
1459
            Get_Thread_Enum_Pos'Access);
1460

1461
         --  For each thread, build the corresponding element
1462
         --  association and append it to the entity list.
1463

1464
         --  Get the Process parent of the thread
1465

1466 1
         P := Parent_Component (S);
1467 1
         pragma Assert (AAU.Is_Process (P) or else AAU.Is_Abstract (P));
1468

1469 1
         if AAU.Is_Process (P) then
1470
            N :=
1471 1
              Make_Element_Association
1472 1
                (Make_Defining_Identifier (Map_Ada_Enumerator_Name (S)),
1473 1
                 Make_Defining_Identifier
1474 1
                   (Map_Ada_Enumerator_Name (Parent_Subcomponent (P))));
1475

1476 1
         elsif AAU.Is_Abstract (P) then
1477
            N :=
1478 1
              Make_Element_Association
1479 1
                (Make_Defining_Identifier (Map_Ada_Enumerator_Name (S)),
1480 1
                 Make_Defining_Identifier (PN (P_My_Node)));
1481

1482
         end if;
1483 1
         Insert_Node_In_List
1484
           (N,
1485
            Entity_Table_List,
1486
            Get_Thread_Enum_Pos'Access);
1487

1488 1
         if Max_Entity_Image_Size < Img_Length then
1489 1
            Max_Entity_Image_Size := Img_Length;
1490
         end if;
1491

1492
         N :=
1493 1
           Make_Element_Association
1494 1
             (Make_Defining_Identifier (Map_Ada_Enumerator_Name (S)),
1495 1
              Make_Literal (New_String_Value (Map_Ada_Enumerator_Name (S))));
1496

1497 1
         Insert_Node_In_List
1498
           (N,
1499
            Entity_Image_List,
1500
            Get_Thread_Enum_Pos'Access);
1501

1502
         --  For each one of the thread ports, create its
1503
         --  corresponding enumerator, representation clause and
1504
         --  association.
1505

1506 1
         if not AAU.Is_Empty (Features (E)) then
1507 1
            F := First_Node (Features (E));
1508

1509 1
            while Present (F) loop
1510 1
               if Kind (F) = K_Port_Spec_Instance then
1511 1
                  declare
1512
                     Enum_Name : constant Name_Id :=
1513 1
                       Map_Ada_Full_Feature_Name (F, 'K');
1514 1
                     Port_Img_Length : constant Unsigned_Long_Long :=
1515 1
                       Get_Name_String (Enum_Name)'Length;
1516
                  begin
1517
                     --  Visit the feature to compute the data size
1518

1519 1
                     if Kind (F) = K_Port_Spec_Instance
1520 1
                       and then AAN.Is_Data (F)
1521
                     then
1522 1
                        Visit (Corresponding_Instance (F));
1523
                     end if;
1524

1525
                     --  Create the enumerator corresponding to the
1526
                     --  port.
1527

1528 1
                     N := Make_Defining_Identifier (Enum_Name);
1529 1
                     Insert_Node_In_List
1530
                       (N,
1531
                        Port_Enumerator_List,
1532
                        Get_Port_Enum_Pos'Access);
1533 1
                     Bind_AADL_To_Enumerator (Identifier (F), N);
1534

1535
                     --  Build the representation clause for the
1536
                     --  enumerator.
1537

1538
                     N :=
1539 1
                       Make_Element_Association
1540 1
                         (Make_Defining_Identifier (Enum_Name),
1541 1
                          Make_Literal
1542 1
                            (New_Integer_Value
1543
                               (Unsigned_Long_Long
1544 1
                                  (Get_Port_Enum_Pos (Enum_Name)),
1545
                                1,
1546
                                10)));
1547 1
                     Insert_Node_In_List
1548
                       (N,
1549
                        Port_Enumerator_Pos_List,
1550
                        Get_Port_Enum_Pos'Access);
1551

1552
                     --  For each port, build the corresponding
1553
                     --  element association and append it to the
1554
                     --  association list.
1555

1556
                     N :=
1557 1
                       Make_Element_Association
1558 1
                         (Make_Defining_Identifier (Enum_Name),
1559 1
                          Make_Defining_Identifier
1560 1
                            (Map_Ada_Enumerator_Name (S)));
1561 1
                     Insert_Node_In_List
1562
                       (N,
1563
                        Port_Table_List,
1564
                        Get_Port_Enum_Pos'Access);
1565

1566
                     --  For each port, build the corresponding
1567
                     --  image association and append it to the
1568
                     --  association list.
1569

1570 1
                     if Max_Port_Image_Size < Port_Img_Length then
1571 1
                        Max_Port_Image_Size := Port_Img_Length;
1572
                     end if;
1573

1574
                     N :=
1575 1
                       Make_Element_Association
1576 1
                         (Make_Defining_Identifier (Enum_Name),
1577 1
                          Make_Literal (New_String_Value (Enum_Name)));
1578 1
                     Insert_Node_In_List
1579
                       (N,
1580
                        Port_Image_List,
1581
                        Get_Port_Enum_Pos'Access);
1582 1
                  end;
1583
               end if;
1584

1585 1
               F := Next_Node (F);
1586 1
            end loop;
1587

1588
         end if;
1589 1
      end Visit_Thread_Instance;
1590

1591
   end Package_Spec;
1592

1593 1
end Ocarina.Backends.PO_HI_Ada.Deployment;

Read our documentation on viewing source code .

Loading