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