path: root/gcc/ada/lib-xref.adb

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             L I B . X R E F                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision$
--                                                                          --
--          Copyright (C) 1998-2002, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with Atree;    use Atree;
with Csets;    use Csets;
with Errout;   use Errout;
with Lib.Util; use Lib.Util;
with Namet;    use Namet;
with Opt;      use Opt;
with Sinfo;    use Sinfo;
with Sinput;   use Sinput;
with Stand;    use Stand;
with Table;    use Table;
with Widechar; use Widechar;

with GNAT.Heap_Sort_A;

package body Lib.Xref is

   ------------------
   -- Declarations --
   ------------------

   --  The Xref table is used to record references. The Loc field is set
   --  to No_Location for a definition entry.

   subtype Xref_Entry_Number is Int;

   type Xref_Entry is record
      Ent : Entity_Id;
      --  Entity referenced (E parameter to Generate_Reference)

      Def : Source_Ptr;
      --  Original source location for entity being referenced. Note that
      --  these values are used only during the output process, they are
      --  not set when the entries are originally built. This is because
      --  private entities can be swapped when the initial call is made.

      Loc : Source_Ptr;
      --  Location of reference (Original_Location (Sloc field of N parameter
      --  to Generate_Reference). Set to No_Location for the case of a
      --  defining occurrence.

      Typ : Character;
      --  Reference type (Typ param to Generate_Reference)

      Eun : Unit_Number_Type;
      --  Unit number corresponding to Ent

      Lun : Unit_Number_Type;
      --  Unit number corresponding to Loc. Value is undefined and not
      --  referenced if Loc is set to No_Location.

   end record;

   package Xrefs is new Table.Table (
     Table_Component_Type => Xref_Entry,
     Table_Index_Type     => Xref_Entry_Number,
     Table_Low_Bound      => 1,
     Table_Initial        => Alloc.Xrefs_Initial,
     Table_Increment      => Alloc.Xrefs_Increment,
     Table_Name           => "Xrefs");

   -------------------------
   -- Generate_Definition --
   -------------------------

   procedure Generate_Definition (E : Entity_Id) is
      Loc  : Source_Ptr;
      Indx : Nat;

   begin
      pragma Assert (Nkind (E) in N_Entity);

      --  Note that we do not test Xref_Entity_Letters here. It is too
      --  early to do so, since we are often called before the entity
      --  is fully constructed, so that the Ekind is still E_Void.

      if Opt.Xref_Active

         --  Definition must come from source

         and then Comes_From_Source (E)

         --  And must have a reasonable source location that is not
         --  within an instance (all entities in instances are ignored)

         and then Sloc (E) > No_Location
         and then Instantiation_Location (Sloc (E)) = No_Location

         --  And must be a non-internal name from the main source unit

         and then In_Extended_Main_Source_Unit (E)
         and then not Is_Internal_Name (Chars (E))
      then
         Xrefs.Increment_Last;
         Indx := Xrefs.Last;
         Loc  := Original_Location (Sloc (E));

         Xrefs.Table (Indx).Ent := E;
         Xrefs.Table (Indx).Loc := No_Location;
         Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
         Xrefs.Table (Indx).Lun := No_Unit;
      end if;
   end Generate_Definition;

   ---------------------------------
   -- Generate_Operator_Reference --
   ---------------------------------

   procedure Generate_Operator_Reference (N : Node_Id) is
   begin
      if not In_Extended_Main_Source_Unit (N) then
         return;
      end if;

      --  If the operator is not a Standard operator, then we generate
      --  a real reference to the user defined operator.

      if Sloc (Entity (N)) /= Standard_Location then
         Generate_Reference (Entity (N), N);

         --  A reference to an implicit inequality operator is a also a
         --  reference to the user-defined equality.

         if Nkind (N) = N_Op_Ne
           and then not Comes_From_Source (Entity (N))
           and then Present (Corresponding_Equality (Entity (N)))
         then
            Generate_Reference (Corresponding_Equality (Entity (N)), N);
         end if;

      --  For the case of Standard operators, we mark the result type
      --  as referenced. This ensures that in the case where we are
      --  using a derived operator, we mark an entity of the unit that
      --  implicitly defines this operator as used. Otherwise we may
      --  think that no entity of the unit is used. The actual entity
      --  marked as referenced is the first subtype, which is the user
      --  defined entity that is relevant.

      else
         if Nkind (N) = N_Op_Eq
           or else Nkind (N) = N_Op_Ne
           or else Nkind (N) = N_Op_Le
           or else Nkind (N) = N_Op_Lt
           or else Nkind (N) = N_Op_Ge
           or else Nkind (N) = N_Op_Gt
         then
            Set_Referenced (First_Subtype (Etype (Right_Opnd (N))));
         else
            Set_Referenced (First_Subtype (Etype (N)));
         end if;
      end if;
   end Generate_Operator_Reference;

   ------------------------
   -- Generate_Reference --
   ------------------------

   procedure Generate_Reference
     (E       : Entity_Id;
      N       : Node_Id;
      Typ     : Character := 'r';
      Set_Ref : Boolean   := True;
      Force   : Boolean   := False)
   is
      Indx : Nat;
      Nod  : Node_Id;
      Ref  : Source_Ptr;
      Def  : Source_Ptr;
      Ent  : Entity_Id;

   begin
      pragma Assert (Nkind (E) in N_Entity);

      --  Never collect references if not in main source unit. However,
      --  we omit this test if Typ is 'e', since these entries are
      --  really structural, and it is useful to have them in units
      --  that reference packages as well as units that define packages.
      --  We also omit the test for the case of 'p' since we want to
      --  include inherited primitive operations from other packages.

      if not In_Extended_Main_Source_Unit (N)
        and then Typ /= 'e'
        and then Typ /= 'p'
      then
         return;
      end if;

      --  For reference type p, then entity must be in main source unit

      if Typ = 'p' and then not In_Extended_Main_Source_Unit (E) then
         return;
      end if;

      --  Unless the reference is forced, we ignore references where
      --  the reference itself does not come from Source.

      if not Force and then not Comes_From_Source (N) then
         return;
      end if;

      --  Deal with setting entity as referenced, unless suppressed.
      --  Note that we still do Set_Referenced on entities that do not
      --  come from source. This situation arises when we have a source
      --  reference to a derived operation, where the derived operation
      --  itself does not come from source, but we still want to mark it
      --  as referenced, since we really are referencing an entity in the
      --  corresponding package (this avoids incorrect complaints that the
      --  package contains no referenced entities).

      if Set_Ref then
         Set_Referenced (E);

         --  Check for pragma unreferenced given

         if Has_Pragma_Unreferenced (E) then

            --  A reference as a named parameter in a call does not count
            --  as a violation of pragma Unreferenced for this purpose.

            if Nkind (N) = N_Identifier
              and then Nkind (Parent (N)) = N_Parameter_Association
              and then Selector_Name (Parent (N)) = N
            then
               null;

            --  Here we issue the warning, since this is a real reference

            else
               Error_Msg_NE ("?pragma Unreferenced given for&", N, E);
            end if;
         end if;

         --  If this is a subprogram instance, mark as well the internal
         --  subprogram in the wrapper package, which may be a visible
         --  compilation unit.

         if Is_Overloadable (E)
           and then Is_Generic_Instance (E)
           and then Present (Alias (E))
         then
            Set_Referenced (Alias (E));
         end if;
      end if;

      --  Generate reference if all conditions are met:

      if
         --  Cross referencing must be active

         Opt.Xref_Active

         --  The entity must be one for which we collect references

         and then Xref_Entity_Letters (Ekind (E)) /= ' '

         --  Both Sloc values must be set to something sensible

         and then Sloc (E) > No_Location
         and then Sloc (N) > No_Location

         --  We ignore references from within an instance

         and then Instantiation_Location (Sloc (N)) = No_Location

         --  Ignore dummy references

        and then Typ /= ' '
      then
         if Nkind (N) = N_Identifier
              or else
            Nkind (N) = N_Defining_Identifier
              or else
            Nkind (N) in N_Op
              or else
            Nkind (N) = N_Defining_Operator_Symbol
              or else
            (Nkind (N) = N_Character_Literal
              and then Sloc (Entity (N)) /= Standard_Location)
              or else
            Nkind (N) = N_Defining_Character_Literal
         then
            Nod := N;

         elsif Nkind (N) = N_Expanded_Name
                 or else
               Nkind (N) = N_Selected_Component
         then
            Nod := Selector_Name (N);

         else
            return;
         end if;

         --  Normal case of source entity comes from source

         if Comes_From_Source (E) then
            Ent := E;

         --  Entity does not come from source, but is a derived subprogram
         --  and the derived subprogram comes from source, in which case
         --  the reference is to this parent subprogram.

         elsif Is_Overloadable (E)
           and then Present (Alias (E))
           and then Comes_From_Source (Alias (E))
         then
            Ent := Alias (E);

         --  Ignore reference to any other source that is not from source

         else
            return;
         end if;

         --  Record reference to entity

         Ref := Original_Location (Sloc (Nod));
         Def := Original_Location (Sloc (Ent));

         Xrefs.Increment_Last;
         Indx := Xrefs.Last;

         Xrefs.Table (Indx).Loc := Ref;
         Xrefs.Table (Indx).Typ := Typ;
         Xrefs.Table (Indx).Eun := Get_Source_Unit (Def);
         Xrefs.Table (Indx).Lun := Get_Source_Unit (Ref);
         Xrefs.Table (Indx).Ent := Ent;
      end if;
   end Generate_Reference;

   -----------------------
   -- Output_References --
   -----------------------

   procedure Output_References is
      Nrefs : constant Nat := Xrefs.Last;

      Rnums : array (0 .. Nrefs) of Nat;
      --  This array contains numbers of references in the Xrefs table. This
      --  list is sorted in output order. The extra 0'th entry is convenient
      --  for the call to sort. When we sort the table, we move these entries
      --  around, but we do not move the original table entries.

      function Lt (Op1, Op2 : Natural) return Boolean;
      --  Comparison function for Sort call

      procedure Move (From : Natural; To : Natural);
      --  Move procedure for Sort call

      function Lt (Op1, Op2 : Natural) return Boolean is
         T1 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op1)));
         T2 : Xref_Entry renames Xrefs.Table (Rnums (Nat (Op2)));

      begin
         --  First test. If entity is in different unit, sort by unit

         if T1.Eun /= T2.Eun then
            return Dependency_Num (T1.Eun) < Dependency_Num (T2.Eun);

         --  Second test, within same unit, sort by entity Sloc

         elsif T1.Def /= T2.Def then
            return T1.Def < T2.Def;

         --  Third test, sort definitions ahead of references

         elsif T1.Loc = No_Location then
            return True;

         elsif T2.Loc = No_Location then
            return False;

         --  Fourth test, for same entity, sort by reference location unit

         elsif T1.Lun /= T2.Lun then
            return Dependency_Num (T1.Lun) < Dependency_Num (T2.Lun);

         --  Fifth test order of location within referencing unit

         elsif T1.Loc /= T2.Loc then
            return T1.Loc < T2.Loc;

         --  Finally, for two locations at the same address, we prefer
         --  the one that does NOT have the type 'r' so that a modification
         --  or extension takes preference, when there are more than one
         --  reference at the same location.

         else
            return T2.Typ = 'r';
         end if;
      end Lt;

      procedure Move (From : Natural; To : Natural) is
      begin
         Rnums (Nat (To)) := Rnums (Nat (From));
      end Move;

   --  Start of processing for Output_References

   begin
      if not Opt.Xref_Active then
         return;
      end if;

      --  Capture the definition Sloc values. We delay doing this till now,
      --  since at the time the reference or definition is made, private
      --  types may be swapped, and the Sloc value may be incorrect. We
      --  also set up the pointer vector for the sort.

      for J in 1 .. Nrefs loop
         Rnums (J) := J;
         Xrefs.Table (J).Def :=
           Original_Location (Sloc (Xrefs.Table (J).Ent));
      end loop;

      --  Sort the references

      GNAT.Heap_Sort_A.Sort
        (Integer (Nrefs),
         Move'Unrestricted_Access,
         Lt'Unrestricted_Access);

      --  Now output the references

      Output_Refs : declare

         Curxu : Unit_Number_Type;
         --  Current xref unit

         Curru : Unit_Number_Type;
         --  Current reference unit for one entity

         Cursrc : Source_Buffer_Ptr;
         --  Current xref unit source text

         Curent : Entity_Id;
         --  Current entity

         Curnam : String (1 .. Name_Buffer'Length);
         Curlen : Natural;
         --  Simple name and length of current entity

         Curdef : Source_Ptr;
         --  Original source location for current entity

         Crloc : Source_Ptr;
         --  Current reference location

         Ctyp : Character;
         --  Entity type character

         Tref : Entity_Id;
         --  Type reference

         Rref : Node_Id;
         --  Renaming reference

         Trunit : Unit_Number_Type;
         --  Unit number for type reference

         function Name_Change (X : Entity_Id) return Boolean;
         --  Determines if entity X has a different simple name from Curent

         -----------------
         -- Name_Change --
         -----------------

         function Name_Change (X : Entity_Id) return Boolean is
         begin
            Get_Unqualified_Name_String (Chars (X));

            if Name_Len /= Curlen then
               return True;

            else
               return Name_Buffer (1 .. Curlen) /= Curnam (1 .. Curlen);
            end if;
         end Name_Change;

      --  Start of processing for Output_Refs

      begin
         Curxu  := No_Unit;
         Curent := Empty;
         Curdef := No_Location;
         Curru  := No_Unit;
         Crloc  := No_Location;

         for Refno in 1 .. Nrefs loop

            Output_One_Ref : declare

               XE : Xref_Entry renames Xrefs.Table (Rnums (Refno));
               --  The current entry to be accessed

               P : Source_Ptr;
               --  Used to index into source buffer to get entity name

               P2  : Source_Ptr;
               WC  : Char_Code;
               Err : Boolean;
               Ent : Entity_Id;
               Sav : Entity_Id;

               Left  : Character;
               Right : Character;
               --  Used for {} or <> for type reference

               procedure Output_Instantiation_Refs (Loc : Source_Ptr);
               --  Recursive procedure to output instantiation references for
               --  the given source ptr in [file|line[...]] form. No output
               --  if the given location is not a generic template reference.

               -------------------------------
               -- Output_Instantiation_Refs --
               -------------------------------

               procedure Output_Instantiation_Refs (Loc : Source_Ptr) is
                  Iloc : constant Source_Ptr := Instantiation_Location (Loc);
                  Lun  : Unit_Number_Type;

               begin
                  --  Nothing to do if this is not an instantiation

                  if Iloc = No_Location then
                     return;
                  end if;

                  --  Output instantiation reference

                  Write_Info_Char ('[');
                  Lun := Get_Source_Unit (Iloc);

                  if Lun /= Curru then
                     Curru := XE.Lun;
                     Write_Info_Nat (Dependency_Num (Curru));
                     Write_Info_Char ('|');
                  end if;

                  Write_Info_Nat (Int (Get_Logical_Line_Number (Iloc)));

                  --  Recursive call to get nested instantiations

                  Output_Instantiation_Refs (Iloc);

                  --  Output final ] after call to get proper nesting

                  Write_Info_Char (']');
                  return;
               end Output_Instantiation_Refs;

            --  Start of processing for Output_One_Ref

            begin
               Ent := XE.Ent;
               Ctyp := Xref_Entity_Letters (Ekind (Ent));

               --  Skip reference if it is the only reference to an entity,
               --  and it is an end-line reference, and the entity is not in
               --  the current extended source. This prevents junk entries
               --  consisting only of packages with end lines, where no
               --  entity from the package is actually referenced.

               if XE.Typ = 'e'
                 and then Ent /= Curent
                 and then (Refno = Nrefs or else
                             Ent /= Xrefs.Table (Rnums (Refno + 1)).Ent)
                 and then
                   not In_Extended_Main_Source_Unit (Ent)
               then
                  goto Continue;
               end if;

               --  For private type, get full view type

               if Ctyp = '+'
                 and then Present (Full_View (XE.Ent))
               then
                  Ent := Underlying_Type (Ent);

                  if Present (Ent) then
                     Ctyp := Xref_Entity_Letters (Ekind (Ent));
                  end if;
               end if;

               --  Special exception for Boolean

               if Ctyp = 'E' and then Is_Boolean_Type (Ent) then
                  Ctyp := 'B';
               end if;

               --  For variable reference, get corresponding type

               if Ctyp = '*' then
                  Ent := Etype (XE.Ent);
                  Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));

                  --  If variable is private type, get full view type

                  if Ctyp = '+'
                    and then Present (Full_View (Etype (XE.Ent)))
                  then
                     Ent := Underlying_Type (Etype (XE.Ent));

                     if Present (Ent) then
                        Ctyp := Xref_Entity_Letters (Ekind (Ent));
                     end if;
                  end if;

                  --  Special handling for access parameter

                  if Ekind (Etype (XE.Ent)) = E_Anonymous_Access_Type
                    and then Is_Formal (XE.Ent)
                  then
                     Ctyp := 'p';

                  --  Special handling for Boolean

                  elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
                     Ctyp := 'b';
                  end if;
               end if;

               --  Only output reference if interesting type of entity,
               --  and suppress self references. Also suppress definitions
               --  of body formals (we only treat these as references, and
               --  the references were separately recorded).

               if Ctyp /= ' '
                 and then XE.Loc /= XE.Def
                 and then (not Is_Formal (XE.Ent)
                            or else No (Spec_Entity (XE.Ent)))
               then
                  --  Start new Xref section if new xref unit

                  if XE.Eun /= Curxu then

                     if Write_Info_Col > 1 then
                        Write_Info_EOL;
                     end if;

                     Curxu := XE.Eun;
                     Cursrc := Source_Text (Source_Index (Curxu));

                     Write_Info_Initiate ('X');
                     Write_Info_Char (' ');
                     Write_Info_Nat (Dependency_Num (XE.Eun));
                     Write_Info_Char (' ');
                     Write_Info_Name (Reference_Name (Source_Index (XE.Eun)));
                  end if;

                  --  Start new Entity line if new entity. Note that we
                  --  consider two entities the same if they have the same
                  --  name and source location. This causes entities in
                  --  instantiations to be treated as though they referred
                  --  to the template.

                  if No (Curent)
                    or else
                      (XE.Ent /= Curent
                         and then
                           (Name_Change (XE.Ent) or else XE.Def /= Curdef))
                  then
                     Curent := XE.Ent;
                     Curdef := XE.Def;

                     Get_Unqualified_Name_String (Chars (XE.Ent));
                     Curlen := Name_Len;
                     Curnam (1 .. Curlen) := Name_Buffer (1 .. Curlen);

                     if Write_Info_Col > 1 then
                        Write_Info_EOL;
                     end if;

                     --  Write column number information

                     Write_Info_Nat (Int (Get_Logical_Line_Number (XE.Def)));
                     Write_Info_Char (Ctyp);
                     Write_Info_Nat (Int (Get_Column_Number (XE.Def)));

                     --  Write level information

                     if Is_Public (Curent) and then not Is_Hidden (Curent) then
                        Write_Info_Char ('*');
                     else
                        Write_Info_Char (' ');
                     end if;

                     --  Output entity name. We use the occurrence from the
                     --  actual source program at the definition point

                     P := Original_Location (Sloc (XE.Ent));

                     --  Entity is character literal

                     if Cursrc (P) = ''' then
                        Write_Info_Char (Cursrc (P));
                        Write_Info_Char (Cursrc (P + 1));
                        Write_Info_Char (Cursrc (P + 2));

                     --  Entity is operator symbol

                     elsif Cursrc (P) = '"' or else Cursrc (P) = '%' then
                        Write_Info_Char (Cursrc (P));

                        P2 := P;
                        loop
                           P2 := P2 + 1;
                           Write_Info_Char (Cursrc (P2));
                           exit when Cursrc (P2) = Cursrc (P);
                        end loop;

                     --  Entity is identifier

                     else
                        loop
                           if Is_Start_Of_Wide_Char (Cursrc, P) then
                              Scan_Wide (Cursrc, P, WC, Err);
                           elsif not Identifier_Char (Cursrc (P)) then
                              exit;
                           else
                              P := P + 1;
                           end if;
                        end loop;

                        for J in
                          Original_Location (Sloc (XE.Ent)) .. P - 1
                        loop
                           Write_Info_Char (Cursrc (J));
                        end loop;
                     end if;

                     --  See if we have a renaming reference

                     if Is_Object (XE.Ent)
                       and then Present (Renamed_Object (XE.Ent))
                     then
                        Rref := Renamed_Object (XE.Ent);

                     elsif Is_Overloadable (XE.Ent)
                       and then Nkind (Parent (Declaration_Node (XE.Ent))) =
                                            N_Subprogram_Renaming_Declaration
                     then
                        Rref := Name (Parent (Declaration_Node (XE.Ent)));

                     elsif Ekind (XE.Ent) = E_Package
                       and then Nkind (Declaration_Node (XE.Ent)) =
                                         N_Package_Renaming_Declaration
                     then
                        Rref := Name (Declaration_Node (XE.Ent));

                     else
                        Rref := Empty;
                     end if;

                     if Present (Rref) then
                        if Nkind (Rref) = N_Expanded_Name then
                           Rref := Selector_Name (Rref);
                        end if;

                        if Nkind (Rref) /= N_Identifier then
                           Rref := Empty;
                        end if;
                     end if;

                     --  Write out renaming reference if we have one

                     if Present (Rref) then
                        Write_Info_Char ('=');
                        Write_Info_Nat
                          (Int (Get_Logical_Line_Number (Sloc (Rref))));
                        Write_Info_Char (':');
                        Write_Info_Nat
                          (Int (Get_Column_Number (Sloc (Rref))));
                     end if;

                     --  See if we have a type reference

                     Tref := XE.Ent;
                     Left := '{';
                     Right := '}';

                     loop
                        Sav := Tref;

                        --  Processing for types

                        if Is_Type (Tref) then

                           --  Case of base type

                           if Base_Type (Tref) = Tref then

                              --  If derived, then get first subtype

                              if Tref /= Etype (Tref) then
                                 Tref := First_Subtype (Etype (Tref));

                                 --  Set brackets for derived type, but don't
                                 --  override pointer case since the fact that
                                 --  something is a pointer is more important

                                 if Left /= '(' then
                                    Left := '<';
                                    Right := '>';
                                 end if;

                              --  If non-derived ptr, get designated type

                              elsif Is_Access_Type (Tref) then
                                 Tref := Designated_Type (Tref);
                                 Left := '(';
                                 Right := ')';

                              --  For other non-derived base types, nothing

                              else
                                 exit;
                              end if;

                           --  For a subtype, go to ancestor subtype

                           else
                              Tref := Ancestor_Subtype (Tref);

                              --  If no ancestor subtype, go to base type

                              if No (Tref) then
                                 Tref := Base_Type (Sav);
                              end if;
                           end if;

                        --  For objects, functions, enum literals,
                        --  just get type from Etype field.

                        elsif Is_Object (Tref)
                          or else Ekind (Tref) = E_Enumeration_Literal
                          or else Ekind (Tref) = E_Function
                          or else Ekind (Tref) = E_Operator
                        then
                           Tref := Etype (Tref);

                        --  For anything else, exit

                        else
                           exit;
                        end if;

                        --  Exit if no type reference, or we are stuck in
                        --  some loop trying to find the type reference, or
                        --  if the type is standard void type (the latter is
                        --  an implementation artifact that should not show
                        --  up in the generated cross-references).

                        exit when No (Tref)
                          or else Tref = Sav
                          or else Tref = Standard_Void_Type;

                        --  Here we have a type reference to output

                        --  Case of standard entity, output name

                        if Sloc (Tref) = Standard_Location then
                           Write_Info_Char (Left);
                           Write_Info_Name (Chars (Tref));
                           Write_Info_Char (Right);
                           exit;

                        --  Case of source entity, output location

                        elsif Comes_From_Source (Tref) then

                           --  Do not output type reference if referenced
                           --  entity is not in the main unit and is itself
                           --  not referenced, since otherwise the reference
                           --  will dangle.

                           exit when not Referenced (Tref)
                             and then not In_Extended_Main_Source_Unit (Tref);

                           --  Output the reference

                           Write_Info_Char (Left);
                           Trunit := Get_Source_Unit (Sloc (Tref));

                           if Trunit /= Curxu then
                              Write_Info_Nat (Dependency_Num (Trunit));
                              Write_Info_Char ('|');
                           end if;

                           Write_Info_Nat
                             (Int (Get_Logical_Line_Number (Sloc (Tref))));

                           declare
                              Ent  : Entity_Id := Tref;
                              Kind : constant Entity_Kind := Ekind (Ent);
                              Ctyp : Character := Xref_Entity_Letters (Kind);

                           begin
                              if Ctyp = '+'
                                and then Present (Full_View (Ent))
                              then
                                 Ent := Underlying_Type (Ent);

                                 if Present (Ent) then
                                    Ctyp := Xref_Entity_Letters (Ekind (Ent));
                                 end if;
                              end if;

                              Write_Info_Char (Ctyp);
                           end;

                           Write_Info_Nat
                             (Int (Get_Column_Number (Sloc (Tref))));
                           Write_Info_Char (Right);
                           exit;

                        --  If non-standard, non-source entity, keep looking

                        else
                           null;
                        end if;
                     end loop;

                     --  End of processing for entity output

                     Curru := Curxu;
                     Crloc := No_Location;
                  end if;

                  --  Output the reference

                  if XE.Loc /= No_Location
                     and then XE.Loc /= Crloc
                  then
                     Crloc := XE.Loc;

                     --  Start continuation if line full, else blank

                     if Write_Info_Col > 72 then
                        Write_Info_EOL;
                        Write_Info_Initiate ('.');
                     end if;

                     Write_Info_Char (' ');

                     --  Output file number if changed

                     if XE.Lun /= Curru then
                        Curru := XE.Lun;
                        Write_Info_Nat (Dependency_Num (Curru));
                        Write_Info_Char ('|');
                     end if;

                     Write_Info_Nat  (Int (Get_Logical_Line_Number (XE.Loc)));
                     Write_Info_Char (XE.Typ);
                     Write_Info_Nat  (Int (Get_Column_Number (XE.Loc)));

                     Output_Instantiation_Refs (Sloc (XE.Ent));
                  end if;
               end if;
            end Output_One_Ref;

         <<Continue>>
            null;
         end loop;

         Write_Info_EOL;
      end Output_Refs;
   end Output_References;

end Lib.Xref;