1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2024, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
29 with ALI
.Util
; use ALI
.Util
;
30 with Binderr
; use Binderr
;
31 with Butil
; use Butil
;
33 with Fname
; use Fname
;
34 with Gnatvsn
; use Gnatvsn
;
35 with Make_Util
; use Make_Util
;
36 with Namet
; use Namet
;
38 with Osint
; use Osint
;
39 with Osint
.L
; use Osint
.L
;
40 with Output
; use Output
;
41 with Rident
; use Rident
;
45 with Switch
; use Switch
;
46 with Types
; use Types
;
49 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
50 with GNAT
.Command_Line
; use GNAT
.Command_Line
;
51 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
52 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
55 pragma Ident
(Gnat_Static_Version_String
);
57 -- NOTE : The following string may be used by other tools, such as
58 -- GNAT Studio. So it can only be modified if these other uses are checked
61 Project_Search_Path
: constant String := "Project Search Path:";
62 -- Label displayed in verbose mode before the directories in the project
63 -- search path. Do not modify without checking NOTE above.
65 Prj_Path
: String_Access
;
67 Max_Column
: constant := 80;
69 No_Obj
: aliased String := "<no_obj>";
71 No_Runtime
: Boolean := False;
72 -- Set to True if there is no default runtime and --RTS= is not specified
75 OK
, -- matching timestamp
76 Checksum_OK
, -- only matching checksum
77 Not_Found
, -- file not found on source PATH
78 Not_Same
, -- neither checksum nor timestamp matching
79 Not_First_On_PATH
); -- matching file hidden by Not_Same file on path
82 type Dir_Ref
is access Dir_Data
;
84 type Dir_Data
is record
85 Value
: String_Access
;
88 -- Simply linked list of dirs
90 First_Source_Dir
: Dir_Ref
;
91 Last_Source_Dir
: Dir_Ref
;
92 -- The list of source directories from the command line.
93 -- These directories are added using Osint.Add_Src_Search_Dir
94 -- after those of the GNAT Project File, if any.
96 First_Lib_Dir
: Dir_Ref
;
97 Last_Lib_Dir
: Dir_Ref
;
98 -- The list of object directories from the command line.
99 -- These directories are added using Osint.Add_Lib_Search_Dir
100 -- after those of the GNAT Project File, if any.
102 Main_File
: File_Name_Type
;
103 Ali_File
: File_Name_Type
;
104 Text
: Text_Buffer_Ptr
;
107 Too_Long
: Boolean := False;
108 -- When True, lines are too long for multi-column output and each
109 -- item of information is on a different line.
111 Selective_Output
: Boolean := False;
112 Print_Usage
: Boolean := False;
113 Print_Unit
: Boolean := True;
114 Print_Source
: Boolean := True;
115 Print_Object
: Boolean := True;
116 -- Flags controlling the form of the output
118 Also_Predef
: Boolean := False; -- -a
119 Dependable
: Boolean := False; -- -d
120 License
: Boolean := False; -- -l
121 Very_Verbose_Mode
: Boolean := False; -- -V
122 -- Command line flags
124 Unit_Start
: Integer;
126 Source_Start
: Integer;
127 Source_End
: Integer;
128 Object_Start
: Integer;
129 Object_End
: Integer;
130 -- Various column starts and ends
132 Spaces
: constant String (1 .. Max_Column
) := (others => ' ');
134 RTS_Specified
: String_Access
:= null;
135 -- Used to detect multiple use of --RTS= switch
137 Exit_Status
: Exit_Code_Type
:= E_Success
;
138 -- Reset to E_Fatal if bad error found
140 -----------------------
141 -- Local Subprograms --
142 -----------------------
144 procedure Add_Lib_Dir
(Dir
: String);
145 -- Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
147 procedure Add_Source_Dir
(Dir
: String);
148 -- Add a source directory in the list First_Source_Dir-Last_Source_Dir
150 procedure Find_General_Layout
;
151 -- Determine the structure of the output (multi columns or not, etc)
153 procedure Find_Status
154 (FS
: in out File_Name_Type
;
155 Stamp
: Time_Stamp_Type
;
157 Status
: out File_Status
);
158 -- Determine the file status (Status) of the file represented by FS with
159 -- the expected Stamp and checksum given as argument. FS will be updated
160 -- to the full file name if available.
162 function Corresponding_Sdep_Entry
(A
: ALI_Id
; U
: Unit_Id
) return Sdep_Id
;
163 -- Give the Sdep entry corresponding to the unit U in ali record A
165 procedure Output_Object
(O
: File_Name_Type
);
166 -- Print out the name of the object when requested
168 procedure Output_Source
(Sdep_I
: Sdep_Id
);
169 -- Print out the name and status of the source corresponding to this
172 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean);
173 -- Print out FS either in a coded form if verbose is false or in an
174 -- expanded form otherwise.
176 procedure Output_Unit
(ALI
: ALI_Id
; U_Id
: Unit_Id
);
177 -- Print out information on the unit when requested
179 procedure Reset_Print
;
180 -- Reset Print flags properly when selective output is chosen
182 procedure Scan_Ls_Arg
(Argv
: String);
183 -- Scan and process user specific arguments (Argv is a single argument)
185 procedure Search_RTS
(Name
: String);
186 -- Find include and objects path for the RTS name.
189 -- Print usage message
191 procedure Output_License_Information
;
192 -- Output license statement, and if not found, output reference to COPYING
194 function Image
(Restriction
: Restriction_Id
) return String;
195 -- Returns the capitalized image of Restriction
197 function Normalize
(Path
: String) return String;
198 -- Returns a normalized path name. On Windows, the directory separators are
199 -- set to '\' in Normalize_Pathname.
201 ------------------------------------------
202 -- GNATDIST specific output subprograms --
203 ------------------------------------------
207 -- Any modification to this subunit requires synchronization with the
210 procedure Output_ALI
(A
: ALI_Id
);
211 -- Comment required saying what this routine does ???
213 procedure Output_No_ALI
(Afile
: File_Name_Type
);
214 -- Comments required saying what this routine does ???
218 ------------------------------
219 -- Support for project path --
220 ------------------------------
224 procedure Initialize_Default_Project_Path
225 (Self
: in out String_Access
;
226 Target_Name
: String;
227 Runtime_Name
: String := "");
228 -- Initialize Self. It will then contain the default project path on
229 -- the given target and runtime (including directories specified by the
230 -- environment variables GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH and
231 -- ADA_PROJECT_PATH). If one of the directory or Target_Name is "-",
232 -- then the path contains only those directories specified by the
233 -- environment variables (except "-"). This does nothing if Self has
234 -- already been initialized.
236 procedure Add_Directories
237 (Self
: in out String_Access
;
239 -- Add one or more directories to the path. Directories added with this
240 -- procedure are added in order after the current directory and before
241 -- the path given by the environment variable GPR_PROJECT_PATH. A value
242 -- of "-" will remove the default project directory from the project
245 -- Calls to this subprogram must be performed before the first call to
246 -- Find_Project below, or PATH will be added at the end of the search
249 function Get_Runtime_Path
250 (Self
: String_Access
;
251 Path
: String) return String_Access
;
252 -- Compute the full path for the project-based runtime name.
253 -- Path is simply searched on the project path.
261 procedure Add_Lib_Dir
(Dir
: String) is
263 if First_Lib_Dir
= null then
266 (Value => new String'(Dir
),
268 Last_Lib_Dir
:= First_Lib_Dir
;
273 (Value => new String'(Dir
),
275 Last_Lib_Dir
:= Last_Lib_Dir
.Next
;
283 procedure Add_Source_Dir
(Dir
: String) is
285 if First_Source_Dir
= null then
288 (Value => new String'(Dir
),
290 Last_Source_Dir
:= First_Source_Dir
;
293 Last_Source_Dir
.Next
:=
295 (Value => new String'(Dir
),
297 Last_Source_Dir
:= Last_Source_Dir
.Next
;
301 ------------------------------
302 -- Corresponding_Sdep_Entry --
303 ------------------------------
305 function Corresponding_Sdep_Entry
307 U
: Unit_Id
) return Sdep_Id
310 for D
in ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
loop
311 if Sdep
.Table
(D
).Sfile
= Units
.Table
(U
).Sfile
then
316 Error_Msg_Unit_1
:= Units
.Table
(U
).Uname
;
317 Error_Msg_File_1
:= ALIs
.Table
(A
).Afile
;
319 Error_Msg
("wrong ALI format, can't find dependency line for $ in {");
320 Exit_Program
(E_Fatal
);
321 end Corresponding_Sdep_Entry
;
323 -------------------------
324 -- Find_General_Layout --
325 -------------------------
327 procedure Find_General_Layout
is
328 Max_Unit_Length
: Integer := 11;
329 Max_Src_Length
: Integer := 11;
330 Max_Obj_Length
: Integer := 11;
336 -- Compute maximum of each column
338 for Id
in ALIs
.First
.. ALIs
.Last
loop
339 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
340 if Also_Predef
or else not Is_Internal_Unit
then
344 Max_Unit_Length
:= Integer'Max (Max_Unit_Length
, Len
);
348 FS
:= Full_Source_Name
(ALIs
.Table
(Id
).Sfile
);
351 Get_Name_String
(ALIs
.Table
(Id
).Sfile
);
352 Name_Len
:= Name_Len
+ 13;
354 Get_Name_String
(FS
);
357 Max_Src_Length
:= Integer'Max (Max_Src_Length
, Name_Len
+ 1);
361 if ALIs
.Table
(Id
).No_Object
then
363 Integer'Max (Max_Obj_Length
, No_Obj
'Length);
365 Get_Name_String
(ALIs
.Table
(Id
).Ofile_Full_Name
);
366 Max_Obj_Length
:= Integer'Max (Max_Obj_Length
, Name_Len
+ 1);
372 -- Verify is output is not wider than maximum number of columns
377 (Max_Unit_Length
+ Max_Src_Length
+ Max_Obj_Length
) > Max_Column
;
379 -- Set start and end of columns
382 Object_End
:= Object_Start
- 1;
385 Object_End
:= Object_Start
+ Max_Obj_Length
;
388 Unit_Start
:= Object_End
+ 1;
389 Unit_End
:= Unit_Start
- 1;
392 Unit_End
:= Unit_Start
+ Max_Unit_Length
;
395 Source_Start
:= Unit_End
+ 1;
397 if Source_Start
> Spaces
'Last then
398 Source_Start
:= Spaces
'Last;
401 Source_End
:= Source_Start
- 1;
404 Source_End
:= Source_Start
+ Max_Src_Length
;
406 end Find_General_Layout
;
412 procedure Find_Status
413 (FS
: in out File_Name_Type
;
414 Stamp
: Time_Stamp_Type
;
416 Status
: out File_Status
)
418 Tmp1
: File_Name_Type
;
419 Tmp2
: File_Name_Type
;
422 Tmp1
:= Full_Source_Name
(FS
);
424 if Tmp1
= No_File
then
427 elsif File_Stamp
(Tmp1
) = Stamp
then
431 elsif Checksums_Match
(Get_File_Checksum
(FS
), Checksum
) then
433 Status
:= Checksum_OK
;
436 Tmp2
:= Matching_Full_Source_Name
(FS
, Stamp
);
438 if Tmp2
= No_File
then
443 Status
:= Not_First_On_PATH
;
453 package body GNATDIST
is
456 N_Indents
: Natural := 0;
487 Image
: constant array (Token_Type
) of String_Access
:=
488 (T_No_ALI
=> new String'("No_ALI"),
489 T_ALI => new String'("ALI"),
490 T_Unit
=> new String'("Unit"),
491 T_With => new String'("With"),
492 T_Source
=> new String'("Source"),
493 T_Afile => new String'("Afile"),
494 T_Ofile
=> new String'("Ofile"),
495 T_Sfile => new String'("Sfile"),
496 T_Name
=> new String'("Name"),
497 T_Main => new String'("Main"),
498 T_Kind
=> new String'("Kind"),
499 T_Flags => new String'("Flags"),
500 T_Preelaborated
=> new String'("Preelaborated"),
501 T_Pure => new String'("Pure"),
502 T_Has_RACW
=> new String'("Has_RACW"),
503 T_Remote_Types => new String'("Remote_Types"),
504 T_Shared_Passive
=> new String'("Shared_Passive"),
505 T_RCI => new String'("RCI"),
506 T_Predefined
=> new String'("Predefined"),
507 T_Internal => new String'("Internal"),
508 T_Is_Generic
=> new String'("Is_Generic"),
509 T_Procedure => new String'("procedure"),
510 T_Function
=> new String'("function"),
511 T_Package => new String'("package"),
512 T_Subprogram
=> new String'("subprogram"),
513 T_Spec => new String'("spec"),
514 T_Body
=> new String'("body"));
516 procedure Output_Name (N : Name_Id);
517 -- Remove any encoding info (%b and %s) and output N
519 procedure Output_Afile (A : File_Name_Type);
520 procedure Output_Ofile (O : File_Name_Type);
521 procedure Output_Sfile (S : File_Name_Type);
522 -- Output various names. Check that the name is different from no name.
523 -- Otherwise, skip the output.
525 procedure Output_Token (T : Token_Type);
526 -- Output token using specific format. That is several indentations and:
528 -- T_No_ALI .. T_With : <token> & " =>" & NL
529 -- T_Source .. T_Kind : <token> & " => "
530 -- T_Flags : <token> & " =>"
531 -- T_Preelab .. T_Body : " " & <token>
533 procedure Output_Sdep (S : Sdep_Id);
534 procedure Output_Unit (U : Unit_Id);
535 procedure Output_With (W : With_Id);
536 -- Output this entry as a global section (like ALIs)
542 procedure Output_Afile (A : File_Name_Type) is
545 Output_Token (T_Afile);
555 procedure Output_ALI (A : ALI_Id) is
557 Output_Token (T_ALI);
558 N_Indents := N_Indents + 1;
560 Output_Afile (ALIs.Table (A).Afile);
561 Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
562 Output_Sfile (ALIs.Table (A).Sfile);
566 if ALIs.Table (A).Main_Program /= None then
567 Output_Token (T_Main);
569 if ALIs.Table (A).Main_Program = Proc then
570 Output_Token (T_Procedure);
572 Output_Token (T_Function);
580 for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
586 for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
590 N_Indents := N_Indents - 1;
597 procedure Output_No_ALI (Afile : File_Name_Type) is
599 Output_Token (T_No_ALI);
600 N_Indents := N_Indents + 1;
601 Output_Afile (Afile);
602 N_Indents := N_Indents - 1;
609 procedure Output_Name (N : Name_Id) is
611 -- Remove any encoding info (%s or %b)
616 and then Name_Buffer (Name_Len - 1) = '%'
618 Name_Len := Name_Len - 2;
621 Output_Token (T_Name);
622 Write_Str (Name_Buffer (1 .. Name_Len));
630 procedure Output_Ofile (O : File_Name_Type) is
633 Output_Token (T_Ofile);
643 procedure Output_Sdep (S : Sdep_Id) is
645 Output_Token (T_Source);
646 Write_Name (Sdep.Table (S).Sfile);
654 procedure Output_Sfile (S : File_Name_Type) is
655 FS : File_Name_Type := S;
658 if FS /= No_File then
660 -- We want to output the full source name
662 FS := Full_Source_Name (FS);
664 -- There is no full source name. This occurs for instance when a
665 -- withed unit has a spec file but no body file. This situation is
666 -- not a problem for GNATDIST since the unit may be located on a
667 -- partition we do not want to build. However, we need to locate
668 -- the spec file and to find its full source name. Replace the
669 -- body file name with the spec file name used to compile the
670 -- current unit when possible.
676 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
678 Name_Buffer (Name_Len) := 's
';
679 FS := Full_Source_Name (Name_Find);
684 if FS /= No_File then
685 Output_Token (T_Sfile);
695 procedure Output_Token (T : Token_Type) is
698 when T_No_ALI .. T_Flags =>
699 for J in 1 .. N_Indents loop
703 Write_Str (Image (T).all);
705 for J in Image (T)'Length .. 12 loop
711 if T in T_No_ALI .. T_With then
713 elsif T in T_Source .. T_Name then
717 when T_Preelaborated .. T_Body =>
718 if T in T_Preelaborated .. T_Is_Generic then
720 Output_Token (T_Flags);
723 N_Flags := N_Flags + 1;
727 Write_Str (Image (T).all);
735 procedure Output_Unit (U : Unit_Id) is
737 Output_Token (T_Unit);
738 N_Indents := N_Indents + 1;
742 Output_Name (Name_Id (Units.Table (U).Uname));
746 Output_Token (T_Kind);
748 if Units.Table (U).Unit_Kind = 'p
' then
749 Output_Token (T_Package);
751 Output_Token (T_Subprogram);
754 if Name_Buffer (Name_Len) = 's
' then
755 Output_Token (T_Spec);
757 Output_Token (T_Body);
762 -- Output source file name
764 Output_Sfile (Units.Table (U).Sfile);
770 if Units.Table (U).Preelab then
771 Output_Token (T_Preelaborated);
774 if Units.Table (U).Pure then
775 Output_Token (T_Pure);
778 if Units.Table (U).Has_RACW then
779 Output_Token (T_Has_RACW);
782 if Units.Table (U).Remote_Types then
783 Output_Token (T_Remote_Types);
786 if Units.Table (U).Shared_Passive then
787 Output_Token (T_Shared_Passive);
790 if Units.Table (U).RCI then
791 Output_Token (T_RCI);
794 if Units.Table (U).Predefined then
795 Output_Token (T_Predefined);
798 if Units.Table (U).Internal then
799 Output_Token (T_Internal);
802 if Units.Table (U).Is_Generic then
803 Output_Token (T_Is_Generic);
812 for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
816 N_Indents := N_Indents - 1;
823 procedure Output_With (W : With_Id) is
825 Output_Token (T_With);
826 N_Indents := N_Indents + 1;
828 Output_Name (Name_Id (Withs.Table (W).Uname));
832 Output_Token (T_Kind);
834 if Name_Buffer (Name_Len) = 's
' then
835 Output_Token (T_Spec);
837 Output_Token (T_Body);
842 Output_Afile (Withs.Table (W).Afile);
843 Output_Sfile (Withs.Table (W).Sfile);
845 N_Indents := N_Indents - 1;
854 function Image (Restriction : Restriction_Id) return String is
855 Result : String := Restriction'Img;
856 Skip : Boolean := True;
859 for J in Result'Range loop
862 Result (J) := To_Upper (Result (J));
864 elsif Result (J) = '_
' then
868 Result (J) := To_Lower (Result (J));
879 function Normalize (Path : String) return String is
881 return Normalize_Pathname (Path);
884 --------------------------------
885 -- Output_License_Information --
886 --------------------------------
888 procedure Output_License_Information is
892 Write_Str ("Please refer to file COPYING in your distribution"
893 & " for license terms.");
896 end Output_License_Information;
902 procedure Output_Object (O : File_Name_Type) is
903 Object_Name : String_Access;
909 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
911 Object_Name := No_Obj'Unchecked_Access;
914 Write_Str (Object_Name.all);
916 if Print_Source or else Print_Unit then
922 (Object_Start + Object_Name'Length .. Object_End));
932 procedure Output_Source (Sdep_I : Sdep_Id) is
933 Stamp : Time_Stamp_Type;
936 Status : File_Status;
937 Object_Name : String_Access;
940 if Sdep_I = No_Sdep_Id then
944 Stamp := Sdep.Table (Sdep_I).Stamp;
945 Checksum := Sdep.Table (Sdep_I).Checksum;
946 FS := Sdep.Table (Sdep_I).Sfile;
949 Find_Status (FS, Stamp, Checksum, Status);
950 Get_Name_String (FS);
952 Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
955 Write_Str (" Source => ");
956 Write_Str (Object_Name.all);
960 (Spaces (Source_Start + Object_Name'Length .. Source_End));
963 Output_Status (Status, Verbose => True);
968 if not Selective_Output then
969 Output_Status (Status, Verbose => False);
972 Write_Str (Object_Name.all);
981 procedure Output_Status (FS : File_Status; Verbose : Boolean) is
986 Write_Str (" unchanged");
989 Write_Str (" slightly modified");
992 Write_Str (" file not found");
995 Write_Str (" modified");
997 when Not_First_On_PATH =>
998 Write_Str (" unchanged version not first on PATH");
1007 Write_Str (" MOK ");
1010 Write_Str (" ??? ");
1013 Write_Str (" DIF ");
1015 when Not_First_On_PATH =>
1016 Write_Str (" HID ");
1025 procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
1027 U : Unit_Record renames Units.Table (U_Id);
1031 Get_Name_String (U.Uname);
1032 Kind := Name_Buffer (Name_Len);
1033 Name_Len := Name_Len - 2;
1035 if not Verbose_Mode then
1036 Write_Str (Name_Buffer (1 .. Name_Len));
1039 Write_Str ("Unit => ");
1041 Write_Str (" Name => ");
1042 Write_Str (Name_Buffer (1 .. Name_Len));
1044 Write_Str (" Kind => ");
1046 if Units.Table (U_Id).Unit_Kind = 'p
' then
1047 Write_Str ("package ");
1049 Write_Str ("subprogram ");
1059 if Verbose_Mode then
1060 if U.Preelab or else
1063 U.Dynamic_Elab or else
1065 U.Remote_Types or else
1066 U.Shared_Passive or else
1068 U.Predefined or else
1070 U.Is_Generic or else
1071 U.Init_Scalars or else
1072 U.SAL_Interface or else
1073 U.Body_Needed_For_SAL or else
1077 Write_Str (" Flags =>");
1080 Write_Str (" Preelaborable");
1084 Write_Str (" No_Elab_Code");
1088 Write_Str (" Pure");
1091 if U.Dynamic_Elab then
1092 Write_Str (" Dynamic_Elab");
1096 Write_Str (" Has_RACW");
1099 if U.Remote_Types then
1100 Write_Str (" Remote_Types");
1103 if U.Shared_Passive then
1104 Write_Str (" Shared_Passive");
1111 if U.Predefined then
1112 Write_Str (" Predefined");
1116 Write_Str (" Internal");
1119 if U.Is_Generic then
1120 Write_Str (" Is_Generic");
1123 if U.Init_Scalars then
1124 Write_Str (" Init_Scalars");
1127 if U.SAL_Interface then
1128 Write_Str (" SAL_Interface");
1131 if U.Body_Needed_For_SAL then
1132 Write_Str (" Body_Needed_For_SAL");
1135 if U.Elaborate_Body then
1136 Write_Str (" Elaborate Body");
1139 if U.Remote_Types then
1140 Write_Str (" Remote_Types");
1143 if U.Shared_Passive then
1144 Write_Str (" Shared_Passive");
1147 if U.Predefined then
1148 Write_Str (" Predefined");
1153 Restrictions : constant Restrictions_Info :=
1154 ALIs.Table (ALI).Restrictions;
1157 -- If the source was compiled with pragmas Restrictions,
1158 -- Display these restrictions.
1160 if Restrictions.Set /= (All_Restrictions => False) then
1162 Write_Str (" pragma Restrictions =>");
1164 -- For boolean restrictions, just display the name of the
1165 -- restriction; for valued restrictions, also display the
1166 -- restriction value.
1168 for Restriction in All_Restrictions loop
1169 if Restrictions.Set (Restriction) then
1172 Write_Str (Image (Restriction));
1174 if Restriction in All_Parameter_Restrictions then
1176 Write_Str (Restrictions.Value (Restriction)'Img);
1182 -- If the unit violates some Restrictions, display the list of
1183 -- these restrictions.
1185 if Restrictions.Violated /= (All_Restrictions => False) then
1187 Write_Str (" Restrictions violated =>");
1189 -- For boolean restrictions, just display the name of the
1190 -- restriction. For valued restrictions, also display the
1191 -- restriction value.
1193 for Restriction in All_Restrictions loop
1194 if Restrictions.Violated (Restriction) then
1197 Write_Str (Image (Restriction));
1199 if Restriction in All_Parameter_Restrictions then
1200 if Restrictions.Count (Restriction) > 0 then
1203 if Restrictions.Unknown (Restriction) then
1204 Write_Str (" at least");
1207 Write_Str (Restrictions.Count (Restriction)'Img);
1216 if Print_Source then
1221 Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
1227 package body Prj_Env is
1229 Uninitialized_Prefix : constant String := '#
' & Path_Separator;
1230 -- Prefix to indicate that the project path has not been initialized
1231 -- yet. Must be two characters long.
1233 ---------------------
1234 -- Add_Directories --
1235 ---------------------
1237 procedure Add_Directories
1238 (Self : in out String_Access;
1241 Tmp : String_Access;
1245 Self := new String'(Uninitialized_Prefix
& Path
);
1248 Self
:= new String'(Tmp.all & Path_Separator & Path);
1251 end Add_Directories;
1253 -------------------------------------
1254 -- Initialize_Default_Project_Path --
1255 -------------------------------------
1257 procedure Initialize_Default_Project_Path
1258 (Self : in out String_Access;
1259 Target_Name : String;
1260 Runtime_Name : String := "")
1262 Add_Default_Dir : Boolean := Target_Name /= "-";
1266 Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
1267 Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
1268 Gpr_Project_Path_File : constant String := "GPR_PROJECT_PATH_FILE";
1269 -- Names of alternate env. variables that contain path name(s) of
1270 -- directories where project files may reside. They are taken into
1271 -- account in this order: GPR_PROJECT_PATH_FILE, GPR_PROJECT_PATH,
1272 -- ADA_PROJECT_PATH.
1274 Gpr_Prj_Path_File : String_Access;
1275 Gpr_Prj_Path : String_Access;
1276 Ada_Prj_Path : String_Access;
1277 -- The path name(s) of directories where project files may reside.
1280 Prefix : String_Ptr;
1281 Runtime : String_Ptr;
1283 procedure Add_Target (Suffix : String);
1284 -- Add :<prefix>/<target>/Suffix to the project path
1286 FD : File_Descriptor;
1293 procedure Add_Target (Suffix : String) is
1294 Extra_Sep : constant String :=
1295 (if Target_Name (Target_Name'Last) = '/' then
1298 (1 => Directory_Separator));
1299 -- Note: Target_Name has a trailing / when it comes from Sdefault
1302 Add_Str_To_Name_Buffer
1303 (Path_Separator & Prefix.all & Target_Name & Extra_Sep & Suffix);
1306 -- Start of processing for Initialize_Default_Project_Path
1310 and then (Self'Length = 0
1311 or else Self (Self'First) /= '#
')
1316 -- The current directory is always first in the search path. Since
1317 -- the Project_Path currently starts with '#
:' as a sign that it is
1318 -- not initialized, we simply replace '#
' with '.'
1321 Self := new String'('.' & Path_Separator
);
1323 Self
(Self
'First) := '.';
1326 -- Then the reset of the project path (if any) currently contains the
1327 -- directories added through Add_Search_Project_Directory
1329 -- If environment variables are defined and not empty, add their
1332 Gpr_Prj_Path_File
:= Getenv
(Gpr_Project_Path_File
);
1333 Gpr_Prj_Path
:= Getenv
(Gpr_Project_Path
);
1334 Ada_Prj_Path
:= Getenv
(Ada_Project_Path
);
1336 if Gpr_Prj_Path_File
.all /= "" then
1337 FD
:= Open_Read
(Gpr_Prj_Path_File
.all, GNAT
.OS_Lib
.Text
);
1339 if FD
/= Invalid_FD
then
1340 Len
:= Integer (File_Length
(FD
));
1343 Buffer
: String (1 .. Len
);
1344 Index
: Positive := 1;
1346 Tmp
: String_Access
;
1351 Len
:= Read
(FD
, Buffer
(1)'Address, Len
);
1354 -- Scan the file line by line
1356 while Index
< Buffer
'Last loop
1358 -- Find the end of line
1361 while Last
<= Buffer
'Last
1362 and then Buffer
(Last
) /= ASCII
.LF
1363 and then Buffer
(Last
) /= ASCII
.CR
1368 -- Ignore empty lines
1370 if Last
> Index
then
1374 (Tmp.all & Path_Separator &
1375 Buffer (Index .. Last - 1));
1379 -- Find the beginning of the next line
1382 while Buffer (Index) = ASCII.CR or else
1383 Buffer (Index) = ASCII.LF
1393 if Gpr_Prj_Path.all /= "" then
1394 Add_Directories (Self, Gpr_Prj_Path.all);
1397 Free (Gpr_Prj_Path);
1399 if Ada_Prj_Path.all /= "" then
1400 Add_Directories (Self, Ada_Prj_Path.all);
1403 Free (Ada_Prj_Path);
1405 -- Copy to Name_Buffer, since we will need to manipulate the path
1407 Name_Len := Self'Length;
1408 Name_Buffer (1 .. Name_Len) := Self.all;
1410 -- Scan the directory path to see if "-" is one of the directories.
1411 -- Remove each occurrence of "-" and set Add_Default_Dir to False.
1412 -- Also resolve relative paths and symbolic links.
1416 while First <= Name_Len
1417 and then Name_Buffer (First) = Path_Separator
1422 exit when First > Name_Len;
1426 while Last < Name_Len
1427 and then Name_Buffer (Last + 1) /= Path_Separator
1432 -- If the directory is "-", set Add_Default_Dir to False and
1433 -- remove from path.
1435 if Name_Buffer (First .. Last) = "-" then
1436 Add_Default_Dir := False;
1438 for J in Last + 1 .. Name_Len loop
1439 Name_Buffer (J - 2) := Name_Buffer (J);
1442 Name_Len := Name_Len - 2;
1444 -- After removing the '-', go back one character to get the
1445 -- next directory correctly.
1451 New_Dir : constant String :=
1453 (Name_Buffer (First .. Last),
1454 Resolve_Links => Opt.Follow_Links_For_Dirs);
1456 New_Last : Positive;
1459 -- If the absolute path was resolved and is different from
1460 -- the original, replace original with the resolved path.
1462 if New_Dir /= Name_Buffer (First .. Last)
1463 and then New_Dir'Length /= 0
1465 New_Len := Name_Len + New_Dir'Length - (Last - First + 1);
1466 New_Last := First + New_Dir'Length - 1;
1467 Name_Buffer (New_Last + 1 .. New_Len) :=
1468 Name_Buffer (Last + 1 .. Name_Len);
1469 Name_Buffer (First .. New_Last) := New_Dir;
1470 Name_Len := New_Len;
1481 -- Set the initial value of Current_Project_Path
1483 if Add_Default_Dir then
1484 if Sdefault.Search_Dir_Prefix = null then
1488 Prefix := new String'(Executable_Prefix_Path
);
1491 Prefix
:= new String'(Sdefault.Search_Dir_Prefix.all
1492 & ".." & Dir_Separator
1493 & ".." & Dir_Separator
1494 & ".." & Dir_Separator
1495 & ".." & Dir_Separator);
1498 if Prefix.all /= "" then
1499 if Target_Name /= "" then
1501 if Runtime_Name /= "" then
1502 if Base_Name (Runtime_Name) = Runtime_Name then
1504 -- $prefix/$target/$runtime/lib/gnat
1507 (Runtime_Name & Directory_Separator &
1508 "lib" & Directory_Separator & "gnat");
1510 -- $prefix/$target/$runtime/share/gpr
1513 (Runtime_Name & Directory_Separator &
1514 "share" & Directory_Separator & "gpr");
1518 new String'(Normalize_Pathname
(Runtime_Name
));
1520 -- $runtime_dir/lib/gnat
1522 Add_Str_To_Name_Buffer
1523 (Path_Separator
& Runtime
.all & Directory_Separator
&
1524 "lib" & Directory_Separator
& "gnat");
1526 -- $runtime_dir/share/gpr
1528 Add_Str_To_Name_Buffer
1529 (Path_Separator
& Runtime
.all & Directory_Separator
&
1530 "share" & Directory_Separator
& "gpr");
1534 -- $prefix/$target/lib/gnat
1537 ("lib" & Directory_Separator
& "gnat");
1539 -- $prefix/$target/share/gpr
1542 ("share" & Directory_Separator
& "gpr");
1545 -- $prefix/share/gpr
1547 Add_Str_To_Name_Buffer
1548 (Path_Separator
& Prefix
.all & "share"
1549 & Directory_Separator
& "gpr");
1553 Add_Str_To_Name_Buffer
1554 (Path_Separator
& Prefix
.all & "lib"
1555 & Directory_Separator
& "gnat");
1561 Self
:= new String'(Name_Buffer (1 .. Name_Len));
1562 end Initialize_Default_Project_Path;
1564 -----------------------
1565 -- Get_Runtime_Path --
1566 -----------------------
1568 function Get_Runtime_Path
1569 (Self : String_Access;
1570 Path : String) return String_Access
1577 if Is_Absolute_Path (Path) then
1578 if Is_Directory (Path) then
1579 return new String'(Path
);
1585 -- Because we do not want to resolve symbolic links, we cannot
1586 -- use Locate_Regular_File. Instead we try each possible path
1589 First
:= Self
'First;
1590 while First
<= Self
'Last loop
1591 while First
<= Self
'Last
1592 and then Self
(First
) = Path_Separator
1597 exit when First
> Self
'Last;
1600 while Last
< Self
'Last
1601 and then Self
(Last
+ 1) /= Path_Separator
1608 if not Is_Absolute_Path
(Self
(First
.. Last
)) then
1609 Add_Str_To_Name_Buffer
(Get_Current_Dir
); -- ??? System call
1610 Add_Char_To_Name_Buffer
(Directory_Separator
);
1613 Add_Str_To_Name_Buffer
(Self
(First
.. Last
));
1614 Add_Char_To_Name_Buffer
(Directory_Separator
);
1615 Add_Str_To_Name_Buffer
(Path
);
1617 if Is_Directory
(Name_Buffer
(1 .. Name_Len
)) then
1618 return new String'(Name_Buffer (1 .. Name_Len));
1626 end Get_Runtime_Path;
1634 procedure Reset_Print is
1636 if not Selective_Output then
1637 Selective_Output := True;
1638 Print_Source := False;
1639 Print_Object := False;
1640 Print_Unit := False;
1648 procedure Search_RTS (Name : String) is
1649 Src_Path : String_Ptr;
1650 Lib_Path : String_Ptr;
1651 -- Paths for source and include subdirs
1653 Rts_Full_Path : String_Access;
1654 -- Full path for RTS project
1657 -- Try to find the RTS
1659 Src_Path := Get_RTS_Search_Dir (Name, Include);
1660 Lib_Path := Get_RTS_Search_Dir (Name, Objects);
1662 -- For non-project RTS, both the include and the objects directories
1665 if Src_Path /= null and then Lib_Path /= null then
1666 Add_Search_Dirs (Src_Path, Include);
1667 Add_Search_Dirs (Lib_Path, Objects);
1668 Prj_Env.Initialize_Default_Project_Path
1670 Target_Name => Sdefault.Target_Name.all,
1671 Runtime_Name => Name);
1675 if Lib_Path /= null then
1677 ("RTS path """ & Name
1678 & """ not valid: missing adainclude directory");
1679 elsif Src_Path /= null then
1681 ("RTS path """ & Name
1682 & """ not valid: missing adalib directory");
1685 -- Try to find the RTS on the project path. First setup the project path
1687 Prj_Env.Initialize_Default_Project_Path
1689 Target_Name => Sdefault.Target_Name.all,
1690 Runtime_Name => Name);
1692 Rts_Full_Path := Prj_Env.Get_Runtime_Path (Prj_Path, Name);
1694 if Rts_Full_Path /= null then
1696 -- Directory name was found on the project path. Look for the
1697 -- include subdirectory(s).
1699 Src_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Include);
1701 if Src_Path /= null then
1702 Add_Search_Dirs (Src_Path, Include);
1704 -- Add the lib subdirectory if it exists
1706 Lib_Path := Get_RTS_Search_Dir (Rts_Full_Path.all, Objects);
1708 if Lib_Path /= null then
1709 Add_Search_Dirs (Lib_Path, Objects);
1717 ("RTS path """ & Name
1718 & """ not valid: missing adainclude and adalib directories");
1725 procedure Scan_Ls_Arg (Argv : String) is
1726 FD : File_Descriptor;
1731 pragma Assert (Argv'First = 1);
1733 if Argv'Length = 0 then
1738 if Argv (1) = '-' then
1739 if Argv'Length = 1 then
1740 Fail ("switch character cannot be followed by a blank");
1742 -- Processing for -I-
1744 elsif Argv (2 .. Argv'Last) = "I-" then
1745 Opt.Look_In_Primary_Dir := False;
1747 -- Forbid -?- or -??- where ? is any character
1749 elsif (Argv'Length = 3 and then Argv (3) = '-')
1750 or else (Argv'Length = 4 and then Argv (4) = '-')
1752 Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");
1754 -- Processing for -Idir
1756 elsif Argv (2) = 'I
' then
1757 Add_Source_Dir (Argv (3 .. Argv'Last));
1758 Add_Lib_Dir (Argv (3 .. Argv'Last));
1760 -- Processing for -aIdir (to gcc this is like a -I switch)
1762 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
1763 Add_Source_Dir (Argv (4 .. Argv'Last));
1765 -- Processing for -aOdir
1767 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
1768 Add_Lib_Dir (Argv (4 .. Argv'Last));
1770 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
1772 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
1773 Add_Lib_Dir (Argv (4 .. Argv'Last));
1775 -- Processing for -aP<dir>
1777 elsif Argv'Length > 3 and then Argv (1 .. 3) = "-aP" then
1778 Prj_Env.Add_Directories (Prj_Path, Argv (4 .. Argv'Last));
1780 -- Processing for -nostdinc
1782 elsif Argv (2 .. Argv'Last) = "nostdinc" then
1783 Opt.No_Stdinc := True;
1785 -- Processing for one character switches
1787 elsif Argv'Length = 2 then
1789 when 'a
' => Also_Predef := True;
1790 when 'h
' => Print_Usage := True;
1791 when 'u
' => Reset_Print; Print_Unit := True;
1792 when 's
' => Reset_Print; Print_Source := True;
1793 when 'o
' => Reset_Print; Print_Object := True;
1794 when 'v
' => Verbose_Mode := True;
1795 when 'd
' => Dependable := True;
1796 when 'l
' => License := True;
1797 when 'V
' => Very_Verbose_Mode := True;
1799 when others => OK := False;
1802 -- Processing for -files=file
1804 elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
1805 FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
1807 if FD = Invalid_FD then
1808 Osint.Fail ("could not find text file """ &
1809 Argv (8 .. Argv'Last) & '"');
1812 Len := Integer (File_Length (FD));
1815 Buffer : String (1 .. Len + 1);
1816 Index : Positive := 1;
1822 Len := Read (FD, Buffer (1)'Address, Len);
1823 Buffer (Buffer'Last) := ASCII.NUL;
1826 -- Scan the file line by line
1828 while Index < Buffer'Last loop
1830 -- Find the end of line
1833 while Last <= Buffer'Last
1834 and then Buffer (Last) /= ASCII.LF
1835 and then Buffer (Last) /= ASCII.CR
1840 -- Ignore empty lines
1842 if Last > Index then
1843 Add_File (Buffer (Index .. Last - 1));
1846 -- Find the beginning of the next line
1849 while Buffer (Index) = ASCII.CR or else
1850 Buffer (Index) = ASCII.LF
1857 -- Processing for --RTS=path
1859 elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
1860 if Argv
'Length <= 6 or else Argv
(6) /= '='then
1861 Osint
.Fail
("missing path for --RTS");
1864 -- Check that it is the first time we see this switch or, if
1865 -- it is not the first time, the same path is specified.
1867 if RTS_Specified
= null then
1868 RTS_Specified
:= new String'(Argv (7 .. Argv'Last));
1870 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
1871 Osint.Fail ("--RTS cannot be specified multiple times");
1874 -- Valid --RTS switch
1876 Opt.No_Stdinc := True;
1877 Opt.RTS_Switch := True;
1884 -- If not a switch, it must be a file name
1891 Write_Str ("warning: unknown switch """);
1906 Write_Str ("Usage: ");
1907 Osint.Write_Program_Name;
1908 Write_Str (" switches [list of object files]");
1914 Write_Str ("switches:");
1917 Display_Usage_Version_And_Help;
1921 Write_Str (" -a also output relevant predefined units");
1926 Write_Str (" -u output only relevant unit names");
1931 Write_Str (" -h output this help message");
1936 Write_Str (" -s output only relevant source names");
1941 Write_Str (" -o output only relevant object names");
1946 Write_Str (" -d output sources on which specified units " &
1952 Write_Str (" -l output license information");
1957 Write_Str (" -v verbose output, full path and unit " &
1964 Write_Str (" -files=fil files are listed in text file 'fil
'");
1967 -- Line for -aI switch
1969 Write_Str (" -aIdir specify source files search path");
1972 -- Line for -aO switch
1974 Write_Str (" -aOdir specify object files search path");
1977 -- Line for -aP switch
1979 Write_Str (" -aPdir specify project search path");
1982 -- Line for -I switch
1984 Write_Str (" -Idir like -aIdir -aOdir");
1987 -- Line for -I- switch
1989 Write_Str (" -I- do not look for sources & object files");
1990 Write_Str (" in the default directory");
1993 -- Line for -nostdinc
1995 Write_Str (" -nostdinc do not look for source files");
1996 Write_Str (" in the system default directory");
2001 Write_Str (" --RTS=dir specify the default source and object search"
2005 -- File Status explanation
2008 Write_Str (" file status can be:");
2011 for ST in File_Status loop
2013 Output_Status (ST, Verbose => False);
2014 Write_Str (" ==> ");
2015 Output_Status (ST, Verbose => True);
2020 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
2022 -- Start of processing for Gnatls
2025 -- Initialize standard packages
2032 -- First check for --version or --help
2034 Check_Version_And_Help ("GNATLS", "1992");
2036 -- Loop to scan out arguments
2039 Scan_Args : while Next_Arg < Arg_Count loop
2041 Next_Argv : String (1 .. Len_Arg (Next_Arg));
2043 Fill_Arg (Next_Argv'Address, Next_Arg);
2044 Scan_Ls_Arg (Next_Argv);
2047 Next_Arg := Next_Arg + 1;
2050 -- If -l (output license information) is given, it must be the only switch
2053 if Arg_Count = 2 then
2054 Output_License_Information;
2058 Write_Str ("Can't use -l with another switch");
2061 Exit_Program (E_Fatal);
2065 -- Handle --RTS switch
2067 if RTS_Specified /= null then
2068 Search_RTS (RTS_Specified.all);
2071 -- Add the source and object directories specified on the command line, if
2072 -- any, to the searched directories.
2074 while First_Source_Dir /= null loop
2075 Add_Src_Search_Dir (First_Source_Dir.Value.all);
2076 First_Source_Dir := First_Source_Dir.Next;
2079 while First_Lib_Dir /= null loop
2080 Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
2081 First_Lib_Dir := First_Lib_Dir.Next;
2084 -- Finally, add the default directories
2086 Osint.Add_Default_Search_Dirs;
2088 -- If --RTS= is not specified, check if there is a default runtime
2090 if RTS_Specified = null then
2092 FD : File_Descriptor;
2093 Text : Source_Buffer_Ptr;
2097 Read_Source_File (Name_Find ("system.ads"), 0, Hi, Text, FD);
2099 if Null_Source_Buffer_Ptr (Text) then
2105 if Verbose_Mode then
2107 Display_Version ("GNATLS", "1997");
2112 ("Default runtime not available. Use --RTS= with a valid runtime");
2115 Exit_Status := E_Warnings;
2118 Write_Str ("Source Search Path:");
2121 for J in 1 .. Nb_Dir_In_Src_Search_Path loop
2124 if Dir_In_Src_Search_Path (J)'Length = 0 then
2125 Write_Str ("<Current_Directory>");
2128 elsif not No_Runtime then
2132 (Dir_In_Src_Search_Path (J).all, True).all));
2139 Write_Str ("Object Search Path:");
2142 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
2145 if Dir_In_Obj_Search_Path (J)'Length = 0 then
2146 Write_Str ("<Current_Directory>");
2149 elsif not No_Runtime then
2153 (Dir_In_Obj_Search_Path (J).all, True).all));
2160 Write_Str (Project_Search_Path);
2162 Write_Str (" <Current_Directory>");
2165 Prj_Env.Initialize_Default_Project_Path
2166 (Prj_Path, Target_Name => Sdefault.Target_Name.all);
2174 if Prj_Path.all /= "" then
2175 First := Prj_Path'First;
2177 while First <= Prj_Path'Last
2178 and then Prj_Path (First) = Path_Separator
2183 exit when First > Prj_Path'Last;
2186 while Last < Prj_Path'Last
2187 and then Prj_Path (Last + 1) /= Path_Separator
2192 if First /= Last or else Prj_Path (First) /= '.' then
2194 -- If the directory is ".", skip it as it is the current
2195 -- directory and it is already the first directory in the
2202 (Prj_Path (First .. Last), True).all));
2214 -- Output usage information when requested
2220 if not More_Lib_Files then
2221 if not Print_Usage and then not Verbose_Mode then
2222 if Arg_Count = 1 then
2226 Exit_Status := E_Fatal;
2230 Exit_Program (Exit_Status);
2234 Initialize_ALI_Source;
2236 -- Print out all libraries for which no ALI files can be located
2238 while More_Lib_Files loop
2239 Main_File := Next_Main_Lib_File;
2240 Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
2242 if Ali_File = No_File then
2243 if Very_Verbose_Mode then
2244 GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
2248 Write_Str ("Can't find library info for ");
2249 Get_Name_String (Main_File);
2250 Write_Char ('"'); -- "
2251 Write_Str
(Name_Buffer
(1 .. Name_Len
));
2252 Write_Char
('"'); -- "
2254 Exit_Status
:= E_Fatal
;
2258 Ali_File
:= Strip_Directory
(Ali_File
);
2260 if Get_Name_Table_Int
(Ali_File
) = 0 then
2261 Text
:= Read_Library_Info
(Ali_File
, True);
2271 Ignore_Errors
=> True);
2279 -- Reset default output file descriptor, if needed
2281 Set_Standard_Output
;
2283 if Very_Verbose_Mode
then
2284 for A
in ALIs
.First
.. ALIs
.Last
loop
2285 GNATDIST
.Output_ALI
(A
);
2291 Find_General_Layout
;
2293 for Id
in ALIs
.First
.. ALIs
.Last
loop
2298 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
2300 if Also_Predef
or else not Is_Internal_Unit
then
2301 if ALIs
.Table
(Id
).No_Object
then
2302 Output_Object
(No_File
);
2304 Output_Object
(ALIs
.Table
(Id
).Ofile_Full_Name
);
2307 -- In verbose mode print all main units in the ALI file, otherwise
2308 -- just print the first one to ease columnwise printout
2310 if Verbose_Mode
then
2311 Last_U
:= ALIs
.Table
(Id
).Last_Unit
;
2313 Last_U
:= ALIs
.Table
(Id
).First_Unit
;
2316 for U
in ALIs
.Table
(Id
).First_Unit
.. Last_U
loop
2317 if U
/= ALIs
.Table
(Id
).First_Unit
2318 and then Selective_Output
2324 Output_Unit
(Id
, U
);
2326 -- Output source now, unless if it will be done as part of
2327 -- outputing dependencies.
2329 if not (Dependable
and then Print_Source
) then
2330 Output_Source
(Corresponding_Sdep_Entry
(Id
, U
));
2334 -- Print out list of units on which this unit depends (D lines)
2336 if Dependable
and then Print_Source
then
2337 if Verbose_Mode
then
2338 Write_Str
("depends upon");
2346 ALIs
.Table
(Id
).First_Sdep
.. ALIs
.Table
(Id
).Last_Sdep
2349 or else not Is_Internal_File_Name
(Sdep
.Table
(D
).Sfile
)
2351 if Verbose_Mode
then
2361 Write_Str
(Spaces
(1 .. Source_Start
- 2));
2374 -- All done. Set proper exit status
2377 Exit_Program
(Exit_Status
);