1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2002 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 Fname
; use Fname
;
32 with Gnatvsn
; use Gnatvsn
;
33 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
34 with Namet
; use Namet
;
36 with Osint
; use Osint
;
37 with Osint
.L
; use Osint
.L
;
38 with Output
; use Output
;
39 with Targparm
; use Targparm
;
40 with Types
; use Types
;
44 Max_Column
: constant := 80;
47 OK
, -- matching timestamp
48 Checksum_OK
, -- only matching checksum
49 Not_Found
, -- file not found on source PATH
50 Not_Same
, -- neither checksum nor timestamp matching
51 Not_First_On_PATH
); -- matching file hidden by Not_Same file on path
54 type Dir_Ref
is access Dir_Data
;
56 type Dir_Data
is record
57 Value
: String_Access
;
62 First_Source_Dir
: Dir_Ref
;
63 Last_Source_Dir
: Dir_Ref
;
64 -- The list of source directories from the command line.
65 -- These directories are added using Osint.Add_Src_Search_Dir
66 -- after those of the GNAT Project File, if any.
68 First_Lib_Dir
: Dir_Ref
;
69 Last_Lib_Dir
: Dir_Ref
;
70 -- The list of object directories from the command line.
71 -- These directories are added using Osint.Add_Lib_Search_Dir
72 -- after those of the GNAT Project File, if any.
74 Main_File
: File_Name_Type
;
75 Ali_File
: File_Name_Type
;
77 Text
: Text_Buffer_Ptr
;
82 Too_Long
: Boolean := False;
83 -- When True, lines are too long for multi-column output and each
84 -- item of information is on a different line.
86 Selective_Output
: Boolean := False;
87 Print_Usage
: Boolean := False;
88 Print_Unit
: Boolean := True;
89 Print_Source
: Boolean := True;
90 Print_Object
: Boolean := True;
91 -- Flags controlling the form of the outpout
93 Dependable
: Boolean := False; -- flag -d
94 Also_Predef
: Boolean := False;
98 Source_Start
: Integer;
100 Object_Start
: Integer;
101 Object_End
: Integer;
102 -- Various column starts and ends
104 Spaces
: constant String (1 .. Max_Column
) := (others => ' ');
106 -----------------------
107 -- Local Subprograms --
108 -----------------------
110 procedure Add_Lib_Dir
(Dir
: String; And_Save
: Boolean);
111 -- Add an object directory, using Osint.Add_Lib_Search_Dir
112 -- if And_Save is False or keeping in the list First_Lib_Dir,
113 -- Last_Lib_Dir if And_Save is True.
115 procedure Add_Source_Dir
(Dir
: String; And_Save
: Boolean);
116 -- Add a source directory, using Osint.Add_Src_Search_Dir
117 -- if And_Save is False or keeping in the list First_Source_Dir,
118 -- Last_Source_Dir if And_Save is True.
120 procedure Find_General_Layout
;
121 -- Determine the structure of the output (multi columns or not, etc)
123 procedure Find_Status
124 (FS
: in out File_Name_Type
;
125 Stamp
: Time_Stamp_Type
;
127 Status
: out File_Status
);
128 -- Determine the file status (Status) of the file represented by FS
129 -- with the expected Stamp and checksum given as argument. FS will be
130 -- updated to the full file name if available.
132 function Corresponding_Sdep_Entry
(A
: ALI_Id
; U
: Unit_Id
) return Sdep_Id
;
133 -- Give the Sdep entry corresponding to the unit U in ali record A.
135 procedure Output_Object
(O
: File_Name_Type
);
136 -- Print out the name of the object when requested
138 procedure Output_Source
(Sdep_I
: Sdep_Id
);
139 -- Print out the name and status of the source corresponding to this
142 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean);
143 -- Print out FS either in a coded form if verbose is false or in an
144 -- expanded form otherwise.
146 procedure Output_Unit
(U_Id
: Unit_Id
);
147 -- Print out information on the unit when requested
149 procedure Reset_Print
;
150 -- Reset Print flags properly when selective output is chosen
152 procedure Scan_Ls_Arg
(Argv
: String; And_Save
: Boolean);
153 -- Scan and process lser specific arguments. Argv is a single argument.
156 -- Print usage message.
162 procedure Add_Lib_Dir
(Dir
: String; And_Save
: Boolean) is
165 if First_Lib_Dir
= null then
168 (Value => new String'(Dir
),
170 Last_Lib_Dir
:= First_Lib_Dir
;
175 (Value => new String'(Dir
),
177 Last_Lib_Dir
:= Last_Lib_Dir
.Next
;
181 Add_Lib_Search_Dir
(Dir
);
189 procedure Add_Source_Dir
(Dir
: String; And_Save
: Boolean) is
192 if First_Source_Dir
= null then
195 (Value => new String'(Dir
),
197 Last_Source_Dir
:= First_Source_Dir
;
200 Last_Source_Dir
.Next
:=
202 (Value => new String'(Dir
),
204 Last_Source_Dir
:= Last_Source_Dir
.Next
;
208 Add_Src_Search_Dir
(Dir
);
212 ------------------------------
213 -- Corresponding_Sdep_Entry --
214 ------------------------------
216 function Corresponding_Sdep_Entry
222 for D
in ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
loop
223 if Sdep
.Table
(D
).Sfile
= Units
.Table
(U
).Sfile
then
228 Error_Msg_Name_1
:= Units
.Table
(U
).Uname
;
229 Error_Msg_Name_2
:= ALIs
.Table
(A
).Afile
;
231 Error_Msg
("wrong ALI format, can't find dependency line for & in %");
232 Exit_Program
(E_Fatal
);
233 end Corresponding_Sdep_Entry
;
235 -------------------------
236 -- Find_General_Layout --
237 -------------------------
239 procedure Find_General_Layout
is
240 Max_Unit_Length
: Integer := 11;
241 Max_Src_Length
: Integer := 11;
242 Max_Obj_Length
: Integer := 11;
248 -- Compute maximum of each column
250 for Id
in ALIs
.First
.. ALIs
.Last
loop
252 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
253 if Also_Predef
or else not Is_Internal_Unit
then
257 Max_Unit_Length
:= Integer'Max (Max_Unit_Length
, Len
);
261 FS
:= Full_Source_Name
(ALIs
.Table
(Id
).Sfile
);
264 Get_Name_String
(ALIs
.Table
(Id
).Sfile
);
265 Name_Len
:= Name_Len
+ 13;
267 Get_Name_String
(FS
);
270 Max_Src_Length
:= Integer'Max (Max_Src_Length
, Name_Len
+ 1);
274 Get_Name_String
(ALIs
.Table
(Id
).Ofile_Full_Name
);
275 Max_Obj_Length
:= Integer'Max (Max_Obj_Length
, Name_Len
+ 1);
280 -- Verify is output is not wider than maximum number of columns
282 Too_Long
:= Verbose_Mode
or else
283 (Max_Unit_Length
+ Max_Src_Length
+ Max_Obj_Length
) > Max_Column
;
285 -- Set start and end of columns.
288 Object_End
:= Object_Start
- 1;
291 Object_End
:= Object_Start
+ Max_Obj_Length
;
294 Unit_Start
:= Object_End
+ 1;
295 Unit_End
:= Unit_Start
- 1;
298 Unit_End
:= Unit_Start
+ Max_Unit_Length
;
301 Source_Start
:= Unit_End
+ 1;
303 if Source_Start
> Spaces
'Last then
304 Source_Start
:= Spaces
'Last;
307 Source_End
:= Source_Start
- 1;
310 Source_End
:= Source_Start
+ Max_Src_Length
;
312 end Find_General_Layout
;
318 procedure Find_Status
319 (FS
: in out File_Name_Type
;
320 Stamp
: Time_Stamp_Type
;
322 Status
: out File_Status
)
324 Tmp1
: File_Name_Type
;
325 Tmp2
: File_Name_Type
;
328 Tmp1
:= Full_Source_Name
(FS
);
330 if Tmp1
= No_File
then
333 elsif File_Stamp
(Tmp1
) = Stamp
then
337 elsif Checksums_Match
(Get_File_Checksum
(FS
), Checksum
) then
339 Status
:= Checksum_OK
;
342 Tmp2
:= Matching_Full_Source_Name
(FS
, Stamp
);
344 if Tmp2
= No_File
then
349 Status
:= Not_First_On_PATH
;
359 procedure Output_Object
(O
: File_Name_Type
) is
360 Object_Name
: String_Access
;
365 Object_Name
:= To_Host_File_Spec
(Name_Buffer
(1 .. Name_Len
));
366 Write_Str
(Object_Name
.all);
368 if Print_Source
or else Print_Unit
then
374 (Object_Start
+ Object_Name
'Length .. Object_End
));
384 procedure Output_Source
(Sdep_I
: Sdep_Id
) is
385 Stamp
: constant Time_Stamp_Type
:= Sdep
.Table
(Sdep_I
).Stamp
;
386 Checksum
: constant Word
:= Sdep
.Table
(Sdep_I
).Checksum
;
387 FS
: File_Name_Type
:= Sdep
.Table
(Sdep_I
).Sfile
;
388 Status
: File_Status
;
389 Object_Name
: String_Access
;
393 Find_Status
(FS
, Stamp
, Checksum
, Status
);
394 Get_Name_String
(FS
);
396 Object_Name
:= To_Host_File_Spec
(Name_Buffer
(1 .. Name_Len
));
399 Write_Str
(" Source => ");
400 Write_Str
(Object_Name
.all);
404 (Spaces
(Source_Start
+ Object_Name
'Length .. Source_End
));
407 Output_Status
(Status
, Verbose
=> True);
412 if not Selective_Output
then
413 Output_Status
(Status
, Verbose
=> False);
416 Write_Str
(Object_Name
.all);
425 procedure Output_Status
(FS
: File_Status
; Verbose
: Boolean) is
430 Write_Str
(" unchanged");
433 Write_Str
(" slightly modified");
436 Write_Str
(" file not found");
439 Write_Str
(" modified");
441 when Not_First_On_PATH
=>
442 Write_Str
(" unchanged version not first on PATH");
459 when Not_First_On_PATH
=>
469 procedure Output_Unit
(U_Id
: Unit_Id
) is
471 U
: Unit_Record
renames Units
.Table
(U_Id
);
475 Get_Name_String
(U
.Uname
);
476 Kind
:= Name_Buffer
(Name_Len
);
477 Name_Len
:= Name_Len
- 2;
479 if not Verbose_Mode
then
480 Write_Str
(Name_Buffer
(1 .. Name_Len
));
483 Write_Str
("Unit => ");
484 Write_Eol
; Write_Str
(" Name => ");
485 Write_Str
(Name_Buffer
(1 .. Name_Len
));
486 Write_Eol
; Write_Str
(" Kind => ");
488 if Units
.Table
(U_Id
).Unit_Kind
= 'p' then
489 Write_Str
("package ");
491 Write_Str
("subprogram ");
511 Write_Eol
; Write_Str
(" Flags =>");
514 Write_Str
(" Preelaborable");
518 Write_Str
(" No_Elab_Code");
525 if U
.Elaborate_Body
then
526 Write_Str
(" Elaborate Body");
529 if U
.Remote_Types
then
530 Write_Str
(" Remote_Types");
533 if U
.Shared_Passive
then
534 Write_Str
(" Shared_Passive");
538 Write_Str
(" Predefined");
542 Write_Str
(" Remote_Call_Interface");
549 Write_Eol
; Write_Str
(" ");
551 Write_Str
(Spaces
(Unit_Start
+ Name_Len
+ 1 .. Unit_End
));
561 procedure Reset_Print
is
563 if not Selective_Output
then
564 Selective_Output
:= True;
565 Print_Source
:= False;
566 Print_Object
:= False;
575 procedure Scan_Ls_Arg
(Argv
: String; And_Save
: Boolean) is
577 pragma Assert
(Argv
'First = 1);
579 if Argv
'Length = 0 then
583 if Argv
(1) = '-' then
585 if Argv
'Length = 1 then
586 Fail
("switch character cannot be followed by a blank");
588 -- Processing for -I-
590 elsif Argv
(2 .. Argv
'Last) = "I-" then
591 Opt
.Look_In_Primary_Dir
:= False;
593 -- Forbid -?- or -??- where ? is any character
595 elsif (Argv
'Length = 3 and then Argv
(3) = '-')
596 or else (Argv
'Length = 4 and then Argv
(4) = '-')
598 Fail
("Trailing ""-"" at the end of ", Argv
, " forbidden.");
600 -- Processing for -Idir
602 elsif Argv
(2) = 'I' then
603 Add_Source_Dir
(Argv
(3 .. Argv
'Last), And_Save
);
604 Add_Lib_Dir
(Argv
(3 .. Argv
'Last), And_Save
);
606 -- Processing for -aIdir (to gcc this is like a -I switch)
608 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aI" then
609 Add_Source_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
611 -- Processing for -aOdir
613 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aO" then
614 Add_Lib_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
616 -- Processing for -aLdir (to gnatbind this is like a -aO switch)
618 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aL" then
619 Add_Lib_Dir
(Argv
(4 .. Argv
'Last), And_Save
);
621 -- Processing for -nostdinc
623 elsif Argv
(2 .. Argv
'Last) = "nostdinc" then
624 Opt
.No_Stdinc
:= True;
626 -- Processing for one character switches
628 elsif Argv
'Length = 2 then
630 when 'a' => Also_Predef
:= True;
631 when 'h' => Print_Usage
:= True;
632 when 'u' => Reset_Print
; Print_Unit
:= True;
633 when 's' => Reset_Print
; Print_Source
:= True;
634 when 'o' => Reset_Print
; Print_Object
:= True;
635 when 'v' => Verbose_Mode
:= True;
636 when 'd' => Dependable
:= True;
641 -- Processing for --RTS=path
643 elsif Argv
(1 .. 5) = "--RTS" then
645 if Argv
(6) /= '=' or else
647 and then Argv
'Length = 6)
649 Osint
.Fail
("missing path for --RTS");
652 -- Valid --RTS switch
654 Opt
.No_Stdinc
:= True;
655 Opt
.RTS_Switch
:= True;
658 Src_Path_Name
: String_Ptr
:=
661 (Argv
(7 .. Argv
'Last), Include
));
662 Lib_Path_Name
: String_Ptr
:=
665 (Argv
(7 .. Argv
'Last), Objects
));
668 if Src_Path_Name
/= null
669 and then Lib_Path_Name
/= null
671 Add_Search_Dirs
(Src_Path_Name
, Include
);
672 Add_Search_Dirs
(Lib_Path_Name
, Objects
);
674 elsif Src_Path_Name
= null
675 and then Lib_Path_Name
= null
677 Osint
.Fail
("RTS path not valid: missing " &
678 "adainclude and adalib directories");
680 elsif Src_Path_Name
= null then
681 Osint
.Fail
("RTS path not valid: missing " &
682 "adainclude directory");
684 elsif Lib_Path_Name
= null then
685 Osint
.Fail
("RTS path not valid: missing " &
692 -- If not a switch, it must be a file name
705 -- Start of processing for Usage
710 Write_Str
("Usage: ");
711 Osint
.Write_Program_Name
;
712 Write_Str
(" switches [list of object files]");
718 Write_Str
("switches:");
723 Write_Str
(" -a also output relevant predefined units");
728 Write_Str
(" -u output only relevant unit names");
733 Write_Str
(" -h output this help message");
738 Write_Str
(" -s output only relevant source names");
743 Write_Str
(" -o output only relevant object names");
748 Write_Str
(" -d output sources on which specified units depend");
753 Write_Str
(" -v verbose output, full path and unit information");
757 -- Line for -aI switch
759 Write_Str
(" -aIdir specify source files search path");
762 -- Line for -aO switch
764 Write_Str
(" -aOdir specify object files search path");
767 -- Line for -I switch
769 Write_Str
(" -Idir like -aIdir -aOdir");
772 -- Line for -I- switch
774 Write_Str
(" -I- do not look for sources & object files");
775 Write_Str
(" in the default directory");
778 -- Line for -nostdinc
780 Write_Str
(" -nostdinc do not look for source files");
781 Write_Str
(" in the system default directory");
786 Write_Str
(" --RTS=dir specify the default source and object search"
790 -- File Status explanation
793 Write_Str
(" file status can be:");
796 for ST
in File_Status
loop
798 Output_Status
(ST
, Verbose
=> False);
800 Output_Status
(ST
, Verbose
=> True);
806 -- Start of processing for Gnatls
810 -- Use low level argument routines to avoid dragging in the secondary stack
814 Scan_Args
: while Next_Arg
< Arg_Count
loop
816 Next_Argv
: String (1 .. Len_Arg
(Next_Arg
));
819 Fill_Arg
(Next_Argv
'Address, Next_Arg
);
820 Scan_Ls_Arg
(Next_Argv
, And_Save
=> True);
823 Next_Arg
:= Next_Arg
+ 1;
826 -- Add the source and object directories specified on the
827 -- command line, if any, to the searched directories.
829 while First_Source_Dir
/= null loop
830 Add_Src_Search_Dir
(First_Source_Dir
.Value
.all);
831 First_Source_Dir
:= First_Source_Dir
.Next
;
834 while First_Lib_Dir
/= null loop
835 Add_Lib_Search_Dir
(First_Lib_Dir
.Value
.all);
836 First_Lib_Dir
:= First_Lib_Dir
.Next
;
839 -- Finally, add the default directories and obtain target parameters
841 Osint
.Add_Default_Search_Dirs
;
845 Targparm
.Get_Target_Parameters
;
847 -- WARNING: the output of gnatls -v is used during the compilation
848 -- and installation of GLADE to recreate sdefault.adb and locate
849 -- the libgnat.a to use. Any change in the output of gnatls -v must
850 -- be synchronized with the GLADE Dist/config.sdefault shell script.
853 Write_Str
("GNATLS ");
855 if Targparm
.High_Integrity_Mode_On_Target
then
856 Write_Str
("Pro High Integrity ");
859 Write_Str
(Gnat_Version_String
);
860 Write_Str
(" Copyright 1997-2002 Free Software Foundation, Inc.");
863 Write_Str
("Source Search Path:");
866 for J
in 1 .. Nb_Dir_In_Src_Search_Path
loop
869 if Dir_In_Src_Search_Path
(J
)'Length = 0 then
870 Write_Str
("<Current_Directory>");
872 Write_Str
(To_Host_Dir_Spec
873 (Dir_In_Src_Search_Path
(J
).all, True).all);
881 Write_Str
("Object Search Path:");
884 for J
in 1 .. Nb_Dir_In_Obj_Search_Path
loop
887 if Dir_In_Obj_Search_Path
(J
)'Length = 0 then
888 Write_Str
("<Current_Directory>");
890 Write_Str
(To_Host_Dir_Spec
891 (Dir_In_Obj_Search_Path
(J
).all, True).all);
900 -- Output usage information when requested
906 if not More_Lib_Files
then
907 if not Print_Usage
and then not Verbose_Mode
then
911 Exit_Program
(E_Fatal
);
916 Initialize_ALI_Source
;
918 -- Print out all library for which no ALI files can be located
920 while More_Lib_Files
loop
921 Main_File
:= Next_Main_Lib_File
;
922 Ali_File
:= Full_Lib_File_Name
(Lib_File_Name
(Main_File
));
924 if Ali_File
= No_File
then
925 Write_Str
("Can't find library info for ");
926 Get_Decoded_Name_String
(Main_File
);
928 Write_Str
(Name_Buffer
(1 .. Name_Len
));
933 Ali_File
:= Strip_Directory
(Ali_File
);
935 if Get_Name_Table_Info
(Ali_File
) = 0 then
936 Text
:= Read_Library_Info
(Ali_File
, True);
939 (Ali_File
, Text
, Ignore_ED
=> False, Err
=> False);
946 for Id
in ALIs
.First
.. ALIs
.Last
loop
951 Get_Name_String
(Units
.Table
(ALIs
.Table
(Id
).First_Unit
).Uname
);
953 if Also_Predef
or else not Is_Internal_Unit
then
954 Output_Object
(ALIs
.Table
(Id
).Ofile_Full_Name
);
956 -- In verbose mode print all main units in the ALI file, otherwise
957 -- just print the first one to ease columnwise printout
960 Last_U
:= ALIs
.Table
(Id
).Last_Unit
;
962 Last_U
:= ALIs
.Table
(Id
).First_Unit
;
965 for U
in ALIs
.Table
(Id
).First_Unit
.. Last_U
loop
966 if U
/= ALIs
.Table
(Id
).First_Unit
967 and then Selective_Output
975 -- Output source now, unless if it will be done as part of
976 -- outputting dependencies.
978 if not (Dependable
and then Print_Source
) then
979 Output_Source
(Corresponding_Sdep_Entry
(Id
, U
));
983 -- Print out list of dependable units
985 if Dependable
and then Print_Source
then
987 Write_Str
("depends upon");
996 ALIs
.Table
(Id
).First_Sdep
.. ALIs
.Table
(Id
).Last_Sdep
999 or else not Is_Internal_File_Name
(Sdep
.Table
(D
).Sfile
)
1001 if Verbose_Mode
then
1011 Write_Str
(Spaces
(1 .. Source_Start
- 2));
1024 -- All done. Set proper exit status.
1027 Exit_Program
(E_Success
);