with Alloc; use Alloc;
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt;
with Output; use Output;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Table;
with Urealp; use Urealp;
package body Exp_Dbug is
package Name_Qualify_Units is new Table.Table (
Table_Component_Type => Node_Id,
Table_Index_Type => Nat,
Table_Low_Bound => 1,
Table_Initial => Alloc.Name_Qualify_Units_Initial,
Table_Increment => Alloc.Name_Qualify_Units_Increment,
Table_Name => "Name_Qualify_Units");
Homonym_Numbers : String (1 .. 256);
Homonym_Len : Natural := 0;
procedure Add_Uint_To_Buffer (U : Uint);
procedure Add_Real_To_Buffer (U : Ureal);
procedure Append_Homonym_Number (E : Entity_Id);
function Bounds_Match_Size (E : Entity_Id) return Boolean;
procedure Output_Homonym_Numbers_Suffix;
procedure Prepend_String_To_Buffer (S : String);
procedure Prepend_Uint_To_Buffer (U : Uint);
procedure Qualify_Entity_Name (Ent : Entity_Id);
procedure Strip_Suffixes (BNPE_Suffix_Found : in out Boolean);
procedure Add_Real_To_Buffer (U : Ureal) is
begin
Add_Uint_To_Buffer (Norm_Num (U));
Add_Str_To_Name_Buffer ("_");
Add_Uint_To_Buffer (Norm_Den (U));
end Add_Real_To_Buffer;
procedure Add_Uint_To_Buffer (U : Uint) is
begin
if U < 0 then
Add_Uint_To_Buffer (-U);
Add_Char_To_Name_Buffer ('m');
else
UI_Image (U, Decimal);
Add_Str_To_Name_Buffer (UI_Image_Buffer (1 .. UI_Image_Length));
end if;
end Add_Uint_To_Buffer;
procedure Append_Homonym_Number (E : Entity_Id) is
procedure Add_Nat_To_H (Nr : Nat);
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;
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;
function Bounds_Match_Size (E : Entity_Id) return Boolean is
Siz : Uint;
begin
if not Is_OK_Static_Subtype (E) then
return False;
elsif Is_Integer_Type (E)
and then Subtypes_Statically_Match (E, Base_Type (E))
then
return True;
else
declare
Umark : constant Uintp.Save_Mark := Uintp.Mark;
Result : Boolean;
begin
if Esize (E) <= 8 then
Siz := Uint_8;
elsif Esize (E) <= 16 then
Siz := Uint_16;
elsif Esize (E) <= 32 then
Siz := Uint_32;
else
Siz := Uint_64;
end if;
if Is_Modular_Integer_Type (E) or else Is_Enumeration_Type (E) then
Result :=
Expr_Rep_Value (Type_Low_Bound (E)) = 0
and then
2 ** Siz - Expr_Rep_Value (Type_High_Bound (E)) = 1;
else
Result :=
Expr_Rep_Value (Type_Low_Bound (E)) + 2 ** (Siz - 1) = 0
and then
2 ** (Siz - 1) - Expr_Rep_Value (Type_High_Bound (E)) = 1;
end if;
Release (Umark);
return Result;
end;
end if;
end Bounds_Match_Size;
function Debug_Renaming_Declaration (N : Node_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (N);
Ent : constant Node_Id := Defining_Entity (N);
Nam : constant Node_Id := Name (N);
Rnm : Name_Id;
Ren : Node_Id;
Lit : Entity_Id;
Typ : Entity_Id;
Res : Node_Id;
Def : Entity_Id;
function Output_Subscript (N : Node_Id; S : String) return Boolean;
function Output_Subscript (N : Node_Id; S : String) return Boolean is
begin
if Compile_Time_Known_Value (N) then
Prepend_Uint_To_Buffer (Expr_Value (N));
elsif Nkind (N) = N_Identifier
and then Scope (Entity (N)) = Scope (Ent)
and then Ekind (Entity (N)) = E_Constant
then
Prepend_String_To_Buffer (Get_Name_String (Chars (Entity (N))));
else
return False;
end if;
Prepend_String_To_Buffer (S);
return True;
end Output_Subscript;
begin
if not Comes_From_Source (N)
and then not Needs_Debug_Info (Ent)
then
return Empty;
end if;
Get_Name_String (Chars (Ent));
case Nkind (N) is
when N_Object_Renaming_Declaration =>
Add_Str_To_Name_Buffer ("___XR");
when N_Exception_Renaming_Declaration =>
Add_Str_To_Name_Buffer ("___XRE");
when N_Package_Renaming_Declaration =>
Add_Str_To_Name_Buffer ("___XRP");
if Is_Child_Unit (Ent) then
Prepend_String_To_Buffer ("__");
Prepend_String_To_Buffer
(Get_Name_String (Chars (Scope (Ent))));
end if;
when others =>
return Empty;
end case;
Rnm := Name_Find;
Name_Len := 0;
Ren := Nam;
loop
case Nkind (Ren) is
when N_Identifier =>
exit;
when N_Expanded_Name =>
exit;
when N_Selected_Component =>
Prepend_String_To_Buffer
(Get_Name_String (Chars (Selector_Name (Ren))));
Prepend_String_To_Buffer ("XR");
Ren := Prefix (Ren);
when N_Indexed_Component =>
declare
X : Node_Id := Last (Expressions (Ren));
begin
while Present (X) loop
if not Output_Subscript (X, "XS") then
Set_Materialize_Entity (Ent);
return Empty;
end if;
Prev (X);
end loop;
end;
Ren := Prefix (Ren);
when N_Slice =>
Typ := Etype (First_Index (Etype (Nam)));
if not Output_Subscript (Type_High_Bound (Typ), "XS") then
Set_Materialize_Entity (Ent);
return Empty;
end if;
if not Output_Subscript (Type_Low_Bound (Typ), "XL") then
Set_Materialize_Entity (Ent);
return Empty;
end if;
Ren := Prefix (Ren);
when N_Explicit_Dereference =>
Prepend_String_To_Buffer ("XA");
Ren := Prefix (Ren);
when others =>
Set_Materialize_Entity (Ent);
return Empty;
end case;
end loop;
Prepend_String_To_Buffer ("___XE");
Lit := Make_Defining_Identifier (Loc, Chars => Name_Enter);
Set_Debug_Renaming_Link (Lit, Entity (Ren));
Def := Make_Defining_Identifier (Loc, Chars => Rnm);
Res :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Def,
Type_Definition =>
Make_Enumeration_Type_Definition (Loc,
Literals => New_List (Lit)));
Set_Needs_Debug_Info (Def);
Set_Needs_Debug_Info (Lit);
Set_Discard_Names (Defining_Identifier (Res));
return Res;
exception
when others =>
return Make_Null_Statement (Loc);
end Debug_Renaming_Declaration;
procedure Get_Encoded_Name (E : Entity_Id) is
Has_Suffix : Boolean;
begin
Get_Name_String (Chars (E));
if not Is_Type (E)
or else (Is_Enumeration_Type (E)
and then E = Base_Type (E))
or else (Name_Len >= 3 and then
Name_Buffer (Name_Len - 2 .. Name_Len) = "_XR")
or else (Name_Len >= 4 and then
(Name_Buffer (Name_Len - 3 .. Name_Len) = "_XRE"
or else
Name_Buffer (Name_Len - 3 .. Name_Len) = "_XRP"))
then
Name_Buffer (Name_Len + 1) := ASCII.Nul;
return;
end if;
Has_Suffix := True;
if Is_Fixed_Point_Type (E) then
Get_External_Name_With_Suffix (E, "XF_");
Add_Real_To_Buffer (Delta_Value (E));
if Small_Value (E) /= Delta_Value (E) then
Add_Str_To_Name_Buffer ("_");
Add_Real_To_Buffer (Small_Value (E));
end if;
elsif Vax_Float (E) then
if Digits_Value (Base_Type (E)) = 6 then
Get_External_Name_With_Suffix (E, "XFF");
elsif Digits_Value (Base_Type (E)) = 9 then
Get_External_Name_With_Suffix (E, "XFF");
else
pragma Assert (Digits_Value (Base_Type (E)) = 15);
Get_External_Name_With_Suffix (E, "XFG");
end if;
elsif Is_Discrete_Type (E)
and then not Bounds_Match_Size (E)
then
if Has_Biased_Representation (E) then
Get_External_Name_With_Suffix (E, "XB");
else
Get_External_Name_With_Suffix (E, "XD");
end if;
declare
Lo : constant Node_Id := Type_Low_Bound (E);
Hi : constant Node_Id := Type_High_Bound (E);
Lo_Con : constant Boolean := Compile_Time_Known_Value (Lo);
Hi_Con : constant Boolean := Compile_Time_Known_Value (Hi);
Lo_Discr : constant Boolean :=
Nkind (Lo) = N_Identifier
and then
Ekind (Entity (Lo)) = E_Discriminant;
Hi_Discr : constant Boolean :=
Nkind (Hi) = N_Identifier
and then
Ekind (Entity (Hi)) = E_Discriminant;
Lo_Encode : constant Boolean := Lo_Con or Lo_Discr;
Hi_Encode : constant Boolean := Hi_Con or Hi_Discr;
begin
if Lo_Encode or Hi_Encode then
if Lo_Encode then
if Hi_Encode then
Add_Str_To_Name_Buffer ("LU_");
else
Add_Str_To_Name_Buffer ("L_");
end if;
else
Add_Str_To_Name_Buffer ("U_");
end if;
if Lo_Con then
Add_Uint_To_Buffer (Expr_Rep_Value (Lo));
elsif Lo_Discr then
Get_Name_String_And_Append (Chars (Entity (Lo)));
end if;
if Lo_Encode and Hi_Encode then
Add_Str_To_Name_Buffer ("__");
end if;
if Hi_Con then
Add_Uint_To_Buffer (Expr_Rep_Value (Hi));
elsif Hi_Discr then
Get_Name_String_And_Append (Chars (Entity (Hi)));
end if;
end if;
end;
else
Has_Suffix := False;
Get_External_Name (E, Has_Suffix);
end if;
if Debug_Flag_B and then Has_Suffix then
Write_Str ("**** type ");
Write_Name (Chars (E));
Write_Str (" is encoded as ");
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Eol;
end if;
Name_Buffer (Name_Len + 1) := ASCII.NUL;
end Get_Encoded_Name;
procedure Get_External_Name (Entity : Entity_Id; Has_Suffix : Boolean) is
E : Entity_Id := Entity;
Kind : Entity_Kind;
procedure Get_Qualified_Name_And_Append (Entity : Entity_Id);
procedure Get_Qualified_Name_And_Append (Entity : Entity_Id) is
begin
if Present (Scope (Scope (Entity)))
and then not Has_Fully_Qualified_Name (Entity)
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;
end Get_Qualified_Name_And_Append;
begin
Name_Len := 0;
if Nkind (E) = N_Defining_Program_Unit_Name then
E := Defining_Identifier (Entity);
end if;
Kind := Ekind (E);
if (Kind = E_Procedure or else
Kind = E_Function or else
Kind = E_Constant or else
Kind = E_Variable or else
Kind = E_Exception)
and then Present (Interface_Name (E))
and then No (Address_Clause (E))
and then not Has_Suffix
then
Add_String_To_Name_Buffer (Strval (Interface_Name (E)));
else
if Is_Subprogram (E)
and then (Is_Compilation_Unit (E) or Is_Child_Unit (E))
and then not Has_Suffix
then
Add_Str_To_Name_Buffer ("_ada_");
end if;
if Is_Generic_Instance (E)
and then Is_Subprogram (E)
and then not Is_Compilation_Unit (Scope (E))
and then (Ekind (Scope (E)) = E_Package
or else
Ekind (Scope (E)) = E_Package_Body)
and then Present (Related_Instance (Scope (E)))
then
E := Related_Instance (Scope (E));
end if;
Get_Qualified_Name_And_Append (E);
end if;
Name_Buffer (Name_Len + 1) := ASCII.Nul;
end Get_External_Name;
procedure Get_External_Name_With_Suffix
(Entity : Entity_Id;
Suffix : String)
is
Has_Suffix : constant Boolean := (Suffix /= "");
use type Opt.Operating_Mode_Type;
begin
if Opt.Operating_Mode /= Opt.Generate_Code then
return;
end if;
Get_External_Name (Entity, Has_Suffix);
if Has_Suffix then
Add_Str_To_Name_Buffer ("___");
Add_Str_To_Name_Buffer (Suffix);
Name_Buffer (Name_Len + 1) := ASCII.Nul;
end if;
end Get_External_Name_With_Suffix;
procedure Get_Variant_Encoding (V : Node_Id) is
Choice : Node_Id;
procedure Choice_Val (Typ : Character; Choice : Node_Id);
procedure Choice_Val (Typ : Character; Choice : Node_Id) is
begin
Add_Char_To_Name_Buffer (Typ);
if Nkind (Choice) = N_Integer_Literal then
Add_Uint_To_Buffer (Intval (Choice));
elsif Nkind (Choice) = N_Character_Literal
and then No (Entity (Choice))
then
Add_Uint_To_Buffer (Char_Literal_Value (Choice));
else
declare
Ent : constant Entity_Id := Entity (Choice);
begin
if Ekind (Ent) = E_Enumeration_Literal then
Add_Uint_To_Buffer (Enumeration_Rep (Ent));
else
pragma Assert (Ekind (Ent) = E_Constant);
Choice_Val (Typ, Constant_Value (Ent));
end if;
end;
end if;
end Choice_Val;
begin
Name_Len := 0;
Choice := First (Discrete_Choices (V));
while Present (Choice) loop
if Nkind (Choice) = N_Others_Choice then
Add_Char_To_Name_Buffer ('O');
elsif Nkind (Choice) = N_Range then
Choice_Val ('R', Low_Bound (Choice));
Choice_Val ('T', High_Bound (Choice));
elsif Is_Entity_Name (Choice)
and then Is_Type (Entity (Choice))
then
Choice_Val ('R', Type_Low_Bound (Entity (Choice)));
Choice_Val ('T', Type_High_Bound (Entity (Choice)));
elsif Nkind (Choice) = N_Subtype_Indication then
declare
Rang : constant Node_Id :=
Range_Expression (Constraint (Choice));
begin
Choice_Val ('R', Low_Bound (Rang));
Choice_Val ('T', High_Bound (Rang));
end;
else
Choice_Val ('S', Choice);
end if;
Next (Choice);
end loop;
Name_Buffer (Name_Len + 1) := ASCII.NUL;
if Debug_Flag_B then
declare
VP : constant Node_Id := Parent (V); CL : constant Node_Id := Parent (VP); RD : constant Node_Id := Parent (CL); FT : constant Node_Id := Parent (RD);
begin
Write_Str ("**** variant for type ");
Write_Name (Chars (Defining_Identifier (FT)));
Write_Str (" is encoded as ");
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Eol;
end;
end if;
end Get_Variant_Encoding;
function Make_Packed_Array_Type_Name
(Typ : Entity_Id;
Csize : Uint)
return Name_Id
is
begin
Get_Name_String (Chars (Typ));
Add_Str_To_Name_Buffer ("___XP");
Add_Uint_To_Buffer (Csize);
return Name_Find;
end Make_Packed_Array_Type_Name;
procedure Output_Homonym_Numbers_Suffix is
J : Natural;
begin
if Homonym_Len > 0 then
J := 1;
loop
exit when Homonym_Numbers (J) /= '1';
if J = Homonym_Len then
Homonym_Len := 0;
return;
end if;
exit when Homonym_Numbers (J + 1) /= '_';
J := J + 2;
end loop;
Add_Str_To_Name_Buffer ("__");
Add_Str_To_Name_Buffer (Homonym_Numbers (1 .. Homonym_Len));
Homonym_Len := 0;
end if;
end Output_Homonym_Numbers_Suffix;
procedure Prepend_String_To_Buffer (S : String) is
N : constant Integer := S'Length;
begin
Name_Buffer (1 + N .. Name_Len + N) := Name_Buffer (1 .. Name_Len);
Name_Buffer (1 .. N) := S;
Name_Len := Name_Len + N;
end Prepend_String_To_Buffer;
procedure Prepend_Uint_To_Buffer (U : Uint) is
begin
if U < 0 then
Prepend_String_To_Buffer ("m");
Prepend_Uint_To_Buffer (-U);
else
UI_Image (U, Decimal);
Prepend_String_To_Buffer (UI_Image_Buffer (1 .. UI_Image_Length));
end if;
end Prepend_Uint_To_Buffer;
procedure Qualify_All_Entity_Names is
E : Entity_Id;
Ent : Entity_Id;
begin
for J in Name_Qualify_Units.First .. Name_Qualify_Units.Last loop
E := Defining_Entity (Name_Qualify_Units.Table (J));
Qualify_Entity_Name (E);
Ent := First_Entity (E);
while Present (Ent) loop
Qualify_Entity_Name (Ent);
Next_Entity (Ent);
exit when Ent = E;
end loop;
end loop;
end Qualify_All_Entity_Names;
procedure Qualify_Entity_Name (Ent : Entity_Id) is
Full_Qualify_Name : String (1 .. Name_Buffer'Length);
Full_Qualify_Len : Natural := 0;
procedure Fully_Qualify_Name (E : Entity_Id);
function Is_BNPE (S : Entity_Id) return Boolean;
function Qualify_Needed (S : Entity_Id) return Boolean;
procedure Set_BNPE_Suffix (E : Entity_Id);
procedure Set_Entity_Name (E : Entity_Id);
BNPE_Suffix_Needed : Boolean := False;
Save_Chars : constant Name_Id := Chars (Ent);
procedure Fully_Qualify_Name (E : Entity_Id) is
Discard : Boolean := False;
begin
if No (E) then
return;
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))
then
Fully_Qualify_Name (Related_Instance (Scope (E)));
return;
end if;
if Has_Fully_Qualified_Name (E) then
Get_Name_String (Chars (E));
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);
else
if Scope (E) = Standard_Standard then
Set_Has_Fully_Qualified_Name (Ent);
else
Fully_Qualify_Name (Scope (E));
Full_Qualify_Name (Full_Qualify_Len + 1) := '_';
Full_Qualify_Name (Full_Qualify_Len + 2) := '_';
Full_Qualify_Len := Full_Qualify_Len + 2;
end if;
if Has_Qualified_Name (E) then
Get_Unqualified_Name_String (Chars (E));
else
Get_Name_String (Chars (E));
end if;
if (Name_Buffer (1) = 'B' or else Name_Buffer (1) = 'L')
and then (not Debug_Flag_VV)
and then Full_Qualify_Len > 2
and then Chars (Ent) /= Name_uClean
then
Full_Qualify_Len := Full_Qualify_Len - 2;
else
Full_Qualify_Name
(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;
end if;
if Is_BNPE (E) then
BNPE_Suffix_Needed := True;
end if;
end Fully_Qualify_Name;
function Is_BNPE (S : Entity_Id) return Boolean is
begin
return
Ekind (S) = E_Package
and then Is_Package_Body_Entity (S);
end Is_BNPE;
function Qualify_Needed (S : Entity_Id) return Boolean is
begin
if S = Standard_Standard then
Set_Has_Fully_Qualified_Name (Ent, True);
return False;
else
return
Is_Subprogram (Ent)
or else
Ekind (Ent) = E_Subprogram_Body
or else
(Ekind (S) /= E_Block
and then not Is_Dynamic_Scope (S));
end if;
end Qualify_Needed;
procedure Set_BNPE_Suffix (E : Entity_Id) is
S : constant Entity_Id := Scope (E);
begin
if Qualify_Needed (S) then
Set_BNPE_Suffix (S);
if Is_BNPE (E) then
Add_Char_To_Name_Buffer ('b');
else
Add_Char_To_Name_Buffer ('n');
end if;
else
Add_Char_To_Name_Buffer ('X');
end if;
end Set_BNPE_Suffix;
procedure Set_Entity_Name (E : Entity_Id) is
S : constant Entity_Id := Scope (E);
begin
if Has_Qualified_Name (E) then
Get_Name_String_And_Append (Chars (E));
Strip_Suffixes (BNPE_Suffix_Needed);
if Has_Fully_Qualified_Name (E) then
Set_Has_Fully_Qualified_Name (Ent);
end if;
else
if Qualify_Needed (S) then
Set_Entity_Name (S);
Add_Str_To_Name_Buffer ("__");
end if;
Get_Name_String_And_Append (Chars (E));
if Is_BNPE (E) then
BNPE_Suffix_Needed := True;
end if;
Append_Homonym_Number (E);
end if;
end Set_Entity_Name;
begin
if Has_Qualified_Name (Ent) then
return;
elsif Ekind (Ent) = E_Enumeration_Literal
and then Present (Debug_Renaming_Link (Ent))
then
Name_Len := 0;
Qualify_Entity_Name (Debug_Renaming_Link (Ent));
Get_Name_String (Chars (Ent));
Prepend_String_To_Buffer
(Get_Name_String (Chars (Debug_Renaming_Link (Ent))));
Set_Chars (Ent, Name_Enter);
Set_Has_Qualified_Name (Ent);
return;
elsif Is_Subprogram (Ent)
or else Ekind (Ent) = E_Subprogram_Body
or else Is_Type (Ent)
then
Fully_Qualify_Name (Ent);
Name_Len := Full_Qualify_Len;
Name_Buffer (1 .. Name_Len) := Full_Qualify_Name (1 .. Name_Len);
elsif Qualify_Needed (Scope (Ent)) then
Name_Len := 0;
Set_Entity_Name (Ent);
else
Set_Has_Qualified_Name (Ent);
return;
end if;
Output_Homonym_Numbers_Suffix;
if BNPE_Suffix_Needed
and then Ekind (Ent) /= E_Enumeration_Literal
then
Set_BNPE_Suffix (Ent);
while Name_Buffer (Name_Len) = 'n' loop
Name_Len := Name_Len - 1;
end loop;
Name_Len := Name_Len - 1;
end if;
Set_Chars (Ent, Name_Enter);
Set_Has_Qualified_Name (Ent);
if Debug_Flag_BB then
Write_Str ("*** ");
Write_Name (Save_Chars);
Write_Str (" qualified as ");
Write_Name (Chars (Ent));
Write_Eol;
end if;
end Qualify_Entity_Name;
procedure Qualify_Entity_Names (N : Node_Id) is
begin
Name_Qualify_Units.Append (N);
end Qualify_Entity_Names;
procedure Strip_Suffixes (BNPE_Suffix_Found : in out Boolean) is
SL : Natural;
begin
for J in reverse 2 .. Name_Len loop
if Name_Buffer (J) = 'X' then
Name_Len := J - 1;
BNPE_Suffix_Found := True;
exit;
end if;
exit when Name_Buffer (J) /= 'b' and then Name_Buffer (J) /= 'n';
end loop;
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;
end Strip_Suffixes;
end Exp_Dbug;