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