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