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 --                            $Revision$
  10 --                                                                          --
  11 --           Copyright (C) 1992-2001 Free Software Foundation, Inc.         --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with ALI;         use ALI;
  30 with ALI.Util;    use ALI.Util;
  31 with Binderr;     use Binderr;
  32 with Butil;       use Butil;
  33 with Csets;
  34 with Fname;       use Fname;
  35 with Gnatvsn;     use Gnatvsn;
  36 with GNAT.OS_Lib; use GNAT.OS_Lib;
  37 with Namet;       use Namet;
  38 with Opt;         use Opt;
  39 with Osint;       use Osint;
  40 with Output;      use Output;
  41 with Prj;         use Prj;
  42 with Prj.Pars;    use Prj.Pars;
  43 with Prj.Env;
  44 with Prj.Ext;     use Prj.Ext;
  45 with Prj.Util;    use Prj.Util;
  46 with Snames;      use Snames;
  47 with Stringt;     use Stringt;
  48 with Types;       use Types;
  49
  50 procedure Gnatls is
  51    pragma Ident (Gnat_Version_String);
  52
  53    Max_Column : constant := 80;
  54
  55    type File_Status is (
  56      OK,                  --  matching timestamp
  57      Checksum_OK,         --  only matching checksum
  58      Not_Found,           --  file not found on source PATH
  59      Not_Same,            --  neither checksum nor timestamp matching
  60      Not_First_On_PATH);  --  matching file hidden by Not_Same file on path
  61
  62    type Dir_Data;
  63    type Dir_Ref is access Dir_Data;
  64
  65    type Dir_Data is record
  66       Value : String_Access;
  67       Next  : Dir_Ref;
  68    end record;
  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
  85    Text : Text_Buffer_Ptr;
  86    Id   : ALI_Id;
  87
  88    Next_Arg : Positive;
  89
  90    Too_Long : Boolean := False;
  91    --  When True, lines are too long for multi-column output and each
  92    --  item of information is on a different line.
  93
  94    Project_File      : String_Access;
  95    Project           : Prj.Project_Id;
  96    Current_Verbosity : Prj.Verbosity := Prj.Default;
  97
  98    Selective_Output : Boolean := False;
  99    Print_Usage      : Boolean := False;
 100    Print_Unit       : Boolean := True;
 101    Print_Source     : Boolean := True;
 102    Print_Object     : Boolean := True;
 103    --  Flags controlling the form of the outpout
 104
 105    Dependable       : Boolean := False;  --  flag -d
 106    Also_Predef      : Boolean := False;
 107
 108    Unit_Start   : Integer;
 109    Unit_End     : Integer;
 110    Source_Start : Integer;
 111    Source_End   : Integer;
 112    Object_Start : Integer;
 113    Object_End   : Integer;
 114    --  Various column starts and ends
 115
 116    Spaces : constant String (1 .. Max_Column) := (others => ' ');
 117
 118    -----------------------
 119    -- Local Subprograms --
 120    -----------------------
 121
 122    procedure Add_Lib_Dir (Dir : String; And_Save : Boolean);
 123    --  Add an object directory, using Osint.Add_Lib_Search_Dir
 124    --  if And_Save is False or keeping in the list First_Lib_Dir,
 125    --  Last_Lib_Dir if And_Save is True.
 126
 127    procedure Add_Source_Dir (Dir : String; And_Save : Boolean);
 128    --  Add a source directory, using Osint.Add_Src_Search_Dir
 129    --  if And_Save is False or keeping in the list First_Source_Dir,
 130    --  Last_Source_Dir if And_Save is True.
 131
 132    procedure Find_General_Layout;
 133    --  Determine the structure of the output (multi columns or not, etc)
 134
 135    procedure Find_Status
 136      (FS       : in out File_Name_Type;
 137       Stamp    : Time_Stamp_Type;
 138       Checksum : Word;
 139       Status   : out File_Status);
 140    --  Determine the file status (Status) of the file represented by FS
 141    --  with the expected Stamp and checksum given as argument. FS will be
 142    --  updated to the full file name if available.
 143
 144    function Corresponding_Sdep_Entry (A : ALI_Id; U : Unit_Id) return Sdep_Id;
 145    --  Give the Sdep entry corresponding to the unit U in ali record A.
 146
 147    function Index (Char : Character; Str : String) return Natural;
 148    --  Returns the first occurence of Char in Str.
 149    --  Returns 0 if Char is not in Str.
 150
 151    procedure Output_Object (O : File_Name_Type);
 152    --  Print out the name of the object when requested
 153
 154    procedure Output_Source (Sdep_I : Sdep_Id);
 155    --  Print out the name and status of the source corresponding to this
 156    --  sdep entry
 157
 158    procedure Output_Status (FS : File_Status; Verbose : Boolean);
 159    --  Print out FS either in a coded form if verbose is false or in an
 160    --  expanded form otherwise.
 161
 162    procedure Output_Unit (U_Id : Unit_Id);
 163    --  Print out information on the unit when requested
 164
 165    procedure Reset_Print;
 166    --  Reset Print flags properly when selective output is chosen
 167
 168    procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean);
 169    --  Scan and process lser specific arguments. Argv is a single argument.
 170
 171    procedure Usage;
 172    --  Print usage message.
 173
 174    -----------------
 175    -- Add_Lib_Dir --
 176    -----------------
 177
 178    procedure Add_Lib_Dir (Dir : String; And_Save : Boolean) is
 179    begin
 180       if And_Save then
 181          if First_Lib_Dir = null then
 182             First_Lib_Dir :=
 183               new Dir_Data'
 184                 (Value => new String'(Dir),
 185                  Next => null);
 186             Last_Lib_Dir := First_Lib_Dir;
 187
 188          else
 189             Last_Lib_Dir.Next :=
 190               new Dir_Data'
 191                 (Value => new String'(Dir),
 192                  Next => null);
 193             Last_Lib_Dir := Last_Lib_Dir.Next;
 194          end if;
 195
 196       else
 197          Add_Lib_Search_Dir (Dir);
 198       end if;
 199    end Add_Lib_Dir;
 200
 201    -- -----------------
 202    -- Add_Source_Dir --
 203    --------------------
 204
 205    procedure Add_Source_Dir (Dir : String; And_Save : Boolean) is
 206    begin
 207       if And_Save then
 208          if First_Source_Dir = null then
 209             First_Source_Dir :=
 210               new Dir_Data'
 211                 (Value => new String'(Dir),
 212                  Next => null);
 213             Last_Source_Dir := First_Source_Dir;
 214
 215          else
 216             Last_Source_Dir.Next :=
 217               new Dir_Data'
 218                 (Value => new String'(Dir),
 219                  Next => null);
 220             Last_Source_Dir := Last_Source_Dir.Next;
 221          end if;
 222
 223       else
 224          Add_Src_Search_Dir (Dir);
 225       end if;
 226    end Add_Source_Dir;
 227
 228    ------------------------------
 229    -- Corresponding_Sdep_Entry --
 230    ------------------------------
 231
 232    function Corresponding_Sdep_Entry
 233      (A     : ALI_Id;
 234       U     : Unit_Id)
 235       return  Sdep_Id
 236    is
 237    begin
 238       for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
 239          if Sdep.Table (D).Sfile = Units.Table (U).Sfile then
 240             return D;
 241          end if;
 242       end loop;
 243
 244       Error_Msg_Name_1 := Units.Table (U).Uname;
 245       Error_Msg_Name_2 := ALIs.Table (A).Afile;
 246       Write_Eol;
 247       Error_Msg ("wrong ALI format, can't find dependancy line for & in %");
 248       Exit_Program (E_Fatal);
 249
 250       --  Not needed since we exit the program but avoids compiler warning
 251
 252       raise Program_Error;
 253    end Corresponding_Sdep_Entry;
 254
 255    -------------------------
 256    -- Find_General_Layout --
 257    -------------------------
 258
 259    procedure Find_General_Layout is
 260       Max_Unit_Length : Integer := 11;
 261       Max_Src_Length  : Integer := 11;
 262       Max_Obj_Length  : Integer := 11;
 263
 264       Len : Integer;
 265       FS  : File_Name_Type;
 266
 267    begin
 268       --  Compute maximum of each column
 269
 270       for Id in ALIs.First .. ALIs.Last loop
 271
 272          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
 273          if Also_Predef or else not Is_Internal_Unit then
 274
 275             if Print_Unit then
 276                Len := Name_Len - 1;
 277                Max_Unit_Length := Integer'Max (Max_Unit_Length, Len);
 278             end if;
 279
 280             if Print_Source then
 281                FS := Full_Source_Name (ALIs.Table (Id).Sfile);
 282
 283                if FS = No_File then
 284                   Get_Name_String (ALIs.Table (Id).Sfile);
 285                   Name_Len := Name_Len + 13;
 286                else
 287                   Get_Name_String (FS);
 288                end if;
 289
 290                Max_Src_Length := Integer'Max (Max_Src_Length, Name_Len + 1);
 291             end if;
 292
 293             if Print_Object then
 294                Get_Name_String (ALIs.Table (Id).Ofile_Full_Name);
 295                Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1);
 296             end if;
 297          end if;
 298       end loop;
 299
 300       --  Verify is output is not wider than maximum number of columns
 301
 302       Too_Long := Verbose_Mode or else
 303         (Max_Unit_Length + Max_Src_Length + Max_Obj_Length) > Max_Column;
 304
 305       --  Set start and end of columns.
 306
 307       Object_Start := 1;
 308       Object_End   := Object_Start - 1;
 309
 310       if Print_Object then
 311          Object_End   := Object_Start + Max_Obj_Length;
 312       end if;
 313
 314       Unit_Start := Object_End + 1;
 315       Unit_End   := Unit_Start - 1;
 316
 317       if Print_Unit then
 318          Unit_End   := Unit_Start + Max_Unit_Length;
 319       end if;
 320
 321       Source_Start := Unit_End + 1;
 322       if Source_Start > Spaces'Last then
 323          Source_Start := Spaces'Last;
 324       end if;
 325       Source_End   := Source_Start - 1;
 326
 327       if Print_Source then
 328          Source_End   := Source_Start + Max_Src_Length;
 329       end if;
 330    end Find_General_Layout;
 331
 332    -----------------
 333    -- Find_Status --
 334    -----------------
 335
 336    procedure Find_Status
 337      (FS       : in out File_Name_Type;
 338       Stamp    : Time_Stamp_Type;
 339       Checksum : Word;
 340       Status   : out File_Status)
 341    is
 342       Tmp1 : File_Name_Type;
 343       Tmp2 : File_Name_Type;
 344
 345    begin
 346       Tmp1 := Full_Source_Name (FS);
 347
 348       if Tmp1 = No_File then
 349          Status := Not_Found;
 350
 351       elsif File_Stamp (Tmp1) = Stamp then
 352          FS     := Tmp1;
 353          Status := OK;
 354
 355       elsif Checksums_Match (Get_File_Checksum (FS), Checksum) then
 356          FS := Tmp1;
 357          Status := Checksum_OK;
 358
 359       else
 360          Tmp2 := Matching_Full_Source_Name (FS, Stamp);
 361
 362          if Tmp2 = No_File then
 363             Status := Not_Same;
 364             FS     := Tmp1;
 365
 366          else
 367             Status := Not_First_On_PATH;
 368             FS := Tmp2;
 369          end if;
 370       end if;
 371    end Find_Status;
 372
 373    -----------
 374    -- Index --
 375    -----------
 376
 377    function Index (Char : Character; Str : String) return Natural is
 378    begin
 379       for Index in Str'Range loop
 380          if Str (Index) = Char then
 381             return Index;
 382          end if;
 383       end loop;
 384
 385       return 0;
 386    end Index;
 387
 388    -------------------
 389    -- Output_Object --
 390    -------------------
 391
 392    procedure Output_Object (O : File_Name_Type) is
 393       Object_Name : String_Access;
 394    begin
 395       if Print_Object then
 396          Get_Name_String (O);
 397          Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 398          Write_Str (Object_Name.all);
 399          if Print_Source or else Print_Unit then
 400             if Too_Long then
 401                Write_Eol;
 402                Write_Str ("   ");
 403             else
 404                Write_Str (Spaces
 405                 (Object_Start + Object_Name'Length .. Object_End));
 406             end if;
 407          end if;
 408       end if;
 409    end Output_Object;
 410
 411    -------------------
 412    -- Output_Source --
 413    -------------------
 414
 415    procedure Output_Source (Sdep_I : Sdep_Id) is
 416       Stamp       : constant Time_Stamp_Type := Sdep.Table (Sdep_I).Stamp;
 417       Checksum    : constant Word            := Sdep.Table (Sdep_I).Checksum;
 418       FS          : File_Name_Type           := Sdep.Table (Sdep_I).Sfile;
 419       Status      : File_Status;
 420       Object_Name : String_Access;
 421
 422    begin
 423       if Print_Source then
 424          Find_Status (FS, Stamp, Checksum, Status);
 425          Get_Name_String (FS);
 426
 427          Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len));
 428
 429          if Verbose_Mode then
 430             Write_Str ("  Source => ");
 431             Write_Str (Object_Name.all);
 432
 433             if not Too_Long then
 434                Write_Str
 435                  (Spaces (Source_Start + Object_Name'Length .. Source_End));
 436             end if;
 437
 438             Output_Status (Status, Verbose => True);
 439             Write_Eol;
 440             Write_Str ("   ");
 441
 442          else
 443             if not Selective_Output then
 444                Output_Status (Status, Verbose => False);
 445             end if;
 446
 447             Write_Str (Object_Name.all);
 448          end if;
 449       end if;
 450    end Output_Source;
 451
 452    -------------------
 453    -- Output_Status --
 454    -------------------
 455
 456    procedure Output_Status (FS : File_Status; Verbose : Boolean) is
 457    begin
 458       if Verbose then
 459          case FS is
 460             when OK =>
 461                Write_Str (" unchanged");
 462
 463             when Checksum_OK =>
 464                Write_Str (" slightly modified");
 465
 466             when Not_Found =>
 467                Write_Str (" file not found");
 468
 469             when Not_Same =>
 470                Write_Str (" modified");
 471
 472             when Not_First_On_PATH =>
 473                Write_Str (" unchanged version not first on PATH");
 474          end case;
 475
 476       else
 477          case FS is
 478             when OK =>
 479                Write_Str ("  OK ");
 480
 481             when Checksum_OK =>
 482                Write_Str (" MOK ");
 483
 484             when Not_Found =>
 485                Write_Str (" ??? ");
 486
 487             when Not_Same =>
 488                Write_Str (" DIF ");
 489
 490             when Not_First_On_PATH =>
 491                Write_Str (" HID ");
 492          end case;
 493       end if;
 494    end Output_Status;
 495
 496    -----------------
 497    -- Output_Unit --
 498    -----------------
 499
 500    procedure Output_Unit (U_Id : Unit_Id) is
 501       Kind : Character;
 502       U    : Unit_Record renames Units.Table (U_Id);
 503
 504    begin
 505       if Print_Unit then
 506          Get_Name_String (U.Uname);
 507          Kind := Name_Buffer (Name_Len);
 508          Name_Len := Name_Len - 2;
 509
 510          if not Verbose_Mode then
 511             Write_Str (Name_Buffer (1 .. Name_Len));
 512
 513          else
 514             Write_Str ("Unit => ");
 515             Write_Eol; Write_Str ("     Name   => ");
 516             Write_Str (Name_Buffer (1 .. Name_Len));
 517             Write_Eol; Write_Str ("     Kind   => ");
 518
 519             if Units.Table (U_Id).Unit_Kind = 'p' then
 520                Write_Str ("package ");
 521             else
 522                Write_Str ("subprogram ");
 523             end if;
 524
 525             if Kind = 's' then
 526                Write_Str ("spec");
 527             else
 528                Write_Str ("body");
 529             end if;
 530          end if;
 531
 532          if Verbose_Mode then
 533             if U.Preelab        or
 534                U.No_Elab        or
 535                U.Pure           or
 536                U.Elaborate_Body or
 537                U.Remote_Types   or
 538                U.Shared_Passive or
 539                U.RCI            or
 540                U.Predefined
 541             then
 542                Write_Eol; Write_Str ("     Flags  =>");
 543
 544                if U.Preelab then
 545                   Write_Str (" Preelaborable");
 546                end if;
 547
 548                if U.No_Elab then
 549                   Write_Str (" No_Elab_Code");
 550                end if;
 551
 552                if U.Pure then
 553                   Write_Str (" Pure");
 554                end if;
 555
 556                if U.Elaborate_Body then
 557                   Write_Str (" Elaborate Body");
 558                end if;
 559
 560                if U.Remote_Types then
 561                   Write_Str (" Remote_Types");
 562                end if;
 563
 564                if U.Shared_Passive then
 565                   Write_Str (" Shared_Passive");
 566                end if;
 567
 568                if U.Predefined then
 569                   Write_Str (" Predefined");
 570                end if;
 571
 572                if U.RCI then
 573                   Write_Str (" Remote_Call_Interface");
 574                end if;
 575             end if;
 576          end if;
 577
 578          if Print_Source then
 579             if Too_Long then
 580                Write_Eol; Write_Str ("   ");
 581             else
 582                Write_Str (Spaces (Unit_Start + Name_Len + 1 .. Unit_End));
 583             end if;
 584          end if;
 585       end if;
 586    end Output_Unit;
 587
 588    -----------------
 589    -- Reset_Print --
 590    -----------------
 591
 592    procedure Reset_Print is
 593    begin
 594       if not Selective_Output then
 595          Selective_Output := True;
 596          Print_Source := False;
 597          Print_Object := False;
 598          Print_Unit   := False;
 599       end if;
 600    end Reset_Print;
 601
 602    -------------------
 603    -- Scan_Ls_Arg --
 604    -------------------
 605
 606    procedure Scan_Ls_Arg (Argv : String; And_Save : Boolean) is
 607    begin
 608       pragma Assert (Argv'First = 1);
 609
 610       if Argv'Length = 0 then
 611          return;
 612       end if;
 613
 614       if Argv (1) = Switch_Character or else Argv (1) = '-' then
 615
 616          if Argv'Length = 1 then
 617             Fail ("switch character cannot be followed by a blank");
 618
 619          --  -I-
 620
 621          elsif Argv (2 .. Argv'Last) = "I-" then
 622             Opt.Look_In_Primary_Dir := False;
 623
 624          --  Forbid  -?-  or  -??-  where ? is any character
 625
 626          elsif (Argv'Length = 3 and then Argv (3) = '-')
 627            or else (Argv'Length = 4 and then Argv (4) = '-')
 628          then
 629             Fail ("Trailing ""-"" at the end of ", Argv, " forbidden.");
 630
 631          --  -Idir
 632
 633          elsif Argv (2) = 'I' then
 634             Add_Source_Dir (Argv (3 .. Argv'Last), And_Save);
 635             Add_Lib_Dir (Argv (3 .. Argv'Last), And_Save);
 636
 637          --  -aIdir (to gcc this is like a -I switch)
 638
 639          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
 640             Add_Source_Dir (Argv (4 .. Argv'Last), And_Save);
 641
 642          --  -aOdir
 643
 644          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
 645             Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
 646
 647          --  -aLdir (to gnatbind this is like a -aO switch)
 648
 649          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
 650             Add_Lib_Dir (Argv (4 .. Argv'Last), And_Save);
 651
 652          --  -vPx
 653
 654          elsif Argv'Length = 4 and then Argv (2 .. 3) = "vP" then
 655             case Argv (4) is
 656                when '0' =>
 657                   Current_Verbosity := Prj.Default;
 658                when '1' =>
 659                   Current_Verbosity := Prj.Medium;
 660                when '2' =>
 661                   Current_Verbosity := Prj.High;
 662                when others =>
 663                   null;
 664             end case;
 665
 666          --  -Pproject_file
 667
 668          elsif Argv'Length >= 3 and then Argv (2) = 'P' then
 669             if Project_File /= null then
 670                Fail (Argv & ": second project file forbidden (first is """ &
 671                      Project_File.all & """)");
 672             else
 673                Project_File := new String'(Argv (3 .. Argv'Last));
 674             end if;
 675
 676          --  -Xexternal=value
 677
 678          elsif Argv'Length >= 5 and then Argv (2) = 'X' then
 679             declare
 680                Equal_Pos : constant Natural :=
 681                  Index ('=', Argv (3 .. Argv'Last));
 682             begin
 683                if Equal_Pos >= 4 and then
 684                   Equal_Pos /= Argv'Last then
 685                   Add (External_Name => Argv (3 .. Equal_Pos - 1),
 686                        Value => Argv (Equal_Pos + 1 .. Argv'Last));
 687                else
 688                   Fail (Argv & " is not a valid external assignment.");
 689                end if;
 690             end;
 691
 692          elsif Argv (2 .. Argv'Last) = "nostdinc" then
 693             Opt.No_Stdinc := True;
 694
 695          elsif Argv'Length = 2 then
 696             case Argv (2) is
 697                when 'a' => Also_Predef := True;
 698                when 'h' => Print_Usage := True;
 699                when 'u' => Reset_Print; Print_Unit   := True;
 700                when 's' => Reset_Print; Print_Source := True;
 701                when 'o' => Reset_Print; Print_Object := True;
 702                when 'v' => Verbose_Mode := True;
 703                when 'd' => Dependable   := True;
 704                when others => null;
 705             end case;
 706          end if;
 707
 708       --  If not a switch it must be a file name
 709
 710       else
 711          Set_Main_File_Name (Argv);
 712       end if;
 713    end Scan_Ls_Arg;
 714
 715    -----------
 716    -- Usage --
 717    -----------
 718
 719    procedure Usage is
 720       procedure Write_Switch_Char;
 721       --  Write two spaces followed by appropriate switch character
 722
 723       procedure Write_Switch_Char is
 724       begin
 725          Write_Str ("  ");
 726          Write_Char (Switch_Character);
 727       end Write_Switch_Char;
 728
 729    --  Start of processing for Usage
 730
 731    begin
 732       --  Usage line
 733
 734       Write_Str ("Usage: ");
 735       Osint.Write_Program_Name;
 736       Write_Str ("  switches  [list of object files]");
 737       Write_Eol;
 738       Write_Eol;
 739
 740       --  GNATLS switches
 741
 742       Write_Str ("switches:");
 743       Write_Eol;
 744
 745       --  Line for -a
 746
 747       Write_Switch_Char;
 748       Write_Str ("a        also output relevant predefined units");
 749       Write_Eol;
 750
 751       --  Line for -u
 752
 753       Write_Switch_Char;
 754       Write_Str ("u        output only relevant unit names");
 755       Write_Eol;
 756
 757       --  Line for -h
 758
 759       Write_Switch_Char;
 760       Write_Str ("h        output this help message");
 761       Write_Eol;
 762
 763       --  Line for -s
 764
 765       Write_Switch_Char;
 766       Write_Str ("s        output only relevant source names");
 767       Write_Eol;
 768
 769       --  Line for -o
 770
 771       Write_Switch_Char;
 772       Write_Str ("o        output only relevant object names");
 773       Write_Eol;
 774
 775       --  Line for -d
 776
 777       Write_Switch_Char;
 778       Write_Str ("d        output sources on which specified units depend");
 779       Write_Eol;
 780
 781       --  Line for -v
 782
 783       Write_Switch_Char;
 784       Write_Str ("v        verbose output, full path and unit information");
 785       Write_Eol;
 786       Write_Eol;
 787
 788       --  Line for -aI switch
 789
 790       Write_Switch_Char;
 791       Write_Str ("aIdir    specify source files search path");
 792       Write_Eol;
 793
 794       --  Line for -aO switch
 795
 796       Write_Switch_Char;
 797       Write_Str ("aOdir    specify object files search path");
 798       Write_Eol;
 799
 800       --  Line for -I switch
 801
 802       Write_Switch_Char;
 803       Write_Str ("Idir     like -aIdir -aOdir");
 804       Write_Eol;
 805
 806       --  Line for -I- switch
 807
 808       Write_Switch_Char;
 809       Write_Str ("I-       do not look for sources & object files");
 810       Write_Str (" in the default directory");
 811       Write_Eol;
 812
 813       --  Line for -vPx
 814
 815       Write_Switch_Char;
 816       Write_Str ("vPx      verbosity for project file (0, 1 or 2)");
 817       Write_Eol;
 818
 819       --  Line for -Pproject_file
 820
 821       Write_Switch_Char;
 822       Write_Str ("Pprj     use a project file prj");
 823       Write_Eol;
 824
 825       --  Line for -Xexternal=value
 826
 827       Write_Switch_Char;
 828       Write_Str ("Xext=val specify an external value.");
 829       Write_Eol;
 830
 831       --  Line for -nostdinc
 832
 833       Write_Switch_Char;
 834       Write_Str ("nostdinc do not look for source files");
 835       Write_Str (" in the system default directory");
 836       Write_Eol;
 837
 838       --  File Status explanation
 839
 840       Write_Eol;
 841       Write_Str (" file status can be:");
 842       Write_Eol;
 843
 844       for ST in File_Status loop
 845          Write_Str ("   ");
 846          Output_Status (ST, Verbose => False);
 847          Write_Str (" ==> ");
 848          Output_Status (ST, Verbose => True);
 849          Write_Eol;
 850       end loop;
 851
 852    end Usage;
 853
 854    --   Start of processing for Gnatls
 855
 856 begin
 857    Osint.Initialize (Binder);
 858
 859    Namet.Initialize;
 860    Csets.Initialize;
 861
 862    Snames.Initialize;
 863
 864    Prj.Initialize;
 865
 866    --  Use low level argument routines to avoid dragging in the secondary stack
 867
 868    Next_Arg := 1;
 869
 870    Scan_Args : while Next_Arg < Arg_Count loop
 871       declare
 872          Next_Argv : String (1 .. Len_Arg (Next_Arg));
 873
 874       begin
 875          Fill_Arg (Next_Argv'Address, Next_Arg);
 876          Scan_Ls_Arg (Next_Argv, And_Save => True);
 877       end;
 878
 879       Next_Arg := Next_Arg + 1;
 880    end loop Scan_Args;
 881
 882    --  If a switch -P is used, parse the project file
 883
 884    if Project_File /= null then
 885
 886       Prj.Pars.Set_Verbosity (To => Current_Verbosity);
 887
 888       Prj.Pars.Parse
 889         (Project           => Project,
 890          Project_File_Name => Project_File.all);
 891
 892       if Project = Prj.No_Project then
 893          Fail ("""" & Project_File.all & """ processing failed");
 894       end if;
 895
 896       --  Add the source directories and the object directories
 897       --  to the searched directories.
 898
 899       declare
 900          procedure Register_Source_Dirs is new
 901            Prj.Env.For_All_Source_Dirs (Add_Src_Search_Dir);
 902
 903          procedure Register_Object_Dirs is new
 904            Prj.Env.For_All_Object_Dirs (Add_Lib_Search_Dir);
 905
 906       begin
 907          Register_Source_Dirs (Project);
 908          Register_Object_Dirs (Project);
 909       end;
 910
 911       --  Check if a package gnatls is in the project file and if there is
 912       --  there is one, get the switches, if any, and scan them.
 913
 914       declare
 915          Data       : Prj.Project_Data := Prj.Projects.Table (Project);
 916          Pkg        : Prj.Package_Id :=
 917                         Prj.Util.Value_Of
 918                           (Name        => Name_Gnatls,
 919                            In_Packages => Data.Decl.Packages);
 920          Element    : Package_Element;
 921          Switches   : Prj.Variable_Value;
 922          Current    : Prj.String_List_Id;
 923          The_String : String_Element;
 924
 925       begin
 926          if Pkg /= No_Package then
 927             Element := Packages.Table (Pkg);
 928             Switches :=
 929               Prj.Util.Value_Of
 930                 (Variable_Name => Name_Switches,
 931                  In_Variables => Element.Decl.Attributes);
 932
 933             case Switches.Kind is
 934                when Prj.Undefined =>
 935                   null;
 936
 937                when Prj.Single =>
 938                   if String_Length (Switches.Value) > 0 then
 939                      String_To_Name_Buffer (Switches.Value);
 940                      Scan_Ls_Arg
 941                        (Name_Buffer (1 .. Name_Len),
 942                         And_Save => False);
 943                   end if;
 944
 945                when Prj.List =>
 946                   Current := Switches.Values;
 947                   while Current /= Prj.Nil_String loop
 948                      The_String := String_Elements.Table (Current);
 949
 950                      if String_Length (The_String.Value) > 0 then
 951                         String_To_Name_Buffer (The_String.Value);
 952                         Scan_Ls_Arg
 953                           (Name_Buffer (1 .. Name_Len),
 954                            And_Save => False);
 955                      end if;
 956
 957                      Current := The_String.Next;
 958                   end loop;
 959             end case;
 960          end if;
 961       end;
 962    end if;
 963
 964    --  Add the source and object directories specified on the
 965    --  command line, if any, to the searched directories.
 966
 967    while First_Source_Dir /= null loop
 968       Add_Src_Search_Dir (First_Source_Dir.Value.all);
 969       First_Source_Dir := First_Source_Dir.Next;
 970    end loop;
 971
 972    while First_Lib_Dir /= null loop
 973       Add_Lib_Search_Dir (First_Lib_Dir.Value.all);
 974       First_Lib_Dir := First_Lib_Dir.Next;
 975    end loop;
 976
 977    --  Finally, add the default directories.
 978
 979    Osint.Add_Default_Search_Dirs;
 980
 981    if Verbose_Mode then
 982
 983       --  WARNING: the output of gnatls -v is used during the compilation
 984       --  and installation of GLADE to recreate sdefault.adb and locate
 985       --  the libgnat.a to use. Any change in the output of gnatls -v must
 986       --  be synchronized with the GLADE Dist/config.sdefault shell script.
 987
 988       Write_Eol;
 989       Write_Str ("GNATLS ");
 990       Write_Str (Gnat_Version_String);
 991       Write_Str (" Copyright 1997-2001 Free Software Foundation, Inc.");
 992       Write_Eol;
 993       Write_Eol;
 994       Write_Str ("Source Search Path:");
 995       Write_Eol;
 996
 997       for J in 1 .. Nb_Dir_In_Src_Search_Path loop
 998          Write_Str ("   ");
 999
1000          if Dir_In_Src_Search_Path (J)'Length = 0 then
1001             Write_Str ("<Current_Directory>");
1002          else
1003             Write_Str (To_Host_Dir_Spec
1004               (Dir_In_Src_Search_Path (J).all, True).all);
1005          end if;
1006
1007          Write_Eol;
1008       end loop;
1009
1010       Write_Eol;
1011       Write_Eol;
1012       Write_Str ("Object Search Path:");
1013       Write_Eol;
1014
1015       for J in 1 .. Nb_Dir_In_Obj_Search_Path loop
1016          Write_Str ("   ");
1017
1018          if Dir_In_Obj_Search_Path (J)'Length = 0 then
1019             Write_Str ("<Current_Directory>");
1020          else
1021             Write_Str (To_Host_Dir_Spec
1022               (Dir_In_Obj_Search_Path (J).all, True).all);
1023          end if;
1024
1025          Write_Eol;
1026       end loop;
1027
1028       Write_Eol;
1029    end if;
1030
1031    --  Output usage information when requested
1032
1033    if Print_Usage then
1034       Usage;
1035    end if;
1036
1037    if not More_Lib_Files then
1038       if not Print_Usage and then not Verbose_Mode then
1039          Usage;
1040       end if;
1041
1042       Exit_Program (E_Fatal);
1043    end if;
1044
1045    Initialize_ALI;
1046    Initialize_ALI_Source;
1047
1048    --  Print out all library for which no ALI files can be located
1049
1050    while More_Lib_Files loop
1051       Main_File := Next_Main_Lib_File;
1052       Ali_File := Full_Lib_File_Name (Lib_File_Name (Main_File));
1053
1054       if Ali_File = No_File then
1055          Write_Str ("Can't find library info for ");
1056          Get_Decoded_Name_String (Main_File);
1057          Write_Char ('"');
1058          Write_Str (Name_Buffer (1 .. Name_Len));
1059          Write_Char ('"');
1060          Write_Eol;
1061
1062       else
1063          Ali_File := Strip_Directory (Ali_File);
1064
1065          if Get_Name_Table_Info (Ali_File) = 0 then
1066             Text := Read_Library_Info (Ali_File, True);
1067             Id :=
1068               Scan_ALI
1069                 (Ali_File, Text, Ignore_ED => False, Err => False);
1070             Free (Text);
1071          end if;
1072       end if;
1073    end loop;
1074
1075    Find_General_Layout;
1076    for Id in ALIs.First .. ALIs.Last loop
1077       declare
1078          Last_U : Unit_Id;
1079
1080       begin
1081          Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
1082
1083          if Also_Predef or else not Is_Internal_Unit then
1084             Output_Object (ALIs.Table (Id).Ofile_Full_Name);
1085
1086             --  In verbose mode print all main units in the ALI file, otherwise
1087             --  just print the first one to ease columnwise printout
1088
1089             if Verbose_Mode then
1090                Last_U := ALIs.Table (Id).Last_Unit;
1091             else
1092                Last_U := ALIs.Table (Id).First_Unit;
1093             end if;
1094
1095             for U in ALIs.Table (Id).First_Unit .. Last_U loop
1096                if U /= ALIs.Table (Id).First_Unit
1097                  and then Selective_Output
1098                  and then Print_Unit
1099                then
1100                   Write_Eol;
1101                end if;
1102
1103                Output_Unit (U);
1104
1105                --  Output source now, unless if it will be done as part of
1106                --  outputing dependancies.
1107
1108                if not (Dependable and then Print_Source) then
1109                   Output_Source (Corresponding_Sdep_Entry (Id, U));
1110                end if;
1111             end loop;
1112
1113             --  Print out list of dependable units
1114
1115             if Dependable and then Print_Source then
1116                if Verbose_Mode then
1117                   Write_Str ("depends upon");
1118                   Write_Eol;
1119                   Write_Str ("   ");
1120
1121                else
1122                   Write_Eol;
1123                end if;
1124
1125                for D in
1126                  ALIs.Table (Id).First_Sdep .. ALIs.Table (Id).Last_Sdep
1127                loop
1128                   if Also_Predef
1129                     or else not Is_Internal_File_Name (Sdep.Table (D).Sfile)
1130                   then
1131                      if Verbose_Mode then
1132                         Write_Str ("   ");
1133                         Output_Source (D);
1134                      elsif Too_Long then
1135                         Write_Str ("   ");
1136                         Output_Source (D);
1137                         Write_Eol;
1138                      else
1139                         Write_Str (Spaces (1 .. Source_Start - 2));
1140                         Output_Source (D);
1141                         Write_Eol;
1142                      end if;
1143                   end if;
1144                end loop;
1145             end if;
1146
1147             Write_Eol;
1148          end if;
1149       end;
1150    end loop;
1151
1152    --  All done. Set proper exit status.
1153
1154    Namet.Finalize;
1155    Exit_Program (E_Success);
1156
1157 end Gnatls;