OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--     O C A R I N A . B A C K E N D S . P O _ H I _ C . R E Q U E S T      --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--               Copyright (C) 2008-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.ME_AADL;
34
with Ocarina.ME_AADL.AADL_Instances.Nodes;
35
with Ocarina.ME_AADL.AADL_Instances.Nutils;
36
with Ocarina.Backends.Utils;
37
with Ocarina.ME_AADL.AADL_Instances.Entities;
38

39
with Ocarina.Backends.C_Common.Mapping;
40
with Ocarina.Backends.PO_HI_C.Runtime;
41
with Ocarina.Backends.C_Tree.Nutils;
42
with Ocarina.Backends.C_Tree.Nodes;
43
with Ocarina.Backends.C_Values;
44

45
with Ocarina.Backends.Properties;
46

47 1
package body Ocarina.Backends.PO_HI_C.Request is
48
   use Ocarina.ME_AADL;
49
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
50
   use Ocarina.Backends.Utils;
51
   use Ocarina.ME_AADL.AADL_Instances.Entities;
52
   use Ocarina.Backends.C_Common.Mapping;
53
   use Ocarina.Backends.PO_HI_C.Runtime;
54
   use Ocarina.Backends.C_Tree.Nutils;
55
   use Ocarina.Backends.Properties;
56

57
   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
58
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
59
   package CTN renames Ocarina.Backends.C_Tree.Nodes;
60
   package CV renames Ocarina.Backends.C_Values;
61

62
   -----------------
63
   -- Header_File --
64
   -----------------
65

66
   package body Header_File is
67

68
      procedure Visit_Architecture_Instance (E : Node_Id);
69
      procedure Visit_Process_Instance (E : Node_Id);
70
      procedure Visit_Thread_Instance (E : Node_Id);
71
      procedure Visit_Component_Instance (E : Node_Id);
72
      procedure Visit_System_Instance (E : Node_Id);
73

74
      --  Global variables for the generated entities. Note that it is
75
      --  safe to use global variable in this case because there is
76
      --  only one distributed application node and it is visited only
77
      --  once in this package.
78

79 1
      Request_Struct       : List_Id;
80 1
      Request_Union_List   : List_Id;
81 1
      Ports_Names_Array    : Node_Id;
82 1
      Operation_Identifier : Unsigned_Long_Long;
83 1
      Request_Declared     : Boolean;
84

85
      -----------
86
      -- Visit --
87
      -----------
88

89 1
      procedure Visit (E : Node_Id) is
90
      begin
91 1
         case Kind (E) is
92 1
            when K_Architecture_Instance =>
93 1
               Visit_Architecture_Instance (E);
94

95 1
            when K_Component_Instance =>
96 1
               Visit_Component_Instance (E);
97

98 0
            when others =>
99 0
               null;
100 1
         end case;
101 1
      end Visit;
102

103
      ---------------------------------
104
      -- Visit_Architecture_Instance --
105
      ---------------------------------
106

107 1
      procedure Visit_Architecture_Instance (E : Node_Id) is
108
      begin
109 1
         Visit (Root_System (E));
110 1
      end Visit_Architecture_Instance;
111

112
      ------------------------------
113
      -- Visit_Component_Instance --
114
      ------------------------------
115

116 1
      procedure Visit_Component_Instance (E : Node_Id) is
117
         Category : constant Component_Category :=
118 1
           Get_Category_Of_Component (E);
119
      begin
120 1
         case Category is
121 1
            when CC_System =>
122 1
               Visit_System_Instance (E);
123

124 1
            when CC_Process =>
125 1
               Visit_Process_Instance (E);
126

127 1
            when CC_Thread =>
128 1
               Visit_Thread_Instance (E);
129

130 1
            when others =>
131 1
               null;
132 1
         end case;
133 1
      end Visit_Component_Instance;
134

135
      ----------------------------
136
      -- Visit_Process_Instance --
137
      ----------------------------
138

139 1
      procedure Visit_Process_Instance (E : Node_Id) is
140 1
         S : Node_Id;
141
         U : constant Node_Id :=
142 1
           CTN.Distributed_Application_Unit
143 1
             (CTN.Naming_Node (Backend_Node (Identifier (E))));
144 1
         P          : constant Node_Id := CTN.Entity (U);
145 1
         N          : Node_Id;
146 1
         C          : Node_Id;
147 1
         D          : Node_Id;
148 1
         F          : Node_Id;
149 1
         J          : Node_Id;
150 1
         I          : Node_Id;
151
         The_System : constant Node_Id :=
152 1
           Parent_Component (Parent_Subcomponent (E));
153 1
         Device_Implementation : Node_Id;
154
      begin
155 1
         Push_Entity (P);
156 1
         Push_Entity (U);
157 1
         Set_Request_Header;
158

159
         --  Create the global lists
160

161 1
         Request_Struct := New_List (CTN.K_Enumeration_Literals);
162

163 1
         Operation_Identifier := 0;
164 1
         Request_Declared     := False;
165

166 1
         if not AINU.Is_Empty (Subcomponents (The_System)) then
167 1
            C := First_Node (Subcomponents (The_System));
168 1
            while Present (C) loop
169 1
               if AINU.Is_Device (Corresponding_Instance (C))
170
                 and then
171 1
                   Get_Bound_Processor (Corresponding_Instance (C)) =
172 1
                   Get_Bound_Processor (E)
173
               then
174
                  Device_Implementation :=
175 1
                    Get_Implementation (Corresponding_Instance (C));
176

177 1
                  if Device_Implementation /= No_Node then
178 1
                     if not AINU.Is_Empty
179 1
                         (AIN.Subcomponents (Device_Implementation))
180
                     then
181
                        N :=
182 1
                          First_Node (Subcomponents (Device_Implementation));
183 1
                        while Present (N) loop
184 1
                           Visit_Component_Instance
185 1
                             (Corresponding_Instance (N));
186 1
                           N := Next_Node (N);
187 1
                        end loop;
188
                     end if;
189
                  end if;
190
               end if;
191 1
               C := Next_Node (C);
192 1
            end loop;
193
         end if;
194

195 1
         if not AINU.Is_Empty (Features (E)) then
196 1
            C := First_Node (Features (E));
197

198 1
            while Present (C) loop
199 1
               if Kind (C) = K_Port_Spec_Instance
200 1
                 and then Is_Out (C)
201 1
                 and then not AINU.Is_Empty (Destinations (C))
202
               then
203 1
                  D := First_Node (Get_Destination_Ports (C));
204 1
                  while Present (D) loop
205 1
                     I := Item (D);
206

207 1
                     if Present (I)
208 1
                       and then Kind (I) = K_Port_Spec_Instance
209 1
                       and then not AINU.Is_Empty (Destinations (I))
210
                     then
211 1
                        F := First_Node (Get_Destination_Ports (I));
212 1
                        while Present (F) loop
213 1
                           J := Item (F);
214

215 1
                           if Present (J) then
216 1
                              Visit (Parent_Component (J));
217
                           end if;
218 1
                           F := Next_Node (F);
219 1
                        end loop;
220
                     end if;
221 1
                     D := Next_Node (D);
222 1
                  end loop;
223
               end if;
224

225 1
               C := Next_Node (C);
226 1
            end loop;
227
         end if;
228

229
         --  Visit all the subcomponents of the process
230

231 1
         if not AINU.Is_Empty (Subcomponents (E)) then
232 1
            S := First_Node (Subcomponents (E));
233 1
            while Present (S) loop
234
               --  Visit the component instance corresponding to the
235
               --  subcomponent S.
236

237 1
               Visit (Corresponding_Instance (S));
238 1
               S := Next_Node (S);
239 1
            end loop;
240
         end if;
241

242 1
         if Request_Declared then
243

244
            --  Create the enumeration type for all the operations of
245
            --  the distributed application.
246

247
            N :=
248 1
              Message_Comment
249
                ("Enumeration type for all the operations" &
250
                 " in the distributed application.");
251 1
            Append_Node_To_List (N, CTN.Declarations (Current_File));
252

253
            N :=
254 1
              Make_Member_Declaration
255 1
                (Defining_Identifier => Make_Defining_Identifier (MN (M_Port)),
256 1
                 Used_Type           => RE (RE_Port_T));
257 1
            Append_Node_To_List (N, Request_Struct);
258

259
            N :=
260 1
              Make_Member_Declaration
261 1
                (Defining_Identifier => Make_Defining_Identifier (MN (M_Vars)),
262
                 Used_Type           =>
263 1
                   Make_Union_Aggregate (Members => Request_Union_List));
264 1
            Append_Node_To_List (N, Request_Struct);
265

266
            N :=
267 1
              Make_Full_Type_Declaration
268 1
                (Defining_Identifier => RE (RE_Request_T),
269
                 Type_Definition     =>
270 1
                   Make_Struct_Aggregate (Members => Request_Struct));
271 1
            Append_Node_To_List (N, CTN.Declarations (Current_File));
272

273 1
            Bind_AADL_To_Request_Type (Identifier (E), N);
274

275
            N :=
276 1
              Make_Define_Statement
277 1
                (Defining_Identifier => RE (RE_Nb_Operations),
278
                 Value               =>
279 1
                   Make_Literal
280 1
                     (CV.New_Int_Value (Operation_Identifier, 1, 10)));
281 1
            Append_Node_To_List (N, CTN.Declarations (Current_File));
282

283 1
            Bind_AADL_To_Request (Identifier (E), Ports_Names_Array);
284
         else
285
            N :=
286 1
              Make_Full_Type_Declaration
287 1
                (Defining_Identifier => RE (RE_Request_T),
288 1
                 Type_Definition     => Make_Defining_Identifier (TN (T_Int)));
289 1
            Append_Node_To_List (N, CTN.Declarations (Current_File));
290

291 1
            Bind_AADL_To_Request_Type (Identifier (E), N);
292
         end if;
293

294 1
         Pop_Entity; -- U
295 1
         Pop_Entity; -- P
296 1
      end Visit_Process_Instance;
297

298
      ---------------------------
299
      -- Visit_System_Instance --
300
      ---------------------------
301

302 1
      procedure Visit_System_Instance (E : Node_Id) is
303 1
         S : Node_Id;
304
      begin
305 1
         Push_Entity (C_Root);
306

307 1
         Request_Union_List := New_List (CTN.K_Enumeration_Literals);
308

309 1
         Ports_Names_Array := Make_Array_Values;
310
         --  Visit all the subcomponents of the system
311

312 1
         if not AINU.Is_Empty (Subcomponents (E)) then
313 1
            S := First_Node (Subcomponents (E));
314 1
            while Present (S) loop
315
               --  Visit the component instance corresponding to the
316
               --  subcomponent S.
317

318 1
               Visit (Corresponding_Instance (S));
319 1
               S := Next_Node (S);
320 1
            end loop;
321
         end if;
322

323 1
         Pop_Entity; --  C_Root
324 1
      end Visit_System_Instance;
325

326
      ---------------------------
327
      -- Visit_Thread_Instance --
328
      ---------------------------
329

330 1
      procedure Visit_Thread_Instance (E : Node_Id) is
331 1
         F              : Node_Id;
332 1
         N              : Node_Id;
333 1
         V              : Node_Id;
334 1
         Struct_Members : List_Id;
335
      begin
336 1
         if Has_Ports (E) then
337 1
            F                := First_Node (Features (E));
338 1
            Request_Declared := True;
339 1
            Add_Include (RH (RH_Types));
340 1
            while Present (F) loop
341 1
               if Kind (F) = K_Port_Spec_Instance
342 1
                 and then No (Get_Handling (F, By_Node, H_C_Request_Spec))
343
               then
344 1
                  Set_Handling (F, By_Node, H_C_Request_Spec, F);
345 1
                  Request_Declared := True;
346

347 1
                  if Is_Data (F) then
348
                     V :=
349 1
                       Map_C_Data_Type_Designator (Corresponding_Instance (F));
350
                  else
351 1
                     V := RE (RE_Bool_T);
352
                  end if;
353

354 1
                  if V /= No_Node then
355 1
                     Struct_Members := New_List (CTN.K_Enumeration_Literals);
356 1
                     Append_Node_To_List
357 1
                       (Make_Member_Declaration
358
                          (Defining_Identifier =>
359 1
                             Make_Defining_Identifier
360 1
                               (Map_C_Enumerator_Name (F)),
361
                           Used_Type =>
362 1
                             Make_Struct_Aggregate
363
                               (Members => Struct_Members)),
364
                        Request_Union_List);
365

366
                     N :=
367 1
                       Make_Member_Declaration
368
                         (Defining_Identifier =>
369 1
                            Make_Defining_Identifier
370 1
                              (Map_C_Enumerator_Name (F)),
371
                          Used_Type => V);
372 1
                     Append_Node_To_List (N, Struct_Members);
373

374 1
                     if No (Backend_Node (Identifier (F)))
375
                       or else
376 1
                       (Present (Backend_Node (Identifier (F)))
377 1
                        and then No
378 1
                          (CTN.Request_Type_Node
379 1
                             (Backend_Node (Identifier (F)))))
380
                     then
381
                        N :=
382 1
                          Make_Literal
383 1
                            (CV.New_Pointed_Char_Value
384 1
                               (Map_C_Enumerator_Name (F)));
385 1
                        Append_Node_To_List
386
                          (N,
387 1
                           CTN.Values (Ports_Names_Array));
388

389 1
                        Bind_AADL_To_Request_Type (Identifier (F), N);
390
                     end if;
391
                  end if;
392
               end if;
393 1
               F := Next_Node (F);
394 1
            end loop;
395
         end if;
396 1
      end Visit_Thread_Instance;
397

398
   end Header_File;
399

400
   -----------------
401
   -- Source_File --
402
   -----------------
403

404
   package body Source_File is
405

406
      procedure Visit_Architecture_Instance (E : Node_Id);
407
      procedure Visit_Process_Instance (E : Node_Id);
408
      procedure Visit_Thread_Instance (E : Node_Id);
409
      procedure Visit_Component_Instance (E : Node_Id);
410
      procedure Visit_System_Instance (E : Node_Id);
411

412
      -----------
413
      -- Visit --
414
      -----------
415

416 1
      procedure Visit (E : Node_Id) is
417
      begin
418 1
         case Kind (E) is
419 1
            when K_Architecture_Instance =>
420 1
               Visit_Architecture_Instance (E);
421

422 1
            when K_Component_Instance =>
423 1
               Visit_Component_Instance (E);
424

425 0
            when others =>
426 0
               null;
427 1
         end case;
428 1
      end Visit;
429

430
      ---------------------------------
431
      -- Visit_Architecture_Instance --
432
      ---------------------------------
433

434 1
      procedure Visit_Architecture_Instance (E : Node_Id) is
435
      begin
436 1
         Visit (Root_System (E));
437 1
      end Visit_Architecture_Instance;
438

439
      ------------------------------
440
      -- Visit_Component_Instance --
441
      ------------------------------
442

443 1
      procedure Visit_Component_Instance (E : Node_Id) is
444
         Category : constant Component_Category :=
445 1
           Get_Category_Of_Component (E);
446
      begin
447 1
         case Category is
448 1
            when CC_System =>
449 1
               Visit_System_Instance (E);
450

451 1
            when CC_Process =>
452 1
               Visit_Process_Instance (E);
453

454 1
            when CC_Thread =>
455 1
               Visit_Thread_Instance (E);
456

457 1
            when others =>
458 1
               null;
459 1
         end case;
460 1
      end Visit_Component_Instance;
461

462
      ----------------------------
463
      -- Visit_Process_Instance --
464
      ----------------------------
465

466 1
      procedure Visit_Process_Instance (E : Node_Id) is
467
         U : constant Node_Id :=
468 1
           CTN.Distributed_Application_Unit
469 1
             (CTN.Naming_Node (Backend_Node (Identifier (E))));
470 1
         P : constant Node_Id := CTN.Entity (U);
471 1
         S : Node_Id;
472 1
         C : Node_Id;
473 1
         D : Node_Id;
474 1
         F : Node_Id;
475 1
         J : Node_Id;
476 1
         I : Node_Id;
477 1
         N : Node_Id;
478
      begin
479 1
         Push_Entity (P);
480 1
         Push_Entity (U);
481 1
         Set_Request_Source;
482

483 1
         Start_Recording_Handlings;
484

485 1
         if not AINU.Is_Empty (Features (E)) then
486 1
            C := First_Node (Features (E));
487

488 1
            while Present (C) loop
489 1
               if Kind (C) = K_Port_Spec_Instance
490 1
                 and then not AINU.Is_Empty (Destinations (C))
491
               then
492 1
                  D := First_Node (Destinations (C));
493 1
                  I := Item (D);
494

495 1
                  if Present (I)
496 1
                    and then Kind (I) = K_Port_Spec_Instance
497 1
                    and then not AINU.Is_Empty (Destinations (I))
498
                  then
499 1
                     F := First_Node (Get_Destination_Ports (I));
500 1
                     while Present (F) loop
501 1
                        J := Item (F);
502

503 1
                        if Present (J) then
504 1
                           Visit (Parent_Component (J));
505
                        end if;
506 1
                        F := Next_Node (F);
507 1
                     end loop;
508
                  end if;
509 1
                  D := Next_Node (D);
510
               end if;
511

512 1
               C := Next_Node (C);
513 1
            end loop;
514
         end if;
515

516
         --  Visit all the subcomponents of the process
517

518 1
         if not AINU.Is_Empty (Subcomponents (E)) then
519 1
            S := First_Node (Subcomponents (E));
520 1
            while Present (S) loop
521
               --  Visit the component instance corresponding to the
522
               --  subcomponent S.
523

524 1
               Visit (Corresponding_Instance (S));
525 1
               S := Next_Node (S);
526 1
            end loop;
527
         end if;
528

529 1
         if Present (Backend_Node (Identifier (E)))
530 1
           and then Present (CTN.Request_Node (Backend_Node (Identifier (E))))
531
         then
532
            N :=
533 1
              Make_Expression
534
                (Left_Expr =>
535 1
                   Make_Variable_Declaration
536
                     (Defining_Identifier =>
537 1
                        Make_Array_Declaration
538 1
                          (Defining_Identifier => RE (RE_Ports_Names),
539 1
                           Array_Size          => RE (RE_Nb_Ports)),
540
                      Used_Type =>
541 1
                        Make_Constant_Type
542 1
                          (Make_Pointer_Type
543 1
                             (Make_Defining_Identifier (TN (T_Char))))),
544
                 Operator   => Op_Equal,
545
                 Right_Expr =>
546 1
                   CTN.Request_Node (Backend_Node (Identifier (E))));
547

548 1
            Append_Node_To_List (N, CTN.Declarations (Current_File));
549
         end if;
550

551 1
         Reset_Handlings;
552

553 1
         Pop_Entity; -- U
554 1
         Pop_Entity; -- P
555 1
      end Visit_Process_Instance;
556

557
      ---------------------------
558
      -- Visit_System_Instance --
559
      ---------------------------
560

561 1
      procedure Visit_System_Instance (E : Node_Id) is
562 1
         S : Node_Id;
563
      begin
564 1
         Push_Entity (C_Root);
565

566
         --  Visit all the subcomponents of the system
567

568 1
         if not AINU.Is_Empty (Subcomponents (E)) then
569 1
            S := First_Node (Subcomponents (E));
570 1
            while Present (S) loop
571
               --  Visit the component instance corresponding to the
572
               --  subcomponent S.
573

574 1
               Visit (Corresponding_Instance (S));
575 1
               S := Next_Node (S);
576 1
            end loop;
577
         end if;
578

579 1
         Pop_Entity; --  C_Root
580 1
      end Visit_System_Instance;
581

582
      ---------------------------
583
      -- Visit_Thread_Instance --
584
      ---------------------------
585

586 1
      procedure Visit_Thread_Instance (E : Node_Id) is
587 1
         Call_Seq : Node_Id;
588 1
         Spg_Call : Node_Id;
589
      begin
590
         --  Visit all the call sequences of the thread
591

592 1
         if not AINU.Is_Empty (Calls (E)) then
593 1
            Call_Seq := First_Node (Calls (E));
594

595 1
            while Present (Call_Seq) loop
596
               --  For each call sequence visit all the called
597
               --  subprograms.
598

599 1
               if not AINU.Is_Empty (Subprogram_Calls (Call_Seq)) then
600 1
                  Spg_Call := First_Node (Subprogram_Calls (Call_Seq));
601

602 1
                  while Present (Spg_Call) loop
603 1
                     Visit (Corresponding_Instance (Spg_Call));
604

605 1
                     Spg_Call := Next_Node (Spg_Call);
606 1
                  end loop;
607
               end if;
608

609 1
               Call_Seq := Next_Node (Call_Seq);
610 1
            end loop;
611
         end if;
612 1
      end Visit_Thread_Instance;
613

614
   end Source_File;
615

616 1
end Ocarina.Backends.PO_HI_C.Request;

Read our documentation on viewing source code .

Loading