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 --                            $Revision: 1.56 $
  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 was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Atree;    use Atree;
  30 with Csets;    use Csets;
  31 with Lib.Util; use Lib.Util;
  32 with Namet;    use Namet;
  33 with Opt;      use Opt;
  34 with Sinfo;    use Sinfo;
  35 with Sinput;   use Sinput;
  36 with Table;    use Table;
  37 with Widechar; use Widechar;
  38
  39 with GNAT.Heap_Sort_A;
  40
  41 package body Lib.Xref is
  42
  43    ------------------
  44    -- Declarations --
  45    ------------------
  46
  47    --  The Xref table is used to record references. The Loc field is set
  48    --  to No_Location for a definition entry.
  49
  50    subtype Xref_Entry_Number is Int;
  51
  52    type Xref_Entry is record
  53       Ent : Entity_Id;
  54       --  Entity referenced (E parameter to Generate_Reference)
  55
  56       Def : Source_Ptr;
  57       --  Original source location for entity being referenced. Note that
  58       --  these values are used only during the output process, they are
  59       --  not set when the entries are originally built. This is because
  60       --  private entities can be swapped when the initial call is made.
  61
  62       Loc : Source_Ptr;
  63       --  Location of reference (Original_Location (Sloc field of N parameter
  64       --  to Generate_Reference). Set to No_Location for the case of a
  65       --  defining occurrence.
  66
  67       Typ : Character;
  68       --  Reference type (Typ param to Generate_Reference)
  69
  70       Eun : Unit_Number_Type;
  71       --  Unit number corresponding to Ent
  72
  73       Lun : Unit_Number_Type;
  74       --  Unit number corresponding to Loc. Value is undefined and not
  75       --  referenced if Loc is set to No_Location.
  76
  77    end record;
  78
  79    package Xrefs is new Table.Table (
  80      Table_Component_Type => Xref_Entry,
  81      Table_Index_Type     => Int,
  82      Table_Low_Bound      => 1,
  83      Table_Initial        => Alloc.Xrefs_Initial,
  84      Table_Increment      => Alloc.Xrefs_Increment,
  85      Table_Name           => "Xrefs");
  86
  87    function Get_Xref_Index (E : Entity_Id) return Xref_Entry_Number;
  88    --  Returns the Xref entry table index for entity E.
  89    --  So : Xrefs.Table (Get_Xref_Index (E)).Ent = E
  90
  91    -------------------------
  92    -- Generate_Definition --
  93    -------------------------
  94
  95    procedure Generate_Definition (E : Entity_Id) is
  96       Loc  : Source_Ptr;
  97       Indx : Nat;
  98
  99    begin
 100       pragma Assert (Nkind (E) in N_Entity);
 101
 102       --  Note that we do not test Xref_Entity_Letters here. It is too
 103       --  early to do so, since we are often called before the entity
 104       --  is fully constructed, so that the Ekind is still E_Void.
 105
 106       if Opt.Xref_Active
 107
 108          --  Definition must come from source
 109
 110          and then Comes_From_Source (E)
 111
 112          --  And must have a reasonable source location that is not
 113          --  within an instance (all entities in instances are ignored)
 114
 115          and then Sloc (E) > No_Location
 116          and then Instantiation_Location (Sloc (E)) = No_Location
 117
 118          --  And must be a non-internal name from the main source unit
 119
 120          and then In_Extended_Main_Source_Unit (E)
 121          and then not Is_Internal_Name (Chars (E))
 122       then
 123          Xrefs.Increment_Last;
 124          Indx := Xrefs.Last;
 125          Loc  := Original_Location (Sloc (E));
 126
 127          Xrefs.Table (Indx).Ent := E;
 128          Xrefs.Table (Indx).Loc := No_Location;
 129          Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
 130          Xrefs.Table (Indx).Lun := No_Unit;
 131       end if;
 132    end Generate_Definition;
 133
 134    ---------------------------------
 135    -- Generate_Operator_Reference --
 136    ---------------------------------
 137
 138    procedure Generate_Operator_Reference (N : Node_Id) is
 139    begin
 140       if not In_Extended_Main_Source_Unit (N) then
 141          return;
 142       end if;
 143
 144       --  If the operator is not a Standard operator, then we generate
 145       --  a real reference to the user defined operator.
 146
 147       if Sloc (Entity (N)) /= Standard_Location then
 148          Generate_Reference (Entity (N), N);
 149
 150          --  A reference to an implicit inequality operator is a also a
 151          --  reference to the user-defined equality.
 152
 153          if Nkind (N) = N_Op_Ne
 154            and then not Comes_From_Source (Entity (N))
 155            and then Present (Corresponding_Equality (Entity (N)))
 156          then
 157             Generate_Reference (Corresponding_Equality (Entity (N)), N);
 158          end if;
 159
 160       --  For the case of Standard operators, we mark the result type
 161       --  as referenced. This ensures that in the case where we are
 162       --  using a derived operator, we mark an entity of the unit that
 163       --  implicitly defines this operator as used. Otherwise we may
 164       --  think that no entity of the unit is used. The actual entity
 165       --  marked as referenced is the first subtype, which is the user
 166       --  defined entity that is relevant.
 167
 168       else
 169          if Nkind (N) = N_Op_Eq
 170            or else Nkind (N) = N_Op_Ne
 171            or else Nkind (N) = N_Op_Le
 172            or else Nkind (N) = N_Op_Lt
 173            or else Nkind (N) = N_Op_Ge
 174            or else Nkind (N) = N_Op_Gt
 175          then
 176             Set_Referenced (First_Subtype (Etype (Right_Opnd (N))));
 177          else
 178             Set_Referenced (First_Subtype (Etype (N)));
 179          end if;
 180       end if;
 181    end Generate_Operator_Reference;
 182
 183    ------------------------
 184    -- Generate_Reference --
 185    ------------------------
 186
 187    procedure Generate_Reference
 188      (E       : Entity_Id;
 189       N       : Node_Id;
 190       Typ     : Character := 'r';
 191       Set_Ref : Boolean   := True;
 192       Force   : Boolean   := False)
 193    is
 194       Indx : Nat;
 195       Nod  : Node_Id;
 196       Ref  : Source_Ptr;
 197       Def  : Source_Ptr;
 198       Ent  : Entity_Id;
 199
 200    begin
 201       pragma Assert (Nkind (E) in N_Entity);
 202
 203       --  Never collect references if not in main source unit. However,
 204       --  we omit this test if Typ is 'e', since these entries are
 205       --  really structural, and it is useful to have them in units
 206       --  that reference packages as well as units that define packages.
 207
 208       if not In_Extended_Main_Source_Unit (N)
 209         and then Typ /= 'e'
 210       then
 211          return;
 212       end if;
 213
 214       --  Unless the reference is forced, we ignore references where
 215       --  the reference itself does not come from Source.
 216
 217       if not Force and then not Comes_From_Source (N) then
 218          return;
 219       end if;
 220
 221       --  Deal with setting entity as referenced, unless suppressed.
 222       --  Note that we still do Set_Referenced on entities that do not
 223       --  come from source. This situation arises when we have a source
 224       --  reference to a derived operation, where the derived operation
 225       --  itself does not come from source, but we still want to mark it
 226       --  as referenced, since we really are referencing an entity in the
 227       --  corresponding package (this avoids incorrect complaints that the
 228       --  package contains no referenced entities).
 229
 230       if Set_Ref then
 231          Set_Referenced (E);
 232
 233          --  If this is a subprogram instance, mark as well the internal
 234          --  subprogram in the wrapper package, which may be a visible
 235          --  compilation unit.
 236
 237          if Is_Overloadable (E)
 238            and then Is_Generic_Instance (E)
 239            and then Present (Alias (E))
 240          then
 241             Set_Referenced (Alias (E));
 242          end if;
 243       end if;
 244
 245       --  Generate reference if all conditions are met:
 246
 247       if
 248          --  Cross referencing must be active
 249
 250          Opt.Xref_Active
 251
 252          --  The entity must be one for which we collect references
 253
 254          and then Xref_Entity_Letters (Ekind (E)) /= ' '
 255
 256          --  Both Sloc values must be set to something sensible
 257
 258          and then Sloc (E) > No_Location
 259          and then Sloc (N) > No_Location
 260
 261          --  We ignore references from within an instance
 262
 263          and then Instantiation_Location (Sloc (N)) = No_Location
 264
 265          --  Ignore dummy references
 266
 267         and then Typ /= ' '
 268       then
 269          if Nkind (N) = N_Identifier
 270               or else
 271             Nkind (N) = N_Defining_Identifier
 272               or else
 273             Nkind (N) in N_Op
 274               or else
 275             Nkind (N) = N_Defining_Operator_Symbol
 276               or else
 277             (Nkind (N) = N_Character_Literal
 278               and then Sloc (Entity (N)) /= Standard_Location)
 279               or else
 280             Nkind (N) = N_Defining_Character_Literal
 281          then
 282             Nod := N;
 283
 284          elsif Nkind (N) = N_Expanded_Name
 285                  or else
 286                Nkind (N) = N_Selected_Component
 287          then
 288             Nod := Selector_Name (N);
 289
 290          else
 291             return;
 292          end if;
 293
 294          --  Normal case of source entity comes from source
 295
 296          if Comes_From_Source (E) then
 297             Ent := E;
 298
 299          --  Entity does not come from source, but is a derived subprogram
 300          --  and the derived subprogram comes from source, in which case
 301          --  the reference is to this parent subprogram.
 302
 303          elsif Is_Overloadable (E)
 304            and then Present (Alias (E))
 305            and then Comes_From_Source (Alias (E))
 306          then
 307             Ent := Alias (E);
 308
 309          --  Ignore reference to any other source that is not from source
 310
 311          else
 312             return;
 313          end if;
 314
 315          --  Record reference to entity
 316
 317          Ref := Original_Location (Sloc (Nod));
 318          Def := Original_Location (Sloc (Ent));
 319
 320          Xrefs.Increment_Last;
 321          Indx := Xrefs.Last;
 322
 323          Xrefs.Table (Indx).Loc := Ref;
 324          Xrefs.Table (Indx).Typ := Typ;
 325          Xrefs.Table (Indx).Eun := Get_Source_Unit (Def);
 326          Xrefs.Table (Indx).Lun := Get_Source_Unit (Ref);
 327          Xrefs.Table (Indx).Ent := Ent;
 328       end if;
 329    end Generate_Reference;
 330
 331    --------------------
 332    -- Get_Xref_Index --
 333    --------------------
 334
 335    function Get_Xref_Index (E : Entity_Id) return Xref_Entry_Number is
 336    begin
 337       for K in 1 .. Xrefs.Last loop
 338          if Xrefs.Table (K).Ent = E then
 339             return K;
 340          end if;
 341       end loop;
 342
 343       --  not found, this happend if the entity is not in the compiled unit.
 344
 345       return 0;
 346    end Get_Xref_Index;
 347
 348    -----------------------
 349    -- Output_References --
 350    -----------------------
 351
 352    procedure Output_References is
 353       Nrefs : constant Nat := Xrefs.Last;
 354
 355       Rnums : array (0 .. Nrefs) of Nat;
 356       --  This array contains numbers of references in the Xrefs table. This
 357       --  list is sorted in output order. The extra 0'th entry is convenient
 358       --  for the call to sort. When we sort the table, we move these entries
 359       --  around, but we do not move the original table entries.
 360
 361       function Lt (Op1, Op2 : Natural) return Boolean;
 362       --  Comparison function for Sort call
 363
 364       procedure Move (From : Natural; To : Natural);
 365       --  Move procedure for Sort call
 366
 367       function Lt (Op1, Op2 : Natural) return Boolean is
 368          T1 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op1)));
 369          T2 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op2)));
 370
 371       begin
 372          --  First test. If entity is in different unit, sort by unit
 373
 374          if T1.Eun /= T2.Eun then
 375             return Dependency_Num (T1.Eun) < Dependency_Num (T2.Eun);
 376
 377          --  Second test, within same unit, sort by entity Sloc
 378
 379          elsif T1.Def /= T2.Def then
 380             return T1.Def < T2.Def;
 381
 382          --  Third test, sort definitions ahead of references
 383
 384          elsif T1.Loc = No_Location then
 385             return True;
 386
 387          elsif T2.Loc = No_Location then
 388             return False;
 389
 390          --  Fourth test, for same entity, sort by reference location unit
 391
 392          elsif T1.Lun /= T2.Lun then
 393             return Dependency_Num (T1.Lun) < Dependency_Num (T2.Lun);
 394
 395          --  Fifth test order of location within referencing unit
 396
 397          elsif T1.Loc /= T2.Loc then
 398             return T1.Loc < T2.Loc;
 399
 400          --  Finally, for two locations at the same address, we prefer
 401          --  the one that does NOT have the type 'r' so that a modification
 402          --  or extension takes preference, when there are more than one
 403          --  reference at the same location.
 404
 405          else
 406             return T2.Typ = 'r';
 407          end if;
 408       end Lt;
 409
 410       procedure Move (From : Natural; To : Natural) is
 411       begin
 412          Rnums (Nat (To)) := Rnums (Nat (From));
 413       end Move;
 414
 415    --  Start of processing for Output_References
 416
 417    begin
 418       if not Opt.Xref_Active then
 419          return;
 420       end if;
 421
 422       --  Capture the definition Sloc values. We delay doing this till now,
 423       --  since at the time the reference or definition is made, private
 424       --  types may be swapped, and the Sloc value may be incorrect. We
 425       --  also set up the pointer vector for the sort.
 426
 427       for J in 1 .. Nrefs loop
 428          Rnums (J) := J;
 429          Xrefs.Table (J).Def :=
 430            Original_Location (Sloc (Xrefs.Table (J).Ent));
 431       end loop;
 432
 433       --  Sort the references
 434
 435       GNAT.Heap_Sort_A.Sort
 436         (Integer (Nrefs),
 437          Move'Unrestricted_Access,
 438          Lt'Unrestricted_Access);
 439
 440       --  Now output the references
 441
 442       Output_Refs : declare
 443
 444          Curxu : Unit_Number_Type;
 445          --  Current xref unit
 446
 447          Curru : Unit_Number_Type;
 448          --  Current reference unit for one entity
 449
 450          Cursrc : Source_Buffer_Ptr;
 451          --  Current xref unit source text
 452
 453          Curent : Entity_Id;
 454          --  Current entity
 455
 456          Curnam : String (1 .. Name_Buffer'Length);
 457          Curlen : Natural;
 458          --  Simple name and length of current entity
 459
 460          Curdef : Source_Ptr;
 461          --  Original source location for current entity
 462
 463          Crloc : Source_Ptr;
 464          --  Current reference location
 465
 466          Ctyp : Character;
 467          --  Entity type character
 468
 469          Parent_Entry : Int;
 470          --  entry for parent of derived type.
 471
 472          function Name_Change (X : Entity_Id) return Boolean;
 473          --  Determines if entity X has a different simple name from Curent
 474
 475          function Get_Parent_Entry (X : Entity_Id) return Int;
 476          --  For a derived type, locate entry of parent type, if defined in
 477          --  in the current unit.
 478
 479          function Get_Parent_Entry (X : Entity_Id) return Int is
 480             Parent_Type : Entity_Id;
 481
 482          begin
 483             if not Is_Type (X)
 484               or else not Is_Derived_Type (X)
 485             then
 486                return 0;
 487             else
 488                Parent_Type := First_Subtype (Etype (Base_Type (X)));
 489
 490                if Comes_From_Source (Parent_Type) then
 491                   return Get_Xref_Index (Parent_Type);
 492
 493                else
 494                   return 0;
 495                end if;
 496             end if;
 497          end Get_Parent_Entry;
 498
 499          function Name_Change (X : Entity_Id) return Boolean is
 500          begin
 501             Get_Unqualified_Name_String (Chars (X));
 502
 503             if Name_Len /= Curlen then
 504                return True;
 505
 506             else
 507                return Name_Buffer (1 .. Curlen) /= Curnam (1 .. Curlen);
 508             end if;
 509          end Name_Change;
 510
 511       --  Start of processing for Output_Refs
 512
 513       begin
 514          Curxu  := No_Unit;
 515          Curent := Empty;
 516          Curdef := No_Location;
 517          Curru  := No_Unit;
 518          Crloc  := No_Location;
 519
 520          for Refno in 1 .. Nrefs loop
 521             declare
 522                XE : Xref_Entry renames Xrefs.Table (Rnums (Refno));
 523                --  The current entry to be accessed
 524
 525                P : Source_Ptr;
 526                --  Used to index into source buffer to get entity name
 527
 528                P2  : Source_Ptr;
 529                WC  : Char_Code;
 530                Err : Boolean;
 531                Ent : Entity_Id;
 532
 533             begin
 534                Ent := XE.Ent;
 535                Ctyp := Xref_Entity_Letters (Ekind (Ent));
 536
 537                --  Skip reference if it is the only reference to an entity,
 538                --  and it is an end-line reference, and the entity is not in
 539                --  the current extended source. This prevents junk entries
 540                --  consisting only of packages with end lines, where no
 541                --  entity from the package is actually referenced.
 542
 543                if XE.Typ = 'e'
 544                  and then Ent /= Curent
 545                  and then (Refno = Nrefs or else
 546                              Ent /= Xrefs.Table (Rnums (Refno + 1)).Ent)
 547                  and then
 548                    not In_Extended_Main_Source_Unit (Ent)
 549                then
 550                   goto Continue;
 551                end if;
 552
 553                --  For private type, get full view type
 554
 555                if Ctyp = '+'
 556                  and then Present (Full_View (XE.Ent))
 557                then
 558                   Ent := Underlying_Type (Ent);
 559
 560                   if Present (Ent) then
 561                      Ctyp := Xref_Entity_Letters (Ekind (Ent));
 562                   end if;
 563                end if;
 564
 565                --  Special exception for Boolean
 566
 567                if Ctyp = 'E' and then Is_Boolean_Type (Ent) then
 568                   Ctyp := 'B';
 569                end if;
 570
 571                --  For variable reference, get corresponding type
 572
 573                if Ctyp = '*' then
 574                   Ent := Etype (XE.Ent);
 575                   Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
 576
 577                   --  If variable is private type, get full view type
 578
 579                   if Ctyp = '+'
 580                     and then Present (Full_View (Etype (XE.Ent)))
 581                   then
 582                      Ent := Underlying_Type (Etype (XE.Ent));
 583
 584                      if Present (Ent) then
 585                         Ctyp := Xref_Entity_Letters (Ekind (Ent));
 586                      end if;
 587                   end if;
 588
 589                   --  Special handling for access parameter
 590
 591                   if Ekind (Etype (XE.Ent)) = E_Anonymous_Access_Type
 592                     and then Is_Formal (XE.Ent)
 593                   then
 594                      Ctyp := 'p';
 595
 596                   --  Special handling for Boolean
 597
 598                   elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
 599                      Ctyp := 'b';
 600                   end if;
 601                end if;
 602
 603                --  Only output reference if interesting type of entity,
 604                --  and suppress self references. Also suppress definitions
 605                --  of body formals (we only treat these as references, and
 606                --  the references were separately recorded).
 607
 608                if Ctyp /= ' '
 609                  and then XE.Loc /= XE.Def
 610                  and then (not Is_Formal (XE.Ent)
 611                             or else No (Spec_Entity (XE.Ent)))
 612                then
 613                   --  Start new Xref section if new xref unit
 614
 615                   if XE.Eun /= Curxu then
 616
 617                      if Write_Info_Col > 1 then
 618                         Write_Info_EOL;
 619                      end if;
 620
 621                      Curxu := XE.Eun;
 622                      Cursrc := Source_Text (Source_Index (Curxu));
 623
 624                      Write_Info_Initiate ('X');
 625                      Write_Info_Char (' ');
 626                      Write_Info_Nat (Dependency_Num (XE.Eun));
 627                      Write_Info_Char (' ');
 628                      Write_Info_Name (Reference_Name (Source_Index (XE.Eun)));
 629                   end if;
 630
 631                   --  Start new Entity line if new entity. Note that we
 632                   --  consider two entities the same if they have the same
 633                   --  name and source location. This causes entities in
 634                   --  instantiations to be treated as though they referred
 635                   --  to the template.
 636
 637                   if No (Curent)
 638                     or else
 639                       (XE.Ent /= Curent
 640                          and then
 641                            (Name_Change (XE.Ent) or else XE.Def /= Curdef))
 642                   then
 643                      Curent := XE.Ent;
 644                      Curdef := XE.Def;
 645
 646                      Get_Unqualified_Name_String (Chars (XE.Ent));
 647                      Curlen := Name_Len;
 648                      Curnam (1 .. Curlen) := Name_Buffer (1 .. Curlen);
 649
 650                      if Write_Info_Col > 1 then
 651                         Write_Info_EOL;
 652                      end if;
 653
 654                      --  Write column number information
 655
 656                      Write_Info_Nat (Int (Get_Logical_Line_Number (XE.Def)));
 657                      Write_Info_Char (Ctyp);
 658                      Write_Info_Nat (Int (Get_Column_Number (XE.Def)));
 659
 660                      --  Write level information
 661
 662                      if Is_Public (Curent) and then not Is_Hidden (Curent) then
 663                         Write_Info_Char ('*');
 664                      else
 665                         Write_Info_Char (' ');
 666                      end if;
 667
 668                      --  Output entity name. We use the occurrence from the
 669                      --  actual source program at the definition point
 670
 671                      P := Original_Location (Sloc (XE.Ent));
 672
 673                      --  Entity is character literal
 674
 675                      if Cursrc (P) = ''' then
 676                         Write_Info_Char (Cursrc (P));
 677                         Write_Info_Char (Cursrc (P + 1));
 678                         Write_Info_Char (Cursrc (P + 2));
 679
 680                      --  Entity is operator symbol
 681
 682                      elsif Cursrc (P) = '"' or else Cursrc (P) = '%' then
 683                         Write_Info_Char (Cursrc (P));
 684
 685                         P2 := P;
 686                         loop
 687                            P2 := P2 + 1;
 688                            Write_Info_Char (Cursrc (P2));
 689                            exit when Cursrc (P2) = Cursrc (P);
 690                         end loop;
 691
 692                      --  Entity is identifier
 693
 694                      else
 695                         loop
 696                            if Is_Start_Of_Wide_Char (Cursrc, P) then
 697                               Scan_Wide (Cursrc, P, WC, Err);
 698                            elsif not Identifier_Char (Cursrc (P)) then
 699                               exit;
 700                            else
 701                               P := P + 1;
 702                            end if;
 703                         end loop;
 704
 705                         for J in
 706                           Original_Location (Sloc (XE.Ent)) .. P - 1
 707                         loop
 708                            Write_Info_Char (Cursrc (J));
 709                         end loop;
 710                      end if;
 711
 712                      --  Output derived entity name if it is available
 713
 714                      Parent_Entry := Get_Parent_Entry (XE.Ent);
 715
 716                      if Parent_Entry /= 0 then
 717                         declare
 718                            XD : Xref_Entry renames Xrefs.Table (Parent_Entry);
 719
 720                         begin
 721                            Write_Info_Char ('<');
 722
 723                            --  Write unit number only if different from the
 724                            --  current one.
 725
 726                            if XE.Eun /= XD.Eun then
 727                               Write_Info_Nat (Dependency_Num (XD.Eun));
 728                               Write_Info_Char ('|');
 729                            end if;
 730
 731                            Write_Info_Nat
 732                              (Int (Get_Logical_Line_Number (XD.Def)));
 733                            Write_Info_Char
 734                              (Xref_Entity_Letters (Ekind (XD.Ent)));
 735                            Write_Info_Nat (Int (Get_Column_Number (XD.Def)));
 736
 737                            Write_Info_Char ('>');
 738                         end;
 739                      end if;
 740
 741                      Curru := Curxu;
 742                      Crloc := No_Location;
 743                   end if;
 744
 745                   --  Output the reference
 746
 747                   if XE.Loc /= No_Location
 748                      and then XE.Loc /= Crloc
 749                   then
 750                      Crloc := XE.Loc;
 751
 752                      --  Start continuation if line full, else blank
 753
 754                      if Write_Info_Col > 72 then
 755                         Write_Info_EOL;
 756                         Write_Info_Initiate ('.');
 757                      end if;
 758
 759                      Write_Info_Char (' ');
 760
 761                      --  Output file number if changed
 762
 763                      if XE.Lun /= Curru then
 764                         Curru := XE.Lun;
 765                         Write_Info_Nat (Dependency_Num (Curru));
 766                         Write_Info_Char ('|');
 767                      end if;
 768
 769                      Write_Info_Nat  (Int (Get_Logical_Line_Number (XE.Loc)));
 770                      Write_Info_Char (XE.Typ);
 771                      Write_Info_Nat  (Int (Get_Column_Number (XE.Loc)));
 772                   end if;
 773                end if;
 774             end;
 775
 776          <<Continue>>
 777             null;
 778          end loop;
 779
 780          Write_Info_EOL;
 781       end Output_Refs;
 782    end Output_References;
 783
 784 end Lib.Xref;