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