gcc/ada/gnatls.adb

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