with ALI; use ALI;
with ALI.Util; use ALI.Util;
with Binderr; use Binderr;
with Butil; use Butil;
with Csets; use Csets;
with Fname; use Fname;
with Gnatvsn; use Gnatvsn;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
with Osint.L; use Osint.L;
with Output; use Output;
with Rident; use Rident;
with Sdefault;
with Snames;
with Targparm; use Targparm;
with Types; use Types;
with GNAT.Case_Util; use GNAT.Case_Util;
procedure Gnatls is
pragma Ident (Gnat_Static_Version_String);
Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
Project_Search_Path : constant String := "Project Search Path:";
No_Project_Default_Dir : constant String := "-";
Max_Column : constant := 80;
No_Obj : aliased String := "<no_obj>";
type File_Status is (
OK, Checksum_OK, Not_Found, Not_Same, Not_First_On_PATH);
type Dir_Data;
type Dir_Ref is access Dir_Data;
type Dir_Data is record
Value : String_Access;
Next : Dir_Ref;
end record;
First_Source_Dir : Dir_Ref;
Last_Source_Dir : Dir_Ref;
First_Lib_Dir : Dir_Ref;
Last_Lib_Dir : Dir_Ref;
Main_File : File_Name_Type;
Ali_File : File_Name_Type;
Text : Text_Buffer_Ptr;
Next_Arg : Positive;
Too_Long : Boolean := False;
Selective_Output : Boolean := False;
Print_Usage : Boolean := False;
Print_Unit : Boolean := True;
Print_Source : Boolean := True;
Print_Object : Boolean := True;
Dependable : Boolean := False; Also_Predef : Boolean := False;
Very_Verbose_Mode : Boolean := False;
Unit_Start : Integer;
Unit_End : Integer;
Source_Start : Integer;
Source_End : Integer;
Object_Start : Integer;
Object_End : Integer;
Spaces : constant String (1 .. Max_Column) := (others => ' ');
RTS_Specified : String_Access := null;
procedure Add_Lib_Dir (Dir : String);
procedure Add_Source_Dir (Dir : String);
procedure Find_General_Layout;
procedure Find_Status
(FS : in out File_Name_Type;
Stamp : Time_Stamp_Type;
Checksum : Word;
Status : out File_Status);
function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
procedure Output_Object (O : File_Name_Type);
procedure Output_Source (Sdep_I : Sdep_Id);
procedure Output_Status (FS : File_Status; Verbose : Boolean);
procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id);
procedure Reset_Print;
procedure Scan_Ls_Arg (Argv : String);
procedure Usage;
function Image (Restriction : Restriction_Id) return String;
package GLADE is
procedure Output_ALI (A : ALI_Id);
procedure Output_No_ALI (Afile : File_Name_Type);
end GLADE;
procedure Add_Lib_Dir (Dir : String) is
begin
if First_Lib_Dir = null then
First_Lib_Dir :=
new Dir_Data'
(Value => new String'(Dir),
Next => null);
Last_Lib_Dir := First_Lib_Dir;
else
Last_Lib_Dir.Next :=
new Dir_Data'
(Value => new String'(Dir),
Next => null);
Last_Lib_Dir := Last_Lib_Dir.Next;
end if;
end Add_Lib_Dir;
procedure Add_Source_Dir (Dir : String) is
begin
if First_Source_Dir = null then
First_Source_Dir :=
new Dir_Data'
(Value => new String'(Dir),
Next => null);
Last_Source_Dir := First_Source_Dir;
else
Last_Source_Dir.Next :=
new Dir_Data'
(Value => new String'(Dir),
Next => null);
Last_Source_Dir := Last_Source_Dir.Next;
end if;
end Add_Source_Dir;
function Corresponding_Sdep_Entry
(A : ALI_Id;
U : Unit_Id) return Sdep_Id
is
begin
for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
return D;
end if;
end loop;
Error_Msg_Name_1 := Units.Table (U).Uname;
Error_Msg_Name_2 := ALIs.Table (A).Afile;
Write_Eol;
Error_Msg ("wrong ALI format, can't find dependency line for & in %");
Exit_Program (E_Fatal);
end Corresponding_Sdep_Entry;
procedure Find_General_Layout is
Max_Unit_Length : Integer := 11;
Max_Src_Length : Integer := 11;
Max_Obj_Length : Integer := 11;
Len : Integer;
FS : File_Name_Type;
begin
for Id in ALIs.First .. ALIs.Last loop
Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
if Also_Predef or else not Is_Internal_Unit then
if Print_Unit then
Len := Name_Len - 1;
Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
end if;
if Print_Source then
FS := Full_Source_Name (ALIs.Table (Id).Sfile);
if FS = No_File then
Get_Name_String (ALIs.Table (Id).Sfile);
Name_Len := Name_Len + 13;
else
Get_Name_String (FS);
end if;
Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
end if;
if Print_Object then
if ALIs.Table (Id).No_Object then
Max_Obj_Length :=
Integer'Max (Max_Obj_Length, No_Obj'Length);
else
Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
end if;
end if;
end if;
end loop;
Too_Long :=
Verbose_Mode
or else
(Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
Object_Start := 1;
Object_End := Object_Start - 1;
if Print_Object then
Object_End := Object_Start + Max_Obj_Length;
end if;
Unit_Start := Object_End + 1;
Unit_End := Unit_Start - 1;
if Print_Unit then
Unit_End := Unit_Start + Max_Unit_Length;
end if;
Source_Start := Unit_End + 1;
if Source_Start > Spaces'Last then
Source_Start := Spaces'Last;
end if;
Source_End := Source_Start - 1;
if Print_Source then
Source_End := Source_Start + Max_Src_Length;
end if;
end Find_General_Layout;
procedure Find_Status
(FS : in out File_Name_Type;
Stamp : Time_Stamp_Type;
Checksum : Word;
Status : out File_Status)
is
Tmp1 : File_Name_Type;
Tmp2 : File_Name_Type;
begin
Tmp1 := Full_Source_Name (FS);
if Tmp1 = No_File then
Status := Not_Found;
elsif File_Stamp (Tmp1) = Stamp then
FS := Tmp1;
Status := OK;
elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
FS := Tmp1;
Status := Checksum_OK;
else
Tmp2 := Matching_Full_Source_Name (FS, Stamp);
if Tmp2 = No_File then
Status := Not_Same;
FS := Tmp1;
else
Status := Not_First_On_PATH;
FS := Tmp2;
end if;
end if;
end Find_Status;
package body GLADE is
N_Flags : Natural;
N_Indents : Natural := 0;
type Token_Type is
(T_No_ALI,
T_ALI,
T_Unit,
T_With,
T_Source,
T_Afile,
T_Ofile,
T_Sfile,
T_Name,
T_Main,
T_Kind,
T_Flags,
T_Preelaborated,
T_Pure,
T_Has_RACW,
T_Remote_Types,
T_Shared_Passive,
T_RCI,
T_Predefined,
T_Internal,
T_Is_Generic,
T_Procedure,
T_Function,
T_Package,
T_Subprogram,
T_Spec,
T_Body);
Image : constant array (Token_Type) of String_Access :=
(T_No_ALI => new String'("No_ALI"),
T_ALI => new String'("ALI"),
T_Unit => new String'("Unit"),
T_With => new String'("With"),
T_Source => new String'("Source"),
T_Afile => new String'("Afile"),
T_Ofile => new String'("Ofile"),
T_Sfile => new String'("Sfile"),
T_Name => new String'("Name"),
T_Main => new String'("Main"),
T_Kind => new String'("Kind"),
T_Flags => new String'("Flags"),
T_Preelaborated => new String'("Preelaborated"),
T_Pure => new String'("Pure"),
T_Has_RACW => new String'("Has_RACW"),
T_Remote_Types => new String'("Remote_Types"),
T_Shared_Passive => new String'("Shared_Passive"),
T_RCI => new String'("RCI"),
T_Predefined => new String'("Predefined"),
T_Internal => new String'("Internal"),
T_Is_Generic => new String'("Is_Generic"),
T_Procedure => new String'("procedure"),
T_Function => new String'("function"),
T_Package => new String'("package"),
T_Subprogram => new String'("subprogram"),
T_Spec => new String'("spec"),
T_Body => new String'("body"));
procedure Output_Name (N : Name_Id);
procedure Output_Afile (A : File_Name_Type);
procedure Output_Ofile (O : File_Name_Type);
procedure Output_Sfile (S : File_Name_Type);
procedure Output_Token (T : Token_Type);
procedure Output_Sdep (S : Sdep_Id);
procedure Output_Unit (U : Unit_Id);
procedure Output_With (W : With_Id);
procedure Output_Afile (A : File_Name_Type) is
begin
if A /= No_File then
Output_Token (T_Afile);
Write_Name (A);
Write_Eol;
end if;
end Output_Afile;
procedure Output_ALI (A : ALI_Id) is
begin
Output_Token (T_ALI);
N_Indents := N_Indents + 1;
Output_Afile (ALIs.Table (A).Afile);
Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
Output_Sfile (ALIs.Table (A).Sfile);
if ALIs.Table (A).Main_Program /= None then
Output_Token (T_Main);
if ALIs.Table (A).Main_Program = Proc then
Output_Token (T_Procedure);
else
Output_Token (T_Function);
end if;
Write_Eol;
end if;
for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
Output_Unit (U);
end loop;
for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
Output_Sdep (S);
end loop;
N_Indents := N_Indents - 1;
end Output_ALI;
procedure Output_No_ALI (Afile : File_Name_Type) is
begin
Output_Token (T_No_ALI);
N_Indents := N_Indents + 1;
Output_Afile (Afile);
N_Indents := N_Indents - 1;
end Output_No_ALI;
procedure Output_Name (N : Name_Id) is
begin
Get_Name_String (N);
if Name_Len > 2
and then Name_Buffer (Name_Len - 1) = '%'
then
Name_Len := Name_Len - 2;
end if;
Output_Token (T_Name);
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Eol;
end Output_Name;
procedure Output_Ofile (O : File_Name_Type) is
begin
if O /= No_File then
Output_Token (T_Ofile);
Write_Name (O);
Write_Eol;
end if;
end Output_Ofile;
procedure Output_Sdep (S : Sdep_Id) is
begin
Output_Token (T_Source);
Write_Name (Sdep.Table (S).Sfile);
Write_Eol;
end Output_Sdep;
procedure Output_Sfile (S : File_Name_Type) is
FS : File_Name_Type := S;
begin
if FS /= No_File then
FS := Full_Source_Name (FS);
if FS = No_File then
Get_Name_String (S);
if Name_Len > 4
and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
then
Name_Buffer (Name_Len) := 's';
FS := Full_Source_Name (Name_Find);
end if;
end if;
end if;
if FS /= No_File then
Output_Token (T_Sfile);
Write_Name (FS);
Write_Eol;
end if;
end Output_Sfile;
procedure Output_Token (T : Token_Type) is
begin
if T in T_No_ALI .. T_Flags then
for J in 1 .. N_Indents loop
Write_Str (" ");
end loop;
Write_Str (Image (T).all);
for J in Image (T)'Length .. 12 loop
Write_Char (' ');
end loop;
Write_Str ("=>");
if T in T_No_ALI .. T_With then
Write_Eol;
elsif T in T_Source .. T_Name then
Write_Char (' ');
end if;
elsif T in T_Preelaborated .. T_Body then
if T in T_Preelaborated .. T_Is_Generic then
if N_Flags = 0 then
Output_Token (T_Flags);
end if;
N_Flags := N_Flags + 1;
end if;
Write_Char (' ');
Write_Str (Image (T).all);
else
Write_Str (Image (T).all);
end if;
end Output_Token;
procedure Output_Unit (U : Unit_Id) is
begin
Output_Token (T_Unit);
N_Indents := N_Indents + 1;
Output_Name (Units.Table (U).Uname);
Output_Token (T_Kind);
if Units.Table (U).Unit_Kind = 'p' then
Output_Token (T_Package);
else
Output_Token (T_Subprogram);
end if;
if Name_Buffer (Name_Len) = 's' then
Output_Token (T_Spec);
else
Output_Token (T_Body);
end if;
Write_Eol;
Output_Sfile (Units.Table (U).Sfile);
N_Flags := 0;
if Units.Table (U).Preelab then
Output_Token (T_Preelaborated);
end if;
if Units.Table (U).Pure then
Output_Token (T_Pure);
end if;
if Units.Table (U).Has_RACW then
Output_Token (T_Has_RACW);
end if;
if Units.Table (U).Remote_Types then
Output_Token (T_Remote_Types);
end if;
if Units.Table (U).Shared_Passive then
Output_Token (T_Shared_Passive);
end if;
if Units.Table (U).RCI then
Output_Token (T_RCI);
end if;
if Units.Table (U).Predefined then
Output_Token (T_Predefined);
end if;
if Units.Table (U).Internal then
Output_Token (T_Internal);
end if;
if Units.Table (U).Is_Generic then
Output_Token (T_Is_Generic);
end if;
if N_Flags > 0 then
Write_Eol;
end if;
for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
Output_With (W);
end loop;
N_Indents := N_Indents - 1;
end Output_Unit;
procedure Output_With (W : With_Id) is
begin
Output_Token (T_With);
N_Indents := N_Indents + 1;
Output_Name (Withs.Table (W).Uname);
Output_Token (T_Kind);
if Name_Buffer (Name_Len) = 's' then
Output_Token (T_Spec);
else
Output_Token (T_Body);
end if;
Write_Eol;
Output_Afile (Withs.Table (W).Afile);
Output_Sfile (Withs.Table (W).Sfile);
N_Indents := N_Indents - 1;
end Output_With;
end GLADE;
function Image (Restriction : Restriction_Id) return String is
Result : String := Restriction'Img;
Skip : Boolean := True;
begin
for J in Result'Range loop
if Skip then
Skip := False;
Result (J) := To_Upper (Result (J));
elsif Result (J) = '_' then
Skip := True;
else
Result (J) := To_Lower (Result (J));
end if;
end loop;
return Result;
end Image;
procedure Output_Object (O : File_Name_Type) is
Object_Name : String_Access;
begin
if Print_Object then
if O /= No_File then
Get_Name_String (O);
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
else
Object_Name := No_Obj'Unchecked_Access;
end if;
Write_Str (Object_Name.all);
if Print_Source or else Print_Unit then
if Too_Long then
Write_Eol;
Write_Str (" ");
else
Write_Str (Spaces
(Object_Start + Object_Name'Length .. Object_End));
end if;
end if;
end if;
end Output_Object;
procedure Output_Source (Sdep_I : Sdep_Id) is
Stamp : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
Checksum : constant Word := Sdep.Table (Sdep_I).Checksum;
FS : File_Name_Type := Sdep.Table (Sdep_I).Sfile;
Status : File_Status;
Object_Name : String_Access;
begin
if Print_Source then
Find_Status (FS, Stamp, Checksum, Status);
Get_Name_String (FS);
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
if Verbose_Mode then
Write_Str (" Source => ");
Write_Str (Object_Name.all);
if not Too_Long then
Write_Str
(Spaces (Source_Start + Object_Name'Length .. Source_End));
end if;
Output_Status (Status, Verbose => True);
Write_Eol;
Write_Str (" ");
else
if not Selective_Output then
Output_Status (Status, Verbose => False);
end if;
Write_Str (Object_Name.all);
end if;
end if;
end Output_Source;
procedure Output_Status (FS : File_Status; Verbose : Boolean) is
begin
if Verbose then
case FS is
when OK =>
Write_Str (" unchanged");
when Checksum_OK =>
Write_Str (" slightly modified");
when Not_Found =>
Write_Str (" file not found");
when Not_Same =>
Write_Str (" modified");
when Not_First_On_PATH =>
Write_Str (" unchanged version not first on PATH");
end case;
else
case FS is
when OK =>
Write_Str (" OK ");
when Checksum_OK =>
Write_Str (" MOK ");
when Not_Found =>
Write_Str (" ??? ");
when Not_Same =>
Write_Str (" DIF ");
when Not_First_On_PATH =>
Write_Str (" HID ");
end case;
end if;
end Output_Status;
procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
Kind : Character;
U : Unit_Record renames Units.Table (U_Id);
begin
if Print_Unit then
Get_Name_String (U.Uname);
Kind := Name_Buffer (Name_Len);
Name_Len := Name_Len - 2;
if not Verbose_Mode then
Write_Str (Name_Buffer (1 .. Name_Len));
else
Write_Str ("Unit => ");
Write_Eol;
Write_Str (" Name => ");
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Eol;
Write_Str (" Kind => ");
if Units.Table (U_Id).Unit_Kind = 'p' then
Write_Str ("package ");
else
Write_Str ("subprogram ");
end if;
if Kind = 's' then
Write_Str ("spec");
else
Write_Str ("body");
end if;
end if;
if Verbose_Mode then
if U.Preelab or
U.No_Elab or
U.Pure or
U.Dynamic_Elab or
U.Has_RACW or
U.Remote_Types or
U.Shared_Passive or
U.RCI or
U.Predefined or
U.Internal or
U.Is_Generic or
U.Init_Scalars or
U.SAL_Interface or
U.Body_Needed_For_SAL or
U.Elaborate_Body
then
Write_Eol;
Write_Str (" Flags =>");
if U.Preelab then
Write_Str (" Preelaborable");
end if;
if U.No_Elab then
Write_Str (" No_Elab_Code");
end if;
if U.Pure then
Write_Str (" Pure");
end if;
if U.Dynamic_Elab then
Write_Str (" Dynamic_Elab");
end if;
if U.Has_RACW then
Write_Str (" Has_RACW");
end if;
if U.Remote_Types then
Write_Str (" Remote_Types");
end if;
if U.Shared_Passive then
Write_Str (" Shared_Passive");
end if;
if U.RCI then
Write_Str (" RCI");
end if;
if U.Predefined then
Write_Str (" Predefined");
end if;
if U.Internal then
Write_Str (" Internal");
end if;
if U.Is_Generic then
Write_Str (" Is_Generic");
end if;
if U.Init_Scalars then
Write_Str (" Init_Scalars");
end if;
if U.SAL_Interface then
Write_Str (" SAL_Interface");
end if;
if U.Body_Needed_For_SAL then
Write_Str (" Body_Needed_For_SAL");
end if;
if U.Elaborate_Body then
Write_Str (" Elaborate Body");
end if;
if U.Remote_Types then
Write_Str (" Remote_Types");
end if;
if U.Shared_Passive then
Write_Str (" Shared_Passive");
end if;
if U.Predefined then
Write_Str (" Predefined");
end if;
end if;
declare
Restrictions : constant Restrictions_Info :=
ALIs.Table (ALI).Restrictions;
begin
if Restrictions.Set /= (All_Restrictions => False) then
Write_Eol;
Write_Str (" pragma Restrictions =>");
for Restriction in All_Restrictions loop
if Restrictions.Set (Restriction) then
Write_Eol;
Write_Str (" ");
Write_Str (Image (Restriction));
if Restriction in All_Parameter_Restrictions then
Write_Str (" =>");
Write_Str (Restrictions.Value (Restriction)'Img);
end if;
end if;
end loop;
end if;
if Restrictions.Violated /= (All_Restrictions => False) then
Write_Eol;
Write_Str (" Restrictions violated =>");
for Restriction in All_Restrictions loop
if Restrictions.Violated (Restriction) then
Write_Eol;
Write_Str (" ");
Write_Str (Image (Restriction));
if Restriction in All_Parameter_Restrictions then
if Restrictions.Count (Restriction) > 0 then
Write_Str (" =>");
if Restrictions.Unknown (Restriction) then
Write_Str (" at least");
end if;
Write_Str (Restrictions.Count (Restriction)'Img);
end if;
end if;
end if;
end loop;
end if;
end;
end if;
if Print_Source then
if Too_Long then
Write_Eol;
Write_Str (" ");
else
Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
end if;
end if;
end if;
end Output_Unit;
procedure Reset_Print is
begin
if not Selective_Output then
Selective_Output := True;
Print_Source := False;
Print_Object := False;
Print_Unit := False;
end if;
end Reset_Print;
procedure Scan_Ls_Arg (Argv : String) is
FD : File_Descriptor;
Len : Integer;
begin
pragma Assert (Argv'First = 1);
if Argv'Length = 0 then
return;
end if;
if Argv (1) = '-' then
if Argv'Length = 1 then
Fail ("switch character cannot be followed by a blank");
elsif Argv (2 .. Argv'Last) = "I-" then
Opt.Look_In_Primary_Dir := False;
elsif (Argv'Length = 3 and then Argv (3) = '-')
or else (Argv'Length = 4 and then Argv (4) = '-')
then
Fail ("Trailing ""-"" at the end of ", Argv, " forbidden.");
elsif Argv (2) = 'I' then
Add_Source_Dir (Argv (3 .. Argv'Last));
Add_Lib_Dir (Argv (3 .. Argv'Last));
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
Add_Source_Dir (Argv (4 .. Argv'Last));
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
Add_Lib_Dir (Argv (4 .. Argv'Last));
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
Add_Lib_Dir (Argv (4 .. Argv'Last));
elsif Argv (2 .. Argv'Last) = "nostdinc" then
Opt.No_Stdinc := True;
elsif Argv'Length = 2 then
case Argv (2) is
when 'a' => Also_Predef := True;
when 'h' => Print_Usage := True;
when 'u' => Reset_Print; Print_Unit := True;
when 's' => Reset_Print; Print_Source := True;
when 'o' => Reset_Print; Print_Object := True;
when 'v' => Verbose_Mode := True;
when 'd' => Dependable := True;
when 'V' => Very_Verbose_Mode := True;
when others => null;
end case;
elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
if FD = Invalid_FD then
Osint.Fail ("could not find text file """ &
Argv (8 .. Argv'Last) & '"');
end if;
Len := Integer (File_Length (FD));
declare
Buffer : String (1 .. Len + 1);
Index : Positive := 1;
Last : Positive;
begin
Len := Read (FD, Buffer (1)'Address, Len);
Buffer (Buffer'Last) := ASCII.NUL;
Close (FD);
while Index < Buffer'Last loop
Last := Index;
while Last <= Buffer'Last
and then Buffer (Last) /= ASCII.LF
and then Buffer (Last) /= ASCII.CR
loop
Last := Last + 1;
end loop;
if Last > Index then
Add_File (Buffer (Index .. Last - 1));
end if;
Index := Last;
while Buffer (Index) = ASCII.CR or else
Buffer (Index) = ASCII.LF
loop
Index := Index + 1;
end loop;
end loop;
end;
elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
if Argv'Length <= 6 or else Argv (6) /= '='then
Osint.Fail ("missing path for --RTS");
else
if RTS_Specified = null then
RTS_Specified := new String'(Argv (7 .. Argv'Last));
elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
Osint.Fail ("--RTS cannot be specified multiple times");
end if;
Opt.No_Stdinc := True;
Opt.RTS_Switch := True;
declare
Src_Path_Name : constant String_Ptr :=
String_Ptr
(Get_RTS_Search_Dir
(Argv (7 .. Argv'Last), Include));
Lib_Path_Name : constant String_Ptr :=
String_Ptr
(Get_RTS_Search_Dir
(Argv (7 .. Argv'Last), Objects));
begin
if Src_Path_Name /= null
and then Lib_Path_Name /= null
then
Add_Search_Dirs (Src_Path_Name, Include);
Add_Search_Dirs (Lib_Path_Name, Objects);
elsif Src_Path_Name = null
and then Lib_Path_Name = null
then
Osint.Fail ("RTS path not valid: missing " &
"adainclude and adalib directories");
elsif Src_Path_Name = null then
Osint.Fail ("RTS path not valid: missing " &
"adainclude directory");
elsif Lib_Path_Name = null then
Osint.Fail ("RTS path not valid: missing " &
"adalib directory");
end if;
end;
end if;
end if;
else
Add_File (Argv);
end if;
end Scan_Ls_Arg;
procedure Usage is
begin
Write_Str ("Usage: ");
Osint.Write_Program_Name;
Write_Str (" switches [list of object files]");
Write_Eol;
Write_Eol;
Write_Str ("switches:");
Write_Eol;
Write_Str (" -a also output relevant predefined units");
Write_Eol;
Write_Str (" -u output only relevant unit names");
Write_Eol;
Write_Str (" -h output this help message");
Write_Eol;
Write_Str (" -s output only relevant source names");
Write_Eol;
Write_Str (" -o output only relevant object names");
Write_Eol;
Write_Str (" -d output sources on which specified units " &
"depend");
Write_Eol;
Write_Str (" -v verbose output, full path and unit " &
"information");
Write_Eol;
Write_Eol;
Write_Str (" -files=fil files are listed in text file 'fil'");
Write_Eol;
Write_Str (" -aIdir specify source files search path");
Write_Eol;
Write_Str (" -aOdir specify object files search path");
Write_Eol;
Write_Str (" -Idir like -aIdir -aOdir");
Write_Eol;
Write_Str (" -I- do not look for sources & object files");
Write_Str (" in the default directory");
Write_Eol;
Write_Str (" -nostdinc do not look for source files");
Write_Str (" in the system default directory");
Write_Eol;
Write_Str (" --RTS=dir specify the default source and object search"
& " path");
Write_Eol;
Write_Eol;
Write_Str (" file status can be:");
Write_Eol;
for ST in File_Status loop
Write_Str (" ");
Output_Status (ST, Verbose => False);
Write_Str (" ==> ");
Output_Status (ST, Verbose => True);
Write_Eol;
end loop;
end Usage;
begin
Namet.Initialize;
Csets.Initialize;
Snames.Initialize;
Next_Arg := 1;
Scan_Args : while Next_Arg < Arg_Count loop
declare
Next_Argv : String (1 .. Len_Arg (Next_Arg));
begin
Fill_Arg (Next_Argv'Address, Next_Arg);
Scan_Ls_Arg (Next_Argv);
end;
Next_Arg := Next_Arg + 1;
end loop Scan_Args;
while First_Source_Dir /= null loop
Add_Src_Search_Dir (First_Source_Dir.Value.all);
First_Source_Dir := First_Source_Dir.Next;
end loop;
while First_Lib_Dir /= null loop
Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
First_Lib_Dir := First_Lib_Dir.Next;
end loop;
Osint.Add_Default_Search_Dirs;
if Verbose_Mode then
Targparm.Get_Target_Parameters;
Write_Eol;
Write_Str ("GNATLS ");
Write_Str (Gnat_Version_String);
Write_Eol;
Write_Str ("Copyright 1997-" &
Current_Year &
", Free Software Foundation, Inc.");
Write_Eol;
Write_Eol;
Write_Str ("Source Search Path:");
Write_Eol;
for J in 1 .. Nb_Dir_In_Src_Search_Path loop
Write_Str (" ");
if Dir_In_Src_Search_Path (J)'Length = 0 then
Write_Str ("<Current_Directory>");
else
Write_Str (To_Host_Dir_Spec
(Dir_In_Src_Search_Path (J).all, True).all);
end if;
Write_Eol;
end loop;
Write_Eol;
Write_Eol;
Write_Str ("Object Search Path:");
Write_Eol;
for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
Write_Str (" ");
if Dir_In_Obj_Search_Path (J)'Length = 0 then
Write_Str ("<Current_Directory>");
else
Write_Str (To_Host_Dir_Spec
(Dir_In_Obj_Search_Path (J).all, True).all);
end if;
Write_Eol;
end loop;
Write_Eol;
Write_Eol;
Write_Str (Project_Search_Path);
Write_Eol;
Write_Str (" <Current_Directory>");
Write_Eol;
declare
Project_Path : constant String_Access := Getenv (Ada_Project_Path);
Lib : constant String :=
Directory_Separator & "lib" & Directory_Separator;
First : Natural;
Last : Natural;
Add_Default_Dir : Boolean := True;
begin
if Project_Path.all /= "" then
First := Project_Path'First;
loop
while First <= Project_Path'Last
and then (Project_Path (First) = Path_Separator)
loop
First := First + 1;
end loop;
exit when First > Project_Path'Last;
Last := First;
while Last < Project_Path'Last
and then Project_Path (Last + 1) /= Path_Separator
loop
Last := Last + 1;
end loop;
if Project_Path (First .. Last) = No_Project_Default_Dir then
Add_Default_Dir := False;
elsif First /= Last or else Project_Path (First) /= '.' then
Write_Str (" ");
Write_Str (Project_Path (First .. Last));
Write_Eol;
end if;
First := Last + 1;
end loop;
end if;
if Add_Default_Dir then
Name_Len := 0;
Add_Str_To_Name_Buffer (Sdefault.Search_Dir_Prefix.all);
if Directory_Separator /= '/' then
for J in 1 .. Name_Len loop
if Name_Buffer (J) = '/' then
Name_Buffer (J) := Directory_Separator;
end if;
end loop;
end if;
while Name_Len >= Lib'Length
and then Name_Buffer (Name_Len - 4 .. Name_Len) /= Lib
loop
Name_Len := Name_Len - 1;
end loop;
if Name_Len >= 5 then
Write_Str (" ");
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Str ("gnat");
Write_Char (Directory_Separator);
Write_Eol;
end if;
end if;
end;
Write_Eol;
end if;
if Print_Usage then
Usage;
end if;
if not More_Lib_Files then
if not Print_Usage and then not Verbose_Mode then
Usage;
end if;
Exit_Program (E_Fatal);
end if;
Initialize_ALI;
Initialize_ALI_Source;
while More_Lib_Files loop
Main_File := Next_Main_Lib_File;
Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
if Ali_File = No_File then
if Very_Verbose_Mode then
GLADE.Output_No_ALI (Lib_File_Name (Main_File));
else
Write_Str ("Can't find library info for ");
Get_Name_String (Main_File);
Write_Char ('"'); Write_Str (Name_Buffer (1 .. Name_Len));
Write_Char ('"'); Write_Eol;
end if;
else
Ali_File := Strip_Directory (Ali_File);
if Get_Name_Table_Info (Ali_File) = 0 then
Text := Read_Library_Info (Ali_File, True);
declare
Discard : ALI_Id;
pragma Unreferenced (Discard);
begin
Discard :=
Scan_ALI
(Ali_File,
Text,
Ignore_ED => False,
Err => False,
Ignore_Errors => True);
end;
Free (Text);
end if;
end if;
end loop;
if Very_Verbose_Mode then
for A in ALIs.First .. ALIs.Last loop
GLADE.Output_ALI (A);
end loop;
return;
end if;
Find_General_Layout;
for Id in ALIs.First .. ALIs.Last loop
declare
Last_U : Unit_Id;
begin
Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
if Also_Predef or else not Is_Internal_Unit then
if ALIs.Table (Id).No_Object then
Output_Object (No_File);
else
Output_Object (ALIs.Table (Id).Ofile_Full_Name);
end if;
if Verbose_Mode then
Last_U := ALIs.Table (Id).Last_Unit;
else
Last_U := ALIs.Table (Id).First_Unit;
end if;
for U in ALIs.Table (Id).First_Unit .. Last_U loop
if U /= ALIs.Table (Id).First_Unit
and then Selective_Output
and then Print_Unit
then
Write_Eol;
end if;
Output_Unit (Id, U);
if not (Dependable and then Print_Source) then
Output_Source (Corresponding_Sdep_Entry (Id, U));
end if;
end loop;
if Dependable and then Print_Source then
if Verbose_Mode then
Write_Str ("depends upon");
Write_Eol;
Write_Str (" ");
else
Write_Eol;
end if;
for D in
ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
loop
if Also_Predef
or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
then
if Verbose_Mode then
Write_Str (" ");
Output_Source (D);
elsif Too_Long then
Write_Str (" ");
Output_Source (D);
Write_Eol;
else
Write_Str (Spaces (1 .. Source_Start - 2));
Output_Source (D);
Write_Eol;
end if;
end if;
end loop;
end if;
Write_Eol;
end if;
end;
end loop;
Namet.Finalize;
Exit_Program (E_Success);
end Gnatls;