OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--    O C A R I N A . B A C K E N D S . C _ T R E E . G E N E R A T O R     --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--               Copyright (C) 2008-2009 Telecom ParisTech,                 --
10
--                 2010-2019 ESA & ISAE, 2019-2020 OpenAADL                 --
11
--                                                                          --
12
-- Ocarina  is free software; you can redistribute it and/or modify under   --
13
-- terms of the  GNU General Public License as published  by the Free Soft- --
14
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
16
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
17
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
--                    Ocarina is maintained by OpenAADL team                --
29
--                              (info@openaadl.org)                         --
30
--                                                                          --
31
------------------------------------------------------------------------------
32

33
with Ocarina.Namet;  use Ocarina.Namet;
34
with Ocarina.Output; use Ocarina.Output;
35
with Utils;          use Utils;
36
with Outfiles;       use Outfiles;
37

38
with GNAT.OS_Lib; use GNAT.OS_Lib;
39

40
with Ocarina.Backends.Utils;
41
with Ocarina.Backends.C_Tree.Nodes;
42
with Ocarina.Backends.C_Tree.Nutils;
43
with Ocarina.Backends.C_Values;
44
with Ocarina.Backends.Messages;
45

46
package body Ocarina.Backends.C_Tree.Generator is
47

48
   use Ocarina.Backends.Utils;
49
   use Ocarina.Backends.C_Tree.Nodes;
50
   use Ocarina.Backends.C_Tree.Nutils;
51
   use Ocarina.Backends.C_Values;
52
   use Ocarina.Backends.Messages;
53

54
   procedure Generate_Define_Statement (N : Node_Id);
55
   procedure Generate_Pointer_Type (N : Node_Id);
56
   procedure Generate_Constant_Type (N : Node_Id);
57
   procedure Generate_Array_Declaration (N : Node_Id);
58
   procedure Generate_Base_Type (N : Node_Id);
59
   procedure Generate_C_Comment (N : Node_Id);
60
   procedure Generate_Call_Profile (N : Node_Id);
61
   procedure Generate_Macro_Call (N : Node_Id);
62
   procedure Generate_Doxygen_C_Comment (N : Node_Id);
63
   procedure Generate_HI_Distributed_Application (N : Node_Id);
64
   procedure Generate_HI_Node (N : Node_Id);
65
   procedure Generate_Assignment_Statement (N : Node_Id);
66
   procedure Generate_Defining_Identifier (N : Node_Id);
67
   procedure Generate_Expression (N : Node_Id);
68
   procedure Generate_Enum_Aggregate (N : Node_Id);
69
   procedure Generate_Array_Values (N : Node_Id);
70
   procedure Generate_Array_Value (N : Node_Id);
71
   procedure Generate_For_Statement (N : Node_Id);
72
   procedure Generate_Full_Type_Declaration (N : Node_Id);
73
   procedure Generate_Function_Implementation (N : Node_Id);
74
   procedure Generate_Function_Specification (N : Node_Id);
75
   procedure Generate_If_Statement (N : Node_Id);
76
   procedure Generate_Literal (N : Node_Id);
77
   procedure Generate_Member_Declaration (N : Node_Id);
78
   procedure Generate_Variable_Declaration (N : Node_Id);
79
   procedure Generate_Parameter (N : Node_Id);
80
   procedure Generate_Parameter_List (L : List_Id);
81
   procedure Generate_Return_Statement (N : Node_Id);
82
   procedure Generate_Struct_Aggregate (N : Node_Id);
83
   procedure Generate_Type_Conversion (N : Node_Id);
84
   procedure Generate_Union_Aggregate (N : Node_Id);
85
   procedure Generate_While_Statement (N : Node_Id);
86
   procedure Generate_Source_File (N : Node_Id);
87
   procedure Generate_Header_File (N : Node_Id);
88
   procedure Generate_HI_Unit (N : Node_Id);
89
   procedure Generate_Included_Files (N : List_Id);
90
   procedure Generate_Include_Clause (N : Node_Id);
91
   procedure Generate_Ifdef_Clause (N : Node_Id);
92
   procedure Generate_Variable_Address (N : Node_Id);
93
   procedure Generate_Member_Designator (N : Node_Id);
94
   procedure Generate_Switch_Alternative (N : Node_Id);
95
   procedure Generate_Switch_Statement (N : Node_Id);
96
   procedure Generate_Extern_Entity_Declaration (N : Node_Id);
97

98
   procedure Write (T : Token_Type);
99
   procedure Write_Line (T : Token_Type);
100

101
   procedure Generate_Statement_Delimiter (N : Node_Id);
102

103
   function Get_File_Name (N : Node_Id) return Name_Id;
104
   --  Generate a C file name from the package node given as parameter
105

106
   -------------------
107
   -- Get_File_Name --
108
   -------------------
109

110 1
   function Get_File_Name (N : Node_Id) return Name_Id is
111
      Header_Suffix : constant String := ".h";
112
      Source_Suffix : constant String := ".c";
113
   begin
114
      --  The File name corresponding is the lowerd name of N
115

116 1
      Get_Name_String
117 1
        (Conventional_Base_Name (Name (Defining_Identifier (N))));
118

119
      --  Adding file suffix
120

121 1
      if Kind (N) = K_Header_File then
122 1
         Add_Str_To_Name_Buffer (Header_Suffix);
123
      else
124 1
         Add_Str_To_Name_Buffer (Source_Suffix);
125
      end if;
126

127 1
      return Name_Find;
128
   end Get_File_Name;
129

130
   --------------
131
   -- Generate --
132
   --------------
133

134 1
   procedure Generate (N : Node_Id) is
135
   begin
136 1
      case Kind (N) is
137 1
         when K_Header_File =>
138 1
            Generate_Header_File (N);
139

140 1
         when K_Source_File =>
141 1
            Generate_Source_File (N);
142

143 1
         when K_C_Comment =>
144 1
            Generate_C_Comment (N);
145

146 1
         when K_HI_Distributed_Application =>
147 1
            Generate_HI_Distributed_Application (N);
148

149 1
         when K_HI_Unit =>
150 1
            Generate_HI_Unit (N);
151

152 1
         when K_HI_Node =>
153 1
            Generate_HI_Node (N);
154

155 1
         when K_Include_Clause =>
156 1
            Generate_Include_Clause (N);
157

158 1
         when K_Ifdef_Clause =>
159 1
            Generate_Ifdef_Clause (N);
160

161 1
         when K_Assignment_Statement =>
162 1
            Generate_Assignment_Statement (N);
163

164 1
         when K_Doxygen_C_Comment =>
165 1
            Generate_Doxygen_C_Comment (N);
166

167 1
         when K_Call_Profile =>
168 1
            Generate_Call_Profile (N);
169

170 1
         when K_Macro_Call =>
171 1
            Generate_Macro_Call (N);
172

173 1
         when K_Defining_Identifier =>
174 1
            Generate_Defining_Identifier (N);
175

176 1
         when K_Expression =>
177 1
            Generate_Expression (N);
178

179 1
         when K_Enum_Aggregate =>
180 1
            Generate_Enum_Aggregate (N);
181

182 1
         when K_For_Statement =>
183 1
            Generate_For_Statement (N);
184

185 1
         when K_While_Statement =>
186 1
            Generate_While_Statement (N);
187

188 1
         when K_Full_Type_Declaration =>
189 1
            Generate_Full_Type_Declaration (N);
190

191 1
         when K_If_Statement =>
192 1
            Generate_If_Statement (N);
193

194 1
         when K_Function_Implementation =>
195 1
            Generate_Function_Implementation (N);
196

197 1
         when K_Function_Specification =>
198 1
            Generate_Function_Specification (N);
199

200 1
         when K_Literal =>
201 1
            Generate_Literal (N);
202

203 1
         when K_Extern_Entity_Declaration =>
204 1
            Generate_Extern_Entity_Declaration (N);
205

206 1
         when K_Array_Values =>
207 1
            Generate_Array_Values (N);
208

209 1
         when K_Array_Value =>
210 1
            Generate_Array_Value (N);
211

212 1
         when K_Member_Declaration =>
213 1
            Generate_Member_Declaration (N);
214

215 1
         when K_Variable_Declaration =>
216 1
            Generate_Variable_Declaration (N);
217

218 1
         when K_Return_Statement =>
219 1
            Generate_Return_Statement (N);
220

221 1
         when K_Struct_Aggregate =>
222 1
            Generate_Struct_Aggregate (N);
223

224 1
         when K_Type_Conversion =>
225 1
            Generate_Type_Conversion (N);
226

227 1
         when K_Union_Aggregate =>
228 1
            Generate_Union_Aggregate (N);
229

230 1
         when K_Define_Statement =>
231 1
            Generate_Define_Statement (N);
232

233 1
         when K_Pointer_Type =>
234 1
            Generate_Pointer_Type (N);
235

236 1
         when K_Constant_Type =>
237 1
            Generate_Constant_Type (N);
238

239 1
         when K_Variable_Address =>
240 1
            Generate_Variable_Address (N);
241

242 1
         when K_Member_Designator =>
243 1
            Generate_Member_Designator (N);
244

245 1
         when K_Switch_Statement =>
246 1
            Generate_Switch_Statement (N);
247

248 1
         when K_Switch_Alternative =>
249 1
            Generate_Switch_Alternative (N);
250

251 1
         when K_Array_Declaration =>
252 1
            Generate_Array_Declaration (N);
253

254 1
         when K_Float .. K_Void =>
255 1
            Generate_Base_Type (N);
256

257 0
         when others =>
258 0
            Display_Error ("other element in generator", Fatal => False);
259 0
            null;
260 1
      end case;
261 1
   end Generate;
262

263
   --------------------------
264
   -- Generate_C_Comment --
265
   --------------------------
266

267 1
   procedure Generate_C_Comment (N : Node_Id) is
268
      --  This procedure does the following :
269

270
      --  * It generates a C comment basing on the name of node N
271

272
      --  * If the name it too long, and depending on the location of
273
      --    the comment in the source code, the procedure splits the
274
      --    comment into more than a line.
275

276
      --  The comment is assumed to be a sequence of caracters,
277
      --  beginning and ending with a NON-SPACE caracter.
278

279
      --  A word is :
280

281
      --  a space character, or else a sequence of non space
282
      --  characters located between two spaces.
283

284
      --  The maximum length of a line, in colums
285 1
      Max_Line_Length : constant Natural := 78;
286

287
      function Are_There_More_Words return Boolean;
288
      --  This function returns True if there are words in the buffer
289

290
      function Next_Word_Length return Natural;
291
      --  This function returns the size of the next word to be
292
      --  got. It returns zero when the buffer is empty.
293

294
      function Get_Next_Word return String;
295
      --  This function extracts the next word from the buffer
296

297
      --------------------------
298
      -- Are_There_More_Words --
299
      --------------------------
300

301 1
      function Are_There_More_Words return Boolean is
302
      begin
303 1
         return (Name_Len /= 0);
304
      end Are_There_More_Words;
305

306
      ----------------------
307
      -- Next_Word_Length --
308
      ----------------------
309

310 1
      function Next_Word_Length return Natural is
311 1
         L : Natural;
312
      begin
313 1
         if not Are_There_More_Words then
314 0
            L := 0;
315 1
         elsif Name_Buffer (1) = ' ' then
316 1
            L := 1;
317
         else
318 1
            L := 0;
319 1
            while L + 1 <= Name_Len and then Name_Buffer (L + 1) /= ' ' loop
320 1
               L := L + 1;
321 1
            end loop;
322
         end if;
323 1
         return L;
324
      end Next_Word_Length;
325

326
      -------------------
327
      -- Get_Next_Word --
328
      -------------------
329

330 1
      function Get_Next_Word return String is
331 1
         L : constant Natural := Next_Word_Length;
332
      begin
333 1
         if L = 0 then
334 0
            return "";
335
         else
336 1
            declare
337 1
               Next_Word : constant String := Name_Buffer (1 .. L);
338
            begin
339 1
               if Name_Len = L then
340 1
                  Name_Len := 0;
341
               else
342 1
                  Set_Str_To_Name_Buffer (Name_Buffer (L + 1 .. Name_Len));
343
               end if;
344 1
               return Next_Word;
345
            end;
346
         end if;
347
      end Get_Next_Word;
348

349 1
      First_Line   : Boolean := True;
350 1
      Used_Columns : Natural;
351
   begin
352 1
      Get_Name_String (Name (Defining_Identifier (N)));
353

354 1
      while Are_There_More_Words loop
355 1
         Used_Columns := N_Space;
356 1
         if First_Line then
357 1
            First_Line := False;
358
         else
359 1
            Write_Indentation;
360
         end if;
361

362
         --  We consume 4 colums
363

364 1
         Used_Columns := Used_Columns + 2;
365 1
         Write_Str ("/*");
366

367 1
         if Has_Header_Spaces (N) then
368 1
            Used_Columns := Used_Columns + 2;
369 1
            Write_Str ("  ");
370
         end if;
371

372 1
         Used_Columns := Used_Columns + Next_Word_Length;
373 1
         Write_Str (Get_Next_Word);
374

375 1
         while Are_There_More_Words
376 1
           and then (Used_Columns + Next_Word_Length < Max_Line_Length)
377
         loop
378 1
            Used_Columns := Used_Columns + Next_Word_Length;
379 1
            Write_Str (Get_Next_Word);
380 1
         end loop;
381 1
         Write_Str ("*/");
382

383 1
         if Are_There_More_Words then
384 1
            Write_Eol;
385
         end if;
386 1
      end loop;
387 1
      Write_Eol;
388 1
   end Generate_C_Comment;
389

390
   --------------------------
391
   -- Generate_Doxygen_C_Comment --
392
   --------------------------
393

394 1
   procedure Generate_Doxygen_C_Comment (N : Node_Id) is
395
      --  This procedure does the following :
396

397
      --  * It generates a C comment basing on the name of node N
398

399
      --  * If the name it too long, and depending on the location of
400
      --    the comment in the source code, the procedure splits the
401
      --    comment into more than a line.
402

403
      --  The comment is assumed to be a sequence of caracters,
404
      --  beginning and ending with a NON-SPACE caracter.
405

406
      --  A word is :
407

408
      --  a space character, or else a sequence of non space
409
      --  characters located between two spaces.
410

411
      --  The maximum length of a line, in colums
412 1
      Max_Line_Length : constant Natural := 78;
413

414
      function Are_There_More_Words return Boolean;
415
      --  This function returns True if there are words in the buffer
416

417
      function Next_Word_Length return Natural;
418
      --  This function returns the size of the next word to be
419
      --  got. It returns zero when the buffer is empty.
420

421
      function Get_Next_Word return String;
422
      --  This function extracts the next word from the buffer
423

424
      --------------------------
425
      -- Are_There_More_Words --
426
      --------------------------
427

428 1
      function Are_There_More_Words return Boolean is
429
      begin
430 1
         return (Name_Len /= 0);
431
      end Are_There_More_Words;
432

433
      ----------------------
434
      -- Next_Word_Length --
435
      ----------------------
436

437 1
      function Next_Word_Length return Natural is
438 1
         L : Natural;
439
      begin
440 1
         if not Are_There_More_Words then
441 0
            L := 0;
442 1
         elsif Name_Buffer (1) = ' ' then
443 1
            L := 1;
444
         else
445 1
            L := 0;
446 1
            while L + 1 <= Name_Len and then Name_Buffer (L + 1) /= ' ' loop
447 1
               L := L + 1;
448 1
            end loop;
449
         end if;
450 1
         return L;
451
      end Next_Word_Length;
452

453
      -------------------
454
      -- Get_Next_Word --
455
      -------------------
456

457 1
      function Get_Next_Word return String is
458 1
         L : constant Natural := Next_Word_Length;
459
      begin
460 1
         if L = 0 then
461 0
            return "";
462
         else
463 1
            declare
464 1
               Next_Word : constant String := Name_Buffer (1 .. L);
465
            begin
466 1
               if Name_Len = L then
467 1
                  Name_Len := 0;
468
               else
469 1
                  Set_Str_To_Name_Buffer (Name_Buffer (L + 1 .. Name_Len));
470
               end if;
471 1
               return Next_Word;
472
            end;
473
         end if;
474
      end Get_Next_Word;
475

476 1
      Used_Columns : Natural;
477
   begin
478 1
      Used_Columns := N_Space;
479 1
      Used_Columns := Used_Columns + 3;
480 1
      Write_Eol;
481 1
      Write_Str ("/*!");
482

483 1
      if For_Struct (N) then
484 0
         Write_Eol;
485 0
         Write_Str (" * \struct ");
486 0
         Write_Name (Name (Element (N)));
487
      end if;
488

489 1
      if For_Union (N) then
490 0
         Write_Eol;
491 0
         Write_Str (" * \union ");
492 0
         Write_Name (Name (Element (N)));
493
      end if;
494

495 1
      if For_Enum (N) then
496 0
         Write_Eol;
497 0
         Write_Str (" * \enum ");
498 0
         Write_Name (Name (Element (N)));
499
      end if;
500

501 1
      if For_Function (N) then
502 1
         Write_Eol;
503 1
         Write_Str (" * \fn ");
504 1
         Write_Name (Name (Element (N)));
505
      end if;
506

507 1
      if For_Variable (N) then
508 1
         Write_Eol;
509 1
         Write_Str (" * \var ");
510 1
         Write_Name (Name (Element (N)));
511
      end if;
512

513 1
      if For_Define (N) then
514 0
         Write_Eol;
515 0
         Write_Str (" * \def ");
516 0
         Write_Name (Name (Element (N)));
517
      end if;
518

519 1
      if For_Typedef (N) then
520 0
         Write_Eol;
521 0
         Write_Str (" * \typedef ");
522 0
         Write_Name (Name (Element (N)));
523
      end if;
524

525 1
      if For_File (N) then
526 0
         Write_Eol;
527 0
         Write_Str (" * \file ");
528 0
         Write_Name (Name (Element (N)));
529
      end if;
530

531 1
      if For_Namespace (N) then
532 0
         Write_Eol;
533 0
         Write_Str (" * \namespace ");
534 0
         Write_Name (Name (Element (N)));
535
      end if;
536

537 1
      if For_Package (N) then
538 0
         Write_Eol;
539 0
         Write_Str (" * \package ");
540 0
         Write_Name (Name (Element (N)));
541
      end if;
542

543 1
      if For_Interface (N) then
544 0
         Write_Eol;
545 0
         Write_Str (" * \interface ");
546 0
         Write_Name (Name (Element (N)));
547
      end if;
548

549 1
      if Summary (N) /= No_Node then
550 1
         Write_Eol;
551 1
         Write_Str (" * \brief ");
552 1
         Write_Name (Name (Summary (N)));
553 1
         Write_Eol;
554 1
         Write_Str (" *");
555
      end if;
556

557 1
      Write_Eol;
558 1
      Get_Name_String (Name (Description (N)));
559 1
      while Are_There_More_Words loop
560 1
         Used_Columns := N_Space;
561

562
         --  We consume 4 colums
563

564 1
         Used_Columns := Used_Columns + 2;
565 1
         Write_Str (" * ");
566 1
         if Has_Header_Spaces (N) then
567 0
            Used_Columns := Used_Columns + 2;
568 0
            Write_Str ("  ");
569
         end if;
570

571 1
         Used_Columns := Used_Columns + Next_Word_Length;
572 1
         Write_Str (Get_Next_Word);
573

574 1
         while Are_There_More_Words
575 1
           and then (Used_Columns + Next_Word_Length < Max_Line_Length)
576
         loop
577 1
            Used_Columns := Used_Columns + Next_Word_Length;
578 1
            Write_Str (Get_Next_Word);
579 1
         end loop;
580

581 1
         if Are_There_More_Words then
582 1
            Write_Eol;
583
         end if;
584 1
      end loop;
585 1
      Write_Eol;
586 1
      Write_Str (" */");
587 1
      Write_Eol;
588 1
   end Generate_Doxygen_C_Comment;
589

590
   -----------------------------------
591
   -- Generate_Assignment_Statement --
592
   -----------------------------------
593

594 1
   procedure Generate_Assignment_Statement (N : Node_Id) is
595
   begin
596 1
      Generate (Defining_Identifier (N));
597 1
      Write_Space;
598 1
      Write (Tok_Equal);
599 1
      Write_Eol;
600 1
      Increment_Indentation;
601 1
      Write_Indentation (-1);
602 1
      Generate (Expression (N));
603 1
      Decrement_Indentation;
604 1
   end Generate_Assignment_Statement;
605

606
   --------------------------------
607
   -- Generate_Array_Declaration --
608
   --------------------------------
609

610 1
   procedure Generate_Array_Declaration (N : Node_Id) is
611
   begin
612 1
      Generate (Defining_Identifier (N));
613 1
      Write (Tok_Left_Hook);
614 1
      Generate (Array_Size (N));
615 1
      Write (Tok_Right_Hook);
616 1
   end Generate_Array_Declaration;
617

618
   ----------------------------------------
619
   -- Generate_Extern_Entity_Declaration --
620
   ----------------------------------------
621

622 1
   procedure Generate_Extern_Entity_Declaration (N : Node_Id) is
623
   begin
624 1
      Write (Tok_Extern);
625 1
      Write_Space;
626 1
      Generate (Entity (N));
627 1
   end Generate_Extern_Entity_Declaration;
628

629
   ---------------------------
630
   -- Generate_Array_Values --
631
   ---------------------------
632

633 1
   procedure Generate_Array_Values (N : Node_Id) is
634 1
      D : Node_Id := First_Node (Values (N));
635
   begin
636 1
      Write (Tok_Left_Brace);
637 1
      while Present (D) loop
638 1
         Generate (D);
639 1
         D := Next_Node (D);
640 1
         if Present (D) then
641 1
            Write (Tok_Comma);
642
         end if;
643 1
      end loop;
644 1
      Write (Tok_Right_Brace);
645 1
   end Generate_Array_Values;
646

647
   --------------------------
648
   -- Generate_Array_Value --
649
   --------------------------
650

651 1
   procedure Generate_Array_Value (N : Node_Id) is
652
   begin
653 1
      Generate (Defining_Identifier (N));
654 1
      Write (Tok_Left_Hook);
655 1
      Generate (Array_Item (N));
656 1
      Write (Tok_Right_Hook);
657 1
   end Generate_Array_Value;
658

659
   ----------------------------------
660
   -- Generate_Defining_Identifier --
661
   ----------------------------------
662

663 1
   procedure Generate_Defining_Identifier (N : Node_Id) is
664
   begin
665 1
      if Is_Pointer (N) then
666 1
         Write (Tok_Asterisk);
667
      end if;
668

669 1
      if Is_Variable_Address (N) then
670 1
         Write (Tok_Ampersand);
671
      end if;
672

673 1
      Write_Name (Name (N));
674 1
   end Generate_Defining_Identifier;
675

676
   -------------------------
677
   -- Generate_Expression --
678
   -------------------------
679

680 1
   procedure Generate_Expression (N : Node_Id) is
681 1
      L_Expr : constant Node_Id     := Left_Expression (N);
682 1
      Op     : constant Operator_Id := Operator (N);
683 1
      R_Expr : constant Node_Id     := Right_Expression (N);
684
   begin
685
      --  Each expression having a right part and a left part is
686
      --  systematically put between two parentheses.
687

688 1
      if Get_Name_String (Operator_Image (Standard.Integer (Op))) = "*"
689
        or else
690 1
          Get_Name_String (Operator_Image (Standard.Integer (Op))) = "/"
691
        or else
692 1
          Get_Name_String (Operator_Image (Standard.Integer (Op))) = "&&"
693 1
        or else
694 1
          Get_Name_String (Operator_Image (Standard.Integer (Op))) = "||"
695
      then
696 1
         if Kind (L_Expr) = K_Expression then
697 1
            Write (Tok_Left_Paren);
698 1
            Generate (L_Expr);
699 1
            Write (Tok_Right_Paren);
700
         else
701 1
            Generate (L_Expr);
702
         end if;
703

704 1
         Write_Space;
705 1
         Write_Name (Operator_Image (Standard.Integer (Op)));
706 1
         Write_Space;
707

708 1
         if Kind (R_Expr) = K_Expression then
709 1
            Write (Tok_Left_Paren);
710 1
            Generate (R_Expr);
711 1
            Write (Tok_Right_Paren);
712
         else
713 1
            Generate (R_Expr);
714
         end if;
715

716
      elsif
717 1
        Get_Name_String (Operator_Image (Standard.Integer (Op))) = "!"
718
      then
719 0
         Write_Name (Operator_Image (Standard.Integer (Op)));
720 0
         if Kind (L_Expr) = K_Expression then
721 0
            Write (Tok_Left_Paren);
722 0
            Generate (L_Expr);
723 0
            Write (Tok_Right_Paren);
724
         else
725 0
            Generate (L_Expr);
726
         end if;
727
      elsif
728 1
        Get_Name_String (Operator_Image (Standard.Integer (Op))) = "++"
729
      then
730 1
         Generate (L_Expr);
731 1
         Write_Name (Operator_Image (Standard.Integer (Op)));
732
      else
733 1
         Generate (L_Expr);
734 1
         Write_Space;
735 1
         Write_Name (Operator_Image (Standard.Integer (Op)));
736 1
         Write_Space;
737 1
         Generate (R_Expr);
738
      end if;
739

740 1
   end Generate_Expression;
741

742
   ----------------------------
743
   -- Generate_For_Statement --
744
   ----------------------------
745

746 1
   procedure Generate_For_Statement (N : Node_Id) is
747 1
      D : Node_Id := First_Node (Statements (N));
748
   begin
749 1
      Write (Tok_For);
750 1
      Write_Space;
751 1
      Write (Tok_Left_Paren);
752 1
      Generate (Pre_Cond (N));
753 1
      Write (Tok_Semicolon);
754 1
      Generate (Condition (N));
755 1
      Write (Tok_Semicolon);
756 1
      Generate (Post_Cond (N));
757 1
      Write (Tok_Right_Paren);
758 1
      Write_Eol;
759 1
      Write (Tok_Left_Brace);
760 1
      Increment_Indentation;
761 1
      while Present (D) loop
762 1
         Write_Indentation;
763 1
         Generate (D);
764 1
         Generate_Statement_Delimiter (D);
765 1
         D := Next_Node (D);
766 1
      end loop;
767 1
      Decrement_Indentation;
768 1
      Write_Indentation;
769 1
      Write (Tok_Right_Brace);
770 1
   end Generate_For_Statement;
771

772
   ------------------------------------
773
   -- Generate_Full_Type_Declaration --
774
   ------------------------------------
775

776 1
   procedure Generate_Full_Type_Declaration (N : Node_Id) is
777
   begin
778 1
      Write (Tok_Typedef);
779 1
      Write_Space;
780 1
      Generate (Type_Definition (N));
781 1
      Write_Space;
782 1
      Generate (Type_Name (N));
783
--      Write_Name (Name (Defining_Identifier (N)));
784 1
   end Generate_Full_Type_Declaration;
785

786
   ---------------------------
787
   -- Generate_If_Statement --
788
   ---------------------------
789

790 1
   procedure Generate_If_Statement (N : Node_Id) is
791 1
      T : constant List_Id := Statements (N);
792 1
      E : constant List_Id := Else_Statements (N);
793 1
      I : Node_Id;
794

795
   begin
796
      --  Enter If_Statement
797

798 1
      Write_Str ("/* :: Yes if commentary :: */");
799 1
      Write (Tok_If);
800 1
      Write_Space;
801 1
      Write (Tok_Left_Paren);
802 1
      Generate (Condition (N));
803 1
      Write (Tok_Right_Paren);
804 1
      Write_Eol;
805 1
      Write_Indentation;
806 1
      Write (Tok_Left_Brace);
807 1
      Write_Eol;
808 1
      Write_Indentation;
809

810
      --  If_Statement cannot be empty. A null statement is always
811
      --  there if needed.
812

813 1
      Increment_Indentation;
814 1
      I := First_Node (T);
815 1
      while Present (I) loop
816 1
         Write_Indentation;
817 1
         Generate (I);
818 1
         Generate_Statement_Delimiter (I);
819 1
         I := Next_Node (I);
820 1
      end loop;
821 1
      Write_Eol;
822 1
      Decrement_Indentation;
823 1
      Write_Indentation;
824 1
      Write (Tok_Right_Brace);
825

826
      --  Else_Statement can be empty
827

828 1
      if not Is_Empty (E) then
829 1
         Write_Indentation;
830 1
         Write (Tok_Else);
831 1
         Write_Eol;
832 1
         Write (Tok_Left_Brace);
833 1
         Write_Eol;
834 1
         Increment_Indentation;
835 1
         I := First_Node (E);
836 1
         while Present (I) loop
837 1
            Write_Indentation;
838 1
            Generate (I);
839 1
            Generate_Statement_Delimiter (I);
840 1
            I := Next_Node (I);
841 1
         end loop;
842 1
         Decrement_Indentation;
843 1
         Write_Eol;
844 1
         Write_Indentation;
845 1
         Write (Tok_Right_Brace);
846 1
         Write_Eol;
847
      end if;
848 1
   end Generate_If_Statement;
849

850
   ----------------------
851
   -- Generate_Literal --
852
   ----------------------
853

854 1
   procedure Generate_Literal (N : Node_Id) is
855
   begin
856 1
      Write_Str (Image (Value (N)));
857 1
   end Generate_Literal;
858

859
   -----------------------------
860
   -- Generate_While_Statement --
861
   -----------------------------
862

863 1
   procedure Generate_While_Statement (N : Node_Id) is
864 1
      D : Node_Id := First_Node (Statements (N));
865
   begin
866 1
      Write (Tok_While);
867 1
      Write_Space;
868 1
      Write (Tok_Left_Paren);
869 1
      Generate (Condition (N));
870 1
      Write (Tok_Right_Paren);
871 1
      Write_Eol;
872 1
      Write_Indentation;
873 1
      Write (Tok_Left_Brace);
874 1
      Write_Eol;
875 1
      Increment_Indentation;
876 1
      while Present (D) loop
877 1
         Write_Indentation;
878 1
         Generate (D);
879 1
         Generate_Statement_Delimiter (D);
880 1
         D := Next_Node (D);
881 1
      end loop;
882 1
      Decrement_Indentation;
883 1
      Write_Indentation;
884 1
      Write (Tok_Right_Brace);
885 1
   end Generate_While_Statement;
886

887
   ------------------------
888
   -- Generate_Parameter --
889
   ------------------------
890

891 1
   procedure Generate_Parameter (N : Node_Id) is
892
   begin
893 1
      Generate (Parameter_Type (N));
894 1
      Write_Space;
895 1
      Name_Buffer (1 .. Var_Name_Len) := (others => ' ');
896 1
      Get_Name_String (Name (Defining_Identifier (N)));
897

898 1
      if Var_Name_Len > Name_Len then
899 0
         Name_Len := Var_Name_Len;
900
      end if;
901

902 1
      Write_Str (Name_Buffer (1 .. Name_Len));
903 1
   end Generate_Parameter;
904

905
   -----------------------------
906
   -- Generate_Parameter_List --
907
   -----------------------------
908

909 1
   procedure Generate_Parameter_List (L : List_Id) is
910 1
      N : Node_Id;
911

912
   begin
913
      --  If we got there, then L is not empty.
914 1
      if Is_Empty (L) then
915 1
         Write (Tok_Left_Paren);
916 1
         Write_Str ("void");
917 1
         Write (Tok_Right_Paren);
918 1
         return;
919
      end if;
920

921 1
      Write_Eol;
922 1
      Increment_Indentation;
923 1
      Increment_Indentation;
924 1
      Write_Indentation;
925 1
      Write (Tok_Left_Paren);
926

927 1
      N := First_Node (L);
928
      loop
929 1
         Generate_Parameter (N);
930 1
         exit when No (Next_Node (N));
931 1
         Write (Tok_Comma);
932 1
         N := Next_Node (N);
933 1
         Write_Eol;
934 1
         Write_Indentation;
935 1
      end loop;
936

937 1
      Write (Tok_Right_Paren);
938 1
      Decrement_Indentation;
939 1
      Decrement_Indentation;
940 1
      Write_Indentation;
941
   end Generate_Parameter_List;
942

943
   -------------------------------
944
   -- Generate_Return_Statement --
945
   -------------------------------
946

947 1
   procedure Generate_Return_Statement (N : Node_Id) is
948 1
      E : constant Node_Id := Expression (N);
949
   begin
950 1
      Write (Tok_Return);
951

952 1
      if Present (E) then
953 1
         Write_Space;
954 1
         Write (Tok_Left_Paren);
955 1
         Generate (E);
956 1
         Write (Tok_Right_Paren);
957
      end if;
958 1
   end Generate_Return_Statement;
959

960
   ---------------------------
961
   -- Generate_Call_Profile --
962
   ---------------------------
963

964 1
   procedure Generate_Call_Profile (N : Node_Id) is
965 1
      L : constant List_Id := Parameters (N);
966 1
      P : Node_Id;
967

968
   begin
969 1
      Generate (Defining_Identifier (N));
970

971 1
      Write_Space;
972

973 1
      Write (Tok_Left_Paren);
974 1
      if not Is_Empty (L) then
975 1
         P := First_Node (L);
976
         loop
977 1
            Generate (P);
978 1
            P := Next_Node (P);
979 1
            exit when No (P);
980 1
            Write (Tok_Comma);
981 1
            Write_Space;
982 1
         end loop;
983
      end if;
984 1
      Write (Tok_Right_Paren);
985 1
   end Generate_Call_Profile;
986

987
   -------------------------
988
   -- Generate_Macro_Call --
989
   -------------------------
990

991 1
   procedure Generate_Macro_Call (N : Node_Id) is
992 1
      L : constant List_Id := Parameters (N);
993 1
      P : Node_Id;
994
   begin
995 1
      Generate (Defining_Identifier (N));
996

997 1
      Write (Tok_Left_Paren);
998 1
      if not Is_Empty (L) then
999 1
         P := First_Node (L);
1000
         loop
1001 1
            Generate (P);
1002 1
            P := Next_Node (P);
1003 1
            exit when No (P);
1004 1
            Write (Tok_Comma);
1005 1
            Write_Space;
1006 1
         end loop;
1007
      end if;
1008 1
      Write (Tok_Right_Paren);
1009 1
   end Generate_Macro_Call;
1010

1011
   --------------------------------------
1012
   -- Generate_Function_Implementation --
1013
   --------------------------------------
1014

1015 1
   procedure Generate_Function_Implementation (N : Node_Id) is
1016 1
      D : constant List_Id := Declarations (N);
1017 1
      S : constant List_Id := Statements (N);
1018 1
      P : constant Node_Id := Specification (N);
1019 1
      M : Node_Id;
1020
   begin
1021 1
      Write_Indentation;
1022 1
      Generate (P);
1023

1024 1
      Write_Eol;
1025 1
      Write (Tok_Left_Brace);
1026 1
      Write_Eol;
1027 1
      Increment_Indentation;
1028

1029 1
      if not Is_Empty (D) then
1030 1
         M := First_Node (D);
1031 1
         while Present (M) loop
1032 1
            Write_Indentation;
1033 1
            Generate (M);
1034 1
            Generate_Statement_Delimiter (M);
1035 1
            M := Next_Node (M);
1036 1
         end loop;
1037
      end if;
1038

1039 1
      Write_Eol;
1040

1041 1
      if not Is_Empty (S) then
1042 1
         M := First_Node (S);
1043 1
         while Present (M) loop
1044 1
            Write_Indentation;
1045 1
            Generate (M);
1046 1
            Generate_Statement_Delimiter (M);
1047 1
            M := Next_Node (M);
1048 1
         end loop;
1049
      end if;
1050

1051 1
      Decrement_Indentation;
1052 1
      Write_Indentation;
1053 1
      Write (Tok_Right_Brace);
1054 1
      Write_Eol;
1055 1
   end Generate_Function_Implementation;
1056

1057
   ---------------------------------------
1058
   -- Generate_Function_Specification --
1059
   ---------------------------------------
1060

1061 1
   procedure Generate_Function_Specification (N : Node_Id) is
1062 1
      P : constant List_Id := Parameters (N);
1063 1
      T : constant Node_Id := Return_Type (N);
1064
   begin
1065
      --  If we deal with a main subprogram, then we generate its
1066
      --  withed packages
1067

1068 1
      if T /= No_Node then
1069 1
         Generate (T);
1070
      end if;
1071

1072 1
      if Present (Defining_Identifier (N)) then
1073 1
         Write_Space;
1074 1
         Write_Name (Name (Defining_Identifier (N)));
1075
      end if;
1076

1077 1
      Write_Space;
1078 1
      Generate_Parameter_List (P);
1079

1080 1
   end Generate_Function_Specification;
1081

1082
   ------------------------------
1083
   -- Generate_Struct_Aggregate --
1084
   ------------------------------
1085

1086 1
   procedure Generate_Struct_Aggregate (N : Node_Id) is
1087 1
      P : Node_Id := First_Node (Struct_Members (N));
1088
   begin
1089 1
      Write (Tok_Struct);
1090 1
      Write_Eol;
1091 1
      Write_Indentation;
1092 1
      Write (Tok_Left_Brace);
1093 1
      Write_Eol;
1094 1
      Increment_Indentation;
1095

1096 1
      while Present (P) loop
1097 1
         Write_Indentation;
1098 1
         Generate (P);
1099 1
         Generate_Statement_Delimiter (P);
1100 1
         P := Next_Node (P);
1101 1
         Write_Eol;
1102 1
      end loop;
1103

1104 1
      Decrement_Indentation;
1105 1
      Write_Indentation;
1106 1
      Write (Tok_Right_Brace);
1107 1
   end Generate_Struct_Aggregate;
1108

1109
   -----------------------------
1110
   -- Generate_Enum_Aggregate --
1111
   -----------------------------
1112

1113 1
   procedure Generate_Enum_Aggregate (N : Node_Id) is
1114 1
      P : Node_Id := First_Node (Enum_Members (N));
1115
   begin
1116 1
      Write (Tok_Enum);
1117 1
      Write_Eol;
1118 1
      Write (Tok_Left_Brace);
1119 1
      Write_Eol;
1120 1
      Increment_Indentation;
1121 1
      while Present (P) loop
1122 1
         Write_Indentation;
1123 1
         Generate (P);
1124 1
         P := Next_Node (P);
1125 1
         if Present (P) then
1126 1
            Write (Tok_Comma);
1127
         end if;
1128 1
         Write_Eol;
1129 1
      end loop;
1130 1
      Decrement_Indentation;
1131 1
      Write_Indentation;
1132 1
      Write (Tok_Right_Brace);
1133 1
   end Generate_Enum_Aggregate;
1134

1135
   ------------------------------
1136
   -- Generate_Union_Aggregate --
1137
   ------------------------------
1138

1139 1
   procedure Generate_Union_Aggregate (N : Node_Id) is
1140 1
      P : Node_Id;
1141
   begin
1142 1
      Write (Tok_Union);
1143 1
      Write_Eol;
1144 1
      Write_Indentation;
1145 1
      Write (Tok_Left_Brace);
1146 1
      Write_Eol;
1147 1
      Increment_Indentation;
1148 1
      if not Is_Empty (Union_Members (N)) then
1149 1
         P := First_Node (Union_Members (N));
1150 1
         while Present (P) loop
1151 1
            Write_Indentation;
1152 1
            Generate (P);
1153 1
            Generate_Statement_Delimiter (P);
1154 1
            P := Next_Node (P);
1155 1
            Write_Eol;
1156 1
         end loop;
1157
      end if;
1158 1
      Decrement_Indentation;
1159 1
      Write_Indentation;
1160 1
      Write (Tok_Right_Brace);
1161 1
   end Generate_Union_Aggregate;
1162

1163
   -------------------------------
1164
   -- Generate_Switch_Statement --
1165
   -------------------------------
1166

1167 1
   procedure Generate_Switch_Statement (N : Node_Id) is
1168 1
      P : Node_Id;
1169
   begin
1170

1171 1
      if Is_Empty (Alternatives (N)) then
1172 0
         return;
1173
      end if;
1174

1175 1
      Write (Tok_Switch);
1176 1
      Write_Space;
1177 1
      Write (Tok_Left_Paren);
1178 1
      Generate (Expression (N));
1179 1
      Write (Tok_Right_Paren);
1180 1
      Write_Eol;
1181 1
      Write_Indentation;
1182 1
      Write (Tok_Left_Brace);
1183 1
      Write_Eol;
1184 1
      Increment_Indentation;
1185

1186 1
      P := First_Node (Alternatives (N));
1187 1
      while Present (P) loop
1188 1
         Write_Indentation;
1189 1
         Generate (P);
1190 1
         P := Next_Node (P);
1191 1
         Write_Eol;
1192 1
      end loop;
1193

1194 1
      Decrement_Indentation;
1195 1
      Write_Indentation;
1196 1
      Write (Tok_Right_Brace);
1197
   end Generate_Switch_Statement;
1198

1199
   ---------------------------------
1200
   -- Generate_Switch_Alternative --
1201
   ---------------------------------
1202

1203 1
   procedure Generate_Switch_Alternative (N : Node_Id) is
1204 1
      P : Node_Id;
1205
   begin
1206 1
      if Is_Empty (Labels (N)) then
1207 1
         Write (Tok_Default);
1208 1
         Write (Tok_Colon);
1209
      else
1210 1
         P := First_Node (Labels (N));
1211 1
         while Present (P) loop
1212 1
            Write (Tok_Case);
1213 1
            Write_Space;
1214 1
            Generate (P);
1215 1
            Write (Tok_Colon);
1216 1
            P := Next_Node (P);
1217 1
         end loop;
1218
      end if;
1219 1
      Write_Eol;
1220 1
      Write_Indentation;
1221 1
      Write (Tok_Left_Brace);
1222 1
      Write_Eol;
1223 1
      Increment_Indentation;
1224 1
      if not Is_Empty (Statements (N)) then
1225 1
         P := First_Node (Statements (N));
1226 1
         while Present (P) loop
1227 1
            Write_Indentation;
1228 1
            Generate (P);
1229 1
            Generate_Statement_Delimiter (P);
1230 1
            P := Next_Node (P);
1231 1
            Write_Eol;
1232 1
         end loop;
1233
      end if;
1234

1235 1
      Write_Indentation;
1236 1
      Write (Tok_Break);
1237 1
      Write (Tok_Semicolon);
1238 1
      Write_Eol;
1239

1240 1
      Decrement_Indentation;
1241 1
      Write_Indentation;
1242 1
      Write (Tok_Right_Brace);
1243 1
   end Generate_Switch_Alternative;
1244

1245
   -----------------------------------
1246
   -- Generate_Variable_Declaration --
1247
   -----------------------------------
1248

1249 1
   procedure Generate_Variable_Declaration (N : Node_Id) is
1250
   begin
1251 1
      if Is_Static (N) then
1252 1
         Write (Tok_Static);
1253 1
         Write_Space;
1254
      end if;
1255 1
      Generate (Used_Type (N));
1256 1
      Write_Space;
1257 1
      Generate (Defining_Identifier (N));
1258 1
      if not No (Initialization_Value (N)) then
1259 1
         Write_Space;
1260 1
         Write (Tok_Equal);
1261 1
         Write_Space;
1262 1
         Generate (Initialization_Value (N));
1263
      end if;
1264 1
   end Generate_Variable_Declaration;
1265

1266
   ---------------------------------
1267
   -- Generate_Member_Declaration --
1268
   ---------------------------------
1269

1270 1
   procedure Generate_Member_Declaration (N : Node_Id) is
1271
   begin
1272 1
      Generate (Used_Type (N));
1273 1
      Write_Space;
1274 1
      Generate (Defining_Identifier (N));
1275 1
   end Generate_Member_Declaration;
1276

1277
   -----------------------------------------
1278
   -- Generate_HI_Distributed_Application --
1279
   -----------------------------------------
1280

1281 1
   procedure Generate_HI_Distributed_Application (N : Node_Id) is
1282 1
      P                     : Node_Id := First_Node (HI_Nodes (N));
1283 1
      Application_Directory : Name_Id;
1284
   begin
1285
      --  Create the application directory (a lower case string)
1286

1287 1
      Get_Name_String (Name (N));
1288 1
      Application_Directory := To_Lower (Name_Find);
1289

1290 1
      Create_Directory (Application_Directory);
1291

1292
      --  Process the application nodes
1293

1294 1
      Enter_Directory (Application_Directory);
1295

1296 1
      while Present (P) loop
1297 1
         Generate (P);
1298 1
         P := Next_Node (P);
1299 1
      end loop;
1300

1301 1
      Leave_Directory;
1302 1
   end Generate_HI_Distributed_Application;
1303

1304
   ----------------------
1305
   -- Generate_HI_Node --
1306
   ----------------------
1307

1308 1
   procedure Generate_HI_Node (N : Node_Id) is
1309 1
      U                   : Node_Id          := First_Node (Units (N));
1310 1
      Partition_Directory : constant Name_Id := To_Lower (Name (N));
1311
   begin
1312
      --  Create the node directory
1313

1314 1
      Create_Directory (Partition_Directory);
1315 1
      Enter_Directory (Partition_Directory);
1316

1317 1
      while Present (U) loop
1318 1
         Generate (U);
1319 1
         U := Next_Node (U);
1320 1
      end loop;
1321

1322 1
      Leave_Directory;
1323 1
   end Generate_HI_Node;
1324

1325
   -----------
1326
   -- Write --
1327
   -----------
1328

1329 1
   procedure Write (T : Token_Type) is
1330
   begin
1331 1
      Write_Name (Token_Image (T));
1332 1
   end Write;
1333

1334
   ----------------
1335
   -- Write_Line --
1336
   ----------------
1337

1338 1
   procedure Write_Line (T : Token_Type) is
1339
   begin
1340 1
      Write (T);
1341 1
      Write_Eol;
1342 1
   end Write_Line;
1343

1344
   ----------------------------------
1345
   -- Generate_Statement_Delimiter --
1346
   ----------------------------------
1347

1348 1
   procedure Generate_Statement_Delimiter (N : Node_Id) is
1349
   begin
1350 1
      if No (N)
1351 1
        or else Kind (N) = K_Define_Statement
1352 1
        or else Kind (N) = K_Switch_Statement
1353 1
        or else Kind (N) = K_Switch_Alternative
1354 1
        or else Kind (N) = K_While_Statement
1355 1
        or else Kind (N) = K_If_Statement
1356 1
        or else Kind (N) = K_Function_Implementation
1357
      then
1358 1
         Write_Eol;
1359 1
      elsif Kind (N) /= K_C_Comment
1360 1
        and then Kind (N) /= K_Doxygen_C_Comment
1361
      then
1362 1
         Write_Line (Tok_Semicolon);
1363
      end if;
1364 1
   end Generate_Statement_Delimiter;
1365

1366
   ------------------------------
1367
   -- Generate_Type_Conversion --
1368
   ------------------------------
1369

1370 1
   procedure Generate_Type_Conversion (N : Node_Id) is
1371
   begin
1372 1
      Increment_Indentation;
1373 1
      Write (Tok_Left_Paren);
1374 1
      Generate (Subtype_Mark (N));
1375 1
      Write (Tok_Right_Paren);
1376 1
      Generate (Expression (N));
1377 1
      Decrement_Indentation;
1378 1
   end Generate_Type_Conversion;
1379

1380
   --------------------------
1381
   -- Generate_Source_File --
1382
   --------------------------
1383

1384 1
   procedure Generate_Source_File (N : Node_Id) is
1385 1
      Fd : File_Descriptor;
1386 1
      D  : Node_Id := First_Node (Declarations (N));
1387
   begin
1388 1
      if No (N) then
1389 0
         return;
1390
      end if;
1391 1
      Fd := Set_Output (Get_File_Name (N));
1392

1393 1
      if not Is_Empty (Included_Headers (N)) then
1394 1
         Generate_Included_Files (Included_Headers (N));
1395
      end if;
1396

1397 1
      while Present (D) loop
1398 1
         Generate (D);
1399 1
         Generate_Statement_Delimiter (D);
1400 1
         D := Next_Node (D);
1401 1
      end loop;
1402 1
      Write_Eol;
1403

1404
      --  Always leave a blank line at the end of a C-source file
1405

1406 1
      Release_Output (Fd);
1407
   end Generate_Source_File;
1408

1409
   -----------------------------
1410
   -- Generate_Included_Files --
1411
   -----------------------------
1412

1413 1
   procedure Generate_Included_Files (N : List_Id) is
1414 1
      H : Node_Id := First_Node (N);
1415
   begin
1416 1
      while Present (H) loop
1417 1
         Write (Tok_Sharp);
1418 1
         Write (Tok_Include);
1419 1
         Write_Space;
1420

1421 1
         if Is_Local (H) then
1422 1
            Write (Tok_Quote);
1423
         else
1424 1
            Write (Tok_Less);
1425
         end if;
1426

1427 1
         Generate (Header_Name (H));
1428 1
         Write (Tok_Dot);
1429 1
         Write_Str ("h");
1430

1431 1
         if Is_Local (H) then
1432 1
            Write (Tok_Quote);
1433
         else
1434 1
            Write (Tok_Greater);
1435
         end if;
1436

1437 1
         Write_Eol;
1438 1
         H := Next_Node (H);
1439 1
      end loop;
1440 1
   end Generate_Included_Files;
1441

1442
   --------------------------
1443
   -- Generate_Header_File --
1444
   --------------------------
1445

1446 1
   procedure Generate_Header_File (N : Node_Id) is
1447 1
      Fd : File_Descriptor;
1448 1
      D  : Node_Id := First_Node (Declarations (N));
1449 1
      NA : Name_Id;
1450
   begin
1451 1
      if No (D) then
1452 0
         return;
1453
      end if;
1454 1
      NA := Name (Defining_Identifier (N));
1455 1
      NA := To_Upper (NA);
1456

1457 1
      Fd := Set_Output (Get_File_Name (N));
1458

1459 1
      Write (Tok_Sharp);
1460 1
      Write (Tok_Ifndef);
1461 1
      Write_Space;
1462 1
      Write (Tok_Underscore);
1463 1
      Write (Tok_Underscore);
1464 1
      Write_Str ("OCARINA_GENERATED_");
1465 1
      Write_Name (NA);
1466 1
      Write (Tok_Underscore);
1467 1
      Write_Str ("H");
1468 1
      Write (Tok_Underscore);
1469 1
      Write_Eol;
1470

1471 1
      Write (Tok_Sharp);
1472 1
      Write (Tok_Define);
1473 1
      Write_Space;
1474 1
      Write (Tok_Underscore);
1475 1
      Write (Tok_Underscore);
1476 1
      Write_Str ("OCARINA_GENERATED_");
1477 1
      Write_Name (NA);
1478 1
      Write (Tok_Underscore);
1479 1
      Write_Str ("H");
1480 1
      Write (Tok_Underscore);
1481 1
      Write_Space;
1482 1
      Write_Eol;
1483

1484 1
      if not Is_Empty (Included_Headers (N)) then
1485 1
         Generate_Included_Files (Included_Headers (N));
1486
      end if;
1487

1488 1
      while Present (D) loop
1489 1
         Generate (D);
1490 1
         Generate_Statement_Delimiter (D);
1491 1
         Write_Eol;
1492 1
         D := Next_Node (D);
1493 1
      end loop;
1494 1
      Write (Tok_Sharp);
1495 1
      Write (Tok_Endif);
1496

1497 1
      Write_Eol;
1498

1499
      --  Always leave a blank line at the end of a C-source file
1500

1501 1
      Release_Output (Fd);
1502
   end Generate_Header_File;
1503

1504
   ------------------------
1505
   -- Generate_Base_Type --
1506
   ------------------------
1507

1508 1
   procedure Generate_Base_Type (N : Node_Id) is
1509
   begin
1510 1
      case Kind (N) is
1511 0
         when K_Int =>
1512 0
            Write_Str ("int");
1513

1514 0
         when K_Float =>
1515 0
            Write_Str ("float");
1516

1517 1
         when K_Char =>
1518 1
            Write_Str ("char");
1519

1520 1
         when K_Void =>
1521 1
            Write_Str ("void");
1522

1523 0
         when others =>
1524 0
            Display_Error ("other element in generator", Fatal => False);
1525 0
            null;
1526 1
      end case;
1527

1528 1
   end Generate_Base_Type;
1529

1530
   ----------------------
1531
   -- Generate_HI_Unit --
1532
   ----------------------
1533

1534 1
   procedure Generate_HI_Unit (N : Node_Id) is
1535 1
      S : Node_Id := First_Node (Sources (N));
1536 1
      H : Node_Id := First_Node (Headers (N));
1537
   begin
1538 1
      while Present (S) loop
1539 1
         Generate (S);
1540 1
         S := Next_Node (S);
1541 1
      end loop;
1542 1
      while Present (H) loop
1543 1
         Generate (H);
1544 1
         H := Next_Node (H);
1545 1
      end loop;
1546 1
   end Generate_HI_Unit;
1547

1548
   -------------------------------
1549
   -- Generate_Define_Statement --
1550
   -------------------------------
1551

1552 1
   procedure Generate_Define_Statement (N : Node_Id) is
1553 1
      V : constant Node_Id := Defined_Value (N);
1554 1
      I : constant Node_Id := Defining_Identifier (N);
1555
   begin
1556 1
      Write (Tok_Sharp);
1557 1
      Write (Tok_Define);
1558 1
      Write_Space;
1559 1
      Generate (I);
1560 1
      Write_Space;
1561 1
      Generate (V);
1562 1
   end Generate_Define_Statement;
1563

1564
   ---------------------------
1565
   -- Generate_Pointer_Type --
1566
   ---------------------------
1567

1568 1
   procedure Generate_Pointer_Type (N : Node_Id) is
1569
   begin
1570 1
      Generate (Used_Type (N));
1571 1
      Write (Tok_Asterisk);
1572 1
   end Generate_Pointer_Type;
1573

1574
   ----------------------------
1575
   -- Generate_Constant_Type --
1576
   ----------------------------
1577

1578 1
   procedure Generate_Constant_Type (N : Node_Id) is
1579
   begin
1580 1
      Write (Tok_Const);
1581 1
      Write_Space;
1582 1
      Generate (Used_Type (N));
1583 1
   end Generate_Constant_Type;
1584

1585
   -------------------------------
1586
   -- Generate_Variable_Address --
1587
   -------------------------------
1588

1589 1
   procedure Generate_Variable_Address (N : Node_Id) is
1590
   begin
1591 1
      Write (Tok_Ampersand);
1592 1
      Write (Tok_Left_Paren);
1593 1
      Generate (Expression (N));
1594 1
      Write (Tok_Right_Paren);
1595 1
   end Generate_Variable_Address;
1596

1597
   --------------------------------
1598
   -- Generate_Member_Designator --
1599
   --------------------------------
1600

1601 1
   procedure Generate_Member_Designator (N : Node_Id) is
1602
   begin
1603 1
      Generate (Aggregate_Name (N));
1604 1
      if Is_Pointer (N) then
1605 1
         Write (Tok_Arrow);
1606
      else
1607 1
         Write (Tok_Dot);
1608
      end if;
1609 1
      Generate (Defining_Identifier (N));
1610 1
   end Generate_Member_Designator;
1611

1612
   -----------------------------
1613
   -- Generate_Include_Clause --
1614
   -----------------------------
1615

1616 1
   procedure Generate_Include_Clause (N : Node_Id) is
1617
   begin
1618 1
      Write (Tok_Sharp);
1619 1
      Write (Tok_Include);
1620 1
      Write_Space;
1621

1622 1
      if Is_Local (N) then
1623 0
         Write (Tok_Quote);
1624
      else
1625 1
         Write (Tok_Less);
1626
      end if;
1627

1628 1
      Generate (Header_Name (N));
1629 1
      Write (Tok_Dot);
1630 1
      Write_Str ("h");
1631

1632 1
      if Is_Local (N) then
1633 0
         Write (Tok_Quote);
1634
      else
1635 1
         Write (Tok_Greater);
1636
      end if;
1637

1638 1
      Write_Eol;
1639 1
   end Generate_Include_Clause;
1640

1641
   ---------------------------
1642
   -- Generate_Ifdef_Clause --
1643
   ---------------------------
1644

1645 1
   procedure Generate_Ifdef_Clause (N : Node_Id) is
1646 1
      S : Node_Id;
1647
   begin
1648 1
      Write (Tok_Sharp);
1649 1
      if Negation (N) then
1650 0
         Write (Tok_Ifndef);
1651
      else
1652 1
         Write (Tok_Ifdef);
1653
      end if;
1654

1655 1
      Write_Space;
1656

1657 1
      Generate (Clause (N));
1658

1659 1
      Write_Eol;
1660

1661 1
      S := First_Node (Then_Statements (N));
1662 1
      while Present (S) loop
1663 1
         Generate (S);
1664 1
         S := Next_Node (S);
1665 1
      end loop;
1666

1667 1
      if not Is_Empty (Else_Statements (N)) then
1668 0
         S := First_Node (Else_Statements (S));
1669 0
         while Present (S) loop
1670 0
            Generate (S);
1671 0
            S := Next_Node (S);
1672 0
         end loop;
1673
      end if;
1674

1675 1
      Write (Tok_Sharp);
1676 1
      Write (Tok_Endif);
1677

1678 1
      Write_Eol;
1679

1680 1
   end Generate_Ifdef_Clause;
1681

1682
end Ocarina.Backends.C_Tree.Generator;

Read our documentation on viewing source code .

Loading