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