44d6a70684
* 5ataprop.adb, 5atpopsp.adb, 5ftaprop.adb, 5gmastop.adb, 5gtaprop.adb, 5htaprop.adb, 5itaprop.adb, 5lintman.adb, 5omastop.adb, 5oosinte.adb, 5otaprop.adb, 5staprop.adb, 5vinterr.adb, 5vtaprop.adb, 5vtpopde.adb, 5wintman.adb, 5wtaprop.adb, 5zinterr.adb, 5ztaprop.adb, 6vcstrea.adb, 7sintman.adb, 7staprop.adb, 9drpc.adb, ChangeLog, Makefile.in, a-except.adb, a-tags.ads, a-tasatt.adb, a-teioed.adb, a-textio.ads, a-witeio.ads, a-wtedit.adb, ali.ads, comperr.adb, cstand.adb, einfo.ads, errout.adb, exp_ch11.adb, exp_ch2.adb, exp_ch3.adb, exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch9.adb, exp_util.adb, exp_util.ads, fname-uf.adb, g-cgi.ads, g-exctra.ads, g-expect.ads, g-regist.adb, g-spipat.adb, gnatchop.adb, gnatlink.adb, gnatls.adb, gnatmain.adb, gnatmem.adb, init.c, make.adb, make.ads, mdlltool.adb, nlists.ads, osint.ads, par-ch3.adb, par-ch4.adb, par-ch5.adb, par-ch6.adb, par.adb, repinfo.adb, s-fatflt.ads, s-fatlfl.ads, s-fatllf.ads, s-fatsfl.ads, s-finimp.adb, s-finimp.ads, s-interr.adb, s-secsta.ads, s-shasto.ads, s-stalib.adb, s-stalib.ads, s-tarest.ads, s-tasdeb.adb, s-tassta.adb, s-tassta.ads, s-vaflop.ads, scans.ads, scn.adb, sem.ads, sem_aggr.adb, sem_attr.adb, sem_case.ads, sem_ch10.adb, sem_ch12.adb, sem_ch13.adb, sem_ch3.adb, sem_ch3.ads, sem_ch5.adb, sem_ch7.adb, sem_ch8.adb, sem_ch8.ads, sem_type.adb, sem_util.ads, sinfo.ads, sprint.adb, tbuild.ads, types.ads, utils.c, xeinfo.adb: Fix spelling errors. From-SVN: r48055
1158 lines
33 KiB
Ada
1158 lines
33 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- G N A T L S --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- $Revision: 1.2 $
|
|
-- --
|
|
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 2, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
|
-- for more details. You should have received a copy of the GNU General --
|
|
-- Public License distributed with GNAT; see file COPYING. If not, write --
|
|
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
|
|
-- MA 02111-1307, USA. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with ALI; use ALI;
|
|
with ALI.Util; use ALI.Util;
|
|
with Binderr; use Binderr;
|
|
with Butil; use Butil;
|
|
with 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 Output; use Output;
|
|
with Prj; use Prj;
|
|
with Prj.Pars; use Prj.Pars;
|
|
with Prj.Env;
|
|
with Prj.Ext; use Prj.Ext;
|
|
with Prj.Util; use Prj.Util;
|
|
with Snames; use Snames;
|
|
with Stringt; use Stringt;
|
|
with Types; use Types;
|
|
|
|
procedure Gnatls is
|
|
pragma Ident (Gnat_Version_String);
|
|
|
|
Max_Column : constant := 80;
|
|
|
|
type File_Status is (
|
|
OK, -- matching timestamp
|
|
Checksum_OK, -- only matching checksum
|
|
Not_Found, -- file not found on source PATH
|
|
Not_Same, -- neither checksum nor timestamp matching
|
|
Not_First_On_PATH); -- matching file hidden by Not_Same file 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;
|
|
-- The list of source directories from the command line.
|
|
-- These directories are added using Osint.Add_Src_Search_Dir
|
|
-- after those of the GNAT Project File, if any.
|
|
|
|
First_Lib_Dir : Dir_Ref;
|
|
Last_Lib_Dir : Dir_Ref;
|
|
-- The list of object directories from the command line.
|
|
-- These directories are added using Osint.Add_Lib_Search_Dir
|
|
-- after those of the GNAT Project File, if any.
|
|
|
|
Main_File : File_Name_Type;
|
|
Ali_File : File_Name_Type;
|
|
|
|
Text : Text_Buffer_Ptr;
|
|
Id : ALI_Id;
|
|
|
|
Next_Arg : Positive;
|
|
|
|
Too_Long : Boolean := False;
|
|
-- When True, lines are too long for multi-column output and each
|
|
-- item of information is on a different line.
|
|
|
|
Project_File : String_Access;
|
|
Project : Prj.Project_Id;
|
|
Current_Verbosity : Prj.Verbosity := Prj.Default;
|
|
|
|
Selective_Output : Boolean := False;
|
|
Print_Usage : Boolean := False;
|
|
Print_Unit : Boolean := True;
|
|
Print_Source : Boolean := True;
|
|
Print_Object : Boolean := True;
|
|
-- Flags controlling the form of the outpout
|
|
|
|
Dependable : Boolean := False; -- flag -d
|
|
Also_Predef : Boolean := False;
|
|
|
|
Unit_Start : Integer;
|
|
Unit_End : Integer;
|
|
Source_Start : Integer;
|
|
Source_End : Integer;
|
|
Object_Start : Integer;
|
|
Object_End : Integer;
|
|
-- Various column starts and ends
|
|
|
|
Spaces : constant String (1 .. Max_Column) := (others => ' ');
|
|
|
|
-----------------------
|
|
-- Local Subprograms --
|
|
-----------------------
|
|
|
|
procedure Add_Lib_Dir (Dir : String; And_Save : Boolean);
|
|
-- Add an object directory, using Osint.Add_Lib_Search_Dir
|
|
-- if And_Save is False or keeping in the list First_Lib_Dir,
|
|
-- Last_Lib_Dir if And_Save is True.
|
|
|
|
procedure Add_Source_Dir (Dir : String; And_Save : Boolean);
|
|
-- Add a source directory, using Osint.Add_Src_Search_Dir
|
|
-- if And_Save is False or keeping in the list First_Source_Dir,
|
|
-- Last_Source_Dir if And_Save is True.
|
|
|
|
procedure Find_General_Layout;
|
|
-- Determine the structure of the output (multi columns or not, etc)
|
|
|
|
procedure Find_Status
|
|
(FS : in out File_Name_Type;
|
|
Stamp : Time_Stamp_Type;
|
|
Checksum : Word;
|
|
Status : out File_Status);
|
|
-- Determine the file status (Status) of the file represented by FS
|
|
-- with the expected Stamp and checksum given as argument. FS will be
|
|
-- updated to the full file name if available.
|
|
|
|
function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
|
|
-- Give the Sdep entry corresponding to the unit U in ali record A.
|
|
|
|
function Index (Char : Character; Str : String) return Natural;
|
|
-- Returns the first occurrence of Char in Str.
|
|
-- Returns 0 if Char is not in Str.
|
|
|
|
procedure Output_Object (O : File_Name_Type);
|
|
-- Print out the name of the object when requested
|
|
|
|
procedure Output_Source (Sdep_I : Sdep_Id);
|
|
-- Print out the name and status of the source corresponding to this
|
|
-- sdep entry
|
|
|
|
procedure Output_Status (FS : File_Status; Verbose : Boolean);
|
|
-- Print out FS either in a coded form if verbose is false or in an
|
|
-- expanded form otherwise.
|
|
|
|
procedure Output_Unit (U_Id : Unit_Id);
|
|
-- Print out information on the unit when requested
|
|
|
|
procedure Reset_Print;
|
|
-- Reset Print flags properly when selective output is chosen
|
|
|
|
procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean);
|
|
-- Scan and process lser specific arguments. Argv is a single argument.
|
|
|
|
procedure Usage;
|
|
-- Print usage message.
|
|
|
|
-----------------
|
|
-- Add_Lib_Dir --
|
|
-----------------
|
|
|
|
procedure Add_Lib_Dir (Dir : String; And_Save : Boolean) is
|
|
begin
|
|
if And_Save then
|
|
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;
|
|
|
|
else
|
|
Add_Lib_Search_Dir (Dir);
|
|
end if;
|
|
end Add_Lib_Dir;
|
|
|
|
-- -----------------
|
|
-- Add_Source_Dir --
|
|
--------------------
|
|
|
|
procedure Add_Source_Dir (Dir : String; And_Save : Boolean) is
|
|
begin
|
|
if And_Save then
|
|
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;
|
|
|
|
else
|
|
Add_Src_Search_Dir (Dir);
|
|
end if;
|
|
end Add_Source_Dir;
|
|
|
|
------------------------------
|
|
-- Corresponding_Sdep_Entry --
|
|
------------------------------
|
|
|
|
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);
|
|
|
|
-- Not needed since we exit the program but avoids compiler warning
|
|
|
|
raise Program_Error;
|
|
end Corresponding_Sdep_Entry;
|
|
|
|
-------------------------
|
|
-- Find_General_Layout --
|
|
-------------------------
|
|
|
|
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
|
|
-- Compute maximum of each column
|
|
|
|
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
|
|
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 loop;
|
|
|
|
-- Verify is output is not wider than maximum number of columns
|
|
|
|
Too_Long := Verbose_Mode or else
|
|
(Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
|
|
|
|
-- Set start and end of columns.
|
|
|
|
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;
|
|
|
|
-----------------
|
|
-- Find_Status --
|
|
-----------------
|
|
|
|
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;
|
|
|
|
-----------
|
|
-- Index --
|
|
-----------
|
|
|
|
function Index (Char : Character; Str : String) return Natural is
|
|
begin
|
|
for Index in Str'Range loop
|
|
if Str (Index) = Char then
|
|
return Index;
|
|
end if;
|
|
end loop;
|
|
|
|
return 0;
|
|
end Index;
|
|
|
|
-------------------
|
|
-- Output_Object --
|
|
-------------------
|
|
|
|
procedure Output_Object (O : File_Name_Type) is
|
|
Object_Name : String_Access;
|
|
begin
|
|
if Print_Object then
|
|
Get_Name_String (O);
|
|
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
|
|
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;
|
|
|
|
-------------------
|
|
-- Output_Source --
|
|
-------------------
|
|
|
|
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;
|
|
|
|
-------------------
|
|
-- Output_Status --
|
|
-------------------
|
|
|
|
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;
|
|
|
|
-----------------
|
|
-- Output_Unit --
|
|
-----------------
|
|
|
|
procedure Output_Unit (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.Elaborate_Body or
|
|
U.Remote_Types or
|
|
U.Shared_Passive or
|
|
U.RCI or
|
|
U.Predefined
|
|
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.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;
|
|
|
|
if U.RCI then
|
|
Write_Str (" Remote_Call_Interface");
|
|
end if;
|
|
end if;
|
|
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;
|
|
|
|
-----------------
|
|
-- Reset_Print --
|
|
-----------------
|
|
|
|
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;
|
|
|
|
-------------------
|
|
-- Scan_Ls_Arg --
|
|
-------------------
|
|
|
|
procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean) is
|
|
begin
|
|
pragma Assert (Argv'First = 1);
|
|
|
|
if Argv'Length = 0 then
|
|
return;
|
|
end if;
|
|
|
|
if Argv (1) = Switch_Character or else Argv (1) = '-' then
|
|
|
|
if Argv'Length = 1 then
|
|
Fail ("switch character cannot be followed by a blank");
|
|
|
|
-- -I-
|
|
|
|
elsif Argv (2 .. Argv'Last) = "I-" then
|
|
Opt.Look_In_Primary_Dir := False;
|
|
|
|
-- Forbid -?- or -??- where ? is any character
|
|
|
|
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.");
|
|
|
|
-- -Idir
|
|
|
|
elsif Argv (2) = 'I' then
|
|
Add_Source_Dir (Argv (3 .. Argv'Last), And_Save);
|
|
Add_Lib_Dir (Argv (3 .. Argv'Last), And_Save);
|
|
|
|
-- -aIdir (to gcc this is like a -I switch)
|
|
|
|
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
|
|
Add_Source_Dir (Argv (4 .. Argv'Last), And_Save);
|
|
|
|
-- -aOdir
|
|
|
|
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
|
|
Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
|
|
|
|
-- -aLdir (to gnatbind this is like a -aO switch)
|
|
|
|
elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
|
|
Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
|
|
|
|
-- -vPx
|
|
|
|
elsif Argv'Length = 4 and then Argv (2 .. 3) = "vP" then
|
|
case Argv (4) is
|
|
when '0' =>
|
|
Current_Verbosity := Prj.Default;
|
|
when '1' =>
|
|
Current_Verbosity := Prj.Medium;
|
|
when '2' =>
|
|
Current_Verbosity := Prj.High;
|
|
when others =>
|
|
null;
|
|
end case;
|
|
|
|
-- -Pproject_file
|
|
|
|
elsif Argv'Length >= 3 and then Argv (2) = 'P' then
|
|
if Project_File /= null then
|
|
Fail (Argv & ": second project file forbidden (first is """ &
|
|
Project_File.all & """)");
|
|
else
|
|
Project_File := new String'(Argv (3 .. Argv'Last));
|
|
end if;
|
|
|
|
-- -Xexternal=value
|
|
|
|
elsif Argv'Length >= 5 and then Argv (2) = 'X' then
|
|
declare
|
|
Equal_Pos : constant Natural :=
|
|
Index ('=', Argv (3 .. Argv'Last));
|
|
begin
|
|
if Equal_Pos >= 4 and then
|
|
Equal_Pos /= Argv'Last then
|
|
Add (External_Name => Argv (3 .. Equal_Pos - 1),
|
|
Value => Argv (Equal_Pos + 1 .. Argv'Last));
|
|
else
|
|
Fail (Argv & " is not a valid external assignment.");
|
|
end if;
|
|
end;
|
|
|
|
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 others => null;
|
|
end case;
|
|
end if;
|
|
|
|
-- If not a switch it must be a file name
|
|
|
|
else
|
|
Set_Main_File_Name (Argv);
|
|
end if;
|
|
end Scan_Ls_Arg;
|
|
|
|
-----------
|
|
-- Usage --
|
|
-----------
|
|
|
|
procedure Usage is
|
|
procedure Write_Switch_Char;
|
|
-- Write two spaces followed by appropriate switch character
|
|
|
|
procedure Write_Switch_Char is
|
|
begin
|
|
Write_Str (" ");
|
|
Write_Char (Switch_Character);
|
|
end Write_Switch_Char;
|
|
|
|
-- Start of processing for Usage
|
|
|
|
begin
|
|
-- Usage line
|
|
|
|
Write_Str ("Usage: ");
|
|
Osint.Write_Program_Name;
|
|
Write_Str (" switches [list of object files]");
|
|
Write_Eol;
|
|
Write_Eol;
|
|
|
|
-- GNATLS switches
|
|
|
|
Write_Str ("switches:");
|
|
Write_Eol;
|
|
|
|
-- Line for -a
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("a also output relevant predefined units");
|
|
Write_Eol;
|
|
|
|
-- Line for -u
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("u output only relevant unit names");
|
|
Write_Eol;
|
|
|
|
-- Line for -h
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("h output this help message");
|
|
Write_Eol;
|
|
|
|
-- Line for -s
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("s output only relevant source names");
|
|
Write_Eol;
|
|
|
|
-- Line for -o
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("o output only relevant object names");
|
|
Write_Eol;
|
|
|
|
-- Line for -d
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("d output sources on which specified units depend");
|
|
Write_Eol;
|
|
|
|
-- Line for -v
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("v verbose output, full path and unit information");
|
|
Write_Eol;
|
|
Write_Eol;
|
|
|
|
-- Line for -aI switch
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("aIdir specify source files search path");
|
|
Write_Eol;
|
|
|
|
-- Line for -aO switch
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("aOdir specify object files search path");
|
|
Write_Eol;
|
|
|
|
-- Line for -I switch
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("Idir like -aIdir -aOdir");
|
|
Write_Eol;
|
|
|
|
-- Line for -I- switch
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("I- do not look for sources & object files");
|
|
Write_Str (" in the default directory");
|
|
Write_Eol;
|
|
|
|
-- Line for -vPx
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("vPx verbosity for project file (0, 1 or 2)");
|
|
Write_Eol;
|
|
|
|
-- Line for -Pproject_file
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("Pprj use a project file prj");
|
|
Write_Eol;
|
|
|
|
-- Line for -Xexternal=value
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("Xext=val specify an external value.");
|
|
Write_Eol;
|
|
|
|
-- Line for -nostdinc
|
|
|
|
Write_Switch_Char;
|
|
Write_Str ("nostdinc do not look for source files");
|
|
Write_Str (" in the system default directory");
|
|
Write_Eol;
|
|
|
|
-- File Status explanation
|
|
|
|
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;
|
|
|
|
-- Start of processing for Gnatls
|
|
|
|
begin
|
|
Osint.Initialize (Binder);
|
|
|
|
Namet.Initialize;
|
|
Csets.Initialize;
|
|
|
|
Snames.Initialize;
|
|
|
|
Prj.Initialize;
|
|
|
|
-- Use low level argument routines to avoid dragging in the secondary stack
|
|
|
|
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, And_Save => True);
|
|
end;
|
|
|
|
Next_Arg := Next_Arg + 1;
|
|
end loop Scan_Args;
|
|
|
|
-- If a switch -P is used, parse the project file
|
|
|
|
if Project_File /= null then
|
|
|
|
Prj.Pars.Set_Verbosity (To => Current_Verbosity);
|
|
|
|
Prj.Pars.Parse
|
|
(Project => Project,
|
|
Project_File_Name => Project_File.all);
|
|
|
|
if Project = Prj.No_Project then
|
|
Fail ("""" & Project_File.all & """ processing failed");
|
|
end if;
|
|
|
|
-- Add the source directories and the object directories
|
|
-- to the searched directories.
|
|
|
|
declare
|
|
procedure Register_Source_Dirs is new
|
|
Prj.Env.For_All_Source_Dirs (Add_Src_Search_Dir);
|
|
|
|
procedure Register_Object_Dirs is new
|
|
Prj.Env.For_All_Object_Dirs (Add_Lib_Search_Dir);
|
|
|
|
begin
|
|
Register_Source_Dirs (Project);
|
|
Register_Object_Dirs (Project);
|
|
end;
|
|
|
|
-- Check if a package gnatls is in the project file and if there is
|
|
-- there is one, get the switches, if any, and scan them.
|
|
|
|
declare
|
|
Data : Prj.Project_Data := Prj.Projects.Table (Project);
|
|
Pkg : Prj.Package_Id :=
|
|
Prj.Util.Value_Of
|
|
(Name => Name_Gnatls,
|
|
In_Packages => Data.Decl.Packages);
|
|
Element : Package_Element;
|
|
Switches : Prj.Variable_Value;
|
|
Current : Prj.String_List_Id;
|
|
The_String : String_Element;
|
|
|
|
begin
|
|
if Pkg /= No_Package then
|
|
Element := Packages.Table (Pkg);
|
|
Switches :=
|
|
Prj.Util.Value_Of
|
|
(Variable_Name => Name_Switches,
|
|
In_Variables => Element.Decl.Attributes);
|
|
|
|
case Switches.Kind is
|
|
when Prj.Undefined =>
|
|
null;
|
|
|
|
when Prj.Single =>
|
|
if String_Length (Switches.Value) > 0 then
|
|
String_To_Name_Buffer (Switches.Value);
|
|
Scan_Ls_Arg
|
|
(Name_Buffer (1 .. Name_Len),
|
|
And_Save => False);
|
|
end if;
|
|
|
|
when Prj.List =>
|
|
Current := Switches.Values;
|
|
while Current /= Prj.Nil_String loop
|
|
The_String := String_Elements.Table (Current);
|
|
|
|
if String_Length (The_String.Value) > 0 then
|
|
String_To_Name_Buffer (The_String.Value);
|
|
Scan_Ls_Arg
|
|
(Name_Buffer (1 .. Name_Len),
|
|
And_Save => False);
|
|
end if;
|
|
|
|
Current := The_String.Next;
|
|
end loop;
|
|
end case;
|
|
end if;
|
|
end;
|
|
end if;
|
|
|
|
-- Add the source and object directories specified on the
|
|
-- command line, if any, to the searched directories.
|
|
|
|
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;
|
|
|
|
-- Finally, add the default directories.
|
|
|
|
Osint.Add_Default_Search_Dirs;
|
|
|
|
if Verbose_Mode then
|
|
|
|
-- WARNING: the output of gnatls -v is used during the compilation
|
|
-- and installation of GLADE to recreate sdefault.adb and locate
|
|
-- the libgnat.a to use. Any change in the output of gnatls -v must
|
|
-- be synchronized with the GLADE Dist/config.sdefault shell script.
|
|
|
|
Write_Eol;
|
|
Write_Str ("GNATLS ");
|
|
Write_Str (Gnat_Version_String);
|
|
Write_Str (" Copyright 1997-2001 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;
|
|
end if;
|
|
|
|
-- Output usage information when requested
|
|
|
|
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;
|
|
|
|
-- Print out all library for which no ALI files can be located
|
|
|
|
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
|
|
Write_Str ("Can't find library info for ");
|
|
Get_Decoded_Name_String (Main_File);
|
|
Write_Char ('"');
|
|
Write_Str (Name_Buffer (1 .. Name_Len));
|
|
Write_Char ('"');
|
|
Write_Eol;
|
|
|
|
else
|
|
Ali_File := Strip_Directory (Ali_File);
|
|
|
|
if Get_Name_Table_Info (Ali_File) = 0 then
|
|
Text := Read_Library_Info (Ali_File, True);
|
|
Id :=
|
|
Scan_ALI
|
|
(Ali_File, Text, Ignore_ED => False, Err => False);
|
|
Free (Text);
|
|
end if;
|
|
end if;
|
|
end loop;
|
|
|
|
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
|
|
Output_Object (ALIs.Table (Id).Ofile_Full_Name);
|
|
|
|
-- In verbose mode print all main units in the ALI file, otherwise
|
|
-- just print the first one to ease columnwise printout
|
|
|
|
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 (U);
|
|
|
|
-- Output source now, unless if it will be done as part of
|
|
-- outputing dependencies.
|
|
|
|
if not (Dependable and then Print_Source) then
|
|
Output_Source (Corresponding_Sdep_Entry (Id, U));
|
|
end if;
|
|
end loop;
|
|
|
|
-- Print out list of dependable units
|
|
|
|
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;
|
|
|
|
-- All done. Set proper exit status.
|
|
|
|
Namet.Finalize;
|
|
Exit_Program (E_Success);
|
|
|
|
end Gnatls;
|