1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
28 with ALI
.Util
; use ALI
.Util
;
29 with Binderr
; use Binderr
;
30 with Butil
; use Butil
;
31 with Csets
; use Csets
;
32 with Fname
; use Fname
;
33 with Gnatvsn
; use Gnatvsn
;
34 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
35 with Namet
; use Namet
;
37 with Osint
; use Osint
;
38 with Osint
.L
; use Osint
.L
;
39 with Output
; use Output
;
40 with Targparm
; use Targparm
;
41 with Types
; use Types
;
44 pragma Ident
(Gnat_Static_Version_String
);
46 Max_Column
: constant := 80;
49 OK
, -- matching timestamp
50 Checksum_OK
, -- only matching checksum
51 Not_Found
, -- file not found on source PATH
52 Not_Same
, -- neither checksum nor timestamp matching
53 Not_First_On_PATH
); -- matching file hidden by Not_Same file on path
56 type Dir_Ref
is access Dir_Data
;
58 type Dir_Data
is record
59 Value
: String_Access
;
64 First_Source_Dir
: Dir_Ref
;
65 Last_Source_Dir
: Dir_Ref
;
66 -- The list of source directories from the command line.
67 -- These directories are added using Osint.Add_Src_Search_Dir
68 -- after those of the GNAT Project File, if any.
70 First_Lib_Dir
: Dir_Ref
;
71 Last_Lib_Dir
: Dir_Ref
;
72 -- The list of object directories from the command line.
73 -- These directories are added using Osint.Add_Lib_Search_Dir
74 -- after those of the GNAT Project File, if any.
76 Main_File
: File_Name_Type
;
77 Ali_File
: File_Name_Type
;
79 Text
: Text_Buffer_Ptr
;
84 Too_Long
: Boolean := False;
85 -- When True, lines are too long for multi-column output and each
86 -- item of information is on a different line.
88 Selective_Output
: Boolean := False;
89 Print_Usage
: Boolean := False;
90 Print_Unit
: Boolean := True;
91 Print_Source
: Boolean := True;
92 Print_Object
: Boolean := True;
93 -- Flags controlling the form of the outpout
95 Dependable
: Boolean := False; -- flag -d
96 Also_Predef
: Boolean := False;
100 Source_Start
: Integer;
101 Source_End
: Integer;
102 Object_Start
: Integer;
103 Object_End
: Integer;
104 -- Various column starts and ends
106 Spaces
: constant String (1 .. Max_Column
) := (others => ' ');
108 RTS_Specified
: String_Access
:= null;
109 -- Used to detect multiple use of --RTS= switch
111 -----------------------
112 -- Local Subprograms --
113 -----------------------
115 procedure Add_Lib_Dir
(Dir
: String; And_Save
: Boolean);
116 -- Add an object directory, using Osint.Add_Lib_Search_Dir
117 -- if And_Save is False or keeping in the list First_Lib_Dir,
118 -- Last_Lib_Dir if And_Save is True.
120 procedure Add_Source_Dir
(Dir
: String; And_Save
: Boolean);
121 -- Add a source directory, using Osint.Add_Src_Search_Dir
122 -- if And_Save is False or keeping in the list First_Source_Dir,
123 -- Last_Source_Dir if And_Save is True.
125 procedure Find_General_Layout
;
126 -- Determine the structure of the output (multi columns or not, etc)
128 procedure Find_Status
129 (FS
: in out File_Name_Type
;
130 Stamp
: Time_Stamp_Type
;
132 Status
: out File_Status
);
133 -- Determine the file status (Status) of the file represented by FS
134 -- with the expected Stamp and checksum given as argument. FS will be
135 -- updated to the full file name if available.
137 function Corresponding_Sdep_Entry
(A
: ALI_Id
; U
: Unit_Id
) return Sdep_Id
;
138 -- Give the Sdep entry corresponding to the unit U in ali record A.
140 procedure Output_Object
(O
: File_Name_Type
);
141 -- Print out the name of the object when requested
143 procedure Output_Source
(Sdep_I
: Sdep_Id
);
144 -- Print out the name and status of the source corresponding to this
147 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean);
148 -- Print out FS either in a coded form if verbose is false or in an
149 -- expanded form otherwise.
151 procedure Output_Unit
(U_Id
: Unit_Id
);
152 -- Print out information on the unit when requested
154 procedure Reset_Print
;
155 -- Reset Print flags properly when selective output is chosen
157 procedure Scan_Ls_Arg
(Argv
: String; And_Save
: Boolean);
158 -- Scan and process lser specific arguments. Argv is a single argument.
161 -- Print usage message.
167 procedure Add_Lib_Dir
(Dir
: String; And_Save
: Boolean) is
170 if First_Lib_Dir
= null then
173 (Value => new String'(Dir
),
175 Last_Lib_Dir
:= First_Lib_Dir
;
180 (Value => new String'(Dir
),
182 Last_Lib_Dir
:= Last_Lib_Dir
.Next
;
186 Add_Lib_Search_Dir
(Dir
);
194 procedure Add_Source_Dir
(Dir
: String; And_Save
: Boolean) is
197 if First_Source_Dir
= null then
200 (Value => new String'(Dir
),
202 Last_Source_Dir
:= First_Source_Dir
;
205 Last_Source_Dir
.Next
:=
207 (Value => new String'(Dir
),
209 Last_Source_Dir
:= Last_Source_Dir
.Next
;
213 Add_Src_Search_Dir
(Dir
);
217 ------------------------------
218 -- Corresponding_Sdep_Entry --
219 ------------------------------
221 function Corresponding_Sdep_Entry
227 for D
in ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
loop
228 if Sdep
.Table
(D
).Sfile
= Units
.Table
(U
).Sfile
then
233 Error_Msg_Name_1
:= Units
.Table
(U
).Uname
;
234 Error_Msg_Name_2
:= ALIs
.Table
(A
).Afile
;
236 Error_Msg
("wrong ALI format, can't find dependency line for & in %");
237 Exit_Program
(E_Fatal
);
238 end Corresponding_Sdep_Entry
;
240 -------------------------
241 -- Find_General_Layout --
242 -------------------------
244 procedure Find_General_Layout
is
245 Max_Unit_Length
: Integer := 11;
246 Max_Src_Length
: Integer := 11;
247 Max_Obj_Length
: Integer := 11;
253 -- Compute maximum of each column
255 for Id
in ALIs
.First
.. ALIs
.Last
loop
257 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
258 if Also_Predef
or else not Is_Internal_Unit
then
262 Max_Unit_Length
:= Integer'Max (Max_Unit_Length
, Len
);
266 FS
:= Full_Source_Name
(ALIs
.Table
(Id
).Sfile
);
269 Get_Name_String
(ALIs
.Table
(Id
).Sfile
);
270 Name_Len
:= Name_Len
+ 13;
272 Get_Name_String
(FS
);
275 Max_Src_Length
:= Integer'Max (Max_Src_Length
, Name_Len
+ 1);
279 Get_Name_String
(ALIs
.Table
(Id
).Ofile_Full_Name
);
280 Max_Obj_Length
:= Integer'Max (Max_Obj_Length
, Name_Len
+ 1);
285 -- Verify is output is not wider than maximum number of columns
287 Too_Long
:= Verbose_Mode
or else
288 (Max_Unit_Length
+ Max_Src_Length
+ Max_Obj_Length
) > Max_Column
;
290 -- Set start and end of columns.
293 Object_End
:= Object_Start
- 1;
296 Object_End
:= Object_Start
+ Max_Obj_Length
;
299 Unit_Start
:= Object_End
+ 1;
300 Unit_End
:= Unit_Start
- 1;
303 Unit_End
:= Unit_Start
+ Max_Unit_Length
;
306 Source_Start
:= Unit_End
+ 1;
308 if Source_Start
> Spaces
'Last then
309 Source_Start
:= Spaces
'Last;
312 Source_End
:= Source_Start
- 1;
315 Source_End
:= Source_Start
+ Max_Src_Length
;
317 end Find_General_Layout
;
323 procedure Find_Status
324 (FS
: in out File_Name_Type
;
325 Stamp
: Time_Stamp_Type
;
327 Status
: out File_Status
)
329 Tmp1
: File_Name_Type
;
330 Tmp2
: File_Name_Type
;
333 Tmp1
:= Full_Source_Name
(FS
);
335 if Tmp1
= No_File
then
338 elsif File_Stamp
(Tmp1
) = Stamp
then
342 elsif Checksums_Match
(Get_File_Checksum
(FS
), Checksum
) then
344 Status
:= Checksum_OK
;
347 Tmp2
:= Matching_Full_Source_Name
(FS
, Stamp
);
349 if Tmp2
= No_File
then
354 Status
:= Not_First_On_PATH
;
364 procedure Output_Object
(O
: File_Name_Type
) is
365 Object_Name
: String_Access
;
370 Object_Name
:= To_Host_File_Spec
(Name_Buffer
(1 .. Name_Len
));
371 Write_Str
(Object_Name
.all);
373 if Print_Source
or else Print_Unit
then
379 (Object_Start
+ Object_Name
'Length .. Object_End
));
389 procedure Output_Source
(Sdep_I
: Sdep_Id
) is
390 Stamp
: constant Time_Stamp_Type
:= Sdep
.Table
(Sdep_I
).Stamp
;
391 Checksum
: constant Word
:= Sdep
.Table
(Sdep_I
).Checksum
;
392 FS
: File_Name_Type
:= Sdep
.Table
(Sdep_I
).Sfile
;
393 Status
: File_Status
;
394 Object_Name
: String_Access
;
398 Find_Status
(FS
, Stamp
, Checksum
, Status
);
399 Get_Name_String
(FS
);
401 Object_Name
:= To_Host_File_Spec
(Name_Buffer
(1 .. Name_Len
));
404 Write_Str
(" Source => ");
405 Write_Str
(Object_Name
.all);
409 (Spaces
(Source_Start
+ Object_Name
'Length .. Source_End
));
412 Output_Status
(Status
, Verbose
=> True);
417 if not Selective_Output
then
418 Output_Status
(Status
, Verbose
=> False);
421 Write_Str
(Object_Name
.all);
430 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean) is
435 Write_Str
(" unchanged");
438 Write_Str
(" slightly modified");
441 Write_Str
(" file not found");
444 Write_Str
(" modified");
446 when Not_First_On_PATH
=>
447 Write_Str
(" unchanged version not first on PATH");
464 when Not_First_On_PATH
=>
474 procedure Output_Unit
(U_Id
: Unit_Id
) is
476 U
: Unit_Record
renames Units
.Table
(U_Id
);
480 Get_Name_String
(U
.Uname
);
481 Kind
:= Name_Buffer
(Name_Len
);
482 Name_Len
:= Name_Len
- 2;
484 if not Verbose_Mode
then
485 Write_Str
(Name_Buffer
(1 .. Name_Len
));
488 Write_Str
("Unit => ");
489 Write_Eol
; Write_Str
(" Name => ");
490 Write_Str
(Name_Buffer
(1 .. Name_Len
));
491 Write_Eol
; Write_Str
(" Kind => ");
493 if Units
.Table
(U_Id
).Unit_Kind
= 'p' then
494 Write_Str
("package ");
496 Write_Str
("subprogram ");
516 Write_Eol
; Write_Str
(" Flags =>");
519 Write_Str
(" Preelaborable");
523 Write_Str
(" No_Elab_Code");
530 if U
.Elaborate_Body
then
531 Write_Str
(" Elaborate Body");
534 if U
.Remote_Types
then
535 Write_Str
(" Remote_Types");
538 if U
.Shared_Passive
then
539 Write_Str
(" Shared_Passive");
543 Write_Str
(" Predefined");
547 Write_Str
(" Remote_Call_Interface");
554 Write_Eol
; Write_Str
(" ");
556 Write_Str
(Spaces
(Unit_Start
+ Name_Len
+ 1 .. Unit_End
));
566 procedure Reset_Print
is
568 if not Selective_Output
then
569 Selective_Output
:= True;
570 Print_Source
:= False;
571 Print_Object
:= False;
580 procedure Scan_Ls_Arg
(Argv
: String; And_Save
: Boolean) is
582 pragma Assert
(Argv
'First = 1);
584 if Argv
'Length = 0 then
588 if Argv
(1) = '-' then
590 if Argv
'Length = 1 then
591 Fail
("switch character cannot be followed by a blank");
593 -- Processing for -I-
595 elsif Argv
(2 .. Argv
'Last) = "I-" then
596 Opt
.Look_In_Primary_Dir
:= False;
598 -- Forbid -?- or -??- where ? is any character
600 elsif (Argv
'Length = 3 and then Argv
(3) = '-')
601 or else (Argv
'Length = 4 and then Argv
(4) = '-')
603 Fail
("Trailing ""-"" at the end of ", Argv
, " forbidden.");
605 -- Processing for -Idir
607 elsif Argv
(2) = 'I' then
608 Add_Source_Dir
(Argv
(3 .. Argv
'Last), And_Save
);
609 Add_Lib_Dir
(Argv
(3 .. Argv
'Last), And_Save
);
611 -- Processing for -aIdir (to gcc this is like a -I switch)
613 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aI" then
614 Add_Source_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
616 -- Processing for -aOdir
618 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aO" then
619 Add_Lib_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
621 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
623 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aL" then
624 Add_Lib_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
626 -- Processing for -nostdinc
628 elsif Argv
(2 .. Argv
'Last) = "nostdinc" then
629 Opt
.No_Stdinc
:= True;
631 -- Processing for one character switches
633 elsif Argv
'Length = 2 then
635 when 'a' => Also_Predef
:= True;
636 when 'h' => Print_Usage
:= True;
637 when 'u' => Reset_Print
; Print_Unit
:= True;
638 when 's' => Reset_Print
; Print_Source
:= True;
639 when 'o' => Reset_Print
; Print_Object
:= True;
640 when 'v' => Verbose_Mode
:= True;
641 when 'd' => Dependable
:= True;
646 -- Processing for --RTS=path
648 elsif Argv
'Length >= 5 and then Argv
(1 .. 5) = "--RTS" then
649 if Argv
'Length <= 6 or else Argv
(6) /= '='then
650 Osint
.Fail
("missing path for --RTS");
653 -- Check that it is the first time we see this switch or, if
654 -- it is not the first time, the same path is specified.
656 if RTS_Specified
= null then
657 RTS_Specified
:= new String'(Argv (7 .. Argv'Last));
659 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
660 Osint.Fail ("--RTS cannot be specified multiple times");
663 -- Valid --RTS switch
665 Opt.No_Stdinc := True;
666 Opt.RTS_Switch := True;
669 Src_Path_Name : constant String_Ptr :=
672 (Argv (7 .. Argv'Last), Include));
673 Lib_Path_Name : constant String_Ptr :=
676 (Argv (7 .. Argv'Last), Objects));
679 if Src_Path_Name /= null
680 and then Lib_Path_Name /= null
682 Add_Search_Dirs (Src_Path_Name, Include);
683 Add_Search_Dirs (Lib_Path_Name, Objects);
685 elsif Src_Path_Name = null
686 and then Lib_Path_Name = null
688 Osint.Fail ("RTS path not valid: missing " &
689 "adainclude and adalib directories");
691 elsif Src_Path_Name = null then
692 Osint.Fail ("RTS path not valid: missing " &
693 "adainclude directory");
695 elsif Lib_Path_Name = null then
696 Osint.Fail ("RTS path not valid: missing " &
703 -- If not a switch, it must be a file name
716 -- Start of processing for Usage
721 Write_Str ("Usage: ");
722 Osint.Write_Program_Name;
723 Write_Str (" switches [list of object files]");
729 Write_Str ("switches:");
734 Write_Str (" -a also output relevant predefined units");
739 Write_Str (" -u output only relevant unit names");
744 Write_Str (" -h output this help message");
749 Write_Str (" -s output only relevant source names");
754 Write_Str (" -o output only relevant object names");
759 Write_Str (" -d output sources on which specified units depend");
764 Write_Str (" -v verbose output, full path and unit information");
768 -- Line for -aI switch
770 Write_Str (" -aIdir specify source files search path");
773 -- Line for -aO switch
775 Write_Str (" -aOdir specify object files search path");
778 -- Line for -I switch
780 Write_Str (" -Idir like -aIdir -aOdir");
783 -- Line for -I- switch
785 Write_Str (" -I- do not look for sources & object files");
786 Write_Str (" in the default directory");
789 -- Line for -nostdinc
791 Write_Str (" -nostdinc do not look for source files");
792 Write_Str (" in the system default directory");
797 Write_Str (" --RTS=dir specify the default source and object search"
801 -- File Status explanation
804 Write_Str (" file status can be:");
807 for ST in File_Status loop
809 Output_Status (ST, Verbose => False);
811 Output_Status (ST, Verbose => True);
817 -- Start of processing for Gnatls
820 -- Initialize standard packages
825 -- Use low level argument routines to avoid dragging in the secondary stack
829 Scan_Args : while Next_Arg < Arg_Count loop
831 Next_Argv : String (1 .. Len_Arg (Next_Arg));
834 Fill_Arg (Next_Argv'Address, Next_Arg);
835 Scan_Ls_Arg (Next_Argv, And_Save => True);
838 Next_Arg := Next_Arg + 1;
841 -- Add the source and object directories specified on the
842 -- command line, if any, to the searched directories.
844 while First_Source_Dir /= null loop
845 Add_Src_Search_Dir (First_Source_Dir.Value.all);
846 First_Source_Dir := First_Source_Dir.Next;
849 while First_Lib_Dir /= null loop
850 Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
851 First_Lib_Dir := First_Lib_Dir.Next;
854 -- Finally, add the default directories and obtain target parameters
856 Osint.Add_Default_Search_Dirs;
859 Targparm.Get_Target_Parameters;
861 -- WARNING: the output of gnatls -v is used during the compilation
862 -- and installation of GLADE to recreate sdefault.adb and locate
863 -- the libgnat.a to use. Any change in the output of gnatls -v must
864 -- be synchronized with the GLADE Dist/config.sdefault shell script.
867 Write_Str ("GNATLS ");
868 Write_Str (Gnat_Version_String);
869 Write_Str (" Copyright 1997-2003 Free Software Foundation, Inc.");
872 Write_Str ("Source Search Path:");
875 for J in 1 .. Nb_Dir_In_Src_Search_Path loop
878 if Dir_In_Src_Search_Path (J)'Length = 0 then
879 Write_Str ("<Current_Directory>");
881 Write_Str (To_Host_Dir_Spec
882 (Dir_In_Src_Search_Path (J).all, True).all);
890 Write_Str ("Object Search Path:");
893 for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
896 if Dir_In_Obj_Search_Path (J)'Length = 0 then
897 Write_Str ("<Current_Directory>");
899 Write_Str (To_Host_Dir_Spec
900 (Dir_In_Obj_Search_Path (J).all, True).all);
909 -- Output usage information when requested
915 if not More_Lib_Files then
916 if not Print_Usage and then not Verbose_Mode then
920 Exit_Program (E_Fatal);
924 Initialize_ALI_Source;
926 -- Print out all library for which no ALI files can be located
928 while More_Lib_Files loop
929 Main_File := Next_Main_Lib_File;
930 Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
932 if Ali_File = No_File then
933 Write_Str ("Can't find library info for ");
934 Get_Name_String (Main_File);
936 Write_Str (Name_Buffer (1 .. Name_Len));
941 Ali_File := Strip_Directory (Ali_File);
943 if Get_Name_Table_Info (Ali_File) = 0 then
944 Text := Read_Library_Info (Ali_File, True);
947 (Ali_File, Text, Ignore_ED => False, Err => False);
954 for Id in ALIs.First .. ALIs.Last loop
959 Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
961 if Also_Predef or else not Is_Internal_Unit then
962 Output_Object (ALIs.Table (Id).Ofile_Full_Name);
964 -- In verbose mode print all main units in the ALI file, otherwise
965 -- just print the first one to ease columnwise printout
968 Last_U := ALIs.Table (Id).Last_Unit;
970 Last_U := ALIs.Table (Id).First_Unit;
973 for U in ALIs.Table (Id).First_Unit .. Last_U loop
974 if U /= ALIs.Table (Id).First_Unit
975 and then Selective_Output
983 -- Output source now, unless if it will be done as part of
984 -- outputing dependencies.
986 if not (Dependable and then Print_Source) then
987 Output_Source (Corresponding_Sdep_Entry (Id, U));
991 -- Print out list of dependable units
993 if Dependable and then Print_Source then
995 Write_Str ("depends upon");
1004 ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
1007 or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
1009 if Verbose_Mode then
1019 Write_Str (Spaces (1 .. Source_Start - 2));
1032 -- All done. Set proper exit status.
1035 Exit_Program (E_Success);