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