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