1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                             L I B . W R I T                              --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17-- for  more details.  You should have  received  a copy of the GNU General --
18-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19-- http://www.gnu.org/licenses for a complete copy of the license.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26with ALI;      use ALI;
27with Atree;    use Atree;
28with Casing;   use Casing;
29with Debug;    use Debug;
30with Einfo;    use Einfo;
31with Errout;   use Errout;
32with Fname;    use Fname;
33with Fname.UF; use Fname.UF;
34with Lib.Util; use Lib.Util;
35with Lib.Xref; use Lib.Xref;
36with Nlists;   use Nlists;
37with Gnatvsn;  use Gnatvsn;
38with Opt;      use Opt;
39with Osint;    use Osint;
40with Osint.C;  use Osint.C;
41with Output;   use Output;
42with Par;
43with Par_SCO;  use Par_SCO;
44with Restrict; use Restrict;
45with Rident;   use Rident;
46with Scn;      use Scn;
47with Sinfo;    use Sinfo;
48with Sinput;   use Sinput;
49with Snames;   use Snames;
50with Stringt;  use Stringt;
51with Tbuild;   use Tbuild;
52with Uname;    use Uname;
53
54with System.Case_Util; use System.Case_Util;
55with System.WCh_Con;   use System.WCh_Con;
56
57package body Lib.Writ is
58
59   -----------------------
60   -- Local Subprograms --
61   -----------------------
62
63   procedure Write_Unit_Name (N : Node_Id);
64   --  Used to write out the unit name for R (pragma Restriction) lines
65   --  for uses of Restriction (No_Dependence => unit-name).
66
67   ----------------------------------
68   -- Add_Preprocessing_Dependency --
69   ----------------------------------
70
71   procedure Add_Preprocessing_Dependency (S : Source_File_Index) is
72   begin
73      Units.Increment_Last;
74      Units.Table (Units.Last) :=
75        (Unit_File_Name    => File_Name (S),
76         Unit_Name         => No_Unit_Name,
77         Expected_Unit     => No_Unit_Name,
78         Source_Index      => S,
79         Cunit             => Empty,
80         Cunit_Entity      => Empty,
81         Dependency_Num    => 0,
82         Dynamic_Elab      => False,
83         Fatal_Error       => False,
84         Generate_Code     => False,
85         Has_Allocator     => False,
86         Has_RACW          => False,
87         Is_Compiler_Unit  => False,
88         Ident_String      => Empty,
89         Loading           => False,
90         Main_Priority     => -1,
91         Main_CPU          => -1,
92         Munit_Index       => 0,
93         Serial_Number     => 0,
94         Version           => 0,
95         Error_Location    => No_Location,
96         OA_Setting        => 'O',
97         SPARK_Mode_Pragma => Empty);
98   end Add_Preprocessing_Dependency;
99
100   ------------------------------
101   -- Ensure_System_Dependency --
102   ------------------------------
103
104   procedure Ensure_System_Dependency is
105      System_Uname : Unit_Name_Type;
106      --  Unit name for system spec if needed for dummy entry
107
108      System_Fname : File_Name_Type;
109      --  File name for system spec if needed for dummy entry
110
111   begin
112      --  Nothing to do if we already compiled System
113
114      for Unum in Units.First .. Last_Unit loop
115         if Units.Table (Unum).Source_Index = System_Source_File_Index then
116            return;
117         end if;
118      end loop;
119
120      --  If no entry for system.ads in the units table, then add a entry
121      --  to the units table for system.ads, which will be referenced when
122      --  the ali file is generated. We need this because every unit depends
123      --  on system as a result of Targparm scanning the system.ads file to
124      --  determine the target dependent parameters for the compilation.
125
126      Name_Len := 6;
127      Name_Buffer (1 .. 6) := "system";
128      System_Uname := Name_To_Unit_Name (Name_Enter);
129      System_Fname := File_Name (System_Source_File_Index);
130
131      Units.Increment_Last;
132      Units.Table (Units.Last) := (
133        Unit_File_Name    => System_Fname,
134        Unit_Name         => System_Uname,
135        Expected_Unit     => System_Uname,
136        Source_Index      => System_Source_File_Index,
137        Cunit             => Empty,
138        Cunit_Entity      => Empty,
139        Dependency_Num    => 0,
140        Dynamic_Elab      => False,
141        Fatal_Error       => False,
142        Generate_Code     => False,
143        Has_Allocator     => False,
144        Has_RACW          => False,
145        Is_Compiler_Unit  => False,
146        Ident_String      => Empty,
147        Loading           => False,
148        Main_Priority     => -1,
149        Main_CPU          => -1,
150        Munit_Index       => 0,
151        Serial_Number     => 0,
152        Version           => 0,
153        Error_Location    => No_Location,
154        OA_Setting        => 'O',
155        SPARK_Mode_Pragma => Empty);
156
157      --  Parse system.ads so that the checksum is set right
158      --  Style checks are not applied.
159
160      declare
161         Save_Mindex : constant Nat := Multiple_Unit_Index;
162         Save_Style  : constant Boolean := Style_Check;
163      begin
164         Multiple_Unit_Index := 0;
165         Style_Check := False;
166         Initialize_Scanner (Units.Last, System_Source_File_Index);
167         Discard_List (Par (Configuration_Pragmas => False));
168         Style_Check := Save_Style;
169         Multiple_Unit_Index := Save_Mindex;
170      end;
171   end Ensure_System_Dependency;
172
173   ---------------
174   -- Write_ALI --
175   ---------------
176
177   procedure Write_ALI (Object : Boolean) is
178
179      ----------------
180      -- Local Data --
181      ----------------
182
183      Last_Unit : constant Unit_Number_Type := Units.Last;
184      --  Record unit number of last unit. We capture this in case we
185      --  have to add a dummy entry to the unit table for package System.
186
187      With_Flags : array (Units.First .. Last_Unit) of Boolean;
188      --  Array of flags to show which units are with'ed
189
190      Elab_Flags : array (Units.First .. Last_Unit) of Boolean;
191      --  Array of flags to show which units have pragma Elaborate set
192
193      Elab_All_Flags : array (Units.First .. Last_Unit) of Boolean;
194      --  Array of flags to show which units have pragma Elaborate All set
195
196      Elab_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
197      --  Array of flags to show which units have Elaborate_Desirable set
198
199      Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
200      --  Array of flags to show which units have Elaborate_All_Desirable set
201
202      type Yes_No is (Unknown, Yes, No);
203      Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
204      --  Indicates if an implicit with has been given for the unit. Yes if
205      --  certainly present, no if certainly absent, unkonwn if not known.
206
207      Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
208      --  Sorted table of source dependencies. One extra entry in case we
209      --  have to add a dummy entry for System.
210
211      Num_Sdep : Nat := 0;
212      --  Number of active entries in Sdep_Table
213
214      flag_compare_debug : Int;
215      pragma Import (C, flag_compare_debug);
216      --  Import from toplev.c
217
218      -----------------------
219      -- Local Subprograms --
220      -----------------------
221
222      procedure Collect_Withs (Cunit : Node_Id);
223      --  Collect with lines for entries in the context clause of the
224      --  given compilation unit, Cunit.
225
226      procedure Update_Tables_From_ALI_File;
227      --  Given an up to date ALI file (see Up_To_Date_ALI_file_Exists
228      --  function), update tables from the ALI information, including
229      --  specifically the Compilation_Switches table.
230
231      function Up_To_Date_ALI_File_Exists return Boolean;
232      --  If there exists an ALI file that is up to date, then this function
233      --  initializes the tables in the ALI spec to contain information on
234      --  this file (using Scan_ALI) and returns True. If no file exists,
235      --  or the file is not up to date, then False is returned.
236
237      procedure Write_Unit_Information (Unit_Num : Unit_Number_Type);
238      --  Write out the library information for one unit for which code is
239      --  generated (includes unit line and with lines).
240
241      procedure Write_With_Lines;
242      --  Write out with lines collected by calls to Collect_Withs
243
244      -------------------
245      -- Collect_Withs --
246      -------------------
247
248      procedure Collect_Withs (Cunit : Node_Id) is
249         Item : Node_Id;
250         Unum : Unit_Number_Type;
251
252      begin
253         Item := First (Context_Items (Cunit));
254         while Present (Item) loop
255
256            --  Process with clause
257
258            --  Ada 2005 (AI-50217): limited with_clauses do not create
259            --  dependencies, but must be recorded as components of the
260            --  partition, in case there is no regular with_clause for
261            --  the unit anywhere else.
262
263            if Nkind (Item) = N_With_Clause then
264               Unum := Get_Cunit_Unit_Number (Library_Unit (Item));
265               With_Flags (Unum) := True;
266
267               if not Limited_Present (Item) then
268                  if Elaborate_Present (Item) then
269                     Elab_Flags (Unum) := True;
270                  end if;
271
272                  if Elaborate_All_Present (Item) then
273                     Elab_All_Flags (Unum) := True;
274                  end if;
275
276                  if Elaborate_All_Desirable (Item) then
277                     Elab_All_Des_Flags (Unum) := True;
278                  end if;
279
280                  if Elaborate_Desirable (Item) then
281                     Elab_Des_Flags (Unum) := True;
282                  end if;
283
284               else
285                  Set_From_Limited_With (Cunit_Entity (Unum));
286               end if;
287
288               if Implicit_With (Unum) /= Yes then
289                  if Implicit_With_From_Instantiation (Item) then
290                     Implicit_With (Unum) := Yes;
291                  else
292                     Implicit_With (Unum) := No;
293                  end if;
294               end if;
295            end if;
296
297            Next (Item);
298         end loop;
299      end Collect_Withs;
300
301      --------------------------------
302      -- Up_To_Date_ALI_File_Exists --
303      --------------------------------
304
305      function Up_To_Date_ALI_File_Exists return Boolean is
306         Name : File_Name_Type;
307         Text : Text_Buffer_Ptr;
308         Id   : Sdep_Id;
309         Sind : Source_File_Index;
310
311      begin
312         Opt.Check_Object_Consistency := True;
313         Read_Library_Info (Name, Text);
314
315         --  Return if we could not find an ALI file
316
317         if Text = null then
318            return False;
319         end if;
320
321         --  Return if ALI file has bad format
322
323         Initialize_ALI;
324
325         if Scan_ALI (Name, Text, False, Err => True) = No_ALI_Id then
326            return False;
327         end if;
328
329         --  If we have an OK ALI file, check if it is up to date
330         --  Note that we assume that the ALI read has all the entries
331         --  we have in our table, plus some additional ones (that can
332         --  come from expansion).
333
334         Id := First_Sdep_Entry;
335         for J in 1 .. Num_Sdep loop
336            Sind := Units.Table (Sdep_Table (J)).Source_Index;
337
338            while Sdep.Table (Id).Sfile /= File_Name (Sind) loop
339               if Id = Sdep.Last then
340                  return False;
341               else
342                  Id := Id + 1;
343               end if;
344            end loop;
345
346            if Sdep.Table (Id).Stamp /= Time_Stamp (Sind) then
347               return False;
348            end if;
349         end loop;
350
351         return True;
352      end Up_To_Date_ALI_File_Exists;
353
354      ---------------------------------
355      -- Update_Tables_From_ALI_File --
356      ---------------------------------
357
358      procedure Update_Tables_From_ALI_File is
359      begin
360         --  Build Compilation_Switches table
361
362         Compilation_Switches.Init;
363
364         for J in First_Arg_Entry .. Args.Last loop
365            Compilation_Switches.Increment_Last;
366            Compilation_Switches.Table (Compilation_Switches.Last) :=
367              Args.Table (J);
368         end loop;
369      end Update_Tables_From_ALI_File;
370
371      ----------------------------
372      -- Write_Unit_Information --
373      ----------------------------
374
375      procedure Write_Unit_Information (Unit_Num : Unit_Number_Type) is
376         Unode : constant Node_Id   := Cunit (Unit_Num);
377         Ukind : constant Node_Kind := Nkind (Unit (Unode));
378         Uent  : constant Entity_Id := Cunit_Entity (Unit_Num);
379         Pnode : Node_Id;
380
381      begin
382         Write_Info_Initiate ('U');
383         Write_Info_Char (' ');
384         Write_Info_Name (Unit_Name (Unit_Num));
385         Write_Info_Tab (25);
386         Write_Info_Name (Unit_File_Name (Unit_Num));
387
388         Write_Info_Tab (49);
389         Write_Info_Str (Version_Get (Unit_Num));
390
391         --  Add BD parameter if Elaborate_Body pragma desirable
392
393         if Ekind (Uent) = E_Package
394           and then Elaborate_Body_Desirable (Uent)
395         then
396            Write_Info_Str (" BD");
397         end if;
398
399         --  Add BN parameter if body needed for SAL
400
401         if (Is_Subprogram (Uent)
402              or else Ekind (Uent) = E_Package
403              or else Is_Generic_Unit (Uent))
404           and then Body_Needed_For_SAL (Uent)
405         then
406            Write_Info_Str (" BN");
407         end if;
408
409         if Dynamic_Elab (Unit_Num) then
410            Write_Info_Str (" DE");
411         end if;
412
413         --  Set the Elaborate_Body indication if either an explicit pragma
414         --  was present, or if this is an instantiation.
415
416         if Has_Pragma_Elaborate_Body (Uent)
417           or else (Ukind = N_Package_Declaration
418                     and then Is_Generic_Instance (Uent)
419                     and then Present (Corresponding_Body (Unit (Unode))))
420         then
421            Write_Info_Str (" EB");
422         end if;
423
424         --  Now see if we should tell the binder that an elaboration entity
425         --  is present, which must be set to true during elaboration.
426         --  We generate the indication if the following condition is met:
427
428         --  If this is a spec ...
429
430         if (Is_Subprogram (Uent)
431               or else
432             Ekind (Uent) = E_Package
433               or else
434             Is_Generic_Unit (Uent))
435
436            --  and an elaboration entity was declared ...
437
438            and then Present (Elaboration_Entity (Uent))
439
440            --  and either the elaboration flag is required ...
441
442            and then
443              (Elaboration_Entity_Required (Uent)
444
445               --  or this unit has elaboration code ...
446
447               or else not Has_No_Elaboration_Code (Unode)
448
449               --  or this unit has a separate body and this
450               --  body has elaboration code.
451
452               or else
453                 (Ekind (Uent) = E_Package
454                   and then Present (Body_Entity (Uent))
455                   and then
456                     not Has_No_Elaboration_Code
457                           (Parent
458                             (Declaration_Node
459                               (Body_Entity (Uent))))))
460         then
461            if Convention (Uent) = Convention_CIL then
462
463               --  Special case for generic CIL packages which never have
464               --  elaboration code
465
466               Write_Info_Str (" NE");
467
468            else
469               Write_Info_Str (" EE");
470            end if;
471         end if;
472
473         if Has_No_Elaboration_Code (Unode) then
474            Write_Info_Str (" NE");
475         end if;
476
477         Write_Info_Str (" O");
478         Write_Info_Char (OA_Setting (Unit_Num));
479
480         if Ekind_In (Uent, E_Package, E_Package_Body)
481           and then Present (Finalizer (Uent))
482         then
483            Write_Info_Str (" PF");
484         end if;
485
486         if Is_Preelaborated (Uent) then
487            Write_Info_Str (" PR");
488         end if;
489
490         if Is_Pure (Uent) then
491            Write_Info_Str (" PU");
492         end if;
493
494         if Has_RACW (Unit_Num) then
495            Write_Info_Str (" RA");
496         end if;
497
498         if Is_Remote_Call_Interface (Uent) then
499            Write_Info_Str (" RC");
500         end if;
501
502         if Is_Remote_Types (Uent) then
503            Write_Info_Str (" RT");
504         end if;
505
506         if Is_Shared_Passive (Uent) then
507            Write_Info_Str (" SP");
508         end if;
509
510         if Ukind = N_Subprogram_Declaration
511           or else Ukind = N_Subprogram_Body
512         then
513            Write_Info_Str (" SU");
514
515         elsif Ukind = N_Package_Declaration
516                 or else
517               Ukind = N_Package_Body
518         then
519            --  If this is a wrapper package for a subprogram instantiation,
520            --  the user view is the subprogram. Note that in this case the
521            --  ali file contains both the spec and body of the instance.
522
523            if Is_Wrapper_Package (Uent) then
524               Write_Info_Str (" SU");
525            else
526               Write_Info_Str (" PK");
527            end if;
528
529         elsif Ukind = N_Generic_Package_Declaration then
530            Write_Info_Str (" PK");
531
532         end if;
533
534         if Ukind in N_Generic_Declaration
535           or else
536             (Present (Library_Unit (Unode))
537                and then
538              Nkind (Unit (Library_Unit (Unode))) in N_Generic_Declaration)
539         then
540            Write_Info_Str (" GE");
541         end if;
542
543         if not Is_Internal_File_Name (Unit_File_Name (Unit_Num), True) then
544            case Identifier_Casing (Source_Index (Unit_Num)) is
545               when All_Lower_Case => Write_Info_Str (" IL");
546               when All_Upper_Case => Write_Info_Str (" IU");
547               when others         => null;
548            end case;
549
550            case Keyword_Casing (Source_Index (Unit_Num)) is
551               when Mixed_Case     => Write_Info_Str (" KM");
552               when All_Upper_Case => Write_Info_Str (" KU");
553               when others         => null;
554            end case;
555         end if;
556
557         if Initialize_Scalars or else Invalid_Value_Used then
558            Write_Info_Str (" IS");
559         end if;
560
561         Write_Info_EOL;
562
563         --  Generate with lines, first those that are directly with'ed
564
565         for J in With_Flags'Range loop
566            With_Flags         (J) := False;
567            Elab_Flags         (J) := False;
568            Elab_All_Flags     (J) := False;
569            Elab_Des_Flags     (J) := False;
570            Elab_All_Des_Flags (J) := False;
571            Implicit_With      (J) := Unknown;
572         end loop;
573
574         Collect_Withs (Unode);
575
576         --  For a body, we must also check for any subunits which belong to
577         --  it and which have context clauses of their own, since these
578         --  with'ed units are part of its own elaboration dependencies.
579
580         if Nkind (Unit (Unode)) in N_Unit_Body then
581            for S in Units.First .. Last_Unit loop
582
583               --  We are only interested in subunits.
584               --  For preproc. data and def. files, Cunit is Empty, so
585               --  we need to test that first.
586
587               if Cunit (S) /= Empty
588                 and then Nkind (Unit (Cunit (S))) = N_Subunit
589               then
590                  Pnode := Library_Unit (Cunit (S));
591
592                  --  In gnatc mode, the errors in the subunits will not
593                  --  have been recorded, but the analysis of the subunit
594                  --  may have failed. There is no information to add to
595                  --  ALI file in this case.
596
597                  if No (Pnode) then
598                     exit;
599                  end if;
600
601                  --  Find ultimate parent of the subunit
602
603                  while Nkind (Unit (Pnode)) = N_Subunit loop
604                     Pnode := Library_Unit (Pnode);
605                  end loop;
606
607                  --  See if it belongs to current unit, and if so, include
608                  --  its with_clauses.
609
610                  if Pnode = Unode then
611                     Collect_Withs (Cunit (S));
612                  end if;
613               end if;
614            end loop;
615         end if;
616
617         Write_With_Lines;
618
619         --  Generate the linker option lines
620
621         for J in 1 .. Linker_Option_Lines.Last loop
622
623            --  Pragma Linker_Options is not allowed in predefined generic
624            --  units. This is because they won't be read, due to the fact that
625            --  with lines for generic units lack the file name and lib name
626            --  parameters (see Lib_Writ spec for an explanation).
627
628            if Is_Generic_Unit (Cunit_Entity (Main_Unit))
629              and then
630                Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
631              and then Linker_Option_Lines.Table (J).Unit = Unit_Num
632            then
633               Set_Standard_Error;
634               Write_Line
635                 ("linker options not allowed in predefined generic unit");
636               raise Unrecoverable_Error;
637            end if;
638
639            --  Output one linker option line
640
641            declare
642               S : Linker_Option_Entry renames Linker_Option_Lines.Table (J);
643            begin
644               if S.Unit = Unit_Num then
645                  Write_Info_Initiate ('L');
646                  Write_Info_Char (' ');
647                  Write_Info_Slit (S.Option);
648                  Write_Info_EOL;
649               end if;
650            end;
651         end loop;
652
653         --  Output notes
654
655         for J in 1 .. Notes.Last loop
656            declare
657               N : constant Node_Id          := Notes.Table (J).Pragma_Node;
658               L : constant Source_Ptr       := Sloc (N);
659               U : constant Unit_Number_Type := Notes.Table (J).Unit;
660               C : Character;
661
662            begin
663               if U = Unit_Num then
664                  Write_Info_Initiate ('N');
665                  Write_Info_Char (' ');
666
667                  case Chars (Pragma_Identifier (N)) is
668                     when Name_Annotate =>
669                        C := 'A';
670                     when Name_Comment =>
671                        C := 'C';
672                     when Name_Ident =>
673                        C := 'I';
674                     when Name_Title =>
675                        C := 'T';
676                     when Name_Subtitle =>
677                        C := 'S';
678                     when others =>
679                        raise Program_Error;
680                  end case;
681
682                  Write_Info_Char (C);
683                  Write_Info_Int (Int (Get_Logical_Line_Number (L)));
684                  Write_Info_Char (':');
685                  Write_Info_Int (Int (Get_Column_Number (L)));
686
687                  declare
688                     A : Node_Id;
689
690                  begin
691                     A := First (Pragma_Argument_Associations (N));
692                     while Present (A) loop
693                        Write_Info_Char (' ');
694
695                        if Chars (A) /= No_Name then
696                           Write_Info_Name (Chars (A));
697                           Write_Info_Char (':');
698                        end if;
699
700                        declare
701                           Expr : constant Node_Id := Expression (A);
702
703                        begin
704                           if Nkind (Expr) = N_Identifier then
705                              Write_Info_Name (Chars (Expr));
706
707                           elsif Nkind (Expr) = N_Integer_Literal
708                             and then Is_Static_Expression (Expr)
709                           then
710                              Write_Info_Uint (Intval (Expr));
711
712                           elsif Nkind (Expr) = N_String_Literal
713                             and then Is_Static_Expression (Expr)
714                           then
715                              Write_Info_Slit (Strval (Expr));
716
717                           else
718                              Write_Info_Str ("<expr>");
719                           end if;
720                        end;
721
722                        Next (A);
723                     end loop;
724                  end;
725
726                  Write_Info_EOL;
727               end if;
728            end;
729         end loop;
730      end Write_Unit_Information;
731
732      ----------------------
733      -- Write_With_Lines --
734      ----------------------
735
736      procedure Write_With_Lines is
737         With_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 1));
738         Num_Withs  : Int := 0;
739         Unum       : Unit_Number_Type;
740         Cunit      : Node_Id;
741         Uname      : Unit_Name_Type;
742         Fname      : File_Name_Type;
743         Pname      : constant Unit_Name_Type :=
744                        Get_Parent_Spec_Name (Unit_Name (Main_Unit));
745         Body_Fname : File_Name_Type;
746         Body_Index : Nat;
747
748         procedure Write_With_File_Names
749           (Nam : in out File_Name_Type;
750            Idx : Nat);
751         --  Write source file name Nam and ALI file name for unit index Idx.
752         --  Possibly change Nam to lowercase (generating a new file name).
753
754         --------------------------
755         -- Write_With_File_Name --
756         --------------------------
757
758         procedure Write_With_File_Names
759           (Nam : in out File_Name_Type;
760            Idx : Nat)
761         is
762         begin
763            if not File_Names_Case_Sensitive then
764               Get_Name_String (Nam);
765               To_Lower (Name_Buffer (1 .. Name_Len));
766               Nam := Name_Find;
767            end if;
768
769            Write_Info_Name (Nam);
770            Write_Info_Tab (49);
771            Write_Info_Name (Lib_File_Name (Nam, Idx));
772         end Write_With_File_Names;
773
774      --  Start of processing for Write_With_Lines
775
776      begin
777         --  Loop to build the with table. A with on the main unit itself
778         --  is ignored (AARM 10.2(14a)). Such a with-clause can occur if
779         --  the main unit is a subprogram with no spec, and a subunit of
780         --  it unnecessarily withs the parent.
781
782         for J in Units.First + 1 .. Last_Unit loop
783
784            --  Add element to with table if it is with'ed or if it is the
785            --  parent spec of the main unit (case of main unit is a child
786            --  unit). The latter with is not needed for semantic purposes,
787            --  but is required by the binder for elaboration purposes.
788            --  For preproc. data and def. files, there is no Unit_Name,
789            --  check for that first.
790
791            if Unit_Name (J) /= No_Unit_Name
792              and then (With_Flags (J) or else Unit_Name (J) = Pname)
793            then
794               Num_Withs := Num_Withs + 1;
795               With_Table (Num_Withs) := J;
796            end if;
797         end loop;
798
799         --  Sort and output the table
800
801         Sort (With_Table (1 .. Num_Withs));
802
803         for J in 1 .. Num_Withs loop
804            Unum   := With_Table (J);
805            Cunit  := Units.Table (Unum).Cunit;
806            Uname  := Units.Table (Unum).Unit_Name;
807            Fname  := Units.Table (Unum).Unit_File_Name;
808
809            if Implicit_With (Unum) = Yes then
810               Write_Info_Initiate ('Z');
811
812            elsif Ekind (Cunit_Entity (Unum)) = E_Package
813              and then From_Limited_With (Cunit_Entity (Unum))
814            then
815               Write_Info_Initiate ('Y');
816
817            else
818               Write_Info_Initiate ('W');
819            end if;
820
821            Write_Info_Char (' ');
822            Write_Info_Name (Uname);
823
824            --  Now we need to figure out the names of the files that contain
825            --  the with'ed unit. These will usually be the files for the body,
826            --  except in the case of a package that has no body. Note that we
827            --  have a specific exemption here for predefined library generics
828            --  (see comments for Generic_May_Lack_ALI). We do not generate
829            --  dependency upon the ALI file for such units. Older compilers
830            --  used to not support generating code (and ALI) for generics, and
831            --  we want to avoid having different processing (namely, different
832            --  lists of files to be compiled) for different stages of the
833            --  bootstrap.
834
835            if not ((Nkind (Unit (Cunit)) in N_Generic_Declaration
836                      or else
837                     Nkind (Unit (Cunit)) in N_Generic_Renaming_Declaration)
838                    and then Generic_May_Lack_ALI (Fname))
839
840              --  In SPARK mode, always generate the dependencies on ALI
841              --  files, which are required to compute frame conditions
842              --  of subprograms.
843
844              or else GNATprove_Mode
845            then
846               Write_Info_Tab (25);
847
848               if Is_Spec_Name (Uname) then
849                  Body_Fname :=
850                    Get_File_Name
851                      (Get_Body_Name (Uname),
852                       Subunit => False, May_Fail => True);
853
854                  Body_Index :=
855                    Get_Unit_Index
856                      (Get_Body_Name (Uname));
857
858                  if Body_Fname = No_File then
859                     Body_Fname := Get_File_Name (Uname, Subunit => False);
860                     Body_Index := Get_Unit_Index (Uname);
861                  end if;
862
863               else
864                  Body_Fname := Get_File_Name (Uname, Subunit => False);
865                  Body_Index := Get_Unit_Index (Uname);
866               end if;
867
868               --  A package is considered to have a body if it requires
869               --  a body or if a body is present in Ada 83 mode.
870
871               if Body_Required (Cunit)
872                 or else (Ada_Version = Ada_83
873                           and then Full_Source_Name (Body_Fname) /= No_File)
874               then
875                  Write_With_File_Names (Body_Fname, Body_Index);
876               else
877                  Write_With_File_Names (Fname, Munit_Index (Unum));
878               end if;
879
880               if Ekind (Cunit_Entity (Unum)) = E_Package
881                  and then From_Limited_With (Cunit_Entity (Unum))
882               then
883                  null;
884               else
885                  if Elab_Flags (Unum) then
886                     Write_Info_Str ("  E");
887                  end if;
888
889                  if Elab_All_Flags (Unum) then
890                     Write_Info_Str ("  EA");
891                  end if;
892
893                  if Elab_Des_Flags (Unum) then
894                     Write_Info_Str ("  ED");
895                  end if;
896
897                  if Elab_All_Des_Flags (Unum) then
898                     Write_Info_Str ("  AD");
899                  end if;
900               end if;
901            end if;
902
903            Write_Info_EOL;
904         end loop;
905
906         --  Finally generate the special lines for cases of Restriction_Set
907         --  with No_Dependence and no restriction present.
908
909         declare
910            Unam : Unit_Name_Type;
911
912         begin
913            for J in Restriction_Set_Dependences.First ..
914                     Restriction_Set_Dependences.Last
915            loop
916               Unam := Restriction_Set_Dependences.Table (J);
917
918               --  Don't need an entry if already in the unit table
919
920               for U in 0 .. Last_Unit loop
921                  if Unit_Name (U) = Unam then
922                     goto Continue;
923                  end if;
924               end loop;
925
926               --  Otherwise generate the entry
927
928               Write_Info_Initiate ('W');
929               Write_Info_Char (' ');
930               Write_Info_Name (Unam);
931               Write_Info_EOL;
932
933            <<Continue>>
934               null;
935            end loop;
936         end;
937      end Write_With_Lines;
938
939   --  Start of processing for Write_ALI
940
941   begin
942      --  We never write an ALI file if the original operating mode was
943      --  syntax-only (-gnats switch used in compiler invocation line)
944
945      if Original_Operating_Mode = Check_Syntax
946        or flag_compare_debug /= 0
947      then
948         return;
949      end if;
950
951      --  Generation of ALI files may be disabled, e.g. for formal verification
952      --  back-end.
953
954      if Disable_ALI_File then
955         return;
956      end if;
957
958      --  Build sorted source dependency table. We do this right away, because
959      --  it is referenced by Up_To_Date_ALI_File_Exists.
960
961      for Unum in Units.First .. Last_Unit loop
962         if Cunit_Entity (Unum) = Empty
963           or else not From_Limited_With (Cunit_Entity (Unum))
964         then
965            Num_Sdep := Num_Sdep + 1;
966            Sdep_Table (Num_Sdep) := Unum;
967         end if;
968      end loop;
969
970      --  Sort the table so that the D lines are in order
971
972      Lib.Sort (Sdep_Table (1 .. Num_Sdep));
973
974      --  If we are not generating code, and there is an up to date ALI file
975      --  file accessible, read it, and acquire the compilation arguments from
976      --  this file. In GNATprove mode, always generate the ALI file, which
977      --  contains a special section for formal verification.
978
979      if Operating_Mode /= Generate_Code and then not GNATprove_Mode then
980         if Up_To_Date_ALI_File_Exists then
981            Update_Tables_From_ALI_File;
982            return;
983         end if;
984      end if;
985
986      --  Otherwise acquire compilation arguments and prepare to write
987      --  out a new ali file.
988
989      Create_Output_Library_Info;
990
991      --  Output version line
992
993      Write_Info_Initiate ('V');
994      Write_Info_Str (" """);
995      Write_Info_Str (Verbose_Library_Version);
996      Write_Info_Char ('"');
997
998      Write_Info_EOL;
999
1000      --  Output main program line if this is acceptable main program
1001
1002      Output_Main_Program_Line : declare
1003         U : Node_Id := Unit (Units.Table (Main_Unit).Cunit);
1004         S : Node_Id;
1005
1006         procedure M_Parameters;
1007         --  Output parameters for main program line
1008
1009         ------------------
1010         -- M_Parameters --
1011         ------------------
1012
1013         procedure M_Parameters is
1014         begin
1015            if Main_Priority (Main_Unit) /= Default_Main_Priority then
1016               Write_Info_Char (' ');
1017               Write_Info_Nat (Main_Priority (Main_Unit));
1018            end if;
1019
1020            if Opt.Time_Slice_Set then
1021               Write_Info_Str (" T=");
1022               Write_Info_Nat (Opt.Time_Slice_Value);
1023            end if;
1024
1025            if Has_Allocator (Main_Unit) then
1026               Write_Info_Str (" AB");
1027            end if;
1028
1029            if Main_CPU (Main_Unit) /= Default_Main_CPU then
1030               Write_Info_Str (" C=");
1031               Write_Info_Nat (Main_CPU (Main_Unit));
1032            end if;
1033
1034            Write_Info_Str (" W=");
1035            Write_Info_Char
1036              (WC_Encoding_Letters (Wide_Character_Encoding_Method));
1037
1038            Write_Info_EOL;
1039         end M_Parameters;
1040
1041      --  Start of processing for Output_Main_Program_Line
1042
1043      begin
1044         if Nkind (U) = N_Subprogram_Body
1045           or else
1046             (Nkind (U) = N_Package_Body
1047               and then
1048                 Nkind (Original_Node (U)) in N_Subprogram_Instantiation)
1049         then
1050            --  If the unit is a subprogram instance, the entity for the
1051            --  subprogram is the alias of the visible entity, which is the
1052            --  related instance of the wrapper package. We retrieve the
1053            --  subprogram declaration of the desired entity.
1054
1055            if Nkind (U) = N_Package_Body then
1056               U := Parent (Parent (
1057                   Alias (Related_Instance (Defining_Unit_Name
1058                     (Specification (Unit (Library_Unit (Parent (U)))))))));
1059            end if;
1060
1061            S := Specification (U);
1062
1063            --  A generic subprogram is never a main program
1064
1065            if Nkind (U) = N_Subprogram_Body
1066              and then Present (Corresponding_Spec (U))
1067              and then
1068                Ekind_In (Corresponding_Spec (U),
1069                  E_Generic_Procedure, E_Generic_Function)
1070            then
1071               null;
1072
1073            elsif No (Parameter_Specifications (S)) then
1074               if Nkind (S) = N_Procedure_Specification then
1075                  Write_Info_Initiate ('M');
1076                  Write_Info_Str (" P");
1077                  M_Parameters;
1078
1079               else
1080                  declare
1081                     Nam : Node_Id := Defining_Unit_Name (S);
1082
1083                  begin
1084                     --  If it is a child unit, get its simple name
1085
1086                     if Nkind (Nam) = N_Defining_Program_Unit_Name then
1087                        Nam := Defining_Identifier (Nam);
1088                     end if;
1089
1090                     if Is_Integer_Type (Etype (Nam)) then
1091                        Write_Info_Initiate ('M');
1092                        Write_Info_Str (" F");
1093                        M_Parameters;
1094                     end if;
1095                  end;
1096               end if;
1097            end if;
1098         end if;
1099      end Output_Main_Program_Line;
1100
1101      --  Write command argument ('A') lines
1102
1103      for A in 1 .. Compilation_Switches.Last loop
1104         Write_Info_Initiate ('A');
1105         Write_Info_Char (' ');
1106         Write_Info_Str (Compilation_Switches.Table (A).all);
1107         Write_Info_Terminate;
1108      end loop;
1109
1110      --  Output parameters ('P') line
1111
1112      Write_Info_Initiate ('P');
1113
1114      if Compilation_Errors then
1115         Write_Info_Str (" CE");
1116      end if;
1117
1118      if Opt.Detect_Blocking then
1119         Write_Info_Str (" DB");
1120      end if;
1121
1122      if Opt.Float_Format /= ' ' then
1123         Write_Info_Str (" F");
1124
1125         if Opt.Float_Format = 'I' then
1126            Write_Info_Char ('I');
1127
1128         elsif Opt.Float_Format_Long = 'D' then
1129            Write_Info_Char ('D');
1130
1131         else
1132            Write_Info_Char ('G');
1133         end if;
1134      end if;
1135
1136      if Tasking_Used
1137        and then not Is_Predefined_File_Name (Unit_File_Name (Main_Unit))
1138      then
1139         if Locking_Policy /= ' ' then
1140            Write_Info_Str  (" L");
1141            Write_Info_Char (Locking_Policy);
1142         end if;
1143
1144         if Queuing_Policy /= ' ' then
1145            Write_Info_Str  (" Q");
1146            Write_Info_Char (Queuing_Policy);
1147         end if;
1148
1149         if Task_Dispatching_Policy /= ' ' then
1150            Write_Info_Str  (" T");
1151            Write_Info_Char (Task_Dispatching_Policy);
1152            Write_Info_Char (' ');
1153         end if;
1154      end if;
1155
1156      if Partition_Elaboration_Policy /= ' ' then
1157         Write_Info_Str  (" E");
1158         Write_Info_Char (Partition_Elaboration_Policy);
1159      end if;
1160
1161      if not Object then
1162         Write_Info_Str (" NO");
1163      end if;
1164
1165      if No_Run_Time_Mode then
1166         Write_Info_Str (" NR");
1167      end if;
1168
1169      if Normalize_Scalars then
1170         Write_Info_Str (" NS");
1171      end if;
1172
1173      if Sec_Stack_Used then
1174         Write_Info_Str (" SS");
1175      end if;
1176
1177      if Unreserve_All_Interrupts then
1178         Write_Info_Str (" UA");
1179      end if;
1180
1181      if Exception_Mechanism = Back_End_Exceptions then
1182         Write_Info_Str (" ZX");
1183      end if;
1184
1185      Write_Info_EOL;
1186
1187      --  Before outputting the restrictions line, update the setting of
1188      --  the No_Elaboration_Code flag. Violations of this restriction
1189      --  cannot be detected until after the backend has been called since
1190      --  it is the backend that sets this flag. We have to check all units
1191      --  for which we have generated code
1192
1193      for Unit in Units.First .. Last_Unit loop
1194         if Units.Table (Unit).Generate_Code
1195           or else Unit = Main_Unit
1196         then
1197            if not Has_No_Elaboration_Code (Cunit (Unit)) then
1198               Main_Restrictions.Violated (No_Elaboration_Code) := True;
1199            end if;
1200         end if;
1201      end loop;
1202
1203      --  Positional case (only if debug flag -gnatd.R is set)
1204
1205      if Debug_Flag_Dot_RR then
1206
1207         --  Output first restrictions line
1208
1209         Write_Info_Initiate ('R');
1210         Write_Info_Char (' ');
1211
1212         --  First the information for the boolean restrictions
1213
1214         for R in All_Boolean_Restrictions loop
1215            if Main_Restrictions.Set (R)
1216              and then not Restriction_Warnings (R)
1217            then
1218               Write_Info_Char ('r');
1219            elsif Main_Restrictions.Violated (R) then
1220               Write_Info_Char ('v');
1221            else
1222               Write_Info_Char ('n');
1223            end if;
1224         end loop;
1225
1226         --  And now the information for the parameter restrictions
1227
1228         for RP in All_Parameter_Restrictions loop
1229            if Main_Restrictions.Set (RP)
1230              and then not Restriction_Warnings (RP)
1231            then
1232               Write_Info_Char ('r');
1233               Write_Info_Nat (Nat (Main_Restrictions.Value (RP)));
1234            else
1235               Write_Info_Char ('n');
1236            end if;
1237
1238            if not Main_Restrictions.Violated (RP)
1239              or else RP not in Checked_Parameter_Restrictions
1240            then
1241               Write_Info_Char ('n');
1242            else
1243               Write_Info_Char ('v');
1244               Write_Info_Nat (Nat (Main_Restrictions.Count (RP)));
1245
1246               if Main_Restrictions.Unknown (RP) then
1247                  Write_Info_Char ('+');
1248               end if;
1249            end if;
1250         end loop;
1251
1252         Write_Info_EOL;
1253
1254      --  Named case (if debug flag -gnatd.R is not set)
1255
1256      else
1257         declare
1258            C : Character;
1259
1260         begin
1261            --  Write RN header line with preceding blank line
1262
1263            Write_Info_EOL;
1264            Write_Info_Initiate ('R');
1265            Write_Info_Char ('N');
1266            Write_Info_EOL;
1267
1268            --  First the lines for the boolean restrictions
1269
1270            for R in All_Boolean_Restrictions loop
1271               if Main_Restrictions.Set (R)
1272                 and then not Restriction_Warnings (R)
1273               then
1274                  C := 'R';
1275               elsif Main_Restrictions.Violated (R) then
1276                  C := 'V';
1277               else
1278                  goto Continue;
1279               end if;
1280
1281               Write_Info_Initiate ('R');
1282               Write_Info_Char (C);
1283               Write_Info_Char (' ');
1284               Write_Info_Str (All_Boolean_Restrictions'Image (R));
1285               Write_Info_EOL;
1286
1287            <<Continue>>
1288               null;
1289            end loop;
1290         end;
1291
1292         --  And now the lines for the parameter restrictions
1293
1294         for RP in All_Parameter_Restrictions loop
1295            if Main_Restrictions.Set (RP)
1296              and then not Restriction_Warnings (RP)
1297            then
1298               Write_Info_Initiate ('R');
1299               Write_Info_Str ("R ");
1300               Write_Info_Str (All_Parameter_Restrictions'Image (RP));
1301               Write_Info_Char ('=');
1302               Write_Info_Nat (Nat (Main_Restrictions.Value (RP)));
1303               Write_Info_EOL;
1304            end if;
1305
1306            if not Main_Restrictions.Violated (RP)
1307              or else RP not in Checked_Parameter_Restrictions
1308            then
1309               null;
1310            else
1311               Write_Info_Initiate ('R');
1312               Write_Info_Str ("V ");
1313               Write_Info_Str (All_Parameter_Restrictions'Image (RP));
1314               Write_Info_Char ('=');
1315               Write_Info_Nat (Nat (Main_Restrictions.Count (RP)));
1316
1317               if Main_Restrictions.Unknown (RP) then
1318                  Write_Info_Char ('+');
1319               end if;
1320
1321               Write_Info_EOL;
1322            end if;
1323         end loop;
1324      end if;
1325
1326      --  Output R lines for No_Dependence entries
1327
1328      for J in No_Dependences.First .. No_Dependences.Last loop
1329         if In_Extended_Main_Source_Unit (No_Dependences.Table (J).Unit)
1330           and then not No_Dependences.Table (J).Warn
1331         then
1332            Write_Info_Initiate ('R');
1333            Write_Info_Char (' ');
1334            Write_Unit_Name (No_Dependences.Table (J).Unit);
1335            Write_Info_EOL;
1336         end if;
1337      end loop;
1338
1339      --  Output interrupt state lines
1340
1341      for J in Interrupt_States.First .. Interrupt_States.Last loop
1342         Write_Info_Initiate ('I');
1343         Write_Info_Char (' ');
1344         Write_Info_Nat (Interrupt_States.Table (J).Interrupt_Number);
1345         Write_Info_Char (' ');
1346         Write_Info_Char (Interrupt_States.Table (J).Interrupt_State);
1347         Write_Info_Char (' ');
1348         Write_Info_Nat
1349           (Nat (Get_Logical_Line_Number
1350                   (Interrupt_States.Table (J).Pragma_Loc)));
1351         Write_Info_EOL;
1352      end loop;
1353
1354      --  Output priority specific dispatching lines
1355
1356      for J in Specific_Dispatching.First .. Specific_Dispatching.Last loop
1357         Write_Info_Initiate ('S');
1358         Write_Info_Char (' ');
1359         Write_Info_Char (Specific_Dispatching.Table (J).Dispatching_Policy);
1360         Write_Info_Char (' ');
1361         Write_Info_Nat (Specific_Dispatching.Table (J).First_Priority);
1362         Write_Info_Char (' ');
1363         Write_Info_Nat (Specific_Dispatching.Table (J).Last_Priority);
1364         Write_Info_Char (' ');
1365         Write_Info_Nat
1366           (Nat (Get_Logical_Line_Number
1367                   (Specific_Dispatching.Table (J).Pragma_Loc)));
1368         Write_Info_EOL;
1369      end loop;
1370
1371      --  Loop through file table to output information for all units for which
1372      --  we have generated code, as marked by the Generate_Code flag.
1373
1374      for Unit in Units.First .. Last_Unit loop
1375         if Units.Table (Unit).Generate_Code
1376           or else Unit = Main_Unit
1377         then
1378            Write_Info_EOL; -- blank line
1379            Write_Unit_Information (Unit);
1380         end if;
1381      end loop;
1382
1383      Write_Info_EOL; -- blank line
1384
1385      --  Output external version reference lines
1386
1387      for J in 1 .. Version_Ref.Last loop
1388         Write_Info_Initiate ('E');
1389         Write_Info_Char (' ');
1390
1391         for K in 1 .. String_Length (Version_Ref.Table (J)) loop
1392            Write_Info_Char_Code (Get_String_Char (Version_Ref.Table (J), K));
1393         end loop;
1394
1395         Write_Info_EOL;
1396      end loop;
1397
1398      --  Prepare to output the source dependency lines
1399
1400      declare
1401         Unum : Unit_Number_Type;
1402         --  Number of unit being output
1403
1404         Sind : Source_File_Index;
1405         --  Index of corresponding source file
1406
1407         Fname : File_Name_Type;
1408
1409      begin
1410         for J in 1 .. Num_Sdep loop
1411            Unum := Sdep_Table (J);
1412            Units.Table (Unum).Dependency_Num := J;
1413            Sind := Units.Table (Unum).Source_Index;
1414
1415            Write_Info_Initiate ('D');
1416            Write_Info_Char (' ');
1417
1418            --  Normal case of a unit entry with a source index
1419
1420            if Sind /= No_Source_File then
1421               Fname := File_Name (Sind);
1422
1423               --  Ensure that on platforms where the file names are not
1424               --  case sensitive, the recorded file name is in lower case.
1425
1426               if not File_Names_Case_Sensitive then
1427                  Get_Name_String (Fname);
1428                  To_Lower (Name_Buffer (1 .. Name_Len));
1429                  Fname := Name_Find;
1430               end if;
1431
1432               Write_Info_Name_May_Be_Quoted (Fname);
1433               Write_Info_Tab (25);
1434               Write_Info_Str (String (Time_Stamp (Sind)));
1435               Write_Info_Char (' ');
1436               Write_Info_Str (Get_Hex_String (Source_Checksum (Sind)));
1437
1438               --  If subunit, add unit name, omitting the %b at the end
1439
1440               if Present (Cunit (Unum))
1441                 and then Nkind (Unit (Cunit (Unum))) = N_Subunit
1442               then
1443                  Get_Decoded_Name_String (Unit_Name (Unum));
1444                  Write_Info_Char (' ');
1445                  Write_Info_Str (Name_Buffer (1 .. Name_Len - 2));
1446               end if;
1447
1448               --  If Source_Reference pragma used output information
1449
1450               if Num_SRef_Pragmas (Sind) > 0 then
1451                  Write_Info_Char (' ');
1452
1453                  if Num_SRef_Pragmas (Sind) = 1 then
1454                     Write_Info_Nat (Int (First_Mapped_Line (Sind)));
1455                  else
1456                     Write_Info_Nat (0);
1457                  end if;
1458
1459                  Write_Info_Char (':');
1460                  Write_Info_Name (Reference_Name (Sind));
1461               end if;
1462
1463               --  Case where there is no source index (happens for missing
1464               --  files). In this case we write a dummy time stamp.
1465
1466            else
1467               Write_Info_Name (Unit_File_Name (Unum));
1468               Write_Info_Tab (25);
1469               Write_Info_Str (String (Dummy_Time_Stamp));
1470               Write_Info_Char (' ');
1471               Write_Info_Str (Get_Hex_String (0));
1472            end if;
1473
1474            Write_Info_EOL;
1475         end loop;
1476      end;
1477
1478      --  Output cross-references
1479
1480      if Opt.Xref_Active then
1481         Output_References;
1482      end if;
1483
1484      --  Output SCO information if present
1485
1486      if Generate_SCO then
1487         SCO_Output;
1488      end if;
1489
1490      --  Output SPARK cross-reference information if needed
1491
1492      if Opt.Xref_Active and then GNATprove_Mode then
1493         SPARK_Specific.Collect_SPARK_Xrefs (Sdep_Table => Sdep_Table,
1494                                             Num_Sdep   => Num_Sdep);
1495         SPARK_Specific.Output_SPARK_Xrefs;
1496      end if;
1497
1498      --  Output final blank line and we are done. This final blank line is
1499      --  probably junk, but we don't feel like making an incompatible change.
1500
1501      Write_Info_Terminate;
1502      Close_Output_Library_Info;
1503   end Write_ALI;
1504
1505   ---------------------
1506   -- Write_Unit_Name --
1507   ---------------------
1508
1509   procedure Write_Unit_Name (N : Node_Id) is
1510   begin
1511      if Nkind (N) = N_Identifier then
1512         Write_Info_Name (Chars (N));
1513
1514      else
1515         pragma Assert (Nkind (N) = N_Selected_Component);
1516         Write_Unit_Name (Prefix (N));
1517         Write_Info_Char ('.');
1518         Write_Unit_Name (Selector_Name (N));
1519      end if;
1520   end Write_Unit_Name;
1521
1522end Lib.Writ;
1523