gcc/ada/gnatls.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               G N A T L S                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --           Copyright (C) 1992-2003 Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with ALI;         use ALI;
  28 with ALI.Util;    use ALI.Util;
  29 with Binderr;     use Binderr;
  30 with Butil;       use Butil;
  31 with Csets;       use Csets;
  32 with Fname;       use Fname;
  33 with Gnatvsn;     use Gnatvsn;
  34 with GNAT.OS_Lib; use GNAT.OS_Lib;
  35 with Namet;       use Namet;
  36 with Opt;         use Opt;
  37 with Osint;       use Osint;
  38 with Osint.L;     use Osint.L;
  39 with Output;      use Output;
  40 with Targparm;    use Targparm;
  41 with Types;       use Types;
  42
  43 procedure Gnatls is
  44    Max_Column : constant := 80;
  45
  46    type File_Status is (
  47      OK,                  --  matching timestamp
  48      Checksum_OK,         --  only matching checksum
  49      Not_Found,           --  file not found on source PATH
  50      Not_Same,            --  neither checksum nor timestamp matching
  51      Not_First_On_PATH);  --  matching file hidden by Not_Same file on path
  52
  53    type Dir_Data;
  54    type Dir_Ref is access Dir_Data;
  55
  56    type Dir_Data is record
  57       Value : String_Access;
  58       Next  : Dir_Ref;
  59    end record;
  60    --  ??? comment needed
  61
  62    First_Source_Dir : Dir_Ref;
  63    Last_Source_Dir  : Dir_Ref;
  64    --  The list of source directories from the command line.
  65    --  These directories are added using Osint.Add_Src_Search_Dir
  66    --  after those of the GNAT Project File, if any.
  67
  68    First_Lib_Dir : Dir_Ref;
  69    Last_Lib_Dir  : Dir_Ref;
  70    --  The list of object directories from the command line.
  71    --  These directories are added using Osint.Add_Lib_Search_Dir
  72    --  after those of the GNAT Project File, if any.
  73
  74    Main_File : File_Name_Type;
  75    Ali_File  : File_Name_Type;
  76
  77    Text : Text_Buffer_Ptr;
  78    Id   : ALI_Id;
  79
  80    Next_Arg : Positive;
  81
  82    Too_Long : Boolean := False;
  83    --  When True, lines are too long for multi-column output and each
  84    --  item of information is on a different line.
  85
  86    Selective_Output : Boolean := False;
  87    Print_Usage      : Boolean := False;
  88    Print_Unit       : Boolean := True;
  89    Print_Source     : Boolean := True;
  90    Print_Object     : Boolean := True;
  91    --  Flags controlling the form of the outpout
  92
  93    Dependable       : Boolean := False;  --  flag -d
  94    Also_Predef      : Boolean := False;
  95
  96    Unit_Start   : Integer;
  97    Unit_End     : Integer;
  98    Source_Start : Integer;
  99    Source_End   : Integer;
 100    Object_Start : Integer;
 101    Object_End   : Integer;
 102    --  Various column starts and ends
 103
 104    Spaces : constant String (1 .. Max_Column) := (others => ' ');
 105
 106    RTS_Specified : String_Access := null;
 107    --  Used to detect multiple use of --RTS= switch
 108
 109    -----------------------
 110    -- Local Subprograms --
 111    -----------------------
 112
 113    procedure Add_Lib_Dir (Dir : String; And_Save : Boolean);
 114    --  Add an object directory, using Osint.Add_Lib_Search_Dir
 115    --  if And_Save is False or keeping in the list First_Lib_Dir,
 116    --  Last_Lib_Dir if And_Save is True.
 117
 118    procedure Add_Source_Dir (Dir : String; And_Save : Boolean);
 119    --  Add a source directory, using Osint.Add_Src_Search_Dir
 120    --  if And_Save is False or keeping in the list First_Source_Dir,
 121    --  Last_Source_Dir if And_Save is True.
 122
 123    procedure Find_General_Layout;
 124    --  Determine the structure of the output (multi columns or not, etc)
 125
 126    procedure Find_Status
 127      (FS       : in out File_Name_Type;
 128       Stamp    : Time_Stamp_Type;
 129       Checksum : Word;
 130       Status   : out File_Status);
 131    --  Determine the file status (Status) of the file represented by FS
 132    --  with the expected Stamp and checksum given as argument. FS will be
 133    --  updated to the full file name if available.
 134
 135    function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
 136    --  Give the Sdep entry corresponding to the unit U in ali record A.
 137
 138    procedure Output_Object (O : File_Name_Type);
 139    --  Print out the name of the object when requested
 140
 141    procedure Output_Source (Sdep_I : Sdep_Id);
 142    --  Print out the name and status of the source corresponding to this
 143    --  sdep entry
 144
 145    procedure Output_Status (FS : File_Status; Verbose : Boolean);
 146    --  Print out FS either in a coded form if verbose is false or in an
 147    --  expanded form otherwise.
 148
 149    procedure Output_Unit (U_Id : Unit_Id);
 150    --  Print out information on the unit when requested
 151
 152    procedure Reset_Print;
 153    --  Reset Print flags properly when selective output is chosen
 154
 155    procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean);
 156    --  Scan and process lser specific arguments. Argv is a single argument.
 157
 158    procedure Usage;
 159    --  Print usage message.
 160
 161    -----------------
 162    -- Add_Lib_Dir --
 163    -----------------
 164
 165    procedure Add_Lib_Dir (Dir : String; And_Save : Boolean) is
 166    begin
 167       if And_Save then
 168          if First_Lib_Dir = null then
 169             First_Lib_Dir :=
 170               new Dir_Data'
 171                 (Value => new String'(Dir),
 172                  Next => null);
 173             Last_Lib_Dir := First_Lib_Dir;
 174
 175          else
 176             Last_Lib_Dir.Next :=
 177               new Dir_Data'
 178                 (Value => new String'(Dir),
 179                  Next => null);
 180             Last_Lib_Dir := Last_Lib_Dir.Next;
 181          end if;
 182
 183       else
 184          Add_Lib_Search_Dir (Dir);
 185       end if;
 186    end Add_Lib_Dir;
 187
 188    -- -----------------
 189    -- Add_Source_Dir --
 190    --------------------
 191
 192    procedure Add_Source_Dir (Dir : String; And_Save : Boolean) is
 193    begin
 194       if And_Save then
 195          if First_Source_Dir = null then
 196             First_Source_Dir :=
 197               new Dir_Data'
 198                 (Value => new String'(Dir),
 199                  Next => null);
 200             Last_Source_Dir := First_Source_Dir;
 201
 202          else
 203             Last_Source_Dir.Next :=
 204               new Dir_Data'
 205                 (Value => new String'(Dir),
 206                  Next => null);
 207             Last_Source_Dir := Last_Source_Dir.Next;
 208          end if;
 209
 210       else
 211          Add_Src_Search_Dir (Dir);
 212       end if;
 213    end Add_Source_Dir;
 214
 215    ------------------------------
 216    -- Corresponding_Sdep_Entry --
 217    ------------------------------
 218
 219    function Corresponding_Sdep_Entry
 220      (A     : ALI_Id;
 221       U     : Unit_Id)
 222       return  Sdep_Id
 223    is
 224    begin
 225       for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 226          if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
 227             return D;
 228          end if;
 229       end loop;
 230
 231       Error_Msg_Name_1 := Units.Table (U).Uname;
 232       Error_Msg_Name_2 := ALIs.Table (A).Afile;
 233       Write_Eol;
 234       Error_Msg ("wrong ALI format, can't find dependency line for & in %");
 235       Exit_Program (E_Fatal);
 236    end Corresponding_Sdep_Entry;
 237
 238    -------------------------
 239    -- Find_General_Layout --
 240    -------------------------
 241
 242    procedure Find_General_Layout is
 243       Max_Unit_Length : Integer := 11;
 244       Max_Src_Length  : Integer := 11;
 245       Max_Obj_Length  : Integer := 11;
 246
 247       Len : Integer;
 248       FS  : File_Name_Type;
 249
 250    begin
 251       --  Compute maximum of each column
 252
 253       for Id in ALIs.First .. ALIs.Last loop
 254
 255          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
 256          if Also_Predef or else not Is_Internal_Unit then
 257
 258             if Print_Unit then
 259                Len := Name_Len - 1;
 260                Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
 261             end if;
 262
 263             if Print_Source then
 264                FS := Full_Source_Name (ALIs.Table (Id).Sfile);
 265
 266                if FS = No_File then
 267                   Get_Name_String (ALIs.Table (Id).Sfile);
 268                   Name_Len := Name_Len + 13;
 269                else
 270                   Get_Name_String (FS);
 271                end if;
 272
 273                Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
 274             end if;
 275
 276             if Print_Object then
 277                Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
 278                Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
 279             end if;
 280          end if;
 281       end loop;
 282
 283       --  Verify is output is not wider than maximum number of columns
 284
 285       Too_Long := Verbose_Mode or else
 286         (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
 287
 288       --  Set start and end of columns.
 289
 290       Object_Start := 1;
 291       Object_End   := Object_Start - 1;
 292
 293       if Print_Object then
 294          Object_End   := Object_Start + Max_Obj_Length;
 295       end if;
 296
 297       Unit_Start := Object_End + 1;
 298       Unit_End   := Unit_Start - 1;
 299
 300       if Print_Unit then
 301          Unit_End   := Unit_Start + Max_Unit_Length;
 302       end if;
 303
 304       Source_Start := Unit_End + 1;
 305
 306       if Source_Start > Spaces'Last then
 307          Source_Start := Spaces'Last;
 308       end if;
 309
 310       Source_End := Source_Start - 1;
 311
 312       if Print_Source then
 313          Source_End   := Source_Start + Max_Src_Length;
 314       end if;
 315    end Find_General_Layout;
 316
 317    -----------------
 318    -- Find_Status --
 319    -----------------
 320
 321    procedure Find_Status
 322      (FS       : in out File_Name_Type;
 323       Stamp    : Time_Stamp_Type;
 324       Checksum : Word;
 325       Status   : out File_Status)
 326    is
 327       Tmp1 : File_Name_Type;
 328       Tmp2 : File_Name_Type;
 329
 330    begin
 331       Tmp1 := Full_Source_Name (FS);
 332
 333       if Tmp1 = No_File then
 334          Status := Not_Found;
 335
 336       elsif File_Stamp (Tmp1) = Stamp then
 337          FS     := Tmp1;
 338          Status := OK;
 339
 340       elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
 341          FS := Tmp1;
 342          Status := Checksum_OK;
 343
 344       else
 345          Tmp2 := Matching_Full_Source_Name (FS, Stamp);
 346
 347          if Tmp2 = No_File then
 348             Status := Not_Same;
 349             FS     := Tmp1;
 350
 351          else
 352             Status := Not_First_On_PATH;
 353             FS := Tmp2;
 354          end if;
 355       end if;
 356    end Find_Status;
 357
 358    -------------------
 359    -- Output_Object --
 360    -------------------
 361
 362    procedure Output_Object (O : File_Name_Type) is
 363       Object_Name : String_Access;
 364
 365    begin
 366       if Print_Object then
 367          Get_Name_String (O);
 368          Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 369          Write_Str (Object_Name.all);
 370
 371          if Print_Source or else Print_Unit then
 372             if Too_Long then
 373                Write_Eol;
 374                Write_Str ("   ");
 375             else
 376                Write_Str (Spaces
 377                 (Object_Start + Object_Name'Length .. Object_End));
 378             end if;
 379          end if;
 380       end if;
 381    end Output_Object;
 382
 383    -------------------
 384    -- Output_Source --
 385    -------------------
 386
 387    procedure Output_Source (Sdep_I : Sdep_Id) is
 388       Stamp       : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
 389       Checksum    : constant Word            := Sdep.Table (Sdep_I).Checksum;
 390       FS          : File_Name_Type           := Sdep.Table (Sdep_I).Sfile;
 391       Status      : File_Status;
 392       Object_Name : String_Access;
 393
 394    begin
 395       if Print_Source then
 396          Find_Status (FS, Stamp, Checksum, Status);
 397          Get_Name_String (FS);
 398
 399          Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 400
 401          if Verbose_Mode then
 402             Write_Str ("  Source => ");
 403             Write_Str (Object_Name.all);
 404
 405             if not Too_Long then
 406                Write_Str
 407                  (Spaces (Source_Start + Object_Name'Length .. Source_End));
 408             end if;
 409
 410             Output_Status (Status, Verbose => True);
 411             Write_Eol;
 412             Write_Str ("   ");
 413
 414          else
 415             if not Selective_Output then
 416                Output_Status (Status, Verbose => False);
 417             end if;
 418
 419             Write_Str (Object_Name.all);
 420          end if;
 421       end if;
 422    end Output_Source;
 423
 424    -------------------
 425    -- Output_Status --
 426    -------------------
 427
 428    procedure Output_Status (FS : File_Status; Verbose : Boolean) is
 429    begin
 430       if Verbose then
 431          case FS is
 432             when OK =>
 433                Write_Str (" unchanged");
 434
 435             when Checksum_OK =>
 436                Write_Str (" slightly modified");
 437
 438             when Not_Found =>
 439                Write_Str (" file not found");
 440
 441             when Not_Same =>
 442                Write_Str (" modified");
 443
 444             when Not_First_On_PATH =>
 445                Write_Str (" unchanged version not first on PATH");
 446          end case;
 447
 448       else
 449          case FS is
 450             when OK =>
 451                Write_Str ("  OK ");
 452
 453             when Checksum_OK =>
 454                Write_Str (" MOK ");
 455
 456             when Not_Found =>
 457                Write_Str (" ??? ");
 458
 459             when Not_Same =>
 460                Write_Str (" DIF ");
 461
 462             when Not_First_On_PATH =>
 463                Write_Str (" HID ");
 464          end case;
 465       end if;
 466    end Output_Status;
 467
 468    -----------------
 469    -- Output_Unit --
 470    -----------------
 471
 472    procedure Output_Unit (U_Id : Unit_Id) is
 473       Kind : Character;
 474       U    : Unit_Record renames Units.Table (U_Id);
 475
 476    begin
 477       if Print_Unit then
 478          Get_Name_String (U.Uname);
 479          Kind := Name_Buffer (Name_Len);
 480          Name_Len := Name_Len - 2;
 481
 482          if not Verbose_Mode then
 483             Write_Str (Name_Buffer (1 .. Name_Len));
 484
 485          else
 486             Write_Str ("Unit => ");
 487             Write_Eol; Write_Str ("     Name   => ");
 488             Write_Str (Name_Buffer (1 .. Name_Len));
 489             Write_Eol; Write_Str ("     Kind   => ");
 490
 491             if Units.Table (U_Id).Unit_Kind = 'p' then
 492                Write_Str ("package ");
 493             else
 494                Write_Str ("subprogram ");
 495             end if;
 496
 497             if Kind = 's' then
 498                Write_Str ("spec");
 499             else
 500                Write_Str ("body");
 501             end if;
 502          end if;
 503
 504          if Verbose_Mode then
 505             if U.Preelab        or
 506                U.No_Elab        or
 507                U.Pure           or
 508                U.Elaborate_Body or
 509                U.Remote_Types   or
 510                U.Shared_Passive or
 511                U.RCI            or
 512                U.Predefined
 513             then
 514                Write_Eol; Write_Str ("     Flags  =>");
 515
 516                if U.Preelab then
 517                   Write_Str (" Preelaborable");
 518                end if;
 519
 520                if U.No_Elab then
 521                   Write_Str (" No_Elab_Code");
 522                end if;
 523
 524                if U.Pure then
 525                   Write_Str (" Pure");
 526                end if;
 527
 528                if U.Elaborate_Body then
 529                   Write_Str (" Elaborate Body");
 530                end if;
 531
 532                if U.Remote_Types then
 533                   Write_Str (" Remote_Types");
 534                end if;
 535
 536                if U.Shared_Passive then
 537                   Write_Str (" Shared_Passive");
 538                end if;
 539
 540                if U.Predefined then
 541                   Write_Str (" Predefined");
 542                end if;
 543
 544                if U.RCI then
 545                   Write_Str (" Remote_Call_Interface");
 546                end if;
 547             end if;
 548          end if;
 549
 550          if Print_Source then
 551             if Too_Long then
 552                Write_Eol; Write_Str ("   ");
 553             else
 554                Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
 555             end if;
 556          end if;
 557       end if;
 558    end Output_Unit;
 559
 560    -----------------
 561    -- Reset_Print --
 562    -----------------
 563
 564    procedure Reset_Print is
 565    begin
 566       if not Selective_Output then
 567          Selective_Output := True;
 568          Print_Source := False;
 569          Print_Object := False;
 570          Print_Unit   := False;
 571       end if;
 572    end Reset_Print;
 573
 574    -------------------
 575    -- Scan_Ls_Arg --
 576    -------------------
 577
 578    procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean) is
 579    begin
 580       pragma Assert (Argv'First = 1);
 581
 582       if Argv'Length = 0 then
 583          return;
 584       end if;
 585
 586       if Argv (1) = '-' then
 587
 588          if Argv'Length = 1 then
 589             Fail ("switch character cannot be followed by a blank");
 590
 591          --  Processing for -I-
 592
 593          elsif Argv (2 .. Argv'Last) = "I-" then
 594             Opt.Look_In_Primary_Dir := False;
 595
 596          --  Forbid -?- or -??- where ? is any character
 597
 598          elsif (Argv'Length = 3 and then Argv (3) = '-')
 599            or else (Argv'Length = 4 and then Argv (4) = '-')
 600          then
 601             Fail ("Trailing ""-"" at the end of ", Argv, " forbidden.");
 602
 603          --  Processing for -Idir
 604
 605          elsif Argv (2) = 'I' then
 606             Add_Source_Dir (Argv (3 .. Argv'Last), And_Save);
 607             Add_Lib_Dir (Argv (3 .. Argv'Last), And_Save);
 608
 609          --  Processing for -aIdir (to gcc this is like a -I switch)
 610
 611          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
 612             Add_Source_Dir (Argv (4 .. Argv'Last), And_Save);
 613
 614          --  Processing for -aOdir
 615
 616          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
 617             Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
 618
 619          --  Processing for -aLdir (to gnatbind this is like a -aO switch)
 620
 621          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
 622             Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
 623
 624          --  Processing for -nostdinc
 625
 626          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 627             Opt.No_Stdinc := True;
 628
 629          --  Processing for one character switches
 630
 631          elsif Argv'Length = 2 then
 632             case Argv (2) is
 633                when 'a' => Also_Predef               := True;
 634                when 'h' => Print_Usage               := True;
 635                when 'u' => Reset_Print; Print_Unit   := True;
 636                when 's' => Reset_Print; Print_Source := True;
 637                when 'o' => Reset_Print; Print_Object := True;
 638                when 'v' => Verbose_Mode              := True;
 639                when 'd' => Dependable                := True;
 640
 641                when others => null;
 642             end case;
 643
 644          --  Processing for --RTS=path
 645
 646          elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
 647             if Argv'Length <= 6 or else Argv (6) /= '='then
 648                Osint.Fail ("missing path for --RTS");
 649
 650             else
 651                --  Check that it is the first time we see this switch or, if
 652                --  it is not the first time, the same path is specified.
 653
 654                if RTS_Specified = null then
 655                   RTS_Specified := new String'(Argv (7 .. Argv'Last));
 656
 657                elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
 658                   Osint.Fail ("--RTS cannot be specified multiple times");
 659                end if;
 660
 661                --  Valid --RTS switch
 662
 663                Opt.No_Stdinc := True;
 664                Opt.RTS_Switch := True;
 665
 666                declare
 667                   Src_Path_Name : constant String_Ptr :=
 668                                     String_Ptr
 669                                       (Get_RTS_Search_Dir
 670                                         (Argv (7 .. Argv'Last), Include));
 671                   Lib_Path_Name : constant String_Ptr :=
 672                                     String_Ptr
 673                                       (Get_RTS_Search_Dir
 674                                         (Argv (7 .. Argv'Last), Objects));
 675
 676                begin
 677                   if Src_Path_Name /= null
 678                     and then Lib_Path_Name /= null
 679                   then
 680                      Add_Search_Dirs (Src_Path_Name, Include);
 681                      Add_Search_Dirs (Lib_Path_Name, Objects);
 682
 683                   elsif Src_Path_Name = null
 684                     and then Lib_Path_Name = null
 685                   then
 686                      Osint.Fail ("RTS path not valid: missing " &
 687                                  "adainclude and adalib directories");
 688
 689                   elsif Src_Path_Name = null then
 690                      Osint.Fail ("RTS path not valid: missing " &
 691                                  "adainclude directory");
 692
 693                   elsif Lib_Path_Name = null then
 694                      Osint.Fail ("RTS path not valid: missing " &
 695                                  "adalib directory");
 696                   end if;
 697                end;
 698             end if;
 699          end if;
 700
 701       --  If not a switch, it must be a file name
 702
 703       else
 704          Add_File (Argv);
 705       end if;
 706    end Scan_Ls_Arg;
 707
 708    -----------
 709    -- Usage --
 710    -----------
 711
 712    procedure Usage is
 713
 714    --  Start of processing for Usage
 715
 716    begin
 717       --  Usage line
 718
 719       Write_Str ("Usage: ");
 720       Osint.Write_Program_Name;
 721       Write_Str ("  switches  [list of object files]");
 722       Write_Eol;
 723       Write_Eol;
 724
 725       --  GNATLS switches
 726
 727       Write_Str ("switches:");
 728       Write_Eol;
 729
 730       --  Line for -a
 731
 732       Write_Str ("  -a        also output relevant predefined units");
 733       Write_Eol;
 734
 735       --  Line for -u
 736
 737       Write_Str ("  -u        output only relevant unit names");
 738       Write_Eol;
 739
 740       --  Line for -h
 741
 742       Write_Str ("  -h        output this help message");
 743       Write_Eol;
 744
 745       --  Line for -s
 746
 747       Write_Str ("  -s        output only relevant source names");
 748       Write_Eol;
 749
 750       --  Line for -o
 751
 752       Write_Str ("  -o        output only relevant object names");
 753       Write_Eol;
 754
 755       --  Line for -d
 756
 757       Write_Str ("  -d        output sources on which specified units depend");
 758       Write_Eol;
 759
 760       --  Line for -v
 761
 762       Write_Str ("  -v        verbose output, full path and unit information");
 763       Write_Eol;
 764       Write_Eol;
 765
 766       --  Line for -aI switch
 767
 768       Write_Str ("  -aIdir    specify source files search path");
 769       Write_Eol;
 770
 771       --  Line for -aO switch
 772
 773       Write_Str ("  -aOdir    specify object files search path");
 774       Write_Eol;
 775
 776       --  Line for -I switch
 777
 778       Write_Str ("  -Idir     like -aIdir -aOdir");
 779       Write_Eol;
 780
 781       --  Line for -I- switch
 782
 783       Write_Str ("  -I-       do not look for sources & object files");
 784       Write_Str (" in the default directory");
 785       Write_Eol;
 786
 787       --  Line for -nostdinc
 788
 789       Write_Str ("  -nostdinc do not look for source files");
 790       Write_Str (" in the system default directory");
 791       Write_Eol;
 792
 793       --  Line for --RTS
 794
 795       Write_Str ("  --RTS=dir specify the default source and object search"
 796                  & " path");
 797       Write_Eol;
 798
 799       --  File Status explanation
 800
 801       Write_Eol;
 802       Write_Str (" file status can be:");
 803       Write_Eol;
 804
 805       for ST in File_Status loop
 806          Write_Str ("   ");
 807          Output_Status (ST, Verbose => False);
 808          Write_Str (" ==> ");
 809          Output_Status (ST, Verbose => True);
 810          Write_Eol;
 811       end loop;
 812
 813    end Usage;
 814
 815    --   Start of processing for Gnatls
 816
 817 begin
 818    --  Initialize standard packages
 819
 820    Namet.Initialize;
 821    Csets.Initialize;
 822
 823    --  Use low level argument routines to avoid dragging in the secondary stack
 824
 825    Next_Arg := 1;
 826
 827    Scan_Args : while Next_Arg < Arg_Count loop
 828       declare
 829          Next_Argv : String (1 .. Len_Arg (Next_Arg));
 830
 831       begin
 832          Fill_Arg (Next_Argv'Address, Next_Arg);
 833          Scan_Ls_Arg (Next_Argv, And_Save => True);
 834       end;
 835
 836       Next_Arg := Next_Arg + 1;
 837    end loop Scan_Args;
 838
 839    --  Add the source and object directories specified on the
 840    --  command line, if any, to the searched directories.
 841
 842    while First_Source_Dir /= null loop
 843       Add_Src_Search_Dir (First_Source_Dir.Value.all);
 844       First_Source_Dir := First_Source_Dir.Next;
 845    end loop;
 846
 847    while First_Lib_Dir /= null loop
 848       Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
 849       First_Lib_Dir := First_Lib_Dir.Next;
 850    end loop;
 851
 852    --  Finally, add the default directories and obtain target parameters
 853
 854    Osint.Add_Default_Search_Dirs;
 855
 856    if Verbose_Mode then
 857       Targparm.Get_Target_Parameters;
 858
 859       --  WARNING: the output of gnatls -v is used during the compilation
 860       --  and installation of GLADE to recreate sdefault.adb and locate
 861       --  the libgnat.a to use. Any change in the output of gnatls -v must
 862       --  be synchronized with the GLADE Dist/config.sdefault shell script.
 863
 864       Write_Eol;
 865       Write_Str ("GNATLS ");
 866       Write_Str (Gnat_Version_String);
 867       Write_Str (" Copyright 1997-2003 Free Software Foundation, Inc.");
 868       Write_Eol;
 869       Write_Eol;
 870       Write_Str ("Source Search Path:");
 871       Write_Eol;
 872
 873       for J in 1 .. Nb_Dir_In_Src_Search_Path loop
 874          Write_Str ("   ");
 875
 876          if Dir_In_Src_Search_Path (J)'Length = 0 then
 877             Write_Str ("<Current_Directory>");
 878          else
 879             Write_Str (To_Host_Dir_Spec
 880               (Dir_In_Src_Search_Path (J).all, True).all);
 881          end if;
 882
 883          Write_Eol;
 884       end loop;
 885
 886       Write_Eol;
 887       Write_Eol;
 888       Write_Str ("Object Search Path:");
 889       Write_Eol;
 890
 891       for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
 892          Write_Str ("   ");
 893
 894          if Dir_In_Obj_Search_Path (J)'Length = 0 then
 895             Write_Str ("<Current_Directory>");
 896          else
 897             Write_Str (To_Host_Dir_Spec
 898               (Dir_In_Obj_Search_Path (J).all, True).all);
 899          end if;
 900
 901          Write_Eol;
 902       end loop;
 903
 904       Write_Eol;
 905    end if;
 906
 907    --  Output usage information when requested
 908
 909    if Print_Usage then
 910       Usage;
 911    end if;
 912
 913    if not More_Lib_Files then
 914       if not Print_Usage and then not Verbose_Mode then
 915          Usage;
 916       end if;
 917
 918       Exit_Program (E_Fatal);
 919    end if;
 920
 921    Initialize_ALI;
 922    Initialize_ALI_Source;
 923
 924    --  Print out all library for which no ALI files can be located
 925
 926    while More_Lib_Files loop
 927       Main_File := Next_Main_Lib_File;
 928       Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
 929
 930       if Ali_File = No_File then
 931          Write_Str ("Can't find library info for ");
 932          Get_Name_String (Main_File);
 933          Write_Char ('"');
 934          Write_Str (Name_Buffer (1 .. Name_Len));
 935          Write_Char ('"');
 936          Write_Eol;
 937
 938       else
 939          Ali_File := Strip_Directory (Ali_File);
 940
 941          if Get_Name_Table_Info (Ali_File) = 0 then
 942             Text := Read_Library_Info (Ali_File, True);
 943             Id :=
 944               Scan_ALI
 945                 (Ali_File, Text, Ignore_ED => False, Err => False);
 946             Free (Text);
 947          end if;
 948       end if;
 949    end loop;
 950
 951    Find_General_Layout;
 952    for Id in ALIs.First .. ALIs.Last loop
 953       declare
 954          Last_U : Unit_Id;
 955
 956       begin
 957          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
 958
 959          if Also_Predef or else not Is_Internal_Unit then
 960             Output_Object (ALIs.Table (Id).Ofile_Full_Name);
 961
 962             --  In verbose mode print all main units in the ALI file, otherwise
 963             --  just print the first one to ease columnwise printout
 964
 965             if Verbose_Mode then
 966                Last_U := ALIs.Table (Id).Last_Unit;
 967             else
 968                Last_U := ALIs.Table (Id).First_Unit;
 969             end if;
 970
 971             for U in ALIs.Table (Id).First_Unit .. Last_U loop
 972                if U /= ALIs.Table (Id).First_Unit
 973                  and then Selective_Output
 974                  and then Print_Unit
 975                then
 976                   Write_Eol;
 977                end if;
 978
 979                Output_Unit (U);
 980
 981                --  Output source now, unless if it will be done as part of
 982                --  outputing dependencies.
 983
 984                if not (Dependable and then Print_Source) then
 985                   Output_Source (Corresponding_Sdep_Entry (Id, U));
 986                end if;
 987             end loop;
 988
 989             --  Print out list of dependable units
 990
 991             if Dependable and then Print_Source then
 992                if Verbose_Mode then
 993                   Write_Str ("depends upon");
 994                   Write_Eol;
 995                   Write_Str ("   ");
 996
 997                else
 998                   Write_Eol;
 999                end if;
1000
1001                for D in
1002                  ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
1003                loop
1004                   if Also_Predef
1005                     or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
1006                   then
1007                      if Verbose_Mode then
1008                         Write_Str ("   ");
1009                         Output_Source (D);
1010
1011                      elsif Too_Long then
1012                         Write_Str ("   ");
1013                         Output_Source (D);
1014                         Write_Eol;
1015
1016                      else
1017                         Write_Str (Spaces (1 .. Source_Start - 2));
1018                         Output_Source (D);
1019                         Write_Eol;
1020                      end if;
1021                   end if;
1022                end loop;
1023             end if;
1024
1025             Write_Eol;
1026          end if;
1027       end;
1028    end loop;
1029
1030    --  All done. Set proper exit status.
1031
1032    Namet.Finalize;
1033    Exit_Program (E_Success);
1034
1035 end Gnatls;