@@ -900,12 +900,12 @@ package body Atree is
end Check_Vanishing_Fields;
Nkind_Offset : constant Field_Offset :=
- Node_Field_Descriptors (Nkind).Offset;
+ Node_Field_Descriptors (F_Nkind).Offset;
procedure Set_Node_Kind_Type is new Set_8_Bit_Field (Node_Kind) with Inline;
procedure Init_Nkind (N : Node_Id; Val : Node_Kind) is
- pragma Assert (Field_Is_Initial_Zero (N, Nkind));
+ pragma Assert (Field_Is_Initial_Zero (N, F_Nkind));
begin
Set_Node_Kind_Type (N, Nkind_Offset, Val);
end Init_Nkind;
@@ -953,7 +953,7 @@ package body Atree is
end Mutate_Nkind;
Ekind_Offset : constant Field_Offset :=
- Entity_Field_Descriptors (Ekind).Offset;
+ Entity_Field_Descriptors (F_Ekind).Offset;
procedure Set_Entity_Kind_Type is new Set_8_Bit_Field (Entity_Kind)
with Inline;
@@ -1323,11 +1323,11 @@ package body Atree is
-- we can't just call Set_Chars, because Empty is of the wrong
-- type, and is outside the range of Name_Id.
- Reinit_Field_To_Zero (New_Id, Chars);
- Reinit_Field_To_Zero (New_Id, Has_Private_View);
- Reinit_Field_To_Zero (New_Id, Is_Elaboration_Checks_OK_Node);
- Reinit_Field_To_Zero (New_Id, Is_Elaboration_Warnings_OK_Node);
- Reinit_Field_To_Zero (New_Id, Is_SPARK_Mode_On_Node);
+ Reinit_Field_To_Zero (New_Id, F_Chars);
+ Reinit_Field_To_Zero (New_Id, F_Has_Private_View);
+ Reinit_Field_To_Zero (New_Id, F_Is_Elaboration_Checks_OK_Node);
+ Reinit_Field_To_Zero (New_Id, F_Is_Elaboration_Warnings_OK_Node);
+ Reinit_Field_To_Zero (New_Id, F_Is_SPARK_Mode_On_Node);
-- Change the node type
@@ -2676,7 +2676,7 @@ package body Einfo.Utils is
function Scope_Depth_Set (Id : E) return B is
begin
return not Is_Record_Type (Id)
- and then not Field_Is_Initial_Zero (Id, Scope_Depth_Value);
+ and then not Field_Is_Initial_Zero (Id, F_Scope_Depth_Value);
-- We can't call Scope_Depth_Value here, because Empty is not a valid
-- value of type Uint.
end Scope_Depth_Set;
@@ -2019,7 +2019,7 @@ package body Gen_IL.Gen is
Put (S, ",\n");
end if;
- Put (S, "\1", Image (F));
+ Put (S, "\1", F_Image (F));
end if;
end loop;
end Put_Field_Array;
@@ -2081,7 +2081,7 @@ package body Gen_IL.Gen is
Put (S, ",\n");
end if;
- Put (S, "\1", Image (F));
+ Put (S, "\1", F_Image (F));
end loop;
Outdent (S, 1);
@@ -2161,7 +2161,7 @@ package body Gen_IL.Gen is
Put (S, ",\n");
end if;
- Put (S, "\1 => (\2_Field, \3)", Image (F),
+ Put (S, "\1 => (\2_Field, \3)", F_Image (F),
Image (Field_Table (F).Field_Type), Image (Field_Table (F).Offset));
end loop;
@@ -2283,6 +2283,8 @@ package body Gen_IL.Gen is
Put (B, "end Set_\1_Id_With_Parent;\n", Kind);
end Put_Setter_With_Parent;
+ -- Start of processing for Put_Nodes
+
begin
Put (S, "with Seinfo; use Seinfo;\n");
Put (S, "pragma Warnings (Off);\n");
@@ -189,6 +189,13 @@ package Gen_IL.Internals is
function Image (F : Opt_Field_Enum) return String;
+ function F_Image (F : Opt_Field_Enum) return String is
+ ("F_" & Image (F));
+ -- Prepends "F_" to Image (F). This is used for the enumeration literals in
+ -- the generated Sinfo.Nodes.Node_Field and Einfo.Entities.Entity_Field
+ -- types. If we used Image (F), these enumeration literals would overload
+ -- the getter functions, which confuses gdb.
+
procedure Nil (T : Node_Or_Entity_Type);
-- Null procedure
@@ -4760,7 +4760,7 @@ package body Sem_Ch3 is
-- Now establish the proper kind and type of the object
if Ekind (Id) = E_Void then
- Reinit_Field_To_Zero (Id, Next_Inlined_Subprogram);
+ Reinit_Field_To_Zero (Id, F_Next_Inlined_Subprogram);
end if;
if Constant_Present (N) then
@@ -6181,7 +6181,7 @@ package body Sem_Ch3 is
if Nkind (Def) = N_Constrained_Array_Definition then
if Ekind (T) in Incomplete_Or_Private_Kind then
- Reinit_Field_To_Zero (T, Stored_Constraint);
+ Reinit_Field_To_Zero (T, F_Stored_Constraint);
else
pragma Assert (Ekind (T) = E_Void);
end if;
@@ -6228,7 +6228,7 @@ package body Sem_Ch3 is
else pragma Assert (Nkind (Def) = N_Unconstrained_Array_Definition);
if Ekind (T) in Incomplete_Or_Private_Kind then
- Reinit_Field_To_Zero (T, Stored_Constraint);
+ Reinit_Field_To_Zero (T, F_Stored_Constraint);
else
pragma Assert (Ekind (T) = E_Void);
end if;
@@ -9747,7 +9747,7 @@ package body Sem_Ch3 is
if Ekind (Derived_Type) in Incomplete_Or_Private_Kind
and then Ekind (Parent_Base) in Modular_Integer_Kind | Array_Kind
then
- Reinit_Field_To_Zero (Derived_Type, Stored_Constraint);
+ Reinit_Field_To_Zero (Derived_Type, F_Stored_Constraint);
end if;
Set_Scope (Derived_Type, Current_Scope);
@@ -12532,7 +12532,7 @@ package body Sem_Ch3 is
Set_Associated_Node_For_Itype (Full, Related_Nod);
if Ekind (Full) in Incomplete_Or_Private_Kind then
- Reinit_Field_To_Zero (Full, Private_Dependents);
+ Reinit_Field_To_Zero (Full, F_Private_Dependents);
end if;
-- Set common attributes for all subtypes: kind, convention, etc.
@@ -19225,19 +19225,19 @@ package body Sem_Ch3 is
-- cannot have any invariants.
if Ekind (CW_Type) in Incomplete_Or_Private_Kind then
- Reinit_Field_To_Zero (CW_Type, Private_Dependents);
+ Reinit_Field_To_Zero (CW_Type, F_Private_Dependents);
elsif Ekind (CW_Type) in Concurrent_Kind then
- Reinit_Field_To_Zero (CW_Type, First_Private_Entity);
- Reinit_Field_To_Zero (CW_Type, Scope_Depth_Value);
+ Reinit_Field_To_Zero (CW_Type, F_First_Private_Entity);
+ Reinit_Field_To_Zero (CW_Type, F_Scope_Depth_Value);
if Ekind (CW_Type) in Task_Kind then
- Reinit_Field_To_Zero (CW_Type, Is_Elaboration_Checks_OK_Id);
- Reinit_Field_To_Zero (CW_Type, Is_Elaboration_Warnings_OK_Id);
+ Reinit_Field_To_Zero (CW_Type, F_Is_Elaboration_Checks_OK_Id);
+ Reinit_Field_To_Zero (CW_Type, F_Is_Elaboration_Warnings_OK_Id);
end if;
if Ekind (CW_Type) in E_Task_Type | E_Protected_Type then
- Reinit_Field_To_Zero (CW_Type, SPARK_Aux_Pragma_Inherited);
+ Reinit_Field_To_Zero (CW_Type, F_SPARK_Aux_Pragma_Inherited);
end if;
end if;
@@ -19624,7 +19624,7 @@ package body Sem_Ch3 is
Analyze_And_Resolve (Mod_Expr, Any_Integer);
if Ekind (T) in Incomplete_Or_Private_Kind then
- Reinit_Field_To_Zero (T, Stored_Constraint);
+ Reinit_Field_To_Zero (T, F_Stored_Constraint);
end if;
Set_Etype (T, T);
@@ -20428,7 +20428,7 @@ package body Sem_Ch3 is
Id := Defining_Identifier (Discr);
if Ekind (Id) = E_In_Parameter then
- Reinit_Field_To_Zero (Id, Discriminal_Link);
+ Reinit_Field_To_Zero (Id, F_Discriminal_Link);
end if;
Mutate_Ekind (Id, E_Discriminant);
@@ -21316,7 +21316,7 @@ package body Sem_Ch3 is
Set_Subtype_Indication
(Parent (Priv_Dep), New_Occurrence_Of (Full_T, Sloc (Priv_Dep)));
Reinit_Field_To_Zero
- (Priv_Dep, Private_Dependents,
+ (Priv_Dep, F_Private_Dependents,
Old_Ekind => E_Incomplete_Subtype);
Mutate_Ekind (Priv_Dep, Subtype_Kind (Ekind (Full_T)));
Set_Etype (Priv_Dep, Full_T);
@@ -1320,7 +1320,7 @@ package body Sem_Ch5 is
else
if Ekind (Ent) = E_Label then
- Reinit_Field_To_Zero (Ent, Enclosing_Scope);
+ Reinit_Field_To_Zero (Ent, F_Enclosing_Scope);
end if;
Mutate_Ekind (Ent, E_Block);
@@ -3760,7 +3760,7 @@ package body Sem_Ch5 is
-- parser for generic units.
if Ekind (Ent) = E_Label then
- Reinit_Field_To_Zero (Ent, Enclosing_Scope);
+ Reinit_Field_To_Zero (Ent, F_Enclosing_Scope);
Mutate_Ekind (Ent, E_Loop);
if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then
@@ -1848,7 +1848,7 @@ package body Sem_Ch6 is
-- Visible generic entity is callable within its own body
Mutate_Ekind (Gen_Id, Ekind (Body_Id));
- Reinit_Field_To_Zero (Body_Id, Has_Out_Or_In_Out_Parameter,
+ Reinit_Field_To_Zero (Body_Id, F_Has_Out_Or_In_Out_Parameter,
Old_Ekind =>
(E_Function | E_Procedure |
E_Generic_Function | E_Generic_Procedure => True,
@@ -1929,7 +1929,7 @@ package body Sem_Ch6 is
-- Outside of its body, unit is generic again
- Reinit_Field_To_Zero (Gen_Id, Has_Nested_Subprogram,
+ Reinit_Field_To_Zero (Gen_Id, F_Has_Nested_Subprogram,
Old_Ekind => (E_Function | E_Procedure => True, others => False));
Mutate_Ekind (Gen_Id, Kind);
Generate_Reference (Gen_Id, Body_Id, 'b', Set_Ref => False);
@@ -4610,16 +4610,16 @@ package body Sem_Ch6 is
Reference_Body_Formals (Spec_Id, Body_Id);
end if;
- Reinit_Field_To_Zero (Body_Id, Has_Out_Or_In_Out_Parameter);
- Reinit_Field_To_Zero (Body_Id, Needs_No_Actuals,
+ Reinit_Field_To_Zero (Body_Id, F_Has_Out_Or_In_Out_Parameter);
+ Reinit_Field_To_Zero (Body_Id, F_Needs_No_Actuals,
Old_Ekind => (E_Function | E_Procedure => True, others => False));
- Reinit_Field_To_Zero (Body_Id, Is_Predicate_Function,
+ Reinit_Field_To_Zero (Body_Id, F_Is_Predicate_Function,
Old_Ekind => (E_Function | E_Procedure => True, others => False));
- Reinit_Field_To_Zero (Body_Id, Protected_Subprogram,
+ Reinit_Field_To_Zero (Body_Id, F_Protected_Subprogram,
Old_Ekind => (E_Function | E_Procedure => True, others => False));
if Ekind (Body_Id) = E_Procedure then
- Reinit_Field_To_Zero (Body_Id, Receiving_Entry);
+ Reinit_Field_To_Zero (Body_Id, F_Receiving_Entry);
end if;
Mutate_Ekind (Body_Id, E_Subprogram_Body);
@@ -3278,8 +3278,8 @@ package body Sem_Ch8 is
-- constructed later at the freeze point, so indicate that the
-- completion has not been seen yet.
- Reinit_Field_To_Zero (New_S, Has_Out_Or_In_Out_Parameter);
- Reinit_Field_To_Zero (New_S, Needs_No_Actuals,
+ Reinit_Field_To_Zero (New_S, F_Has_Out_Or_In_Out_Parameter);
+ Reinit_Field_To_Zero (New_S, F_Needs_No_Actuals,
Old_Ekind => (E_Function | E_Procedure => True, others => False));
Mutate_Ekind (New_S, E_Subprogram_Body);
New_S := Rename_Spec;
@@ -6835,7 +6835,7 @@ package body Sem_Ch8 is
case Nkind (N) is
when N_Selected_Component =>
- Reinit_Field_To_Zero (N, Is_Prefixed_Call);
+ Reinit_Field_To_Zero (N, F_Is_Prefixed_Call);
Change_Selected_Component_To_Expanded_Name (N);
when N_Expanded_Name =>
@@ -45,7 +45,7 @@ package body Sinfo.CN is
(N : Node_Id)
is
begin
- Reinit_Field_To_Zero (N, Char_Literal_Value);
+ Reinit_Field_To_Zero (N, F_Char_Literal_Value);
Extend_Node (N);
end Change_Character_Literal_To_Defining_Character_Literal;
@@ -130,7 +130,7 @@ package body Sinfo.CN is
(N : Node_Id)
is
begin
- Reinit_Field_To_Zero (N, Strval);
+ Reinit_Field_To_Zero (N, F_Strval);
Extend_Node (N);
end Change_Operator_Symbol_To_Defining_Operator_Symbol;
@@ -140,7 +140,7 @@ package body Sinfo.CN is
procedure Change_Operator_Symbol_To_String_Literal (N : Node_Id) is
begin
- Reinit_Field_To_Zero (N, Chars);
+ Reinit_Field_To_Zero (N, F_Chars);
Set_Entity (N, Empty);
Mutate_Nkind (N, N_String_Literal);
end Change_Operator_Symbol_To_String_Literal;
@@ -239,7 +239,7 @@ package body Sinfo.Utils is
begin
for J in Fields'Range loop
- if Fields (J) /= Link then -- Don't walk Parent!
+ if Fields (J) /= F_Link then -- Don't walk Parent!
declare
Desc : Field_Descriptor renames
Node_Field_Descriptors (Fields (J));
@@ -264,7 +264,7 @@ package body Sinfo.Utils is
begin
for J in Fields'Range loop
- if Fields (J) /= Link then -- Don't walk Parent!
+ if Fields (J) /= F_Link then -- Don't walk Parent!
declare
Desc : Field_Descriptor renames
Node_Field_Descriptors (Fields (J));
@@ -139,10 +139,10 @@ package Sinfo.Utils is
(N : N_Inclusive_Has_Entity; Val : Node_Id)
renames Set_Entity_Or_Associated_Node;
- function Associated_Node return Node_Field renames
- Entity_Or_Associated_Node;
- function Entity return Node_Field renames
- Entity_Or_Associated_Node;
+ function F_Associated_Node return Node_Field renames
+ F_Entity_Or_Associated_Node;
+ function F_Entity return Node_Field renames
+ F_Entity_Or_Associated_Node;
-- Note that we are renaming the enumeration literals here
---------------
@@ -284,110 +284,118 @@ package body Treepr is
function Image (F : Node_Field) return String is
begin
case F is
- when Alloc_For_BIP_Return =>
+ when F_Alloc_For_BIP_Return =>
return "Alloc_For_BIP_Return";
- when Assignment_OK =>
+ when F_Assignment_OK =>
return "Assignment_OK";
- when Backwards_OK =>
+ when F_Backwards_OK =>
return "Backwards_OK";
- when Conversion_OK =>
+ when F_Conversion_OK =>
return "Conversion_OK";
- when Forwards_OK =>
+ when F_Forwards_OK =>
return "Forwards_OK";
- when Has_SP_Choice =>
+ when F_Has_SP_Choice =>
return "Has_SP_Choice";
- when Is_Elaboration_Checks_OK_Node =>
+ when F_Is_Elaboration_Checks_OK_Node =>
return "Is_Elaboration_Checks_OK_Node";
- when Is_Elaboration_Warnings_OK_Node =>
+ when F_Is_Elaboration_Warnings_OK_Node =>
return "Is_Elaboration_Warnings_OK_Node";
- when Is_Known_Guaranteed_ABE =>
+ when F_Is_Known_Guaranteed_ABE =>
return "Is_Known_Guaranteed_ABE";
- when Is_SPARK_Mode_On_Node =>
+ when F_Is_SPARK_Mode_On_Node =>
return "Is_SPARK_Mode_On_Node";
- when Local_Raise_Not_OK =>
+ when F_Local_Raise_Not_OK =>
return "Local_Raise_Not_OK";
- when SCIL_Controlling_Tag =>
+ when F_SCIL_Controlling_Tag =>
return "SCIL_Controlling_Tag";
- when SCIL_Entity =>
+ when F_SCIL_Entity =>
return "SCIL_Entity";
- when SCIL_Tag_Value =>
+ when F_SCIL_Tag_Value =>
return "SCIL_Tag_Value";
- when SCIL_Target_Prim =>
+ when F_SCIL_Target_Prim =>
return "SCIL_Target_Prim";
- when Shift_Count_OK =>
+ when F_Shift_Count_OK =>
return "Shift_Count_OK";
- when Split_PPC =>
+ when F_Split_PPC =>
return "Split_PPC";
- when TSS_Elist =>
+ when F_TSS_Elist =>
return "TSS_Elist";
when others =>
- return Capitalize (F'Img);
+ declare
+ Result : constant String := Capitalize (F'Img);
+ begin
+ return Result (3 .. Result'Last); -- Remove "F_"
+ end;
end case;
end Image;
function Image (F : Entity_Field) return String is
begin
case F is
- when BIP_Initialization_Call =>
+ when F_BIP_Initialization_Call =>
return "BIP_Initialization_Call";
- when Body_Needed_For_SAL =>
+ when F_Body_Needed_For_SAL =>
return "Body_Needed_For_SAL";
- when CR_Discriminant =>
+ when F_CR_Discriminant =>
return "CR_Discriminant";
- when DT_Entry_Count =>
+ when F_DT_Entry_Count =>
return "DT_Entry_Count";
- when DT_Offset_To_Top_Func =>
+ when F_DT_Offset_To_Top_Func =>
return "DT_Offset_To_Top_Func";
- when DT_Position =>
+ when F_DT_Position =>
return "DT_Position";
- when DTC_Entity =>
+ when F_DTC_Entity =>
return "DTC_Entity";
- when Has_Inherited_DIC =>
+ when F_Has_Inherited_DIC =>
return "Has_Inherited_DIC";
- when Has_Own_DIC =>
+ when F_Has_Own_DIC =>
return "Has_Own_DIC";
- when Has_RACW =>
+ when F_Has_RACW =>
return "Has_RACW";
- when Ignore_SPARK_Mode_Pragmas =>
+ when F_Ignore_SPARK_Mode_Pragmas =>
return "Ignore_SPARK_Mode_Pragmas";
- when Is_Constr_Subt_For_UN_Aliased =>
+ when F_Is_Constr_Subt_For_UN_Aliased =>
return "Is_Constr_Subt_For_UN_Aliased";
- when Is_CPP_Class =>
+ when F_Is_CPP_Class =>
return "Is_CPP_Class";
- when Is_CUDA_Kernel =>
+ when F_Is_CUDA_Kernel =>
return "Is_CUDA_Kernel";
- when Is_DIC_Procedure =>
+ when F_Is_DIC_Procedure =>
return "Is_DIC_Procedure";
- when Is_Discrim_SO_Function =>
+ when F_Is_Discrim_SO_Function =>
return "Is_Discrim_SO_Function";
- when Is_Elaboration_Checks_OK_Id =>
+ when F_Is_Elaboration_Checks_OK_Id =>
return "Is_Elaboration_Checks_OK_Id";
- when Is_Elaboration_Warnings_OK_Id =>
+ when F_Is_Elaboration_Warnings_OK_Id =>
return "Is_Elaboration_Warnings_OK_Id";
- when Is_RACW_Stub_Type =>
+ when F_Is_RACW_Stub_Type =>
return "Is_RACW_Stub_Type";
- when OK_To_Rename =>
+ when F_OK_To_Rename =>
return "OK_To_Rename";
- when Referenced_As_LHS =>
+ when F_Referenced_As_LHS =>
return "Referenced_As_LHS";
- when RM_Size =>
+ when F_RM_Size =>
return "RM_Size";
- when SPARK_Aux_Pragma =>
+ when F_SPARK_Aux_Pragma =>
return "SPARK_Aux_Pragma";
- when SPARK_Aux_Pragma_Inherited =>
+ when F_SPARK_Aux_Pragma_Inherited =>
return "SPARK_Aux_Pragma_Inherited";
- when SPARK_Pragma =>
+ when F_SPARK_Pragma =>
return "SPARK_Pragma";
- when SPARK_Pragma_Inherited =>
+ when F_SPARK_Pragma_Inherited =>
return "SPARK_Pragma_Inherited";
- when SSO_Set_High_By_Default =>
+ when F_SSO_Set_High_By_Default =>
return "SSO_Set_High_By_Default";
- when SSO_Set_Low_By_Default =>
+ when F_SSO_Set_Low_By_Default =>
return "SSO_Set_Low_By_Default";
when others =>
- return Capitalize (F'Img);
+ declare
+ Result : constant String := Capitalize (F'Img);
+ begin
+ return Result (3 .. Result'Last); -- Remove "F_"
+ end;
end case;
end Image;
@@ -646,8 +654,8 @@ package body Treepr is
Should_Print : constant Entity_Field_Set :=
-- Set of fields that should be printed. False for fields that were
-- already printed above.
- (Ekind
- | Basic_Convention => False, -- Convention was printed
+ (F_Ekind
+ | F_Basic_Convention => False, -- Convention was printed
others => True);
begin
-- Outer loop makes flags come out last
@@ -1372,31 +1380,31 @@ package body Treepr is
-- Set of fields that should be printed. False for fields that were
-- already printed above, and for In_List, which we don't bother
-- printing.
- (Nkind
- | Chars
- | Comes_From_Source
- | Analyzed
- | Error_Posted
- | Is_Ignored_Ghost_Node
- | Check_Actuals
- | Link -- Parent was printed
- | Sloc
- | Left_Opnd
- | Right_Opnd
- | Entity
- | Assignment_OK
- | Do_Range_Check
- | Has_Dynamic_Length_Check
- | Has_Aspects
- | Is_Controlling_Actual
- | Is_Overloaded
- | Is_Static_Expression
- | Must_Not_Freeze
- | Small_Paren_Count -- Paren_Count was printed
- | Raises_Constraint_Error
- | Do_Overflow_Check
- | Etype
- | In_List
+ (F_Nkind
+ | F_Chars
+ | F_Comes_From_Source
+ | F_Analyzed
+ | F_Error_Posted
+ | F_Is_Ignored_Ghost_Node
+ | F_Check_Actuals
+ | F_Link -- Parent was printed
+ | F_Sloc
+ | F_Left_Opnd
+ | F_Right_Opnd
+ | F_Entity
+ | F_Assignment_OK
+ | F_Do_Range_Check
+ | F_Has_Dynamic_Length_Check
+ | F_Has_Aspects
+ | F_Is_Controlling_Actual
+ | F_Is_Overloaded
+ | F_Is_Static_Expression
+ | F_Must_Not_Freeze
+ | F_Small_Paren_Count -- Paren_Count was printed
+ | F_Raises_Constraint_Error
+ | F_Do_Overflow_Check
+ | F_Etype
+ | F_In_List
=> False,
others => True);
@@ -1415,7 +1423,7 @@ package body Treepr is
-- Special case for End_Span, which also prints the
-- End_Location.
- if Fields (Field_Index) = End_Span then
+ if Fields (Field_Index) = F_End_Span then
Print_End_Span (N);
else
@@ -2227,7 +2235,7 @@ package body Treepr is
-- but what concerns us now is looking for descendants in
-- the tree.
- and then F /= Next_Entity -- See below for why we skip this
+ and then F /= F_Next_Entity -- See below for why we skip this
then
Visit_Descendant (Get_Union_Id (N, FD.Offset));
end if;