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