| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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; |
