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