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