ocarina-backends-po_hi_c-request.adb 21.2 KB
Newer Older
1
2
3
4
5
6
7
8
------------------------------------------------------------------------------
--                                                                          --
--                           OCARINA COMPONENTS                             --
--                                                                          --
--     O C A R I N A . B A C K E N D S . P O _ H I _ C . R E Q U E S T      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
--    Copyright (C) 2008-2009 Telecom ParisTech, 2010-2015 ESA & ISAE.      --
--                                                                          --
-- Ocarina  is free software; you can redistribute it and/or modify under   --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
jhugues's avatar
jhugues committed
27
28
--                 Ocarina is maintained by the TASTE project               --
--                      (taste-users@lists.tuxfamily.org)                   --
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
--                                                                          --
------------------------------------------------------------------------------

with Ocarina.ME_AADL;
with Ocarina.ME_AADL.AADL_Instances.Nodes;
with Ocarina.ME_AADL.AADL_Instances.Nutils;
with Ocarina.Backends.Utils;
with Ocarina.ME_AADL.AADL_Instances.Entities;

with Ocarina.Backends.C_Common.Mapping;
with Ocarina.Backends.PO_HI_C.Runtime;
with Ocarina.Backends.C_Tree.Nutils;
with Ocarina.Backends.C_Tree.Nodes;
with Ocarina.Backends.C_Values;

44
45
with Ocarina.Backends.Properties;

46
47
48
49
50
51
52
53
package body Ocarina.Backends.PO_HI_C.Request is
   use Ocarina.ME_AADL;
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
   use Ocarina.Backends.Utils;
   use Ocarina.ME_AADL.AADL_Instances.Entities;
   use Ocarina.Backends.C_Common.Mapping;
   use Ocarina.Backends.PO_HI_C.Runtime;
   use Ocarina.Backends.C_Tree.Nutils;
54
   use Ocarina.Backends.Properties;
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

   package AIN renames Ocarina.ME_AADL.AADL_Instances.Nodes;
   package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
   package CTN renames Ocarina.Backends.C_Tree.Nodes;
   package CV renames Ocarina.Backends.C_Values;

   -----------------
   -- Header_File --
   -----------------

   package body Header_File is

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

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

78
79
80
81
82
      Request_Struct       : List_Id;
      Request_Union_List   : List_Id;
      Ports_Names_Array    : Node_Id;
      Operation_Identifier : Unsigned_Long_Long;
      Request_Declared     : Boolean;
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

      -----------
      -- Visit --
      -----------

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

            when K_Component_Instance =>
               Visit_Component_Instance (E);

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

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

      procedure Visit_Architecture_Instance (E : Node_Id) is
      begin
         Visit (Root_System (E));
      end Visit_Architecture_Instance;

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

      procedure Visit_Component_Instance (E : Node_Id) is
116
117
         Category : constant Component_Category :=
           Get_Category_Of_Component (E);
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
      begin
         case Category is
            when CC_System =>
               Visit_System_Instance (E);

            when CC_Process =>
               Visit_Process_Instance (E);

            when CC_Thread =>
               Visit_Thread_Instance (E);

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

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

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

         --  Create the global lists

160
         Request_Struct := New_List (CTN.K_Enumeration_Literals);
161

162
163
         Operation_Identifier := 0;
         Request_Declared     := False;
164

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

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

194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
         if not AINU.Is_Empty (Features (E)) then
            C := First_Node (Features (E));

            while Present (C) loop
               if Kind (C) = K_Port_Spec_Instance
                 and then Is_Out (C)
                 and then not AINU.Is_Empty (Destinations (C))
               then
                  D := First_Node (Destinations (C));
                  while Present (D) loop
                     I := Item (D);

                     if Present (I)
                       and then Kind (I) = K_Port_Spec_Instance
                       and then not AINU.Is_Empty (Destinations (I))
                     then
                        F := First_Node (Destinations (I));
                        while Present (F) loop
                           J := Item (F);

                           if Present (J) then
                              Visit (Parent_Component (J));
                           end if;
                           F := Next_Node (F);
                        end loop;
                     end if;
                     D := Next_Node (D);
                  end loop;
               end if;

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

         --  Visit all the subcomponents of the process

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

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

         if Request_Declared then

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

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

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

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

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

272
            Bind_AADL_To_Request_Type (Identifier (E), N);
273

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

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

290
            Bind_AADL_To_Request_Type (Identifier (E), N);
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
         end if;

         Pop_Entity; -- U
         Pop_Entity; -- P
      end Visit_Process_Instance;

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

      procedure Visit_System_Instance (E : Node_Id) is
         S : Node_Id;
      begin
         Push_Entity (C_Root);

306
         Request_Union_List := New_List (CTN.K_Enumeration_Literals);
307

308
         Ports_Names_Array := Make_Array_Values;
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
         --  Visit all the subcomponents of the system

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

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

         Pop_Entity; --  C_Root
      end Visit_System_Instance;

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

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

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

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

                     N :=
                       Make_Member_Declaration
                         (Defining_Identifier =>
                            Make_Defining_Identifier
                              (Map_C_Enumerator_Name (F)),
                          Used_Type => V);
371
372
373
                     Append_Node_To_List (N, Struct_Members);

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

388
                        Bind_AADL_To_Request_Type (Identifier (F), N);
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
                     end if;
                  end if;
               end if;
               F := Next_Node (F);
            end loop;
         end if;
      end Visit_Thread_Instance;

   end Header_File;

   -----------------
   -- Source_File --
   -----------------

   package body Source_File is

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

      -----------
      -- Visit --
      -----------

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

            when K_Component_Instance =>
               Visit_Component_Instance (E);

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

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

      procedure Visit_Architecture_Instance (E : Node_Id) is
      begin
         Visit (Root_System (E));
      end Visit_Architecture_Instance;

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

      procedure Visit_Component_Instance (E : Node_Id) is
443
444
         Category : constant Component_Category :=
           Get_Category_Of_Component (E);
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
      begin
         case Category is
            when CC_System =>
               Visit_System_Instance (E);

            when CC_Process =>
               Visit_Process_Instance (E);

            when CC_Thread =>
               Visit_Thread_Instance (E);

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

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

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

         Start_Recording_Handlings;

         if not AINU.Is_Empty (Features (E)) then
            C := First_Node (Features (E));

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

494
495
496
497
                  if Present (I)
                    and then Kind (I) = K_Port_Spec_Instance
                    and then not AINU.Is_Empty (Destinations (I))
                  then
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
                     F := First_Node (Destinations (I));
                     while Present (F) loop
                        J := Item (F);

                        if Present (J) then
                           Visit (Parent_Component (J));
                        end if;
                        F := Next_Node (F);
                     end loop;
                  end if;
                  D := Next_Node (D);
               end if;

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

         --  Visit all the subcomponents of the process

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

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

528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
         if Present (Backend_Node (Identifier (E)))
           and then Present (CTN.Request_Node (Backend_Node (Identifier (E))))
         then

            N :=
              Make_Expression
                (Left_Expr =>
                   Make_Variable_Declaration
                     (Defining_Identifier =>
                        Make_Array_Declaration
                          (Defining_Identifier => RE (RE_Ports_Names),
                           Array_Size          => RE (RE_Nb_Ports)),
                      Used_Type =>
                        Make_Constant_Type
                          (Make_Pointer_Type
                             (Make_Defining_Identifier (TN (T_Char))))),
                 Operator   => Op_Equal,
                 Right_Expr =>
                   CTN.Request_Node (Backend_Node (Identifier (E))));
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616

            Append_Node_To_List (N, CTN.Declarations (Current_File));
         end if;

         Reset_Handlings;

         Pop_Entity; -- U
         Pop_Entity; -- P
      end Visit_Process_Instance;

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

      procedure Visit_System_Instance (E : Node_Id) is
         S : Node_Id;
      begin
         Push_Entity (C_Root);

         --  Visit all the subcomponents of the system

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

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

         Pop_Entity; --  C_Root
      end Visit_System_Instance;

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

      procedure Visit_Thread_Instance (E : Node_Id) is
         Call_Seq : Node_Id;
         Spg_Call : Node_Id;
      begin
         --  Visit all the call sequences of the thread

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

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

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

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

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

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

   end Source_File;

end Ocarina.Backends.PO_HI_C.Request;