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