1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--         O C A R I N A . B A C K E N D S . B U I L D _ U T I L S          --
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 Ada.Unchecked_Deallocation;
34

35
with GNAT.Directory_Operations;
36
with GNAT.OS_Lib;
37
with GNAT.Table;
38

39
with Ocarina.Namet;
40
with Ocarina.Output;
41
with Utils; use Utils;
42

43
with Ocarina.ME_AADL;
44
with Ocarina.ME_AADL.AADL_Instances.Nodes;
45
with Ocarina.ME_AADL.AADL_Instances.Nutils;
46
with Ocarina.Options;  use Ocarina.Options;
47
with Ocarina.ME_AADL.AADL_Instances.Entities;
48
with Ocarina.Backends; use Ocarina.Backends;
49
with Ocarina.Backends.Utils;
50
with Ocarina.Backends.Messages;
51
with Ocarina.Backends.Ada_Tree.Nutils;
52

53 2
package body Ocarina.Backends.Build_Utils is
54

55
   use GNAT.OS_Lib;
56
   use GNAT.Directory_Operations;
57
   use Ocarina.Namet;
58
   use Ocarina.Output;
59

60
   use Ocarina.ME_AADL;
61
   use Ocarina.ME_AADL.AADL_Instances.Nodes;
62
   use Ocarina.ME_AADL.AADL_Instances.Entities;
63
   use Ocarina.Backends.Utils;
64
   use Ocarina.Backends.Messages;
65

66
   package AAU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
67
   package ADU renames Ocarina.Backends.Ada_Tree.Nutils;
68

69
   procedure Split_Path
70
     (Filename  :     Name_Id;
71
      Directory :     Name_Id;
72
      Basename  : out Name_Id;
73
      Dirname   : out Name_Id;
74
      Relative_Path : Boolean := False);
75
   --  Split the path made of Filename and Directory into Basename and
76
   --  Dirname (with regular shell interpretations)
77
   --
78
   --  * If Relative_Path is true, and if Directory is not Ocarina
79
   --    install directory (case of runtime library elements), then we
80
   --    disregard Directory and assume the base directory to be "../.."
81
   --    relative to the generated code directory.
82
   --
83
   --  * If Relative_Path is false, the full directory path is
84
   --    resolved and is absolute to the user environment.
85

86
   function Resolve_Language (E : Node_Id) return Supported_Source_Language;
87
   --  Fetches the Source_Language property of E. If the property is
88
   --  not set, try to deduce the language from the current generator.
89

90
   generic
91
      --  This generic package is a generic list to store the "build
92
      --  utils" (makefiles, project files...). It provides accessor
93
      --  routines to allow a process node to find its corresponding
94
      --  "build util".
95

96
      type Build_Util is private;
97
      --  The type of "build util"
98

99
      Id : String;
100
      --  The Id of the generic table. It MUST be a unique string
101

102
      with procedure Free (T : in out Build_Util);
103
      --  For deallocation purpose
104

105
   package Generic_List is
106
      --  This package is a generic list to store the "build utils"
107
      --  (makefiles, project files...). It provides accessor routines
108
      --  to allow a process node to find its corresponding "build util".
109

110
      procedure Set (P : Node_Id; U : Build_Util);
111
      function Get (P : Node_Id) return Build_Util;
112

113
      procedure Free;
114
      --  Deallocates the table
115

116
      procedure Init;
117
      --  A call to this procedure is NECESSARY after any call to
118
      --  Free. It is not necessary before the first use of the table.
119

120
   end Generic_List;
121

122
   ------------
123
   -- Length --
124
   ------------
125

126 2
   function Length (T : Name_Tables.Instance) return Int is
127
   begin
128 1
      return Name_Tables.Last (T) - Name_Tables.First + 1;
129
   end Length;
130

131
   ----------------------
132
   -- Get_Runtime_Path --
133
   ----------------------
134

135 1
   function Get_Runtime_Path (Runtime_Name : String) return String is
136
   begin
137 2
      Get_Name_String (Installation_Directory);
138 2
      Add_Str_To_Name_Buffer ("include" & Directory_Separator);
139 2
      Add_Str_To_Name_Buffer ("ocarina" & Directory_Separator);
140 2
      Add_Str_To_Name_Buffer ("runtime" & Directory_Separator);
141 2
      Add_Str_To_Name_Buffer (Runtime_Name);
142

143 1
      declare
144 1
         Path : constant String := Get_Name_String (Name_Find);
145
      begin
146 2
         if not Is_Directory (Path) then
147 0
            Display_Error (Path & " is not a valid runtime directory", True);
148
         end if;
149 1
         return Path;
150 2
      end;
151
   end Get_Runtime_Path;
152

153
   ----------------
154
   -- Split_Path --
155
   ----------------
156

157 2
   procedure Split_Path
158
     (Filename  :     Name_Id;
159
      Directory :     Name_Id;
160
      Basename  : out Name_Id;
161
      Dirname   : out Name_Id;
162
      Relative_Path : Boolean := False)
163
   is
164 2
      Temp_Dirname : Name_Id := No_Name;
165 2
      AADL_Library_File : Boolean := False;
166
   begin
167 2
      if Relative_Path then
168 2
         Temp_Dirname := Get_String_Name
169 1
           (Normalize_Pathname (Get_Name_String (Directory)) & "/");
170 2
         if Temp_Dirname = Default_Library_Path then
171 2
            AADL_Library_File := True;
172
         end if;
173
      end if;
174

175 2
      if Relative_Path and then not
176 2
        AADL_Library_File
177
      then
178 2
         Set_Str_To_Name_Buffer ("../..");
179

180 2
      elsif Directory = No_Name then
181 2
         Set_Str_To_Name_Buffer (".");
182

183
      else
184 2
         Get_Name_String (Directory);
185
      end if;
186

187 2
      declare
188 1
         Normalized_Dir : constant String :=
189 1
           (if Relative_Path then
190 1
               Format_Pathname (Name_Buffer (1 .. Name_Len))
191
           else
192 1
               Normalize_Pathname (Name_Buffer (1 .. Name_Len)));
193

194 1
         Resolved_Filename : constant String :=
195 1
           (if Relative_Path then
196 2
               Format_Pathname (Normalized_Dir & "/"
197 1
                                  & Get_Name_String (Filename))
198
            else
199 2
               Normalize_Pathname (Get_Name_String (Filename),
200
                                   Normalized_Dir));
201

202
      begin
203 2
         Dirname  := Get_String_Name (Dir_Name (Resolved_Filename));
204 2
         Basename := Get_String_Name (Base_Name (Resolved_Filename));
205 2
      end;
206

207 1
   end Split_Path;
208

209
   ------------------
210
   -- Generic_List --
211
   ------------------
212

213
   package body Generic_List is
214

215
      package Internal_Table is new GNAT.Table (Build_Util, Nat, 1, 10, 10);
216
      --  The internal table
217

218
      function Get_Internal_Name (P : Node_Id) return Name_Id;
219
      --  For code factorization purpose
220

221
      -----------------------
222
      -- Get_Internal_Name --
223
      -----------------------
224

225 2
      function Get_Internal_Name (P : Node_Id) return Name_Id is
226 1
         pragma Assert (AAU.Is_Process (P));
227
      begin
228

229 1
         Set_Nat_To_Name_Buffer (Nat (P));
230 2
         Add_Str_To_Name_Buffer ('%' & Id & '%');
231 2
         return Name_Find;
232
      end Get_Internal_Name;
233

234
      ---------
235
      -- Set --
236
      ---------
237

238 2
      procedure Set (P : Node_Id; U : Build_Util) is
239 2
         I_Name : constant Name_Id := Get_Internal_Name (P);
240
      begin
241 2
         Internal_Table.Append (U);
242 2
         Set_Name_Table_Info (I_Name, Internal_Table.Last);
243 2
      end Set;
244

245
      ---------
246
      -- Get --
247
      ---------
248

249 2
      function Get (P : Node_Id) return Build_Util is
250 2
         I_Name : constant Name_Id := Get_Internal_Name (P);
251 1
         Index  : constant Nat     := Get_Name_Table_Info (I_Name);
252
      begin
253 2
         if Index = 0 then
254 0
            raise Program_Error
255
              with "Try to get a build utils which has" & " not been set";
256
         end if;
257

258 1
         return Internal_Table.Table (Index);
259
      end Get;
260

261
      ----------
262
      -- Init --
263
      ----------
264

265 0
      procedure Init is
266
      begin
267 0
         Internal_Table.Init;
268 0
      end Init;
269

270
      ----------
271
      -- Free --
272
      ----------
273

274 2
      procedure Free is
275
      begin
276 1
         for J in Internal_Table.First .. Internal_Table.Last loop
277 0
            Free (Internal_Table.Table (J));
278 0
         end loop;
279

280 2
         Internal_Table.Free;
281 2
         Internal_Table.Init;
282 2
      end Free;
283
   end Generic_List;
284

285
   ----------------------
286
   -- Resolve_Language --
287
   ----------------------
288

289 2
   function Resolve_Language (E : Node_Id) return Supported_Source_Language is
290 2
      Language : Supported_Source_Language := Get_Source_Language (E);
291
   begin
292
      --  If the user did not specify a language for E, we assume that
293
      --  the language is the current generator one.
294

295 2
      if Language = Language_None then
296 1
         case Get_Current_Backend_Kind is
297 2
            when PolyORB_HI_Ada =>
298 2
               Language := Language_Ada_95;
299

300 2
            when PolyORB_HI_C =>
301 2
               Language := Language_C;
302

303 0
            when others =>
304 0
               raise Program_Error;
305 2
         end case;
306
      end if;
307

308 2
      return Language;
309
   end Resolve_Language;
310

311
   ---------------
312
   -- Makefiles --
313
   ---------------
314

315
   package body Makefiles is
316

317
      procedure Visit_Architecture_Instance (E : Node_Id);
318
      procedure Visit_Component_Instance (E : Node_Id);
319
      procedure Visit_System_Instance (E : Node_Id);
320
      procedure Visit_Process_Instance (E : Node_Id);
321
      procedure Visit_Thread_Instance (E : Node_Id);
322
      procedure Visit_Subprogram_Instance
323
        (E            : Node_Id;
324
         Force_Parent : Node_Id := No_Node);
325
      procedure Visit_Port_Instance (E : Node_Id);
326
      procedure Visit_Bus_Instance (E : Node_Id);
327
      procedure Visit_Virtual_Bus_Instance (E : Node_Id);
328
      procedure Visit_Data_Instance (E : Node_Id);
329
      procedure Visit_Abstract_Instance (E : Node_Id);
330
      procedure Visit_Device_Instance (E : Node_Id);
331
      procedure Visit_Subcomponents_Of is new Visit_Subcomponents_Of_G (Visit);
332

333
      procedure Build_Architecture_Instance (E : Node_Id);
334
      procedure Build_Component_Instance (E : Node_Id);
335
      procedure Build_System_Instance (E : Node_Id);
336
      procedure Build_Process_Instance (E : Node_Id);
337

338
      procedure Clean_Architecture_Instance (E : Node_Id);
339
      procedure Clean_Component_Instance (E : Node_Id);
340
      procedure Clean_System_Instance (E : Node_Id);
341

342
      Current_Process : Node_Id := No_Node;
343

344
      Appli_Name : Name_Id := No_Name;
345
      --  Denotes the application name, derived from the AADL root system name
346

347
      type Makefile_Rec is record
348
         Appli_Name : Name_Id;
349
         --  The distributed application name
350

351
         Node_Name : Name_Id;
352
         --  The node name (in lower case)
353

354
         Execution_Platform : Supported_Execution_Platform := Platform_None;
355
         Execution_Platform_Name : Name_Id                      := No_Name;
356
         --  The execution platform of the processor the current node
357
         --  is bound to.
358

359
         USER_CFLAGS             : Name_Id := No_Name;
360
         USER_LDFLAGS            : Name_Id := No_Name;
361

362
         Transport_API : Supported_Transport_APIs;
363
         --  The transport API used by the current node to
364
         --  communicate with other nodes.
365

366
         C_Objs : Name_Tables.Instance;
367

368
         Ada_Sources : Name_Tables.Instance;
369

370
         Asn_Sources : Name_Tables.Instance;
371

372
         C_Sources : Name_Tables.Instance;
373
         --  The C source files that may implement some subprograms of
374
         --  the current node (absolute or relative path).
375

376
         CPP_Sources : Name_Tables.Instance;
377
         --  The C source files that may implement some subprograms of
378
         --  the current node (absolute or relative path).
379

380
         C_Libraries : Name_Tables.Instance;
381
         --  The C libraries that may contain the binary code of some
382
         --  subprograms of the current node (absolute or relative
383
         --  path).
384

385
         User_Source_Dirs : Name_Tables.Instance;
386
         --  Directories of the source files provided by the user
387

388
         Use_Transport : Boolean;
389
         --  Use_Transport is used to know if the node has in or out
390
         --  port If it uses transport, the C Makefiles will contain
391
         --  something like NEED_TRANSPORT = [yes|no]. It is used to
392
         --  know if the files that handle transport in PolyORB-HI-C
393
         --  should be compiled or not.
394

395
         Simulink_Directory : Name_Id;
396
         --  The Simulink_Directory corresponds to the directory
397
         --  that contains the simulink application code.
398

399
         Simulink_Node : Name_Id;
400
         --  The Simulink_Node is the name of the node we try to
401
         --  integrate in our AADL model.
402

403
         Use_Simulink : Boolean;
404
         --  Use_Simulink states if we integrate simulink application
405
         --  code or not.
406

407
         Scade_Directory : Name_Id;
408
         --  The Scade_Directory is the name of the directory that contains
409
         --  Scade source code.
410

411
         Use_Scade : Boolean;
412
         --  The Use_Scade variable tells the build-system if we try
413
         --  to integrate SCADE application code in our generated
414
         --  system.
415

416
      end record;
417
      --  This structure gathers all the information needed to
418
      --  generate a makefile for a given node of the distributed
419
      --  application.
420

421
      type Makefile_Type is access all Makefile_Rec;
422

423
      procedure Free (M : in out Makefile_Type);
424
      --  Deallocates the internals of T
425

426
      procedure Ada_C_Command_Line_Flags
427
        (Ada_Sources : Name_Tables.Instance;
428
         C_Sources   : Name_Tables.Instance;
429
         CPP_Sources : Name_Tables.Instance;
430
         C_Libraries : Name_Tables.Instance);
431

432
      procedure Compile_Ada_Files (Ada_Sources : Name_Tables.Instance);
433
      procedure Compile_C_Files (C_Sources : Name_Tables.Instance);
434
      procedure Compile_CPP_Files (CPP_Sources : Name_Tables.Instance);
435
      --  Generate a makefile target to compile C_Sources C files
436

437
      procedure Handle_C_Source
438
        (E                 : Node_Id;
439
         Implem_Name       : Name_Id;
440
         Source_Files      : Name_Array;
441
         M                 : Makefile_Type;
442
         Custom_Source_Dir : Name_Id := No_Name);
443
      --  Update the makefile structure by adding necessary paths to
444
      --  sources or libraries provided by the 'Source_Files' array. E
445
      --  is the node for which the source files are given, it is used
446
      --  to resolve relative paths through its absolute location.
447

448
      procedure Handle_CPP_Source
449
        (E                 : Node_Id;
450
         Implem_Name       : Name_Id;
451
         Source_Files      : Name_Array;
452
         M                 : Makefile_Type;
453
         Custom_Source_Dir : Name_Id := No_Name);
454
      --  Update the makefile structure by adding necessary paths to
455
      --  sources or libraries provided by the 'Source_Files' array. E
456
      --  is the node for which the source files are given, it is used
457
      --  to resolve relative paths through its absolute location.
458

459
      procedure Handle_Ada_Source
460
        (E            : Node_Id;
461
         Implem_Name  : Name_Id;
462
         Source_Files : Name_Array;
463
         M            : Makefile_Type);
464
      --  Update the makefile structure by adding necessary paths to
465
      --  sources or libraries provided by the 'Source_Files' array. E
466
      --  is the node for which the source files are given, it is used
467
      --  to resolve relative paths through its absolute location.
468

469
      ----------
470
      -- Free --
471
      ----------
472

473 0
      procedure Free (M : in out Makefile_Type) is
474
         procedure Deallocate is new Ada.Unchecked_Deallocation
475
           (Makefile_Rec,
476
            Makefile_Type);
477
      begin
478 0
         Name_Tables.Free (M.all.Ada_Sources);
479 0
         Name_Tables.Free (M.all.Asn_Sources);
480 0
         Name_Tables.Free (M.all.C_Objs);
481 0
         Name_Tables.Free (M.all.C_Sources);
482 0
         Name_Tables.Free (M.all.C_Libraries);
483 0
         Name_Tables.Free (M.all.User_Source_Dirs);
484

485 0
         Deallocate (M);
486 0
      end Free;
487

488
      package Makefiles is new Generic_List
489
        (Makefile_Type,
490
         "Makefile_List",
491
         Free);
492
      --  The list of all the makefile structures
493

494
      -----------
495
      -- Reset --
496
      -----------
497

498 2
      procedure Reset is
499
      begin
500 2
         Makefiles.Free;
501 2
      end Reset;
502

503
      -----------------------
504
      -- Handle_Ada_Source --
505
      -----------------------
506

507 2
      procedure Handle_Ada_Source
508
        (E            : Node_Id;
509
         Implem_Name  : Name_Id;
510
         Source_Files : Name_Array;
511
         M            : Makefile_Type)
512
      is
513 2
         Source_Basename : Name_Id;
514 2
         Source_Dirname  : Name_Id;
515 2
         S_Name          : Name_Id;
516

517
      begin
518
         --  Ensure the user gives at most one source file (.adb)
519

520 2
         if Source_Files'Length > 2 then
521 0
            Display_Located_Error
522 0
              (Loc (E),
523
               "cannot have more than two source files for an Ada subprogram",
524
               Fatal => True);
525

526 2
         elsif Source_Files'Length /= 0 and then Implem_Name /= No_Name then
527 2
            for J in Source_Files'Range loop
528
               --  Ensure the source is added only once per node
529

530 2
               Get_Name_String (Source_Files (J));
531 1
               Get_Name_String_And_Append (M.Node_Name);
532 2
               Add_Str_To_Name_Buffer ("%source_text%");
533 2
               S_Name := Name_Find;
534

535 2
               if Get_Name_Table_Info (S_Name) = 0 then
536 2
                  Set_Name_Table_Info (S_Name, 1);
537

538 2
                  Get_Name_String (Source_Files (J));
539

540 2
                  Split_Path
541
                    (Source_Files (J),
542 2
                     Loc (E).Dir_Name,
543
                     Source_Basename,
544
                     Source_Dirname);
545

546 2
                  Get_Name_String (Source_Basename);
547

548 1
                  if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" then
549 2
                     Get_Name_String (Source_Dirname);
550 2
                     Get_Name_String_And_Append (Source_Basename);
551

552 1
                     Name_Tables.Append (M.Ada_Sources, Name_Find);
553
                  end if;
554
               end if;
555 2
            end loop;
556
         end if;
557 2
      end Handle_Ada_Source;
558

559
      ---------------------
560
      -- Handle_C_Source --
561
      ---------------------
562

563 2
      procedure Handle_C_Source
564
        (E                 : Node_Id;
565
         Implem_Name       : Name_Id;
566
         Source_Files      : Name_Array;
567
         M                 : Makefile_Type;
568
         Custom_Source_Dir : Name_Id := No_Name)
569
      is
570 2
         Source_Basename : Name_Id;
571 2
         Source_Dirname  : Name_Id;
572 2
         S_Name          : Name_Id;
573
         Binding_Key     : constant String := "%user_src_dir%";
574
      begin
575
         --  Ensure the user gives at most one source file (.c)
576

577 2
         if Source_Files'Length > 1
578 2
           and then Get_Current_Backend_Kind = PolyORB_HI_Ada
579
         then
580 0
            Display_Located_Error
581 0
              (Loc (E),
582
               "more than one source files for a C subprogram",
583
               Fatal => True);
584
         end if;
585

586 2
         if Source_Files'Length = 0 and then Implem_Name /= No_Name then
587
            --  This means that the user did not provide source file
588
            --  names for the C implementation but did provide the
589
            --  implementation name. Therefore, the corresponding
590
            --  source files have conventional names and are located
591
            --  at the same directory as the AADL file.
592

593 2
            Split_Path
594
              (Implem_Name,
595 2
               Loc (E).Dir_Name,
596
               Source_Basename,
597
               Source_Dirname,
598
               Relative_Path => True);
599

600 2
            if Custom_Source_Dir /= No_Name then
601 0
               Source_Dirname := Custom_Source_Dir;
602
            end if;
603

604 2
            Set_Str_To_Name_Buffer (Binding_Key);
605 2
            Get_Name_String_And_Append (Source_Dirname);
606 1
            Get_Name_String_And_Append (M.Node_Name);
607

608 2
            if Get_Name_Table_Byte (Name_Find) = 0 then
609 1
               Name_Tables.Append (M.User_Source_Dirs, Source_Dirname);
610 2
               Set_Name_Table_Byte (Name_Find, 1);
611
            end if;
612

613 2
         elsif Source_Files'Length /= 0 then
614 2
            for J in Source_Files'Range loop
615
               --  Ensure the source is added only once per node
616

617 2
               Get_Name_String (Source_Files (J));
618 1
               Get_Name_String_And_Append (M.Node_Name);
619 2
               Add_Str_To_Name_Buffer ("%source_text%");
620 2
               S_Name := Name_Find;
621

622 2
               if Get_Name_Table_Info (S_Name) = 0 then
623 2
                  Set_Name_Table_Info (S_Name, 1);
624

625 2
                  Get_Name_String (Source_Files (J));
626

627
                  --  The path to the source file is deduced from the
628
                  --  path of the AADL entity definition
629

630 2
                  Split_Path
631
                    (Source_Files (J),
632 2
                     Loc (E).Dir_Name,
633
                     Source_Basename,
634
                     Source_Dirname,
635
                     Relative_Path => True);
636

637
                  --  If the directory points to the default AADL
638
                  --  property set directory (case of PolyORB-HI/C
639
                  --  provided driver), then we adjust the path to
640
                  --  point to the corresponding default installation
641
                  --  directory: PolyORB-HI/C runtime directory.
642

643 2
                  if Source_Dirname = Default_Library_Path then
644 2
                     Source_Dirname := Get_String_Name
645 2
                       (Get_Runtime_Path ("polyorb-hi-c"));
646
                     Source_Dirname :=
647 2
                       Add_Directory_Separator (Source_Dirname);
648 2
                     Get_Name_String (Source_Dirname);
649 2
                     Add_Str_To_Name_Buffer ("src/");
650 2
                     Source_Dirname := Name_Find;
651
                  end if;
652

653 2
                  if Custom_Source_Dir /= No_Name then
654 0
                     Source_Dirname := Custom_Source_Dir;
655
                  end if;
656

657 2
                  Get_Name_String (Source_Basename);
658

659 1
                  if Name_Buffer (Name_Len - 1 .. Name_Len) = ".o"
660 1
                    or else Name_Buffer (Name_Len - 1 .. Name_Len) = ".a"
661
                  then
662
                     --  Library names MUST begin with "lib"
663

664 0
                     if Name_Buffer (Name_Len - 1 .. Name_Len) = ".a"
665
                       and then
666 0
                       (Name_Len <= 5 or else Name_Buffer (1 .. 3) /= "lib")
667
                     then
668 0
                        Display_Error
669 0
                          ("Invalid library name" &
670 0
                           Name_Buffer (1 .. Name_Len),
671
                           Fatal => True);
672
                     end if;
673

674 0
                     Get_Name_String (Source_Dirname);
675 0
                     Get_Name_String_And_Append (Source_Basename);
676

677 0
                     Name_Tables.Append (M.C_Libraries, Name_Find);
678

679 1
                  elsif (Name_Buffer (Name_Len - 1 .. Name_Len) = ".c" or else
680 1
                           Name_Buffer (Name_Len - 3 .. Name_Len) = ".cpp")
681
                  then
682 2
                     if Source_Dirname /= Get_String_Name ("./") then
683 2
                        Get_Name_String (Source_Dirname);
684 2
                        Get_Name_String_And_Append (Source_Basename);
685
                     else
686 0
                        Get_Name_String (Source_Basename);
687
                     end if;
688

689 1
                     Name_Tables.Append (M.C_Sources, Name_Find);
690

691 2
                     Set_Str_To_Name_Buffer (Binding_Key);
692 2
                     Get_Name_String (Source_Dirname);
693 1
                     Get_Name_String_And_Append (M.Node_Name);
694

695 2
                     if Get_Name_Table_Byte (Name_Find) = 0 then
696 2
                        Name_Tables.Append
697 1
                          (M.User_Source_Dirs,
698
                           Source_Dirname);
699 2
                        Set_Name_Table_Byte (Name_Find, 1);
700
                     end if;
701

702
                  else
703 2
                     Set_Str_To_Name_Buffer (Binding_Key);
704 2
                     Get_Name_String (Source_Dirname);
705 1
                     Get_Name_String_And_Append (M.Node_Name);
706

707 2
                     if Get_Name_Table_Byte (Name_Find) = 0 then
708 2
                        Name_Tables.Append
709 1
                          (M.User_Source_Dirs,
710
                           Source_Dirname);
711 2
                        Set_Name_Table_Byte (Name_Find, 1);
712
                     end if;
713
                  end if;
714
               end if;
715 2
            end loop;
716
         end if;
717 2
      end Handle_C_Source;
718

719
      -----------------------
720
      -- Handle_CPP_Source --
721
      -----------------------
722

723 1
      procedure Handle_CPP_Source
724
        (E                 : Node_Id;
725
         Implem_Name       : Name_Id;
726
         Source_Files      : Name_Array;
727
         M                 : Makefile_Type;
728
         Custom_Source_Dir : Name_Id := No_Name)
729
      is
730 2
         Source_Basename : Name_Id;
731 2
         Source_Dirname  : Name_Id;
732 2
         S_Name          : Name_Id;
733
         Binding_Key     : constant String := "%user_src_dir%";
734
      begin
735
         --  Ensure the user gives at most one source file (.cc or .cpp)
736

737 2
         if Source_Files'Length > 1
738 0
           and then Get_Current_Backend_Kind = PolyORB_HI_Ada
739
         then
740 0
            Display_Located_Error
741 0
              (Loc (E),
742
               "more than one source files for a C++ subprogram",
743
               Fatal => True);
744
         end if;
745

746 1
         if Source_Files'Length = 0 and then Implem_Name /= No_Name then
747
            --  This means that the user did not provide source file
748
            --  names for the C implementation but did provide the
749
            --  implementation name. Therefore, the corresponding
750
            --  source files have conventional names and are located
751
            --  at the same directory as the AADL file.
752

753 0
            Split_Path
754
              (Implem_Name,
755 0
               Loc (E).Dir_Name,
756
               Source_Basename,
757
               Source_Dirname);
758

759 0
            if Custom_Source_Dir /= No_Name then
760 0
               Source_Dirname := Custom_Source_Dir;
761
            end if;
762

763 0
            Set_Str_To_Name_Buffer (Binding_Key);
764 0
            Get_Name_String_And_Append (Source_Dirname);
765 0
            Get_Name_String_And_Append (M.Node_Name);
766

767 0
            if Get_Name_Table_Byte (Name_Find) = 0 then
768 0
               Name_Tables.Append (M.User_Source_Dirs, Source_Dirname);
769 0
               Set_Name_Table_Byte (Name_Find, 1);
770
            end if;
771

772 2
         elsif Source_Files'Length /= 0 then
773 1
            for J in Source_Files'Range loop
774
               --  Ensure the source is added only once per node
775

776 2
               Get_Name_String (Source_Files (J));
777 1
               Get_Name_String_And_Append (M.Node_Name);
778 2
               Add_Str_To_Name_Buffer ("%source_text%");
779 2
               S_Name := Name_Find;
780

781 2
               if Get_Name_Table_Info (S_Name) = 0 then
782 2
                  Set_Name_Table_Info (S_Name, 1);
783

784 2
                  Get_Name_String (Source_Files (J));
785 2
                  Split_Path
786
                    (Source_Files (J),
787 2
                     Loc (E).Dir_Name,
788
                     Source_Basename,
789
                     Source_Dirname);
790

791 2
                  if Custom_Source_Dir /= No_Name then
792 0
                     Source_Dirname := Custom_Source_Dir;
793
                  end if;
794

795 2
                  Get_Name_String (Source_Basename);
796

797 1
                  if Name_Buffer (Name_Len - 1 .. Name_Len) = ".c"
798 1
                    or else Name_Buffer (Name_Len - 2 .. Name_Len) = ".cc"
799 1
                    or else Name_Buffer (Name_Len - 3 .. Name_Len) = ".cpp"
800
                  then
801 2
                     Get_Name_String (Source_Dirname);
802 2
                     Get_Name_String_And_Append (Source_Basename);
803

804 1
                     Name_Tables.Append (M.CPP_Sources, Name_Find);
805

806 2
                     Set_Str_To_Name_Buffer (Binding_Key);
807 2
                     Get_Name_String (Source_Dirname);
808 1
                     Get_Name_String_And_Append (M.Node_Name);
809

810 2
                     if Get_Name_Table_Byte (Name_Find) = 0 then
811 2
                        Name_Tables.Append
812 1
                          (M.User_Source_Dirs,
813
                           Source_Dirname);
814 2
                        Set_Name_Table_Byte (Name_Find, 1);
815
                     end if;
816

817
                  else
818 0
                     Set_Str_To_Name_Buffer (Binding_Key);
819 0
                     Get_Name_String (Source_Dirname);
820 0
                     Get_Name_String_And_Append (M.Node_Name);
821

822 0
                     if Get_Name_Table_Byte (Name_Find) = 0 then
823 0
                        Name_Tables.Append
824 0
                          (M.User_Source_Dirs,
825
                           Source_Dirname);
826 0
                        Set_Name_Table_Byte (Name_Find, 1);
827
                     end if;
828
                  end if;
829
               end if;
830 0
            end loop;
831
         end if;
832 2
      end Handle_CPP_Source;
833

834
      -----------
835
      -- Visit --
836
      -----------
837

838 2
      procedure Visit (E : Node_Id) is
839
      begin
840 1
         case Kind (E) is
841 2
            when K_Architecture_Instance =>
842 2
               Visit_Architecture_Instance (E);
843

844 2
            when K_Component_Instance =>
845 2
               Visit_Component_Instance (E);
846

847 2
            when K_Port_Spec_Instance =>
848 2
               Visit_Port_Instance (E);
849

850 0
            when others =>
851 0
               null;
852 1
         end case;
853 2
      end Visit;
854

855
      ---------------------------------
856
      -- Visit_Architecture_Instance --
857
      ---------------------------------
858

859 2
      procedure Visit_Architecture_Instance (E : Node_Id) is
860
      begin
861 2
         Visit (Root_System (E));
862 2
      end Visit_Architecture_Instance;
863

864
      ------------------------------
865
      -- Visit_Component_Instance --
866
      ------------------------------
867

868 2
      procedure Visit_Component_Instance (E : Node_Id) is
869
         Category : constant Component_Category :=
870 2
           Get_Category_Of_Component (E);
871
      begin
872 1
         case Category is
873 2
            when CC_System =>
874 2
               Visit_System_Instance (E);
875

876 2
            when CC_Process =>
877 2
               Visit_Process_Instance (E);
878

879 2
            when CC_Thread =>
880 2
               Visit_Thread_Instance (E);
881

882 2
            when CC_Bus =>
883 2
               Visit_Bus_Instance (E);
884

885 2
            when CC_Virtual_Bus =>
886 2
               Visit_Virtual_Bus_Instance (E);
887

888 2
            when CC_Device =>
889 2
               Visit_Device_Instance (E);
890

891 2
            when CC_Data =>
892 2
               Visit_Data_Instance (E);
893

894 2
            when CC_Abstract =>
895 2
               Visit_Abstract_Instance (E);
896

897 2
            when CC_Subprogram =>
898 2
               Visit_Subprogram_Instance (E);
899

900 2
            when others =>
901 2
               null;
902 2
         end case;
903 2
      end Visit_Component_Instance;
904

905
      ------------------------
906
      -- Visit_Bus_Instance --
907
      ------------------------
908

909 2
      procedure Visit_Bus_Instance (E : Node_Id) is
910
      begin
911 2
         Visit_Subcomponents_Of (E);
912 2
      end Visit_Bus_Instance;
913

914
      -----------------------------
915
      -- Visit_Abstract_Instance --
916
      -----------------------------
917

918 2
      procedure Visit_Abstract_Instance (E : Node_Id) is
919 2
         SC       : Node_Id;
920 2
         Instance : Node_Id;
921
      begin
922 2
         if not AAU.Is_Empty (Subcomponents (E)) then
923 2
            SC := First_Node (Subcomponents (E));
924

925 2
            while Present (SC) loop
926
               --  Visit the corresponding instance of SC
927 2
               Instance := Corresponding_Instance (SC);
928 2
               if (Get_Category_Of_Component (Instance) = CC_Subprogram) then
929 2
                  Visit_Subprogram_Instance (Instance, Current_Process);
930
               else
931 2
                  Visit (Instance);
932
               end if;
933

934 2
               SC := Next_Node (SC);
935 2
            end loop;
936
         end if;
937 2
      end Visit_Abstract_Instance;
938

939
      -------------------------
940
      -- Visit_Data_Instance --
941
      -------------------------
942

943 2
      procedure Visit_Data_Instance (E : Node_Id) is
944 2
         Source  : Name_Id;
945 1
         Sources : constant Name_Array    := Get_Source_Text (E);
946 2
         M       : constant Makefile_Type := Makefiles.Get (Current_Process);
947
      begin
948 2
         if Get_Source_Language (E) = Language_ASN1
949 0
           and then Sources'Length /= 0
950
         then
951 0
            Source := Sources (1);
952 0
            Name_Tables.Append (M.Asn_Sources, Source);
953
         end if;
954 2
      end Visit_Data_Instance;
955

956
      ---------------------------
957
      -- Visit_Device_Instance --
958
      ---------------------------
959

960 2
      procedure Visit_Device_Instance (E : Node_Id) is
961
      begin
962 2
         if Get_Implementation (E) /= No_Node then
963 2
            Visit (Get_Implementation (E));
964
         end if;
965

966 2
         Visit_Subcomponents_Of (E);
967 2
      end Visit_Device_Instance;
968

969
      --------------------------------
970
      -- Visit_Virtual_Bus_Instance --
971
      --------------------------------
972

973 2
      procedure Visit_Virtual_Bus_Instance (E : Node_Id) is
974
      begin
975 2
         if Get_Implementation (E) /= No_Node then
976 0
            Visit (Get_Implementation (E));
977
         end if;
978

979 2
         Visit_Subcomponents_Of (E);
980 2
      end Visit_Virtual_Bus_Instance;
981

982
      ----------------------------
983
      -- Visit_Process_Instance --
984
      ----------------------------
985

986 2
      procedure Visit_Process_Instance (E : Node_Id) is
987 2
         C              : Node_Id;
988 2
         S              : constant Node_Id       := Parent_Subcomponent (E);
989 2
         M              : constant Makefile_Type := new Makefile_Rec;
990 2
         SC             : Node_Id;
991 2
         Current_Device : Node_Id;
992 2
         Feature        : Node_Id;
993 2
         Parent         : Node_Id;
994 2
         Src            : Node_Id;
995 2
         Dst            : Node_Id;
996
         The_System     : constant Node_Id       :=
997 2
           Parent_Component (Parent_Subcomponent (E));
998
      begin
999
         --  Associates the Makefile structure to the process
1000
         --  instance. Keep in mind that it is important to use
1001
         --  accesses here because all the visited threads and
1002
         --  subprgrams will fetch this access to update the
1003
         --  corresponding structure.
1004

1005 2
         Current_Process := E;
1006

1007 2
         Makefiles.Set (E, M);
1008

1009 2
         M.Appli_Name    := Appli_Name;
1010 2
         M.Node_Name     := Normalize_Name (Name (Identifier (S)));
1011 2
         M.Use_Transport := False;
1012 2
         M.Use_Simulink  := False;
1013 2
         M.Use_Scade     := False;
1014

1015
         --  Get the execution platform of the processor this node is
1016
         --  bound to.
1017

1018 2
         M.Execution_Platform :=
1019 2
           Get_Execution_Platform (Get_Bound_Processor (E));
1020 2
         M.Execution_Platform_Name :=
1021 2
           Get_Execution_Platform (Get_Bound_Processor (E));
1022

1023 2
         M.USER_CFLAGS :=
1024 2
           Get_User_CFLAGS (Get_Bound_Processor (E));
1025 2
         M.USER_LDFLAGS :=
1026 2
           Get_User_LDFLAGS (Get_Bound_Processor (E));
1027

1028
         --  Get the transport API used by this node. It is
1029
         --  important to ensure that the Namings package visitors
1030
         --  have already been executed since they perform all
1031
         --  consistency checks and bind a node to its transport
1032
         --  API.
1033

1034 2
         M.Transport_API := Fetch_Transport_API (E);
1035

1036
         --  Initialize the lists
1037

1038 2
         Name_Tables.Init (M.Ada_Sources);
1039 2
         Name_Tables.Init (M.Asn_Sources);
1040 2
         Name_Tables.Init (M.C_Sources);
1041 2
         Name_Tables.Init (M.CPP_Sources);
1042 2
         Name_Tables.Init (M.C_Objs);
1043 2
         Name_Tables.Init (M.C_Libraries);
1044 2
         Name_Tables.Init (M.User_Source_Dirs);
1045

1046
         --  Visit all the subcomponents of the process
1047

1048 2
         if not AAU.Is_Empty (Subcomponents (E)) then
1049 2
            SC := First_Node (Subcomponents (E));
1050

1051 2
            while Present (SC) loop
1052
               --  Visit the corresponding instance of SC
1053

1054 2
               Visit (Corresponding_Instance (SC));
1055

1056 2
               SC := Next_Node (SC);
1057 2
            end loop;
1058
         end if;
1059

1060 2
         if not AAU.Is_Empty (Features (E)) then
1061 2
            Feature := First_Node (Features (E));
1062

1063 2
            while Present (Feature) loop
1064 2
               if not AAU.Is_Empty (Sources (Feature)) then
1065 2
                  Src := First_Node (Sources (Feature));
1066

1067 2
                  while Present (Src) loop
1068

1069 2
                     Parent := Parent_Component (Item (Src));
1070

1071 2
                     if AAU.Is_Process (Parent) and then Parent /= E then
1072 2
                        if Get_Provided_Virtual_Bus_Class (Extra_Item (Src)) /=
1073
                          No_Node
1074
                        then
1075 0
                           Visit
1076 0
                             (Get_Provided_Virtual_Bus_Class
1077 0
                                (Extra_Item (Src)));
1078
                        end if;
1079
                     end if;
1080

1081 2
                     Src := Next_Node (Src);
1082 2
                  end loop;
1083
               end if;
1084

1085
               --  The destinations of F
1086

1087 2
               if not AAU.Is_Empty (Destinations (Feature)) then
1088 2
                  Dst := First_Node (Destinations (Feature));
1089

1090 2
                  while Present (Dst) loop
1091 2
                     Parent := Parent_Component (Item (Dst));
1092

1093 2
                     if AAU.Is_Process (Parent) and then Parent /= E then
1094 2
                        if Get_Provided_Virtual_Bus_Class (Extra_Item (Dst)) /=
1095
                          No_Node
1096
                        then
1097 0
                           Visit
1098 0
                             (Get_Provided_Virtual_Bus_Class
1099 0
                                (Extra_Item (Dst)));
1100
                        end if;
1101
                     end if;
1102

1103 2
                     Dst := Next_Node (Dst);
1104 2
                  end loop;
1105
               end if;
1106

1107 2
               Feature := Next_Node (Feature);
1108 2
            end loop;
1109
         end if;
1110

1111
         --  We look for devices bound to the same processor
1112
         --  than the current process to find the file
1113
         --  that contains the configuration of the device.
1114

1115
         --  XXX dubious, we do not check processor bindings
1116

1117 2
         if not AAU.Is_Empty (Subcomponents (The_System)) then
1118 2
            C := First_Node (Subcomponents (The_System));
1119 2
            while Present (C) loop
1120 2
               if AAU.Is_Device (Corresponding_Instance (C)) then
1121 2
                  Current_Device := Corresponding_Instance (C);
1122 2
                  declare
1123 2
                     Source_Files : constant Name_Array :=
1124 1
                       Get_Source_Text (Current_Device);
1125
                  begin
1126 2
                     Handle_C_Source
1127 2
                       (Parent_Subcomponent (Current_Device),
1128
                        No_Name,
1129
                        Source_Files,
1130
                        M);
1131 2
                  end;
1132
               end if;
1133 2
               C := Next_Node (C);
1134 2
            end loop;
1135
         end if;
1136 2
      end Visit_Process_Instance;
1137

1138
      ---------------------------
1139
      -- Visit_System_Instance --
1140
      ---------------------------
1141

1142 2
      procedure Visit_System_Instance (E : Node_Id) is
1143
      begin
1144 2
         if Appli_Name = No_Name then
1145
            --  We need a unique application name, derived from the
1146
            --  root system. The application name is used to derive
1147
            --  the name of the root directory in which files are
1148
            --  generated.
1149

1150 2
            Appli_Name := Normalize_Name (Name (Identifier (E)));
1151
         end if;
1152

1153
         --  Visit all the subcomponents of the system
1154

1155 2
         Visit_Subcomponents_Of (E);
1156 2
      end Visit_System_Instance;
1157

1158
      ---------------------------
1159
      -- Visit_Thread_Instance --
1160
      ---------------------------
1161

1162 2
      procedure Visit_Thread_Instance (E : Node_Id) is
1163 2
         Parent_Process : Node_Id;
1164

1165 2
         M                     : Makefile_Type;
1166 2
         Compute_Entrypoint    : Name_Id;
1167
         Initialize_Entrypoint : constant Name_Id       :=
1168 2
           Get_Thread_Initialize_Entrypoint (E);
1169 2
         Language : constant Supported_Source_Language := Resolve_Language (E);
1170 1
         Source_Files : constant Name_Array := Get_Source_Text (E);
1171 2
         Call_Seq     : Node_Id;
1172 2
         Spg_Call     : Node_Id;
1173 2
         F            : Node_Id;
1174
      begin
1175 2
         if Present (Get_Container_Process (E)) then
1176
            Parent_Process :=
1177 2
              Corresponding_Instance (Get_Container_Process (E));
1178
         else
1179 2
            Parent_Process := Current_Process; --  XXX
1180
         end if;
1181

1182 2
         M := Makefiles.Get (Parent_Process);
1183

1184
         --  If the thread implementation is in C, we need to update
1185
         --  the makefile structure.
1186

1187 2
         if Language = Language_C then
1188 2
            Compute_Entrypoint := Get_Thread_Compute_Entrypoint (E);
1189 2
            Handle_C_Source (E, Compute_Entrypoint, Source_Files, M);
1190 2
            Handle_C_Source (E, Initialize_Entrypoint, Source_Files, M);
1191
         end if;
1192

1193
         --  Visit the features of the thread for possible source
1194
         --  files.
1195

1196 2
         if not AAU.Is_Empty (Features (E)) then
1197 2
            F := First_Node (Features (E));
1198

1199 2
            while Present (F) loop
1200 2
               if Kind (F) = K_Port_Spec_Instance then
1201 1
                  M.Use_Transport := True;
1202 2
                  if Is_In (F) then
1203 2
                     Visit (F);
1204
                  end if;
1205
               end if;
1206

1207 2
               F := Next_Node (F);
1208 2
            end loop;
1209
         end if;
1210

1211
         --  Visit all the call sequences of the thread
1212

1213 2
         if not AAU.Is_Empty (Calls (E)) then
1214 2
            Call_Seq := First_Node (Calls (E));
1215

1216 2
            while Present (Call_Seq) loop
1217
               --  For each call sequence visit all the called
1218
               --  subprograms.
1219

1220 2
               if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then
1221 2
                  Spg_Call := First_Node (Subprogram_Calls (Call_Seq));
1222

1223 2
                  while Present (Spg_Call) loop
1224 2
                     Visit (Corresponding_Instance (Spg_Call));
1225

1226 2
                     Spg_Call := Next_Node (Spg_Call);
1227 2
                  end loop;
1228
               end if;
1229

1230 2
               Call_Seq := Next_Node (Call_Seq);
1231 2
            end loop;
1232
         end if;
1233

1234 2
         Visit_Subcomponents_Of (E);
1235 2
      end Visit_Thread_Instance;
1236

1237
      -------------------------------
1238
      -- Visit_Subprogram_Instance --
1239
      -------------------------------
1240

1241 2
      procedure Visit_Subprogram_Instance
1242
        (E            : Node_Id;
1243
         Force_Parent : Node_Id := No_Node)
1244
      is
1245 2
         Parent_Process  : Node_Id;
1246 2
         M               : Makefile_Type;
1247
         Subprogram_Kind : constant Supported_Subprogram_Kind :=
1248 2
           Get_Subprogram_Kind (E);
1249 2
         Source_Name  : constant Name_Id    := Get_Source_Name (E);
1250 1
         Source_Files : constant Name_Array := Get_Source_Text (E);
1251 2
         Call_Seq     : Node_Id;
1252 2
         Spg_Call     : Node_Id;
1253 2
         Simulink_Dir : Name_Id;
1254 2
         Scade_Dir    : Name_Id;
1255
      begin
1256
         --  Only C subprogram influence the structure of the
1257
         --  generated makefile.
1258 2
         if Force_Parent /= No_Node then
1259 2
            Parent_Process := Force_Parent;
1260
         else
1261 2
            if Present (Get_Container_Process (E)) then
1262
               Parent_Process :=
1263 2
                 Corresponding_Instance (Get_Container_Process (E));
1264
            else
1265 2
               Parent_Process := Current_Process; --  XXX
1266
            end if;
1267
         end if;
1268

1269 2
         M := Makefiles.Get (Parent_Process);
1270

1271 1
         case Subprogram_Kind is
1272 2
            when Subprogram_Opaque_C =>
1273
               --  If the subprogram is implemented by C source files,
1274
               --  add the files to the C_Files list of the makefile
1275
               --  structure. If the subprogram is implemented by a C
1276
               --  library, add the files to the C_Libraries list of
1277
               --  the makefile structure.
1278

1279 2
               Handle_C_Source (E, Source_Name, Source_Files, M);
1280

1281 2
            when Subprogram_Opaque_CPP =>
1282
               --  If the subprogram is implemented by CPP source
1283
               --  files, add the files to the CPP_Files list of the
1284
               --  makefile structure. If the subprogram is
1285
               --  implemented by a CPP library, add the files to the
1286
               --  C_Libraries list of the makefile structure.
1287

1288 2
               Handle_CPP_Source (E, Source_Name, Source_Files, M);
1289

1290 2
            when Subprogram_Opaque_Ada_95 =>
1291
               --  If the subprogram is implemented by Ada source files,
1292
               --  add the files to the Ada_Files list of the makefile
1293
               --  structure.
1294

1295 2
               Handle_Ada_Source (E, Source_Name, Source_Files, M);
1296

1297 0
            when Subprogram_Scade =>
1298 0
               Scade_Dir         := Source_Files (1);
1299 0
               M.Use_Scade       := True;
1300 0
               M.Scade_Directory := Scade_Dir;
1301

1302 0
            when Subprogram_Simulink =>
1303 0
               Simulink_Dir := Source_Files (1);
1304

1305 0
               M.Use_Simulink := True;
1306

1307 0
               M.Simulink_Directory := Simulink_Dir;
1308 0
               M.Simulink_Node      := Source_Name;
1309

1310 0
               Set_Str_To_Name_Buffer ("");
1311 0
               Get_Name_String (Simulink_Dir);
1312 0
               Add_Str_To_Name_Buffer ("/");
1313 0
               Add_Str_To_Name_Buffer ("/*.o");
1314 0
               Name_Tables.Append (M.C_Objs, Name_Find);
1315

1316 2
            when others =>
1317 2
               null;
1318 1
         end case;
1319

1320
         --  Visit all the call sequences of the subprogram
1321

1322 2
         if not AAU.Is_Empty (Calls (E)) then
1323 2
            Call_Seq := First_Node (Calls (E));
1324

1325 2
            while Present (Call_Seq) loop
1326
               --  For each call sequence visit all the called
1327
               --  subprograms.
1328

1329 2
               if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then
1330 2
                  Spg_Call := First_Node (Subprogram_Calls (Call_Seq));
1331

1332 2
                  while Present (Spg_Call) loop
1333 2
                     Visit (Corresponding_Instance (Spg_Call));
1334

1335 2
                     Spg_Call := Next_Node (Spg_Call);
1336 2
                  end loop;
1337
               end if;
1338

1339 2
               Call_Seq := Next_Node (Call_Seq);
1340 2
            end loop;
1341
         end if;
1342 2
      end Visit_Subprogram_Instance;
1343

1344
      -------------------------
1345
      -- Visit_Port_Instance --
1346
      -------------------------
1347

1348 2
      procedure Visit_Port_Instance (E : Node_Id) is
1349
         Parent_Process : constant Node_Id :=
1350 2
           Corresponding_Instance
1351 2
             (Get_Container_Process (Parent_Component (E)));
1352 2
         M : constant Makefile_Type := Makefiles.Get (Parent_Process);
1353 2
         Language : constant Supported_Source_Language := Resolve_Language (E);
1354
         Compute_Entrypoint : constant Name_Id                   :=
1355 2
           Get_Port_Compute_Entrypoint (E);
1356 1
         Source_Files : constant Name_Array := Get_Source_Text (E);
1357 2
         Data         : Node_Id;
1358
      begin
1359
         --  If the port implementation is in C, we need to update
1360
         --  the makefile structure.
1361

1362 2
         if Language = Language_C then
1363 2
            Handle_C_Source (E, Compute_Entrypoint, Source_Files, M);
1364
         end if;
1365

1366 2
         if Is_Data (E) then
1367 2
            Data := Corresponding_Instance (E);
1368

1369 2
            if Get_Source_Language (Data) = Language_Simulink then
1370 0
               declare
1371 0
                  Source_Text : constant Name_Array := Get_Source_Text (Data);
1372
               begin
1373

1374 0
                  M.Use_Simulink := True;
1375

1376 0
                  if Source_Text'Length /= 0 then
1377 0
                     M.Simulink_Directory := Source_Text (1);
1378
                  end if;
1379

1380 0
                  if Get_Source_Name (Data) /= No_Name then
1381 0
                     M.Simulink_Node := Get_Source_Name (Data);
1382
                  end if;
1383 0
               end;
1384 2
            elsif Get_Source_Language (Data) = Language_ASN1 then
1385 0
               declare
1386 0
                  Source_Text : constant Name_Array := Get_Source_Text (Data);
1387
               begin
1388 0
                  if Get_Name_Table_Byte (Name_Find) = 0 then
1389 0
                     Name_Tables.Append (M.Asn_Sources, Source_Text (1));
1390 0
                     Set_Name_Table_Byte (Source_Text (1), 1);
1391
                  end if;
1392

1393 0
                  if Get_Source_Name (Data) /= No_Name then
1394 0
                     M.Simulink_Node := Get_Source_Name (Data);
1395
                  end if;
1396 0
               end;
1397
            else
1398 2
               declare
1399
                  Source_Name : constant Name_Id :=
1400 2
                    Get_Type_Source_Name (Data);
1401 1
                  Source_Files : constant Name_Array := Get_Source_Text (Data);
1402
               begin
1403 2
                  Handle_C_Source (E, Source_Name, Source_Files, M);
1404 2
               end;
1405
            end if;
1406

1407
         end if;
1408 2
      end Visit_Port_Instance;
1409

1410
      --------------
1411
      -- Generate --
1412
      --------------
1413

1414
      procedure Generate (E : Node_Id) is
1415

1416
         procedure Generate_Architecture_Instance (E : Node_Id);
1417
         procedure Generate_Component_Instance (E : Node_Id);
1418
         procedure Generate_System_Instance (E : Node_Id);
1419
         procedure Generate_Process_Instance (E : Node_Id);
1420
         procedure Generate_Processor_Instance (E : Node_Id);
1421

1422
         ------------------------------------
1423
         -- Generate_Architecture_Instance --
1424
         ------------------------------------
1425

1426 2
         procedure Generate_Architecture_Instance (E : Node_Id) is
1427
         begin
1428 2
            Generate (Root_System (E));
1429 2
         end Generate_Architecture_Instance;
1430

1431
         ---------------------------------
1432
         -- Generate_Component_Instance --
1433
         ---------------------------------
1434

1435 2
         procedure Generate_Component_Instance (E : Node_Id) is
1436
            Category : constant Component_Category :=
1437 2
              Get_Category_Of_Component (E);
1438
         begin
1439 1
            case Category is
1440 2
               when CC_System =>
1441 2
                  Generate_System_Instance (E);
1442

1443 2
               when CC_Processor =>
1444 2
                  Generate_Processor_Instance (E);
1445

1446 2
               when CC_Process =>
1447 2
                  Generate_Process_Instance (E);
1448

1449 2
               when others =>
1450 2
                  null;
1451 2
            end case;
1452 2
         end Generate_Component_Instance;
1453

1454
         ------------------------------
1455
         -- Generate_System_Instance --
1456
         ------------------------------
1457

1458 2
         procedure Generate_System_Instance (E : Node_Id) is
1459
            Dir_Name : constant Name_Id :=
1460 2
              Normalize_Name (Name (Identifier (E)));
1461

1462 2
            S  : Node_Id;
1463 2
            Fd : File_Descriptor;
1464

1465
         begin
1466

1467 2
            if Is_Directory (Get_Name_String (Dir_Name)) then
1468
               --  We create a makefile iff. the current system is the
1469
               --  root system. In the case of other systems,
1470
               --  e.g. case of a deep hierarchy with systems inside
1471
               --  systems, no source has been generated.
1472

1473 2
               Enter_Directory (Dir_Name);
1474

1475 2
               Fd := Create_File ("Makefile", Text);
1476 2
               if Fd = Invalid_FD then
1477 0
                  raise Program_Error;
1478
               end if;
1479

1480
               --  Setting the output
1481

1482 2
               Set_Output (Fd);
1483

1484 2
               Write_Line
1485
                 ("###################################################");
1486 2
               Write_Line
1487
                 ("# This Makefile has been generated automatically  #");
1488 2
               Write_Line
1489
                 ("# by the Ocarina AADL toolsuite                   #");
1490 1
               Write_Line ("# " & SCM_Version.all & ". #");
1491 2
               Write_Line
1492
                 ("# Do not edit this file, all your changes will    #");
1493 2
               Write_Line
1494
                 ("# be overridden at the next code generation.      #");
1495 2
               Write_Line
1496
                 ("###################################################");
1497 2
               Write_Eol;
1498 2
               Write_Line
1499
                 ("SUBDIRS = " &
1500
                    "$(filter-out Makefile polyorb-hi-c polyorb-hi-ada"
1501
                    & ", $(wildcard *))");
1502 2
               Write_Eol;
1503 2
               Write_Line ("all:");
1504 2
               Write_Line
1505
                 (ASCII.HT &
1506
                  "set -e; for d in $(SUBDIRS); do $(MAKE) -C $$d ; done");
1507 2
               Write_Eol;
1508

1509 2
               Write_Line ("coverage:");
1510 2
               Write_Line (ASCII.HT & "-rm lcov.args");
1511 2
               Write_Line (ASCII.HT & "touch lcov.args");
1512 2
               Write_Line (ASCII.HT & "for d in $(SUBDIRS); do \");
1513 2
               Write_Line (ASCII.HT & ASCII.HT &
1514
               "lcov -c -i -d $$d -o coverage.$$d ;\");
1515 2
               Write_Line (ASCII.HT & ASCII.HT &
1516
               "lcov -c -d $$d -o coverage.$$d ;\");
1517 2
               Write_Line (ASCII.HT & ASCII.HT &
1518
               "echo ""-a coverage.$$d "" >> lcov.args ;\");
1519 2
               Write_Line (ASCII.HT & "done");
1520 2
               Write_Line (ASCII.HT
1521
                             & "lcov `cat lcov.args` -o coverage.total");
1522 2
               Write_Line (ASCII.HT &
1523
                             "genhtml --no-branch-coverage " &
1524
                             "-o ../gcov_output coverage.total");
1525 2
               Write_Line (ASCII.HT & "rm lcov.args coverage.*");
1526 2
               Write_Eol;
1527 2
               Write_Line ("clean:");
1528 2
               Write_Line
1529
                 (ASCII.HT &
1530
                  "set -e; for d in $(SUBDIRS); do $(MAKE) " &
1531
                  "clean -C $$d ; done");
1532

1533
               --  Close the file
1534

1535 2
               Close (Fd);
1536 2
               Set_Standard_Output;
1537

1538
               --  Copy the runtime directory
1539

1540 2
               if Get_Current_Backend_Kind = PolyORB_HI_C then
1541 2
                  Copy_Directory
1542 2
                    (Get_Runtime_Path ("polyorb-hi-c"), "polyorb-hi-c");
1543
               else
1544 2
                  if Get_Current_Backend_Kind = PolyORB_HI_Ada then
1545 2
                     Copy_Directory
1546 2
                       (Get_Runtime_Path ("polyorb-hi-ada"), "polyorb-hi-ada");
1547
                  end if;
1548
               end if;
1549

1550 2
               Leave_Directory;
1551
            end if;
1552

1553
            --  Generate the makefiles of all process subcomponents
1554

1555 2
            if not AAU.Is_Empty (Subcomponents (E)) then
1556 2
               S := First_Node (Subcomponents (E));
1557

1558 2
               while Present (S) loop
1559 2
                  Generate (Corresponding_Instance (S));
1560 2
                  S := Next_Node (S);
1561 2
               end loop;
1562
            end if;
1563 2
         end Generate_System_Instance;
1564

1565
         -------------------------------
1566
         -- Generate_Process_Instance --
1567
         -------------------------------
1568

1569 2
         procedure Generate_Process_Instance (E : Node_Id) is
1570 2
            M  : constant Makefile_Type := Makefiles.Get (E);
1571 2
            Fd : File_Descriptor;
1572
         begin
1573
            --  Enter the directories
1574

1575 1
            Enter_Directory (M.Appli_Name);
1576 2
            Enter_Directory (M.Node_Name);
1577

1578
            --  Create the file
1579

1580 2
            Fd := Create_File ("Makefile", Text);
1581

1582 2
            if Fd = Invalid_FD then
1583 0
               raise Program_Error;
1584
            end if;
1585

1586
            --  Setting the output
1587

1588 2
            Set_Output (Fd);
1589

1590 2
            Write_Line ("###################################################");
1591 2
            Write_Line ("# This Makefile has been generated automatically  #");
1592 2
            Write_Line ("# by the Ocarina AADL toolsuite                   #");
1593 1
            Write_Line ("# " & SCM_Version.all & ". #");
1594 2
            Write_Line ("# Do not edit this file, all your changes will    #");
1595 2
            Write_Line ("# be overridden at the next code generation.      #");
1596 2
            Write_Line ("###################################################");
1597 2
            Write_Eol;
1598

1599 2
            Write_Str ("#  Distributed application name : ");
1600 2
            Write_Name (M.Appli_Name);
1601 2
            Write_Eol;
1602

1603 2
            Write_Str ("#  Node name                    : ");
1604 2
            Write_Name (M.Node_Name);
1605 2
            Write_Eol;
1606

1607 2
            Write_Str ("#  Execution platform           : ");
1608 2
            Write_Name (M.Execution_Platform_Name);
1609 2
            if M.Execution_Platform = Platform_None then
1610 2
               Write_Eol;
1611 2
               Write_Str ("#   Note: user defined");
1612
            end if;
1613 2
            Write_Eol;
1614

1615 1
            Write_Line
1616 1
              ("#  Transport API                : " & M.Transport_API'Img);
1617

1618 2
            Write_Eol;
1619

1620 2
            if Get_Current_Backend_Kind = PolyORB_HI_C then
1621 2
               Write_Str ("USER_OBJS = ");
1622 2
               if Length (M.C_Objs) > 0 then
1623 0
                  for J in Name_Tables.First .. Name_Tables.Last (M.C_Objs)
1624
                  loop
1625 0
                     Write_Name (M.C_Objs.Table (J));
1626 0
                     exit when J = Name_Tables.Last (M.C_Objs);
1627

1628 0
                     Write_Line (" \");
1629 0
                     Write_Str (ASCII.HT & "   ");
1630 0
                  end loop;
1631 0
                  Write_Eol;
1632
               end if;
1633

1634 2
               Ada_C_Command_Line_Flags
1635
                 (M.Ada_Sources,
1636
                  M.C_Sources,
1637
                  M.CPP_Sources,
1638
                  M.C_Libraries);
1639

1640 2
               if Length (M.Ada_Sources) > 0 then
1641 2
                  Write_Line ("USER_LD=gnatlink `cat ali_file`");
1642
               end if;
1643
            else
1644 2
               Write_Str ("C_OBJECTS=");
1645 2
               Ada_C_Command_Line_Flags
1646
                 (M.Ada_Sources,
1647
                  M.C_Sources,
1648
                  M.CPP_Sources,
1649
                  M.C_Libraries);
1650
            end if;
1651 2
            Write_Eol;
1652

1653 2
            Generate_Runtime_Specific
1654
              (M.Appli_Name,
1655
               M.Node_Name,
1656
               M.Execution_Platform,
1657
               M.Execution_Platform_Name,
1658
               M.USER_CFLAGS,
1659
               M.USER_LDFLAGS,
1660
               M.Transport_API,
1661
               M.Ada_Sources,
1662
               M.Asn_Sources,
1663
               M.C_Sources,
1664
               M.C_Libraries,
1665
               M.User_Source_Dirs,
1666
               M.Use_Transport,
1667
               M.Use_Simulink,
1668
               M.Simulink_Directory,
1669
               M.Simulink_Node,
1670
               M.Use_Scade,
1671
               M.Scade_Directory);
1672

1673
            --  Add user-defined environment variable
1674

1675
            declare
1676 2
               Env : constant Name_Id := Get_USER_ENV
1677 2
                 (Get_Bound_Processor (E));
1678
            begin
1679 2
               if Env /= No_Name then
1680 0
                  Write_Str ("export ");
1681 0
                  Write_Name (Env);
1682 0
                  Write_Eol;
1683
               end if;
1684
            end;
1685

1686
            --  Add rule to compile the C files, if any
1687

1688 2
            Write_Eol;
1689 2
            Compile_C_Files (M.C_Sources);
1690 2
            Write_Eol;
1691

1692 2
            Compile_CPP_Files (M.CPP_Sources);
1693 2
            Write_Eol;
1694

1695 2
            Compile_Ada_Files (M.Ada_Sources);
1696 2
            Write_Eol;
1697

1698 2
            if Get_Current_Backend_Kind = PolyORB_HI_Ada then
1699 2
               Write_Line ("prove:");
1700 2
               Write_Line
1701
                 (ASCII.HT &
1702
                  "gnatprove -P$(PROJECT_FILE) -XTARGET=SPARK " &
1703
                  "--warnings=continue --report=fail");
1704
            end if;
1705

1706
            --  Close the file
1707

1708 2
            Close (Fd);
1709 2
            Set_Standard_Output;
1710

1711
            --  Leave the directories
1712

1713 2
            Leave_Directory;
1714 2
            Leave_Directory;
1715 2
         end Generate_Process_Instance;
1716

1717
         ---------------------------------
1718
         -- Generate_Processor_Instance --
1719
         ---------------------------------
1720

1721 2
         procedure Generate_Processor_Instance (E : Node_Id) is
1722 2
            Fd         : File_Descriptor;
1723 2
            S          : Node_Id;
1724 2
            The_System : Node_Id;
1725 2
            PID        : Unsigned_Long_Long := 0;
1726
         begin
1727

1728
            --  The following part is very specific to PolyORB-HI-C
1729
            --  and especially to the code generator for Xtratum. It
1730
            --  creates a Makefile to make the final Makefile that
1731
            --  integrates all partitions together.
1732

1733 2
            if Get_Current_Backend_Kind /= PolyORB_HI_C then
1734 2
               return;
1735
            end if;
1736

1737 2
            if Get_Execution_Platform (E) /= Platform_LEON3_XTRATUM then
1738 2
               return;
1739
            end if;
1740

1741 2
            The_System := Parent_Component (Parent_Subcomponent (E));
1742

1743
            --  Enter the directories
1744

1745 2
            Enter_Directory
1746 2
              (To_Lower
1747 2
                 (Normalize_Name (Display_Name (Identifier (The_System)))));
1748

1749
            --  Create the file
1750

1751 2
            Fd :=
1752 2
              Create_File
1753 1
                ("Makefile." &
1754 2
                 Get_Name_String
1755 2
                   (To_Lower
1756 2
                      (Normalize_Name
1757 2
                         (Display_Name (Identifier (The_System))))),
1758
                 Text);
1759

1760 2
            if Fd = Invalid_FD then
1761 0
               raise Program_Error;
1762
            end if;
1763

1764
            --  Setting the output
1765

1766 2
            Set_Output (Fd);
1767

1768 2
            Write_Line ("###################################################");
1769 2
            Write_Line ("# This Makefile has been generated automatically  #");
1770 2
            Write_Line ("# by the Ocarina AADL toolsuite                   #");
1771 1
            Write_Line ("# " & SCM_Version.all & ". #");
1772 2
            Write_Line ("# Do not edit this file, all your changes will    #");
1773 2
            Write_Line ("# be overridden at the next code generation.      #");
1774 2
            Write_Line ("###################################################");
1775 2
            Write_Eol;
1776

1777
            --  The following syntax escapes whitespace in the path
1778

1779 2
            Write_Line ("RUNTIME_PATH=../polyorb-hi-c");
1780 2
            Write_Eol;
1781

1782 2
            Write_Str ("all: build-partitions resident_sw");
1783

1784 2
            Write_Eol;
1785 2
            Write_Eol;
1786

1787 2
            Write_Str ("MAINAPP=");
1788 2
            Write_Name
1789 2
              (To_Lower
1790 2
                 (Normalize_Name (Display_Name (Identifier (The_System)))));
1791 2
            Write_Eol;
1792

1793 2
            Write_Str ("PARTITIONS_NAME=");
1794
            --  Generate the makefiles of all process subcomponents
1795

1796 2
            if not AAU.Is_Empty (Subcomponents (The_System)) then
1797 2
               S := First_Node (Subcomponents (The_System));
1798

1799 2
               while Present (S) loop
1800 2
                  if AAU.Is_Process (Corresponding_Instance (S)) then
1801 2
                     Write_Name
1802 2
                       (To_Lower
1803 2
                          (Normalize_Name (Display_Name (Identifier (S)))));
1804 2
                     Write_Space;
1805
                  end if;
1806 2
                  S := Next_Node (S);
1807 2
               end loop;
1808
            end if;
1809 2
            Write_Eol;
1810

1811 2
            Write_Str ("PARTITIONS=");
1812

1813
            --  Generate the makefiles of all process subcomponents
1814

1815 2
            if not AAU.Is_Empty (Subcomponents (The_System)) then
1816 2
               S := First_Node (Subcomponents (The_System));
1817

1818 2
               while Present (S) loop
1819 2
                  if AAU.Is_Process (Corresponding_Instance (S)) then
1820 2
                     Write_Name
1821 2
                       (To_Lower
1822 2
                          (Normalize_Name (Display_Name (Identifier (S)))));
1823 2
                     Write_Str ("/");
1824 2
                     Write_Name
1825 2
                       (To_Lower
1826 2
                          (Normalize_Name (Display_Name (Identifier (S)))));
1827 2
                     Write_Str (".xef");
1828 2
                     Write_Space;
1829
                  end if;
1830 2
                  S := Next_Node (S);
1831 2
               end loop;
1832
            end if;
1833 2
            Write_Eol;
1834 2
            Write_Eol;
1835

1836 2
            Write_Str ("GENERATED_PACK_ARGS=");
1837

1838
            --  Generate the makefiles of all process subcomponents
1839

1840 2
            if not AAU.Is_Empty (Subcomponents (The_System)) then
1841 2
               S := First_Node (Subcomponents (The_System));
1842

1843 2
               while Present (S) loop
1844 2
                  if AAU.Is_Process (Corresponding_Instance (S)) then
1845 2
                     Write_Str ("-p ");
1846

1847 2
                     Write_Str (Unsigned_Long_Long'Image (PID));
1848 2
                     Write_Str (":");
1849 2
                     Write_Name
1850 2
                       (To_Lower
1851 2
                          (Normalize_Name (Display_Name (Identifier (S)))));
1852 2
                     Write_Str ("/");
1853 2
                     Write_Name
1854 2
                       (To_Lower
1855 2
                          (Normalize_Name (Display_Name (Identifier (S)))));
1856 2
                     Write_Str (".xef");
1857 2
                     Write_Space;
1858 2
                     PID := PID + 1;
1859
                  end if;
1860 2
                  S := Next_Node (S);
1861 2
               end loop;
1862
            end if;
1863 2
            Write_Eol;
1864 2
            Write_Eol;
1865

1866 2
            Write_Str ("include $(RUNTIME_PATH)/make/Makefile.leon3-xtratum");
1867

1868 2
            Write_Eol;
1869 2
            Write_Eol;
1870

1871 2
            Close (Fd);
1872

1873 2
            Set_Standard_Output;
1874

1875
            --  Leave the directories
1876

1877 2
            Leave_Directory;
1878
         end Generate_Processor_Instance;
1879

1880
      --  Main part of Generate begins here
1881

1882
      begin
1883
         case Kind (E) is
1884
            when K_Architecture_Instance =>
1885
               Generate_Architecture_Instance (E);
1886

1887
            when K_Component_Instance =>
1888
               Generate_Component_Instance (E);
1889

1890
            when others =>
1891
               null;
1892
         end case;
1893
      end Generate;
1894

1895
      ------------------------------
1896
      -- Ada_C_Command_Line_Flags --
1897
      ------------------------------
1898

1899 2
      procedure Ada_C_Command_Line_Flags
1900
        (Ada_Sources : Name_Tables.Instance;
1901
         C_Sources   : Name_Tables.Instance;
1902
         CPP_Sources : Name_Tables.Instance;
1903
         C_Libraries : Name_Tables.Instance)
1904
      is
1905
      begin
1906 2
         if Length (Ada_Sources) > 0
1907 2
           or else Length (C_Sources) > 0
1908 2
           or else Length (C_Libraries) > 0
1909
         then
1910 2
            Write_Str (" ");
1911
         end if;
1912

1913
         --  In case of Ada source files, link has to be performed by
1914
         --  gnatlink (as of August 2011 and decision made to get rid
1915
         --  of C binder file). The actual list of Ada object file is
1916
         --  retrived form the binder generated file, hence there is
1917
         --  no need to add them.
1918

1919
         --  In case of C source files, we add the corresponding .o
1920
         --  files.
1921

1922 2
         if Length (C_Sources) > 0 then
1923 2
            if Get_Current_Backend_Kind = PolyORB_HI_C
1924 2
              and then Length (Ada_Sources) > 0
1925
            then
1926 2
               Write_Line (" \");
1927 2
               Write_Str (ASCII.HT & "   ");
1928
            end if;
1929

1930 1
            for J in Name_Tables.First .. Name_Tables.Last (C_Sources) loop
1931 1
               Get_Name_String (C_Sources.Table (J));
1932 2
               Set_Str_To_Name_Buffer
1933 1
                 (Base_Name (Name_Buffer (1 .. Name_Len)));
1934

1935 1
               if Name_Buffer (Name_Len - 2 .. Name_Len) = "cpp" then
1936 0
                  Name_Buffer (Name_Len - 2 .. Name_Len) := "o  ";
1937
               else
1938 1
                  Name_Buffer (Name_Len) := 'o';
1939
               end if;
1940 2
               Write_Name (Name_Find);
1941

1942 2
               exit when J = Name_Tables.Last (C_Sources);
1943

1944 2
               Write_Line (" \");
1945 2
               Write_Str (ASCII.HT & "   ");
1946 2
            end loop;
1947
         end if;
1948

1949 2
         if Length (CPP_Sources) > 0 then
1950 2
            Write_Line (" \");
1951 2
            Write_Str (ASCII.HT & "   ");
1952 1
            for J in Name_Tables.First .. Name_Tables.Last (CPP_Sources) loop
1953 1
               Get_Name_String (CPP_Sources.Table (J));
1954 2
               Set_Str_To_Name_Buffer
1955 1
                 (Base_Name (Name_Buffer (1 .. Name_Len)));
1956

1957 1
               if Name_Buffer (Name_Len - 2 .. Name_Len) = "cpp" then
1958 1
                  Name_Buffer (Name_Len - 2 .. Name_Len) := "o  ";
1959 1
               elsif Name_Buffer (Name_Len - 1 .. Name_Len) = "cc" then
1960 1
                  Name_Buffer (Name_Len - 1 .. Name_Len) := "o ";
1961 0
               elsif Name_Buffer (Name_Len - 1 .. Name_Len) = ".c" then
1962 0
                  Name_Buffer (Name_Len - 1 .. Name_Len) := ".o ";
1963
               end if;
1964

1965 2
               Write_Name (Name_Find);
1966

1967 2
               exit when J = Name_Tables.Last (CPP_Sources);
1968

1969 0
               Write_Line (" \");
1970 0
               Write_Str (ASCII.HT & "   ");
1971 0
            end loop;
1972
         end if;
1973

1974
         --  In case of C libraries or objects, we add the
1975
         --  corresponding option.
1976

1977 2
         if Length (C_Libraries) > 0 then
1978 0
            Write_Line (" \");
1979 0
            Write_Str (ASCII.HT & "   ");
1980

1981 0
            for J in Name_Tables.First .. Name_Tables.Last (C_Libraries) loop
1982 0
               Get_Name_String (C_Libraries.Table (J));
1983

1984
               --  Some tests
1985

1986 0
               declare
1987 0
                  Is_Object : constant Boolean := Name_Buffer (Name_Len) = 'o';
1988 0
                  Dirname   : constant String  :=
1989 0
                    Dir_Name (Name_Buffer (1 .. Name_Len));
1990 0
                  Basename : constant String :=
1991 0
                    Base_Name (Name_Buffer (1 .. Name_Len));
1992
               begin
1993 0
                  if Is_Object then
1994 0
                     Write_Name (C_Libraries.Table (J));
1995
                  else
1996 0
                     Write_Str ("-L" & Dirname & ' ');
1997 0
                     Write_Str ("-l");
1998 0
                     Write_Str
1999 0
                       (Basename (Basename'First + 3 .. Basename'Last));
2000
                  end if;
2001 0
               end;
2002

2003 0
               exit when J = Name_Tables.Last (C_Libraries);
2004

2005 0
               Write_Line (" \");
2006 0
               Write_Str (ASCII.HT & "   ");
2007 0
            end loop;
2008
         end if;
2009 2
         Write_Eol;
2010

2011 2
         if Length (CPP_Sources) > 0 then
2012 2
            Write_Line ("USE_CPP_LINKER = true");
2013
         end if;
2014 2
      end Ada_C_Command_Line_Flags;
2015

2016
      ---------------------
2017
      -- Compile_C_Files --
2018
      ---------------------
2019

2020 2
      procedure Compile_C_Files (C_Sources : Name_Tables.Instance) is
2021
      begin
2022
         --  Define VPATH, search path for all prerequisites
2023

2024 2
         Write_Str ("VPATH = ../..");
2025 2
         if Scenario_Dir /= null then
2026 1
            Write_Str (":" & Scenario_Dir.all);
2027
         end if;
2028

2029 2
         if Length (C_Sources) > 0 then
2030 1
            for J in Name_Tables.First .. Name_Tables.Last (C_Sources) loop
2031 2
               Write_Str (":");
2032 2
               Write_Str
2033 1
                 (Dir_Name (Get_Name_String (C_Sources.Table (J))));
2034 2
               exit when J = Name_Tables.Last (C_Sources);
2035 2
            end loop;
2036
         end if;
2037 2
         Write_Eol;
2038 2
         Write_Eol;
2039

2040
         --  Generic rule for compiling C files
2041

2042 2
         Write_Line ("%.o : %.c");
2043 2
         Write_Char (ASCII.HT);
2044 2
         Write_Str ("$(CC) -c $(INCLUDE) $(CFLAGS) " &
2045
                      "-I""$(RUNTIME_PATH)/include"" ");
2046 2
         if Scenario_Dir /= null then
2047 1
            Write_Str ("-I""" & Remove_Directory_Separator (Scenario_Dir.all)
2048 1
                         & """ ");
2049
         end if;
2050 2
         Write_Line (" $< -o $@");
2051 2
         Write_Eol;
2052

2053
         --  compile-c-files rule, simply build $(USER_OBJS)
2054

2055 2
         Write_Line ("compile-c-files: $(USER_OBJS) $(C_OBJECTS)");
2056

2057 2
      end Compile_C_Files;
2058

2059
      -----------------------
2060
      -- Compile_CPP_Files --
2061
      -----------------------
2062

2063 2
      procedure Compile_CPP_Files (CPP_Sources : Name_Tables.Instance) is
2064
      begin
2065 2
         if Length (CPP_Sources) > 0 then
2066 2
            Write_Line ("USE_CPP_LINKER = 1");
2067 2
            Write_Str ("VPATH += ");
2068 1
            for J in Name_Tables.First .. Name_Tables.Last (CPP_Sources) loop
2069 2
               Write_Str (":");
2070 2
               Write_Str
2071 1
                 (Dir_Name (Get_Name_String (CPP_Sources.Table (J))));
2072 2
               exit when J = Name_Tables.Last (CPP_Sources);
2073 0
            end loop;
2074
         end if;
2075 2
         Write_Eol;
2076 2
         Write_Eol;
2077

2078
         --  Generic rule for compiling C++ files
2079

2080 2
         Write_Line ("%.o : %.cpp");
2081 2
         Write_Char (ASCII.HT);
2082 2
         Write_Str ("$(CXX) -c $(INCLUDE) $(CFLAGS) " &
2083
                      "-I""$(RUNTIME_PATH)/include"" ");
2084 2
         if Scenario_Dir /= null then
2085 1
            Write_Str ("-I""" & Remove_Directory_Separator (Scenario_Dir.all)
2086 1
                         & """ ");
2087
         end if;
2088 2
         Write_Line (" $< -o $@");
2089 2
         Write_Eol;
2090

2091
         --  compile-c-files rule, simply biuld $(USER_OBJS)
2092

2093 2
         Write_Line ("compile-cpp-files: $(USER_OBJS) $(CPP_OBJECTS)");
2094

2095 2
      end Compile_CPP_Files;
2096

2097
      -----------------------
2098
      -- Compile_Ada_Files --
2099
      -----------------------
2100

2101 2
      procedure Compile_Ada_Files (Ada_Sources : Name_Tables.Instance) is
2102
      begin
2103 2
         Write_Line ("compile-ada-files:");
2104 2
         if Length (Ada_Sources) > 0 then
2105 1
            for J in Name_Tables.First .. Name_Tables.Last (Ada_Sources) loop
2106
               declare
2107 2
                  O_File   : Name_Id;
2108 2
                  Ali_File : Name_Id;
2109
               begin
2110 1
                  Get_Name_String (Ada_Sources.Table (J));
2111 1
                  Name_Buffer (Name_Len - 2 .. Name_Len) := "o  ";
2112 2
                  Set_Str_To_Name_Buffer
2113 1
                    (Base_Name (Name_Buffer (1 .. Name_Len)));
2114 2
                  O_File := Name_Find;
2115

2116 1
                  Name_Buffer (Name_Len - 2 .. Name_Len) := "ali";
2117 2
                  Set_Str_To_Name_Buffer
2118 1
                    (Base_Name (Name_Buffer (1 .. Name_Len)));
2119 2
                  Ali_File := Name_Find;
2120

2121 2
                  Write_Char (ASCII.HT);
2122 2
                  Write_Str ("$(CC) -c $(INCLUDE) $(CFLAGS) '");
2123 1
                  Write_Name (Ada_Sources.Table (J));
2124 2
                  Write_Str ("' -o ");
2125 2
                  Write_Name (O_File);
2126 2
                  Write_Eol;
2127 2
                  Write_Char (ASCII.HT);
2128 2
                  Write_Str ("echo ");
2129 2
                  Write_Name (Ali_File);
2130 2
                  Write_Str (" > ali_file");
2131 2
                  Write_Eol;
2132

2133
               end;
2134 2
            end loop;
2135

2136 2
            Write_Char (ASCII.HT);
2137 2
            Write_Line ("gnatbind -n *.ali");
2138
         end if;
2139 2
      end Compile_Ada_Files;
2140

2141
      -----------
2142
      -- Build --
2143
      -----------
2144

2145 2
      procedure Build (E : Node_Id) is
2146
      begin
2147 1
         case Kind (E) is
2148 2
            when K_Architecture_Instance =>
2149 2
               Build_Architecture_Instance (E);
2150

2151 2
            when K_Component_Instance =>
2152 2
               Build_Component_Instance (E);
2153

2154 0
            when others =>
2155 0
               null;
2156 1
         end case;
2157 2
      end Build;
2158

2159
      ---------------------------------
2160
      -- Build_Architecture_Instance --
2161
      ---------------------------------
2162

2163 2
      procedure Build_Architecture_Instance (E : Node_Id) is
2164
      begin
2165 2
         Build (Root_System (E));
2166 2
      end Build_Architecture_Instance;
2167

2168
      ------------------------------
2169
      -- Build_Component_Instance --
2170
      ------------------------------
2171

2172 2
      procedure Build_Component_Instance (E : Node_Id) is
2173
         Category : constant Component_Category :=
2174 2
           Get_Category_Of_Component (E);
2175
      begin
2176 1
         case Category is
2177 2
            when CC_System =>
2178 2
               Build_System_Instance (E);
2179

2180 2
            when CC_Process =>
2181 2
               Build_Process_Instance (E);
2182

2183 2
            when others =>
2184 2
               null;
2185 2
         end case;
2186 2
      end Build_Component_Instance;
2187

2188
      ---------------------------
2189
      -- Build_System_Instance --
2190
      ---------------------------
2191

2192 2
      procedure Build_System_Instance (E : Node_Id) is
2193 2
         S : Node_Id;
2194
      begin
2195
         --  Build all process subcomponents
2196

2197 2
         if not AAU.Is_Empty (Subcomponents (E)) then
2198 2
            S := First_Node (Subcomponents (E));
2199

2200 2
            while Present (S) loop
2201 2
               Build (Corresponding_Instance (S));
2202 2
               S := Next_Node (S);
2203 2
            end loop;
2204
         end if;
2205 2
      end Build_System_Instance;
2206

2207
      ----------------------------
2208
      -- Build_Process_Instance --
2209
      ----------------------------
2210

2211 2
      procedure Build_Process_Instance (E : Node_Id) is
2212 2
         M       : constant Makefile_Type := Makefiles.Get (E);
2213 2
         Pid     : Process_Id;
2214 2
         Out_Pid : Process_Id             := Invalid_Pid;
2215 2
         Success : Boolean;
2216 2
         Args    : Argument_List (1 .. 1);
2217
      begin
2218
         --  Enter the directories
2219

2220 1
         Enter_Directory (M.Appli_Name);
2221 2
         Enter_Directory (M.Node_Name);
2222

2223
         --  If the user set the BUILD environment variable to some
2224
         --  value, we pass it the GNU make command.
2225

2226 2
         declare
2227 2
            Build_Kind    : String_Access := Getenv ("BUILD");
2228
            GNU_Make_Path : String_Access :=
2229 2
              Locate_Exec_On_Path (GNU_Make_Cmd);
2230
         begin
2231 2
            Change_If_Empty (String_Ptr (Build_Kind), "Debug");
2232 1
            Args (1) := new String'("BUILD=" & Build_Kind.all);
2233

2234
            --  Invoke the 'make' command
2235

2236
            Pid :=
2237 2
              Non_Blocking_Spawn
2238 1
                (Program_Name => GNU_Make_Path.all,
2239
                 Args         => Args);
2240

2241
            --  Wait until the command achieves its execution
2242

2243 2
            while Out_Pid /= Pid loop
2244 2
               Wait_Process (Out_Pid, Success);
2245 1
               exit when Out_Pid = Pid or else Out_Pid = Invalid_Pid;
2246 0
            end loop;
2247

2248 2
            if Out_Pid = Pid then
2249 2
               if not Success then
2250 2
                  Display_Error
2251 1
                    (GNU_Make_Path.all & " died unexpectedly",
2252
                     Fatal => True);
2253
               else
2254
                  pragma Debug
2255 2
                    (Display_Debug_Message
2256 1
                       (GNU_Make_Cmd & " terminated normally",
2257
                        Force => True));
2258 2
                  null;
2259
               end if;
2260
            end if;
2261

2262 2
            Free (Build_Kind);
2263 2
            Free (GNU_Make_Path);
2264

2265 2
            for J in Args'Range loop
2266 2
               Free (Args (J));
2267 2
            end loop;
2268 2
         end;
2269

2270
         --  Leave the directories
2271

2272 2
         Leave_Directory;
2273 2
         Leave_Directory;
2274 1
      end Build_Process_Instance;
2275

2276
      -----------
2277
      -- Clean --
2278
      -----------
2279

2280 0
      procedure Clean (E : Node_Id) is
2281
      begin
2282 0
         case Kind (E) is
2283 0
            when K_Architecture_Instance =>
2284 0
               Clean_Architecture_Instance (E);
2285

2286 0
            when K_Component_Instance =>
2287 0
               Clean_Component_Instance (E);
2288

2289 0
            when others =>
2290 0
               null;
2291 0
         end case;
2292 0
      end Clean;
2293

2294
      ---------------------------------
2295
      -- Clean_Architecture_Instance --
2296
      ---------------------------------
2297

2298 0
      procedure Clean_Architecture_Instance (E : Node_Id) is
2299
      begin
2300 0
         Clean (Root_System (E));
2301 0
      end Clean_Architecture_Instance;
2302

2303
      ------------------------------
2304
      -- Clean_Component_Instance --
2305
      ------------------------------
2306

2307 0
      procedure Clean_Component_Instance (E : Node_Id) is
2308
         Category : constant Component_Category :=
2309 0
           Get_Category_Of_Component (E);
2310
      begin
2311 0
         case Category is
2312
            when CC_System =>
2313 0
               Clean_System_Instance (E);
2314

2315
            when others =>
2316 0
               null;
2317
         end case;
2318 0
      end Clean_Component_Instance;
2319

2320
      ---------------------------
2321
      -- Clean_System_Instance --
2322
      ---------------------------
2323

2324 0
      procedure Clean_System_Instance (E : Node_Id) is
2325 0
         S : Node_Id;
2326
      begin
2327
         --  Clean all process subcomponents
2328

2329 0
         if not AAU.Is_Empty (Subcomponents (E)) then
2330 0
            S := First_Node (Subcomponents (E));
2331

2332 0
            while Present (S) loop
2333 0
               if AAU.Is_Process (Corresponding_Instance (S)) then
2334
                  --  We fetch the application directory name from the
2335
                  --  Makefile structure of one of the application
2336
                  --  nodes.
2337

2338
                  declare
2339
                     M : constant Makefile_Type :=
2340 0
                       Makefiles.Get (Corresponding_Instance (S));
2341
                  begin
2342 0
                     GNAT.Directory_Operations.Remove_Dir
2343 0
                       (Get_Name_String (M.Appli_Name),
2344
                        True);
2345
                  exception
2346 0
                     when GNAT.Directory_Operations.Directory_Error =>
2347
                        pragma Debug
2348 0
                          (Display_Debug_Message
2349 0
                             (Get_Name_String (M.Appli_Name) &
2350
                              " already clean",
2351
                              Force => True));
2352 0
                        null;
2353
                  end;
2354

2355 0
                  exit;
2356
               end if;
2357

2358 0
               S := Next_Node (S);
2359 0
            end loop;
2360
         end if;
2361 0
      end Clean_System_Instance;
2362

2363
   end Makefiles;
2364

2365
   -----------------------
2366
   -- Ada_Project_Files --
2367
   -----------------------
2368

2369
   package body Ada_Project_Files is
2370

2371
      procedure Visit_Architecture_Instance (E : Node_Id);
2372
      procedure Visit_Component_Instance (E : Node_Id);
2373
      procedure Visit_System_Instance (E : Node_Id);
2374
      procedure Visit_Process_Instance (E : Node_Id);
2375
      procedure Visit_Thread_Instance (E : Node_Id);
2376
      procedure Visit_Subprogram_Instance
2377
        (E            : Node_Id;
2378
         Force_Parent : Node_Id := No_Node);
2379
      procedure Visit_Port_Instance (E : Node_Id);
2380

2381
      type Ada_Project_File_Rec is record
2382
         Appli_Name : Name_Id;
2383
         --  The distributed application name
2384

2385
         Node_Name : Name_Id;
2386
         --  The node name (in lower case)
2387

2388
         Is_Server : Boolean;
2389
         --  True of the process has IN ports
2390

2391
         Execution_Platform : Supported_Execution_Platform;
2392
         --  The execution platform of the processor the current node
2393
         --  is bound to.
2394

2395
         Ada_Runtime        : Name_Id;
2396
         --  Ada runtime to be used
2397

2398
         Transport_API : Supported_Transport_APIs;
2399
         --  The transport API used by the current node to
2400
         --  communicate with other nodes.
2401

2402
         Spec_Names        : Name_Tables.Instance;
2403
         Custom_Spec_Names : Name_Tables.Instance;
2404
         --  USER Ada specs with custom names. For each index J,
2405
         --  Spec_Names (J) is the Ada spec name and Custom_Spec_Names
2406
         --  (J) is the file name containing the spec.
2407

2408
         Body_Names        : Name_Tables.Instance;
2409
         Custom_Body_Names : Name_Tables.Instance;
2410
         --  USER Ada bodies with custom names. For each index J,
2411
         --  Body_Names (J) is the Ada body name and Custom_Body_Names
2412
         --  (J) is the file name containing the body.
2413

2414
         User_Source_Dirs : Name_Tables.Instance;
2415
         --  Directories of the source files provided by the user
2416
      end record;
2417
      --  This structure gathers all the information needed to
2418
      --  generate an Ada project file for a given node of the
2419
      --  distributed application.
2420

2421
      type Ada_Project_File_Type is access all Ada_Project_File_Rec;
2422

2423
      procedure Free (P : in out Ada_Project_File_Type);
2424
      --  Deallocates the internals of T
2425

2426
      procedure Handle_Ada_Source
2427
        (E            : Node_Id;
2428
         Implem_Name  : Name_Id;
2429
         Source_Files : Name_Array;
2430
         P            : Ada_Project_File_Type);
2431
      --  Update the project file structure by adding necessary paths
2432
      --  to sources provided by the 'Source_Files' array. If no
2433
      --  source text is given by an implementation name, we deduce
2434
      --  file names from implementation name. E is the node for which
2435
      --  the source files are given, it is used to resolve relative
2436
      --  paths through its absolute location.
2437

2438
      ----------
2439
      -- Free --
2440
      ----------
2441

2442 0
      procedure Free (P : in out Ada_Project_File_Type) is
2443
         procedure Deallocate is new Ada.Unchecked_Deallocation
2444
           (Ada_Project_File_Rec,
2445
            Ada_Project_File_Type);
2446
      begin
2447
         --  Deallocate internal tables
2448

2449 0
         Name_Tables.Free (P.all.Spec_Names);
2450 0
         Name_Tables.Free (P.all.Custom_Spec_Names);
2451 0
         Name_Tables.Free (P.all.Body_Names);
2452 0
         Name_Tables.Free (P.all.Custom_Body_Names);
2453 0
         Name_Tables.Free (P.all.User_Source_Dirs);
2454

2455 0
         Deallocate (P);
2456 0
      end Free;
2457

2458
      package Ada_Project_Files is new Generic_List
2459
        (Ada_Project_File_Type,
2460
         "Ada_Project_File_List",
2461
         Free);
2462
      --  The list of all the makefile structures
2463

2464
      -----------
2465
      -- Reset --
2466
      -----------
2467

2468 2
      procedure Reset is
2469
      begin
2470 2
         Ada_Project_Files.Free;
2471 2
      end Reset;
2472

2473
      -----------------------
2474
      -- Handle_Ada_Source --
2475
      -----------------------
2476

2477 2
      procedure Handle_Ada_Source
2478
        (E            : Node_Id;
2479
         Implem_Name  : Name_Id;
2480
         Source_Files : Name_Array;
2481
         P            : Ada_Project_File_Type)
2482
      is
2483 2
         Conv_Base_Name  : Name_Id;
2484 2
         Custom_Name     : Name_Id;
2485 2
         Suffix          : String (1 .. 4);
2486 2
         Source_Dirname  : Name_Id;
2487 2
         Source_Basename : Name_Id;
2488
         Binding_Key     : constant String := "%user_src_dir%";
2489
      begin
2490 2
         if Implem_Name /= No_Name then
2491
            Conv_Base_Name :=
2492 2
              ADU.Conventional_Base_Name (ADU.Unit_Name (Implem_Name));
2493
         end if;
2494

2495
         --  Ensure the user gives at most 2 sources files (a spec and
2496
         --  a body).
2497

2498 2
         if Source_Files'Length > 2 then
2499 0
            Display_Located_Error
2500 0
              (Loc (E),
2501
               "More than 2 source files for an Ada subprogram",
2502
               Fatal => True);
2503
         end if;
2504

2505 2
         if Source_Files'Length = 0 and then Implem_Name /= No_Name then
2506
            --  This means that the user did not provide source file
2507
            --  names for the Ada implementation but provided the
2508
            --  implementation name. Therefore, the corresponding
2509
            --  source files have conventional names and are located
2510
            --  at the same directory as the AADL file.
2511

2512 2
            Split_Path
2513
              (Conv_Base_Name,
2514 2
               Loc (E).Dir_Name,
2515
               Source_Basename,
2516
               Source_Dirname);
2517

2518 2
            Set_Str_To_Name_Buffer (Binding_Key);
2519 2
            Get_Name_String_And_Append (Source_Dirname);
2520 1
            Get_Name_String_And_Append (P.Node_Name);
2521

2522 2
            if Get_Name_Table_Byte (Name_Find) = 0 then
2523 1
               Name_Tables.Append (P.User_Source_Dirs, Source_Dirname);
2524 2
               Set_Name_Table_Byte (Name_Find, 1);
2525
            end if;
2526

2527 2
         elsif Source_Files'Length /= 0 and then Implem_Name /= No_Name then
2528 2
            for J in Source_Files'Range loop
2529 2
               Split_Path
2530
                 (Source_Files (J),
2531 2
                  Loc (E).Dir_Name,
2532
                  Source_Basename,
2533
                  Source_Dirname);
2534

2535
               --  Add the directory to the user directory list
2536
               --  (if it has not been added yet).
2537

2538 2
               Set_Str_To_Name_Buffer (Binding_Key);
2539 2
               Get_Name_String_And_Append (Source_Dirname);
2540 1
               Get_Name_String_And_Append (P.Node_Name);
2541

2542 2
               if Get_Name_Table_Byte (Name_Find) = 0 then
2543 1
                  Name_Tables.Append (P.User_Source_Dirs, Source_Dirname);
2544 2
                  Set_Name_Table_Byte (Name_Find, 1);
2545
               end if;
2546

2547 2
               Get_Name_String (Source_Basename);
2548

2549
               --  The .ad[bs] consumes 4 characters from to
2550
               --  total file name. The user must give at least
2551
               --  one character base name.
2552

2553 2
               if Name_Len < 5 then
2554 0
                  Display_Located_Error
2555 0
                    (Loc (E),
2556
                     "Incorrect text file name",
2557
                     Fatal => True);
2558
               end if;
2559

2560 1
               Suffix := Name_Buffer (Name_Len - 3 .. Name_Len);
2561

2562 2
               Custom_Name := Name_Find;
2563

2564 2
               if Suffix = ".ads" then
2565 2
                  if Custom_Name /= Conv_Base_Name then
2566
                     --  Add a custom Spec clause
2567

2568 2
                     Name_Tables.Append
2569 1
                       (P.Spec_Names,
2570 2
                        ADU.Unit_Name (Implem_Name));
2571 1
                     Name_Tables.Append (P.Custom_Spec_Names, Custom_Name);
2572
                  end if;
2573 2
               elsif Suffix = ".adb" then
2574 2
                  if Custom_Name /= Conv_Base_Name then
2575
                     --  Add a custom Body clause
2576

2577 2
                     Name_Tables.Append
2578 1
                       (P.Body_Names,
2579 2
                        ADU.Unit_Name (Implem_Name));
2580 1
                     Name_Tables.Append (P.Custom_Body_Names, Custom_Name);
2581
                  end if;
2582
               else
2583 0
                  Display_Located_Error
2584 0
                    (Loc (E),
2585 0
                     "Unknown suffix for Ada file name: """ & Suffix & """",
2586
                     Fatal => True);
2587
               end if;
2588 2
            end loop;
2589
         end if;
2590 2
      end Handle_Ada_Source;
2591

2592
      -----------
2593
      -- Visit --
2594
      -----------
2595

2596 2
      procedure Visit (E : Node_Id) is
2597
      begin
2598 1
         case Kind (E) is
2599 2
            when K_Architecture_Instance =>
2600 2
               Visit_Architecture_Instance (E);
2601

2602 2
            when K_Component_Instance =>
2603 2
               Visit_Component_Instance (E);
2604

2605 2
            when K_Port_Spec_Instance =>
2606 2
               Visit_Port_Instance (E);
2607

2608 0
            when others =>
2609 0
               null;
2610 1
         end case;
2611 2
      end Visit;
2612

2613
      ---------------------------------
2614
      -- Visit_Architecture_Instance --
2615
      ---------------------------------
2616

2617 2
      procedure Visit_Architecture_Instance (E : Node_Id) is
2618
      begin
2619 2
         Visit (Root_System (E));
2620 2
      end Visit_Architecture_Instance;
2621

2622
      ------------------------------
2623
      -- Visit_Component_Instance --
2624
      ------------------------------
2625

2626 2
      procedure Visit_Component_Instance (E : Node_Id) is
2627
         Category : constant Component_Category :=
2628 2
           Get_Category_Of_Component (E);
2629
      begin
2630 1
         case Category is
2631 2
            when CC_System =>
2632 2
               Visit_System_Instance (E);
2633

2634 2
            when CC_Process =>
2635 2
               Visit_Process_Instance (E);
2636

2637 2
            when CC_Thread =>
2638 2
               Visit_Thread_Instance (E);
2639

2640 2
            when CC_Subprogram =>
2641 2
               Visit_Subprogram_Instance (E);
2642

2643 2
            when others =>
2644 2
               null;
2645 2
         end case;
2646 2
      end Visit_Component_Instance;
2647

2648
      ----------------------------
2649
      -- Visit_Process_Instance --
2650
      ----------------------------
2651

2652 2
      procedure Visit_Process_Instance (E : Node_Id) is
2653 2
         S  : constant Node_Id               := Parent_Subcomponent (E);
2654 2
         A  : constant Node_Id := Parent_Component (Parent_Subcomponent (E));
2655 2
         P  : constant Ada_Project_File_Type := new Ada_Project_File_Rec;
2656 2
         SC : Node_Id;
2657
      begin
2658
         --  Associates the Ada project file structure to the process
2659
         --  instance. Keep in mind that it is important to use
2660
         --  accesses here because all the visited threads and
2661
         --  subprograms will fetch this access to update the
2662
         --  corresponding structure.
2663

2664 2
         Ada_Project_Files.Set (E, P);
2665

2666 2
         P.Appli_Name := Normalize_Name (Name (Identifier (A)));
2667 2
         P.Node_Name  := Normalize_Name (Name (Identifier (S)));
2668

2669 2
         P.Is_Server := Has_In_Ports (E);
2670

2671
         --  Get the execution platform of the processor this node is
2672
         --  bound to.
2673

2674 2
         P.Execution_Platform :=
2675 2
           Get_Execution_Platform (Get_Bound_Processor (E));
2676

2677 2
         P.Ada_Runtime := Get_Ada_Runtime (Get_Bound_Processor (E));
2678
         --  Get the transport API used by this node. It is
2679
         --  important to ensure that the Namings package visitors
2680
         --  have already been executed since they perform all
2681
         --  consistency checks and bind a node to its transport
2682
         --  API.
2683

2684 2
         P.Transport_API := Fetch_Transport_API (E);
2685

2686
         --  Initialize the lists
2687

2688 2
         Name_Tables.Init (P.Spec_Names);
2689 2
         Name_Tables.Init (P.Custom_Spec_Names);
2690

2691 2
         Name_Tables.Init (P.Body_Names);
2692 2
         Name_Tables.Init (P.Custom_Body_Names);
2693

2694 2
         Name_Tables.Init (P.User_Source_Dirs);
2695

2696
         --  Visit all the subcomponents of the process
2697

2698 2
         if not AAU.Is_Empty (Subcomponents (E)) then
2699 2
            SC := First_Node (Subcomponents (E));
2700

2701 2
            while Present (SC) loop
2702
               --  Visit the corresponding instance of SC
2703

2704 2
               Visit (Corresponding_Instance (SC));
2705

2706 2
               SC := Next_Node (SC);
2707 2
            end loop;
2708
         end if;
2709 2
      end Visit_Process_Instance;
2710

2711
      ---------------------------
2712
      -- Visit_System_Instance --
2713
      ---------------------------
2714

2715 2
      procedure Visit_System_Instance (E : Node_Id) is
2716 2
         S : Node_Id;
2717
      begin
2718
         --  Visit all the subcomponents of the system
2719

2720 2
         if not AAU.Is_Empty (Subcomponents (E)) then
2721 2
            S := First_Node (Subcomponents (E));
2722 2
            while Present (S) loop
2723
               --  Visit the component instance corresponding to the
2724
               --  subcomponent S.
2725

2726 2
               Visit (Corresponding_Instance (S));
2727 2
               S := Next_Node (S);
2728 2
            end loop;
2729
         end if;
2730 2
      end Visit_System_Instance;
2731

2732
      ---------------------------
2733
      -- Visit_Thread_Instance --
2734
      ---------------------------
2735

2736 2
      procedure Visit_Thread_Instance (E : Node_Id) is
2737
         Parent_Process : constant Node_Id :=
2738 2
           Corresponding_Instance (Get_Container_Process (E));
2739
         P : constant Ada_Project_File_Type :=
2740 2
           Ada_Project_Files.Get (Parent_Process);
2741 2
         Language : constant Supported_Source_Language := Resolve_Language (E);
2742
         Compute_Entrypoint : constant Name_Id                   :=
2743 2
           Get_Thread_Compute_Entrypoint (E);
2744 1
         Source_Files : constant Name_Array := Get_Source_Text (E);
2745 2
         Call_Seq     : Node_Id;
2746 2
         Spg_Call     : Node_Id;
2747 2
         F            : Node_Id;
2748
      begin
2749
         --  Only Ada files affect the structure of Ada project files
2750

2751 2
         if Language = Language_Ada_95 then
2752 2
            Handle_Ada_Source (E, Compute_Entrypoint, Source_Files, P);
2753
         end if;
2754

2755
         --  Visit the features of the thread for possible source
2756
         --  files.
2757

2758 2
         if not AAU.Is_Empty (Features (E)) then
2759 2
            F := First_Node (Features (E));
2760

2761 2
            while Present (F) loop
2762 2
               if Kind (F) = K_Port_Spec_Instance and then Is_In (F) then
2763 2
                  Visit (F);
2764
               end if;
2765

2766 2
               F := Next_Node (F);
2767 2
            end loop;
2768
         end if;
2769

2770
         --  Visit all the call sequences of the thread
2771

2772 2
         if not AAU.Is_Empty (Calls (E)) then
2773 2
            Call_Seq := First_Node (Calls (E));
2774

2775 2
            while Present (Call_Seq) loop
2776
               --  For each call sequence visit all the called
2777
               --  subprograms.
2778

2779 2
               if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then
2780 2
                  Spg_Call := First_Node (Subprogram_Calls (Call_Seq));
2781

2782 2
                  while Present (Spg_Call) loop
2783 2
                     Visit (Corresponding_Instance (Spg_Call));
2784

2785 2
                     Spg_Call := Next_Node (Spg_Call);
2786 2
                  end loop;
2787
               end if;
2788

2789 2
               Call_Seq := Next_Node (Call_Seq);
2790 2
            end loop;
2791
         end if;
2792 2
      end Visit_Thread_Instance;
2793

2794
      -------------------------------
2795
      -- Visit_Subprogram_Instance --
2796
      -------------------------------
2797

2798 2
      procedure Visit_Subprogram_Instance
2799
        (E            : Node_Id;
2800
         Force_Parent : Node_Id := No_Node)
2801
      is
2802 2
         Parent_Process  : Node_Id;
2803 2
         P               : Ada_Project_File_Type;
2804
         Subprogram_Kind : constant Supported_Subprogram_Kind :=
2805 2
           Get_Subprogram_Kind (E);
2806 2
         Source_Name  : constant Name_Id    := Get_Source_Name (E);
2807 1
         Source_Files : constant Name_Array := Get_Source_Text (E);
2808 2
         Call_Seq     : Node_Id;
2809 2
         Spg_Call     : Node_Id;
2810
      begin
2811 2
         if Force_Parent = No_Node then
2812
            Parent_Process :=
2813 2
              Corresponding_Instance (Get_Container_Process (E));
2814
         else
2815 0
            Parent_Process := Force_Parent;
2816
         end if;
2817

2818 2
         P := Ada_Project_Files.Get (Parent_Process);
2819
         --  Only Ada subprograms may influence the structure of the
2820
         --  generated project files.
2821

2822 1
         case Subprogram_Kind is
2823 2
            when Subprogram_Opaque_Ada_95 | Subprogram_Hybrid_Ada_95 =>
2824 2
               Handle_Ada_Source (E, Source_Name, Source_Files, P);
2825

2826 2
            when others =>
2827 2
               null;
2828 2
         end case;
2829

2830
         --  Visit all the call sequences of the subprogram
2831

2832 2
         if not AAU.Is_Empty (Calls (E)) then
2833 2
            Call_Seq := First_Node (Calls (E));
2834

2835 2
            while Present (Call_Seq) loop
2836
               --  For each call sequence visit all the called
2837
               --  subprograms.
2838

2839 2
               if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then
2840 2
                  Spg_Call := First_Node (Subprogram_Calls (Call_Seq));
2841

2842 2
                  while Present (Spg_Call) loop
2843 2
                     Visit (Corresponding_Instance (Spg_Call));
2844

2845 2
                     Spg_Call := Next_Node (Spg_Call);
2846 2
                  end loop;
2847
               end if;
2848

2849 2
               Call_Seq := Next_Node (Call_Seq);
2850 2
            end loop;
2851
         end if;
2852 2
      end Visit_Subprogram_Instance;
2853

2854
      -------------------------
2855
      -- Visit_Port_Instance --
2856
      -------------------------
2857

2858 2
      procedure Visit_Port_Instance (E : Node_Id) is
2859
         Parent_Process : constant Node_Id :=
2860 2
           Corresponding_Instance
2861 2
             (Get_Container_Process (Parent_Component (E)));
2862
         P : constant Ada_Project_File_Type :=
2863 2
           Ada_Project_Files.Get (Parent_Process);
2864 2
         Language : constant Supported_Source_Language := Resolve_Language (E);
2865
         Compute_Entrypoint : constant Name_Id                   :=
2866 2
           Get_Port_Compute_Entrypoint (E);
2867 1
         Source_Files : constant Name_Array := Get_Source_Text (E);
2868
      begin
2869
         --  Only Ada files affect the structure of Ada project files
2870

2871 2
         if Language = Language_Ada_95 then
2872 2
            Handle_Ada_Source (E, Compute_Entrypoint, Source_Files, P);
2873
         end if;
2874 2
      end Visit_Port_Instance;
2875

2876
      --------------
2877
      -- Generate --
2878
      --------------
2879

2880
      procedure Generate (E : Node_Id) is
2881

2882
         procedure Generate_Architecture_Instance (E : Node_Id);
2883
         procedure Generate_Component_Instance (E : Node_Id);
2884
         procedure Generate_System_Instance (E : Node_Id);
2885
         procedure Generate_Process_Instance (E : Node_Id);
2886

2887
         ------------------------------------
2888
         -- Generate_Architecture_Instance --
2889
         ------------------------------------
2890

2891 2
         procedure Generate_Architecture_Instance (E : Node_Id) is
2892
         begin
2893 2
            Generate (Root_System (E));
2894 2
         end Generate_Architecture_Instance;
2895

2896
         ---------------------------------
2897
         -- Generate_Component_Instance --
2898
         ---------------------------------
2899

2900 2
         procedure Generate_Component_Instance (E : Node_Id) is
2901
            Category : constant Component_Category :=
2902 2
              Get_Category_Of_Component (E);
2903
         begin
2904 1
            case Category is
2905 2
               when CC_System =>
2906 2
                  Generate_System_Instance (E);
2907

2908 2
               when CC_Process =>
2909 2
                  Generate_Process_Instance (E);
2910

2911 2
               when others =>
2912 2
                  null;
2913 2
            end case;
2914 2
         end Generate_Component_Instance;
2915

2916
         ------------------------------
2917
         -- Generate_System_Instance --
2918
         ------------------------------
2919

2920 2
         procedure Generate_System_Instance (E : Node_Id) is
2921 2
            S : Node_Id;
2922
         begin
2923
            --  Generate the project files of all process subcomponents
2924

2925 2
            if not AAU.Is_Empty (Subcomponents (E)) then
2926 2
               S := First_Node (Subcomponents (E));
2927

2928 2
               while Present (S) loop
2929 2
                  Generate (Corresponding_Instance (S));
2930 2
                  S := Next_Node (S);
2931 2
               end loop;
2932
            end if;
2933 2
         end Generate_System_Instance;
2934

2935
         -------------------------------
2936
         -- Generate_Process_Instance --
2937
         -------------------------------
2938

2939 2
         procedure Generate_Process_Instance (E : Node_Id) is
2940 2
            P  : constant Ada_Project_File_Type := Ada_Project_Files.Get (E);
2941 2
            Fd : File_Descriptor;
2942
         begin
2943
            --  Enter the directories
2944

2945 1
            Enter_Directory (P.Appli_Name);
2946 2
            Enter_Directory (P.Node_Name);
2947

2948
            --  Create the file
2949

2950 2
            Get_Name_String (P.Node_Name);
2951 1
            Fd := Create_File (Name_Buffer (1 .. Name_Len) & ".gpr", Text);
2952

2953 2
            if Fd = Invalid_FD then
2954 0
               raise Program_Error;
2955
            end if;
2956

2957
            --  Setting the output
2958

2959 2
            Set_Output (Fd);
2960

2961 2
            Write_Line
2962
              ("--------------------------------------------------------");
2963 2
            Write_Line
2964
              ("-- This project file has been generated automatically --");
2965 2
            Write_Line
2966
              ("-- by the Ocarina AADL toolsuite                      --");
2967 1
            Write_Line ("-- " & SCM_Version.all & " --");
2968 2
            Write_Line
2969
              ("-- Do not edit this file since all your changes will  --");
2970 2
            Write_Line
2971
              ("-- be overridden at the next code generation.         --");
2972 2
            Write_Line
2973
              ("--------------------------------------------------------");
2974 2
            Write_Eol;
2975

2976 2
            Write_Str ("--  Application name   : ");
2977 2
            Write_Name (P.Appli_Name);
2978 2
            Write_Eol;
2979

2980 2
            Write_Str ("--  Node name          : ");
2981 2
            Write_Name (P.Node_Name);
2982 2
            Write_Eol;
2983

2984 1
            Write_Line
2985 1
              ("--  Execution platform : " & P.Execution_Platform'Img);
2986 1
            Write_Line ("--  Transport API      : " & P.Transport_API'Img);
2987

2988 2
            Write_Eol;
2989

2990 2
            Generate_Runtime_Specific
2991
              (P.Appli_Name,
2992
               P.Node_Name,
2993
               P.Is_Server,
2994
               P.Execution_Platform,
2995
               P.Ada_Runtime,
2996
               P.Transport_API,
2997
               P.Spec_Names,
2998
               P.Custom_Spec_Names,
2999
               P.Body_Names,
3000
               P.Custom_Body_Names,
3001
               P.User_Source_Dirs);
3002

3003
            --  Close the file
3004

3005 2
            Close (Fd);
3006 2
            Set_Standard_Output;
3007

3008
            --  Leave the directories
3009

3010 2
            Leave_Directory;
3011 2
            Leave_Directory;
3012 2
         end Generate_Process_Instance;
3013

3014
      --  Main processing part of Generate begins here
3015

3016
      begin
3017
         case Kind (E) is
3018
            when K_Architecture_Instance =>
3019
               Generate_Architecture_Instance (E);
3020

3021
            when K_Component_Instance =>
3022
               Generate_Component_Instance (E);
3023

3024
            when others =>
3025
               null;
3026
         end case;
3027
      end Generate;
3028

3029
   end Ada_Project_Files;
3030

3031
   -----------
3032
   -- Reset --
3033
   -----------
3034

3035 2
   procedure Reset is
3036
   begin
3037 2
      Makefiles.Reset;
3038 2
      Ada_Project_Files.Reset;
3039 2
   end Reset;
3040

3041 2
end Ocarina.Backends.Build_Utils;

Read our documentation on viewing source code .

Loading