gcc/ada/lib-xref.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             L I B . X R E F                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1998-2004, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Atree;    use Atree;
  28 with Csets;    use Csets;
  29 with Elists;   use Elists;
  30 with Errout;   use Errout;
  31 with Lib.Util; use Lib.Util;
  32 with Namet;    use Namet;
  33 with Nlists;   use Nlists;
  34 with Opt;      use Opt;
  35 with Sem_Prag; use Sem_Prag;
  36 with Sinfo;    use Sinfo;
  37 with Sinput;   use Sinput;
  38 with Snames;   use Snames;
  39 with Stringt;  use Stringt;
  40 with Stand;    use Stand;
  41 with Table;    use Table;
  42 with Widechar; use Widechar;
  43
  44 with GNAT.Heap_Sort_A;
  45
  46 package body Lib.Xref is
  47
  48    ------------------
  49    -- Declarations --
  50    ------------------
  51
  52    --  The Xref table is used to record references. The Loc field is set
  53    --  to No_Location for a definition entry.
  54
  55    subtype Xref_Entry_Number is Int;
  56
  57    type Xref_Entry is record
  58       Ent : Entity_Id;
  59       --  Entity referenced (E parameter to Generate_Reference)
  60
  61       Def : Source_Ptr;
  62       --  Original source location for entity being referenced. Note that
  63       --  these values are used only during the output process, they are
  64       --  not set when the entries are originally built. This is because
  65       --  private entities can be swapped when the initial call is made.
  66
  67       Loc : Source_Ptr;
  68       --  Location of reference (Original_Location (Sloc field of N parameter
  69       --  to Generate_Reference). Set to No_Location for the case of a
  70       --  defining occurrence.
  71
  72       Typ : Character;
  73       --  Reference type (Typ param to Generate_Reference)
  74
  75       Eun : Unit_Number_Type;
  76       --  Unit number corresponding to Ent
  77
  78       Lun : Unit_Number_Type;
  79       --  Unit number corresponding to Loc. Value is undefined and not
  80       --  referenced if Loc is set to No_Location.
  81
  82    end record;
  83
  84    package Xrefs is new Table.Table (
  85      Table_Component_Type => Xref_Entry,
  86      Table_Index_Type     => Xref_Entry_Number,
  87      Table_Low_Bound      => 1,
  88      Table_Initial        => Alloc.Xrefs_Initial,
  89      Table_Increment      => Alloc.Xrefs_Increment,
  90      Table_Name           => "Xrefs");
  91
  92    -------------------------
  93    -- Generate_Definition --
  94    -------------------------
  95
  96    procedure Generate_Definition (E : Entity_Id) is
  97       Loc  : Source_Ptr;
  98       Indx : Nat;
  99
 100    begin
 101       pragma Assert (Nkind (E) in N_Entity);
 102
 103       --  Note that we do not test Xref_Entity_Letters here. It is too
 104       --  early to do so, since we are often called before the entity
 105       --  is fully constructed, so that the Ekind is still E_Void.
 106
 107       if Opt.Xref_Active
 108
 109          --  Definition must come from source
 110
 111          and then Comes_From_Source (E)
 112
 113          --  And must have a reasonable source location that is not
 114          --  within an instance (all entities in instances are ignored)
 115
 116          and then Sloc (E) > No_Location
 117          and then Instantiation_Location (Sloc (E)) = No_Location
 118
 119          --  And must be a non-internal name from the main source unit
 120
 121          and then In_Extended_Main_Source_Unit (E)
 122          and then not Is_Internal_Name (Chars (E))
 123       then
 124          Xrefs.Increment_Last;
 125          Indx := Xrefs.Last;
 126          Loc  := Original_Location (Sloc (E));
 127
 128          Xrefs.Table (Indx).Ent := E;
 129          Xrefs.Table (Indx).Loc := No_Location;
 130          Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
 131          Xrefs.Table (Indx).Lun := No_Unit;
 132          Set_Has_Xref_Entry (E);
 133       end if;
 134    end Generate_Definition;
 135
 136    ---------------------------------
 137    -- Generate_Operator_Reference --
 138    ---------------------------------
 139
 140    procedure Generate_Operator_Reference
 141      (N : Node_Id;
 142       T : Entity_Id)
 143    is
 144    begin
 145       if not In_Extended_Main_Source_Unit (N) then
 146          return;
 147       end if;
 148
 149       --  If the operator is not a Standard operator, then we generate
 150       --  a real reference to the user defined operator.
 151
 152       if Sloc (Entity (N)) /= Standard_Location then
 153          Generate_Reference (Entity (N), N);
 154
 155          --  A reference to an implicit inequality operator is a also a
 156          --  reference to the user-defined equality.
 157
 158          if Nkind (N) = N_Op_Ne
 159            and then not Comes_From_Source (Entity (N))
 160            and then Present (Corresponding_Equality (Entity (N)))
 161          then
 162             Generate_Reference (Corresponding_Equality (Entity (N)), N);
 163          end if;
 164
 165       --  For the case of Standard operators, we mark the result type
 166       --  as referenced. This ensures that in the case where we are
 167       --  using a derived operator, we mark an entity of the unit that
 168       --  implicitly defines this operator as used. Otherwise we may
 169       --  think that no entity of the unit is used. The actual entity
 170       --  marked as referenced is the first subtype, which is the user
 171       --  defined entity that is relevant.
 172
 173       --  Note: we only do this for operators that come from source.
 174       --  The generated code sometimes reaches for entities that do
 175       --  not need to be explicitly visible (for example, when we
 176       --  expand the code for comparing two record types, the fields
 177       --  of the record may not be visible).
 178
 179       elsif Comes_From_Source (N) then
 180          Set_Referenced (First_Subtype (T));
 181       end if;
 182    end Generate_Operator_Reference;
 183
 184    ------------------------
 185    -- Generate_Reference --
 186    ------------------------
 187
 188    procedure Generate_Reference
 189      (E       : Entity_Id;
 190       N       : Node_Id;
 191       Typ     : Character := 'r';
 192       Set_Ref : Boolean   := True;
 193       Force   : Boolean   := False)
 194    is
 195       Indx : Nat;
 196       Nod  : Node_Id;
 197       Ref  : Source_Ptr;
 198       Def  : Source_Ptr;
 199       Ent  : Entity_Id;
 200
 201    begin
 202       pragma Assert (Nkind (E) in N_Entity);
 203
 204       --  Never collect references if not in main source unit. However,
 205       --  we omit this test if Typ is 'e' or 'k', since these entries are
 206       --  really structural, and it is useful to have them in units
 207       --  that reference packages as well as units that define packages.
 208       --  We also omit the test for the case of 'p' since we want to
 209       --  include inherited primitive operations from other packages.
 210
 211       if not In_Extended_Main_Source_Unit (N)
 212         and then Typ /= 'e'
 213         and then Typ /= 'p'
 214         and then Typ /= 'k'
 215       then
 216          return;
 217       end if;
 218
 219       --  For reference type p, the entity must be in main source unit
 220
 221       if Typ = 'p' and then not In_Extended_Main_Source_Unit (E) then
 222          return;
 223       end if;
 224
 225       --  Unless the reference is forced, we ignore references where
 226       --  the reference itself does not come from Source.
 227
 228       if not Force and then not Comes_From_Source (N) then
 229          return;
 230       end if;
 231
 232       --  Deal with setting entity as referenced, unless suppressed.
 233       --  Note that we still do Set_Referenced on entities that do not
 234       --  come from source. This situation arises when we have a source
 235       --  reference to a derived operation, where the derived operation
 236       --  itself does not come from source, but we still want to mark it
 237       --  as referenced, since we really are referencing an entity in the
 238       --  corresponding package (this avoids incorrect complaints that the
 239       --  package contains no referenced entities).
 240
 241       if Set_Ref then
 242
 243          --  For a variable that appears on the left side of an
 244          --  assignment statement, we set the Referenced_As_LHS
 245          --  flag since this is indeed a left hand side.
 246
 247          if Ekind (E) = E_Variable
 248            and then Nkind (Parent (N)) = N_Assignment_Statement
 249            and then Name (Parent (N)) = N
 250            and then No (Renamed_Object (E))
 251          then
 252             Set_Referenced_As_LHS (E);
 253
 254          --  Check for a reference in a pragma that should not count as a
 255          --  making the variable referenced for warning purposes.
 256
 257          elsif Is_Non_Significant_Pragma_Reference (N) then
 258             null;
 259
 260          --  A reference in an attribute definition clause does not
 261          --  count as a reference except for the case of Address.
 262          --  The reason that 'Address is an exception is that it
 263          --  creates an alias through which the variable may be
 264          --  referenced.
 265
 266          elsif Nkind (Parent (N)) = N_Attribute_Definition_Clause
 267            and then Chars (Parent (N)) /= Name_Address
 268            and then N = Name (Parent (N))
 269          then
 270             null;
 271
 272          --  Constant completion does not count as a reference
 273
 274          elsif Typ = 'c'
 275            and then Ekind (E) = E_Constant
 276          then
 277             null;
 278
 279          --  Record representation clause does not count as a reference
 280
 281          elsif Nkind (N) = N_Identifier
 282            and then Nkind (Parent (N)) = N_Record_Representation_Clause
 283          then
 284             null;
 285
 286          --  Discriminants do not need to produce a reference to record type
 287
 288          elsif Typ = 'd'
 289            and then Nkind (Parent (N)) = N_Discriminant_Specification
 290          then
 291             null;
 292
 293          --  Any other occurrence counts as referencing the entity
 294
 295          else
 296             Set_Referenced (E);
 297          end if;
 298
 299          --  Check for pragma Unreferenced given and reference is within
 300          --  this source unit (occasion for possible warning to be issued)
 301
 302          if Has_Pragma_Unreferenced (E)
 303            and then In_Same_Extended_Unit (Sloc (E), Sloc (N))
 304          then
 305             --  A reference as a named parameter in a call does not count
 306             --  as a violation of pragma Unreferenced for this purpose.
 307
 308             if Nkind (N) = N_Identifier
 309               and then Nkind (Parent (N)) = N_Parameter_Association
 310               and then Selector_Name (Parent (N)) = N
 311             then
 312                null;
 313
 314             --  Neither does a reference to a variable on the left side
 315             --  of an assignment
 316
 317             elsif Ekind (E) = E_Variable
 318               and then Nkind (Parent (N)) = N_Assignment_Statement
 319               and then Name (Parent (N)) = N
 320             then
 321                null;
 322
 323             --  Here we issue the warning, since this is a real reference
 324
 325             else
 326                Error_Msg_NE ("?pragma Unreferenced given for&", N, E);
 327             end if;
 328          end if;
 329
 330          --  If this is a subprogram instance, mark as well the internal
 331          --  subprogram in the wrapper package, which may be a visible
 332          --  compilation unit.
 333
 334          if Is_Overloadable (E)
 335            and then Is_Generic_Instance (E)
 336            and then Present (Alias (E))
 337          then
 338             Set_Referenced (Alias (E));
 339          end if;
 340       end if;
 341
 342       --  Generate reference if all conditions are met:
 343
 344       if
 345          --  Cross referencing must be active
 346
 347          Opt.Xref_Active
 348
 349          --  The entity must be one for which we collect references
 350
 351          and then Xref_Entity_Letters (Ekind (E)) /= ' '
 352
 353          --  Both Sloc values must be set to something sensible
 354
 355          and then Sloc (E) > No_Location
 356          and then Sloc (N) > No_Location
 357
 358          --  We ignore references from within an instance
 359
 360          and then Instantiation_Location (Sloc (N)) = No_Location
 361
 362          --  Ignore dummy references
 363
 364         and then Typ /= ' '
 365       then
 366          if Nkind (N) = N_Identifier
 367               or else
 368             Nkind (N) = N_Defining_Identifier
 369               or else
 370             Nkind (N) in N_Op
 371               or else
 372             Nkind (N) = N_Defining_Operator_Symbol
 373               or else
 374             Nkind (N) = N_Operator_Symbol
 375               or else
 376             (Nkind (N) = N_Character_Literal
 377               and then Sloc (Entity (N)) /= Standard_Location)
 378               or else
 379             Nkind (N) = N_Defining_Character_Literal
 380          then
 381             Nod := N;
 382
 383          elsif Nkind (N) = N_Expanded_Name
 384                  or else
 385                Nkind (N) = N_Selected_Component
 386          then
 387             Nod := Selector_Name (N);
 388
 389          else
 390             return;
 391          end if;
 392
 393          --  Normal case of source entity comes from source
 394
 395          if Comes_From_Source (E) then
 396             Ent := E;
 397
 398          --  Entity does not come from source, but is a derived subprogram
 399          --  and the derived subprogram comes from source (after one or more
 400          --  derivations) in which case the reference is to parent subprogram.
 401
 402          elsif Is_Overloadable (E)
 403            and then Present (Alias (E))
 404          then
 405             Ent := Alias (E);
 406
 407             loop
 408                if Comes_From_Source (Ent) then
 409                   exit;
 410                elsif No (Alias (Ent)) then
 411                   return;
 412                else
 413                   Ent := Alias (Ent);
 414                end if;
 415             end loop;
 416
 417          --  Record components of discriminated subtypes or derived types
 418          --  must be treated as references to the original component.
 419
 420          elsif Ekind (E) = E_Component
 421            and then Comes_From_Source (Original_Record_Component (E))
 422          then
 423             Ent := Original_Record_Component (E);
 424
 425          --  Ignore reference to any other entity that is not from source
 426
 427          else
 428             return;
 429          end if;
 430
 431          --  Record reference to entity
 432
 433          Ref := Original_Location (Sloc (Nod));
 434          Def := Original_Location (Sloc (Ent));
 435
 436          Xrefs.Increment_Last;
 437          Indx := Xrefs.Last;
 438
 439          Xrefs.Table (Indx).Loc := Ref;
 440
 441          --  Overriding operations are marked with 'P'.
 442
 443          if Typ = 'p'
 444            and then Is_Subprogram (N)
 445            and then Is_Overriding_Operation (N)
 446          then
 447             Xrefs.Table (Indx).Typ := 'P';
 448          else
 449             Xrefs.Table (Indx).Typ := Typ;
 450          end if;
 451
 452          Xrefs.Table (Indx).Eun := Get_Source_Unit (Def);
 453          Xrefs.Table (Indx).Lun := Get_Source_Unit (Ref);
 454          Xrefs.Table (Indx).Ent := Ent;
 455          Set_Has_Xref_Entry (Ent);
 456       end if;
 457    end Generate_Reference;
 458
 459    -----------------------------------
 460    -- Generate_Reference_To_Formals --
 461    -----------------------------------
 462
 463    procedure Generate_Reference_To_Formals (E : Entity_Id) is
 464       Formal : Entity_Id;
 465
 466    begin
 467       if Is_Generic_Subprogram (E) then
 468          Formal := First_Entity (E);
 469
 470          while Present (Formal)
 471            and then not Is_Formal (Formal)
 472          loop
 473             Next_Entity (Formal);
 474          end loop;
 475
 476       else
 477          Formal := First_Formal (E);
 478       end if;
 479
 480       while Present (Formal) loop
 481          if Ekind (Formal) = E_In_Parameter then
 482
 483             if Nkind (Parameter_Type (Parent (Formal)))
 484               = N_Access_Definition
 485             then
 486                Generate_Reference (E, Formal, '^', False);
 487             else
 488                Generate_Reference (E, Formal, '>', False);
 489             end if;
 490
 491          elsif Ekind (Formal) = E_In_Out_Parameter then
 492             Generate_Reference (E, Formal, '=', False);
 493
 494          else
 495             Generate_Reference (E, Formal, '<', False);
 496          end if;
 497
 498          Next_Formal (Formal);
 499       end loop;
 500    end Generate_Reference_To_Formals;
 501
 502    -------------------------------------------
 503    -- Generate_Reference_To_Generic_Formals --
 504    -------------------------------------------
 505
 506    procedure Generate_Reference_To_Generic_Formals (E : Entity_Id) is
 507       Formal : Entity_Id;
 508
 509    begin
 510       Formal := First_Entity (E);
 511
 512       while Present (Formal) loop
 513          if Comes_From_Source (Formal) then
 514             Generate_Reference (E, Formal, 'z', False);
 515          end if;
 516
 517          Next_Entity (Formal);
 518       end loop;
 519    end Generate_Reference_To_Generic_Formals;
 520
 521    ----------------
 522    -- Initialize --
 523    ----------------
 524
 525    procedure Initialize is
 526    begin
 527       Xrefs.Init;
 528    end Initialize;
 529
 530    -----------------------
 531    -- Output_References --
 532    -----------------------
 533
 534    procedure Output_References is
 535
 536       procedure Get_Type_Reference
 537         (Ent   : Entity_Id;
 538          Tref  : out Entity_Id;
 539          Left  : out Character;
 540          Right : out Character);
 541       --  Given an entity id Ent, determines whether a type reference is
 542       --  required. If so, Tref is set to the entity for the type reference
 543       --  and Left and Right are set to the left/right brackets to be
 544       --  output for the reference. If no type reference is required, then
 545       --  Tref is set to Empty, and Left/Right are set to space.
 546
 547       procedure Output_Import_Export_Info (Ent : Entity_Id);
 548       --  Ouput language and external name information for an interfaced
 549       --  entity, using the format <language, external_name>,
 550
 551       ------------------------
 552       -- Get_Type_Reference --
 553       ------------------------
 554
 555       procedure Get_Type_Reference
 556         (Ent   : Entity_Id;
 557          Tref  : out Entity_Id;
 558          Left  : out Character;
 559          Right : out Character)
 560       is
 561          Sav : Entity_Id;
 562
 563       begin
 564          --  See if we have a type reference
 565
 566          Tref := Ent;
 567          Left := '{';
 568          Right := '}';
 569
 570          loop
 571             Sav := Tref;
 572
 573             --  Processing for types
 574
 575             if Is_Type (Tref) then
 576
 577                --  Case of base type
 578
 579                if Base_Type (Tref) = Tref then
 580
 581                   --  If derived, then get first subtype
 582
 583                   if Tref /= Etype (Tref) then
 584                      Tref := First_Subtype (Etype (Tref));
 585
 586                      --  Set brackets for derived type, but don't
 587                      --  override pointer case since the fact that
 588                      --  something is a pointer is more important
 589
 590                      if Left /= '(' then
 591                         Left := '<';
 592                         Right := '>';
 593                      end if;
 594
 595                   --  If non-derived ptr, get directly designated type.
 596                   --  If the type has a full view, all references are
 597                   --  on the partial view, that is seen first.
 598
 599                   elsif Is_Access_Type (Tref) then
 600                      Tref := Directly_Designated_Type (Tref);
 601                      Left := '(';
 602                      Right := ')';
 603
 604                   elsif Is_Private_Type (Tref)
 605                     and then Present (Full_View (Tref))
 606                     and then Is_Access_Type (Full_View (Tref))
 607                   then
 608                      Tref := Directly_Designated_Type (Full_View (Tref));
 609                      Left := '(';
 610                      Right := ')';
 611
 612                   --  If non-derived array, get component type.
 613                   --  Skip component type for case of String
 614                   --  or Wide_String, saves worthwhile space.
 615
 616                   elsif Is_Array_Type (Tref)
 617                     and then Tref /= Standard_String
 618                     and then Tref /= Standard_Wide_String
 619                   then
 620                      Tref := Component_Type (Tref);
 621                      Left := '(';
 622                      Right := ')';
 623
 624                   --  For other non-derived base types, nothing
 625
 626                   else
 627                      exit;
 628                   end if;
 629
 630                --  For a subtype, go to ancestor subtype.
 631
 632                else
 633                   Tref := Ancestor_Subtype (Tref);
 634
 635                   --  If no ancestor subtype, go to base type
 636
 637                   if No (Tref) then
 638                      Tref := Base_Type (Sav);
 639                   end if;
 640                end if;
 641
 642             --  For objects, functions, enum literals,
 643             --  just get type from Etype field.
 644
 645             elsif Is_Object (Tref)
 646               or else Ekind (Tref) = E_Enumeration_Literal
 647               or else Ekind (Tref) = E_Function
 648               or else Ekind (Tref) = E_Operator
 649             then
 650                Tref := Etype (Tref);
 651
 652             --  For anything else, exit
 653
 654             else
 655                exit;
 656             end if;
 657
 658             --  Exit if no type reference, or we are stuck in
 659             --  some loop trying to find the type reference, or
 660             --  if the type is standard void type (the latter is
 661             --  an implementation artifact that should not show
 662             --  up in the generated cross-references).
 663
 664             exit when No (Tref)
 665               or else Tref = Sav
 666               or else Tref = Standard_Void_Type;
 667
 668             --  If we have a usable type reference, return, otherwise
 669             --  keep looking for something useful (we are looking for
 670             --  something that either comes from source or standard)
 671
 672             if Sloc (Tref) = Standard_Location
 673               or else Comes_From_Source (Tref)
 674             then
 675                --  If the reference is a subtype created for a generic
 676                --  actual, go to actual directly, the inner subtype is
 677                --  not user visible.
 678
 679                if Nkind (Parent (Tref)) = N_Subtype_Declaration
 680                  and then not Comes_From_Source (Parent (Tref))
 681                  and then
 682                   (Is_Wrapper_Package (Scope (Tref))
 683                      or else Is_Generic_Instance (Scope (Tref)))
 684                then
 685                   Tref := Base_Type (Tref);
 686                end if;
 687
 688                return;
 689             end if;
 690          end loop;
 691
 692          --  If we fall through the loop, no type reference
 693
 694          Tref := Empty;
 695          Left := ' ';
 696          Right := ' ';
 697       end Get_Type_Reference;
 698
 699       -------------------------------
 700       -- Output_Import_Export_Info --
 701       -------------------------------
 702
 703       procedure Output_Import_Export_Info (Ent : Entity_Id) is
 704          Language_Name : Name_Id;
 705          Conv          : constant Convention_Id := Convention (Ent);
 706       begin
 707          if Conv  = Convention_C then
 708             Language_Name := Name_C;
 709
 710          elsif Conv = Convention_CPP then
 711             Language_Name := Name_CPP;
 712
 713          elsif Conv = Convention_Ada then
 714             Language_Name := Name_Ada;
 715
 716          else
 717             --  These are the only languages that GPS knows about.
 718
 719             return;
 720          end if;
 721
 722          Write_Info_Char ('<');
 723          Get_Unqualified_Name_String (Language_Name);
 724
 725          for J in 1 .. Name_Len loop
 726             Write_Info_Char (Name_Buffer (J));
 727          end loop;
 728
 729          if Present (Interface_Name (Ent)) then
 730             Write_Info_Char (',');
 731             String_To_Name_Buffer (Strval (Interface_Name (Ent)));
 732
 733             for J in 1 .. Name_Len loop
 734                Write_Info_Char (Name_Buffer (J));
 735             end loop;
 736          end if;
 737
 738          Write_Info_Char ('>');
 739       end Output_Import_Export_Info;
 740
 741    --  Start of processing for Output_References
 742
 743    begin
 744       if not Opt.Xref_Active then
 745          return;
 746       end if;
 747
 748       --  Before we go ahead and output the references we have a problem
 749       --  that needs dealing with. So far we have captured things that are
 750       --  definitely referenced by the main unit, or defined in the main
 751       --  unit. That's because we don't want to clutter up the ali file
 752       --  for this unit with definition lines for entities in other units
 753       --  that are not referenced.
 754
 755       --  But there is a glitch. We may reference an entity in another unit,
 756       --  and it may have a type reference to an entity that is not directly
 757       --  referenced in the main unit, which may mean that there is no xref
 758       --  entry for this entity yet in the list of references.
 759
 760       --  If we don't do something about this, we will end with an orphan
 761       --  type reference, i.e. it will point to an entity that does not
 762       --  appear within the generated references in the ali file. That is
 763       --  not good for tools using the xref information.
 764
 765       --  To fix this, we go through the references adding definition
 766       --  entries for any unreferenced entities that can be referenced
 767       --  in a type reference. There is a recursion problem here, and
 768       --  that is dealt with by making sure that this traversal also
 769       --  traverses any entries that get added by the traversal.
 770
 771       declare
 772          J    : Nat;
 773          Tref : Entity_Id;
 774          L, R : Character;
 775          Indx : Nat;
 776          Ent  : Entity_Id;
 777          Loc  : Source_Ptr;
 778
 779       begin
 780          --  Note that this is not a for loop for a very good reason. The
 781          --  processing of items in the table can add new items to the
 782          --  table, and they must be processed as well
 783
 784          J := 1;
 785          while J <= Xrefs.Last loop
 786             Ent := Xrefs.Table (J).Ent;
 787             Get_Type_Reference (Ent, Tref, L, R);
 788
 789             if Present (Tref)
 790               and then not Has_Xref_Entry (Tref)
 791               and then Sloc (Tref) > No_Location
 792             then
 793                Xrefs.Increment_Last;
 794                Indx := Xrefs.Last;
 795                Loc  := Original_Location (Sloc (Tref));
 796                Xrefs.Table (Indx).Ent := Tref;
 797                Xrefs.Table (Indx).Loc := No_Location;
 798                Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
 799                Xrefs.Table (Indx).Lun := No_Unit;
 800                Set_Has_Xref_Entry (Tref);
 801             end if;
 802
 803             --  Collect inherited primitive operations that may be
 804             --  declared in another unit and have no visible reference
 805             --  in the current one.
 806
 807             if Is_Type (Ent)
 808               and then Is_Tagged_Type (Ent)
 809               and then Is_Derived_Type (Ent)
 810               and then Ent = Base_Type (Ent)
 811               and then In_Extended_Main_Source_Unit (Ent)
 812             then
 813                declare
 814                   Op_List : constant Elist_Id := Primitive_Operations (Ent);
 815                   Op      : Elmt_Id;
 816                   Prim    : Entity_Id;
 817
 818                   function Parent_Op (E : Entity_Id) return Entity_Id;
 819                   --  Find original operation, which may be inherited
 820                   --  through several derivations.
 821
 822                   function Parent_Op (E : Entity_Id) return Entity_Id is
 823                      Orig_Op : constant Entity_Id := Alias (E);
 824                   begin
 825                      if No (Orig_Op) then
 826                         return Empty;
 827                      elsif not Comes_From_Source (E)
 828                        and then not Has_Xref_Entry (Orig_Op)
 829                        and then Comes_From_Source (Orig_Op)
 830                      then
 831                         return Orig_Op;
 832                      else
 833                         return Parent_Op (Orig_Op);
 834                      end if;
 835                   end Parent_Op;
 836
 837                begin
 838                   Op := First_Elmt (Op_List);
 839                   while Present (Op) loop
 840                      Prim := Parent_Op (Node (Op));
 841
 842                      if Present (Prim) then
 843                         Xrefs.Increment_Last;
 844                         Indx := Xrefs.Last;
 845                         Loc  := Original_Location (Sloc (Prim));
 846                         Xrefs.Table (Indx).Ent := Prim;
 847                         Xrefs.Table (Indx).Loc := No_Location;
 848                         Xrefs.Table (Indx).Eun :=
 849                           Get_Source_Unit (Sloc (Prim));
 850                         Xrefs.Table (Indx).Lun := No_Unit;
 851                         Set_Has_Xref_Entry (Prim);
 852                      end if;
 853
 854                      Next_Elmt (Op);
 855                   end loop;
 856                end;
 857             end if;
 858
 859             J := J + 1;
 860          end loop;
 861       end;
 862
 863       --  Now we have all the references, including those for any embedded
 864       --  type references, so we can sort them, and output them.
 865
 866       Output_Refs : declare
 867
 868          Nrefs : Nat := Xrefs.Last;
 869          --  Number of references in table. This value may get reset
 870          --  (reduced) when we eliminate duplicate reference entries.
 871
 872          Rnums : array (0 .. Nrefs) of Nat;
 873          --  This array contains numbers of references in the Xrefs table.
 874          --  This list is sorted in output order. The extra 0'th entry is
 875          --  convenient for the call to sort. When we sort the table, we
 876          --  move the entries in Rnums around, but we do not move the
 877          --  original table entries.
 878
 879          Curxu : Unit_Number_Type;
 880          --  Current xref unit
 881
 882          Curru : Unit_Number_Type;
 883          --  Current reference unit for one entity
 884
 885          Cursrc : Source_Buffer_Ptr;
 886          --  Current xref unit source text
 887
 888          Curent : Entity_Id;
 889          --  Current entity
 890
 891          Curnam : String (1 .. Name_Buffer'Length);
 892          Curlen : Natural;
 893          --  Simple name and length of current entity
 894
 895          Curdef : Source_Ptr;
 896          --  Original source location for current entity
 897
 898          Crloc : Source_Ptr;
 899          --  Current reference location
 900
 901          Ctyp : Character;
 902          --  Entity type character
 903
 904          Tref : Entity_Id;
 905          --  Type reference
 906
 907          Rref : Node_Id;
 908          --  Renaming reference
 909
 910          Trunit : Unit_Number_Type;
 911          --  Unit number for type reference
 912
 913          function Lt (Op1, Op2 : Natural) return Boolean;
 914          --  Comparison function for Sort call
 915
 916          function Name_Change (X : Entity_Id) return Boolean;
 917          --  Determines if entity X has a different simple name from Curent
 918
 919          procedure Move (From : Natural; To : Natural);
 920          --  Move procedure for Sort call
 921
 922          --------
 923          -- Lt --
 924          --------
 925
 926          function Lt (Op1, Op2 : Natural) return Boolean is
 927             T1 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op1)));
 928             T2 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op2)));
 929
 930          begin
 931             --  First test. If entity is in different unit, sort by unit
 932
 933             if T1.Eun /= T2.Eun then
 934                return Dependency_Num (T1.Eun) < Dependency_Num (T2.Eun);
 935
 936             --  Second test, within same unit, sort by entity Sloc
 937
 938             elsif T1.Def /= T2.Def then
 939                return T1.Def < T2.Def;
 940
 941             --  Third test, sort definitions ahead of references
 942
 943             elsif T1.Loc = No_Location then
 944                return True;
 945
 946             elsif T2.Loc = No_Location then
 947                return False;
 948
 949             --  Fourth test, for same entity, sort by reference location unit
 950
 951             elsif T1.Lun /= T2.Lun then
 952                return Dependency_Num (T1.Lun) < Dependency_Num (T2.Lun);
 953
 954             --  Fifth test order of location within referencing unit
 955
 956             elsif T1.Loc /= T2.Loc then
 957                return T1.Loc < T2.Loc;
 958
 959             --  Finally, for two locations at the same address, we prefer
 960             --  the one that does NOT have the type 'r' so that a modification
 961             --  or extension takes preference, when there are more than one
 962             --  reference at the same location.
 963
 964             else
 965                return T2.Typ = 'r';
 966             end if;
 967          end Lt;
 968
 969          ----------
 970          -- Move --
 971          ----------
 972
 973          procedure Move (From : Natural; To : Natural) is
 974          begin
 975             Rnums (Nat (To)) := Rnums (Nat (From));
 976          end Move;
 977
 978          -----------------
 979          -- Name_Change --
 980          -----------------
 981
 982          function Name_Change (X : Entity_Id) return Boolean is
 983          begin
 984             Get_Unqualified_Name_String (Chars (X));
 985
 986             if Name_Len /= Curlen then
 987                return True;
 988
 989             else
 990                return Name_Buffer (1 .. Curlen) /= Curnam (1 .. Curlen);
 991             end if;
 992          end Name_Change;
 993
 994       --  Start of processing for Output_Refs
 995
 996       begin
 997          --  Capture the definition Sloc values. We delay doing this till now,
 998          --  since at the time the reference or definition is made, private
 999          --  types may be swapped, and the Sloc value may be incorrect. We
1000          --  also set up the pointer vector for the sort.
1001
1002          for J in 1 .. Nrefs loop
1003             Rnums (J) := J;
1004             Xrefs.Table (J).Def :=
1005               Original_Location (Sloc (Xrefs.Table (J).Ent));
1006          end loop;
1007
1008          --  Sort the references
1009
1010          GNAT.Heap_Sort_A.Sort
1011            (Integer (Nrefs),
1012             Move'Unrestricted_Access,
1013             Lt'Unrestricted_Access);
1014
1015          --  Eliminate duplicate entries
1016
1017          declare
1018             NR : constant Nat := Nrefs;
1019
1020          begin
1021             --  We need this test for NR because if we force ALI file
1022             --  generation in case of errors detected, it may be the case
1023             --  that Nrefs is 0, so we should not reset it here
1024
1025             if NR >= 2 then
1026                Nrefs := 1;
1027
1028                for J in 2 .. NR loop
1029                   if Xrefs.Table (Rnums (J)) /=
1030                      Xrefs.Table (Rnums (Nrefs))
1031                   then
1032                      Nrefs := Nrefs + 1;
1033                      Rnums (Nrefs) := Rnums (J);
1034                   end if;
1035                end loop;
1036             end if;
1037          end;
1038
1039          --  Initialize loop through references
1040
1041          Curxu  := No_Unit;
1042          Curent := Empty;
1043          Curdef := No_Location;
1044          Curru  := No_Unit;
1045          Crloc  := No_Location;
1046
1047          --  Loop to output references
1048
1049          for Refno in 1 .. Nrefs loop
1050             Output_One_Ref : declare
1051                P2  : Source_Ptr;
1052                WC  : Char_Code;
1053                Err : Boolean;
1054                Ent : Entity_Id;
1055
1056                XE : Xref_Entry renames Xrefs.Table (Rnums (Refno));
1057                --  The current entry to be accessed
1058
1059                P : Source_Ptr;
1060                --  Used to index into source buffer to get entity name
1061
1062                Left  : Character;
1063                Right : Character;
1064                --  Used for {} or <> or () for type reference
1065
1066                procedure Output_Instantiation_Refs (Loc : Source_Ptr);
1067                --  Recursive procedure to output instantiation references for
1068                --  the given source ptr in [file|line[...]] form. No output
1069                --  if the given location is not a generic template reference.
1070
1071                -------------------------------
1072                -- Output_Instantiation_Refs --
1073                -------------------------------
1074
1075                procedure Output_Instantiation_Refs (Loc : Source_Ptr) is
1076                   Iloc : constant Source_Ptr := Instantiation_Location (Loc);
1077                   Lun  : Unit_Number_Type;
1078                   Cu   : constant Unit_Number_Type := Curru;
1079
1080                begin
1081                   --  Nothing to do if this is not an instantiation
1082
1083                   if Iloc = No_Location then
1084                      return;
1085                   end if;
1086
1087                   --  Output instantiation reference
1088
1089                   Write_Info_Char ('[');
1090                   Lun := Get_Source_Unit (Iloc);
1091
1092                   if Lun /= Curru then
1093                      Curru := Lun;
1094                      Write_Info_Nat (Dependency_Num (Curru));
1095                      Write_Info_Char ('|');
1096                   end if;
1097
1098                   Write_Info_Nat (Int (Get_Logical_Line_Number (Iloc)));
1099
1100                   --  Recursive call to get nested instantiations
1101
1102                   Output_Instantiation_Refs (Iloc);
1103
1104                   --  Output final ] after call to get proper nesting
1105
1106                   Write_Info_Char (']');
1107                   Curru := Cu;
1108                   return;
1109                end Output_Instantiation_Refs;
1110
1111             --  Start of processing for Output_One_Ref
1112
1113             begin
1114                Ent := XE.Ent;
1115                Ctyp := Xref_Entity_Letters (Ekind (Ent));
1116
1117                --  Skip reference if it is the only reference to an entity,
1118                --  and it is an end-line reference, and the entity is not in
1119                --  the current extended source. This prevents junk entries
1120                --  consisting only of packages with end lines, where no
1121                --  entity from the package is actually referenced.
1122
1123                if XE.Typ = 'e'
1124                  and then Ent /= Curent
1125                  and then (Refno = Nrefs or else
1126                              Ent /= Xrefs.Table (Rnums (Refno + 1)).Ent)
1127                  and then
1128                    not In_Extended_Main_Source_Unit (Ent)
1129                then
1130                   goto Continue;
1131                end if;
1132
1133                --  For private type, get full view type
1134
1135                if Ctyp = '+'
1136                  and then Present (Full_View (XE.Ent))
1137                then
1138                   Ent := Underlying_Type (Ent);
1139
1140                   if Present (Ent) then
1141                      Ctyp := Xref_Entity_Letters (Ekind (Ent));
1142                   end if;
1143                end if;
1144
1145                --  Special exception for Boolean
1146
1147                if Ctyp = 'E' and then Is_Boolean_Type (Ent) then
1148                   Ctyp := 'B';
1149                end if;
1150
1151                --  For variable reference, get corresponding type
1152
1153                if Ctyp = '*' then
1154                   Ent := Etype (XE.Ent);
1155                   Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
1156
1157                   --  If variable is private type, get full view type
1158
1159                   if Ctyp = '+'
1160                     and then Present (Full_View (Etype (XE.Ent)))
1161                   then
1162                      Ent := Underlying_Type (Etype (XE.Ent));
1163
1164                      if Present (Ent) then
1165                         Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
1166                      end if;
1167                   end if;
1168
1169                   --  Special handling for access parameter
1170
1171                   declare
1172                      K : constant Entity_Kind := Ekind (Etype (XE.Ent));
1173
1174                   begin
1175                      if (K = E_Anonymous_Access_Type
1176                            or else
1177                          K = E_Anonymous_Access_Subprogram_Type
1178                             or else K =
1179                          E_Anonymous_Access_Protected_Subprogram_Type)
1180                        and then Is_Formal (XE.Ent)
1181                      then
1182                         Ctyp := 'p';
1183
1184                         --  Special handling for Boolean
1185
1186                      elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
1187                         Ctyp := 'b';
1188                      end if;
1189                   end;
1190                end if;
1191
1192                --  Special handling for abstract types and operations.
1193
1194                if Is_Abstract (XE.Ent) then
1195
1196                   if Ctyp = 'U' then
1197                      Ctyp := 'x';            --  abstract procedure
1198
1199                   elsif Ctyp = 'V' then
1200                      Ctyp := 'y';            --  abstract function
1201
1202                   elsif Ctyp = 'R' then
1203                      Ctyp := 'H';            --  abstract type
1204                   end if;
1205                end if;
1206
1207                --  Only output reference if interesting type of entity,
1208                --  and suppress self references, except for bodies that
1209                --  act as specs. Also suppress definitions of body formals
1210                --  (we only treat these as references, and the references
1211                --  were separately recorded).
1212
1213                if Ctyp = ' '
1214                  or else (XE.Loc = XE.Def
1215                             and then
1216                               (XE.Typ /= 'b'
1217                                 or else not Is_Subprogram (XE.Ent)))
1218                  or else (Is_Formal (XE.Ent)
1219                             and then Present (Spec_Entity (XE.Ent)))
1220                then
1221                   null;
1222
1223                else
1224                   --  Start new Xref section if new xref unit
1225
1226                   if XE.Eun /= Curxu then
1227                      if Write_Info_Col > 1 then
1228                         Write_Info_EOL;
1229                      end if;
1230
1231                      Curxu := XE.Eun;
1232                      Cursrc := Source_Text (Source_Index (Curxu));
1233
1234                      Write_Info_Initiate ('X');
1235                      Write_Info_Char (' ');
1236                      Write_Info_Nat (Dependency_Num (XE.Eun));
1237                      Write_Info_Char (' ');
1238                      Write_Info_Name (Reference_Name (Source_Index (XE.Eun)));
1239                   end if;
1240
1241                   --  Start new Entity line if new entity. Note that we
1242                   --  consider two entities the same if they have the same
1243                   --  name and source location. This causes entities in
1244                   --  instantiations to be treated as though they referred
1245                   --  to the template.
1246
1247                   if No (Curent)
1248                     or else
1249                       (XE.Ent /= Curent
1250                          and then
1251                            (Name_Change (XE.Ent) or else XE.Def /= Curdef))
1252                   then
1253                      Curent := XE.Ent;
1254                      Curdef := XE.Def;
1255
1256                      Get_Unqualified_Name_String (Chars (XE.Ent));
1257                      Curlen := Name_Len;
1258                      Curnam (1 .. Curlen) := Name_Buffer (1 .. Curlen);
1259
1260                      if Write_Info_Col > 1 then
1261                         Write_Info_EOL;
1262                      end if;
1263
1264                      --  Write column number information
1265
1266                      Write_Info_Nat (Int (Get_Logical_Line_Number (XE.Def)));
1267                      Write_Info_Char (Ctyp);
1268                      Write_Info_Nat (Int (Get_Column_Number (XE.Def)));
1269
1270                      --  Write level information
1271
1272                      Write_Level_Info : declare
1273                         function Is_Visible_Generic_Entity
1274                           (E : Entity_Id) return Boolean;
1275                         --  Check whether E is declared in the visible part
1276                         --  of a generic package. For source navigation
1277                         --  purposes, treat this as a visible entity.
1278
1279                         function Is_Private_Record_Component
1280                           (E : Entity_Id) return Boolean;
1281                         --  Check whether E is a non-inherited component of a
1282                         --  private extension. Even if the enclosing record is
1283                         --  public, we want to treat the component as private
1284                         --  for navigation purposes.
1285
1286                         ---------------------------------
1287                         -- Is_Private_Record_Component --
1288                         ---------------------------------
1289
1290                         function Is_Private_Record_Component
1291                           (E : Entity_Id) return Boolean
1292                         is
1293                            S : constant Entity_Id := Scope (E);
1294                         begin
1295                            return
1296                              Ekind (E) = E_Component
1297                                and then Nkind (Declaration_Node (S)) =
1298                                  N_Private_Extension_Declaration
1299                                and then Original_Record_Component (E) = E;
1300                         end Is_Private_Record_Component;
1301
1302                         -------------------------------
1303                         -- Is_Visible_Generic_Entity --
1304                         -------------------------------
1305
1306                         function Is_Visible_Generic_Entity
1307                           (E : Entity_Id) return Boolean
1308                         is
1309                            Par : Node_Id;
1310
1311                         begin
1312                            if Ekind (Scope (E)) /= E_Generic_Package then
1313                               return False;
1314                            end if;
1315
1316                            Par := Parent (E);
1317                            while Present (Par) loop
1318                               if
1319                                 Nkind (Par) = N_Generic_Package_Declaration
1320                               then
1321                                  --  Entity is a generic formal
1322
1323                                  return False;
1324
1325                               elsif
1326                                 Nkind (Parent (Par)) = N_Package_Specification
1327                               then
1328                                  return
1329                                    Is_List_Member (Par)
1330                                      and then List_Containing (Par) =
1331                                        Visible_Declarations (Parent (Par));
1332                               else
1333                                  Par := Parent (Par);
1334                               end if;
1335                            end loop;
1336
1337                            return False;
1338                         end Is_Visible_Generic_Entity;
1339
1340                      --  Start of processing for Write_Level_Info
1341
1342                      begin
1343                         if Is_Hidden (Curent)
1344                           or else Is_Private_Record_Component (Curent)
1345                         then
1346                            Write_Info_Char (' ');
1347
1348                         elsif
1349                            Is_Public (Curent)
1350                              or else Is_Visible_Generic_Entity (Curent)
1351                         then
1352                            Write_Info_Char ('*');
1353
1354                         else
1355                            Write_Info_Char (' ');
1356                         end if;
1357                      end Write_Level_Info;
1358
1359                      --  Output entity name. We use the occurrence from the
1360                      --  actual source program at the definition point
1361
1362                      P := Original_Location (Sloc (XE.Ent));
1363
1364                      --  Entity is character literal
1365
1366                      if Cursrc (P) = ''' then
1367                         Write_Info_Char (Cursrc (P));
1368                         Write_Info_Char (Cursrc (P + 1));
1369                         Write_Info_Char (Cursrc (P + 2));
1370
1371                      --  Entity is operator symbol
1372
1373                      elsif Cursrc (P) = '"' or else Cursrc (P) = '%' then
1374                         Write_Info_Char (Cursrc (P));
1375
1376                         P2 := P;
1377                         loop
1378                            P2 := P2 + 1;
1379                            Write_Info_Char (Cursrc (P2));
1380                            exit when Cursrc (P2) = Cursrc (P);
1381                         end loop;
1382
1383                      --  Entity is identifier
1384
1385                      else
1386                         loop
1387                            if Is_Start_Of_Wide_Char (Cursrc, P) then
1388                               Scan_Wide (Cursrc, P, WC, Err);
1389                            elsif not Identifier_Char (Cursrc (P)) then
1390                               exit;
1391                            else
1392                               P := P + 1;
1393                            end if;
1394                         end loop;
1395
1396                         for J in
1397                           Original_Location (Sloc (XE.Ent)) .. P - 1
1398                         loop
1399                            Write_Info_Char (Cursrc (J));
1400                         end loop;
1401                      end if;
1402
1403                      --  See if we have a renaming reference
1404
1405                      if Is_Object (XE.Ent)
1406                        and then Present (Renamed_Object (XE.Ent))
1407                      then
1408                         Rref := Renamed_Object (XE.Ent);
1409
1410                      elsif Is_Overloadable (XE.Ent)
1411                        and then Nkind (Parent (Declaration_Node (XE.Ent))) =
1412                                             N_Subprogram_Renaming_Declaration
1413                      then
1414                         Rref := Name (Parent (Declaration_Node (XE.Ent)));
1415
1416                      elsif Ekind (XE.Ent) = E_Package
1417                        and then Nkind (Declaration_Node (XE.Ent)) =
1418                                          N_Package_Renaming_Declaration
1419                      then
1420                         Rref := Name (Declaration_Node (XE.Ent));
1421
1422                      else
1423                         Rref := Empty;
1424                      end if;
1425
1426                      if Present (Rref) then
1427                         if Nkind (Rref) = N_Expanded_Name then
1428                            Rref := Selector_Name (Rref);
1429                         end if;
1430
1431                         if Nkind (Rref) /= N_Identifier then
1432                            Rref := Empty;
1433                         end if;
1434                      end if;
1435
1436                      --  Write out renaming reference if we have one
1437
1438                      if Present (Rref) then
1439                         Write_Info_Char ('=');
1440                         Write_Info_Nat
1441                           (Int (Get_Logical_Line_Number (Sloc (Rref))));
1442                         Write_Info_Char (':');
1443                         Write_Info_Nat
1444                           (Int (Get_Column_Number (Sloc (Rref))));
1445                      end if;
1446
1447                      --  Indicate that the entity is in the unit
1448                      --  of the current xref xection.
1449
1450                      Curru := Curxu;
1451
1452                      --  See if we have a type reference and if so output
1453
1454                      Get_Type_Reference (XE.Ent, Tref, Left, Right);
1455
1456                      if Present (Tref) then
1457
1458                         --  Case of standard entity, output name
1459
1460                         if Sloc (Tref) = Standard_Location then
1461                            Write_Info_Char (Left);
1462                            Write_Info_Name (Chars (Tref));
1463                            Write_Info_Char (Right);
1464
1465                         --  Case of source entity, output location
1466
1467                         else
1468                            Write_Info_Char (Left);
1469                            Trunit := Get_Source_Unit (Sloc (Tref));
1470
1471                            if Trunit /= Curxu then
1472                               Write_Info_Nat (Dependency_Num (Trunit));
1473                               Write_Info_Char ('|');
1474                            end if;
1475
1476                            Write_Info_Nat
1477                              (Int (Get_Logical_Line_Number (Sloc (Tref))));
1478
1479                            declare
1480                               Ent  : Entity_Id := Tref;
1481                               Kind : constant Entity_Kind := Ekind (Ent);
1482                               Ctyp : Character := Xref_Entity_Letters (Kind);
1483
1484                            begin
1485                               if Ctyp = '+'
1486                                 and then Present (Full_View (Ent))
1487                               then
1488                                  Ent := Underlying_Type (Ent);
1489
1490                                  if Present (Ent) then
1491                                     Ctyp := Xref_Entity_Letters (Ekind (Ent));
1492                                  end if;
1493                               end if;
1494
1495                               Write_Info_Char (Ctyp);
1496                            end;
1497
1498                            Write_Info_Nat
1499                              (Int (Get_Column_Number (Sloc (Tref))));
1500
1501                            --  If the type comes from an instantiation,
1502                            --  add the corresponding info.
1503
1504                            Output_Instantiation_Refs (Sloc (Tref));
1505                            Write_Info_Char (Right);
1506                         end if;
1507                      end if;
1508
1509                      --  End of processing for entity output
1510
1511                      Crloc := No_Location;
1512                   end if;
1513
1514                   --  Output the reference
1515
1516                   if XE.Loc /= No_Location
1517                      and then XE.Loc /= Crloc
1518                   then
1519                      Crloc := XE.Loc;
1520
1521                      --  Start continuation if line full, else blank
1522
1523                      if Write_Info_Col > 72 then
1524                         Write_Info_EOL;
1525                         Write_Info_Initiate ('.');
1526                      end if;
1527
1528                      Write_Info_Char (' ');
1529
1530                      --  Output file number if changed
1531
1532                      if XE.Lun /= Curru then
1533                         Curru := XE.Lun;
1534                         Write_Info_Nat (Dependency_Num (Curru));
1535                         Write_Info_Char ('|');
1536                      end if;
1537
1538                      Write_Info_Nat  (Int (Get_Logical_Line_Number (XE.Loc)));
1539                      Write_Info_Char (XE.Typ);
1540
1541                      if Is_Overloadable (XE.Ent)
1542                        and then Is_Imported (XE.Ent)
1543                        and then XE.Typ = 'b'
1544                      then
1545                         Output_Import_Export_Info (XE.Ent);
1546                      end if;
1547
1548                      Write_Info_Nat  (Int (Get_Column_Number (XE.Loc)));
1549
1550                      Output_Instantiation_Refs (Sloc (XE.Ent));
1551                   end if;
1552                end if;
1553             end Output_One_Ref;
1554
1555          <<Continue>>
1556             null;
1557          end loop;
1558
1559          Write_Info_EOL;
1560       end Output_Refs;
1561    end Output_References;
1562
1563 end Lib.Xref;