* 41intnam.ads, 42intnam.ads, 4aintnam.ads, 4cintnam.ads,

	4dintnam.ads, 4gintnam.ads, 4hintnam.ads, 4lintnam.ads,
	4mintnam.ads, 4pintnam.ads, 4rintnam.ads, 4sintnam.ads,
	4uintnam.ads, 4vcalend.adb, 4zintnam.ads, 52system.ads,
	5amastop.adb, 5asystem.ads, 5ataprop.adb, 5atpopsp.adb,
	5avxwork.ads, 5bosinte.adb, 5bsystem.ads, 5esystem.ads,
	5fsystem.ads, 5ftaprop.adb, 5ginterr.adb, 5gmastop.adb,
	5gsystem.ads, 5gtaprop.adb, 5gtasinf.adb, 5gtasinf.ads,
	5hparame.ads, 5hsystem.ads, 5htaprop.adb, 5htraceb.adb,
	5itaprop.adb, 5ksystem.ads, 5kvxwork.ads, 5lintman.adb,
	5lsystem.ads, 5mvxwork.ads, 5ninmaop.adb, 5nosinte.ads,
	5ntaprop.adb, 5ointerr.adb, 5omastop.adb, 5oosinte.adb,
	5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5pvxwork.ads,
	5qtaprop.adb, 5sintman.adb, 5ssystem.ads, 5staprop.adb,
	5stpopse.adb, 5svxwork.ads, 5tosinte.ads, 5uintman.adb,
	5vasthan.adb, 5vinmaop.adb, 5vinterr.adb, 5vintman.adb,
	5vmastop.adb, 5vparame.ads, 5vsystem.ads, 5vtaprop.adb,
	5vtpopde.adb, 5wmemory.adb, 5wsystem.ads, 5wtaprop.adb,
	5ysystem.ads, 5zinterr.adb, 5zintman.adb, 5zosinte.adb,
	5zosinte.ads, 5zsystem.ads, 5ztaprop.adb, 6vcpp.adb, 6vcstrea.adb,
	7sintman.adb, 7staprop.adb, 7stpopsp.adb, 9drpc.adb,
	Make-lang.in, Makefile.in, a-caldel.adb, a-comlin.ads,
	a-dynpri.adb, a-except.adb, a-except.ads, a-finali.adb,
	a-ncelfu.ads, a-reatim.adb, a-retide.adb, a-stream.ads,
	a-ststio.adb, a-ststio.ads, a-stwifi.adb, a-tags.adb, a-tasatt.adb,
	a-textio.adb, a-tideau.adb, a-tiflau.adb, a-tigeau.adb,
	a-tigeau.ads, a-tiinau.adb, a-timoau.adb, a-witeio.adb,
	a-wtdeau.adb, a-wtenau.adb, a-wtflau.adb, a-wtgeau.adb,
	a-wtgeau.ads, a-wtinau.adb, a-wtmoau.adb, ada-tree.def, ada-tree.h,
	adaint.c, adaint.h, ali-util.adb, ali.adb, ali.ads, atree.adb,
	atree.ads, atree.h, back_end.adb, bcheck.adb, bindgen.adb,
	bindusg.adb, checks.adb, comperr.adb, config-lang.in, csets.adb,
	csets.ads, cstand.adb, cstreams.c, debug.adb, debug.ads, decl.c,
	einfo.adb, einfo.ads, einfo.h, elists.h, errout.adb, errout.ads,
	eval_fat.adb, exp_aggr.adb, exp_attr.adb, exp_ch11.adb,
	exp_ch12.adb, exp_ch13.adb, exp_ch2.adb, exp_ch3.adb, exp_ch3.ads,
	exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_ch7.ads,
	exp_ch9.adb, exp_ch9.ads, exp_dbug.adb, exp_dbug.ads, exp_disp.ads,
	exp_dist.adb, exp_fixd.adb, exp_intr.adb, exp_pakd.adb,
	exp_prag.adb, exp_strm.adb, exp_util.adb, exp_util.ads,
	expander.adb, expect.c, fe.h, fmap.adb, fmap.ads, fname-uf.adb,
	freeze.adb, frontend.adb, g-awk.adb, g-cgideb.adb, g-comlin.adb,
	g-comlin.ads, g-debpoo.adb, g-dirope.adb, g-dirope.ads,
	g-dyntab.adb, g-expect.adb, g-expect.ads, g-io.ads, g-io_aux.adb,
	g-io_aux.ads, g-locfil.adb, g-locfil.ads, g-os_lib.adb,
	g-os_lib.ads, g-regexp.adb, g-regpat.adb, g-socket.adb,
	g-socket.ads, g-spipat.adb, g-table.adb, g-trasym.adb,
	g-trasym.ads, gigi.h, gmem.c, gnat1drv.adb, gnatbind.adb, gnatbl.c,
	gnatchop.adb, gnatcmd.adb, gnatdll.adb, gnatfind.adb, gnatlbr.adb,
	gnatlink.adb, gnatls.adb, gnatmem.adb, gnatprep.adb, gnatvsn.ads,
	gnatxref.adb, hlo.adb, hostparm.ads, i-cobol.adb, i-cpp.adb,
	i-cstrea.ads, i-cstrin.adb, i-pacdec.adb, i-vxwork.ads,
	impunit.adb, init.c, inline.adb, io-aux.c, layout.adb, lib-load.adb,
	lib-util.adb, lib-writ.adb, lib-writ.ads, lib-xref.adb,
	lib-xref.ads, lib.adb, lib.ads, make.adb, makeusg.adb, mdll.adb,
	memroot.adb, misc.c, mlib-tgt.adb, mlib-utl.adb, mlib-utl.ads,
	mlib.adb, namet.adb, namet.ads, namet.h, nlists.h, nmake.adb,
	nmake.ads, nmake.adt, opt.adb, opt.ads, osint.adb, osint.ads,
	output.adb, output.ads, par-ch2.adb, par-ch3.adb, par-ch5.adb,
	par-prag.adb, par-tchk.adb, par-util.adb, par.adb, prj-attr.adb,
	prj-dect.adb, prj-env.adb, prj-env.ads, prj-nmsc.adb, prj-part.adb,
	prj-proc.adb, prj-strt.adb, prj-tree.adb, prj-tree.ads, prj.adb,
	prj.ads, raise.c, raise.h, repinfo.adb, restrict.adb, restrict.ads,
	rident.ads, rtsfind.adb, rtsfind.ads, s-arit64.adb, s-asthan.adb,
	s-atacco.adb, s-atacco.ads, s-auxdec.adb, s-crc32.adb, s-crc32.ads,
	s-direio.adb, s-fatgen.adb, s-fileio.adb, s-finimp.adb,
	s-gloloc.adb, s-gloloc.ads, s-interr.adb, s-mastop.adb,
	s-mastop.ads, s-memory.adb, s-parame.ads, s-parint.adb,
	s-pooglo.adb, s-pooloc.adb, s-rpc.adb, s-secsta.adb, s-sequio.adb,
	s-shasto.adb, s-soflin.adb, s-soflin.ads, s-stache.adb,
	s-taasde.adb, s-taasde.ads, s-tadeca.adb, s-tadeca.ads,
	s-tadert.adb, s-tadert.ads, s-taenca.adb, s-taenca.ads,
	s-taprob.adb, s-taprop.ads, s-tarest.adb, s-tasdeb.adb,
	s-tasini.adb, s-tasini.ads, s-taskin.adb, s-taskin.ads,
	s-tasque.adb, s-tasque.ads, s-tasren.adb, s-tasren.ads,
	s-tassta.adb, s-tasuti.adb, s-tasuti.ads, s-tataat.adb,
	s-tataat.ads, s-tpoben.adb, s-tpoben.ads, s-tpobop.adb,
	s-tposen.adb, s-tposen.ads, s-traceb.adb, s-traceb.ads,
	s-unstyp.ads, s-widenu.adb, scn-nlit.adb, scn.adb, sem.adb,
	sem_aggr.adb, sem_attr.adb, sem_attr.ads, sem_case.adb,
	sem_ch10.adb, sem_ch11.adb, sem_ch11.ads, sem_ch12.adb,
	sem_ch13.adb, sem_ch13.ads, sem_ch2.adb, sem_ch3.adb, sem_ch3.ads,
	sem_ch4.adb, sem_ch5.adb, sem_ch6.adb, sem_ch6.ads, sem_ch7.adb,
	sem_ch8.adb, sem_ch8.ads, sem_ch9.adb, sem_disp.adb, sem_dist.adb,
	sem_elab.adb, sem_elim.adb, sem_elim.ads, sem_eval.adb,
	sem_intr.adb, sem_mech.adb, sem_prag.adb, sem_res.adb,
	sem_type.adb, sem_util.adb, sem_util.ads, sem_vfpt.adb,
	sem_warn.adb, sinfo.adb, sinfo.ads, sinfo.h, sinput-l.adb,
	sinput-l.ads, sinput.adb, sinput.ads, snames.adb, snames.ads,
	snames.h, sprint.adb, sprint.ads, stringt.adb, stringt.ads,
	stringt.h, style.adb, switch.adb, switch.ads, sysdep.c, system.ads,
	table.adb, targparm.adb, targparm.ads, targtyps.c, tbuild.adb,
	tbuild.ads, tracebak.c, trans.c, tree_gen.adb, tree_io.adb,
	treepr.adb, treepr.ads, treeprs.ads, treeprs.adt, ttypes.ads,
	types.adb, types.ads, types.h, uintp.ads, urealp.ads, usage.adb,
	utils.c, utils2.c, validsw.adb, xnmake.adb, xr_tabls.adb,
	xr_tabls.ads, xref_lib.adb, xref_lib.ads : Merge in ACT changes.

	* 1ssecsta.adb, 1ssecsta.ads, a-chlat9.ads, a-cwila9.ads,
	g-enblsp.adb, g-md5.adb, g-md5.ads, gnatname.adb, gnatname.ads,
	mkdir.c, osint-b.adb, osint-b.ads, osint-c.adb, osint-c.ads,
	osint-l.adb, osint-l.ads, osint-m.adb, osint-m.ads : New files

	* 3lsoccon.ads, 5qparame.ads, 5qvxwork.ads, 5smastop.adb,
	5zparame.ads, gnatmain.adb, gnatmain.ads, gnatpsys.adb : Removed

	* mdllfile.adb, mdllfile.ads, mdlltool.adb, mdlltool.ads : Renamed
	to mdll-fil.ad[bs] and mdll-util.ad[bs]

	* mdll-fil.adb, mdll-fil.ads, mdll-utl.adb, mdll-utl.ads : Renamed
	from mdllfile.ad[bs] and mdlltool.ad[bs]


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@50451 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 199 insertions, 294 deletions

diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index c5f362b83c1..1a130789641 100644
--- a/gcc/ada/exp_dbug.adb
+++ b/gcc/ada/exp_dbug.adb
@@ -8,7 +8,7 @@
 --                                                                          --
 --                            $Revision$
 --                                                                          --
---          Copyright (C) 1996-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1996-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- --
@@ -41,7 +41,7 @@ with Opt;      use Opt;
 with Output;   use Output;
 with Sem_Eval; use Sem_Eval;
 with Sem_Util; use Sem_Util;
-with Sinput;   use Sinput;
+with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
@@ -139,6 +139,19 @@ package body Exp_Dbug is
    --  building this name to realize efficiently that b needs further
    --  qualification.
 
+   --------------------
+   -- Homonym_Suffix --
+   --------------------
+
+   --  The string defined here (and its associated length) is used to
+   --  gather the homonym string that will be appended to Name_Buffer
+   --  when the name is complete. Strip_Suffixes appends to this string
+   --  as does Append_Homonym_Number, and Output_Homonym_Numbers_Suffix
+   --  appends the string to the end of Name_Buffer.
+
+   Homonym_Numbers : String (1 .. 256);
+   Homonym_Len     : Natural := 0;
+
    ----------------------
    -- Local Procedures --
    ----------------------
@@ -150,6 +163,10 @@ package body Exp_Dbug is
    --  Add nnn_ddd to Name_Buffer, where nnn and ddd are integer values of
    --  the normalized numerator and denominator of the given real value.
 
+   procedure Append_Homonym_Number (E : Entity_Id);
+   --  If the entity E has homonyms in the same scope, then make an entry
+   --  in the Homonym_Numbers array, bumping Homonym_Count accordingly.
+
    function Bounds_Match_Size (E : Entity_Id) return  Boolean;
    --  Determine whether the bounds of E match the size of the type. This is
    --  used to determine whether encoding is required for a discrete type.
@@ -171,6 +188,9 @@ package body Exp_Dbug is
    --  sequence in the string S (defined as two underscores
    --  which are preceded and followed by a non-underscore)
 
+   procedure Output_Homonym_Numbers_Suffix;
+   --  If homonym numbers are stored, then output them into Name_Buffer.
+
    procedure Prepend_String_To_Buffer (S : String);
    --  Prepend given string to the contents of the string buffer, updating
    --  the value in Name_Len (i.e. string is added at start of buffer).
@@ -185,12 +205,15 @@ package body Exp_Dbug is
    --  If not already done, replaces the Chars field of the given entity
    --  with the appropriate fully qualified name.
 
-   procedure Strip_BNPE_Suffix (Suffix_Found : in out Boolean);
+   procedure Strip_Suffixes (BNPE_Suffix_Found : in out Boolean);
    --  Given an qualified entity name in Name_Buffer, remove any plain X or
    --  X{nb} qualification suffix. The contents of Name_Buffer is not changed
    --  but Name_Len may be adjusted on return to remove the suffix. If a
-   --  suffix is found and stripped, then Suffix_Found is set to True. If
-   --  no suffix is found, then Suffix_Found is not modified.
+   --  BNPE suffix is found and stripped, then BNPE_Suffix_Found is set to
+   --  True. If no suffix is found, then BNPE_Suffix_Found is not modified.
+   --  This routine also searches for a homonym suffix, and if one is found
+   --  it is also stripped, and the entries are added to the global homonym
+   --  list (Homonym_Numbers) so that they can later be put back.
 
    ------------------------
    -- Add_Real_To_Buffer --
@@ -218,6 +241,57 @@ package body Exp_Dbug is
       end if;
    end Add_Uint_To_Buffer;
 
+   ---------------------------
+   -- Append_Homonym_Number --
+   ---------------------------
+
+   procedure Append_Homonym_Number (E : Entity_Id) is
+
+      procedure Add_Nat_To_H (Nr : Nat);
+      --  Little procedure to append Nr to Homonym_Numbers
+
+      ------------------
+      -- Add_Nat_To_H --
+      ------------------
+
+      procedure Add_Nat_To_H (Nr : Nat) is
+      begin
+         if Nr >= 10 then
+            Add_Nat_To_H (Nr / 10);
+         end if;
+
+         Homonym_Len := Homonym_Len + 1;
+         Homonym_Numbers (Homonym_Len) :=
+           Character'Val (Nr mod 10 + Character'Pos ('0'));
+      end Add_Nat_To_H;
+
+   --  Start of processing for Append_Homonym_Number
+
+   begin
+      if Has_Homonym (E) then
+         declare
+            H  : Entity_Id := Homonym (E);
+            Nr : Nat := 1;
+
+         begin
+            while Present (H) loop
+               if (Scope (H) = Scope (E)) then
+                  Nr := Nr + 1;
+               end if;
+
+               H := Homonym (H);
+            end loop;
+
+            if Homonym_Len > 0 then
+               Homonym_Len := Homonym_Len + 1;
+               Homonym_Numbers (Homonym_Len) := '_';
+            end if;
+
+            Add_Nat_To_H (Nr);
+         end;
+      end if;
+   end Append_Homonym_Number;
+
    -----------------------
    -- Bounds_Match_Size --
    -----------------------
@@ -827,15 +901,6 @@ package body Exp_Dbug is
       Name_Buffer (Name_Len + 1) := ASCII.NUL;
    end Get_Encoded_Name;
 
-   -------------------
-   -- Get_Entity_Id --
-   -------------------
-
-   function Get_Entity_Id (External_Name : String) return Entity_Id is
-   begin
-      return Empty;
-   end Get_Entity_Id;
-
    -----------------------
    -- Get_External_Name --
    -----------------------
@@ -867,9 +932,13 @@ package body Exp_Dbug is
          then
             Get_Qualified_Name_And_Append (Scope (Entity));
             Add_Str_To_Name_Buffer ("__");
+            Get_Name_String_And_Append (Chars (Entity));
+            Append_Homonym_Number (Entity);
+
+         else
+            Get_Name_String_And_Append (Chars (Entity));
          end if;
 
-         Get_Name_String_And_Append (Chars (Entity));
       end Get_Qualified_Name_And_Append;
 
    --  Start of processing for Get_External_Name
@@ -934,32 +1003,6 @@ package body Exp_Dbug is
          end if;
 
          Get_Qualified_Name_And_Append (E);
-
-         if Has_Homonym (E) then
-            declare
-               H  : Entity_Id := Homonym (E);
-               Nr : Nat := 1;
-
-            begin
-               while Present (H) loop
-                  if (Scope (H) = Scope (E)) then
-                     Nr := Nr + 1;
-                  end if;
-
-                  H := Homonym (H);
-               end loop;
-
-               if Nr > 1 then
-                  if No_Dollar_In_Label then
-                     Add_Str_To_Name_Buffer ("__");
-                  else
-                     Add_Char_To_Name_Buffer ('$');
-                  end if;
-
-                  Add_Nat_To_Name_Buffer (Nr);
-               end if;
-            end;
-         end if;
       end if;
 
       Name_Buffer (Name_Len + 1) := ASCII.Nul;
@@ -1103,6 +1146,46 @@ package body Exp_Dbug is
       return Name_Find;
    end Make_Packed_Array_Type_Name;
 
+   -----------------------------------
+   -- Output_Homonym_Numbers_Suffix --
+   -----------------------------------
+
+   procedure Output_Homonym_Numbers_Suffix is
+      J : Natural;
+
+   begin
+      if Homonym_Len > 0 then
+
+         --  Check for all 1's, in which case we do not output
+
+         J := 1;
+         loop
+            exit when Homonym_Numbers (J) /= '1';
+
+            --  If we reached end of string we do not output
+
+            if J = Homonym_Len then
+               Homonym_Len := 0;
+               return;
+            end if;
+
+            exit when Homonym_Numbers (J + 1) /= '_';
+            J := J + 2;
+         end loop;
+
+         --  If we exit the loop then suffix must be output
+
+         if No_Dollar_In_Label then
+            Add_Str_To_Name_Buffer ("__");
+         else
+            Add_Char_To_Name_Buffer ('$');
+         end if;
+
+         Add_Str_To_Name_Buffer (Homonym_Numbers (1 .. Homonym_Len));
+         Homonym_Len := 0;
+      end if;
+   end Output_Homonym_Numbers_Suffix;
+
    ------------------------------
    -- Prepend_String_To_Buffer --
    ------------------------------
@@ -1240,12 +1323,17 @@ package body Exp_Dbug is
          Discard : Boolean := False;
 
       begin
+         --  Ignore empty entry (can happen in error cases)
+
+         if No (E) then
+            return;
+
          --  If this we are qualifying entities local to a generic
          --  instance, use the name of the original instantiation,
          --  not that of the anonymous subprogram in the wrapper
          --  package, so that gdb doesn't have to know about these.
 
-         if Is_Generic_Instance (E)
+         elsif Is_Generic_Instance (E)
            and then Is_Subprogram (E)
            and then not Comes_From_Source (E)
            and then not Is_Compilation_Unit (Scope (E))
@@ -1258,7 +1346,7 @@ package body Exp_Dbug is
 
          if Has_Fully_Qualified_Name (E) then
             Get_Name_String (Chars (E));
-            Strip_BNPE_Suffix (Discard);
+            Strip_Suffixes (Discard);
             Full_Qualify_Name (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
             Full_Qualify_Len := Name_Len;
             Set_Has_Fully_Qualified_Name (Ent);
@@ -1285,6 +1373,7 @@ package body Exp_Dbug is
               (Full_Qualify_Len + 1 .. Full_Qualify_Len + Name_Len) :=
                 Name_Buffer (1 .. Name_Len);
             Full_Qualify_Len := Full_Qualify_Len + Name_Len;
+            Append_Homonym_Number (E);
          end if;
 
          if Is_BNPE (E) then
@@ -1367,7 +1456,7 @@ package body Exp_Dbug is
 
          if Has_Qualified_Name (E) then
             Get_Name_String_And_Append (Chars (E));
-            Strip_BNPE_Suffix (BNPE_Suffix_Needed);
+            Strip_Suffixes (BNPE_Suffix_Needed);
 
             --  If the top level name we are adding is itself fully
             --  qualified, then that means that the name that we are
@@ -1395,6 +1484,8 @@ package body Exp_Dbug is
             if Is_BNPE (E) then
                BNPE_Suffix_Needed := True;
             end if;
+
+            Append_Homonym_Number (E);
          end if;
       end Set_Entity_Name;
 
@@ -1409,6 +1500,7 @@ package body Exp_Dbug is
       elsif Ekind (Ent) = E_Enumeration_Literal
         and then Present (Debug_Renaming_Link (Ent))
       then
+         Name_Len := 0;
          Set_Entity_Name (Debug_Renaming_Link (Ent));
          Get_Name_String (Chars (Ent));
          Prepend_String_To_Buffer
@@ -1436,6 +1528,8 @@ package body Exp_Dbug is
 
       --  Fall through with a fully qualified name in Name_Buffer/Name_Len
 
+      Output_Homonym_Numbers_Suffix;
+
       --  Add body-nested package suffix if required
 
       if BNPE_Suffix_Needed
@@ -1474,250 +1568,6 @@ package body Exp_Dbug is
       Name_Qualify_Units.Append (N);
    end Qualify_Entity_Names;
 
-   --------------------------------
-   -- Save_Unitname_And_Use_List --
-   --------------------------------
-
-   procedure Save_Unitname_And_Use_List
-     (Main_Unit_Node : Node_Id;
-      Main_Kind      : Node_Kind)
-   is
-      INITIAL_NAME_LENGTH : constant := 1024;
-
-      Item       : Node_Id;
-      Pack_Name  : Node_Id;
-
-      Unit_Spec  : Node_Id := 0;
-      Unit_Body  : Node_Id := 0;
-
-      Main_Name : String_Id;
-      --  Fully qualified name of Main Unit
-
-      Unit_Name : String_Id;
-      --  Name of unit specified in a Use clause
-
-      Spec_Unit_Index : Source_File_Index;
-      Spec_File_Name  : File_Name_Type := No_File;
-
-      Body_Unit_Index : Source_File_Index;
-      Body_File_Name : File_Name_Type := No_File;
-
-      type String_Ptr is access all String;
-
-      Spec_File_Name_Str : String_Ptr;
-      Body_File_Name_Str : String_Ptr;
-
-      type Label is record
-        Label_Name  : String_Ptr;
-        Name_Length : Integer;
-        Pos         : Integer;
-      end record;
-
-      Spec_Label : Label;
-      Body_Label : Label;
-
-      procedure Initialize  (L : out Label);
-      --  Initialize label
-
-      procedure Append      (L : in out Label; Ch : Character);
-      --  Append character to label
-
-      procedure Append      (L : in out Label; Str : String);
-      --  Append string to label
-
-      procedure Append_Name (L : in out Label; Unit_Name : String_Id);
-      --  Append name to label
-
-      function  Sufficient_Space
-        (L         : Label;
-         Unit_Name : String_Id)
-         return      Boolean;
-      --  Does sufficient space exist to append another name?
-
-      procedure Append (L : in out Label; Str : String) is
-      begin
-         L.Label_Name (L.Pos + 1 .. L.Pos + Str'Length) := Str;
-         L.Pos := L.Pos + Str'Length;
-      end Append;
-
-      procedure Append (L : in out Label; Ch : Character) is
-      begin
-         L.Pos := L.Pos + 1;
-         L.Label_Name (L.Pos) := Ch;
-      end Append;
-
-      procedure Append_Name (L : in out Label; Unit_Name : String_Id) is
-         Char         : Char_Code;
-         Upper_Offset : constant := Character'Pos ('a') - Character'Pos ('A');
-
-      begin
-         for J in 1 .. String_Length (Unit_Name) loop
-            Char := Get_String_Char (Unit_Name, J);
-
-            if Character'Val (Char) = '.' then
-               Append (L, "__");
-            elsif Character'Val (Char) in 'A' .. 'Z' then
-               Append (L, Character'Val (Char + Upper_Offset));
-            elsif Char /= 0 then
-               Append (L, Character'Val (Char));
-            end if;
-         end loop;
-      end Append_Name;
-
-      procedure Initialize (L : out Label) is
-      begin
-         L.Name_Length := INITIAL_NAME_LENGTH;
-         L.Pos := 0;
-         L.Label_Name := new String (1 .. L.Name_Length);
-      end Initialize;
-
-      function  Sufficient_Space
-        (L         : Label;
-         Unit_Name : String_Id)
-         return      Boolean
-      is
-         Len : Integer := Integer (String_Length (Unit_Name)) + 1;
-
-      begin
-         for J in 1 .. String_Length (Unit_Name) loop
-            if Character'Val (Get_String_Char (Unit_Name, J)) = '.' then
-               Len := Len + 1;
-            end if;
-         end loop;
-
-         return L.Pos + Len < L.Name_Length;
-      end Sufficient_Space;
-
-   --  Start of processing for Save_Unitname_And_Use_List
-
-   begin
-      Initialize (Spec_Label);
-      Initialize (Body_Label);
-
-      case Main_Kind is
-         when N_Package_Declaration =>
-            Main_Name := Full_Qualified_Name
-              (Defining_Unit_Name (Specification (Unit (Main_Unit_Node))));
-            Unit_Spec := Main_Unit_Node;
-            Append (Spec_Label, "_LPS__");
-            Append (Body_Label, "_LPB__");
-
-         when N_Package_Body =>
-            Unit_Spec := Corresponding_Spec (Unit (Main_Unit_Node));
-            Unit_Body := Main_Unit_Node;
-            Main_Name := Full_Qualified_Name (Unit_Spec);
-            Append (Spec_Label, "_LPS__");
-            Append (Body_Label, "_LPB__");
-
-         when N_Subprogram_Body =>
-            Unit_Body := Main_Unit_Node;
-
-            if Present (Corresponding_Spec (Unit (Main_Unit_Node))) then
-               Unit_Spec := Corresponding_Spec (Unit (Main_Unit_Node));
-               Main_Name := Full_Qualified_Name
-                 (Corresponding_Spec (Unit (Main_Unit_Node)));
-            else
-               Main_Name := Full_Qualified_Name
-                 (Defining_Unit_Name (Specification (Unit (Main_Unit_Node))));
-            end if;
-
-            Append (Spec_Label, "_LSS__");
-            Append (Body_Label, "_LSB__");
-
-         when others =>
-            return;
-      end case;
-
-      Append_Name (Spec_Label, Main_Name);
-      Append_Name (Body_Label, Main_Name);
-
-      --  If we have a body, process it first
-
-      if Present (Unit_Body) then
-
-         Item := First (Context_Items (Unit_Body));
-
-         while Present (Item) loop
-            if Nkind (Item) = N_Use_Package_Clause then
-               Pack_Name := First (Names (Item));
-               while Present (Pack_Name) loop
-                  Unit_Name := Full_Qualified_Name (Entity (Pack_Name));
-
-                  if Sufficient_Space (Body_Label, Unit_Name) then
-                     Append (Body_Label, '$');
-                     Append_Name (Body_Label, Unit_Name);
-                  end if;
-
-                  Pack_Name := Next (Pack_Name);
-               end loop;
-            end if;
-
-            Item := Next (Item);
-         end loop;
-      end if;
-
-      while Present (Unit_Spec) and then
-        Nkind (Unit_Spec) /= N_Compilation_Unit
-      loop
-         Unit_Spec := Parent (Unit_Spec);
-      end loop;
-
-      if Present (Unit_Spec) then
-
-         Item := First (Context_Items (Unit_Spec));
-
-         while Present (Item) loop
-            if Nkind (Item) = N_Use_Package_Clause then
-               Pack_Name := First (Names (Item));
-               while Present (Pack_Name) loop
-                  Unit_Name := Full_Qualified_Name (Entity (Pack_Name));
-
-                  if Sufficient_Space (Spec_Label, Unit_Name) then
-                     Append (Spec_Label, '$');
-                     Append_Name (Spec_Label, Unit_Name);
-                  end if;
-
-                  if Sufficient_Space (Body_Label, Unit_Name) then
-                     Append (Body_Label, '$');
-                     Append_Name (Body_Label, Unit_Name);
-                  end if;
-
-                  Pack_Name := Next (Pack_Name);
-               end loop;
-            end if;
-
-            Item := Next (Item);
-         end loop;
-      end if;
-
-      if Present (Unit_Spec) then
-         Append (Spec_Label, Character'Val (0));
-         Spec_Unit_Index := Source_Index (Get_Cunit_Unit_Number (Unit_Spec));
-         Spec_File_Name := Full_File_Name (Spec_Unit_Index);
-         Get_Name_String (Spec_File_Name);
-         Spec_File_Name_Str := new String (1 .. Name_Len + 1);
-         Spec_File_Name_Str (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
-         Spec_File_Name_Str (Name_Len + 1) := Character'Val (0);
-         Spec_Filename := Spec_File_Name_Str (1)'Unrestricted_Access;
-         Spec_Context_List :=
-           Spec_Label.Label_Name.all (1)'Unrestricted_Access;
-      end if;
-
-      if Present (Unit_Body) then
-         Append (Body_Label, Character'Val (0));
-         Body_Unit_Index := Source_Index (Get_Cunit_Unit_Number (Unit_Body));
-         Body_File_Name := Full_File_Name (Body_Unit_Index);
-         Get_Name_String (Body_File_Name);
-         Body_File_Name_Str := new String (1 .. Name_Len + 1);
-         Body_File_Name_Str (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
-         Body_File_Name_Str (Name_Len + 1) := Character'Val (0);
-         Body_Filename := Body_File_Name_Str (1)'Unrestricted_Access;
-         Body_Context_List :=
-           Body_Label.Label_Name.all (1)'Unrestricted_Access;
-      end if;
-
-   end Save_Unitname_And_Use_List;
-
    ---------
    -- SEq --
    ---------
@@ -1737,21 +1587,76 @@ package body Exp_Dbug is
         (Hindex'First + Hindex (CDN_Hash (S.all) mod Hindex'Range_Length));
    end SHash;
 
-   -----------------------
-   -- Strip_BNPE_Suffix --
-   -----------------------
+   --------------------
+   -- Strip_Suffixes --
+   --------------------
+
+   procedure Strip_Suffixes (BNPE_Suffix_Found : in out Boolean) is
+      SL : Natural;
 
-   procedure Strip_BNPE_Suffix (Suffix_Found : in out Boolean) is
    begin
+      --  Search for and strip BNPE suffix
+
       for J in reverse 2 .. Name_Len loop
          if Name_Buffer (J) = 'X' then
             Name_Len := J - 1;
-            Suffix_Found := True;
+            BNPE_Suffix_Found := True;
             exit;
          end if;
 
          exit when Name_Buffer (J) /= 'b' and then Name_Buffer (J) /= 'n';
       end loop;
-   end Strip_BNPE_Suffix;
+
+      --  Search for and strip homonym numbers suffix
+
+      --  Case of __ used for homonym numbers suffix
+
+      if No_Dollar_In_Label then
+         for J in reverse 2 .. Name_Len - 2 loop
+            if Name_Buffer (J) = '_'
+              and then Name_Buffer (J + 1) = '_'
+            then
+               if Name_Buffer (J + 2) in '0' .. '9' then
+                  if Homonym_Len > 0 then
+                     Homonym_Len := Homonym_Len + 1;
+                     Homonym_Numbers (Homonym_Len) := '-';
+                  end if;
+
+                  SL := Name_Len - (J + 1);
+
+                  Homonym_Numbers (Homonym_Len + 1 .. Homonym_Len + SL) :=
+                    Name_Buffer (J + 2 .. Name_Len);
+                  Name_Len := J - 1;
+                  Homonym_Len := Homonym_Len + SL;
+               end if;
+
+               exit;
+            end if;
+         end loop;
+
+      --  Case of $ used for homonym numbers suffix
+
+      else
+         for J in reverse 2 .. Name_Len - 1 loop
+            if Name_Buffer (J) = '$' then
+               if Name_Buffer (J + 1) in '0' .. '9' then
+                  if Homonym_Len > 0 then
+                     Homonym_Len := Homonym_Len + 1;
+                     Homonym_Numbers (Homonym_Len) := '-';
+                  end if;
+
+                  SL := Name_Len - J;
+
+                  Homonym_Numbers (Homonym_Len + 1 .. Homonym_Len + SL) :=
+                    Name_Buffer (J + 1 .. Name_Len);
+                  Name_Len := J - 1;
+                  Homonym_Len := Homonym_Len + SL;
+               end if;
+
+               exit;
+            end if;
+         end loop;
+      end if;
+   end Strip_Suffixes;
 
 end Exp_Dbug;