OSDN Git Service

c49866f4af2c9529b838e258f4fdbc792ac9a726
[pf3gnuchains/gcc-fork.git] / 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                                  Left := '<';
702                                  Right := '>';
703
704                               --  If non-derived ptr, get designated type
705
706                               elsif Is_Access_Type (Tref) then
707                                  Tref := Designated_Type (Tref);
708                                  Left := '(';
709                                  Right := ')';
710
711                               --  For other non-derived base types, nothing
712
713                               else
714                                  exit;
715                               end if;
716
717                            --  For a subtype, go to ancestor subtype
718
719                            else
720                               Tref := Ancestor_Subtype (Tref);
721
722                               --  If no ancestor subtype, go to base type
723
724                               if No (Tref) then
725                                  Tref := Base_Type (Sav);
726                               end if;
727                            end if;
728
729                         --  For objects, functions, enum literals,
730                         --  just get type from Etype field.
731
732                         elsif Is_Object (Tref)
733                           or else Ekind (Tref) = E_Enumeration_Literal
734                           or else Ekind (Tref) = E_Function
735                           or else Ekind (Tref) = E_Operator
736                         then
737                            Tref := Etype (Tref);
738
739                         --  For anything else, exit
740
741                         else
742                            exit;
743                         end if;
744
745                         --  Exit if no type reference, or we are stuck in
746                         --  some loop trying to find the type reference.
747
748                         exit when No (Tref) or else Tref = Sav;
749
750                         --  Case of standard entity, output name
751
752                         if Sloc (Tref) = Standard_Location then
753
754                            --  For now, output only if special -gnatdM flag set
755
756                            exit when not Debug_Flag_MM;
757
758                            Write_Info_Char (Left);
759                            Write_Info_Name (Chars (Tref));
760                            Write_Info_Char (Right);
761                            exit;
762
763                         --  Case of source entity, output location
764
765                         elsif Comes_From_Source (Tref) then
766
767                            --  For now, output only derived type entries
768                            --  unless we have special debug flag -gnatdM
769
770                            exit when not (Debug_Flag_MM or else Left = '<');
771
772                            --  Do not output type reference if referenced
773                            --  entity is not in the main unit and is itself
774                            --  not referenced, since otherwise the reference
775                            --  will dangle.
776
777                            exit when not Referenced (Tref)
778                              and then not In_Extended_Main_Source_Unit (Tref);
779
780                            --  Output the reference
781
782                            Write_Info_Char (Left);
783                            Trunit := Get_Source_Unit (Sloc (Tref));
784
785                            if Trunit /= Curxu then
786                               Write_Info_Nat (Dependency_Num (Trunit));
787                               Write_Info_Char ('|');
788                            end if;
789
790                            Write_Info_Nat
791                              (Int (Get_Logical_Line_Number (Sloc (Tref))));
792                            Write_Info_Char
793                              (Xref_Entity_Letters (Ekind (Tref)));
794                            Write_Info_Nat
795                              (Int (Get_Column_Number (Sloc (Tref))));
796                            Write_Info_Char (Right);
797                            exit;
798
799                         --  If non-standard, non-source entity, keep looking
800
801                         else
802                            null;
803                         end if;
804                      end loop;
805
806                      Curru := Curxu;
807                      Crloc := No_Location;
808                   end if;
809
810                   --  Output the reference
811
812                   if XE.Loc /= No_Location
813                      and then XE.Loc /= Crloc
814                   then
815                      Crloc := XE.Loc;
816
817                      --  Start continuation if line full, else blank
818
819                      if Write_Info_Col > 72 then
820                         Write_Info_EOL;
821                         Write_Info_Initiate ('.');
822                      end if;
823
824                      Write_Info_Char (' ');
825
826                      --  Output file number if changed
827
828                      if XE.Lun /= Curru then
829                         Curru := XE.Lun;
830                         Write_Info_Nat (Dependency_Num (Curru));
831                         Write_Info_Char ('|');
832                      end if;
833
834                      Write_Info_Nat  (Int (Get_Logical_Line_Number (XE.Loc)));
835                      Write_Info_Char (XE.Typ);
836                      Write_Info_Nat  (Int (Get_Column_Number (XE.Loc)));
837                   end if;
838                end if;
839             end;
840
841          <<Continue>>
842             null;
843          end loop;
844
845          Write_Info_EOL;
846       end Output_Refs;
847    end Output_References;
848
849 end Lib.Xref;