diff options
Diffstat (limited to 'gcc/ada/gnatls.adb')
| -rw-r--r-- | gcc/ada/gnatls.adb | 1157 |
1 files changed, 1157 insertions, 0 deletions
diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb new file mode 100644 index 00000000000..b131ddb572f --- /dev/null +++ b/gcc/ada/gnatls.adb @@ -0,0 +1,1157 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T L S -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.37 $ +-- -- +-- 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 occurence 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 dependancy 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 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 dependancies. + + 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; |