OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--           O C A R I N A . B A C K E N D S . P O _ H I _ A D A            --
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 GNAT.OS_Lib;
34
with Ocarina.Output;
35
with Utils;
36

37
with Ocarina.Instances;
38
with Ocarina.Backends.Ada_Tree.Generator;
39
with Ocarina.Backends.Expander;
40
with Ocarina.Backends.Messages;
41
with Ocarina.Backends.Properties;
42
with Ocarina.Backends.PO_HI_Ada.Runtime;
43
with Ocarina.Backends.PO_HI_Ada.Naming;
44
with Ocarina.Backends.PO_HI_Ada.Marshallers;
45
with Ocarina.Backends.PO_HI_Ada.Deployment;
46
with Ocarina.Backends.PO_HI_Ada.Activity;
47
with Ocarina.Backends.PO_HI_Ada.Job;
48
with Ocarina.Backends.PO_HI_Ada.Subprograms;
49
with Ocarina.Backends.PO_HI_Ada.Transport;
50
with Ocarina.Backends.PO_HI_Ada.Types;
51
with Ocarina.Backends.PO_HI_Ada.Main;
52
with Ocarina.Backends.ASN1;
53

54
with Ocarina.Backends.Utils;
55
with Ocarina.Backends.Build_Utils;
56
with Ocarina.Backends.Execution_Utils;
57
with Ocarina.Backends.Execution_Tests;
58

59
with Ocarina.Namet; use Ocarina.Namet;
60

61
package body Ocarina.Backends.PO_HI_Ada is
62

63
   use GNAT.OS_Lib;
64
   use Ocarina.Output;
65
   use Ocarina.Instances;
66
   use Ocarina.Backends.Expander;
67
   use Ocarina.Backends.Messages;
68
   use Ocarina.Backends.Utils;
69
   use Ocarina.Backends.Properties;
70
   use Ocarina.Backends.Build_Utils;
71
   use Ocarina.Backends.Execution_Tests;
72

73
   procedure Visit_Architecture_Instance (E : Node_Id);
74
   --  Most top level visitor routine. E is the root of the AADL
75
   --  instance tree. The procedure does a traversal for each
76
   --  compilation unit to be generated.
77

78
   procedure PolyORB_HI_Ada_Makefile
79
     (Appli_Name              : Name_Id;
80
      Node_Name               : Name_Id;
81
      Execution_Platform      : Supported_Execution_Platform := Platform_None;
82
      Execution_Platform_Name : Name_Id;
83
      USER_CFLAGS             : Name_Id;
84
      USER_LDFLAGS            : Name_Id;
85
      Transport_API           : Supported_Transport_APIs;
86
      Ada_Sources             : Name_Tables.Instance;
87
      Asn_Sources             : Name_Tables.Instance;
88
      C_Sources               : Name_Tables.Instance;
89
      C_Libraries             : Name_Tables.Instance;
90
      User_Source_Dirs        : Name_Tables.Instance;
91
      Use_Transport           : Boolean;
92
      Use_Simulink            : Boolean;
93
      Simulink_Directory      : Name_Id;
94
      Simulink_Node           : Name_Id;
95
      Use_Scade               : Boolean;
96
      Scade_Directory         : Name_Id);
97

98
   --  Generate the part of the Makefile that is specific to the
99
   --  corresponding code generator.
100

101
   procedure PolyORB_HI_Ada_Ada_Project_File
102
     (Appli_Name         : Name_Id;
103
      Node_Name          : Name_Id;
104
      Is_Server          : Boolean;
105
      Execution_Platform : Supported_Execution_Platform;
106
      Ada_Runtime        : Name_Id;
107
      Transport_API      : Supported_Transport_APIs;
108
      Spec_Names         : Name_Tables.Instance;
109
      Custom_Spec_Names  : Name_Tables.Instance;
110
      Body_Names         : Name_Tables.Instance;
111
      Custom_Body_Names  : Name_Tables.Instance;
112
      User_Source_Dirs   : Name_Tables.Instance);
113

114
   --------------------------
115
   --  Set_ASN1_Deployment --
116
   --------------------------
117

118
   Generate_ASN1_Deployment : Boolean := False;
119

120 0
   procedure Set_ASN1_Deployment (Use_It : Boolean) is
121
   begin
122 0
      Generate_ASN1_Deployment := Use_It;
123 0
   end Set_ASN1_Deployment;
124

125
   -----------------------------
126
   -- PolyORB_HI_Ada_Makefile --
127
   -----------------------------
128

129 1
   procedure PolyORB_HI_Ada_Makefile
130
     (Appli_Name              : Name_Id;
131
      Node_Name               : Name_Id;
132
      Execution_Platform      : Supported_Execution_Platform := Platform_None;
133
      Execution_Platform_Name : Name_Id;
134
      USER_CFLAGS             : Name_Id;
135
      USER_LDFLAGS            : Name_Id;
136
      Transport_API           : Supported_Transport_APIs;
137
      Ada_Sources             : Name_Tables.Instance;
138
      Asn_Sources             : Name_Tables.Instance;
139
      C_Sources               : Name_Tables.Instance;
140
      C_Libraries             : Name_Tables.Instance;
141
      User_Source_Dirs        : Name_Tables.Instance;
142
      Use_Transport           : Boolean;
143
      Use_Simulink            : Boolean;
144
      Simulink_Directory      : Name_Id;
145
      Simulink_Node           : Name_Id;
146
      Use_Scade               : Boolean;
147
      Scade_Directory         : Name_Id)
148
   is
149
      pragma Unreferenced
150
        (Appli_Name,
151
         Transport_API,
152
         Execution_Platform_Name,
153
         Ada_Sources,
154
         C_Libraries,
155
         User_Source_Dirs,
156
         Use_Transport,
157
         Use_Scade,
158
         Scade_Directory,
159
         Use_Simulink,
160
         Simulink_Directory,
161
         Simulink_Node);
162

163 1
      Target_Prefix : String_Access := Getenv ("TARGET_PREFIX");
164 1
      Target        : String_Access;
165

166
   begin
167
      --  Determine the compiler that will be used. If the
168
      --  user did specify the target prefix by mean of the
169
      --  environment variable "TARGET_PREFIX" then we use
170
      --  its value. Otherwise, we use the default compiler
171
      --  name.
172

173 1
      case Execution_Platform is
174 1
         when Platform_Native |
175
           Platform_LINUX32   |
176
           Platform_LINUX64   |
177
           Platform_WIN32     |
178
           Platform_None      =>
179 1
            Change_If_Empty (String_Ptr (Target_Prefix), "");
180 1
            Target := new String'("NATIVE");
181

182 1
         when Platform_LEON_ORK =>
183 1
            Change_If_Empty (String_Ptr (Target_Prefix), "sparc-elf-");
184 1
            Target := new String'("LEON_ORK");
185

186 0
         when Platform_LEON_GNAT =>
187 0
            Change_If_Empty (String_Ptr (Target_Prefix), "leon-elf-");
188 0
            Target := new String'("LEON_GNAT");
189

190 0
         when Platform_ERC32_ORK =>
191 0
            Change_If_Empty (String_Ptr (Target_Prefix), "erc32-elf-");
192 0
            Target := new String'("ERC32");
193

194 0
         when Platform_MARTE_OS =>
195 0
            Change_If_Empty (String_Ptr (Target_Prefix), "m");
196 0
            Target := new String'("MARTEOS");
197

198 1
         when Platform_GNAT_Runtime =>
199 1
            Change_If_Empty (String_Ptr (Target_Prefix), "arm-eabi-");
200 1
            Target := new String'("GNAT_Runtime");
201

202 0
         when Platform_LEON_RTEMS | Platform_LEON_RTEMS_POSIX =>
203
            --   Nothing to do: a special makefile is used for RTEMS
204 0
            null;
205

206 0
         when others =>
207 0
            raise Program_Error
208 0
              with "Unsupported platform: " & Execution_Platform'Img;
209 1
      end case;
210

211 1
      if Execution_Platform /= Platform_LEON_RTEMS
212 1
        and then Execution_Platform /= Platform_LEON_RTEMS_POSIX
213
      then
214
         --  For GNAT ARM GPL 2018, gnatmake is no longer provided, we
215
         --  have to rely on gprbuild instead.
216

217 1
         if Execution_Platform /= Platform_GNAT_Runtime then
218 1
            Write_Line ("GNATMAKE = " & Target_Prefix.all & "gnatmake");
219 1
            Write_Line ("GNAT = " & Target_Prefix.all & "gnat");
220
         else
221 1
            Write_Line ("GNATMAKE = " & "gprbuild");
222 1
            Write_Line ("GNAT = " & Target_Prefix.all & "gnat");
223
         end if;
224

225 1
         Write_Line ("CC = " & Target_Prefix.all & "gcc");
226 1
         Write_Line ("TARGET = " & Target.all);
227 1
         Write_Line ("BUILD = Debug");
228 1
         Write_Line ("CGCTRL = No");
229 1
         Free (Target_Prefix);
230 1
         Free (Target);
231

232 1
         if USER_CFLAGS /= No_Name then
233 0
            Write_Str ("USER_CFLAGS += $(USER_CFLAGS)");
234 0
            Write_Name (USER_CFLAGS);
235 0
            Write_Eol;
236
         end if;
237 1
         if USER_LDFLAGS /= No_Name then
238 0
            Write_Str ("USER_LDFLAGS += $(USER_LDFLAGS)");
239 0
            Write_Name (USER_LDFLAGS);
240 0
            Write_Eol;
241
         end if;
242

243
         --  Project file
244

245 1
         Write_Str ("PROJECT_FILE = ");
246 1
         Write_Name (Node_Name);
247 1
         Write_Line (".gpr");
248 1
         Write_Str ("ASN_SOURCES=");
249

250 1
         if Generate_ASN1_Deployment then
251 0
            Write_Str ("../../asn1_deployment.asn ");
252
         end if;
253

254 1
         if Length (Asn_Sources) > 0 then
255 0
            for J in Name_Tables.First .. Name_Tables.Last (Asn_Sources) loop
256 0
               Write_Str ("");
257 0
               Write_Name (Asn_Sources.Table (J));
258 0
               exit when J = Name_Tables.Last (Asn_Sources);
259 0
               Write_Space;
260 0
            end loop;
261
         end if;
262 1
         Write_Eol;
263

264
         --  The 'all' target
265

266 1
         Write_Str ("all:");
267

268
         --  First, process ASN.1 files
269

270 1
         if Length (Asn_Sources) > 0 then
271 0
            Write_Str (" generate-asn1-files");
272
         end if;
273

274
         --  If there are C files to be compiled, add a dependency on
275
         --  these files
276

277 1
         if Length (C_Sources) > 0 then
278 1
            Write_Str (" compile-c-files");
279
         end if;
280

281 1
         Write_Eol;
282

283 1
         Write_Char (ASCII.HT);
284 1
         Write_Line
285
           ("ADA_PROJECT_PATH=" &
286 1
            Standard.Utils.Quoted
287 1
              (Get_Runtime_Path ("polyorb-hi-ada") &
288 1
               Path_Separator &
289 1
               "$$ADA_PROJECT_PATH") &
290
            " \");
291 1
         Write_Char (ASCII.HT);
292 1
         Write_Str
293
           ("  $(GNATMAKE) -x -p -P$(PROJECT_FILE) -XTARGET=$(TARGET)" &
294
            " -XBUILD=$(BUILD) -XCGCTRL=$(CGCTRL) -cargs ${USER_CFLAGS}");
295

296
         --  If there are C source or C libraries, there will be more
297
         --  options.
298

299 1
         Write_Str
300
           (" -largs $(EXTERNAL_OBJECTS) ${C_OBJECTS} ${USER_LDFLAGS}");
301

302 1
         Write_Eol;
303

304
         --  Use gnatelim to determine which portion of code is
305
         --  unused and recompile the application with Eliminate
306
         --  pragmas. Note: gnatelim is available in GNAT GPL/Pro,
307
         --  but not GCC
308

309 1
         Write_Eol;
310 1
         Write_Line ("elim:");
311 1
         Write_Char (ASCII.HT);
312 1
         Write_Line
313
           ("ADA_PROJECT_PATH=" &
314 1
            Standard.Utils.Quoted
315 1
              (Get_Runtime_Path ("polyorb-hi-ada") &
316 1
               Path_Separator &
317 1
               "$$ADA_PROJECT_PATH") &
318
            " \");
319 1
         Write_Char (ASCII.HT);
320 1
         Write_Str ("  $(GNAT) elim -P$(PROJECT_FILE) ");
321 1
         Write_Name (Node_Name);
322 1
         Write_Str (" > local.adc");
323 1
         Write_Eol;
324

325 1
         Write_Char (ASCII.HT);
326 1
         Write_Line
327
           ("ADA_PROJECT_PATH=" &
328 1
            Standard.Utils.Quoted
329 1
              (Get_Runtime_Path ("polyorb-hi-ada") &
330 1
               Path_Separator &
331 1
               "$$ADA_PROJECT_PATH") &
332
            " \");
333 1
         Write_Char (ASCII.HT);
334 1
         Write_Str
335
           ("  $(GNATMAKE) -f -P$(PROJECT_FILE) -XTARGET=$(TARGET)" &
336
              " -XBUILD=$(BUILD) -XCGCTRL=$(CGCTRL)" &
337
              " -cargs -gnatec=local.adc");
338

339
         --  If there are C source or C libraries, there will be more
340
         --  options.
341

342 1
         Write_Str
343
           (" -largs $(EXTERNAL_OBJECTS) ${C_OBJECTS} ${USER_LDFLAGS}");
344 1
         Write_Eol;
345

346
      else
347 0
         Write_Str ("PROGRAM = ");
348 0
         Write_Name (Node_Name);
349 0
         Write_Eol;
350 0
         Write_Eol;
351 0
         Write_Line
352
           ("include " &
353 0
            Get_Runtime_Path ("polyorb-hi-ada") &
354
            "/make/Makefile.rtems_ada");
355 0
         Write_Eol;
356 0
         Write_Line
357
           ("rtems_init.o: " &
358 0
            Get_Runtime_Path ("polyorb-hi-ada") &
359
            "/make/rtems_init.c $(FILESYSTEM_SRCS) $(NETWORK_HFILE) ");
360 0
         Write_Char (ASCII.HT);
361 0
         Write_Str ("$(CC) $(CFLAGS) -I. $(CPU_CFLAGS) -c $<");
362
      end if;
363

364 1
      Write_Eol;
365 1
      Write_Line ("generate-asn1-files: $(ASN_SOURCES)");
366 1
      Write_Char (ASCII.HT);
367 1
      Write_Line (" mono $(which asn1.exe) -Ada -uPER $(ASN_SOURCES)");
368 1
   end PolyORB_HI_Ada_Makefile;
369

370
   -------------------------------------
371
   -- PolyORB_HI_Ada_Ada_Project_File --
372
   -------------------------------------
373

374 1
   procedure PolyORB_HI_Ada_Ada_Project_File
375
     (Appli_Name         : Name_Id;
376
      Node_Name          : Name_Id;
377
      Is_Server          : Boolean;
378
      Execution_Platform : Supported_Execution_Platform;
379
      Ada_Runtime        : Name_Id;
380
      Transport_API      : Supported_Transport_APIs;
381
      Spec_Names         : Name_Tables.Instance;
382
      Custom_Spec_Names  : Name_Tables.Instance;
383
      Body_Names         : Name_Tables.Instance;
384
      Custom_Body_Names  : Name_Tables.Instance;
385
      User_Source_Dirs   : Name_Tables.Instance)
386
   is
387
      pragma Unreferenced (Appli_Name, Is_Server);
388

389
   begin
390 1
      if Ada_Runtime /= No_Name then
391 1
         Write_Str ("with """);
392 1
         Write_Name (Ada_Runtime);
393 1
         Write_Line (""";");
394
      end if;
395

396 1
      Write_Line
397
        ("with """ &
398 1
         Get_Runtime_Path ("polyorb-hi-ada") &
399 1
         Directory_Separator &
400
         "polyorb_hi"";");
401

402 1
      Write_Eol;
403

404 1
      Write_Str ("project ");
405 1
      Write_Name (Node_Name);
406 1
      Write_Line (" is");
407 1
      Increment_Indentation;
408

409
      --  The source directory list
410

411 1
      Write_Indentation;
412 1
      Write_Line ("for Source_Dirs use");
413 1
      Increment_Indentation;
414

415 1
      Write_Indentation (-1);
416 1
      Write_Line ("(""."",");
417

418
      --  Get the PolyORB-HI/Ada runtime source directory
419

420 1
      Write_Indentation;
421 1
      Write_Str ("""" & Get_Runtime_Path ("polyorb-hi-ada") & """");
422

423
      --  The user provided source dirs
424

425 1
      if Length (User_Source_Dirs) > 0 then
426 1
         Write_Line (",");
427

428 1
         for J in Name_Tables.First .. Name_Tables.Last (User_Source_Dirs) loop
429 1
            Write_Indentation;
430 1
            Write_Char ('"');
431 1
            Write_Name (User_Source_Dirs.Table (J));
432 1
            Write_Char ('"');
433

434 1
            exit when J = Name_Tables.Last (User_Source_Dirs);
435

436 0
            Write_Line (",");
437 0
         end loop;
438
      end if;
439

440 1
      Write_Line
441
        (") & external_as_list(""" &
442
         "ADA_INCLUDE_PATH" &
443
         """, """ &
444
         ":" &
445
         """);");
446

447 1
      Decrement_Indentation;
448

449
      --  The main subprogram name
450

451 1
      Write_Eol;
452 1
      Write_Indentation;
453 1
      Write_Str ("for Main use (""");
454 1
      Write_Name (Node_Name);
455 1
      Write_Line (".adb"");");
456

457 1
      if Ada_Runtime /= No_Name then
458 1
         Write_Eol;
459 1
         Write_Indentation;
460 1
         Write_Str ("for Target use ");
461 1
         Write_Name (Ada_Runtime);
462 1
         Write_Line ("'Target;");
463 1
         Write_Eol;
464 1
         Write_Indentation;
465 1
         Write_Str ("for Runtime (""Ada"") use ");
466 1
         Write_Name (Ada_Runtime);
467 1
         Write_Line ("'Runtime (""Ada"");");
468
      end if;
469

470
      --  The custom file names
471

472 1
      Write_Eol;
473 1
      Write_Indentation;
474 1
      Write_Line ("package Naming is");
475 1
      Increment_Indentation;
476

477 1
      Write_Eol;
478 1
      Write_Indentation;
479 1
      Write_Line ("--  Custom middleware file names");
480 1
      Write_Eol;
481

482 1
      case Execution_Platform is
483 1
         when Platform_LEON_ORK | Platform_LEON_GNAT | Platform_ERC32_ORK =>
484 1
            Write_Indentation;
485 1
            Write_Line
486
              ("for Body (""PolyORB_HI.Output_Low_Level"")" &
487
               " use ""polyorb_hi-output_low_level_leon.adb"";");
488

489 1
         when Platform_GNAT_Runtime =>
490 1
            Write_Indentation;
491 1
            Write_Line
492
              ("for Body (""PolyORB_HI.Output_Low_Level"")" &
493
               " use ""polyorb_hi-output_low_level_gnatruntime.adb"";");
494

495 1
         when others =>
496 1
            Write_Indentation;
497 1
            Write_Line
498
              ("for Body (""PolyORB_HI.Output_Low_Level"")" &
499
               " use ""polyorb_hi-output_low_level_native.adb"";");
500 1
      end case;
501

502 1
      case Transport_API is
503 0
         when Transport_BSD_Sockets =>
504 0
            Write_Indentation;
505 0
            if Add_SPARK2014_Annotations then
506 0
               Write_Line
507
                 ("for Body (""PolyORB_HI.Transport_Low_Level"")" &
508
                    " use ""polyorb_hi-transport_low_level_spark.adb"";");
509
            else
510 0
               Write_Line
511
                 ("for Body (""PolyORB_HI.Transport_Low_Level"")" &
512
                    " use ""polyorb_hi-transport_low_level_sockets.adb"";");
513
            end if;
514

515 0
         when Transport_SpaceWire =>
516 0
            raise Program_Error;
517

518 1
         when Transport_None =>
519
            --  This means the application is monolithic
520 1
            null;
521

522 0
         when Transport_User =>
523
            --  Code to be supplied by the user
524 0
            null;
525 1
      end case;
526

527 1
      if Length (Spec_Names) > 0 then
528 1
         Write_Eol;
529 1
         Write_Indentation;
530 1
         Write_Line ("--  Custom user spec names");
531 1
         Write_Eol;
532

533 1
         for J in Name_Tables.First .. Name_Tables.Last (Spec_Names) loop
534 1
            Write_Indentation;
535 1
            Write_Str ("for Specification (""");
536 1
            Write_Name (Spec_Names.Table (J));
537 1
            Write_Str (""") use """);
538 1
            Write_Name (Custom_Spec_Names.Table (J));
539 1
            Write_Line (""";");
540 1
         end loop;
541
      end if;
542

543 1
      if Length (Body_Names) > 0 then
544 1
         Write_Eol;
545 1
         Write_Indentation;
546 1
         Write_Line ("--  Custom user body names");
547 1
         Write_Eol;
548

549 1
         for J in Name_Tables.First .. Name_Tables.Last (Body_Names) loop
550 1
            Write_Indentation;
551 1
            Write_Str ("for Body (""");
552 1
            Write_Name (Body_Names.Table (J));
553 1
            Write_Str (""") use """);
554 1
            Write_Name (Custom_Body_Names.Table (J));
555 1
            Write_Line (""";");
556 1
         end loop;
557
      end if;
558

559 1
      Write_Eol;
560 1
      Decrement_Indentation;
561 1
      Write_Indentation;
562 1
      Write_Line ("end Naming;");
563 1
      Write_Eol;
564

565 1
      Write_Indentation;
566 1
      Write_Line ("package Compiler renames PolyORB_HI.Compiler;");
567 1
      Write_Indentation;
568 1
      Write_Line ("package Builder renames PolyORB_HI.Builder;");
569 1
      Write_Indentation;
570 1
      Write_Line ("package Binder renames PolyORB_HI.Binder;");
571 1
      Write_Indentation;
572 1
      Write_Line ("package Linker renames PolyORB_HI.Linker;");
573 1
      Write_Indentation;
574 1
      Write_Line ("package Check renames PolyORB_HI.Check;");
575 1
      Write_Indentation;
576 1
      Write_Line ("package Prove renames PolyORB_HI.Prove;");
577 1
      Write_Eol;
578

579 1
      Decrement_Indentation;
580 1
      Write_Str ("end ");
581 1
      Write_Name (Node_Name);
582 1
      Write_Line (";");
583 1
   end PolyORB_HI_Ada_Ada_Project_File;
584

585
   --------------
586
   -- Generate --
587
   --------------
588

589 1
   procedure Generate (AADL_Root : Node_Id) is
590 1
      Instance_Root : Node_Id;
591 1
      Success       : Boolean := True;
592

593
      procedure Generate_PolyORB_HI_Ada_Makefile is new Build_Utils.Makefiles
594
        .Generate
595
        (PolyORB_HI_Ada_Makefile);
596

597
      procedure Generate_PolyORB_HI_Ada_Ada_Project_File is new Build_Utils
598
        .Ada_Project_Files
599
        .Generate
600
        (PolyORB_HI_Ada_Ada_Project_File);
601

602
   begin
603
      --  Instantiate the AADL tree
604

605 1
      Instance_Root := Instantiate_Model (AADL_Root);
606

607
      --  Expand the AADL instance
608

609 1
      Expand (Instance_Root);
610

611 1
      Visit_Architecture_Instance (Instance_Root);
612

613
      --  Abort if the construction of the Ada tree failed
614

615 1
      if No (Ada_Root) then
616 0
         Display_Error ("Code generation failed", Fatal => True);
617
      end if;
618

619
      --  At this point, we have a valid Ada tree, we can begin the
620
      --  Ada source file generation.
621

622
      --  Enter the output directory
623

624 1
      Enter_Directory (Generated_Sources_Directory);
625

626 1
      if not Remove_Generated_Sources then
627
         --  Create the source files
628

629 1
         Ada_Tree.Generator.Generate (Ada_Root);
630

631
         --  Generate the Makefiles
632

633 1
         Generate_PolyORB_HI_Ada_Makefile (Instance_Root);
634

635
         --  Generate the Ada project files
636

637 1
         Generate_PolyORB_HI_Ada_Ada_Project_File (Instance_Root);
638

639
         --  If we have to generate the ASN1 deployment file, then
640
         --  we enter the directory that contains the generated
641
         --  code and invoke directly the ASN1 generator with the
642
         --  instance root. It should automatically create an .asn1
643
         --  file that contains deployment/messages informations.
644

645 1
         if Generate_ASN1_Deployment then
646 0
            ASN1.Generate (Instance_Root);
647
         end if;
648

649
         --  If the user requested to build the applications then we
650
         --  build it.
651

652 1
         if Compile_Generated_Sources then
653 1
            Build_Utils.Makefiles.Build (Instance_Root);
654
         end if;
655

656
      else
657 0
         Build_Utils.Makefiles.Clean (Instance_Root);
658
      end if;
659

660
      --  If the user requested to test the applications then we
661
      --  test it.
662

663 1
      if Do_Regression_Test or else Do_Coverage_Test then
664
         --  Execution_Utils package initialization
665

666 0
         Execution_Utils.Init;
667 0
         Execution_Utils.Visit (Instance_Root);
668

669 0
         Execution_Tests.Init;
670

671 0
         if Do_Regression_Test then
672 0
            Success :=
673 0
              Execute_Regression_Test
674 0
                (Scenario_Dir.all,
675
                 Ref_Map,
676 0
                 Integer (Timeout))
677 0
              and then Success;
678

679 0
            if not Create_Referencial then
680 0
               Write_Eol;
681 0
               if Success then
682 0
                  Write_Line ("--- All regression tests PASSED ---");
683
               else
684 0
                  Write_Line ("--- Regression tests FAILED ---");
685
               end if;
686
            end if;
687
         end if;
688

689 0
         if Do_Coverage_Test then
690 0
            Success :=
691 0
              Execute_Coverage_Test (Integer (Timeout)) and then Success;
692

693
         end if;
694

695
         --  Free memory
696

697 0
         Execution_Utils.Reset;
698 0
         Execution_Tests.Reset;
699 0
         Free (Scenario_Dir);
700

701
         --  Exit if one of the tests failed
702

703 0
         if not Success then
704 0
            OS_Exit (1);
705
         end if;
706
      end if;
707

708
      --  Leave the output directory
709

710 1
      Leave_Directory;
711 1
   end Generate;
712

713
   ----------
714
   -- Init --
715
   ----------
716

717 1
   procedure Init is
718
   begin
719
      --  Registration of the generator
720

721 1
      Register_Backend ("polyorb_hi_ada", Generate'Access, PolyORB_HI_Ada);
722

723
      --  Initialize some units
724

725 1
      Ocarina.Backends.PO_HI_Ada.Runtime.Initialize;
726 1
   end Init;
727

728
   -----------
729
   -- Reset --
730
   -----------
731

732 1
   procedure Reset is
733
   begin
734 1
      Ocarina.Backends.PO_HI_Ada.Runtime.Reset;
735 1
   end Reset;
736

737
   ---------------------------------
738
   -- Visit_Architecture_Instance --
739
   ---------------------------------
740

741 1
   procedure Visit_Architecture_Instance (E : Node_Id) is
742
   begin
743
      --  Create the specs subtrees
744

745 1
      Deployment.Package_Spec.Visit (E);
746 1
      Naming.Package_Spec.Visit (E);
747 1
      Types.Package_Spec.Visit (E);
748 1
      Subprograms.Package_Spec.Visit (E);
749 1
      Activity.Package_Spec.Visit (E);
750 1
      Job.Package_Spec.Visit (E);
751 1
      Transport.Package_Spec.Visit (E);
752 1
      Marshallers.Package_Spec.Visit (E);
753

754
      --  Create the bodies subtrees
755

756 1
      Types.Package_Body.Visit (E);
757 1
      Subprograms.Package_Body.Visit (E);
758 1
      Transport.Package_Body.Visit (E);
759 1
      Activity.Package_Body.Visit (E);
760 1
      Job.Package_Body.Visit (E);
761 1
      Marshallers.Package_Body.Visit (E);
762

763
      --  The main subprogram
764

765 1
      Main.Subprogram_Body.Visit (E);
766

767
      --  The makefiles
768

769 1
      Build_Utils.Makefiles.Visit (E);
770

771
      --  The Ada project files
772

773 1
      Build_Utils.Ada_Project_Files.Visit (E);
774 1
   end Visit_Architecture_Instance;
775

776
end Ocarina.Backends.PO_HI_Ada;

Read our documentation on viewing source code .

Loading