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 . M A I N         --
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.Namet; use 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.Properties;
41
with Ocarina.Backends.Utils;
42
with Ocarina.Backends.Messages;
43
with Ocarina.Backends.C_Tree.Nutils;
44
with Ocarina.Backends.C_Tree.Nodes;
45
with Ocarina.Backends.C_Values;
46
with Ocarina.Backends.PO_HI_C;
47
with Ocarina.Backends.PO_HI_C.Runtime;
48
with Ocarina.Backends.C_Common.Mapping;
49

50 1
package body Ocarina.Backends.PO_HI_C.Main is
51

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.Properties;
56
   use Ocarina.Backends.Messages;
57
   use Ocarina.Backends.C_Tree.Nutils;
58
   use Ocarina.Backends.C_Values;
59
   use Ocarina.Backends.PO_HI_C.Runtime;
60
   use Ocarina.Backends.C_Common.Mapping;
61
   use Ocarina.Backends.Utils;
62

63
   package AAU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
64
   package CTN renames Ocarina.Backends.C_Tree.Nodes;
65
   package CTU renames Ocarina.Backends.C_Tree.Nutils;
66

67
   ---------------------
68
   -- Subprogram_Body --
69
   ---------------------
70

71
   package body Source_File is
72

73 1
      Main_Function            : Node_Id;
74
      Current_Device           : Node_Id := No_Node;
75
      Period_Variable_Declared : Boolean := False;
76

77
      procedure Visit_Architecture_Instance (E : Node_Id);
78
      procedure Visit_Component_Instance (E : Node_Id);
79
      procedure Visit_System_Instance (E : Node_Id);
80
      procedure Visit_Process_Instance (E : Node_Id);
81
      procedure Visit_Device_Instance (E : Node_Id);
82
      procedure Visit_Thread_Instance (E : Node_Id);
83
      procedure Visit_Subprogram_Instance (E : Node_Id);
84

85
      procedure Setup_Thread (E : Node_Id);
86
      --  Create a task according to all its properties
87
      --  (like period, priority, ...). The task creation
88
      --  is made in the main function, calling the function
89
      --  __po_hi_create_<>_task().
90

91
      Ada_Initialized : Boolean := False;
92

93
      ------------------
94
      -- Setup_Thread --
95
      ------------------
96

97 1
      procedure Setup_Thread (E : Node_Id) is
98 1
         N          : Node_Id;
99 1
         Parameters : List_Id;
100 1
         Priority   : Unsigned_Long_Long;
101 1
         Stack_Size : Unsigned_Long_Long;
102 1
         Core_Id    : Unsigned_Long_Long;
103 1
         S          : constant Node_Id := Parent_Subcomponent (E);
104
      begin
105 1
         Parameters := New_List (CTN.K_Parameter_List);
106

107
         --  Add the task name to the parameters list
108

109
         N :=
110 1
           Make_Defining_Identifier
111 1
             (Map_C_Enumerator_Name (S, Custom_Parent => Current_Device));
112 1
         Append_Node_To_List (N, Parameters);
113

114
         --  Add the period of the task to the parameters list. We use
115
         --  the fact that an aperiodic thread is sporadic, with
116
         --  period of 0.
117 1
         if Period_Variable_Declared = False then
118 1
            N :=
119 1
              Make_Doxygen_C_Comment
120
                (Brief       => "Variable for task period",
121
                 Is_Variable => True,
122
                 Desc        =>
123
                   "This variable is used to store the value" &
124
                   "of the period of a task when we create it. The " &
125
                   "value put in the variable is set according to " &
126
                   "AADL model description",
127 1
                 Element_Name      => Get_Name_String (VN (V_Period)),
128
                 Has_Header_Spaces => False);
129 1
            Append_Node_To_List (N, CTN.Declarations (Main_Function));
130

131
            N :=
132 1
              Make_Variable_Declaration
133 1
                (Make_Defining_Identifier (VN (V_Period)),
134 1
                 RE (RE_Time_T));
135 1
            Append_Node_To_List (N, CTN.Declarations (Main_Function));
136

137 1
            Period_Variable_Declared := True;
138
         end if;
139

140 1
         N :=
141 1
           Make_Doxygen_C_Comment
142
             (Desc =>
143 1
                "Store the period time for task " &
144 1
                Get_Name_String (Name (Identifier (S))),
145
              Has_Header_Spaces => False);
146 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
147

148 1
         if Get_Thread_Dispatch_Protocol (E) /= Thread_Aperiodic
149 1
           and then Get_Thread_Dispatch_Protocol (E) /= Thread_Background
150
         then
151 1
            N := Map_Time (Get_Thread_Period (E), VN (V_Period));
152

153
         else
154 1
            N := Map_Time ((0, Second), VN (V_Period));
155
         end if;
156

157 1
         Append_Node_To_List
158 1
           (Make_Variable_Address (Make_Defining_Identifier (VN (V_Period))),
159
            Parameters);
160

161 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
162

163
         --  Add the priority of the task in the parameters list. If
164
         --  the task does not have any priority, we use the macro
165
         --  DEFAULT_PRIORITY.
166

167 1
         Priority := Get_Thread_Priority (E);
168 1
         if Priority = 0 then
169 1
            N := RE (RE_Default_Priority);
170
         else
171 1
            N := Make_Literal (New_Int_Value (Priority, 1, 10));
172
         end if;
173 1
         Append_Node_To_List (N, Parameters);
174

175
         --  Add thread stack size
176

177 1
         Stack_Size := To_Bytes (Get_Thread_Stack_Size (E));
178 1
         N          := Make_Literal (New_Int_Value (Stack_Size, 1, 10));
179 1
         Append_Node_To_List (N, Parameters);
180

181
         --  Add the core this thread is attached to
182

183 1
         Core_Id := Utils.Get_Core_Id (E);
184

185 1
         N := Make_Literal (New_Int_Value (Core_Id, 1, 10));
186 1
         Append_Node_To_List (N, Parameters);
187

188
         --  Add the name of function executed by the task in the
189
         --  parameters list.
190

191
         N :=
192 1
           Copy_Node
193 1
             (CTN.Defining_Identifier
194 1
                (CTN.Job_Node (Backend_Node (Identifier (S)))));
195 1
         Append_Node_To_List (N, Parameters);
196

197 1
         case Get_Thread_Dispatch_Protocol (E) is
198 1
            when Thread_Periodic =>
199 1
               N :=
200 1
                 Make_Doxygen_C_Comment
201
                   (Brief =>
202 1
                      "Making Periodic Task " &
203 1
                      Get_Name_String (Name (Identifier (S))),
204
                    Desc =>
205
                      "Make a periodic task according to " &
206
                      "AADL model requirements. The first " &
207
                      "parameter is the task identifier defined " &
208
                      "in deployment.h (" &
209 1
                      Get_Name_String
210 1
                        (Map_C_Enumerator_Name
211
                           (S,
212
                            Custom_Parent => Current_Device)) &
213
                      ") the second is the period " &
214
                      "defined in the AADL model. Third is the task " &
215
                      "priority (" &
216 1
                      Unsigned_Long_Long'Image (Get_Thread_Priority (E)) &
217
                      "), fourth is the stack size (" &
218 1
                      Unsigned_Long_Long'Image
219 1
                        (To_Bytes (Get_Thread_Stack_Size (E))) &
220 1
                      " bytes) and last is the subprogram executed " &
221
                      "by the task",
222
                    Has_Header_Spaces => False);
223 1
               Append_Node_To_List (N, CTN.Statements (Main_Function));
224

225 1
               Append_Node_To_List
226 1
                 (CTU.Make_Call_Profile
227 1
                    (RE (RE_Create_Periodic_Task),
228
                     Parameters),
229 1
                  CTN.Statements (Main_Function));
230

231 1
            when Thread_Sporadic | Thread_Aperiodic =>
232
               N :=
233 1
                 Make_Doxygen_C_Comment
234
                   ("Making Sporadic task",
235
                    Has_Header_Spaces => False);
236 1
               Append_Node_To_List (N, CTN.Statements (Main_Function));
237

238 1
               Append_Node_To_List
239 1
                 (CTU.Make_Call_Profile
240 1
                    (RE (RE_Create_Sporadic_Task),
241
                     Parameters),
242 1
                  CTN.Statements (Main_Function));
243

244 1
            when Thread_Background =>
245
               N :=
246 1
                 Make_Doxygen_C_Comment
247
                   ("Making background task",
248
                    Has_Header_Spaces => False);
249 1
               Append_Node_To_List (N, CTN.Statements (Main_Function));
250

251 1
               Append_Node_To_List
252 1
                 (CTU.Make_Call_Profile
253 1
                    (RE (RE_Create_Sporadic_Task),
254
                     Parameters),
255 1
                  CTN.Statements (Main_Function));
256

257 0
            when others =>
258 0
               Display_Located_Error
259 0
                 (Loc (E),
260
                  "Thread kind is not supported",
261
                  Fatal => True);
262 1
         end case;
263 1
      end Setup_Thread;
264

265
      -----------
266
      -- Visit --
267
      -----------
268

269 1
      procedure Visit (E : Node_Id) is
270
      begin
271 1
         case Kind (E) is
272 1
            when K_Architecture_Instance =>
273 1
               Visit_Architecture_Instance (E);
274

275 1
            when K_Component_Instance =>
276 1
               Visit_Component_Instance (E);
277

278 0
            when others =>
279 0
               null;
280 1
         end case;
281 1
      end Visit;
282

283
      ---------------------------------
284
      -- Visit_Architecture_Instance --
285
      ---------------------------------
286

287 1
      procedure Visit_Architecture_Instance (E : Node_Id) is
288
      begin
289 1
         Visit (Root_System (E));
290 1
      end Visit_Architecture_Instance;
291

292
      ------------------------------
293
      -- Visit_Component_Instance --
294
      ------------------------------
295

296 1
      procedure Visit_Component_Instance (E : Node_Id) is
297
         Category : constant Component_Category :=
298 1
           Get_Category_Of_Component (E);
299
      begin
300 1
         case Category is
301 1
            when CC_System =>
302 1
               Visit_System_Instance (E);
303

304 1
            when CC_Process =>
305 1
               Visit_Process_Instance (E);
306

307 1
            when CC_Thread =>
308 1
               Visit_Thread_Instance (E);
309

310 1
            when CC_Subprogram =>
311 1
               Visit_Subprogram_Instance (E);
312

313 1
            when others =>
314 1
               null;
315 1
         end case;
316 1
      end Visit_Component_Instance;
317

318
      ----------------------------
319
      -- Visit_Process_Instance --
320
      ----------------------------
321

322 1
      procedure Visit_Process_Instance (E : Node_Id) is
323
         U : constant Node_Id :=
324 1
           CTN.Distributed_Application_Unit
325 1
             (CTN.Naming_Node (Backend_Node (Identifier (E))));
326 1
         P            : constant Node_Id := CTN.Entity (U);
327 1
         N            : Node_Id;
328 1
         C            : Node_Id;
329 1
         S            : Node_Id;
330 1
         Spec         : Node_Id;
331 1
         Declarations : constant List_Id := New_List (CTN.K_Declaration_List);
332 1
         Statements   : constant List_Id := New_List (CTN.K_Statement_List);
333
         The_System   : constant Node_Id :=
334 1
           Parent_Component (Parent_Subcomponent (E));
335
      begin
336 1
         Push_Entity (P);
337 1
         Push_Entity (U);
338

339 1
         Set_Main_Source;
340 1
         Ada_Initialized := False;
341

342 1
         Period_Variable_Declared := False;
343

344 1
         Add_Include (E => RH (RH_Activity));
345

346
         --  Make the main function specification and add it in the current
347
         --  file (main.c).
348

349
         Spec :=
350 1
           Make_Function_Specification
351 1
             (Defining_Identifier => RE (RE_Main_Name),
352
              Parameters          => No_List,
353 1
              Return_Type         => RE (RE_Main_Type));
354 1
         Main_Function :=
355 1
           Make_Function_Implementation (Spec, Declarations, Statements);
356

357 1
         N := CTU.Make_Call_Profile (RE (RE_Initialize_Early));
358 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
359

360
         --  Visit all devices attached to the parent system that
361
         --  share the same processor as process E.
362
         --  This is done to initialize all devices before system starts.
363

364 1
         if not AAU.Is_Empty (Subcomponents (The_System)) then
365 1
            C := First_Node (Subcomponents (The_System));
366 1
            while Present (C) loop
367 1
               if AAU.Is_Device (Corresponding_Instance (C))
368
                 and then
369 1
                   Get_Bound_Processor (Corresponding_Instance (C)) =
370 1
                   Get_Bound_Processor (E)
371
               then
372 1
                  Visit_Device_Instance (Corresponding_Instance (C));
373
               end if;
374 1
               C := Next_Node (C);
375 1
            end loop;
376
         end if;
377

378
         N :=
379 1
           Make_Doxygen_C_Comment
380
             ("Initialize the runtime",
381
              Has_Header_Spaces => False);
382 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
383

384 1
         N := CTU.Make_Call_Profile (RE (RE_Initialize));
385 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
386

387 1
         if Process_Use_Defaults_Sockets (E) then
388 0
            Add_Include
389 0
              (Make_Include_Clause
390 0
                 (Make_Defining_Identifier
391 0
                    (Get_String_Name ("drivers/po_hi_driver_sockets"))));
392
            N :=
393 0
              Make_Call_Profile
394 0
                (Make_Defining_Identifier
395 0
                   (Get_String_Name ("__po_hi_driver_sockets_init")),
396 0
                 Make_List_Id (Make_Literal (New_Int_Value (0, 0, 10))));
397 0
            Append_Node_To_List (N, CTN.Statements (Main_Function));
398
         end if;
399

400
         --  Visit all threads and see if there is an initialize entrypoint.
401
         --  In that case, call the initialize entrypoint.
402

403
         --  There is two ways to deal with initialize entrypoint. The
404
         --  entrypoint can point a subprogram classifier (a node)
405
         --  or just reference text. We have to handle both cases.
406

407 1
         if not AAU.Is_Empty (Subcomponents (E)) then
408 1
            C := First_Node (Subcomponents (E));
409 1
            while Present (C) loop
410

411
               --  First, handle the case when the initialize_entrypoint
412
               --  is a subprogram classifier reference.
413

414 1
               if AAU.Is_Thread (Corresponding_Instance (C))
415
                 and then
416 1
                   Get_Thread_Initialize_Entrypoint
417 1
                     (Corresponding_Instance (C)) /=
418
                   No_Node
419
               then
420 1
                  Append_Node_To_List
421 1
                    (Make_Extern_Entity_Declaration
422 1
                       (Make_Function_Specification
423 1
                          (Map_C_Subprogram_Identifier
424 1
                             (Get_Thread_Initialize_Entrypoint
425 1
                                (Corresponding_Instance (C))),
426
                           Parameters  => No_List,
427 1
                           Return_Type => New_Node (CTN.K_Void))),
428 1
                     CTN.Declarations (Current_File));
429

430 1
                  Append_Node_To_List
431 1
                    (Make_Call_Profile
432 1
                       (Map_C_Subprogram_Identifier
433 1
                          (Get_Thread_Initialize_Entrypoint
434 1
                             (Corresponding_Instance (C))),
435
                        No_List),
436 1
                     CTN.Statements (Main_Function));
437
               end if;
438

439
               --  Then, handle the case when the initialize entrypoint
440
               --  is just a string.
441

442 1
               if AAU.Is_Thread (Corresponding_Instance (C))
443
                 and then
444 1
                   Get_Thread_Initialize_Entrypoint
445 1
                     (Corresponding_Instance (C)) /=
446
                   No_Name
447
               then
448 0
                  Append_Node_To_List
449 0
                    (Make_Extern_Entity_Declaration
450 0
                       (Make_Function_Specification
451 0
                          (Make_Defining_Identifier
452 0
                             (Get_Thread_Initialize_Entrypoint
453 0
                                (Corresponding_Instance (C))),
454
                           Parameters  => No_List,
455 0
                           Return_Type => New_Node (CTN.K_Void))),
456 0
                     CTN.Declarations (Current_File));
457

458 0
                  Append_Node_To_List
459 0
                    (Make_Call_Profile
460 0
                       (Make_Defining_Identifier
461 0
                          (Get_Thread_Initialize_Entrypoint
462 0
                             (Corresponding_Instance (C))),
463
                        No_List),
464 0
                     CTN.Statements (Main_Function));
465
               end if;
466

467 1
               C := Next_Node (C);
468 1
            end loop;
469
         end if;
470

471
         --  Here, we should automatically initialize the sockets layer
472

473 1
         if not AAU.Is_Empty (Subcomponents (E)) then
474 1
            S := First_Node (Subcomponents (E));
475 1
            while Present (S) loop
476
               --  Handle protected data, the following lines initialize
477
               --  the protected_id attribute for each protected data
478
               --  The generated code will look like :
479
               --  data_variable.protected_id = value.
480

481 1
               if AAU.Is_Data (Corresponding_Instance (S)) then
482
                  --  Automatically use the types.h header if we use
483
                  --  protected data.
484

485 1
                  Add_Include (RH (RH_Types));
486

487
                  N :=
488 1
                    Make_Variable_Declaration
489 1
                      (Map_C_Defining_Identifier (S),
490 1
                       Map_C_Data_Type_Designator
491 1
                         (Corresponding_Instance (S)));
492

493 1
                  Append_Node_To_List (N, CTN.Declarations (Current_File));
494

495 1
                  if Get_Concurrency_Protocol (Corresponding_Instance (S)) /=
496
                    None_Specified
497
                  then
498
                     N :=
499 0
                       Make_Expression
500
                         (Left_Expr =>
501 0
                            Make_Member_Designator
502
                              (Defining_Identifier =>
503 0
                                 Make_Defining_Identifier
504
                                   (MN (M_Protected_Id)),
505
                               Aggregate_Name =>
506 0
                                 Map_C_Defining_Identifier (S)),
507
                          Operator   => Op_Equal,
508
                          Right_Expr =>
509 0
                            CTN.Default_Value_Node
510 0
                              (Backend_Node (Identifier (S))));
511 0
                     Append_Node_To_List (N, CTN.Statements (Main_Function));
512
                  end if;
513
               else
514
                  --  Visit the component instance corresponding to the
515
                  --  subcomponent S.
516

517 1
                  Visit (Corresponding_Instance (S));
518
               end if;
519 1
               S := Next_Node (S);
520 1
            end loop;
521
         end if;
522

523
         N :=
524 1
           Make_Doxygen_C_Comment
525
             (Is_Function  => True,
526
              Element_Name => "__PO_HI_MAIN_TYPE __PO_HI_MAIN_NAME (void)",
527
              Brief        => "Main function executed by the system",
528
              Desc         =>
529
                "Full function name and return types are available " &
530
                " in the PolyORB-HI-C runtime header files.",
531
              Has_Header_Spaces => False);
532 1
         Append_Node_To_List (N, CTN.Declarations (Current_File));
533

534 1
         Append_Node_To_List (Main_Function, CTN.Declarations (Current_File));
535
         --  Call __po_hi_wait_initialization(). With this function,
536
         --  the main function will wait all other tasks initialization.
537

538
         N :=
539 1
           Make_Doxygen_C_Comment
540
             ("Waiting for other tasks initialization",
541
              Has_Header_Spaces => False);
542 1
         Append_Node_To_List (N, Statements);
543

544 1
         N := CTU.Make_Call_Profile (RE (RE_Wait_Initialization), No_List);
545 1
         Append_Node_To_List (N, Statements);
546

547
         --  Make the call to __po_hi_wait_for_tasks(). This function will wait
548
         --  all other task. In fact, no task will terminate, so this function
549
         --  will only switch the main task to the sleep state all the time.
550

551
         N :=
552 1
           Make_Doxygen_C_Comment
553
             ("Used to switch the main task to sleep all the time",
554
              Has_Header_Spaces => False);
555 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
556

557 1
         if not PO_HI_C.Use_Performance_Analysis then
558 1
            N := CTU.Make_Call_Profile (RE (RE_Wait_For_Tasks));
559
         else
560 0
            N := CTU.Make_Call_Profile (RE (RE_Wait_End_Of_Instrumentation));
561
         end if;
562

563 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
564

565
         N :=
566 1
           Make_Doxygen_C_Comment
567
             ("Return Statement",
568
              Has_Header_Spaces => False);
569 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
570

571 1
         N := CTU.Make_Return_Statement (RE (RE_Main_Return));
572 1
         Append_Node_To_List (N, CTN.Statements (Main_Function));
573

574 1
         Pop_Entity; -- U
575 1
         Pop_Entity; -- P
576 1
      end Visit_Process_Instance;
577

578
      ---------------------------
579
      -- Visit_System_Instance --
580
      ---------------------------
581

582 1
      procedure Visit_System_Instance (E : Node_Id) is
583 1
         S : Node_Id;
584
      begin
585 1
         Push_Entity (C_Root);
586

587
         --  Visit all the subcomponents of the system
588

589 1
         if not AAU.Is_Empty (Subcomponents (E)) then
590 1
            S := First_Node (Subcomponents (E));
591 1
            while Present (S) loop
592
               --  Visit the component instance corresponding to the
593
               --  subcomponent S.
594

595 1
               Visit (Corresponding_Instance (S));
596 1
               S := Next_Node (S);
597 1
            end loop;
598
         end if;
599

600 1
         Pop_Entity; --  C_Root
601 1
      end Visit_System_Instance;
602

603
      ---------------------------
604
      -- Visit_Thread_Instance --
605
      ---------------------------
606

607 1
      procedure Visit_Thread_Instance (E : Node_Id) is
608 1
         S        : Node_Id;
609 1
         Call_Seq : Node_Id;
610 1
         Spg_Call : Node_Id;
611
      begin
612 1
         if not AAU.Is_Empty (Subcomponents (E)) then
613 1
            S := First_Node (Subcomponents (E));
614 1
            while Present (S) loop
615
               --  Visit the component instance corresponding to the
616
               --  subcomponent S.
617

618 1
               Visit (Corresponding_Instance (S));
619 1
               S := Next_Node (S);
620 1
            end loop;
621
         end if;
622

623 1
         if not AAU.Is_Empty (Calls (E)) then
624 1
            Call_Seq := First_Node (Calls (E));
625

626 1
            while Present (Call_Seq) loop
627
               --  For each call sequence visit all the called
628
               --  subprograms.
629

630 1
               if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then
631 1
                  Spg_Call := First_Node (Subprogram_Calls (Call_Seq));
632

633 1
                  while Present (Spg_Call) loop
634 1
                     Visit (Corresponding_Instance (Spg_Call));
635

636 1
                     Spg_Call := Next_Node (Spg_Call);
637 1
                  end loop;
638
               end if;
639

640 1
               Call_Seq := Next_Node (Call_Seq);
641 1
            end loop;
642
         end if;
643

644 1
         Setup_Thread (E);
645 1
      end Visit_Thread_Instance;
646

647
      -------------------------------
648
      -- Visit_Subprogram_Instance --
649
      -------------------------------
650

651 1
      procedure Visit_Subprogram_Instance (E : Node_Id) is
652
--         Initialize_Function_Name : Name_Id;
653
--         Start_Function_Name : Name_Id;
654
      begin
655 1
         if Get_Subprogram_Kind (E) = Subprogram_Simulink then
656 0
            Add_Include
657 0
              (Make_Include_Clause
658 0
                 (Make_Defining_Identifier (Get_Source_Name (E), False),
659
                  False),
660
               True);
661

662
--            Set_Str_To_Name_Buffer ("MdlInitialize");
663

664
--            Initialize_Function_Name := Name_Find;
665

666
--            Append_Node_To_List
667
--               (CTU.Make_Call_Profile
668
--    (Make_Defining_Identifier (Initialize_Function_Name, False),
669
--                  No_List),
670
--               CTN.Declarations (Main_Function));
671

672
--            Set_Str_To_Name_Buffer ("MdlStart");
673

674
--            Start_Function_Name := Name_Find;
675

676
--            Append_Node_To_List
677
--               (CTU.Make_Call_Profile
678
--      (Make_Defining_Identifier (Start_Function_Name, False),
679
--                  No_List),
680
--               CTN.Declarations (Main_Function));
681

682 0
            Append_Node_To_List
683 0
              (CTU.Make_Call_Profile (RE (RE_Simulink_Init), No_List),
684 0
               CTN.Declarations (Main_Function));
685

686 1
         elsif Get_Subprogram_Kind (E) = Subprogram_Opaque_Ada_95
687 1
           and then not Ada_Initialized
688
         then
689 1
            Ada_Initialized := True;
690
            declare
691 1
               Parameter_List : constant List_Id := New_List (CTN.K_List_Id);
692 1
               N              : Node_Id;
693

694
            begin
695 1
               Set_Str_To_Name_Buffer ("adainit");
696
               N :=
697 1
                 Make_Extern_Entity_Declaration
698 1
                   (Make_Function_Specification
699 1
                      (Make_Defining_Identifier (Name_Find),
700
                       Parameters  => Parameter_List, --  XXX
701 1
                       Return_Type => New_Node (CTN.K_Void)));
702 1
               Append_Node_To_List (N, CTN.Declarations (Main_Function));
703

704 1
               Set_Str_To_Name_Buffer ("adainit");
705 1
               Append_Node_To_List
706 1
                 (CTU.Make_Call_Profile
707 1
                    (Make_Defining_Identifier (Name_Find),
708
                     No_List),
709 1
                  CTN.Statements (Main_Function));
710
            end;
711
         end if;
712 1
      end Visit_Subprogram_Instance;
713

714
      ---------------------------
715
      -- Visit_Device_Instance --
716
      ---------------------------
717

718 1
      procedure Visit_Device_Instance (E : Node_Id) is
719 1
         N          : Node_Id;
720 1
         S          : Node_Id;
721 1
         Entrypoint : constant Node_Id := Get_Thread_Initialize_Entrypoint (E);
722 1
         Impl       : constant Node_Id := Get_Implementation (E);
723
      begin
724 1
         Current_Device := E;
725

726 1
         if Entrypoint /= No_Node then
727
            N :=
728 1
              Make_Extern_Entity_Declaration
729 1
                (Make_Function_Specification
730 1
                   (Map_C_Subprogram_Identifier (Entrypoint),
731 1
                    Make_List_Id
732 1
                      (Make_Parameter_Specification
733 1
                         (Make_Defining_Identifier (Get_String_Name ("id")),
734 1
                          RE (RE_Device_Id))),
735 1
                    New_Node (CTN.K_Void)));
736 1
            Append_Node_To_List (N, CTN.Declarations (Current_File));
737

738
            N :=
739 1
              Make_Call_Profile
740 1
                (Map_C_Subprogram_Identifier (Entrypoint),
741 1
                 Make_List_Id
742 1
                   (Make_Defining_Identifier (Map_C_Enumerator_Name (E))));
743 1
            Append_Node_To_List (N, CTN.Statements (Main_Function));
744
         end if;
745

746 1
         if Impl /= No_Node then
747 1
            if not AAU.Is_Empty (Subcomponents (Impl)) then
748 1
               S := First_Node (Subcomponents (Impl));
749 1
               while Present (S) loop
750
                  --  Visit the component instance corresponding to the
751
                  --  subcomponent S.
752

753 1
                  Visit (Corresponding_Instance (S));
754 1
                  S := Next_Node (S);
755 1
               end loop;
756
            end if;
757
         end if;
758

759 1
         Current_Device := No_Node;
760 1
      end Visit_Device_Instance;
761

762
   end Source_File;
763

764 1
end Ocarina.Backends.PO_HI_C.Main;

Read our documentation on viewing source code .

Loading