1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2002 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 ALI
.Util
; use ALI
.Util
;
30 with Binderr
; use Binderr
;
31 with Butil
; use Butil
;
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_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 -----------------------
109 -- Local Subprograms --
110 -----------------------
112 procedure Add_Lib_Dir
(Dir
: String; And_Save
: Boolean);
113 -- Add an object directory, using Osint.Add_Lib_Search_Dir
114 -- if And_Save is False or keeping in the list First_Lib_Dir,
115 -- Last_Lib_Dir if And_Save is True.
117 procedure Add_Source_Dir
(Dir
: String; And_Save
: Boolean);
118 -- Add a source directory, using Osint.Add_Src_Search_Dir
119 -- if And_Save is False or keeping in the list First_Source_Dir,
120 -- Last_Source_Dir if And_Save is True.
122 procedure Find_General_Layout
;
123 -- Determine the structure of the output (multi columns or not, etc)
125 procedure Find_Status
126 (FS
: in out File_Name_Type
;
127 Stamp
: Time_Stamp_Type
;
129 Status
: out File_Status
);
130 -- Determine the file status (Status) of the file represented by FS
131 -- with the expected Stamp and checksum given as argument. FS will be
132 -- updated to the full file name if available.
134 function Corresponding_Sdep_Entry
(A
: ALI_Id
; U
: Unit_Id
) return Sdep_Id
;
135 -- Give the Sdep entry corresponding to the unit U in ali record A.
137 procedure Output_Object
(O
: File_Name_Type
);
138 -- Print out the name of the object when requested
140 procedure Output_Source
(Sdep_I
: Sdep_Id
);
141 -- Print out the name and status of the source corresponding to this
144 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean);
145 -- Print out FS either in a coded form if verbose is false or in an
146 -- expanded form otherwise.
148 procedure Output_Unit
(U_Id
: Unit_Id
);
149 -- Print out information on the unit when requested
151 procedure Reset_Print
;
152 -- Reset Print flags properly when selective output is chosen
154 procedure Scan_Ls_Arg
(Argv
: String; And_Save
: Boolean);
155 -- Scan and process lser specific arguments. Argv is a single argument.
158 -- Print usage message.
164 procedure Add_Lib_Dir
(Dir
: String; And_Save
: Boolean) is
167 if First_Lib_Dir
= null then
170 (Value => new String'(Dir
),
172 Last_Lib_Dir
:= First_Lib_Dir
;
177 (Value => new String'(Dir
),
179 Last_Lib_Dir
:= Last_Lib_Dir
.Next
;
183 Add_Lib_Search_Dir
(Dir
);
191 procedure Add_Source_Dir
(Dir
: String; And_Save
: Boolean) is
194 if First_Source_Dir
= null then
197 (Value => new String'(Dir
),
199 Last_Source_Dir
:= First_Source_Dir
;
202 Last_Source_Dir
.Next
:=
204 (Value => new String'(Dir
),
206 Last_Source_Dir
:= Last_Source_Dir
.Next
;
210 Add_Src_Search_Dir
(Dir
);
214 ------------------------------
215 -- Corresponding_Sdep_Entry --
216 ------------------------------
218 function Corresponding_Sdep_Entry
224 for D
in ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
loop
225 if Sdep
.Table
(D
).Sfile
= Units
.Table
(U
).Sfile
then
230 Error_Msg_Name_1
:= Units
.Table
(U
).Uname
;
231 Error_Msg_Name_2
:= ALIs
.Table
(A
).Afile
;
233 Error_Msg
("wrong ALI format, can't find dependency line for & in %");
234 Exit_Program
(E_Fatal
);
235 end Corresponding_Sdep_Entry
;
237 -------------------------
238 -- Find_General_Layout --
239 -------------------------
241 procedure Find_General_Layout
is
242 Max_Unit_Length
: Integer := 11;
243 Max_Src_Length
: Integer := 11;
244 Max_Obj_Length
: Integer := 11;
250 -- Compute maximum of each column
252 for Id
in ALIs
.First
.. ALIs
.Last
loop
254 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
255 if Also_Predef
or else not Is_Internal_Unit
then
259 Max_Unit_Length
:= Integer'Max (Max_Unit_Length
, Len
);
263 FS
:= Full_Source_Name
(ALIs
.Table
(Id
).Sfile
);
266 Get_Name_String
(ALIs
.Table
(Id
).Sfile
);
267 Name_Len
:= Name_Len
+ 13;
269 Get_Name_String
(FS
);
272 Max_Src_Length
:= Integer'Max (Max_Src_Length
, Name_Len
+ 1);
276 Get_Name_String
(ALIs
.Table
(Id
).Ofile_Full_Name
);
277 Max_Obj_Length
:= Integer'Max (Max_Obj_Length
, Name_Len
+ 1);
282 -- Verify is output is not wider than maximum number of columns
284 Too_Long
:= Verbose_Mode
or else
285 (Max_Unit_Length
+ Max_Src_Length
+ Max_Obj_Length
) > Max_Column
;
287 -- Set start and end of columns.
290 Object_End
:= Object_Start
- 1;
293 Object_End
:= Object_Start
+ Max_Obj_Length
;
296 Unit_Start
:= Object_End
+ 1;
297 Unit_End
:= Unit_Start
- 1;
300 Unit_End
:= Unit_Start
+ Max_Unit_Length
;
303 Source_Start
:= Unit_End
+ 1;
305 if Source_Start
> Spaces
'Last then
306 Source_Start
:= Spaces
'Last;
309 Source_End
:= Source_Start
- 1;
312 Source_End
:= Source_Start
+ Max_Src_Length
;
314 end Find_General_Layout
;
320 procedure Find_Status
321 (FS
: in out File_Name_Type
;
322 Stamp
: Time_Stamp_Type
;
324 Status
: out File_Status
)
326 Tmp1
: File_Name_Type
;
327 Tmp2
: File_Name_Type
;
330 Tmp1
:= Full_Source_Name
(FS
);
332 if Tmp1
= No_File
then
335 elsif File_Stamp
(Tmp1
) = Stamp
then
339 elsif Checksums_Match
(Get_File_Checksum
(FS
), Checksum
) then
341 Status
:= Checksum_OK
;
344 Tmp2
:= Matching_Full_Source_Name
(FS
, Stamp
);
346 if Tmp2
= No_File
then
351 Status
:= Not_First_On_PATH
;
361 procedure Output_Object
(O
: File_Name_Type
) is
362 Object_Name
: String_Access
;
367 Object_Name
:= To_Host_File_Spec
(Name_Buffer
(1 .. Name_Len
));
368 Write_Str
(Object_Name
.all);
370 if Print_Source
or else Print_Unit
then
376 (Object_Start
+ Object_Name
'Length .. Object_End
));
386 procedure Output_Source
(Sdep_I
: Sdep_Id
) is
387 Stamp
: constant Time_Stamp_Type
:= Sdep
.Table
(Sdep_I
).Stamp
;
388 Checksum
: constant Word
:= Sdep
.Table
(Sdep_I
).Checksum
;
389 FS
: File_Name_Type
:= Sdep
.Table
(Sdep_I
).Sfile
;
390 Status
: File_Status
;
391 Object_Name
: String_Access
;
395 Find_Status
(FS
, Stamp
, Checksum
, Status
);
396 Get_Name_String
(FS
);
398 Object_Name
:= To_Host_File_Spec
(Name_Buffer
(1 .. Name_Len
));
401 Write_Str
(" Source => ");
402 Write_Str
(Object_Name
.all);
406 (Spaces
(Source_Start
+ Object_Name
'Length .. Source_End
));
409 Output_Status
(Status
, Verbose
=> True);
414 if not Selective_Output
then
415 Output_Status
(Status
, Verbose
=> False);
418 Write_Str
(Object_Name
.all);
427 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean) is
432 Write_Str
(" unchanged");
435 Write_Str
(" slightly modified");
438 Write_Str
(" file not found");
441 Write_Str
(" modified");
443 when Not_First_On_PATH
=>
444 Write_Str
(" unchanged version not first on PATH");
461 when Not_First_On_PATH
=>
471 procedure Output_Unit
(U_Id
: Unit_Id
) is
473 U
: Unit_Record
renames Units
.Table
(U_Id
);
477 Get_Name_String
(U
.Uname
);
478 Kind
:= Name_Buffer
(Name_Len
);
479 Name_Len
:= Name_Len
- 2;
481 if not Verbose_Mode
then
482 Write_Str
(Name_Buffer
(1 .. Name_Len
));
485 Write_Str
("Unit => ");
486 Write_Eol
; Write_Str
(" Name => ");
487 Write_Str
(Name_Buffer
(1 .. Name_Len
));
488 Write_Eol
; Write_Str
(" Kind => ");
490 if Units
.Table
(U_Id
).Unit_Kind
= 'p' then
491 Write_Str
("package ");
493 Write_Str
("subprogram ");
513 Write_Eol
; Write_Str
(" Flags =>");
516 Write_Str
(" Preelaborable");
520 Write_Str
(" No_Elab_Code");
527 if U
.Elaborate_Body
then
528 Write_Str
(" Elaborate Body");
531 if U
.Remote_Types
then
532 Write_Str
(" Remote_Types");
535 if U
.Shared_Passive
then
536 Write_Str
(" Shared_Passive");
540 Write_Str
(" Predefined");
544 Write_Str
(" Remote_Call_Interface");
551 Write_Eol
; Write_Str
(" ");
553 Write_Str
(Spaces
(Unit_Start
+ Name_Len
+ 1 .. Unit_End
));
563 procedure Reset_Print
is
565 if not Selective_Output
then
566 Selective_Output
:= True;
567 Print_Source
:= False;
568 Print_Object
:= False;
577 procedure Scan_Ls_Arg
(Argv
: String; And_Save
: Boolean) is
579 pragma Assert
(Argv
'First = 1);
581 if Argv
'Length = 0 then
585 if Argv
(1) = '-' then
587 if Argv
'Length = 1 then
588 Fail
("switch character cannot be followed by a blank");
590 -- Processing for -I-
592 elsif Argv
(2 .. Argv
'Last) = "I-" then
593 Opt
.Look_In_Primary_Dir
:= False;
595 -- Forbid -?- or -??- where ? is any character
597 elsif (Argv
'Length = 3 and then Argv
(3) = '-')
598 or else (Argv
'Length = 4 and then Argv
(4) = '-')
600 Fail
("Trailing ""-"" at the end of ", Argv
, " forbidden.");
602 -- Processing for -Idir
604 elsif Argv
(2) = 'I' then
605 Add_Source_Dir
(Argv
(3 .. Argv
'Last), And_Save
);
606 Add_Lib_Dir
(Argv
(3 .. Argv
'Last), And_Save
);
608 -- Processing for -aIdir (to gcc this is like a -I switch)
610 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aI" then
611 Add_Source_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
613 -- Processing for -aOdir
615 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aO" then
616 Add_Lib_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
618 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
620 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aL" then
621 Add_Lib_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
623 -- Processing for -nostdinc
625 elsif Argv
(2 .. Argv
'Last) = "nostdinc" then
626 Opt
.No_Stdinc
:= True;
628 -- Processing for one character switches
630 elsif Argv
'Length = 2 then
632 when 'a' => Also_Predef
:= True;
633 when 'h' => Print_Usage
:= True;
634 when 'u' => Reset_Print
; Print_Unit
:= True;
635 when 's' => Reset_Print
; Print_Source
:= True;
636 when 'o' => Reset_Print
; Print_Object
:= True;
637 when 'v' => Verbose_Mode
:= True;
638 when 'd' => Dependable
:= True;
643 -- Processing for --RTS=path
645 elsif Argv
(1 .. 5) = "--RTS" then
647 if Argv
(6) /= '=' or else
649 and then Argv
'Length = 6)
651 Osint
.Fail
("missing path for --RTS");
654 -- Valid --RTS switch
656 Opt
.No_Stdinc
:= True;
657 Opt
.RTS_Switch
:= True;
660 Src_Path_Name
: String_Ptr
:=
663 (Argv
(7 .. Argv
'Last), Include
));
664 Lib_Path_Name
: String_Ptr
:=
667 (Argv
(7 .. Argv
'Last), Objects
));
670 if Src_Path_Name
/= null
671 and then Lib_Path_Name
/= null
673 Add_Search_Dirs
(Src_Path_Name
, Include
);
674 Add_Search_Dirs
(Lib_Path_Name
, Objects
);
676 elsif Src_Path_Name
= null
677 and then Lib_Path_Name
= null
679 Osint
.Fail
("RTS path not valid: missing " &
680 "adainclude and adalib directories");
682 elsif Src_Path_Name
= null then
683 Osint
.Fail
("RTS path not valid: missing " &
684 "adainclude directory");
686 elsif Lib_Path_Name
= null then
687 Osint
.Fail
("RTS path not valid: missing " &
694 -- If not a switch, it must be a file name
707 -- Start of processing for Usage
712 Write_Str
("Usage: ");
713 Osint
.Write_Program_Name
;
714 Write_Str
(" switches [list of object files]");
720 Write_Str
("switches:");
725 Write_Str
(" -a also output relevant predefined units");
730 Write_Str
(" -u output only relevant unit names");
735 Write_Str
(" -h output this help message");
740 Write_Str
(" -s output only relevant source names");
745 Write_Str
(" -o output only relevant object names");
750 Write_Str
(" -d output sources on which specified units depend");
755 Write_Str
(" -v verbose output, full path and unit information");
759 -- Line for -aI switch
761 Write_Str
(" -aIdir specify source files search path");
764 -- Line for -aO switch
766 Write_Str
(" -aOdir specify object files search path");
769 -- Line for -I switch
771 Write_Str
(" -Idir like -aIdir -aOdir");
774 -- Line for -I- switch
776 Write_Str
(" -I- do not look for sources & object files");
777 Write_Str
(" in the default directory");
780 -- Line for -nostdinc
782 Write_Str
(" -nostdinc do not look for source files");
783 Write_Str
(" in the system default directory");
788 Write_Str
(" --RTS=dir specify the default source and object search"
792 -- File Status explanation
795 Write_Str
(" file status can be:");
798 for ST
in File_Status
loop
800 Output_Status
(ST
, Verbose
=> False);
802 Output_Status
(ST
, Verbose
=> True);
808 -- Start of processing for Gnatls
812 -- Use low level argument routines to avoid dragging in the secondary stack
816 Scan_Args
: while Next_Arg
< Arg_Count
loop
818 Next_Argv
: String (1 .. Len_Arg
(Next_Arg
));
821 Fill_Arg
(Next_Argv
'Address, Next_Arg
);
822 Scan_Ls_Arg
(Next_Argv
, And_Save
=> True);
825 Next_Arg
:= Next_Arg
+ 1;
828 -- Add the source and object directories specified on the
829 -- command line, if any, to the searched directories.
831 while First_Source_Dir
/= null loop
832 Add_Src_Search_Dir
(First_Source_Dir
.Value
.all);
833 First_Source_Dir
:= First_Source_Dir
.Next
;
836 while First_Lib_Dir
/= null loop
837 Add_Lib_Search_Dir
(First_Lib_Dir
.Value
.all);
838 First_Lib_Dir
:= First_Lib_Dir
.Next
;
841 -- Finally, add the default directories and obtain target parameters
843 Osint
.Add_Default_Search_Dirs
;
847 Targparm
.Get_Target_Parameters
;
849 -- WARNING: the output of gnatls -v is used during the compilation
850 -- and installation of GLADE to recreate sdefault.adb and locate
851 -- the libgnat.a to use. Any change in the output of gnatls -v must
852 -- be synchronized with the GLADE Dist/config.sdefault shell script.
855 Write_Str
("GNATLS ");
857 if Targparm
.High_Integrity_Mode_On_Target
then
858 Write_Str
("Pro High Integrity ");
861 Write_Str
(Gnat_Version_String
);
862 Write_Str
(" Copyright 1997-2002 Free Software Foundation, Inc.");
865 Write_Str
("Source Search Path:");
868 for J
in 1 .. Nb_Dir_In_Src_Search_Path
loop
871 if Dir_In_Src_Search_Path
(J
)'Length = 0 then
872 Write_Str
("<Current_Directory>");
874 Write_Str
(To_Host_Dir_Spec
875 (Dir_In_Src_Search_Path
(J
).all, True).all);
883 Write_Str
("Object Search Path:");
886 for J
in 1 .. Nb_Dir_In_Obj_Search_Path
loop
889 if Dir_In_Obj_Search_Path
(J
)'Length = 0 then
890 Write_Str
("<Current_Directory>");
892 Write_Str
(To_Host_Dir_Spec
893 (Dir_In_Obj_Search_Path
(J
).all, True).all);
902 -- Output usage information when requested
908 if not More_Lib_Files
then
909 if not Print_Usage
and then not Verbose_Mode
then
913 Exit_Program
(E_Fatal
);
918 Initialize_ALI_Source
;
920 -- Print out all library for which no ALI files can be located
922 while More_Lib_Files
loop
923 Main_File
:= Next_Main_Lib_File
;
924 Ali_File
:= Full_Lib_File_Name
(Lib_File_Name
(Main_File
));
926 if Ali_File
= No_File
then
927 Write_Str
("Can't find library info for ");
928 Get_Decoded_Name_String
(Main_File
);
930 Write_Str
(Name_Buffer
(1 .. Name_Len
));
935 Ali_File
:= Strip_Directory
(Ali_File
);
937 if Get_Name_Table_Info
(Ali_File
) = 0 then
938 Text
:= Read_Library_Info
(Ali_File
, True);
941 (Ali_File
, Text
, Ignore_ED
=> False, Err
=> False);
948 for Id
in ALIs
.First
.. ALIs
.Last
loop
953 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
955 if Also_Predef
or else not Is_Internal_Unit
then
956 Output_Object
(ALIs
.Table
(Id
).Ofile_Full_Name
);
958 -- In verbose mode print all main units in the ALI file, otherwise
959 -- just print the first one to ease columnwise printout
962 Last_U
:= ALIs
.Table
(Id
).Last_Unit
;
964 Last_U
:= ALIs
.Table
(Id
).First_Unit
;
967 for U
in ALIs
.Table
(Id
).First_Unit
.. Last_U
loop
968 if U
/= ALIs
.Table
(Id
).First_Unit
969 and then Selective_Output
977 -- Output source now, unless if it will be done as part of
978 -- outputing dependencies.
980 if not (Dependable
and then Print_Source
) then
981 Output_Source
(Corresponding_Sdep_Entry
(Id
, U
));
985 -- Print out list of dependable units
987 if Dependable
and then Print_Source
then
989 Write_Str
("depends upon");
998 ALIs
.Table
(Id
).First_Sdep
.. ALIs
.Table
(Id
).Last_Sdep
1001 or else not Is_Internal_File_Name
(Sdep
.Table
(D
).Sfile
)
1003 if Verbose_Mode
then
1013 Write_Str
(Spaces
(1 .. Source_Start
- 2));
1026 -- All done. Set proper exit status.
1029 Exit_Program
(E_Success
);