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-2004 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, 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 Snames;
  42 with Targparm;    use Targparm;
  43 with Types;       use Types;
  44
  45 with GNAT.Case_Util; use GNAT.Case_Util;
  46
  47 procedure Gnatls is
  48    pragma Ident (Gnat_Static_Version_String);
  49
  50    Max_Column : constant := 80;
  51
  52    No_Obj : aliased String := "<no_obj>";
  53
  54    type File_Status is (
  55      OK,                  --  matching timestamp
  56      Checksum_OK,         --  only matching checksum
  57      Not_Found,           --  file not found on source PATH
  58      Not_Same,            --  neither checksum nor timestamp matching
  59      Not_First_On_PATH);  --  matching file hidden by Not_Same file on path
  60
  61    type Dir_Data;
  62    type Dir_Ref is access Dir_Data;
  63
  64    type Dir_Data is record
  65       Value : String_Access;
  66       Next  : Dir_Ref;
  67    end record;
  68    --  ??? comment needed
  69
  70    First_Source_Dir : Dir_Ref;
  71    Last_Source_Dir  : Dir_Ref;
  72    --  The list of source directories from the command line.
  73    --  These directories are added using Osint.Add_Src_Search_Dir
  74    --  after those of the GNAT Project File, if any.
  75
  76    First_Lib_Dir : Dir_Ref;
  77    Last_Lib_Dir  : Dir_Ref;
  78    --  The list of object directories from the command line.
  79    --  These directories are added using Osint.Add_Lib_Search_Dir
  80    --  after those of the GNAT Project File, if any.
  81
  82    Main_File : File_Name_Type;
  83    Ali_File  : File_Name_Type;
  84    Text      : Text_Buffer_Ptr;
  85    Next_Arg  : Positive;
  86
  87    Too_Long : Boolean := False;
  88    --  When True, lines are too long for multi-column output and each
  89    --  item of information is on a different line.
  90
  91    Selective_Output : Boolean := False;
  92    Print_Usage      : Boolean := False;
  93    Print_Unit       : Boolean := True;
  94    Print_Source     : Boolean := True;
  95    Print_Object     : Boolean := True;
  96    --  Flags controlling the form of the output
  97
  98    Dependable  : Boolean := False;  --  flag -d
  99    Also_Predef : Boolean := False;
 100
 101    Unit_Start   : Integer;
 102    Unit_End     : Integer;
 103    Source_Start : Integer;
 104    Source_End   : Integer;
 105    Object_Start : Integer;
 106    Object_End   : Integer;
 107    --  Various column starts and ends
 108
 109    Spaces : constant String (1 .. Max_Column) := (others => ' ');
 110
 111    RTS_Specified : String_Access := null;
 112    --  Used to detect multiple use of --RTS= switch
 113
 114    -----------------------
 115    -- Local Subprograms --
 116    -----------------------
 117
 118    procedure Add_Lib_Dir (Dir : String);
 119    --  Add an object directory in the list First_Lib_Dir-Last_Lib_Dir
 120
 121    procedure Add_Source_Dir (Dir : String);
 122    --  Add a source directory in the list First_Source_Dir-Last_Source_Dir
 123
 124    procedure Find_General_Layout;
 125    --  Determine the structure of the output (multi columns or not, etc)
 126
 127    procedure Find_Status
 128      (FS       : in out File_Name_Type;
 129       Stamp    : Time_Stamp_Type;
 130       Checksum : Word;
 131       Status   : out File_Status);
 132    --  Determine the file status (Status) of the file represented by FS
 133    --  with the expected Stamp and checksum given as argument. FS will be
 134    --  updated to the full file name if available.
 135
 136    function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
 137    --  Give the Sdep entry corresponding to the unit U in ali record A
 138
 139    procedure Output_Object (O : File_Name_Type);
 140    --  Print out the name of the object when requested
 141
 142    procedure Output_Source (Sdep_I : Sdep_Id);
 143    --  Print out the name and status of the source corresponding to this
 144    --  sdep entry.
 145
 146    procedure Output_Status (FS : File_Status; Verbose : Boolean);
 147    --  Print out FS either in a coded form if verbose is false or in an
 148    --  expanded form otherwise.
 149
 150    procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id);
 151    --  Print out information on the unit when requested
 152
 153    procedure Reset_Print;
 154    --  Reset Print flags properly when selective output is chosen
 155
 156    procedure Scan_Ls_Arg (Argv : String);
 157    --  Scan and process lser specific arguments. Argv is a single argument
 158
 159    procedure Usage;
 160    --  Print usage message
 161
 162    function Image (Restriction : Restriction_Id) return String;
 163    --  Returns the capitalized image of Restriction
 164
 165    -----------------
 166    -- Add_Lib_Dir --
 167    -----------------
 168
 169    procedure Add_Lib_Dir (Dir : String) is
 170    begin
 171       if First_Lib_Dir = null then
 172          First_Lib_Dir :=
 173            new Dir_Data'
 174              (Value => new String'(Dir),
 175               Next  => null);
 176          Last_Lib_Dir := First_Lib_Dir;
 177
 178       else
 179          Last_Lib_Dir.Next :=
 180            new Dir_Data'
 181              (Value => new String'(Dir),
 182               Next  => null);
 183          Last_Lib_Dir := Last_Lib_Dir.Next;
 184       end if;
 185    end Add_Lib_Dir;
 186
 187    -- -----------------
 188    -- Add_Source_Dir --
 189    --------------------
 190
 191    procedure Add_Source_Dir (Dir : String) is
 192    begin
 193       if First_Source_Dir = null then
 194          First_Source_Dir :=
 195            new Dir_Data'
 196              (Value => new String'(Dir),
 197               Next  => null);
 198          Last_Source_Dir := First_Source_Dir;
 199
 200       else
 201          Last_Source_Dir.Next :=
 202            new Dir_Data'
 203              (Value => new String'(Dir),
 204               Next  => null);
 205          Last_Source_Dir := Last_Source_Dir.Next;
 206       end if;
 207    end Add_Source_Dir;
 208
 209    ------------------------------
 210    -- Corresponding_Sdep_Entry --
 211    ------------------------------
 212
 213    function Corresponding_Sdep_Entry
 214      (A : ALI_Id;
 215       U : Unit_Id) return Sdep_Id
 216    is
 217    begin
 218       for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 219          if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
 220             return D;
 221          end if;
 222       end loop;
 223
 224       Error_Msg_Name_1 := Units.Table (U).Uname;
 225       Error_Msg_Name_2 := ALIs.Table (A).Afile;
 226       Write_Eol;
 227       Error_Msg ("wrong ALI format, can't find dependency line for & in %");
 228       Exit_Program (E_Fatal);
 229    end Corresponding_Sdep_Entry;
 230
 231    -------------------------
 232    -- Find_General_Layout --
 233    -------------------------
 234
 235    procedure Find_General_Layout is
 236       Max_Unit_Length : Integer := 11;
 237       Max_Src_Length  : Integer := 11;
 238       Max_Obj_Length  : Integer := 11;
 239
 240       Len : Integer;
 241       FS  : File_Name_Type;
 242
 243    begin
 244       --  Compute maximum of each column
 245
 246       for Id in ALIs.First .. ALIs.Last loop
 247          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
 248          if Also_Predef or else not Is_Internal_Unit then
 249
 250             if Print_Unit then
 251                Len := Name_Len - 1;
 252                Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
 253             end if;
 254
 255             if Print_Source then
 256                FS := Full_Source_Name (ALIs.Table (Id).Sfile);
 257
 258                if FS = No_File then
 259                   Get_Name_String (ALIs.Table (Id).Sfile);
 260                   Name_Len := Name_Len + 13;
 261                else
 262                   Get_Name_String (FS);
 263                end if;
 264
 265                Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
 266             end if;
 267
 268             if Print_Object then
 269                if ALIs.Table (Id).No_Object then
 270                   Max_Obj_Length :=
 271                     Integer'Max (Max_Obj_Length, No_Obj'Length);
 272                else
 273                   Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
 274                   Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
 275                end if;
 276             end if;
 277          end if;
 278       end loop;
 279
 280       --  Verify is output is not wider than maximum number of columns
 281
 282       Too_Long :=
 283         Verbose_Mode
 284           or else
 285             (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
 286
 287       --  Set start and end of columns
 288
 289       Object_Start := 1;
 290       Object_End   := Object_Start - 1;
 291
 292       if Print_Object then
 293          Object_End   := Object_Start + Max_Obj_Length;
 294       end if;
 295
 296       Unit_Start := Object_End + 1;
 297       Unit_End   := Unit_Start - 1;
 298
 299       if Print_Unit then
 300          Unit_End   := Unit_Start + Max_Unit_Length;
 301       end if;
 302
 303       Source_Start := Unit_End + 1;
 304
 305       if Source_Start > Spaces'Last then
 306          Source_Start := Spaces'Last;
 307       end if;
 308
 309       Source_End := Source_Start - 1;
 310
 311       if Print_Source then
 312          Source_End   := Source_Start + Max_Src_Length;
 313       end if;
 314    end Find_General_Layout;
 315
 316    -----------------
 317    -- Find_Status --
 318    -----------------
 319
 320    procedure Find_Status
 321      (FS       : in out File_Name_Type;
 322       Stamp    : Time_Stamp_Type;
 323       Checksum : Word;
 324       Status   : out File_Status)
 325    is
 326       Tmp1 : File_Name_Type;
 327       Tmp2 : File_Name_Type;
 328
 329    begin
 330       Tmp1 := Full_Source_Name (FS);
 331
 332       if Tmp1 = No_File then
 333          Status := Not_Found;
 334
 335       elsif File_Stamp (Tmp1) = Stamp then
 336          FS     := Tmp1;
 337          Status := OK;
 338
 339       elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
 340          FS := Tmp1;
 341          Status := Checksum_OK;
 342
 343       else
 344          Tmp2 := Matching_Full_Source_Name (FS, Stamp);
 345
 346          if Tmp2 = No_File then
 347             Status := Not_Same;
 348             FS     := Tmp1;
 349
 350          else
 351             Status := Not_First_On_PATH;
 352             FS := Tmp2;
 353          end if;
 354       end if;
 355    end Find_Status;
 356
 357    -----------
 358    -- Image --
 359    -----------
 360
 361    function Image (Restriction : Restriction_Id) return String is
 362       Result : String := Restriction'Img;
 363       Skip   : Boolean := True;
 364
 365    begin
 366       for J in Result'Range loop
 367          if Skip then
 368             Skip := False;
 369             Result (J) := To_Upper (Result (J));
 370
 371          elsif Result (J) = '_' then
 372             Skip := True;
 373
 374          else
 375             Result (J) := To_Lower (Result (J));
 376          end if;
 377       end loop;
 378
 379       return Result;
 380    end Image;
 381
 382    -------------------
 383    -- Output_Object --
 384    -------------------
 385
 386    procedure Output_Object (O : File_Name_Type) is
 387       Object_Name : String_Access;
 388
 389    begin
 390       if Print_Object then
 391          if O /= No_File then
 392             Get_Name_String (O);
 393             Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 394          else
 395             Object_Name := No_Obj'Unchecked_Access;
 396          end if;
 397
 398          Write_Str (Object_Name.all);
 399
 400          if Print_Source or else Print_Unit then
 401             if Too_Long then
 402                Write_Eol;
 403                Write_Str ("   ");
 404             else
 405                Write_Str (Spaces
 406                 (Object_Start + Object_Name'Length .. Object_End));
 407             end if;
 408          end if;
 409       end if;
 410    end Output_Object;
 411
 412    -------------------
 413    -- Output_Source --
 414    -------------------
 415
 416    procedure Output_Source (Sdep_I : Sdep_Id) is
 417       Stamp       : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
 418       Checksum    : constant Word            := Sdep.Table (Sdep_I).Checksum;
 419       FS          : File_Name_Type           := Sdep.Table (Sdep_I).Sfile;
 420       Status      : File_Status;
 421       Object_Name : String_Access;
 422
 423    begin
 424       if Print_Source then
 425          Find_Status (FS, Stamp, Checksum, Status);
 426          Get_Name_String (FS);
 427
 428          Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 429
 430          if Verbose_Mode then
 431             Write_Str ("  Source => ");
 432             Write_Str (Object_Name.all);
 433
 434             if not Too_Long then
 435                Write_Str
 436                  (Spaces (Source_Start + Object_Name'Length .. Source_End));
 437             end if;
 438
 439             Output_Status (Status, Verbose => True);
 440             Write_Eol;
 441             Write_Str ("   ");
 442
 443          else
 444             if not Selective_Output then
 445                Output_Status (Status, Verbose => False);
 446             end if;
 447
 448             Write_Str (Object_Name.all);
 449          end if;
 450       end if;
 451    end Output_Source;
 452
 453    -------------------
 454    -- Output_Status --
 455    -------------------
 456
 457    procedure Output_Status (FS : File_Status; Verbose : Boolean) is
 458    begin
 459       if Verbose then
 460          case FS is
 461             when OK =>
 462                Write_Str (" unchanged");
 463
 464             when Checksum_OK =>
 465                Write_Str (" slightly modified");
 466
 467             when Not_Found =>
 468                Write_Str (" file not found");
 469
 470             when Not_Same =>
 471                Write_Str (" modified");
 472
 473             when Not_First_On_PATH =>
 474                Write_Str (" unchanged version not first on PATH");
 475          end case;
 476
 477       else
 478          case FS is
 479             when OK =>
 480                Write_Str ("  OK ");
 481
 482             when Checksum_OK =>
 483                Write_Str (" MOK ");
 484
 485             when Not_Found =>
 486                Write_Str (" ??? ");
 487
 488             when Not_Same =>
 489                Write_Str (" DIF ");
 490
 491             when Not_First_On_PATH =>
 492                Write_Str (" HID ");
 493          end case;
 494       end if;
 495    end Output_Status;
 496
 497    -----------------
 498    -- Output_Unit --
 499    -----------------
 500
 501    procedure Output_Unit (ALI : ALI_Id; U_Id : Unit_Id) is
 502       Kind : Character;
 503       U    : Unit_Record renames Units.Table (U_Id);
 504
 505    begin
 506       if Print_Unit then
 507          Get_Name_String (U.Uname);
 508          Kind := Name_Buffer (Name_Len);
 509          Name_Len := Name_Len - 2;
 510
 511          if not Verbose_Mode then
 512             Write_Str (Name_Buffer (1 .. Name_Len));
 513
 514          else
 515             Write_Str ("Unit => ");
 516             Write_Eol;
 517             Write_Str ("     Name   => ");
 518             Write_Str (Name_Buffer (1 .. Name_Len));
 519             Write_Eol;
 520             Write_Str ("     Kind   => ");
 521
 522             if Units.Table (U_Id).Unit_Kind = 'p' then
 523                Write_Str ("package ");
 524             else
 525                Write_Str ("subprogram ");
 526             end if;
 527
 528             if Kind = 's' then
 529                Write_Str ("spec");
 530             else
 531                Write_Str ("body");
 532             end if;
 533          end if;
 534
 535          if Verbose_Mode then
 536             if U.Preelab             or
 537                U.No_Elab             or
 538                U.Pure                or
 539                U.Dynamic_Elab        or
 540                U.Has_RACW            or
 541                U.Remote_Types        or
 542                U.Shared_Passive      or
 543                U.RCI                 or
 544                U.Predefined          or
 545                U.Internal            or
 546                U.Is_Generic          or
 547                U.Init_Scalars        or
 548                U.Interface           or
 549                U.Body_Needed_For_SAL or
 550                U.Elaborate_Body
 551             then
 552                Write_Eol;
 553                Write_Str ("     Flags  =>");
 554
 555                if U.Preelab then
 556                   Write_Str (" Preelaborable");
 557                end if;
 558
 559                if U.No_Elab then
 560                   Write_Str (" No_Elab_Code");
 561                end if;
 562
 563                if U.Pure then
 564                   Write_Str (" Pure");
 565                end if;
 566
 567                if U.Dynamic_Elab then
 568                   Write_Str (" Dynamic_Elab");
 569                end if;
 570
 571                if U.Has_RACW then
 572                   Write_Str (" Has_RACW");
 573                end if;
 574
 575                if U.Remote_Types then
 576                   Write_Str (" Remote_Types");
 577                end if;
 578
 579                if U.Shared_Passive then
 580                   Write_Str (" Shared_Passive");
 581                end if;
 582
 583                if U.RCI then
 584                   Write_Str (" RCI");
 585                end if;
 586
 587                if U.Predefined then
 588                   Write_Str (" Predefined");
 589                end if;
 590
 591                if U.Internal then
 592                   Write_Str (" Internal");
 593                end if;
 594
 595                if U.Is_Generic then
 596                   Write_Str (" Is_Generic");
 597                end if;
 598
 599                if U.Init_Scalars then
 600                   Write_Str (" Init_Scalars");
 601                end if;
 602
 603                if U.Interface then
 604                   Write_Str (" Interface");
 605                end if;
 606
 607                if U.Body_Needed_For_SAL then
 608                   Write_Str (" Body_Needed_For_SAL");
 609                end if;
 610
 611                if U.Elaborate_Body then
 612                   Write_Str (" Elaborate Body");
 613                end if;
 614
 615                if U.Remote_Types then
 616                   Write_Str (" Remote_Types");
 617                end if;
 618
 619                if U.Shared_Passive then
 620                   Write_Str (" Shared_Passive");
 621                end if;
 622
 623                if U.Predefined then
 624                   Write_Str (" Predefined");
 625                end if;
 626
 627             end if;
 628
 629             declare
 630                Restrictions : constant Restrictions_Info :=
 631                                 ALIs.Table (ALI).Restrictions;
 632             begin
 633                --  If the source was compiled with pragmas Restrictions,
 634                --  Display these restrictions.
 635
 636                if Restrictions.Set /= (All_Restrictions => False) then
 637                   Write_Eol;
 638                   Write_Str ("     pragma Restrictions  =>");
 639
 640                   --  For boolean restrictions, just display the name of the
 641                   --  restriction; for valued restrictions, also display the
 642                   --  restriction value.
 643
 644                   for Restriction in All_Restrictions loop
 645                      if Restrictions.Set (Restriction) then
 646                         Write_Eol;
 647                         Write_Str ("       ");
 648                         Write_Str (Image (Restriction));
 649
 650                         if Restriction in All_Parameter_Restrictions then
 651                            Write_Str (" =>");
 652                            Write_Str (Restrictions.Value (Restriction)'Img);
 653                         end if;
 654                      end if;
 655                   end loop;
 656                end if;
 657
 658                --  If the unit violates some Restrictions, display the list of
 659                --  these restrictions.
 660
 661                if Restrictions.Violated /= (All_Restrictions => False) then
 662                   Write_Eol;
 663                   Write_Str ("     Restrictions violated =>");
 664
 665                   --  For boolean restrictions, just display the name of the
 666                   --  restriction; for valued restrictions, also display the
 667                   --  restriction value.
 668
 669                   for Restriction in All_Restrictions loop
 670                      if Restrictions.Violated (Restriction) then
 671                         Write_Eol;
 672                         Write_Str ("       ");
 673                         Write_Str (Image (Restriction));
 674
 675                         if Restriction in All_Parameter_Restrictions then
 676                            if Restrictions.Count (Restriction) > 0 then
 677                               Write_Str (" =>");
 678
 679                               if Restrictions.Unknown (Restriction) then
 680                                  Write_Str (" at least");
 681                               end if;
 682
 683                               Write_Str (Restrictions.Count (Restriction)'Img);
 684                            end if;
 685                         end if;
 686                      end if;
 687                   end loop;
 688                end if;
 689             end;
 690          end if;
 691
 692          if Print_Source then
 693             if Too_Long then
 694                Write_Eol;
 695                Write_Str ("   ");
 696             else
 697                Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
 698             end if;
 699          end if;
 700       end if;
 701    end Output_Unit;
 702
 703    -----------------
 704    -- Reset_Print --
 705    -----------------
 706
 707    procedure Reset_Print is
 708    begin
 709       if not Selective_Output then
 710          Selective_Output := True;
 711          Print_Source := False;
 712          Print_Object := False;
 713          Print_Unit   := False;
 714       end if;
 715    end Reset_Print;
 716
 717    -------------------
 718    -- Scan_Ls_Arg --
 719    -------------------
 720
 721    procedure Scan_Ls_Arg (Argv : String) is
 722       FD  : File_Descriptor;
 723       Len : Integer;
 724    begin
 725       pragma Assert (Argv'First = 1);
 726
 727       if Argv'Length = 0 then
 728          return;
 729       end if;
 730
 731       if Argv (1) = '-' then
 732
 733          if Argv'Length = 1 then
 734             Fail ("switch character cannot be followed by a blank");
 735
 736          --  Processing for -I-
 737
 738          elsif Argv (2 .. Argv'Last) = "I-" then
 739             Opt.Look_In_Primary_Dir := False;
 740
 741          --  Forbid -?- or -??- where ? is any character
 742
 743          elsif (Argv'Length = 3 and then Argv (3) = '-')
 744            or else (Argv'Length = 4 and then Argv (4) = '-')
 745          then
 746             Fail ("Trailing ""-"" at the end of ", Argv, " forbidden.");
 747
 748          --  Processing for -Idir
 749
 750          elsif Argv (2) = 'I' then
 751             Add_Source_Dir (Argv (3 .. Argv'Last));
 752             Add_Lib_Dir (Argv (3 .. Argv'Last));
 753
 754          --  Processing for -aIdir (to gcc this is like a -I switch)
 755
 756          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
 757             Add_Source_Dir (Argv (4 .. Argv'Last));
 758
 759          --  Processing for -aOdir
 760
 761          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
 762             Add_Lib_Dir (Argv (4 .. Argv'Last));
 763
 764          --  Processing for -aLdir (to gnatbind this is like a -aO switch)
 765
 766          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
 767             Add_Lib_Dir (Argv (4 .. Argv'Last));
 768
 769          --  Processing for -nostdinc
 770
 771          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 772             Opt.No_Stdinc := True;
 773
 774          --  Processing for one character switches
 775
 776          elsif Argv'Length = 2 then
 777             case Argv (2) is
 778                when 'a' => Also_Predef               := True;
 779                when 'h' => Print_Usage               := True;
 780                when 'u' => Reset_Print; Print_Unit   := True;
 781                when 's' => Reset_Print; Print_Source := True;
 782                when 'o' => Reset_Print; Print_Object := True;
 783                when 'v' => Verbose_Mode              := True;
 784                when 'd' => Dependable                := True;
 785
 786                when others => null;
 787             end case;
 788
 789          --  Processing for -files=file
 790
 791          elsif Argv'Length > 7 and then Argv (1 .. 7) = "-files=" then
 792             FD := Open_Read (Argv (8 .. Argv'Last), GNAT.OS_Lib.Text);
 793
 794             if FD = Invalid_FD then
 795                Osint.Fail ("could not find text file """ &
 796                            Argv (8 .. Argv'Last) & '"');
 797             end if;
 798
 799             Len := Integer (File_Length (FD));
 800
 801             declare
 802                Buffer : String (1 .. Len + 1);
 803                Index  : Positive := 1;
 804                Last   : Positive;
 805
 806             begin
 807                --  Read the file
 808
 809                Len := Read (FD, Buffer (1)'Address, Len);
 810                Buffer (Buffer'Last) := ASCII.NUL;
 811                Close (FD);
 812
 813                --  Scan the file line by line
 814
 815                while Index < Buffer'Last loop
 816                   --  Find the end of line
 817
 818                   Last := Index;
 819
 820                   while Last <= Buffer'Last
 821                     and then Buffer (Last) /= ASCII.LF
 822                     and then Buffer (Last) /= ASCII.CR
 823                   loop
 824                      Last := Last + 1;
 825                   end loop;
 826
 827                   --  Ignore empty lines
 828
 829                   if Last > Index then
 830                      Add_File (Buffer (Index .. Last - 1));
 831                   end if;
 832
 833                   Index := Last;
 834
 835                   --  Find the beginning of the next line
 836
 837                   while Buffer (Index) = ASCII.CR or else
 838                         Buffer (Index) = ASCII.LF
 839                   loop
 840                      Index := Index + 1;
 841                   end loop;
 842                end loop;
 843             end;
 844
 845          --  Processing for --RTS=path
 846
 847          elsif Argv'Length >= 5 and then Argv (1 .. 5) = "--RTS" then
 848             if Argv'Length <= 6 or else Argv (6) /= '='then
 849                Osint.Fail ("missing path for --RTS");
 850
 851             else
 852                --  Check that it is the first time we see this switch or, if
 853                --  it is not the first time, the same path is specified.
 854
 855                if RTS_Specified = null then
 856                   RTS_Specified := new String'(Argv (7 .. Argv'Last));
 857
 858                elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
 859                   Osint.Fail ("--RTS cannot be specified multiple times");
 860                end if;
 861
 862                --  Valid --RTS switch
 863
 864                Opt.No_Stdinc := True;
 865                Opt.RTS_Switch := True;
 866
 867                declare
 868                   Src_Path_Name : constant String_Ptr :=
 869                                     String_Ptr
 870                                       (Get_RTS_Search_Dir
 871                                         (Argv (7 .. Argv'Last), Include));
 872                   Lib_Path_Name : constant String_Ptr :=
 873                                     String_Ptr
 874                                       (Get_RTS_Search_Dir
 875                                         (Argv (7 .. Argv'Last), Objects));
 876
 877                begin
 878                   if Src_Path_Name /= null
 879                     and then Lib_Path_Name /= null
 880                   then
 881                      Add_Search_Dirs (Src_Path_Name, Include);
 882                      Add_Search_Dirs (Lib_Path_Name, Objects);
 883
 884                   elsif Src_Path_Name = null
 885                     and then Lib_Path_Name = null
 886                   then
 887                      Osint.Fail ("RTS path not valid: missing " &
 888                                  "adainclude and adalib directories");
 889
 890                   elsif Src_Path_Name = null then
 891                      Osint.Fail ("RTS path not valid: missing " &
 892                                  "adainclude directory");
 893
 894                   elsif Lib_Path_Name = null then
 895                      Osint.Fail ("RTS path not valid: missing " &
 896                                  "adalib directory");
 897                   end if;
 898                end;
 899             end if;
 900          end if;
 901
 902       --  If not a switch, it must be a file name
 903
 904       else
 905          Add_File (Argv);
 906       end if;
 907    end Scan_Ls_Arg;
 908
 909    -----------
 910    -- Usage --
 911    -----------
 912
 913    procedure Usage is
 914
 915    --  Start of processing for Usage
 916
 917    begin
 918       --  Usage line
 919
 920       Write_Str ("Usage: ");
 921       Osint.Write_Program_Name;
 922       Write_Str ("  switches  [list of object files]");
 923       Write_Eol;
 924       Write_Eol;
 925
 926       --  GNATLS switches
 927
 928       Write_Str ("switches:");
 929       Write_Eol;
 930
 931       --  Line for -a
 932
 933       Write_Str ("  -a         also output relevant predefined units");
 934       Write_Eol;
 935
 936       --  Line for -u
 937
 938       Write_Str ("  -u         output only relevant unit names");
 939       Write_Eol;
 940
 941       --  Line for -h
 942
 943       Write_Str ("  -h         output this help message");
 944       Write_Eol;
 945
 946       --  Line for -s
 947
 948       Write_Str ("  -s         output only relevant source names");
 949       Write_Eol;
 950
 951       --  Line for -o
 952
 953       Write_Str ("  -o         output only relevant object names");
 954       Write_Eol;
 955
 956       --  Line for -d
 957
 958       Write_Str ("  -d         output sources on which specified units " &
 959                                "depend");
 960       Write_Eol;
 961
 962       --  Line for -v
 963
 964       Write_Str ("  -v         verbose output, full path and unit " &
 965                                "information");
 966       Write_Eol;
 967       Write_Eol;
 968
 969       --  Line for -files=
 970
 971       Write_Str ("  -files=fil files are listed in text file 'fil'");
 972       Write_Eol;
 973
 974       --  Line for -aI switch
 975
 976       Write_Str ("  -aIdir     specify source files search path");
 977       Write_Eol;
 978
 979       --  Line for -aO switch
 980
 981       Write_Str ("  -aOdir     specify object files search path");
 982       Write_Eol;
 983
 984       --  Line for -I switch
 985
 986       Write_Str ("  -Idir      like -aIdir -aOdir");
 987       Write_Eol;
 988
 989       --  Line for -I- switch
 990
 991       Write_Str ("  -I-        do not look for sources & object files");
 992       Write_Str (" in the default directory");
 993       Write_Eol;
 994
 995       --  Line for -nostdinc
 996
 997       Write_Str ("  -nostdinc  do not look for source files");
 998       Write_Str (" in the system default directory");
 999       Write_Eol;
1000
1001       --  Line for --RTS
1002
1003       Write_Str ("  --RTS=dir  specify the default source and object search"
1004                  & " path");
1005       Write_Eol;
1006
1007       --  File Status explanation
1008
1009       Write_Eol;
1010       Write_Str (" file status can be:");
1011       Write_Eol;
1012
1013       for ST in File_Status loop
1014          Write_Str ("   ");
1015          Output_Status (ST, Verbose => False);
1016          Write_Str (" ==> ");
1017          Output_Status (ST, Verbose => True);
1018          Write_Eol;
1019       end loop;
1020
1021    end Usage;
1022
1023    --   Start of processing for Gnatls
1024
1025 begin
1026    --  Initialize standard packages
1027
1028    Namet.Initialize;
1029    Csets.Initialize;
1030    Snames.Initialize;
1031
1032    --  Loop to scan out arguments
1033
1034    Next_Arg := 1;
1035    Scan_Args : while Next_Arg < Arg_Count loop
1036       declare
1037          Next_Argv : String (1 .. Len_Arg (Next_Arg));
1038       begin
1039          Fill_Arg (Next_Argv'Address, Next_Arg);
1040          Scan_Ls_Arg (Next_Argv);
1041       end;
1042
1043       Next_Arg := Next_Arg + 1;
1044    end loop Scan_Args;
1045
1046    --  Add the source and object directories specified on the
1047    --  command line, if any, to the searched directories.
1048
1049    while First_Source_Dir /= null loop
1050       Add_Src_Search_Dir (First_Source_Dir.Value.all);
1051       First_Source_Dir := First_Source_Dir.Next;
1052    end loop;
1053
1054    while First_Lib_Dir /= null loop
1055       Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
1056       First_Lib_Dir := First_Lib_Dir.Next;
1057    end loop;
1058
1059    --  Finally, add the default directories and obtain target parameters
1060
1061    Osint.Add_Default_Search_Dirs;
1062
1063    if Verbose_Mode then
1064       Targparm.Get_Target_Parameters;
1065
1066       --  WARNING: the output of gnatls -v is used during the compilation
1067       --  and installation of GLADE to recreate sdefault.adb and locate
1068       --  the libgnat.a to use. Any change in the output of gnatls -v must
1069       --  be synchronized with the GLADE Dist/config.sdefault shell script.
1070
1071       Write_Eol;
1072       Write_Str ("GNATLS ");
1073       Write_Str (Gnat_Version_String);
1074       Write_Str (" Copyright 1997-2004 Free Software Foundation, Inc.");
1075       Write_Eol;
1076       Write_Eol;
1077       Write_Str ("Source Search Path:");
1078       Write_Eol;
1079
1080       for J in 1 .. Nb_Dir_In_Src_Search_Path loop
1081          Write_Str ("   ");
1082
1083          if Dir_In_Src_Search_Path (J)'Length = 0 then
1084             Write_Str ("<Current_Directory>");
1085          else
1086             Write_Str (To_Host_Dir_Spec
1087               (Dir_In_Src_Search_Path (J).all, True).all);
1088          end if;
1089
1090          Write_Eol;
1091       end loop;
1092
1093       Write_Eol;
1094       Write_Eol;
1095       Write_Str ("Object Search Path:");
1096       Write_Eol;
1097
1098       for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
1099          Write_Str ("   ");
1100
1101          if Dir_In_Obj_Search_Path (J)'Length = 0 then
1102             Write_Str ("<Current_Directory>");
1103          else
1104             Write_Str (To_Host_Dir_Spec
1105               (Dir_In_Obj_Search_Path (J).all, True).all);
1106          end if;
1107
1108          Write_Eol;
1109       end loop;
1110
1111       Write_Eol;
1112    end if;
1113
1114    --  Output usage information when requested
1115
1116    if Print_Usage then
1117       Usage;
1118    end if;
1119
1120    if not More_Lib_Files then
1121       if not Print_Usage and then not Verbose_Mode then
1122          Usage;
1123       end if;
1124
1125       Exit_Program (E_Fatal);
1126    end if;
1127
1128    Initialize_ALI;
1129    Initialize_ALI_Source;
1130
1131    --  Print out all library for which no ALI files can be located
1132
1133    while More_Lib_Files loop
1134       Main_File := Next_Main_Lib_File;
1135       Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
1136
1137       if Ali_File = No_File then
1138          Write_Str ("Can't find library info for ");
1139          Get_Name_String (Main_File);
1140          Write_Char ('"');
1141          Write_Str (Name_Buffer (1 .. Name_Len));
1142          Write_Char ('"');
1143          Write_Eol;
1144
1145       else
1146          Ali_File := Strip_Directory (Ali_File);
1147
1148          if Get_Name_Table_Info (Ali_File) = 0 then
1149             Text := Read_Library_Info (Ali_File, True);
1150
1151             declare
1152                Discard : ALI_Id;
1153                pragma Unreferenced (Discard);
1154             begin
1155                Discard :=
1156                  Scan_ALI
1157                    (Ali_File,
1158                     Text,
1159                     Ignore_ED     => False,
1160                     Err           => False,
1161                     Ignore_Errors => True);
1162             end;
1163
1164             Free (Text);
1165          end if;
1166       end if;
1167    end loop;
1168
1169    Find_General_Layout;
1170
1171    for Id in ALIs.First .. ALIs.Last loop
1172       declare
1173          Last_U : Unit_Id;
1174
1175       begin
1176          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
1177
1178          if Also_Predef or else not Is_Internal_Unit then
1179             if ALIs.Table (Id).No_Object then
1180                Output_Object (No_File);
1181             else
1182                Output_Object (ALIs.Table (Id).Ofile_Full_Name);
1183             end if;
1184
1185             --  In verbose mode print all main units in the ALI file, otherwise
1186             --  just print the first one to ease columnwise printout
1187
1188             if Verbose_Mode then
1189                Last_U := ALIs.Table (Id).Last_Unit;
1190             else
1191                Last_U := ALIs.Table (Id).First_Unit;
1192             end if;
1193
1194             for U in ALIs.Table (Id).First_Unit .. Last_U loop
1195                if U /= ALIs.Table (Id).First_Unit
1196                  and then Selective_Output
1197                  and then Print_Unit
1198                then
1199                   Write_Eol;
1200                end if;
1201
1202                Output_Unit (Id, U);
1203
1204                --  Output source now, unless if it will be done as part of
1205                --  outputing dependencies.
1206
1207                if not (Dependable and then Print_Source) then
1208                   Output_Source (Corresponding_Sdep_Entry (Id, U));
1209                end if;
1210             end loop;
1211
1212             --  Print out list of units on which this unit depends (D lines)
1213
1214             if Dependable and then Print_Source then
1215                if Verbose_Mode then
1216                   Write_Str ("depends upon");
1217                   Write_Eol;
1218                   Write_Str ("   ");
1219
1220                else
1221                   Write_Eol;
1222                end if;
1223
1224                for D in
1225                  ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
1226                loop
1227                   if Also_Predef
1228                     or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
1229                   then
1230                      if Verbose_Mode then
1231                         Write_Str ("   ");
1232                         Output_Source (D);
1233
1234                      elsif Too_Long then
1235                         Write_Str ("   ");
1236                         Output_Source (D);
1237                         Write_Eol;
1238
1239                      else
1240                         Write_Str (Spaces (1 .. Source_Start - 2));
1241                         Output_Source (D);
1242                         Write_Eol;
1243                      end if;
1244                   end if;
1245                end loop;
1246             end if;
1247
1248             Write_Eol;
1249          end if;
1250       end;
1251    end loop;
1252
1253    --  All done. Set proper exit status
1254
1255    Namet.Finalize;
1256    Exit_Program (E_Success);
1257 end Gnatls;