------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T L S -- -- -- -- B o d y -- -- -- -- $Revision: 1.1.1.3 $ -- -- -- 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 (""); 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 (""); 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;