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 1
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 1
   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 1
      Get_Name_String (Installation_Directory);
138 1
      Add_Str_To_Name_Buffer ("include" & Directory_Separator);
139 1
      Add_Str_To_Name_Buffer ("ocarina" & Directory_Separator);
140 1
      Add_Str_To_Name_Buffer ("runtime" & Directory_Separator);
141 1
      Add_Str_To_Name_Buffer (Runtime_Name);
142

143 1
      declare
144 1
         Path : constant String := Get_Name_String (Name_Find);
145
      begin
146 1
         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 1
      end;
151
   end Get_Runtime_Path;
152

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

157 1
   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 1
      Temp_Dirname : Name_Id := No_Name;
165 1
      AADL_Library_File : Boolean := False;
166
   begin
167 1
      if Relative_Path then
168 1
         Temp_Dirname := Get_String_Name
169 1
           (Normalize_Pathname (Get_Name_String (Directory)) & "/");
170 1
         if Temp_Dirname = Default_Library_Path then
171 1
            AADL_Library_File := True;
172
         end if;
173
      end if;
174

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

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

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

187 1
      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 1
               Format_Pathname (Normalized_Dir & "/"
197 1
                                  & Get_Name_String (Filename))
198
            else
199 1
               Normalize_Pathname (Get_Name_String (Filename),
200
                                   Normalized_Dir));
201

202
      begin
203 1
         Dirname  := Get_String_Name (Dir_Name (Resolved_Filename));
204 1
         Basename := Get_String_Name (Base_Name (Resolved_Filename));
205 1
      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 1
      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 1
         Add_Str_To_Name_Buffer ('%' & Id & '%');
231 1
         return Name_Find;
232
      end Get_Internal_Name;
233

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

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

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

249 1
      function Get (P : Node_Id) return Build_Util is
250 1
         I_Name : constant Name_Id := Get_Internal_Name (P);
251 1
         Index  : constant Nat     := Get_Name_Table_Info (I_Name);
252
      begin
253 1
         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 1
      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 1
         Internal_Table.Free;
281 1
         Internal_Table.Init;
282 1
      end Free;
283
   end Generic_List;
284

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

289 1
   function Resolve_Language (E : Node_Id) return Supported_Source_Language is
290 1
      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 1
      if Language = Language_None then
296 1
         case Get_Current_Backend_Kind is
297 1
            when PolyORB_HI_Ada =>
298 1
               Language := Language_Ada_95;
299

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

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

308 1
      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 1
      procedure Reset is
499
      begin
500 1
         Makefiles.Free;
501 1
      end Reset;
502

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

507 1
      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 1
         Source_Basename : Name_Id;
514 1
         Source_Dirname  : Name_Id;
515 1
         S_Name          : Name_Id;
516

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

520 1
         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 1
         elsif Source_Files'Length /= 0 and then Implem_Name /= No_Name then
527 1
            for J in Source_Files'Range loop
528
               --  Ensure the source is added only once per node
529

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

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

538 1
                  Get_Name_String (Source_Files (J));
539

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

546 1
                  Get_Name_String (Source_Basename);
547

548 1
                  if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" then
549 1
                     Get_Name_String (Source_Dirname);
550 1
                     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 1
            end loop;
556
         end if;
557 1
      end Handle_Ada_Source;
558

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

563 1
      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 1
         Source_Basename : Name_Id;
571 1
         Source_Dirname  : Name_Id;
572 1
         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 1
         if Source_Files'Length > 1
578 1
           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 1
         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 1
            Split_Path
594
              (Implem_Name,
595 1
               Loc (E).Dir_Name,
596
               Source_Basename,
597
               Source_Dirname,
598
               Relative_Path => True);
599

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

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

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

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

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

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

625 1
                  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 1
                  Split_Path
631
                    (Source_Files (J),
632 1
                     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 1
                  if Source_Dirname = Default_Library_Path then
644 1
                     Source_Dirname := Get_String_Name
645 1
                       (Get_Runtime_Path ("polyorb-hi-c"));
646
                     Source_Dirname :=
647 1
                       Add_Directory_Separator (Source_Dirname);
648 1
                     Get_Name_String (Source_Dirname);
649 1
                     Add_Str_To_Name_Buffer ("src/");
650 1
                     Source_Dirname := Name_Find;
651
                  end if;
652

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

657 1
                  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 1
                     if Source_Dirname /= Get_String_Name ("./") then
683 1
                        Get_Name_String (Source_Dirname);
684 1
                        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 1
                     Set_Str_To_Name_Buffer (Binding_Key);
692 1
                     Get_Name_String (Source_Dirname);
693 1
                     Get_Name_String_And_Append (M.Node_Name);
694

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

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

707 1
                     if Get_Name_Table_Byte (Name_Find) = 0 then
708 1
                        Name_Tables.Append
709 1
                          (M.User_Source_Dirs,
710
                           Source_Dirname);
711 1
                        Set_Name_Table_Byte (Name_Find, 1);
712
                     end if;
713
                  end if;
714
               end if;
715 1
            end loop;
716
         end if;
717 1
      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 1
         Source_Basename : Name_Id;
731 1
         Source_Dirname  : Name_Id;
732 1
         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 1
         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 1
         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 1
               Get_Name_String (Source_Files (J));
777 1
               Get_Name_String_And_Append (M.Node_Name);
778 1
               Add_Str_To_Name_Buffer ("%source_text%");
779 1
               S_Name := Name_Find;
780

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

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

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

795 1
                  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 1
                     Get_Name_String (Source_Dirname);
802 1
                     Get_Name_String_And_Append (Source_Basename);
803

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

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

810 1
                     if Get_Name_Table_Byte (Name_Find) = 0 then
811 1
                        Name_Tables.Append
812 1
                          (M.User_Source_Dirs,
813
                           Source_Dirname);
814 1
                        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 1
      end Handle_CPP_Source;
833

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

943 1
      procedure Visit_Data_Instance (E : Node_Id) is
944 1
         Source  : Name_Id;
945 1
         Sources : constant Name_Array    := Get_Source_Text (E);
946 1
         M       : constant Makefile_Type := Makefiles.Get (Current_Process);
947
      begin
948 1
         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 1
      end Visit_Data_Instance;
955

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

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

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

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

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

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

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

986 1
      procedure Visit_Process_Instance (E : Node_Id) is
987 1
         C              : Node_Id;
988 1
         S              : constant Node_Id       := Parent_Subcomponent (E);
989 1
         M              : constant Makefile_Type := new Makefile_Rec;
990 1
         SC             : Node_Id;
991 1
         Current_Device : Node_Id;
992 1
         Feature        : Node_Id;
993 1
         Parent         : Node_Id;
994 1
         Src            : Node_Id;
995 1
         Dst            : Node_Id;
996
         The_System     : constant Node_Id       :=
997 1
           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 1
         Current_Process := E;
1006

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

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

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

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

1023 1
         M.USER_CFLAGS :=
1024 1
           Get_User_CFLAGS (Get_Bound_Processor (E));
1025 1
         M.USER_LDFLAGS :=
1026 1
           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 1
         M.Transport_API := Fetch_Transport_API (E);
1035

1036
         --  Initialize the lists
1037

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

1046
         --  Visit all the subcomponents of the process
1047

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

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

1054 1
               Visit (Corresponding_Instance (SC));
1055

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

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

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

1067 1
                  while Present (Src) loop
1068

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

1071 1
                     if AAU.Is_Process (Parent) and then Parent /= E then
1072 1
                        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 1
                     Src := Next_Node (Src);
1082 1
                  end loop;
1083
               end if;
1084

1085
               --  The destinations of F
1086

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

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

1093 1
                     if AAU.Is_Process (Parent) and then Parent /= E then
1094 1
                        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 1
                     Dst := Next_Node (Dst);
1104 1
                  end loop;
1105
               end if;
1106

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

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

1142 1
      procedure Visit_System_Instance (E : Node_Id) is
1143
      begin
1144 1
         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 1
            Appli_Name := Normalize_Name (Name (Identifier (E)));
1151
         end if;
1152

1153
         --  Visit all the subcomponents of the system
1154

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

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

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

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

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

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

1187 1
         if Language = Language_C then
1188 1
            Compute_Entrypoint := Get_Thread_Compute_Entrypoint (E);
1189 1
            Handle_C_Source (E, Compute_Entrypoint, Source_Files, M);
1190 1
            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 1
         if not AAU.Is_Empty (Features (E)) then
1197 1
            F := First_Node (Features (E));
1198

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

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

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

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

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

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

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

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

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

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

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

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

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

1271 1
         case Subprogram_Kind is
1272 1
            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 1
               Handle_C_Source (E, Source_Name, Source_Files, M);
1280

1281 1
            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 1
               Handle_CPP_Source (E, Source_Name, Source_Files, M);
1289

1290 1
            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 1
               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 1
            when others =>
1317 1
               null;
1318 1
         end case;
1319

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

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

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

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

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

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

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

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

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

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

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

1369 1
            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 1
            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 1
               declare
1399
                  Source_Name : constant Name_Id :=
1400 1
                    Get_Type_Source_Name (Data);
1401 1
                  Source_Files : constant Name_Array := Get_Source_Text (Data);
1402
               begin
1403 1
                  Handle_C_Source (E, Source_Name, Source_Files, M);
1404 1
               end;
1405
            end if;
1406

1407
         end if;
1408 1
      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 1
         procedure Generate_Architecture_Instance (E : Node_Id) is
1427
         begin
1428 1
            Generate (Root_System (E));
1429 1
         end Generate_Architecture_Instance;
1430

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

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

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

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

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

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

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

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

1465
         begin
1466

1467 1
            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 1
               Enter_Directory (Dir_Name);
1474

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

1480
               --  Setting the output
1481

1482 1
               Set_Output (Fd);
1483

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

1509 1
               Write_Line ("coverage:");
1510 1
               Write_Line (ASCII.HT & "-rm lcov.args");
1511 1
               Write_Line (ASCII.HT & "touch lcov.args");
1512 1
               Write_Line (ASCII.HT & "for d in $(SUBDIRS); do \");
1513 1
               Write_Line (ASCII.HT & ASCII.HT &
1514
               "lcov -c -i -d $$d -o coverage.$$d ;\");
1515 1
               Write_Line (ASCII.HT & ASCII.HT &
1516
               "lcov -c -d $$d -o coverage.$$d ;\");
1517 1
               Write_Line (ASCII.HT & ASCII.HT &
1518
               "echo ""-a coverage.$$d "" >> lcov.args ;\");
1519 1
               Write_Line (ASCII.HT & "done");
1520 1
               Write_Line (ASCII.HT
1521
                             & "lcov `cat lcov.args` -o coverage.total");
1522 1
               Write_Line (ASCII.HT &
1523
                             "genhtml --no-branch-coverage " &
1524
                             "-o ../gcov_output coverage.total");
1525 1
               Write_Line (ASCII.HT & "rm lcov.args coverage.*");
1526 1
               Write_Eol;
1527 1
               Write_Line ("clean:");
1528 1
               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 1
               Close (Fd);
1536 1
               Set_Standard_Output;
1537

1538
               --  Copy the runtime directory
1539

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

1550 1
               Leave_Directory;
1551
            end if;
1552

1553
            --  Generate the makefiles of all process subcomponents
1554

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

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

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

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

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

1578
            --  Create the file
1579

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

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

1586
            --  Setting the output
1587

1588 1
            Set_Output (Fd);
1589

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

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

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

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

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

1618 1
            Write_Eol;
1619

1620 1
            if Get_Current_Backend_Kind = PolyORB_HI_C then
1621 1
               Write_Str ("USER_OBJS = ");
1622 1
               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 1
               Ada_C_Command_Line_Flags
1635
                 (M.Ada_Sources,
1636
                  M.C_Sources,
1637
                  M.CPP_Sources,
1638
                  M.C_Libraries);
1639

1640 1
               if Length (M.Ada_Sources) > 0 then
1641 1
                  Write_Line ("USER_LD=gnatlink `cat ali_file`");
1642
               end if;
1643
            else
1644 1
               Write_Str ("C_OBJECTS=");
1645 1
               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 1
            Write_Eol;
1652

1653 1
            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 1
               Env : constant Name_Id := Get_USER_ENV
1677 1
                 (Get_Bound_Processor (E));
1678
            begin
1679 1
               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 1
            Write_Eol;
1689 1
            Compile_C_Files (M.C_Sources);
1690 1
            Write_Eol;
1691

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

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

1698 1
            if Get_Current_Backend_Kind = PolyORB_HI_Ada then
1699 1
               Write_Line ("prove:");
1700 1
               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 1
            Close (Fd);
1709 1
            Set_Standard_Output;
1710

1711
            --  Leave the directories
1712

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

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

1721 1
         procedure Generate_Processor_Instance (E : Node_Id) is
1722 1
            Fd         : File_Descriptor;
1723 1
            S          : Node_Id;
1724 1
            The_System : Node_Id;
1725 1
            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 1
            if Get_Current_Backend_Kind /= PolyORB_HI_C then
1734 1
               return;
1735
            end if;
1736

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

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

1743
            --  Enter the directories
1744

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

1749
            --  Create the file
1750

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

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

1764
            --  Setting the output
1765

1766 1
            Set_Output (Fd);
1767

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

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

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

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

1784 1
            Write_Eol;
1785 1
            Write_Eol;
1786

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

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

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

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

1811 1
            Write_Str ("PARTITIONS=");
1812

1813
            --  Generate the makefiles of all process subcomponents
1814

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

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

1836 1
            Write_Str ("GENERATED_PACK_ARGS=");
1837

1838
            --  Generate the makefiles of all process subcomponents
1839

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

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

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

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

1868 1
            Write_Eol;
1869 1
            Write_Eol;
1870

1871 1
            Close (Fd);
1872

1873 1
            Set_Standard_Output;
1874

1875
            --  Leave the directories
1876

1877 1
            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 1
      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 1
         if Length (Ada_Sources) > 0
1907 1
           or else Length (C_Sources) > 0
1908 1
           or else Length (C_Libraries) > 0
1909
         then
1910 1
            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 1
         if Length (C_Sources) > 0 then
1923 1
            if Get_Current_Backend_Kind = PolyORB_HI_C
1924 1
              and then Length (Ada_Sources) > 0
1925
            then
1926 1
               Write_Line (" \");
1927 1
               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 1
               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 1
               Write_Name (Name_Find);
1941

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

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

1949 1
         if Length (CPP_Sources) > 0 then
1950 1
            Write_Line (" \");
1951 1
            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 1
               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 1
               Write_Name (Name_Find);
1966

1967 1
               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 1
         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 1
         Write_Eol;
2010

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

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

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

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

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

2040
         --  Generic rule for compiling C files
2041

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

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

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

2057 1
      end Compile_C_Files;
2058

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

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

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

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

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

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

2095 1
      end Compile_CPP_Files;
2096

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

2101 1
      procedure Compile_Ada_Files (Ada_Sources : Name_Tables.Instance) is
2102
      begin
2103 1
         Write_Line ("compile-ada-files:");
2104 1
         if Length (Ada_Sources) > 0 then
2105 1
            for J in Name_Tables.First .. Name_Tables.Last (Ada_Sources) loop
2106
               declare
2107 1
                  O_File   : Name_Id;
2108 1
                  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 1
                  Set_Str_To_Name_Buffer
2113 1
                    (Base_Name (Name_Buffer (1 .. Name_Len)));
2114 1
                  O_File := Name_Find;
2115

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

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

2133
               end;
2134 1
            end loop;
2135

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

2220 1
         Enter_Directory (M.Appli_Name);
2221 1
         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 1
         declare
2227 1
            Build_Kind    : String_Access := Getenv ("BUILD");
2228
            GNU_Make_Path : String_Access :=
2229 1
              Locate_Exec_On_Path (GNU_Make_Cmd);
2230
         begin
2231 1
            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 1
              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 1
            while Out_Pid /= Pid loop
2244 1
               Wait_Process (Out_Pid, Success);
2245 1
               exit when Out_Pid = Pid or else Out_Pid = Invalid_Pid;
2246 0
            end loop;
2247

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

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

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

2270
         --  Leave the directories
2271

2272 1
         Leave_Directory;
2273 1
         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 1
      procedure Reset is
2469
      begin
2470 1
         Ada_Project_Files.Free;
2471 1
      end Reset;
2472

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

2477 1
      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 1
         Conv_Base_Name  : Name_Id;
2484 1
         Custom_Name     : Name_Id;
2485 1
         Suffix          : String (1 .. 4);
2486 1
         Source_Dirname  : Name_Id;
2487 1
         Source_Basename : Name_Id;
2488
         Binding_Key     : constant String := "%user_src_dir%";
2489
      begin
2490 1
         if Implem_Name /= No_Name then
2491
            Conv_Base_Name :=
2492 1
              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 1
         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 1
         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 1
            Split_Path
2513
              (Conv_Base_Name,
2514 1
               Loc (E).Dir_Name,
2515
               Source_Basename,
2516
               Source_Dirname);
2517

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

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

2527 1
         elsif Source_Files'Length /= 0 and then Implem_Name /= No_Name then
2528 1
            for J in Source_Files'Range loop
2529 1
               Split_Path
2530
                 (Source_Files (J),
2531 1
                  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 1
               Set_Str_To_Name_Buffer (Binding_Key);
2539 1
               Get_Name_String_And_Append (Source_Dirname);
2540 1
               Get_Name_String_And_Append (P.Node_Name);
2541

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

2547 1
               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 1
               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 1
               Custom_Name := Name_Find;
2563

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

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

2577 1
                     Name_Tables.Append
2578 1
                       (P.Body_Names,
2579 1
                        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 1
            end loop;
2589
         end if;
2590 1
      end Handle_Ada_Source;
2591

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

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

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

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

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

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

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

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

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

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

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

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

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

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

2652 1
      procedure Visit_Process_Instance (E : Node_Id) is
2653 1
         S  : constant Node_Id               := Parent_Subcomponent (E);
2654 1
         A  : constant Node_Id := Parent_Component (Parent_Subcomponent (E));
2655 1
         P  : constant Ada_Project_File_Type := new Ada_Project_File_Rec;
2656 1
         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 1
         Ada_Project_Files.Set (E, P);
2665

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

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

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

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

2677 1
         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 1
         P.Transport_API := Fetch_Transport_API (E);
2685

2686
         --  Initialize the lists
2687

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

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

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

2696
         --  Visit all the subcomponents of the process
2697

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

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

2704 1
               Visit (Corresponding_Instance (SC));
2705

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

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

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

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

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

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

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

2751 1
         if Language = Language_Ada_95 then
2752 1
            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 1
         if not AAU.Is_Empty (Features (E)) then
2759 1
            F := First_Node (Features (E));
2760

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

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

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

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

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

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

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

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

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

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

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

2818 1
         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 1
            when Subprogram_Opaque_Ada_95 | Subprogram_Hybrid_Ada_95 =>
2824 1
               Handle_Ada_Source (E, Source_Name, Source_Files, P);
2825

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

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

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

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

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

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

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

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

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

2858 1
      procedure Visit_Port_Instance (E : Node_Id) is
2859
         Parent_Process : constant Node_Id :=
2860 1
           Corresponding_Instance
2861 1
             (Get_Container_Process (Parent_Component (E)));
2862
         P : constant Ada_Project_File_Type :=
2863 1
           Ada_Project_Files.Get (Parent_Process);
2864 1
         Language : constant Supported_Source_Language := Resolve_Language (E);
2865
         Compute_Entrypoint : constant Name_Id                   :=
2866 1
           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 1
         if Language = Language_Ada_95 then
2872 1
            Handle_Ada_Source (E, Compute_Entrypoint, Source_Files, P);
2873
         end if;
2874 1
      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 1
         procedure Generate_Architecture_Instance (E : Node_Id) is
2892
         begin
2893 1
            Generate (Root_System (E));
2894 1
         end Generate_Architecture_Instance;
2895

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

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

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

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

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

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

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

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

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

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

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

2948
            --  Create the file
2949

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

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

2957
            --  Setting the output
2958

2959 1
            Set_Output (Fd);
2960

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

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

2980 1
            Write_Str ("--  Node name          : ");
2981 1
            Write_Name (P.Node_Name);
2982 1
            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 1
            Write_Eol;
2989

2990 1
            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 1
            Close (Fd);
3006 1
            Set_Standard_Output;
3007

3008
            --  Leave the directories
3009

3010 1
            Leave_Directory;
3011 1
            Leave_Directory;
3012 1
         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 1
   procedure Reset is
3036
   begin
3037 1
      Makefiles.Reset;
3038 1
      Ada_Project_Files.Reset;
3039 1
   end Reset;
3040

3041 1
end Ocarina.Backends.Build_Utils;

Read our documentation on viewing source code .

Loading