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-2009, 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 3,  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 COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with ALI;         use ALI;
  27 with ALI.Util;    use ALI.Util;
  28 with Binderr;     use Binderr;
  29 with Butil;       use Butil;
  30 with Csets;       use Csets;
  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 Rident;      use Rident;
  40 with Sdefault;
  41 with Snames;
  42 with Switch;      use Switch;
  43 with Targparm;    use Targparm;
  44 with Types;       use Types;
  45
  46 with GNAT.Case_Util; use GNAT.Case_Util;
  47
  48 procedure Gnatls is
  49    pragma Ident (Gnat_Static_Version_String);
  50
  51    Gpr_Project_Path : constant String := "GPR_PROJECT_PATH";
  52    Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
  53    --  Names of the env. variables that contains path name(s) of directories
  54    --  where project files may reside. If GPR_PROJECT_PATH is defined, its
  55    --  value is used, otherwise ADA_PROJECT_PATH is used, if defined.
  56
  57    --  NOTE : The following string may be used by other tools, such as GPS. So
  58    --  it can only be modified if these other uses are checked and coordinated.
  59
  60    Project_Search_Path : constant String := "Project Search Path:";
  61    --  Label displayed in verbose mode before the directories in the project
  62    --  search path. Do not modify without checking NOTE above.
  63
  64    No_Project_Default_Dir : constant String := "-";
  65
  66    Max_Column : constant := 80;
  67
  68    No_Obj : aliased String := "<no_obj>";
  69
  70    type File_Status is (
  71      OK,                  --  matching timestamp
  72      Checksum_OK,         --  only matching checksum
  73      Not_Found,           --  file not found on source PATH
  74      Not_Same,            --  neither checksum nor timestamp matching
  75      Not_First_On_PATH);  --  matching file hidden by Not_Same file on path
  76
  77    type Dir_Data;
  78    type Dir_Ref is access Dir_Data;
  79
  80    type Dir_Data is record
  81       Value : String_Access;
  82       Next  : Dir_Ref;
  83    end record;
  84    --  ??? comment needed
  85
  86    First_Source_Dir : Dir_Ref;
  87    Last_Source_Dir  : Dir_Ref;
  88    --  The list of source directories from the command line.
  89    --  These directories are added using Osint.Add_Src_Search_Dir
  90    --  after those of the GNAT Project File, if any.
  91
  92    First_Lib_Dir : Dir_Ref;
  93    Last_Lib_Dir  : Dir_Ref;
  94    --  The list of object directories from the command line.
  95    --  These directories are added using Osint.Add_Lib_Search_Dir
  96    --  after those of the GNAT Project File, if any.
  97
  98    Main_File : File_Name_Type;
  99    Ali_File  : File_Name_Type;
 100    Text      : Text_Buffer_Ptr;
 101    Next_Arg  : Positive;
 102
 103    Too_Long : Boolean := False;
 104    --  When True, lines are too long for multi-column output and each
 105    --  item of information is on a different line.
 106
 107    Selective_Output : Boolean := False;
 108    Print_Usage      : Boolean := False;
 109    Print_Unit       : Boolean := True;
 110    Print_Source     : Boolean := True;
 111    Print_Object     : Boolean := True;
 112    --  Flags controlling the form of the output
 113
 114    Also_Predef       : Boolean := False;  --  -a
 115    Dependable        : Boolean := False;  --  -d
 116    License           : Boolean := False;  --  -l
 117    Very_Verbose_Mode : Boolean := False;  --  -V
 118    --  Command line flags
 119
 120    Unit_Start   : Integer;
 121    Unit_End     : Integer;
 122    Source_Start : Integer;
 123    Source_End   : Integer;
 124    Object_Start : Integer;
 125    Object_End   : Integer;
 126    --  Various column starts and ends
 127
 128    Spaces : constant String (1 .. Max_Column) := (others => ' ');
 129
 130    RTS_Specified : String_Access := null;
 131    --  Used to detect multiple use of --RTS= switch
 132
 133    -----------------------
 134    -- Local Subprograms --
 135    -----------------------
 136
 137    procedure Add_Lib_Dir (Dir : String);
 138    --  Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
 139
 140    procedure Add_Source_Dir (Dir : String);
 141    --  Add a source directory in the list First_Source_Dir-Last_Source_Dir
 142
 143    procedure Find_General_Layout;
 144    --  Determine the structure of the output (multi columns or not, etc)
 145
 146    procedure Find_Status
 147      (FS       : in out File_Name_Type;
 148       Stamp    : Time_Stamp_Type;
 149       Checksum : Word;
 150       Status   : out File_Status);
 151    --  Determine the file status (Status) of the file represented by FS
 152    --  with the expected Stamp and checksum given as argument. FS will be
 153    --  updated to the full file name if available.
 154
 155    function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
 156    --  Give the Sdep entry corresponding to the unit U in ali record A
 157
 158    procedure Output_Object (O : File_Name_Type);
 159    --  Print out the name of the object when requested
 160
 161    procedure Output_Source (Sdep_I : Sdep_Id);
 162    --  Print out the name and status of the source corresponding to this
 163    --  sdep entry.
 164
 165    procedure Output_Status (FS : File_Status; Verbose : Boolean);
 166    --  Print out FS either in a coded form if verbose is false or in an
 167    --  expanded form otherwise.
 168
 169    procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id);
 170    --  Print out information on the unit when requested
 171
 172    procedure Reset_Print;
 173    --  Reset Print flags properly when selective output is chosen
 174
 175    procedure Scan_Ls_Arg (Argv : String);
 176    --  Scan and process lser specific arguments. Argv is a single argument
 177
 178    procedure Usage;
 179    --  Print usage message
 180
 181    procedure Output_License_Information;
 182    --  Output license statement, and if not found, output reference to
 183    --  COPYING.
 184
 185    function Image (Restriction : Restriction_Id) return String;
 186    --  Returns the capitalized image of Restriction
 187
 188    ------------------------------------------
 189    -- GNATDIST specific output subprograms --
 190    ------------------------------------------
 191
 192    package GNATDIST is
 193
 194       --  Any modification to this subunit requires synchronization with the
 195       --  GNATDIST sources.
 196
 197       procedure Output_ALI (A : ALI_Id);
 198       --  Comment required saying what this routine does ???
 199
 200       procedure Output_No_ALI (Afile : File_Name_Type);
 201       --  Comments required saying what this routine does ???
 202
 203    end GNATDIST;
 204
 205    -----------------
 206    -- Add_Lib_Dir --
 207    -----------------
 208
 209    procedure Add_Lib_Dir (Dir : String) is
 210    begin
 211       if First_Lib_Dir = null then
 212          First_Lib_Dir :=
 213            new Dir_Data'
 214              (Value => new String'(Dir),
 215               Next  => null);
 216          Last_Lib_Dir := First_Lib_Dir;
 217
 218       else
 219          Last_Lib_Dir.Next :=
 220            new Dir_Data'
 221              (Value => new String'(Dir),
 222               Next  => null);
 223          Last_Lib_Dir := Last_Lib_Dir.Next;
 224       end if;
 225    end Add_Lib_Dir;
 226
 227    -- -----------------
 228    -- Add_Source_Dir --
 229    --------------------
 230
 231    procedure Add_Source_Dir (Dir : String) is
 232    begin
 233       if First_Source_Dir = null then
 234          First_Source_Dir :=
 235            new Dir_Data'
 236              (Value => new String'(Dir),
 237               Next  => null);
 238          Last_Source_Dir := First_Source_Dir;
 239
 240       else
 241          Last_Source_Dir.Next :=
 242            new Dir_Data'
 243              (Value => new String'(Dir),
 244               Next  => null);
 245          Last_Source_Dir := Last_Source_Dir.Next;
 246       end if;
 247    end Add_Source_Dir;
 248
 249    ------------------------------
 250    -- Corresponding_Sdep_Entry --
 251    ------------------------------
 252
 253    function Corresponding_Sdep_Entry
 254      (A : ALI_Id;
 255       U : Unit_Id) return Sdep_Id
 256    is
 257    begin
 258       for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 259          if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
 260             return D;
 261          end if;
 262       end loop;
 263
 264       Error_Msg_Unit_1 := Units.Table (U).Uname;
 265       Error_Msg_File_1 := ALIs.Table (A).Afile;
 266       Write_Eol;
 267       Error_Msg ("wrong ALI format, can't find dependency line for $ in {");
 268       Exit_Program (E_Fatal);
 269       return No_Sdep_Id;
 270    end Corresponding_Sdep_Entry;
 271
 272    -------------------------
 273    -- Find_General_Layout --
 274    -------------------------
 275
 276    procedure Find_General_Layout is
 277       Max_Unit_Length : Integer := 11;
 278       Max_Src_Length  : Integer := 11;
 279       Max_Obj_Length  : Integer := 11;
 280
 281       Len : Integer;
 282       FS  : File_Name_Type;
 283
 284    begin
 285       --  Compute maximum of each column
 286
 287       for Id in ALIs.First .. ALIs.Last loop
 288          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
 289          if Also_Predef or else not Is_Internal_Unit then
 290
 291             if Print_Unit then
 292                Len := Name_Len - 1;
 293                Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
 294             end if;
 295
 296             if Print_Source then
 297                FS := Full_Source_Name (ALIs.Table (Id).Sfile);
 298
 299                if FS = No_File then
 300                   Get_Name_String (ALIs.Table (Id).Sfile);
 301                   Name_Len := Name_Len + 13;
 302                else
 303                   Get_Name_String (FS);
 304                end if;
 305
 306                Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
 307             end if;
 308
 309             if Print_Object then
 310                if ALIs.Table (Id).No_Object then
 311                   Max_Obj_Length :=
 312                     Integer'Max (Max_Obj_Length, No_Obj'Length);
 313                else
 314                   Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
 315                   Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
 316                end if;
 317             end if;
 318          end if;
 319       end loop;
 320
 321       --  Verify is output is not wider than maximum number of columns
 322
 323       Too_Long :=
 324         Verbose_Mode
 325           or else
 326             (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
 327
 328       --  Set start and end of columns
 329
 330       Object_Start := 1;
 331       Object_End   := Object_Start - 1;
 332
 333       if Print_Object then
 334          Object_End   := Object_Start + Max_Obj_Length;
 335       end if;
 336
 337       Unit_Start := Object_End + 1;
 338       Unit_End   := Unit_Start - 1;
 339
 340       if Print_Unit then
 341          Unit_End   := Unit_Start + Max_Unit_Length;
 342       end if;
 343
 344       Source_Start := Unit_End + 1;
 345
 346       if Source_Start > Spaces'Last then
 347          Source_Start := Spaces'Last;
 348       end if;
 349
 350       Source_End := Source_Start - 1;
 351
 352       if Print_Source then
 353          Source_End := Source_Start + Max_Src_Length;
 354       end if;
 355    end Find_General_Layout;
 356
 357    -----------------
 358    -- Find_Status --
 359    -----------------
 360
 361    procedure Find_Status
 362      (FS       : in out File_Name_Type;
 363       Stamp    : Time_Stamp_Type;
 364       Checksum : Word;
 365       Status   : out File_Status)
 366    is
 367       Tmp1 : File_Name_Type;
 368       Tmp2 : File_Name_Type;
 369
 370    begin
 371       Tmp1 := Full_Source_Name (FS);
 372
 373       if Tmp1 = No_File then
 374          Status := Not_Found;
 375
 376       elsif File_Stamp (Tmp1) = Stamp then
 377          FS     := Tmp1;
 378          Status := OK;
 379
 380       elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
 381          FS := Tmp1;
 382          Status := Checksum_OK;
 383
 384       else
 385          Tmp2 := Matching_Full_Source_Name (FS, Stamp);
 386
 387          if Tmp2 = No_File then
 388             Status := Not_Same;
 389             FS     := Tmp1;
 390
 391          else
 392             Status := Not_First_On_PATH;
 393             FS := Tmp2;
 394          end if;
 395       end if;
 396    end Find_Status;
 397
 398    --------------
 399    -- GNATDIST --
 400    --------------
 401
 402    package body GNATDIST is
 403
 404       N_Flags   : Natural;
 405       N_Indents : Natural := 0;
 406
 407       type Token_Type is
 408         (T_No_ALI,
 409          T_ALI,
 410          T_Unit,
 411          T_With,
 412          T_Source,
 413          T_Afile,
 414          T_Ofile,
 415          T_Sfile,
 416          T_Name,
 417          T_Main,
 418          T_Kind,
 419          T_Flags,
 420          T_Preelaborated,
 421          T_Pure,
 422          T_Has_RACW,
 423          T_Remote_Types,
 424          T_Shared_Passive,
 425          T_RCI,
 426          T_Predefined,
 427          T_Internal,
 428          T_Is_Generic,
 429          T_Procedure,
 430          T_Function,
 431          T_Package,
 432          T_Subprogram,
 433          T_Spec,
 434          T_Body);
 435
 436       Image : constant array (Token_Type) of String_Access :=
 437                 (T_No_ALI         => new String'("No_ALI"),
 438                  T_ALI            => new String'("ALI"),
 439                  T_Unit           => new String'("Unit"),
 440                  T_With           => new String'("With"),
 441                  T_Source         => new String'("Source"),
 442                  T_Afile          => new String'("Afile"),
 443                  T_Ofile          => new String'("Ofile"),
 444                  T_Sfile          => new String'("Sfile"),
 445                  T_Name           => new String'("Name"),
 446                  T_Main           => new String'("Main"),
 447                  T_Kind           => new String'("Kind"),
 448                  T_Flags          => new String'("Flags"),
 449                  T_Preelaborated  => new String'("Preelaborated"),
 450                  T_Pure           => new String'("Pure"),
 451                  T_Has_RACW       => new String'("Has_RACW"),
 452                  T_Remote_Types   => new String'("Remote_Types"),
 453                  T_Shared_Passive => new String'("Shared_Passive"),
 454                  T_RCI            => new String'("RCI"),
 455                  T_Predefined     => new String'("Predefined"),
 456                  T_Internal       => new String'("Internal"),
 457                  T_Is_Generic     => new String'("Is_Generic"),
 458                  T_Procedure      => new String'("procedure"),
 459                  T_Function       => new String'("function"),
 460                  T_Package        => new String'("package"),
 461                  T_Subprogram     => new String'("subprogram"),
 462                  T_Spec           => new String'("spec"),
 463                  T_Body           => new String'("body"));
 464
 465       procedure Output_Name  (N : Name_Id);
 466       --  Remove any encoding info (%b and %s) and output N
 467
 468       procedure Output_Afile (A : File_Name_Type);
 469       procedure Output_Ofile (O : File_Name_Type);
 470       procedure Output_Sfile (S : File_Name_Type);
 471       --  Output various names. Check that the name is different from no name.
 472       --  Otherwise, skip the output.
 473
 474       procedure Output_Token (T : Token_Type);
 475       --  Output token using specific format. That is several indentations and:
 476       --
 477       --  T_No_ALI  .. T_With : <token> & " =>" & NL
 478       --  T_Source  .. T_Kind : <token> & " => "
 479       --  T_Flags             : <token> & " =>"
 480       --  T_Preelab .. T_Body : " " & <token>
 481
 482       procedure Output_Sdep  (S : Sdep_Id);
 483       procedure Output_Unit  (U : Unit_Id);
 484       procedure Output_With  (W : With_Id);
 485       --  Output this entry as a global section (like ALIs)
 486
 487       ------------------
 488       -- Output_Afile --
 489       ------------------
 490
 491       procedure Output_Afile (A : File_Name_Type) is
 492       begin
 493          if A /= No_File then
 494             Output_Token (T_Afile);
 495             Write_Name (A);
 496             Write_Eol;
 497          end if;
 498       end Output_Afile;
 499
 500       ----------------
 501       -- Output_ALI --
 502       ----------------
 503
 504       procedure Output_ALI (A : ALI_Id) is
 505       begin
 506          Output_Token (T_ALI);
 507          N_Indents := N_Indents + 1;
 508
 509          Output_Afile (ALIs.Table (A).Afile);
 510          Output_Ofile (ALIs.Table (A).Ofile_Full_Name);
 511          Output_Sfile (ALIs.Table (A).Sfile);
 512
 513          --  Output Main
 514
 515          if ALIs.Table (A).Main_Program /= None then
 516             Output_Token (T_Main);
 517
 518             if ALIs.Table (A).Main_Program = Proc then
 519                Output_Token (T_Procedure);
 520             else
 521                Output_Token (T_Function);
 522             end if;
 523
 524             Write_Eol;
 525          end if;
 526
 527          --  Output Units
 528
 529          for U in ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit loop
 530             Output_Unit (U);
 531          end loop;
 532
 533          --  Output Sdeps
 534
 535          for S in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 536             Output_Sdep (S);
 537          end loop;
 538
 539          N_Indents := N_Indents - 1;
 540       end Output_ALI;
 541
 542       -------------------
 543       -- Output_No_ALI --
 544       -------------------
 545
 546       procedure Output_No_ALI (Afile : File_Name_Type) is
 547       begin
 548          Output_Token (T_No_ALI);
 549          N_Indents := N_Indents + 1;
 550          Output_Afile (Afile);
 551          N_Indents := N_Indents - 1;
 552       end Output_No_ALI;
 553
 554       -----------------
 555       -- Output_Name --
 556       -----------------
 557
 558       procedure Output_Name (N : Name_Id) is
 559       begin
 560          --  Remove any encoding info (%s or %b)
 561
 562          Get_Name_String (N);
 563
 564          if Name_Len > 2
 565            and then Name_Buffer (Name_Len - 1) = '%'
 566          then
 567             Name_Len := Name_Len - 2;
 568          end if;
 569
 570          Output_Token (T_Name);
 571          Write_Str (Name_Buffer (1 .. Name_Len));
 572          Write_Eol;
 573       end Output_Name;
 574
 575       ------------------
 576       -- Output_Ofile --
 577       ------------------
 578
 579       procedure Output_Ofile (O : File_Name_Type) is
 580       begin
 581          if O /= No_File then
 582             Output_Token (T_Ofile);
 583             Write_Name (O);
 584             Write_Eol;
 585          end if;
 586       end Output_Ofile;
 587
 588       -----------------
 589       -- Output_Sdep --
 590       -----------------
 591
 592       procedure Output_Sdep (S : Sdep_Id) is
 593       begin
 594          Output_Token (T_Source);
 595          Write_Name (Sdep.Table (S).Sfile);
 596          Write_Eol;
 597       end Output_Sdep;
 598
 599       ------------------
 600       -- Output_Sfile --
 601       ------------------
 602
 603       procedure Output_Sfile (S : File_Name_Type) is
 604          FS : File_Name_Type := S;
 605
 606       begin
 607          if FS /= No_File then
 608
 609             --  We want to output the full source name
 610
 611             FS := Full_Source_Name (FS);
 612
 613             --  There is no full source name. This occurs for instance when a
 614             --  withed unit has a spec file but no body file. This situation is
 615             --  not a problem for GNATDIST since the unit may be located on a
 616             --  partition we do not want to build. However, we need to locate
 617             --  the spec file and to find its full source name. Replace the
 618             --  body file name with the spec file name used to compile the
 619             --  current unit when possible.
 620
 621             if FS = No_File then
 622                Get_Name_String (S);
 623
 624                if Name_Len > 4
 625                  and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
 626                then
 627                   Name_Buffer (Name_Len) := 's';
 628                   FS := Full_Source_Name (Name_Find);
 629                end if;
 630             end if;
 631          end if;
 632
 633          if FS /= No_File then
 634             Output_Token (T_Sfile);
 635             Write_Name (FS);
 636             Write_Eol;
 637          end if;
 638       end Output_Sfile;
 639
 640       ------------------
 641       -- Output_Token --
 642       ------------------
 643
 644       procedure Output_Token (T : Token_Type) is
 645       begin
 646          if T in T_No_ALI .. T_Flags then
 647             for J in 1 .. N_Indents loop
 648                Write_Str ("   ");
 649             end loop;
 650
 651             Write_Str (Image (T).all);
 652
 653             for J in Image (T)'Length .. 12 loop
 654                Write_Char (' ');
 655             end loop;
 656
 657             Write_Str ("=>");
 658
 659             if T in T_No_ALI .. T_With then
 660                Write_Eol;
 661             elsif T in T_Source .. T_Name then
 662                Write_Char (' ');
 663             end if;
 664
 665          elsif T in T_Preelaborated .. T_Body then
 666             if T in T_Preelaborated .. T_Is_Generic then
 667                if N_Flags = 0 then
 668                   Output_Token (T_Flags);
 669                end if;
 670
 671                N_Flags := N_Flags + 1;
 672             end if;
 673
 674             Write_Char (' ');
 675             Write_Str  (Image (T).all);
 676
 677          else
 678             Write_Str  (Image (T).all);
 679          end if;
 680       end Output_Token;
 681
 682       -----------------
 683       -- Output_Unit --
 684       -----------------
 685
 686       procedure Output_Unit (U : Unit_Id) is
 687       begin
 688          Output_Token (T_Unit);
 689          N_Indents := N_Indents + 1;
 690
 691          --  Output Name
 692
 693          Output_Name (Name_Id (Units.Table (U).Uname));
 694
 695          --  Output Kind
 696
 697          Output_Token (T_Kind);
 698
 699          if Units.Table (U).Unit_Kind = 'p' then
 700             Output_Token (T_Package);
 701          else
 702             Output_Token (T_Subprogram);
 703          end if;
 704
 705          if Name_Buffer (Name_Len) = 's' then
 706             Output_Token (T_Spec);
 707          else
 708             Output_Token (T_Body);
 709          end if;
 710
 711          Write_Eol;
 712
 713          --  Output source file name
 714
 715          Output_Sfile (Units.Table (U).Sfile);
 716
 717          --  Output Flags
 718
 719          N_Flags := 0;
 720
 721          if Units.Table (U).Preelab then
 722             Output_Token (T_Preelaborated);
 723          end if;
 724
 725          if Units.Table (U).Pure then
 726             Output_Token (T_Pure);
 727          end if;
 728
 729          if Units.Table (U).Has_RACW then
 730             Output_Token (T_Has_RACW);
 731          end if;
 732
 733          if Units.Table (U).Remote_Types then
 734             Output_Token (T_Remote_Types);
 735          end if;
 736
 737          if Units.Table (U).Shared_Passive then
 738             Output_Token (T_Shared_Passive);
 739          end if;
 740
 741          if Units.Table (U).RCI then
 742             Output_Token (T_RCI);
 743          end if;
 744
 745          if Units.Table (U).Predefined then
 746             Output_Token (T_Predefined);
 747          end if;
 748
 749          if Units.Table (U).Internal then
 750             Output_Token (T_Internal);
 751          end if;
 752
 753          if Units.Table (U).Is_Generic then
 754             Output_Token (T_Is_Generic);
 755          end if;
 756
 757          if N_Flags > 0 then
 758             Write_Eol;
 759          end if;
 760
 761          --  Output Withs
 762
 763          for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop
 764             Output_With (W);
 765          end loop;
 766
 767          N_Indents := N_Indents - 1;
 768       end Output_Unit;
 769
 770       -----------------
 771       -- Output_With --
 772       -----------------
 773
 774       procedure Output_With (W : With_Id) is
 775       begin
 776          Output_Token (T_With);
 777          N_Indents := N_Indents + 1;
 778
 779          Output_Name (Name_Id (Withs.Table (W).Uname));
 780
 781          --  Output Kind
 782
 783          Output_Token (T_Kind);
 784
 785          if Name_Buffer (Name_Len) = 's' then
 786             Output_Token (T_Spec);
 787          else
 788             Output_Token (T_Body);
 789          end if;
 790
 791          Write_Eol;
 792
 793          Output_Afile (Withs.Table (W).Afile);
 794          Output_Sfile (Withs.Table (W).Sfile);
 795
 796          N_Indents := N_Indents - 1;
 797       end Output_With;
 798
 799    end GNATDIST;
 800
 801    -----------
 802    -- Image --
 803    -----------
 804
 805    function Image (Restriction : Restriction_Id) return String is
 806       Result : String := Restriction'Img;
 807       Skip   : Boolean := True;
 808
 809    begin
 810       for J in Result'Range loop
 811          if Skip then
 812             Skip := False;
 813             Result (J) := To_Upper (Result (J));
 814
 815          elsif Result (J) = '_' then
 816             Skip := True;
 817
 818          else
 819             Result (J) := To_Lower (Result (J));
 820          end if;
 821       end loop;
 822
 823       return Result;
 824    end Image;
 825
 826    --------------------------------
 827    -- Output_License_Information --
 828    --------------------------------
 829
 830    procedure Output_License_Information is
 831       Params_File_Name : constant String := "gnatlic.adl";
 832       --  Name of license file
 833
 834       Lo   : constant Source_Ptr := 1;
 835       Hi   : Source_Ptr;
 836       Text : Source_Buffer_Ptr;
 837
 838    begin
 839       Name_Len := 0;
 840       Add_Str_To_Name_Buffer (Params_File_Name);
 841       Read_Source_File (Name_Find, Lo, Hi, Text);
 842
 843       if Text /= null then
 844
 845          --  Omit last character (end-of-file marker) in output
 846
 847          Write_Str (String (Text (Lo .. Hi - 1)));
 848          Write_Eol;
 849
 850          --  The following condition is determined at compile time: disable
 851          --  "condition is always true/false" warning.
 852
 853          pragma Warnings (Off);
 854       elsif Build_Type /= GPL and then Build_Type /= FSF then
 855          pragma Warnings (On);
 856
 857          Write_Str ("License file missing, please contact AdaCore.");
 858          Write_Eol;
 859
 860       else
 861          Write_Str ("Please refer to file COPYING in your distribution"
 862                   & " for license terms.");
 863          Write_Eol;
 864
 865       end if;
 866
 867       Exit_Program (E_Success);
 868    end Output_License_Information;
 869
 870    -------------------
 871    -- Output_Object --
 872    -------------------
 873
 874    procedure Output_Object (O : File_Name_Type) is
 875       Object_Name : String_Access;
 876
 877    begin
 878       if Print_Object then
 879          if O /= No_File then
 880             Get_Name_String (O);
 881             Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 882          else
 883             Object_Name := No_Obj'Unchecked_Access;
 884          end if;
 885
 886          Write_Str (Object_Name.all);
 887
 888          if Print_Source or else Print_Unit then
 889             if Too_Long then
 890                Write_Eol;
 891                Write_Str ("   ");
 892             else
 893                Write_Str (Spaces
 894                 (Object_Start + Object_Name'Length .. Object_End));
 895             end if;
 896          end if;
 897       end if;
 898    end Output_Object;
 899
 900    -------------------
 901    -- Output_Source --
 902    -------------------
 903
 904    procedure Output_Source (Sdep_I : Sdep_Id) is
 905       Stamp       : Time_Stamp_Type;
 906       Checksum    : Word;
 907       FS          : File_Name_Type;
 908       Status      : File_Status;
 909       Object_Name : String_Access;
 910
 911    begin
 912       if Sdep_I = No_Sdep_Id then
 913          return;
 914       end if;
 915
 916       Stamp    := Sdep.Table (Sdep_I).Stamp;
 917       Checksum := Sdep.Table (Sdep_I).Checksum;
 918       FS       := Sdep.Table (Sdep_I).Sfile;
 919
 920       if Print_Source then
 921          Find_Status (FS, Stamp, Checksum, Status);
 922          Get_Name_String (FS);
 923
 924          Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 925
 926          if Verbose_Mode then
 927             Write_Str ("  Source => ");
 928             Write_Str (Object_Name.all);
 929
 930             if not Too_Long then
 931                Write_Str
 932                  (Spaces (Source_Start + Object_Name'Length .. Source_End));
 933             end if;
 934
 935             Output_Status (Status, Verbose => True);
 936             Write_Eol;
 937             Write_Str ("   ");
 938
 939          else
 940             if not Selective_Output then
 941                Output_Status (Status, Verbose => False);
 942             end if;
 943
 944             Write_Str (Object_Name.all);
 945          end if;
 946       end if;
 947    end Output_Source;
 948
 949    -------------------
 950    -- Output_Status --
 951    -------------------
 952
 953    procedure Output_Status (FS : File_Status; Verbose : Boolean) is
 954    begin
 955       if Verbose then
 956          case FS is
 957             when OK =>
 958                Write_Str (" unchanged");
 959
 960             when Checksum_OK =>
 961                Write_Str (" slightly modified");
 962
 963             when Not_Found =>
 964                Write_Str (" file not found");
 965
 966             when Not_Same =>
 967                Write_Str (" modified");
 968
 969             when Not_First_On_PATH =>
 970                Write_Str (" unchanged version not first on PATH");
 971          end case;
 972
 973       else
 974          case FS is
 975             when OK =>
 976                Write_Str ("  OK ");
 977
 978             when Checksum_OK =>
 979                Write_Str (" MOK ");
 980
 981             when Not_Found =>
 982                Write_Str (" ??? ");
 983
 984             when Not_Same =>
 985                Write_Str (" DIF ");
 986
 987             when Not_First_On_PATH =>
 988                Write_Str (" HID ");
 989          end case;
 990       end if;
 991    end Output_Status;
 992
 993    -----------------
 994    -- Output_Unit --
 995    -----------------
 996
 997    procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
 998       Kind : Character;
 999       U    : Unit_Record renames Units.Table (U_Id);
1000
1001    begin
1002       if Print_Unit then
1003          Get_Name_String (U.Uname);
1004          Kind := Name_Buffer (Name_Len);
1005          Name_Len := Name_Len - 2;
1006
1007          if not Verbose_Mode then
1008             Write_Str (Name_Buffer (1 .. Name_Len));
1009
1010          else
1011             Write_Str ("Unit => ");
1012             Write_Eol;
1013             Write_Str ("     Name   => ");
1014             Write_Str (Name_Buffer (1 .. Name_Len));
1015             Write_Eol;
1016             Write_Str ("     Kind   => ");
1017
1018             if Units.Table (U_Id).Unit_Kind = 'p' then
1019                Write_Str ("package ");
1020             else
1021                Write_Str ("subprogram ");
1022             end if;
1023
1024             if Kind = 's' then
1025                Write_Str ("spec");
1026             else
1027                Write_Str ("body");
1028             end if;
1029          end if;
1030
1031          if Verbose_Mode then
1032             if U.Preelab             or
1033                U.No_Elab             or
1034                U.Pure                or
1035                U.Dynamic_Elab        or
1036                U.Has_RACW            or
1037                U.Remote_Types        or
1038                U.Shared_Passive      or
1039                U.RCI                 or
1040                U.Predefined          or
1041                U.Internal            or
1042                U.Is_Generic          or
1043                U.Init_Scalars        or
1044                U.SAL_Interface       or
1045                U.Body_Needed_For_SAL or
1046                U.Elaborate_Body
1047             then
1048                Write_Eol;
1049                Write_Str ("     Flags  =>");
1050
1051                if U.Preelab then
1052                   Write_Str (" Preelaborable");
1053                end if;
1054
1055                if U.No_Elab then
1056                   Write_Str (" No_Elab_Code");
1057                end if;
1058
1059                if U.Pure then
1060                   Write_Str (" Pure");
1061                end if;
1062
1063                if U.Dynamic_Elab then
1064                   Write_Str (" Dynamic_Elab");
1065                end if;
1066
1067                if U.Has_RACW then
1068                   Write_Str (" Has_RACW");
1069                end if;
1070
1071                if U.Remote_Types then
1072                   Write_Str (" Remote_Types");
1073                end if;
1074
1075                if U.Shared_Passive then
1076                   Write_Str (" Shared_Passive");
1077                end if;
1078
1079                if U.RCI then
1080                   Write_Str (" RCI");
1081                end if;
1082
1083                if U.Predefined then
1084                   Write_Str (" Predefined");
1085                end if;
1086
1087                if U.Internal then
1088                   Write_Str (" Internal");
1089                end if;
1090
1091                if U.Is_Generic then
1092                   Write_Str (" Is_Generic");
1093                end if;
1094
1095                if U.Init_Scalars then
1096                   Write_Str (" Init_Scalars");
1097                end if;
1098
1099                if U.SAL_Interface then
1100                   Write_Str (" SAL_Interface");
1101                end if;
1102
1103                if U.Body_Needed_For_SAL then
1104                   Write_Str (" Body_Needed_For_SAL");
1105                end if;
1106
1107                if U.Elaborate_Body then
1108                   Write_Str (" Elaborate Body");
1109                end if;
1110
1111                if U.Remote_Types then
1112                   Write_Str (" Remote_Types");
1113                end if;
1114
1115                if U.Shared_Passive then
1116                   Write_Str (" Shared_Passive");
1117                end if;
1118
1119                if U.Predefined then
1120                   Write_Str (" Predefined");
1121                end if;
1122
1123             end if;
1124
1125             declare
1126                Restrictions : constant Restrictions_Info :=
1127                                 ALIs.Table (ALI).Restrictions;
1128
1129             begin
1130                --  If the source was compiled with pragmas Restrictions,
1131                --  Display these restrictions.
1132
1133                if Restrictions.Set /= (All_Restrictions => False) then
1134                   Write_Eol;
1135                   Write_Str ("     pragma Restrictions  =>");
1136
1137                   --  For boolean restrictions, just display the name of the
1138                   --  restriction; for valued restrictions, also display the
1139                   --  restriction value.
1140
1141                   for Restriction in All_Restrictions loop
1142                      if Restrictions.Set (Restriction) then
1143                         Write_Eol;
1144                         Write_Str ("       ");
1145                         Write_Str (Image (Restriction));
1146
1147                         if Restriction in All_Parameter_Restrictions then
1148                            Write_Str (" =>");
1149                            Write_Str (Restrictions.Value (Restriction)'Img);
1150                         end if;
1151                      end if;
1152                   end loop;
1153                end if;
1154
1155                --  If the unit violates some Restrictions, display the list of
1156                --  these restrictions.
1157
1158                if Restrictions.Violated /= (All_Restrictions => False) then
1159                   Write_Eol;
1160                   Write_Str ("     Restrictions violated =>");
1161
1162                   --  For boolean restrictions, just display the name of the
1163                   --  restriction; for valued restrictions, also display the
1164                   --  restriction value.
1165
1166                   for Restriction in All_Restrictions loop
1167                      if Restrictions.Violated (Restriction) then
1168                         Write_Eol;
1169                         Write_Str ("       ");
1170                         Write_Str (Image (Restriction));
1171
1172                         if Restriction in All_Parameter_Restrictions then
1173                            if Restrictions.Count (Restriction) > 0 then
1174                               Write_Str (" =>");
1175
1176                               if Restrictions.Unknown (Restriction) then
1177                                  Write_Str (" at least");
1178                               end if;
1179
1180                               Write_Str (Restrictions.Count (Restriction)'Img);
1181                            end if;
1182                         end if;
1183                      end if;
1184                   end loop;
1185                end if;
1186             end;
1187          end if;
1188
1189          if Print_Source then
1190             if Too_Long then
1191                Write_Eol;
1192                Write_Str ("   ");
1193             else
1194                Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
1195             end if;
1196          end if;
1197       end if;
1198    end Output_Unit;
1199
1200    -----------------
1201    -- Reset_Print --
1202    -----------------
1203
1204    procedure Reset_Print is
1205    begin
1206       if not Selective_Output then
1207          Selective_Output := True;
1208          Print_Source := False;
1209          Print_Object := False;
1210          Print_Unit   := False;
1211       end if;
1212    end Reset_Print;
1213
1214    -------------------
1215    -- Scan_Ls_Arg --
1216    -------------------
1217
1218    procedure Scan_Ls_Arg (Argv : String) is
1219       FD  : File_Descriptor;
1220       Len : Integer;
1221
1222    begin
1223       pragma Assert (Argv'First = 1);
1224
1225       if Argv'Length = 0 then
1226          return;
1227       end if;
1228
1229       if Argv (1) = '-' then
1230          if Argv'Length = 1 then
1231             Fail ("switch character cannot be followed by a blank");
1232
1233          --  Processing for -I-
1234
1235          elsif Argv (2 .. Argv'Last) = "I-" then
1236             Opt.Look_In_Primary_Dir := False;
1237
1238          --  Forbid -?- or -??- where ? is any character
1239
1240          elsif (Argv'Length = 3 and then Argv (3) = '-')
1241            or else (Argv'Length = 4 and then Argv (4) = '-')
1242          then
1243             Fail ("Trailing ""-"" at the end of " & Argv & " forbidden.");
1244
1245          --  Processing for -Idir
1246
1247          elsif Argv (2) = 'I' then
1248             Add_Source_Dir (Argv (3 .. Argv'Last));
1249             Add_Lib_Dir (Argv (3 .. Argv'Last));
1250
1251          --  Processing for -aIdir (to gcc this is like a -I switch)
1252
1253          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
1254             Add_Source_Dir (Argv (4 .. Argv'Last));
1255
1256          --  Processing for -aOdir
1257
1258          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
1259             Add_Lib_Dir (Argv (4 .. Argv'Last));
1260
1261          --  Processing for -aLdir (to gnatbind this is like a -aO switch)
1262
1263          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
1264             Add_Lib_Dir (Argv (4 .. Argv'Last));
1265
1266          --  Processing for -nostdinc
1267
1268          elsif Argv (2 .. Argv'Last) = "nostdinc" then
1269             Opt.No_Stdinc := True;
1270
1271          --  Processing for one character switches
1272
1273          elsif Argv'Length = 2 then
1274             case Argv (2) is
1275                when 'a' => Also_Predef               := True;
1276                when 'h' => Print_Usage               := True;
1277                when 'u' => Reset_Print; Print_Unit   := True;
1278                when 's' => Reset_Print; Print_Source := True;
1279                when 'o' => Reset_Print; Print_Object := True;
1280                when 'v' => Verbose_Mode              := True;
1281                when 'd' => Dependable                := True;
1282                when 'l' => License                   := True;
1283                when 'V' => Very_Verbose_Mode         := True;
1284
1285                when others => null;
1286             end case;
1287
1288          --  Processing for -files=file
1289
1290          elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
1291             FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
1292
1293             if FD = Invalid_FD then
1294                Osint.Fail ("could not find text file """ &
1295                            Argv (8 .. Argv'Last) & '"');
1296             end if;
1297
1298             Len := Integer (File_Length (FD));
1299
1300             declare
1301                Buffer : String (1 .. Len + 1);
1302                Index  : Positive := 1;
1303                Last   : Positive;
1304
1305             begin
1306                --  Read the file
1307
1308                Len := Read (FD, Buffer (1)'Address, Len);
1309                Buffer (Buffer'Last) := ASCII.NUL;
1310                Close (FD);
1311
1312                --  Scan the file line by line
1313
1314                while Index < Buffer'Last loop
1315
1316                   --  Find the end of line
1317
1318                   Last := Index;
1319
1320                   while Last <= Buffer'Last
1321                     and then Buffer (Last) /= ASCII.LF
1322                     and then Buffer (Last) /= ASCII.CR
1323                   loop
1324                      Last := Last + 1;
1325                   end loop;
1326
1327                   --  Ignore empty lines
1328
1329                   if Last > Index then
1330                      Add_File (Buffer (Index .. Last - 1));
1331                   end if;
1332
1333                   Index := Last;
1334
1335                   --  Find the beginning of the next line
1336
1337                   while Buffer (Index) = ASCII.CR or else
1338                         Buffer (Index) = ASCII.LF
1339                   loop
1340                      Index := Index + 1;
1341                   end loop;
1342                end loop;
1343             end;
1344
1345          --  Processing for --RTS=path
1346
1347          elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
1348             if Argv'Length <= 6 or else Argv (6) /= '='then
1349                Osint.Fail ("missing path for --RTS");
1350
1351             else
1352                --  Check that it is the first time we see this switch or, if
1353                --  it is not the first time, the same path is specified.
1354
1355                if RTS_Specified = null then
1356                   RTS_Specified := new String'(Argv (7 .. Argv'Last));
1357
1358                elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
1359                   Osint.Fail ("--RTS cannot be specified multiple times");
1360                end if;
1361
1362                --  Valid --RTS switch
1363
1364                Opt.No_Stdinc := True;
1365                Opt.RTS_Switch := True;
1366
1367                declare
1368                   Src_Path_Name : constant String_Ptr :=
1369                                     String_Ptr
1370                                       (Get_RTS_Search_Dir
1371                                         (Argv (7 .. Argv'Last), Include));
1372                   Lib_Path_Name : constant String_Ptr :=
1373                                     String_Ptr
1374                                       (Get_RTS_Search_Dir
1375                                         (Argv (7 .. Argv'Last), Objects));
1376
1377                begin
1378                   if Src_Path_Name /= null
1379                     and then Lib_Path_Name /= null
1380                   then
1381                      Add_Search_Dirs (Src_Path_Name, Include);
1382                      Add_Search_Dirs (Lib_Path_Name, Objects);
1383
1384                   elsif Src_Path_Name = null
1385                     and then Lib_Path_Name = null
1386                   then
1387                      Osint.Fail ("RTS path not valid: missing " &
1388                                  "adainclude and adalib directories");
1389
1390                   elsif Src_Path_Name = null then
1391                      Osint.Fail ("RTS path not valid: missing " &
1392                                  "adainclude directory");
1393
1394                   elsif Lib_Path_Name = null then
1395                      Osint.Fail ("RTS path not valid: missing " &
1396                                  "adalib directory");
1397                   end if;
1398                end;
1399             end if;
1400          end if;
1401
1402       --  If not a switch, it must be a file name
1403
1404       else
1405          Add_File (Argv);
1406       end if;
1407    end Scan_Ls_Arg;
1408
1409    -----------
1410    -- Usage --
1411    -----------
1412
1413    procedure Usage is
1414    begin
1415       --  Usage line
1416
1417       Write_Str ("Usage: ");
1418       Osint.Write_Program_Name;
1419       Write_Str ("  switches  [list of object files]");
1420       Write_Eol;
1421       Write_Eol;
1422
1423       --  GNATLS switches
1424
1425       Write_Str ("switches:");
1426       Write_Eol;
1427
1428       --  Line for -a
1429
1430       Write_Str ("  -a         also output relevant predefined units");
1431       Write_Eol;
1432
1433       --  Line for -u
1434
1435       Write_Str ("  -u         output only relevant unit names");
1436       Write_Eol;
1437
1438       --  Line for -h
1439
1440       Write_Str ("  -h         output this help message");
1441       Write_Eol;
1442
1443       --  Line for -s
1444
1445       Write_Str ("  -s         output only relevant source names");
1446       Write_Eol;
1447
1448       --  Line for -o
1449
1450       Write_Str ("  -o         output only relevant object names");
1451       Write_Eol;
1452
1453       --  Line for -d
1454
1455       Write_Str ("  -d         output sources on which specified units " &
1456                                "depend");
1457       Write_Eol;
1458
1459       --  Line for -l
1460
1461       Write_Str ("  -l         output license information");
1462       Write_Eol;
1463
1464       --  Line for -v
1465
1466       Write_Str ("  -v         verbose output, full path and unit " &
1467                                "information");
1468       Write_Eol;
1469       Write_Eol;
1470
1471       --  Line for -files=
1472
1473       Write_Str ("  -files=fil files are listed in text file 'fil'");
1474       Write_Eol;
1475
1476       --  Line for -aI switch
1477
1478       Write_Str ("  -aIdir     specify source files search path");
1479       Write_Eol;
1480
1481       --  Line for -aO switch
1482
1483       Write_Str ("  -aOdir     specify object files search path");
1484       Write_Eol;
1485
1486       --  Line for -I switch
1487
1488       Write_Str ("  -Idir      like -aIdir -aOdir");
1489       Write_Eol;
1490
1491       --  Line for -I- switch
1492
1493       Write_Str ("  -I-        do not look for sources & object files");
1494       Write_Str (" in the default directory");
1495       Write_Eol;
1496
1497       --  Line for -nostdinc
1498
1499       Write_Str ("  -nostdinc  do not look for source files");
1500       Write_Str (" in the system default directory");
1501       Write_Eol;
1502
1503       --  Line for --RTS
1504
1505       Write_Str ("  --RTS=dir  specify the default source and object search"
1506                  & " path");
1507       Write_Eol;
1508
1509       --  File Status explanation
1510
1511       Write_Eol;
1512       Write_Str (" file status can be:");
1513       Write_Eol;
1514
1515       for ST in File_Status loop
1516          Write_Str ("   ");
1517          Output_Status (ST, Verbose => False);
1518          Write_Str (" ==> ");
1519          Output_Status (ST, Verbose => True);
1520          Write_Eol;
1521       end loop;
1522    end Usage;
1523
1524    procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage);
1525
1526 --  Start of processing for Gnatls
1527
1528 begin
1529    --  Initialize standard packages
1530
1531    Namet.Initialize;
1532    Csets.Initialize;
1533    Snames.Initialize;
1534
1535    --  First check for --version or --help
1536
1537    Check_Version_And_Help ("GNATLS", "1997");
1538
1539    --  Loop to scan out arguments
1540
1541    Next_Arg := 1;
1542    Scan_Args : while Next_Arg < Arg_Count loop
1543       declare
1544          Next_Argv : String (1 .. Len_Arg (Next_Arg));
1545       begin
1546          Fill_Arg (Next_Argv'Address, Next_Arg);
1547          Scan_Ls_Arg (Next_Argv);
1548       end;
1549
1550       Next_Arg := Next_Arg + 1;
1551    end loop Scan_Args;
1552
1553    --  If -l (output license information) is given, it must be the only switch
1554
1555    if License and then Arg_Count /= 2 then
1556       Write_Str ("Can't use -l with another switch");
1557       Write_Eol;
1558       Usage;
1559       Exit_Program (E_Fatal);
1560    end if;
1561
1562    --  Add the source and object directories specified on the
1563    --  command line, if any, to the searched directories.
1564
1565    while First_Source_Dir /= null loop
1566       Add_Src_Search_Dir (First_Source_Dir.Value.all);
1567       First_Source_Dir := First_Source_Dir.Next;
1568    end loop;
1569
1570    while First_Lib_Dir /= null loop
1571       Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
1572       First_Lib_Dir := First_Lib_Dir.Next;
1573    end loop;
1574
1575    --  Finally, add the default directories and obtain target parameters
1576
1577    Osint.Add_Default_Search_Dirs;
1578
1579    if Verbose_Mode then
1580       Targparm.Get_Target_Parameters;
1581
1582       Write_Eol;
1583       Display_Version ("GNATLS", "1997");
1584       Write_Eol;
1585       Write_Str ("Source Search Path:");
1586       Write_Eol;
1587
1588       for J in 1 .. Nb_Dir_In_Src_Search_Path loop
1589          Write_Str ("   ");
1590
1591          if Dir_In_Src_Search_Path (J)'Length = 0 then
1592             Write_Str ("<Current_Directory>");
1593          else
1594             Write_Str (To_Host_Dir_Spec
1595               (Dir_In_Src_Search_Path (J).all, True).all);
1596          end if;
1597
1598          Write_Eol;
1599       end loop;
1600
1601       Write_Eol;
1602       Write_Eol;
1603       Write_Str ("Object Search Path:");
1604       Write_Eol;
1605
1606       for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
1607          Write_Str ("   ");
1608
1609          if Dir_In_Obj_Search_Path (J)'Length = 0 then
1610             Write_Str ("<Current_Directory>");
1611          else
1612             Write_Str (To_Host_Dir_Spec
1613               (Dir_In_Obj_Search_Path (J).all, True).all);
1614          end if;
1615
1616          Write_Eol;
1617       end loop;
1618
1619       Write_Eol;
1620       Write_Eol;
1621       Write_Str (Project_Search_Path);
1622       Write_Eol;
1623       Write_Str ("   <Current_Directory>");
1624       Write_Eol;
1625
1626       declare
1627          Project_Path : String_Access := Getenv (Gpr_Project_Path);
1628
1629          Lib : constant String :=
1630                  Directory_Separator & "lib" & Directory_Separator;
1631
1632          First : Natural;
1633          Last  : Natural;
1634
1635          Add_Default_Dir : Boolean := True;
1636
1637       begin
1638          --  If there is a project path, display each directory in the path
1639
1640          if Project_Path.all = "" then
1641             Project_Path := Getenv (Ada_Project_Path);
1642          end if;
1643
1644          if Project_Path.all /= "" then
1645             First := Project_Path'First;
1646             loop
1647                while First <= Project_Path'Last
1648                  and then (Project_Path (First) = Path_Separator)
1649                loop
1650                   First := First + 1;
1651                end loop;
1652
1653                exit when First > Project_Path'Last;
1654
1655                Last := First;
1656                while Last < Project_Path'Last
1657                  and then Project_Path (Last + 1) /= Path_Separator
1658                loop
1659                   Last := Last + 1;
1660                end loop;
1661
1662                --  If the directory is No_Default_Project_Dir, set
1663                --  Add_Default_Dir to False.
1664
1665                if Project_Path (First .. Last) = No_Project_Default_Dir then
1666                   Add_Default_Dir := False;
1667
1668                elsif First /= Last or else Project_Path (First) /= '.' then
1669
1670                   --  If the directory is ".", skip it as it is the current
1671                   --  directory and it is already the first directory in the
1672                   --  project path.
1673
1674                   Write_Str ("   ");
1675                   Write_Str
1676                     (To_Host_Dir_Spec
1677                        (Project_Path (First .. Last), True).all);
1678                   Write_Eol;
1679                end if;
1680
1681                First := Last + 1;
1682             end loop;
1683          end if;
1684
1685          --  Add the default dir, except if "-" was one of the "directories"
1686          --  specified in ADA_PROJECT_DIR.
1687
1688          if Add_Default_Dir then
1689             Name_Len := 0;
1690             Add_Str_To_Name_Buffer (Sdefault.Search_Dir_Prefix.all);
1691
1692             --  On Windows, make sure that all directory separators are '\'
1693
1694             if Directory_Separator /= '/' then
1695                for J in 1 .. Name_Len loop
1696                   if Name_Buffer (J) = '/' then
1697                      Name_Buffer (J) := Directory_Separator;
1698                   end if;
1699                end loop;
1700             end if;
1701
1702             --  Find the sequence "/lib/"
1703
1704             while Name_Len >= Lib'Length
1705               and then Name_Buffer (Name_Len - 4 .. Name_Len) /= Lib
1706             loop
1707                Name_Len := Name_Len - 1;
1708             end loop;
1709
1710             --  If the sequence "/lib"/ was found, display the default
1711             --  directory <prefix>/lib/gnat/.
1712
1713             if Name_Len >= 5 then
1714                Name_Buffer (Name_Len + 1 .. Name_Len + 4) := "gnat";
1715                Name_Buffer (Name_Len + 5) := Directory_Separator;
1716                Name_Len := Name_Len + 5;
1717                Write_Str ("   ");
1718                Write_Line
1719                  (To_Host_Dir_Spec (Name_Buffer (1 .. Name_Len), True).all);
1720             end if;
1721          end if;
1722       end;
1723
1724       Write_Eol;
1725    end if;
1726
1727    --  Output usage information when requested
1728
1729    if Print_Usage then
1730       Usage;
1731    end if;
1732
1733    --  Output license information when requested
1734
1735    if License then
1736       Output_License_Information;
1737       Exit_Program (E_Success);
1738    end if;
1739
1740    if not More_Lib_Files then
1741       if not Print_Usage and then not Verbose_Mode then
1742          Usage;
1743       end if;
1744
1745       Exit_Program (E_Fatal);
1746    end if;
1747
1748    Initialize_ALI;
1749    Initialize_ALI_Source;
1750
1751    --  Print out all library for which no ALI files can be located
1752
1753    while More_Lib_Files loop
1754       Main_File := Next_Main_Lib_File;
1755       Ali_File  := Full_Lib_File_Name (Lib_File_Name (Main_File));
1756
1757       if Ali_File = No_File then
1758          if Very_Verbose_Mode then
1759             GNATDIST.Output_No_ALI (Lib_File_Name (Main_File));
1760
1761          else
1762             Write_Str ("Can't find library info for ");
1763             Get_Name_String (Main_File);
1764             Write_Char ('"'); -- "
1765             Write_Str (Name_Buffer (1 .. Name_Len));
1766             Write_Char ('"'); -- "
1767             Write_Eol;
1768          end if;
1769
1770       else
1771          Ali_File := Strip_Directory (Ali_File);
1772
1773          if Get_Name_Table_Info (Ali_File) = 0 then
1774             Text := Read_Library_Info (Ali_File, True);
1775
1776             declare
1777                Discard : ALI_Id;
1778                pragma Unreferenced (Discard);
1779             begin
1780                Discard :=
1781                  Scan_ALI
1782                    (Ali_File,
1783                     Text,
1784                     Ignore_ED     => False,
1785                     Err           => False,
1786                     Ignore_Errors => True);
1787             end;
1788
1789             Free (Text);
1790          end if;
1791       end if;
1792    end loop;
1793
1794    if Very_Verbose_Mode then
1795       for A in ALIs.First .. ALIs.Last loop
1796          GNATDIST.Output_ALI (A);
1797       end loop;
1798
1799       return;
1800    end if;
1801
1802    Find_General_Layout;
1803
1804    for Id in ALIs.First .. ALIs.Last loop
1805       declare
1806          Last_U : Unit_Id;
1807
1808       begin
1809          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
1810
1811          if Also_Predef or else not Is_Internal_Unit then
1812             if ALIs.Table (Id).No_Object then
1813                Output_Object (No_File);
1814             else
1815                Output_Object (ALIs.Table (Id).Ofile_Full_Name);
1816             end if;
1817
1818             --  In verbose mode print all main units in the ALI file, otherwise
1819             --  just print the first one to ease columnwise printout
1820
1821             if Verbose_Mode then
1822                Last_U := ALIs.Table (Id).Last_Unit;
1823             else
1824                Last_U := ALIs.Table (Id).First_Unit;
1825             end if;
1826
1827             for U in ALIs.Table (Id).First_Unit .. Last_U loop
1828                if U /= ALIs.Table (Id).First_Unit
1829                  and then Selective_Output
1830                  and then Print_Unit
1831                then
1832                   Write_Eol;
1833                end if;
1834
1835                Output_Unit (Id, U);
1836
1837                --  Output source now, unless if it will be done as part of
1838                --  outputing dependencies.
1839
1840                if not (Dependable and then Print_Source) then
1841                   Output_Source (Corresponding_Sdep_Entry (Id, U));
1842                end if;
1843             end loop;
1844
1845             --  Print out list of units on which this unit depends (D lines)
1846
1847             if Dependable and then Print_Source then
1848                if Verbose_Mode then
1849                   Write_Str ("depends upon");
1850                   Write_Eol;
1851                   Write_Str ("   ");
1852                else
1853                   Write_Eol;
1854                end if;
1855
1856                for D in
1857                  ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
1858                loop
1859                   if Also_Predef
1860                     or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
1861                   then
1862                      if Verbose_Mode then
1863                         Write_Str ("   ");
1864                         Output_Source (D);
1865
1866                      elsif Too_Long then
1867                         Write_Str ("   ");
1868                         Output_Source (D);
1869                         Write_Eol;
1870
1871                      else
1872                         Write_Str (Spaces (1 .. Source_Start - 2));
1873                         Output_Source (D);
1874                         Write_Eol;
1875                      end if;
1876                   end if;
1877                end loop;
1878             end if;
1879
1880             Write_Eol;
1881          end if;
1882       end;
1883    end loop;
1884
1885    --  All done. Set proper exit status
1886
1887    Namet.Finalize;
1888    Exit_Program (E_Success);
1889 end Gnatls;