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