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