gcc/ada/xref_lib.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              X R E F _ L I B                             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1998-2002 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Osint;
  28 with Output;                 use Output;
  29 with Types;                  use Types;
  30 with Unchecked_Deallocation;
  31
  32 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
  33
  34 with GNAT.Command_Line; use GNAT.Command_Line;
  35 with GNAT.IO_Aux;       use GNAT.IO_Aux;
  36
  37 package body Xref_Lib is
  38
  39    Type_Position : constant := 50;
  40    --  Column for label identifying type of entity
  41
  42    ---------------------
  43    -- Local Variables --
  44    ---------------------
  45
  46    Pipe : constant Character := '|';
  47    --  First character on xref lines in the .ali file
  48
  49    EOF : constant Character := ASCII.SUB;
  50    --  Special character to signal end of file. Not required in input file,
  51    --  but should be properly treated if present. See also Read_File.
  52
  53    No_Xref_Information : exception;
  54    --  Exception raised when there is no cross-referencing information in
  55    --  the .ali files
  56
  57    subtype File_Offset is Natural;
  58
  59    procedure Read_File
  60      (FD       : File_Descriptor;
  61       Contents : out String_Access;
  62       Success  : out Boolean);
  63    --  Reads file associated with FS into the newly allocated
  64    --  string Contents. An EOF character will be added to the
  65    --  returned Contents to simplify parsing.
  66    --  [VMS] Success is true iff the number of bytes read is less than or
  67    --   equal to the file size.
  68    --  [Other] Success is true iff the number of bytes read is equal to
  69    --   the file size.
  70
  71    procedure Parse_EOL (Source : access String; Ptr : in out Positive);
  72    --  On return Source (Ptr) is the first character of the next line
  73    --  or EOF. Source.all must be terminated by EOF.
  74
  75    procedure Parse_Identifier_Info
  76      (Pattern       : Search_Pattern;
  77       File          : in out ALI_File;
  78       Local_Symbols : Boolean;
  79       Der_Info      : Boolean := False;
  80       Type_Tree     : Boolean := False;
  81       Wide_Search   : Boolean := True);
  82    --  Output the file and the line where the identifier was referenced,
  83    --  If Local_Symbols is False then only the publicly visible symbols
  84    --  will be processed
  85
  86    procedure Parse_Token
  87      (Source    : access String;
  88       Ptr       : in out Positive;
  89       Token_Ptr : out Positive);
  90    --  Skips any separators and stores the start of the token in Token_Ptr.
  91    --  Then stores the position of the next separator in Ptr.
  92    --  On return Source (Token_Ptr .. Ptr - 1) is the token.
  93    --  Separators are space and ASCII.HT.
  94    --  Parse_Token will never skip to the next line.
  95
  96    procedure Parse_Number
  97      (Source : access String;
  98       Ptr    : in out Positive;
  99       Number : out Natural);
 100    --  Skips any separators and parses Source upto the first character that
 101    --  is not a decimal digit. Returns value of parsed digits or 0 if none.
 102
 103    procedure Parse_X_Filename (File : in out ALI_File);
 104    --  Reads and processes "X..." lines in the ALI file
 105    --  and updates the File.X_File information.
 106
 107    ----------------
 108    -- Add_Entity --
 109    ----------------
 110
 111    procedure Add_Entity
 112      (Pattern : in out Search_Pattern;
 113       Entity  : String;
 114       Glob    : Boolean := False)
 115    is
 116       File_Start   : Natural;
 117       Line_Start   : Natural;
 118       Col_Start    : Natural;
 119       Line_Num     : Natural := 0;
 120       Col_Num      : Natural := 0;
 121       File_Ref     : File_Reference := Empty_File;
 122       File_Existed : Boolean;
 123       Has_Pattern  : Boolean := False;
 124
 125    begin
 126       --  Find the end of the first item in Entity (pattern or file?)
 127       --  If there is no ':', we only have a pattern
 128
 129       File_Start := Index (Entity, ":");
 130       if File_Start = 0 then
 131
 132          --  If the regular expression is invalid, just consider it as a string
 133
 134          begin
 135             Pattern.Entity := Compile (Entity, Glob, False);
 136             Pattern.Initialized := True;
 137
 138          exception
 139             when Error_In_Regexp =>
 140
 141                --  The basic idea is to insert a \ before every character
 142
 143                declare
 144                   Tmp_Regexp : String (1 .. 2 * Entity'Length);
 145                   Index      : Positive := 1;
 146
 147                begin
 148                   for J in Entity'Range loop
 149                      Tmp_Regexp (Index) := '\';
 150                      Tmp_Regexp (Index + 1) := Entity (J);
 151                      Index := Index + 2;
 152                   end loop;
 153
 154                   Pattern.Entity := Compile (Tmp_Regexp, True, False);
 155                   Pattern.Initialized := True;
 156                end;
 157          end;
 158
 159          Set_Default_Match (True);
 160          return;
 161       end if;
 162
 163       --  If there is a dot in the pattern, then it is a file name
 164
 165       if (Glob and then
 166              Index (Entity (Entity'First .. File_Start - 1), ".") /= 0)
 167                or else
 168                 (not Glob
 169                    and then Index (Entity (Entity'First .. File_Start - 1),
 170                                    "\.") /= 0)
 171       then
 172          Pattern.Entity := Compile (".*", False);
 173          Pattern.Initialized := True;
 174          File_Start     := Entity'First;
 175
 176       else
 177          --  If the regular expression is invalid,
 178          --  just consider it as a string
 179
 180          begin
 181             Pattern.Entity :=
 182               Compile (Entity (Entity'First .. File_Start - 1), Glob, False);
 183             Pattern.Initialized := True;
 184
 185          exception
 186             when Error_In_Regexp =>
 187
 188                --  The basic idea is to insert a \ before every character
 189
 190                declare
 191                   Tmp_Regexp : String (1 .. 2 * (File_Start - Entity'First));
 192                   Index      : Positive := 1;
 193
 194                begin
 195                   for J in Entity'First .. File_Start - 1 loop
 196                      Tmp_Regexp (Index) := '\';
 197                      Tmp_Regexp (Index + 1) := Entity (J);
 198                      Index := Index + 2;
 199                   end loop;
 200
 201                   Pattern.Entity := Compile (Tmp_Regexp, True, False);
 202                   Pattern.Initialized := True;
 203                end;
 204          end;
 205
 206          File_Start  := File_Start + 1;
 207          Has_Pattern := True;
 208       end if;
 209
 210       --  Parse the file name
 211
 212       Line_Start := Index (Entity (File_Start .. Entity'Last), ":");
 213
 214       --  Check if it was a disk:\directory item (for NT and OS/2)
 215
 216       if File_Start = Line_Start - 1
 217         and then Line_Start < Entity'Last
 218         and then Entity (Line_Start + 1) = '\'
 219       then
 220          Line_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":");
 221       end if;
 222
 223       if Line_Start = 0 then
 224          Line_Start := Entity'Length + 1;
 225
 226       elsif Line_Start /= Entity'Last then
 227          Col_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":");
 228
 229          if Col_Start = 0 then
 230             Col_Start := Entity'Last + 1;
 231          end if;
 232
 233          if Col_Start > Line_Start + 1 then
 234             begin
 235                Line_Num := Natural'Value
 236                  (Entity (Line_Start + 1 .. Col_Start - 1));
 237
 238             exception
 239                when Constraint_Error =>
 240                   raise Invalid_Argument;
 241             end;
 242          end if;
 243
 244          if Col_Start < Entity'Last then
 245             begin
 246                Col_Num := Natural'Value (Entity
 247                                          (Col_Start + 1 .. Entity'Last));
 248
 249             exception
 250                when Constraint_Error => raise Invalid_Argument;
 251             end;
 252          end if;
 253       end if;
 254
 255       Add_To_Xref_File (Entity (File_Start .. Line_Start - 1),
 256                 File_Existed,
 257                 File_Ref,
 258                 Visited => True);
 259       Add_Line (File_Ref, Line_Num, Col_Num);
 260       Add_To_Xref_File
 261         (ALI_File_Name (Entity (File_Start .. Line_Start - 1)),
 262          File_Existed, File_Ref,
 263          Visited => False,
 264          Emit_Warning => True);
 265    end Add_Entity;
 266
 267    -------------------
 268    -- Add_Xref_File --
 269    -------------------
 270
 271    procedure Add_Xref_File (File : String) is
 272       File_Ref     : File_Reference := Empty_File;
 273       File_Existed : Boolean;
 274       Iterator     : Expansion_Iterator;
 275
 276       procedure Add_Xref_File_Internal (File : String);
 277       --  Do the actual addition of the file
 278
 279       ----------------------------
 280       -- Add_Xref_File_Internal --
 281       ----------------------------
 282
 283       procedure Add_Xref_File_Internal (File : String) is
 284       begin
 285          --  Case where we have an ALI file, accept it even though this is
 286          --  not official usage, since the intention is obvious
 287
 288          if Tail (File, 4) = ".ali" then
 289             Add_To_Xref_File
 290               (File,
 291                File_Existed,
 292                File_Ref,
 293                Visited => False,
 294                Emit_Warning => True);
 295
 296          --  Normal non-ali file case
 297
 298          else
 299             Add_To_Xref_File
 300               (File,
 301                File_Existed,
 302                File_Ref,
 303                Visited => True);
 304
 305             Add_To_Xref_File
 306               (ALI_File_Name (File),
 307                File_Existed,
 308                File_Ref,
 309                Visited => False,
 310                Emit_Warning => True);
 311          end if;
 312       end Add_Xref_File_Internal;
 313
 314    --  Start of processing for Add_Xref_File
 315
 316    begin
 317       --  Check if we need to do the expansion
 318
 319       if Ada.Strings.Fixed.Index (File, "*") /= 0
 320         or else Ada.Strings.Fixed.Index (File, "?") /= 0
 321       then
 322          Start_Expansion (Iterator, File);
 323
 324          loop
 325             declare
 326                S : constant String := Expansion (Iterator);
 327
 328             begin
 329                exit when S'Length = 0;
 330                Add_Xref_File_Internal (S);
 331             end;
 332          end loop;
 333
 334       else
 335          Add_Xref_File_Internal (File);
 336       end if;
 337    end Add_Xref_File;
 338
 339    -----------------------
 340    -- Current_Xref_File --
 341    -----------------------
 342
 343    function Current_Xref_File (File : ALI_File) return File_Reference is
 344    begin
 345       return File.X_File;
 346    end Current_Xref_File;
 347
 348    --------------------------
 349    -- Default_Project_File --
 350    --------------------------
 351
 352    function Default_Project_File
 353      (Dir_Name : String)
 354       return     String
 355    is
 356       My_Dir  : Dir_Type;
 357       Dir_Ent : File_Name_String;
 358       Last    : Natural;
 359
 360    begin
 361       Open (My_Dir, Dir_Name);
 362
 363       loop
 364          Read (My_Dir, Dir_Ent, Last);
 365          exit when Last = 0;
 366
 367          if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then
 368
 369             --  The first project file found is the good one.
 370
 371             Close (My_Dir);
 372             return Dir_Ent (1 .. Last);
 373          end if;
 374       end loop;
 375
 376       Close (My_Dir);
 377       return String'(1 .. 0 => ' ');
 378
 379    exception
 380       when Directory_Error => return String'(1 .. 0 => ' ');
 381    end Default_Project_File;
 382
 383    ---------------
 384    -- File_Name --
 385    ---------------
 386
 387    function File_Name
 388      (File : ALI_File;
 389       Num  : Positive)
 390       return File_Reference
 391    is
 392    begin
 393       return File.Dep.Table (Num);
 394    end File_Name;
 395
 396    --------------------
 397    -- Find_ALI_Files --
 398    --------------------
 399
 400    procedure Find_ALI_Files is
 401       My_Dir       : Rec_DIR;
 402       Dir_Ent      : File_Name_String;
 403       Last         : Natural;
 404       File_Existed : Boolean;
 405       File_Ref     : File_Reference;
 406
 407       function Open_Next_Dir return Boolean;
 408       --  Tries to open the next object directory, and return False if
 409       --  the directory cannot be opened.
 410
 411       -------------------
 412       -- Open_Next_Dir --
 413       -------------------
 414
 415       function Open_Next_Dir return Boolean is
 416       begin
 417          --  Until we are able to open a new directory
 418
 419          loop
 420             declare
 421                Obj_Dir : constant String := Next_Obj_Dir;
 422
 423             begin
 424                --  If there was no more Obj_Dir line
 425
 426                if Obj_Dir'Length = 0 then
 427                   return False;
 428                end if;
 429
 430                Open (My_Dir.Dir, Obj_Dir);
 431                exit;
 432
 433             exception
 434                --  Could not open the directory
 435
 436                when Directory_Error => null;
 437             end;
 438          end loop;
 439
 440          return True;
 441       end Open_Next_Dir;
 442
 443    --  Start of processing for Find_ALI_Files
 444
 445    begin
 446       if Open_Next_Dir then
 447          loop
 448             Read (My_Dir.Dir, Dir_Ent, Last);
 449
 450             if Last = 0 then
 451                Close (My_Dir.Dir);
 452
 453                if not Open_Next_Dir then
 454                   return;
 455                end if;
 456
 457             elsif Last > 4 and then Dir_Ent (Last - 3 .. Last) = ".ali" then
 458                Add_To_Xref_File
 459                  (Dir_Ent (1 .. Last),
 460                   File_Existed,
 461                   File_Ref,
 462                   Visited => False);
 463                Set_Directory (File_Ref, Current_Obj_Dir);
 464             end if;
 465          end loop;
 466       end if;
 467    end Find_ALI_Files;
 468
 469    -------------------
 470    -- Get_Full_Type --
 471    -------------------
 472
 473    function Get_Full_Type (Abbrev : Character) return String is
 474    begin
 475       case Abbrev is
 476          when 'A' => return "array type";
 477          when 'B' => return "boolean type";
 478          when 'C' => return "class-wide type";
 479          when 'D' => return "decimal type";
 480          when 'E' => return "enumeration type";
 481          when 'F' => return "float type";
 482          when 'I' => return "integer type";
 483          when 'M' => return "modular type";
 484          when 'O' => return "fixed type";
 485          when 'P' => return "access type";
 486          when 'R' => return "record type";
 487          when 'S' => return "string type";
 488          when 'T' => return "task type";
 489          when 'W' => return "protected type";
 490
 491          when 'a' => return "array type";
 492          when 'b' => return "boolean object";
 493          when 'c' => return "class-wide object";
 494          when 'd' => return "decimal object";
 495          when 'e' => return "enumeration object";
 496          when 'f' => return "float object";
 497          when 'i' => return "integer object";
 498          when 'm' => return "modular object";
 499          when 'o' => return "fixed object";
 500          when 'p' => return "access object";
 501          when 'r' => return "record object";
 502          when 's' => return "string object";
 503          when 't' => return "task object";
 504          when 'w' => return "protected object";
 505
 506          when 'K' => return "package";
 507          when 'k' => return "generic package";
 508          when 'L' => return "statement label";
 509          when 'l' => return "loop label";
 510          when 'N' => return "named number";
 511          when 'n' => return "enumeration literal";
 512          when 'q' => return "block label";
 513          when 'U' => return "procedure";
 514          when 'u' => return "generic procedure";
 515          when 'V' => return "function";
 516          when 'v' => return "generic function";
 517          when 'X' => return "exception";
 518          when 'Y' => return "entry";
 519
 520          --  The above should be the only possibilities, but for a
 521          --  tool like this we don't want to bomb if we find something
 522          --  else, so just return ??? when we have an unknown Abbrev value
 523
 524          when others =>
 525             return "???";
 526       end case;
 527    end Get_Full_Type;
 528
 529    -----------
 530    -- Match --
 531    -----------
 532
 533    function Match
 534      (Pattern : Search_Pattern;
 535       Symbol  : String)
 536       return    Boolean
 537    is
 538    begin
 539       --  Get the entity name
 540
 541       return Match (Symbol, Pattern.Entity);
 542    end Match;
 543
 544    ----------
 545    -- Open --
 546    ----------
 547
 548    procedure Open
 549      (Name         : String;
 550       File         : out ALI_File;
 551       Dependencies : Boolean := False)
 552    is
 553       Name_0           : constant String := Name & ASCII.NUL;
 554       Num_Dependencies : Natural := 0;
 555       File_Existed     : Boolean;
 556       File_Ref         : File_Reference;
 557       FD               : File_Descriptor;
 558       Success          : Boolean := False;
 559       Ali              : String_Access renames File.Buffer;
 560       Token            : Positive;
 561       Ptr              : Positive;
 562       File_Start       : Positive;
 563       File_End         : Positive;
 564       Gnatchop_Offset  : Integer;
 565       Gnatchop_Name    : Positive;
 566
 567    begin
 568       if File.Buffer /= null then
 569          Free (File.Buffer);
 570       end if;
 571
 572       Init (File.Dep);
 573
 574       FD := Open_Read (Name_0'Address, Binary);
 575
 576       if FD = Invalid_FD then
 577          raise No_Xref_Information;
 578       end if;
 579
 580       Read_File (FD, Ali, Success);
 581       Close (FD);
 582
 583       Ptr := Ali'First;
 584
 585       --  Read all the lines possibly processing with-clauses and dependency
 586       --  information and exit on finding the first Xref line.
 587       --  A fall-through of the loop means that there is no xref information
 588       --  which is an error condition.
 589
 590       while Ali (Ptr) /= EOF loop
 591
 592          if Ali (Ptr) = 'D' then
 593             --  Found dependency information. Format looks like:
 594             --  D source-name time-stamp checksum [subunit-name] \
 595             --    [line:file-name]
 596
 597             --  Skip the D and parse the filename
 598
 599             Ptr := Ptr + 1;
 600             Parse_Token (Ali, Ptr, Token);
 601             File_Start := Token;
 602             File_End := Ptr - 1;
 603
 604             Num_Dependencies := Num_Dependencies + 1;
 605             Set_Last (File.Dep, Num_Dependencies);
 606
 607             Parse_Token (Ali, Ptr, Token); --  Skip time-stamp
 608             Parse_Token (Ali, Ptr, Token); --  Skip checksum
 609             Parse_Token (Ali, Ptr, Token); --  Read next entity on the line
 610
 611             if not (Ali (Token) in '0' .. '9') then
 612                Parse_Token (Ali, Ptr, Token); --  Was a subunit name
 613             end if;
 614
 615             --  Did we have a gnatchop-ed file with a pragma Source_Reference ?
 616             Gnatchop_Offset := 0;
 617
 618             if Ali (Token) in '0' .. '9' then
 619                Gnatchop_Name := Token;
 620                while Ali (Gnatchop_Name) /= ':' loop
 621                   Gnatchop_Name := Gnatchop_Name + 1;
 622                end loop;
 623                Gnatchop_Offset :=
 624                  2 - Natural'Value (Ali (Token .. Gnatchop_Name - 1));
 625                Token := Gnatchop_Name + 1;
 626             end if;
 627
 628             Add_To_Xref_File
 629               (Ali (File_Start .. File_End),
 630                File_Existed,
 631                File.Dep.Table (Num_Dependencies),
 632                Gnatchop_File => Ali (Token .. Ptr - 1),
 633                Gnatchop_Offset => Gnatchop_Offset);
 634
 635          elsif Dependencies and then Ali (Ptr) = 'W' then
 636             --  Found with-clause information. Format looks like:
 637             --     "W debug%s               debug.adb               debug.ali"
 638
 639             --  Skip the W and parse the .ali filename (3rd token)
 640
 641             Parse_Token (Ali, Ptr, Token);
 642             Parse_Token (Ali, Ptr, Token);
 643             Parse_Token (Ali, Ptr, Token);
 644
 645             Add_To_Xref_File
 646               (Ali (Token .. Ptr - 1),
 647                File_Existed,
 648                File_Ref,
 649                Visited => False);
 650
 651          elsif Ali (Ptr) = 'X' then
 652             --  Found a cross-referencing line - stop processing
 653
 654             File.Current_Line := Ptr;
 655             File.Xref_Line    := Ptr;
 656             return;
 657          end if;
 658
 659          Parse_EOL (Ali, Ptr);
 660       end loop;
 661
 662       raise No_Xref_Information;
 663    end Open;
 664
 665    ---------------
 666    -- Parse_EOL --
 667    ---------------
 668
 669    procedure Parse_EOL (Source : access String; Ptr : in out Positive) is
 670    begin
 671       --  Skip to end of line
 672
 673       while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF
 674         and then Source (Ptr) /= EOF
 675       loop
 676          Ptr := Ptr + 1;
 677       end loop;
 678
 679       if Source (Ptr) /= EOF then
 680          Ptr := Ptr + 1;      -- skip CR or LF
 681       end if;
 682
 683       --  Skip past CR/LF or LF/CR combination
 684
 685       if (Source (Ptr) = ASCII.CR or else Source (Ptr) = ASCII.LF)
 686          and then Source (Ptr) /= Source (Ptr - 1)
 687       then
 688          Ptr := Ptr + 1;
 689       end if;
 690    end Parse_EOL;
 691
 692    ---------------------------
 693    -- Parse_Identifier_Info --
 694    ---------------------------
 695
 696    procedure Parse_Identifier_Info
 697      (Pattern       : Search_Pattern;
 698       File          : in out ALI_File;
 699       Local_Symbols : Boolean;
 700       Der_Info      : Boolean := False;
 701       Type_Tree     : Boolean := False;
 702       Wide_Search   : Boolean := True)
 703    is
 704       Ptr      : Positive renames File.Current_Line;
 705       Ali      : String_Access renames File.Buffer;
 706
 707       E_Line   : Natural;   --  Line number of current entity
 708       E_Col    : Natural;   --  Column number of current entity
 709       E_Type   : Character; --  Type of current entity
 710       E_Name   : Positive;  --  Pointer to begin of entity name
 711       E_Global : Boolean;   --  True iff entity is global
 712
 713       R_Line   : Natural;   --  Line number of current reference
 714       R_Col    : Natural;   --  Column number of current reference
 715       R_Type   : Character; --  Type of current reference
 716
 717       Decl_Ref : Declaration_Reference;
 718       File_Ref : File_Reference := Current_Xref_File (File);
 719
 720       function Get_Symbol_Name (Eun, Line, Col : Natural) return String;
 721       --  Returns the symbol name for the entity defined at the specified
 722       --  line and column in the dependent unit number Eun. For this we need
 723       --  to parse the ali file again because the parent entity is not in
 724       --  the declaration table if it did not match the search pattern.
 725
 726       ---------------------
 727       -- Get_Symbol_Name --
 728       ---------------------
 729
 730       function Get_Symbol_Name (Eun, Line, Col : Natural) return String is
 731          Ptr    : Positive := 1;
 732          E_Eun  : Positive;   --  Unit number of current entity
 733          E_Line : Natural;    --  Line number of current entity
 734          E_Col  : Natural;    --  Column number of current entity
 735          E_Name : Positive;   --  Pointer to begin of entity name
 736          E_Type : Character;  --  Type of current entity
 737
 738          procedure Skip_Line;
 739          --  skip current line and continuation line
 740
 741          procedure Skip_Line is
 742          begin
 743             loop
 744                Parse_EOL (Ali, Ptr);
 745                exit when Ali (Ptr) /= '.';
 746             end loop;
 747          end Skip_Line;
 748
 749       --  Start of processing for Get_Symbol_Name
 750
 751       begin
 752          --  Look for the X lines corresponding to unit Eun
 753
 754          loop
 755             if Ali (Ptr) = 'X' then
 756                Ptr := Ptr + 1;
 757                Parse_Number (Ali, Ptr, E_Eun);
 758                exit when E_Eun = Eun;
 759             end if;
 760
 761             Skip_Line;
 762          end loop;
 763
 764          --  Here we are in the right Ali section, we now look for the entity
 765          --  declared at position (Line, Col).
 766
 767          loop
 768             Parse_Number (Ali, Ptr, E_Line);
 769             E_Type := Ali (Ptr);
 770             Ptr := Ptr + 1;
 771             Parse_Number (Ali, Ptr, E_Col);
 772             Ptr := Ptr + 1;
 773
 774             if Line = E_Line and then Col = E_Col then
 775                Parse_Token (Ali, Ptr, E_Name);
 776                return Ali (E_Name .. Ptr - 1);
 777             end if;
 778
 779             Skip_Line;
 780          end loop;
 781
 782          --  We were not able to find the symbol, this should not happend but
 783          --  since we don't want to stop here we return a string of three
 784          --  question marks as the symbol name.
 785
 786          return "???";
 787       end Get_Symbol_Name;
 788
 789    --  Start of processing for Parse_Identifier_Info
 790
 791    begin
 792       --  The identifier info looks like:
 793       --     "38U9*Debug 12|36r6 36r19"
 794
 795       --  Extract the line, column and entity name information
 796
 797       Parse_Number (Ali, Ptr, E_Line);
 798
 799       if Ali (Ptr) > ' ' then
 800          E_Type := Ali (Ptr);
 801          Ptr := Ptr + 1;
 802       end if;
 803
 804       Parse_Number (Ali, Ptr, E_Col);
 805
 806       E_Global := False;
 807       if Ali (Ptr) >= ' ' then
 808          E_Global := (Ali (Ptr) = '*');
 809          Ptr := Ptr + 1;
 810       end if;
 811
 812       Parse_Token (Ali, Ptr, E_Name);
 813
 814       --  Exit if the symbol does not match
 815       --  or if we have a local symbol and we do not want it
 816
 817       if (not Local_Symbols and not E_Global)
 818         or else (Pattern.Initialized
 819                   and then not Match (Pattern, Ali (E_Name .. Ptr - 1)))
 820         or else (E_Name >= Ptr)
 821       then
 822          --  Skip rest of this line and all continuation lines
 823
 824          loop
 825             Parse_EOL (Ali, Ptr);
 826             exit when Ali (Ptr) /= '.';
 827          end loop;
 828          return;
 829       end if;
 830
 831       --  Insert the declaration in the table
 832
 833       Decl_Ref := Add_Declaration
 834         (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type);
 835
 836       if Ali (Ptr) = '<'
 837         or else Ali (Ptr) = '('
 838         or else Ali (Ptr) = '{'
 839       then
 840
 841          --  Here we have a type derivation information. The format is
 842          --  <3|12I45> which means that the current entity is derived from the
 843          --  type defined in unit number 3, line 12 column 45. The pipe and
 844          --  unit number is optional. It is specified only if the parent type
 845          --  is not defined in the current unit.
 846
 847          --  We could also have something like
 848          --  16I9*I<integer>
 849          --  that indicates that I derives from the predefined type integer.
 850
 851          Ptr := Ptr + 1;
 852
 853          if Ali (Ptr) in '0' .. '9' then
 854             Parse_Derived_Info : declare
 855                P_Line   : Natural;          --  parent entity line
 856                P_Column : Natural;          --  parent entity column
 857                P_Type   : Character;        --  parent entity type
 858                P_Eun    : Positive;         --  parent entity file number
 859
 860             begin
 861                Parse_Number (Ali, Ptr, P_Line);
 862
 863                --  If we have a pipe then the first number was the unit number
 864
 865                if Ali (Ptr) = '|' then
 866                   P_Eun := P_Line;
 867                   Ptr := Ptr + 1;
 868
 869                   --  Now we have the line number
 870
 871                   Parse_Number (Ali, Ptr, P_Line);
 872
 873                else
 874                   --  We don't have a unit number specified, so we set P_Eun to
 875                   --  the current unit.
 876
 877                   for K in Dependencies_Tables.First .. Last (File.Dep) loop
 878                      P_Eun := K;
 879                      exit when File.Dep.Table (K) = File_Ref;
 880                   end loop;
 881                end if;
 882
 883                --  Then parse the type and column number
 884
 885                P_Type := Ali (Ptr);
 886                Ptr := Ptr + 1;
 887                Parse_Number (Ali, Ptr, P_Column);
 888
 889                --  Skip '>', or ')' or '>'
 890
 891                Ptr := Ptr + 1;
 892
 893                --  The derived info is needed only is the derived info mode is
 894                --  on or if we want to output the type hierarchy
 895
 896                if Der_Info or else Type_Tree then
 897                   Add_Parent
 898                     (Decl_Ref,
 899                      Get_Symbol_Name (P_Eun, P_Line, P_Column),
 900                      P_Line,
 901                      P_Column,
 902                      File.Dep.Table (P_Eun));
 903                end if;
 904
 905                if Type_Tree then
 906                   Search_Parent_Tree : declare
 907                      Pattern         : Search_Pattern;  --  Parent type pattern
 908                      File_Pos_Backup : Positive;
 909
 910                   begin
 911                      Add_Entity
 912                        (Pattern,
 913                         Get_Symbol_Name (P_Eun, P_Line, P_Column)
 914                         & ':' & Get_Gnatchop_File (File.Dep.Table (P_Eun))
 915                         & ':' & Get_Line (Get_Parent (Decl_Ref))
 916                         & ':' & Get_Column (Get_Parent (Decl_Ref)),
 917                      False);
 918
 919                      --  No default match is needed to look for the parent type
 920                      --  since we are using the fully qualified symbol name:
 921                      --  symbol:file:line:column
 922
 923                      Set_Default_Match (False);
 924
 925                      --  The parent type is defined in the same unit as the
 926                      --  derived type. So we want to revisit the unit.
 927
 928                      File_Pos_Backup   := File.Current_Line;
 929
 930                      if File.Dep.Table (P_Eun) = File_Ref then
 931
 932                         --  set file pointer at the start of the xref lines
 933
 934                         File.Current_Line := File.Xref_Line;
 935
 936                         Revisit_ALI_File : declare
 937                            File_Existed : Boolean;
 938                            File_Ref     : File_Reference;
 939
 940                         begin
 941                            Add_To_Xref_File
 942                              (ALI_File_Name
 943                               (Get_File (File.Dep.Table (P_Eun))),
 944                               File_Existed,
 945                               File_Ref,
 946                               Visited => False);
 947                            Set_Unvisited (File_Ref);
 948                         end Revisit_ALI_File;
 949                      end if;
 950
 951                      Search (Pattern,
 952                              Local_Symbols, False, False, Der_Info, Type_Tree);
 953
 954                      File.Current_Line := File_Pos_Backup;
 955                   end Search_Parent_Tree;
 956                end if;
 957             end Parse_Derived_Info;
 958
 959          else
 960             while Ali (Ptr) /= '>'
 961               and then Ali (Ptr) /= ')'
 962               and then Ali (Ptr) /= '}'
 963             loop
 964                Ptr := Ptr + 1;
 965             end loop;
 966             Ptr := Ptr + 1;
 967          end if;
 968
 969       elsif Ali (Ptr) = '=' then
 970          declare
 971             P_Line, P_Column : Natural;
 972          begin
 973             Ptr := Ptr + 1;
 974             Parse_Number (Ali, Ptr, P_Line);
 975             Ptr := Ptr + 1;
 976             Parse_Number (Ali, Ptr, P_Column);
 977          end;
 978       end if;
 979
 980       --  To find the body, we will have to parse the file too
 981
 982       if Wide_Search then
 983          declare
 984             File_Existed : Boolean;
 985             File_Ref     : File_Reference;
 986             File_Name    : constant String :=
 987                              Get_Gnatchop_File (File.X_File);
 988
 989          begin
 990             Add_To_Xref_File
 991               (ALI_File_Name (File_Name), File_Existed, File_Ref, False);
 992          end;
 993       end if;
 994
 995       --  Parse references to this entity.
 996       --  Ptr points to next reference with leading blanks
 997
 998       loop
 999          --  Process references on current line
1000
1001          while Ali (Ptr) = ' ' or Ali (Ptr) = ASCII.HT loop
1002
1003             --  For every reference read the line, type and column,
1004             --  optionally preceded by a file number and a pipe symbol.
1005
1006             Parse_Number (Ali, Ptr, R_Line);
1007
1008             if Ali (Ptr) = Pipe then
1009                Ptr := Ptr + 1;
1010                File_Ref := File_Name (File, R_Line);
1011
1012                Parse_Number (Ali, Ptr, R_Line);
1013             end if;
1014
1015             if Ali (Ptr) > ' ' then
1016                R_Type := Ali (Ptr);
1017                Ptr := Ptr + 1;
1018             end if;
1019
1020             Parse_Number (Ali, Ptr, R_Col);
1021
1022             --  Insert the reference or body in the table
1023
1024             Add_Reference (Decl_Ref, File_Ref, R_Line, R_Col, R_Type);
1025
1026             --  Skip generic information, if any
1027
1028             if Ali (Ptr) = '[' then
1029                declare
1030                   Num_Nested : Integer := 1;
1031                begin
1032                   Ptr := Ptr + 1;
1033                   while Num_Nested /= 0 loop
1034                      if Ali (Ptr) = ']' then
1035                         Num_Nested := Num_Nested - 1;
1036                      elsif Ali (Ptr) = '[' then
1037                         Num_Nested := Num_Nested + 1;
1038                      end if;
1039                      Ptr := Ptr + 1;
1040                   end loop;
1041                end;
1042             end if;
1043
1044          end loop;
1045
1046          Parse_EOL (Ali, Ptr);
1047
1048          --   Loop until new line is no continuation line
1049
1050          exit when Ali (Ptr) /= '.';
1051          Ptr := Ptr + 1;
1052       end loop;
1053    end Parse_Identifier_Info;
1054
1055    ------------------
1056    -- Parse_Number --
1057    ------------------
1058
1059    procedure Parse_Number
1060      (Source    : access String;
1061       Ptr       : in out Positive;
1062       Number    : out Natural)
1063    is
1064    begin
1065       --  Skip separators
1066
1067       while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop
1068          Ptr := Ptr + 1;
1069       end loop;
1070
1071       Number := 0;
1072       while Source (Ptr) in '0' .. '9' loop
1073          Number := 10 * Number
1074            + (Character'Pos (Source (Ptr)) - Character'Pos ('0'));
1075          Ptr := Ptr + 1;
1076       end loop;
1077    end Parse_Number;
1078
1079    -----------------
1080    -- Parse_Token --
1081    -----------------
1082
1083    procedure Parse_Token
1084      (Source    : access String;
1085       Ptr       : in out Positive;
1086       Token_Ptr : out Positive)
1087    is
1088       In_Quotes : Boolean := False;
1089
1090    begin
1091       --  Skip separators
1092
1093       while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop
1094          Ptr := Ptr + 1;
1095       end loop;
1096
1097       Token_Ptr := Ptr;
1098
1099       --  Find end-of-token
1100
1101       while (In_Quotes or else
1102                not (Source (Ptr) = ' '
1103                     or else Source (Ptr) = ASCII.HT
1104                     or else Source (Ptr) = '<'
1105                     or else Source (Ptr) = '{'
1106                     or else Source (Ptr) = '='
1107                     or else Source (Ptr) = '('))
1108         and then Source (Ptr) >= ' '
1109       loop
1110          if Source (Ptr) = '"' then
1111             In_Quotes := not In_Quotes;
1112          end if;
1113
1114          Ptr := Ptr + 1;
1115       end loop;
1116    end Parse_Token;
1117
1118    ----------------------
1119    -- Parse_X_Filename --
1120    ----------------------
1121
1122    procedure Parse_X_Filename (File : in out ALI_File) is
1123       Ali     : String_Access renames File.Buffer;
1124       Ptr     : Positive renames File.Current_Line;
1125       File_Nr : Natural;
1126
1127    begin
1128       while Ali (Ptr) = 'X' loop
1129
1130          --  The current line is the start of a new Xref file section,
1131          --  whose format looks like:
1132
1133          --     " X 1 debug.ads"
1134
1135          --  Skip the X and read the file number for the new X_File
1136
1137          Ptr := Ptr + 1;
1138          Parse_Number (Ali, Ptr, File_Nr);
1139
1140          if File_Nr > 0 then
1141             File.X_File := File.Dep.Table (File_Nr);
1142          end if;
1143
1144          Parse_EOL (Ali, Ptr);
1145       end loop;
1146
1147    end Parse_X_Filename;
1148
1149    --------------------
1150    -- Print_Gnatfind --
1151    --------------------
1152
1153    procedure Print_Gnatfind
1154      (References     : Boolean;
1155       Full_Path_Name : Boolean)
1156    is
1157       Decl : Declaration_Reference := First_Declaration;
1158       Ref1 : Reference;
1159       Ref2 : Reference;
1160
1161       procedure Print_Ref
1162         (Ref : Reference;
1163          Msg : String := "      ");
1164       --  Print a reference, according to the extended tag of the output
1165
1166       ---------------
1167       -- Print_Ref --
1168       ---------------
1169
1170       procedure Print_Ref
1171         (Ref : Reference;
1172          Msg : String := "      ")
1173       is
1174          Buffer : constant String :=
1175            Osint.To_Host_File_Spec
1176              (Get_Gnatchop_File (Ref, Full_Path_Name)).all
1177            & ":" & Get_Line (Ref)
1178            & ":" & Get_Column (Ref)
1179            & ": ";
1180          Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length;
1181
1182       begin
1183          Num_Blanks := Integer'Max (0, Num_Blanks);
1184          Write_Line
1185            (Buffer
1186             & String'(1 .. Num_Blanks => ' ')
1187             & Msg & " " & Get_Symbol (Decl));
1188          if Get_Source_Line (Ref)'Length /= 0 then
1189             Write_Line ("   " & Get_Source_Line (Ref));
1190          end if;
1191       end Print_Ref;
1192
1193    --  Start of processing for Print_Gnatfind
1194
1195    begin
1196       while Decl /= Empty_Declaration loop
1197          if Match (Decl) then
1198
1199             --  Output the declaration
1200
1201             declare
1202                Parent : constant Declaration_Reference := Get_Parent (Decl);
1203                Buffer : constant String :=
1204                  Osint.To_Host_File_Spec
1205                    (Get_Gnatchop_File (Decl, Full_Path_Name)).all
1206                  & ":" & Get_Line (Decl)
1207                  & ":" & Get_Column (Decl)
1208                  & ": ";
1209                Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length;
1210
1211             begin
1212                Num_Blanks := Integer'Max (0, Num_Blanks);
1213                Write_Line
1214                  (Buffer & String'(1 .. Num_Blanks => ' ')
1215                   & "(spec) " & Get_Symbol (Decl));
1216
1217                if Parent /= Empty_Declaration then
1218                   Write_Line
1219                     (Buffer & String'(1 .. Num_Blanks => ' ')
1220                      & "   derived from " & Get_Symbol (Parent)
1221                      & " ("
1222                      & Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)).all
1223                      & ':' & Get_Line (Parent)
1224                      & ':' & Get_Column (Parent) & ')');
1225                end if;
1226             end;
1227
1228             if Get_Source_Line (Decl)'Length /= 0 then
1229                Write_Line ("   " & Get_Source_Line (Decl));
1230             end if;
1231
1232             --  Output the body (sorted)
1233
1234             Ref1 := First_Body (Decl);
1235             while Ref1 /= Empty_Reference loop
1236                Print_Ref (Ref1, "(body)");
1237                Ref1 := Next (Ref1);
1238             end loop;
1239
1240             if References then
1241                Ref1 := First_Modif (Decl);
1242                Ref2 := First_Reference (Decl);
1243                while Ref1 /= Empty_Reference
1244                  or else Ref2 /= Empty_Reference
1245                loop
1246                   if Compare (Ref1, Ref2) = LessThan then
1247                      Print_Ref (Ref1);
1248                      Ref1 := Next (Ref1);
1249                   else
1250                      Print_Ref (Ref2);
1251                      Ref2 := Next (Ref2);
1252                   end if;
1253                end loop;
1254             end if;
1255          end if;
1256
1257          Decl := Next (Decl);
1258       end loop;
1259    end Print_Gnatfind;
1260
1261    ------------------
1262    -- Print_Unused --
1263    ------------------
1264
1265    procedure Print_Unused (Full_Path_Name : in Boolean) is
1266       Decl : Declaration_Reference := First_Declaration;
1267       Ref  : Reference;
1268
1269    begin
1270       while Decl /= Empty_Declaration loop
1271          if First_Modif (Decl) = Empty_Reference
1272            and then First_Reference (Decl) = Empty_Reference
1273          then
1274             Write_Str (Get_Symbol (Decl)
1275                       & " "
1276                       & Get_Type (Decl)
1277                       & " "
1278                       & Osint.To_Host_File_Spec
1279                          (Get_Gnatchop_File (Decl, Full_Path_Name)).all
1280                       & ':'
1281                       & Get_Line (Decl)
1282                       & ':'
1283                       & Get_Column (Decl));
1284
1285             --  Print the body if any
1286
1287             Ref := First_Body (Decl);
1288
1289             if Ref /= Empty_Reference then
1290                Write_Line (' '
1291                           & Osint.To_Host_File_Spec
1292                              (Get_Gnatchop_File (Ref, Full_Path_Name)).all
1293                           & ':' & Get_Line (Ref)
1294                           & ':' & Get_Column (Ref));
1295             else
1296                Write_Eol;
1297             end if;
1298          end if;
1299
1300          Decl := Next (Decl);
1301       end loop;
1302    end Print_Unused;
1303
1304    --------------
1305    -- Print_Vi --
1306    --------------
1307
1308    procedure Print_Vi (Full_Path_Name : in Boolean) is
1309       Tab  : constant Character := ASCII.HT;
1310       Decl : Declaration_Reference := First_Declaration;
1311       Ref  : Reference;
1312
1313    begin
1314       while Decl /= Empty_Declaration loop
1315          Write_Line (Get_Symbol (Decl) & Tab
1316                             & Get_File (Decl, Full_Path_Name) & Tab
1317                             & Get_Line (Decl));
1318
1319          --  Print the body if any
1320
1321          Ref := First_Body (Decl);
1322
1323          if Ref /= Empty_Reference then
1324             Write_Line (Get_Symbol (Decl) & Tab
1325                                & Get_File (Ref, Full_Path_Name)
1326                                & Tab
1327                                & Get_Line (Ref));
1328          end if;
1329
1330          --  Print the modifications
1331
1332          Ref := First_Modif (Decl);
1333
1334          while Ref /= Empty_Reference loop
1335             Write_Line (Get_Symbol (Decl) & Tab
1336                                & Get_File (Ref, Full_Path_Name)
1337                                & Tab
1338                                & Get_Line (Ref));
1339             Ref := Next (Ref);
1340          end loop;
1341
1342          Decl := Next (Decl);
1343       end loop;
1344    end Print_Vi;
1345
1346    ----------------
1347    -- Print_Xref --
1348    ----------------
1349
1350    procedure Print_Xref (Full_Path_Name : in Boolean) is
1351       Decl : Declaration_Reference := First_Declaration;
1352       Ref  : Reference;
1353       File : File_Reference;
1354
1355       Margin : constant := 10;
1356       --  Column where file names start
1357
1358       procedure New_Line80;
1359       --  Go to start of new line
1360
1361       procedure Print80 (S : in String);
1362       --  Print the text, respecting the 80 columns rule.
1363
1364       procedure Print_Ref (Line, Column : String);
1365       --  The beginning of the output is aligned on a column multiple of 9
1366
1367       ----------------
1368       -- New_Line80 --
1369       ----------------
1370
1371       procedure New_Line80 is
1372       begin
1373          Write_Eol;
1374          Write_Str (String'(1 .. Margin - 1 => ' '));
1375       end New_Line80;
1376
1377       -------------
1378       -- Print80 --
1379       -------------
1380
1381       procedure Print80 (S : in String) is
1382          Align : Natural := Margin - (Integer (Column) mod Margin);
1383       begin
1384          if Align = Margin then
1385             Align := 0;
1386          end if;
1387
1388          Write_Str (String'(1 .. Align => ' ') & S);
1389       end Print80;
1390
1391       ---------------
1392       -- Print_Ref --
1393       ---------------
1394
1395       procedure Print_Ref (Line, Column : String) is
1396          Line_Align : constant Integer := 4 - Line'Length;
1397
1398          S : constant String := String'(1 .. Line_Align => ' ')
1399                                   & Line & ':' & Column;
1400
1401          Align : Natural := Margin - (Integer (Output.Column) mod Margin);
1402
1403       begin
1404          if Align = Margin then
1405             Align := 0;
1406          end if;
1407
1408          if Integer (Output.Column) + Align + S'Length > 79 then
1409             New_Line80;
1410             Align := 0;
1411          end if;
1412
1413          Write_Str (String'(1 .. Align => ' ') & S);
1414       end Print_Ref;
1415
1416    --  Start of processing for Print_Xref
1417
1418    begin
1419       while Decl /= Empty_Declaration loop
1420          Write_Str (Get_Symbol (Decl));
1421
1422          while Column < Type_Position loop
1423             Write_Char (' ');
1424          end loop;
1425
1426          Write_Line (Get_Full_Type (Get_Type (Decl)));
1427
1428          Write_Parent_Info : declare
1429             Parent : constant Declaration_Reference := Get_Parent (Decl);
1430          begin
1431             if Parent /= Empty_Declaration then
1432                Write_Str ("  Ptype: ");
1433                Print80
1434                  (Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)).all);
1435                Print_Ref (Get_Line (Parent), Get_Column (Parent));
1436                Print80 ("  " & Get_Symbol (Parent));
1437                Write_Eol;
1438             end if;
1439          end Write_Parent_Info;
1440
1441          Write_Str ("  Decl:  ");
1442          Print80
1443            (Osint.To_Host_File_Spec
1444              (Get_Gnatchop_File (Decl, Full_Path_Name)).all & ' ');
1445          Print_Ref (Get_Line (Decl), Get_Column (Decl));
1446
1447          --  Print the body if any
1448
1449          Ref := First_Body (Decl);
1450
1451          if Ref /= Empty_Reference then
1452             Write_Eol;
1453             Write_Str ("  Body:  ");
1454             Print80
1455               (Osint.To_Host_File_Spec
1456                 (Get_Gnatchop_File (Ref, Full_Path_Name)).all & ' ');
1457             Print_Ref (Get_Line (Ref), Get_Column (Ref));
1458          end if;
1459
1460          --  Print the modifications if any
1461
1462          Ref := First_Modif (Decl);
1463
1464          if Ref /= Empty_Reference then
1465             Write_Eol;
1466             Write_Str ("  Modi:  ");
1467          end if;
1468
1469          File := Empty_File;
1470
1471          while Ref /= Empty_Reference loop
1472             if Get_File_Ref (Ref) /= File then
1473                if File /= Empty_File then
1474                   New_Line80;
1475                end if;
1476
1477                File := Get_File_Ref (Ref);
1478                Write_Str
1479                  (Get_Gnatchop_File (Ref, Full_Path_Name) & ' ');
1480                Print_Ref (Get_Line (Ref), Get_Column (Ref));
1481
1482             else
1483                Print_Ref (Get_Line (Ref), Get_Column (Ref));
1484             end if;
1485
1486             Ref := Next (Ref);
1487          end loop;
1488
1489          --  Print the references
1490
1491          Ref := First_Reference (Decl);
1492
1493          if Ref /= Empty_Reference then
1494             Write_Eol;
1495             Write_Str ("  Ref:   ");
1496          end if;
1497
1498          File := Empty_File;
1499
1500          while Ref /= Empty_Reference loop
1501             if Get_File_Ref (Ref) /= File then
1502                if File /= Empty_File then
1503                   New_Line80;
1504                end if;
1505
1506                File := Get_File_Ref (Ref);
1507                Write_Str
1508                  (Osint.To_Host_File_Spec
1509                    (Get_Gnatchop_File (Ref, Full_Path_Name)).all & ' ');
1510                Print_Ref (Get_Line (Ref), Get_Column (Ref));
1511
1512             else
1513                Print_Ref (Get_Line (Ref), Get_Column (Ref));
1514             end if;
1515
1516             Ref := Next (Ref);
1517          end loop;
1518
1519          Write_Eol;
1520          Decl := Next (Decl);
1521       end loop;
1522    end Print_Xref;
1523
1524    ---------------
1525    -- Read_File --
1526    ---------------
1527
1528    procedure Read_File
1529      (FD       : File_Descriptor;
1530       Contents : out String_Access;
1531       Success  : out Boolean)
1532    is
1533       Length : constant File_Offset := File_Offset (File_Length (FD));
1534       --  Include room for EOF char
1535
1536       Buffer : String (1 .. Length + 1);
1537
1538       This_Read : Integer;
1539       Read_Ptr  : File_Offset := 1;
1540
1541    begin
1542
1543       loop
1544          This_Read := Read (FD,
1545            A => Buffer (Read_Ptr)'Address,
1546            N => Length + 1 - Read_Ptr);
1547          Read_Ptr := Read_Ptr + Integer'Max (This_Read, 0);
1548          exit when This_Read <= 0;
1549       end loop;
1550
1551       Buffer (Read_Ptr) := EOF;
1552       Contents := new String'(Buffer (1 .. Read_Ptr));
1553
1554       --  Things aren't simple on VMS due to the plethora of file types
1555       --  and organizations. It seems clear that there shouldn't be more
1556       --  bytes read than are contained in the file though.
1557
1558       if Hostparm.OpenVMS then
1559          Success := Read_Ptr <= Length + 1;
1560       else
1561          Success := Read_Ptr = Length + 1;
1562       end if;
1563    end Read_File;
1564
1565    ------------
1566    -- Search --
1567    ------------
1568
1569    procedure Search
1570      (Pattern       : Search_Pattern;
1571       Local_Symbols : Boolean;
1572       Wide_Search   : Boolean;
1573       Read_Only     : Boolean;
1574       Der_Info      : Boolean;
1575       Type_Tree     : Boolean)
1576    is
1577       type String_Access is access String;
1578       procedure Free is new Unchecked_Deallocation (String, String_Access);
1579
1580       ALIfile    : ALI_File;
1581       File_Ref   : File_Reference;
1582       Strip_Num  : Natural := 0;
1583       Ali_Name   : String_Access;
1584
1585    begin
1586       --  If we want all the .ali files, then find them
1587
1588       if Wide_Search then
1589          Find_ALI_Files;
1590       end if;
1591
1592       loop
1593          --  Get the next unread ali file
1594
1595          File_Ref := Next_Unvisited_File;
1596
1597          exit when File_Ref = Empty_File;
1598
1599          --  Find the ALI file to use. Most of the time, it will be the unit
1600          --  name, with a different extension. However, when dealing with
1601          --  separates the ALI file is in fact the parent's ALI file (and this
1602          --  is recursive, in case the parent itself is a separate).
1603
1604          Strip_Num := 0;
1605          loop
1606             Free (Ali_Name);
1607             Ali_Name := new String'
1608               (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num));
1609
1610             --  Striped too many things...
1611             if Ali_Name.all = "" then
1612                if Get_Emit_Warning (File_Ref) then
1613                   Set_Standard_Error;
1614                   Write_Line
1615                     ("warning : file " & Get_File (File_Ref, With_Dir => True)
1616                      & " not found");
1617                   Set_Standard_Output;
1618                end if;
1619                Free (Ali_Name);
1620                exit;
1621
1622                --  If not found, try the parent's ALI file (this is needed for
1623                --  separate units and subprograms).
1624             elsif not File_Exists (Ali_Name.all) then
1625                Strip_Num := Strip_Num + 1;
1626
1627                --  Else we finally found it
1628             else
1629                exit;
1630             end if;
1631          end loop;
1632
1633          --  Now that we have a file name, parse it to find any reference to
1634          --  the entity.
1635
1636          if Ali_Name /= null
1637            and then (Read_Only or else Is_Writable_File (Ali_Name.all))
1638          then
1639             begin
1640                Open (Ali_Name.all, ALIfile);
1641                while ALIfile.Buffer (ALIfile.Current_Line) /= EOF loop
1642                   Parse_X_Filename (ALIfile);
1643                   Parse_Identifier_Info (Pattern, ALIfile, Local_Symbols,
1644                      Der_Info, Type_Tree, Wide_Search);
1645                end loop;
1646
1647             exception
1648                when No_Xref_Information   =>
1649                   if Get_Emit_Warning (File_Ref) then
1650                      Set_Standard_Error;
1651                      Write_Line
1652                        ("warning : No cross-referencing information in  "
1653                         & Ali_Name.all);
1654                      Set_Standard_Output;
1655                   end if;
1656             end;
1657          end if;
1658       end loop;
1659
1660       Free (Ali_Name);
1661    end Search;
1662
1663    -----------------
1664    -- Search_Xref --
1665    -----------------
1666
1667    procedure Search_Xref
1668      (Local_Symbols : Boolean;
1669       Read_Only     : Boolean;
1670       Der_Info      : Boolean)
1671    is
1672       ALIfile    : ALI_File;
1673       File_Ref   : File_Reference;
1674       Null_Pattern : Search_Pattern;
1675    begin
1676       loop
1677          --  Find the next unvisited file
1678
1679          File_Ref := Next_Unvisited_File;
1680          exit when File_Ref = Empty_File;
1681
1682          --  Search the object directories for the .ali file
1683
1684          if Read_Only
1685            or else Is_Writable_File (Get_File (File_Ref, With_Dir => True))
1686          then
1687             begin
1688                Open (Get_File (File_Ref, With_Dir => True), ALIfile, True);
1689
1690                while ALIfile.Buffer (ALIfile.Current_Line) /= EOF loop
1691                   Parse_X_Filename (ALIfile);
1692                   Parse_Identifier_Info
1693                     (Null_Pattern, ALIfile, Local_Symbols, Der_Info);
1694                end loop;
1695
1696             exception
1697                when No_Xref_Information =>  null;
1698             end;
1699          end if;
1700       end loop;
1701    end Search_Xref;
1702
1703 end Xref_Lib;