1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
29 with Atree
; use Atree
;
30 with Casing
; use Casing
;
31 with Einfo
; use Einfo
;
32 with Errout
; use Errout
;
33 with Fname
; use Fname
;
34 with Fname
.UF
; use Fname
.UF
;
35 with Lib
.Util
; use Lib
.Util
;
36 with Lib
.Xref
; use Lib
.Xref
;
37 with Namet
; use Namet
;
38 with Nlists
; use Nlists
;
39 with Gnatvsn
; use Gnatvsn
;
41 with Osint
; use Osint
;
42 with Osint
.C
; use Osint
.C
;
44 with Restrict
; use Restrict
;
46 with Sinfo
; use Sinfo
;
47 with Sinput
; use Sinput
;
48 with Stringt
; use Stringt
;
49 with Uname
; use Uname
;
51 with System
.WCh_Con
; use System
.WCh_Con
;
53 package body Lib
.Writ
is
55 ------------------------------
56 -- Ensure_System_Dependency --
57 ------------------------------
59 procedure Ensure_System_Dependency
is
62 System_Uname
: Unit_Name_Type
;
63 -- Unit name for system spec if needed for dummy entry
65 System_Fname
: File_Name_Type
;
66 -- File name for system spec if needed for dummy entry
69 -- Nothing to do if we already compiled System
71 for Unum
in Units
.First
.. Last_Unit
loop
72 if Units
.Table
(Unum
).Source_Index
= System_Source_File_Index
then
77 -- If no entry for system.ads in the units table, then add a entry
78 -- to the units table for system.ads, which will be referenced when
79 -- the ali file is generated. We need this because every unit depends
80 -- on system as a result of Targparm scanning the system.ads file to
81 -- determine the target dependent parameters for the compilation.
84 Name_Buffer
(1 .. 6) := "system";
85 System_Uname
:= Name_To_Unit_Name
(Name_Enter
);
86 System_Fname
:= File_Name
(System_Source_File_Index
);
89 Units
.Table
(Units
.Last
) := (
90 Unit_File_Name
=> System_Fname
,
91 Unit_Name
=> System_Uname
,
92 Expected_Unit
=> System_Uname
,
93 Source_Index
=> System_Source_File_Index
,
95 Cunit_Entity
=> Empty
,
97 Dependent_Unit
=> True,
98 Dynamic_Elab
=> False,
100 Generate_Code
=> False,
102 Ident_String
=> Empty
,
107 Error_Location
=> No_Location
);
109 -- Parse system.ads so that the checksum is set right
111 Initialize_Scanner
(Units
.Last
, System_Source_File_Index
);
112 Discard
:= Par
(Configuration_Pragmas
=> False);
113 end Ensure_System_Dependency
;
119 procedure Write_ALI
(Object
: Boolean) is
125 Last_Unit
: constant Unit_Number_Type
:= Units
.Last
;
126 -- Record unit number of last unit. We capture this in case we
127 -- have to add a dummy entry to the unit table for package System.
129 With_Flags
: array (Units
.First
.. Last_Unit
) of Boolean;
130 -- Array of flags to show which units are with'ed
132 Elab_Flags
: array (Units
.First
.. Last_Unit
) of Boolean;
133 -- Array of flags to show which units have pragma Elaborate set
135 Elab_All_Flags
: array (Units
.First
.. Last_Unit
) of Boolean;
136 -- Array of flags to show which units have pragma Elaborate All set
138 Elab_Des_Flags
: array (Units
.First
.. Last_Unit
) of Boolean;
139 -- Array of flags to show which units have Elaborate_All_Desirable set
141 Sdep_Table
: Unit_Ref_Table
(1 .. Pos
(Last_Unit
- Units
.First
+ 2));
142 -- Sorted table of source dependencies. One extra entry in case we
143 -- have to add a dummy entry for System.
146 -- Number of active entries in Sdep_Table
148 -----------------------
149 -- Local Subprograms --
150 -----------------------
152 procedure Collect_Withs
(Cunit
: Node_Id
);
153 -- Collect with lines for entries in the context clause of the
154 -- given compilation unit, Cunit.
156 procedure Update_Tables_From_ALI_File
;
157 -- Given an up to date ALI file (see Up_To_Date_ALI_file_Exists
158 -- function), update tables from the ALI information, including
159 -- specifically the Compilation_Switches table.
161 function Up_To_Date_ALI_File_Exists
return Boolean;
162 -- If there exists an ALI file that is up to date, then this function
163 -- initializes the tables in the ALI spec to contain information on
164 -- this file (using Scan_ALI) and returns True. If no file exists,
165 -- or the file is not up to date, then False is returned.
167 procedure Write_Unit_Information
(Unit_Num
: Unit_Number_Type
);
168 -- Write out the library information for one unit for which code is
169 -- generated (includes unit line and with lines).
171 procedure Write_With_Lines
;
172 -- Write out with lines collected by calls to Collect_Withs
178 procedure Collect_Withs
(Cunit
: Node_Id
) is
180 Unum
: Unit_Number_Type
;
183 Item
:= First
(Context_Items
(Cunit
));
184 while Present
(Item
) loop
186 if Nkind
(Item
) = N_With_Clause
then
187 Unum
:= Get_Cunit_Unit_Number
(Library_Unit
(Item
));
188 With_Flags
(Unum
) := True;
190 if Elaborate_Present
(Item
) then
191 Elab_Flags
(Unum
) := True;
194 if Elaborate_All_Present
(Item
) then
195 Elab_All_Flags
(Unum
) := True;
198 if Elaborate_All_Desirable
(Cunit_Entity
(Unum
)) then
199 Elab_Des_Flags
(Unum
) := True;
207 --------------------------------
208 -- Up_To_Date_ALI_File_Exists --
209 --------------------------------
211 function Up_To_Date_ALI_File_Exists
return Boolean is
212 Name
: File_Name_Type
;
213 Text
: Text_Buffer_Ptr
;
215 Sind
: Source_File_Index
;
218 Opt
.Check_Object_Consistency
:= True;
219 Read_Library_Info
(Name
, Text
);
221 -- Return if we could not find an ALI file
227 -- Return if ALI file has bad format
231 if Scan_ALI
(Name
, Text
, False, Err
=> True) = No_ALI_Id
then
235 -- If we have an OK ALI file, check if it is up to date
236 -- Note that we assume that the ALI read has all the entries
237 -- we have in our table, plus some additional ones (that can
238 -- come from expansion).
240 Id
:= First_Sdep_Entry
;
241 for J
in 1 .. Num_Sdep
loop
242 Sind
:= Units
.Table
(Sdep_Table
(J
)).Source_Index
;
244 while Sdep
.Table
(Id
).Sfile
/= File_Name
(Sind
) loop
245 if Id
= Sdep
.Last
then
252 if Sdep
.Table
(Id
).Stamp
/= Time_Stamp
(Sind
) then
258 end Up_To_Date_ALI_File_Exists
;
260 ---------------------------------
261 -- Update_Tables_From_ALI_File --
262 ---------------------------------
264 procedure Update_Tables_From_ALI_File
is
266 -- Build Compilation_Switches table
268 Compilation_Switches
.Init
;
270 for J
in First_Arg_Entry
.. Args
.Last
loop
271 Compilation_Switches
.Increment_Last
;
272 Compilation_Switches
.Table
(Compilation_Switches
.Last
) :=
275 end Update_Tables_From_ALI_File
;
277 ----------------------------
278 -- Write_Unit_Information --
279 ----------------------------
281 procedure Write_Unit_Information
(Unit_Num
: Unit_Number_Type
) is
282 Unode
: constant Node_Id
:= Cunit
(Unit_Num
);
283 Ukind
: constant Node_Kind
:= Nkind
(Unit
(Unode
));
284 Uent
: constant Entity_Id
:= Cunit_Entity
(Unit_Num
);
288 Write_Info_Initiate
('U');
289 Write_Info_Char
(' ');
290 Write_Info_Name
(Unit_Name
(Unit_Num
));
292 Write_Info_Name
(Unit_File_Name
(Unit_Num
));
295 Write_Info_Str
(Version_Get
(Unit_Num
));
297 if Dynamic_Elab
(Unit_Num
) then
298 Write_Info_Str
(" DE");
301 -- We set the Elaborate_Body indication if either an explicit pragma
302 -- was present, or if this is an instantiation. RM 12.3(20) requires
303 -- that the body be immediately elaborated after the spec. We would
304 -- normally do that anyway, but the EB we generate here ensures that
305 -- this gets done even when we use the -p gnatbind switch.
307 if Has_Pragma_Elaborate_Body
(Uent
)
308 or else (Ukind
= N_Package_Declaration
309 and then Is_Generic_Instance
(Uent
)
310 and then Present
(Corresponding_Body
(Unit
(Unode
))))
312 Write_Info_Str
(" EB");
315 -- Now see if we should tell the binder that an elaboration entity
316 -- is present, which must be reset to true during elaboration. We
317 -- generate the indication if the following condition is met:
319 -- If this is a spec ...
321 if (Is_Subprogram
(Uent
)
323 Ekind
(Uent
) = E_Package
325 Is_Generic_Unit
(Uent
))
327 -- and an elaboration entity was declared ...
329 and then Present
(Elaboration_Entity
(Uent
))
331 -- and either the elaboration flag is required ...
334 (Elaboration_Entity_Required
(Uent
)
336 -- or this unit has elaboration code ...
338 or else not Has_No_Elaboration_Code
(Unode
)
340 -- or this unit has a separate body and this
341 -- body has elaboration code.
344 (Ekind
(Uent
) = E_Package
345 and then Present
(Body_Entity
(Uent
))
347 not Has_No_Elaboration_Code
350 (Body_Entity
(Uent
))))))
352 Write_Info_Str
(" EE");
355 if Has_No_Elaboration_Code
(Unode
) then
356 Write_Info_Str
(" NE");
359 if Is_Preelaborated
(Uent
) then
360 Write_Info_Str
(" PR");
363 if Is_Pure
(Uent
) then
364 Write_Info_Str
(" PU");
367 if Has_RACW
(Unit_Num
) then
368 Write_Info_Str
(" RA");
371 if Is_Remote_Call_Interface
(Uent
) then
372 Write_Info_Str
(" RC");
375 if Is_Remote_Types
(Uent
) then
376 Write_Info_Str
(" RT");
379 if Is_Shared_Passive
(Uent
) then
380 Write_Info_Str
(" SP");
383 if Ukind
= N_Subprogram_Declaration
384 or else Ukind
= N_Subprogram_Body
386 Write_Info_Str
(" SU");
388 elsif Ukind
= N_Package_Declaration
390 Ukind
= N_Package_Body
392 -- If this is a wrapper package for a subprogram instantiation,
393 -- the user view is the subprogram. Note that in this case the
394 -- ali file contains both the spec and body of the instance.
396 if Is_Wrapper_Package
(Uent
) then
397 Write_Info_Str
(" SU");
399 Write_Info_Str
(" PK");
402 elsif Ukind
= N_Generic_Package_Declaration
then
403 Write_Info_Str
(" PK");
407 if Ukind
in N_Generic_Declaration
409 (Present
(Library_Unit
(Unode
))
411 Nkind
(Unit
(Library_Unit
(Unode
))) in N_Generic_Declaration
)
413 Write_Info_Str
(" GE");
416 if not Is_Internal_File_Name
(Unit_File_Name
(Unit_Num
), True) then
417 case Identifier_Casing
(Source_Index
(Unit_Num
)) is
418 when All_Lower_Case
=> Write_Info_Str
(" IL");
419 when All_Upper_Case
=> Write_Info_Str
(" IU");
423 case Keyword_Casing
(Source_Index
(Unit_Num
)) is
424 when Mixed_Case
=> Write_Info_Str
(" KM");
425 when All_Upper_Case
=> Write_Info_Str
(" KU");
430 if Initialize_Scalars
then
431 Write_Info_Str
(" IS");
436 -- Generate with lines, first those that are directly with'ed
438 for J
in With_Flags
'Range loop
439 With_Flags
(J
) := False;
440 Elab_Flags
(J
) := False;
441 Elab_All_Flags
(J
) := False;
442 Elab_Des_Flags
(J
) := False;
445 Collect_Withs
(Unode
);
447 -- For a body, we must also check for any subunits which belong to
448 -- it and which have context clauses of their own, since these
449 -- with'ed units are part of its own elaboration dependencies.
451 if Nkind
(Unit
(Unode
)) in N_Unit_Body
then
452 for S
in Units
.First
.. Last_Unit
loop
454 -- We are only interested in subunits
456 if Nkind
(Unit
(Cunit
(S
))) = N_Subunit
then
457 Pnode
:= Library_Unit
(Cunit
(S
));
459 -- In gnatc mode, the errors in the subunits will not
460 -- have been recorded, but the analysis of the subunit
461 -- may have failed. There is no information to add to
462 -- ALI file in this case.
468 -- Find ultimate parent of the subunit
470 while Nkind
(Unit
(Pnode
)) = N_Subunit
loop
471 Pnode
:= Library_Unit
(Pnode
);
474 -- See if it belongs to current unit, and if so, include
477 if Pnode
= Unode
then
478 Collect_Withs
(Cunit
(S
));
486 -- Output linker option lines
488 for J
in 1 .. Linker_Option_Lines
.Last
loop
490 S
: constant Linker_Option_Entry
:=
491 Linker_Option_Lines
.Table
(J
);
495 if S
.Unit
= Unit_Num
then
496 Write_Info_Initiate
('L');
497 Write_Info_Str
(" """);
499 for J
in 1 .. String_Length
(S
.Option
) loop
500 C
:= Get_Character
(Get_String_Char
(S
.Option
, J
));
502 if C
in Character'Val (16#
20#
) .. Character'Val (16#
7E#
)
513 Hex
: array (0 .. 15) of Character :=
517 Write_Info_Char
('{');
518 Write_Info_Char
(Hex
(Character'Pos (C
) / 16));
519 Write_Info_Char
(Hex
(Character'Pos (C
) mod 16));
520 Write_Info_Char
('}');
525 Write_Info_Char
('"');
530 end Write_Unit_Information
;
532 ----------------------
533 -- Write_With_Lines --
534 ----------------------
536 procedure Write_With_Lines
is
537 With_Table
: Unit_Ref_Table
(1 .. Pos
(Last_Unit
- Units
.First
+ 1));
538 Num_Withs
: Int
:= 0;
539 Unum
: Unit_Number_Type
;
542 Uname
: Unit_Name_Type
;
543 Fname
: File_Name_Type
;
544 Pname
: constant Unit_Name_Type
:=
545 Get_Parent_Spec_Name
(Unit_Name
(Main_Unit
));
546 Body_Fname
: File_Name_Type
;
549 -- Loop to build the with table. A with on the main unit itself
550 -- is ignored (AARM 10.2(14a)). Such a with-clause can occur if
551 -- the main unit is a subprogram with no spec, and a subunit of
552 -- it unecessarily withs the parent.
554 for J
in Units
.First
+ 1 .. Last_Unit
loop
556 -- Add element to with table if it is with'ed or if it is the
557 -- parent spec of the main unit (case of main unit is a child
558 -- unit). The latter with is not needed for semantic purposes,
559 -- but is required by the binder for elaboration purposes.
561 if (With_Flags
(J
) or else Unit_Name
(J
) = Pname
)
562 and then Units
.Table
(J
).Dependent_Unit
564 Num_Withs
:= Num_Withs
+ 1;
565 With_Table
(Num_Withs
) := J
;
569 -- Sort and output the table
571 Sort
(With_Table
(1 .. Num_Withs
));
573 for J
in 1 .. Num_Withs
loop
574 Unum
:= With_Table
(J
);
575 Cunit
:= Units
.Table
(Unum
).Cunit
;
576 Cunite
:= Units
.Table
(Unum
).Cunit_Entity
;
577 Uname
:= Units
.Table
(Unum
).Unit_Name
;
578 Fname
:= Units
.Table
(Unum
).Unit_File_Name
;
580 Write_Info_Initiate
('W');
581 Write_Info_Char
(' ');
582 Write_Info_Name
(Uname
);
584 -- Now we need to figure out the names of the files that contain
585 -- the with'ed unit. These will usually be the files for the body,
586 -- except in the case of a package that has no body.
588 if (Nkind
(Unit
(Cunit
)) not in N_Generic_Declaration
590 Nkind
(Unit
(Cunit
)) not in N_Generic_Renaming_Declaration
)
591 or else Generic_Separately_Compiled
(Cunite
)
595 if Is_Spec_Name
(Uname
) then
597 Get_File_Name
(Get_Body_Name
(Uname
), Subunit
=> False);
599 Body_Fname
:= Get_File_Name
(Uname
, Subunit
=> False);
602 -- A package is considered to have a body if it requires
603 -- a body or if a body is present in Ada 83 mode.
605 if Body_Required
(Cunit
)
607 and then Full_Source_Name
(Body_Fname
) /= No_File
)
609 Write_Info_Name
(Body_Fname
);
611 Write_Info_Name
(Lib_File_Name
(Body_Fname
));
613 Write_Info_Name
(Fname
);
615 Write_Info_Name
(Lib_File_Name
(Fname
));
618 if Elab_Flags
(Unum
) then
619 Write_Info_Str
(" E");
622 if Elab_All_Flags
(Unum
) then
623 Write_Info_Str
(" EA");
626 if Elab_Des_Flags
(Unum
) then
627 Write_Info_Str
(" ED");
633 end Write_With_Lines
;
635 -- Start of processing for Writ_ALI
638 -- Build sorted source dependency table. We do this right away,
639 -- because it is referenced by Up_To_Date_ALI_File_Exists.
641 for Unum
in Units
.First
.. Last_Unit
loop
642 Num_Sdep
:= Num_Sdep
+ 1;
643 Sdep_Table
(Num_Sdep
) := Unum
;
646 -- Sort the table so that the D lines are in order
648 Lib
.Sort
(Sdep_Table
(1 .. Num_Sdep
));
650 -- If we are not generating code, and there is an up to date
651 -- ali file accessible, read it, and acquire the compilation
652 -- arguments from this file.
654 if Operating_Mode
/= Generate_Code
then
655 if Up_To_Date_ALI_File_Exists
then
656 Update_Tables_From_ALI_File
;
661 -- Otherwise acquire compilation arguments and prepare to write
662 -- out a new ali file.
664 Create_Output_Library_Info
;
666 -- Output version line
668 Write_Info_Initiate
('V');
669 Write_Info_Str
(" """);
670 Write_Info_Str
(Library_Version
);
671 Write_Info_Char
('"');
675 -- Output main program line if this is acceptable main program
678 U
: Node_Id
:= Unit
(Units
.Table
(Main_Unit
).Cunit
);
681 procedure M_Parameters
;
682 -- Output parameters for main program line
684 procedure M_Parameters
is
686 if Main_Priority
(Main_Unit
) /= Default_Main_Priority
then
687 Write_Info_Char
(' ');
688 Write_Info_Nat
(Main_Priority
(Main_Unit
));
691 if Opt
.Time_Slice_Set
then
692 Write_Info_Str
(" T=");
693 Write_Info_Nat
(Opt
.Time_Slice_Value
);
696 Write_Info_Str
(" W=");
698 (WC_Encoding_Letters
(Wide_Character_Encoding_Method
));
704 if Nkind
(U
) = N_Subprogram_Body
705 or else (Nkind
(U
) = N_Package_Body
707 (Nkind
(Original_Node
(U
)) = N_Function_Instantiation
709 Nkind
(Original_Node
(U
)) =
710 N_Procedure_Instantiation
))
712 -- If the unit is a subprogram instance, the entity for the
713 -- subprogram is the alias of the visible entity, which is the
714 -- related instance of the wrapper package. We retrieve the
715 -- subprogram declaration of the desired entity.
717 if Nkind
(U
) = N_Package_Body
then
718 U
:= Parent
(Parent
(
719 Alias
(Related_Instance
(Defining_Unit_Name
720 (Specification
(Unit
(Library_Unit
(Parent
(U
)))))))));
723 S
:= Specification
(U
);
725 if not Present
(Parameter_Specifications
(S
)) then
726 if Nkind
(S
) = N_Procedure_Specification
then
727 Write_Info_Initiate
('M');
728 Write_Info_Str
(" P");
733 Nam
: Node_Id
:= Defining_Unit_Name
(S
);
736 -- If it is a child unit, get its simple name.
738 if Nkind
(Nam
) = N_Defining_Program_Unit_Name
then
739 Nam
:= Defining_Identifier
(Nam
);
742 if Is_Integer_Type
(Etype
(Nam
)) then
743 Write_Info_Initiate
('M');
744 Write_Info_Str
(" F");
753 -- Write command argmument ('A') lines
755 for A
in 1 .. Compilation_Switches
.Last
loop
756 Write_Info_Initiate
('A');
757 Write_Info_Char
(' ');
758 Write_Info_Str
(Compilation_Switches
.Table
(A
).all);
759 Write_Info_Terminate
;
762 -- Output parameters ('P') line
764 Write_Info_Initiate
('P');
766 if Compilation_Errors
then
767 Write_Info_Str
(" CE");
770 if Opt
.Float_Format
/= ' ' then
771 Write_Info_Str
(" F");
773 if Opt
.Float_Format
= 'I' then
774 Write_Info_Char
('I');
776 elsif Opt
.Float_Format_Long
= 'D' then
777 Write_Info_Char
('D');
780 Write_Info_Char
('G');
785 and then not Is_Predefined_File_Name
(Unit_File_Name
(Main_Unit
))
787 if Locking_Policy
/= ' ' then
788 Write_Info_Str
(" L");
789 Write_Info_Char
(Locking_Policy
);
792 if Queuing_Policy
/= ' ' then
793 Write_Info_Str
(" Q");
794 Write_Info_Char
(Queuing_Policy
);
797 if Task_Dispatching_Policy
/= ' ' then
798 Write_Info_Str
(" T");
799 Write_Info_Char
(Task_Dispatching_Policy
);
800 Write_Info_Char
(' ');
805 Write_Info_Str
(" NO");
809 Write_Info_Str
(" NR");
812 if Normalize_Scalars
then
813 Write_Info_Str
(" NS");
816 if Unreserve_All_Interrupts
then
817 Write_Info_Str
(" UA");
820 if Exception_Mechanism
/= Setjmp_Longjmp
then
821 if Unit_Exception_Table_Present
then
822 Write_Info_Str
(" UX");
825 Write_Info_Str
(" ZX");
830 -- Output restrictions line
832 Write_Info_Initiate
('R');
833 Write_Info_Char
(' ');
835 for J
in All_Restrictions
loop
836 if Main_Restrictions
(J
) then
837 Write_Info_Char
('r');
838 elsif Violations
(J
) then
839 Write_Info_Char
('v');
841 Write_Info_Char
('n');
847 -- Loop through file table to output information for all units for which
848 -- we have generated code, as marked by the Generate_Code flag.
850 for Unit
in Units
.First
.. Last_Unit
loop
851 if Units
.Table
(Unit
).Generate_Code
852 or else Unit
= Main_Unit
854 Write_Info_EOL
; -- blank line
855 Write_Unit_Information
(Unit
);
859 Write_Info_EOL
; -- blank line
861 -- Output external version reference lines
863 for J
in 1 .. Version_Ref
.Last
loop
864 Write_Info_Initiate
('E');
865 Write_Info_Char
(' ');
867 for K
in 1 .. String_Length
(Version_Ref
.Table
(J
)) loop
868 Write_Info_Char_Code
(Get_String_Char
(Version_Ref
.Table
(J
), K
));
874 -- Prepare to output the source dependency lines
877 Unum
: Unit_Number_Type
;
878 -- Number of unit being output
880 Sind
: Source_File_Index
;
881 -- Index of corresponding source file
884 for J
in 1 .. Num_Sdep
loop
885 Unum
:= Sdep_Table
(J
);
886 Units
.Table
(Unum
).Dependency_Num
:= J
;
887 Sind
:= Units
.Table
(Unum
).Source_Index
;
889 Write_Info_Initiate
('D');
890 Write_Info_Char
(' ');
892 -- Normal case of a dependent unit entry with a source index
894 if Sind
/= No_Source_File
895 and then Units
.Table
(Unum
).Dependent_Unit
897 Write_Info_Name
(File_Name
(Sind
));
899 Write_Info_Str
(String (Time_Stamp
(Sind
)));
900 Write_Info_Char
(' ');
901 Write_Info_Str
(Get_Hex_String
(Source_Checksum
(Sind
)));
903 -- If subunit, add unit name, omitting the %b at the end
905 if Present
(Cunit
(Unum
))
906 and then Nkind
(Unit
(Cunit
(Unum
))) = N_Subunit
908 Get_Decoded_Name_String
(Unit_Name
(Unum
));
909 Write_Info_Char
(' ');
910 Write_Info_Str
(Name_Buffer
(1 .. Name_Len
- 2));
913 -- If Source_Reference pragma used output information
915 if Num_SRef_Pragmas
(Sind
) > 0 then
916 Write_Info_Char
(' ');
918 if Num_SRef_Pragmas
(Sind
) = 1 then
919 Write_Info_Nat
(Int
(First_Mapped_Line
(Sind
)));
924 Write_Info_Char
(':');
925 Write_Info_Name
(Reference_Name
(Sind
));
928 -- Case where there is no source index (happens for missing files)
929 -- Also come here for non-dependent units.
932 Write_Info_Name
(Unit_File_Name
(Unum
));
934 Write_Info_Str
(String (Dummy_Time_Stamp
));
935 Write_Info_Char
(' ');
936 Write_Info_Str
(Get_Hex_String
(0));
944 Write_Info_Terminate
;
945 Close_Output_Library_Info
;