From baaf92dcd8c1a7fc1147a9d2827ac6f6f9332c3b Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 27 Apr 2016 10:49:35 +0000 Subject: [PATCH] * gcc-interface/gigi.h (gnat_to_gnu_entity): Adjust prototype. (maybe_pad_type): Adjust comment. (finish_record_type): Likewise. (rest_of_record_type_compilation): Likewise. * gcc-interface/decl.c (gnat_to_gnu_entity): Change DEFINITION type parameter from integer to boolean. Adjust recursive calls. : Use copy_type and remove redundant assignments. : Adjust comment. Remove call to rest_of_record_type_compilation. Set TYPE_PADDING_P flag earlier. Pass false to finish_record_type. Set the debug type later. : Remove call to rest_of_record_type_compilation. (gnat_to_gnu_component_type): Fix formatting. (gnat_to_gnu_field_decl): Adjust call to gnat_to_gnu_entity. (gnat_to_gnu_type): Likewise. * gcc-interface/trans.c (Identifier_to_gnu): Likewise. (Loop_Statement_to_gnu): Likewise. (Subprogram_Body_to_gnu): Likewise. (Exception_Handler_to_gnu_fe_sjlj): Likewise. (Exception_Handler_to_gnu_gcc): Likewise. (Compilation_Unit_to_gnu): Likewise. (gnat_to_gnu): Likewise. (push_exception_label_stack): Likewise. (elaborate_all_entities_for_package): Likewise. (process_freeze_entity): Likewise. (process_decls): Likewise. (process_type): Likewise. * gcc-interface/utils.c (struct deferred_decl_context_node): Tweak. (maybe_pad_type): Adjust comments. Set the debug type later. Remove call to rest_of_record_type_compilation. (rest_of_record_type_compilation): Use copy_type. (copy_type): Use correctly typed constants. (gnat_signed_or_unsigned_type_for): Use copy_type. * gcc-interface/utils2.c (nonbinary_modular_operation): Likewise. (build_goto_raise): Adjust call tognat_to_gnu_entity. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@235479 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 37 ++++++++++++++++ gcc/ada/gcc-interface/decl.c | 99 ++++++++++++++++++++---------------------- gcc/ada/gcc-interface/gigi.h | 24 +++++----- gcc/ada/gcc-interface/trans.c | 48 ++++++++++---------- gcc/ada/gcc-interface/utils.c | 58 ++++++++++++++----------- gcc/ada/gcc-interface/utils2.c | 12 ++--- 6 files changed, 158 insertions(+), 120 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aff9a45a66d..8d418bf89b9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,42 @@ 2016-04-27 Eric Botcazou + * gcc-interface/gigi.h (gnat_to_gnu_entity): Adjust prototype. + (maybe_pad_type): Adjust comment. + (finish_record_type): Likewise. + (rest_of_record_type_compilation): Likewise. + * gcc-interface/decl.c (gnat_to_gnu_entity): Change DEFINITION type + parameter from integer to boolean. Adjust recursive calls. + : Use copy_type and remove redundant assignments. + : Adjust comment. Remove call to + rest_of_record_type_compilation. Set TYPE_PADDING_P flag earlier. + Pass false to finish_record_type. Set the debug type later. + : Remove call to rest_of_record_type_compilation. + (gnat_to_gnu_component_type): Fix formatting. + (gnat_to_gnu_field_decl): Adjust call to gnat_to_gnu_entity. + (gnat_to_gnu_type): Likewise. + * gcc-interface/trans.c (Identifier_to_gnu): Likewise. + (Loop_Statement_to_gnu): Likewise. + (Subprogram_Body_to_gnu): Likewise. + (Exception_Handler_to_gnu_fe_sjlj): Likewise. + (Exception_Handler_to_gnu_gcc): Likewise. + (Compilation_Unit_to_gnu): Likewise. + (gnat_to_gnu): Likewise. + (push_exception_label_stack): Likewise. + (elaborate_all_entities_for_package): Likewise. + (process_freeze_entity): Likewise. + (process_decls): Likewise. + (process_type): Likewise. + * gcc-interface/utils.c (struct deferred_decl_context_node): Tweak. + (maybe_pad_type): Adjust comments. Set the debug type later. Remove + call to rest_of_record_type_compilation. + (rest_of_record_type_compilation): Use copy_type. + (copy_type): Use correctly typed constants. + (gnat_signed_or_unsigned_type_for): Use copy_type. + * gcc-interface/utils2.c (nonbinary_modular_operation): Likewise. + (build_goto_raise): Adjust call tognat_to_gnu_entity. + +2016-04-27 Eric Botcazou + * gcc-interface/misc.c (gnat_init): Do not call internal_reference_types. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 8ea72b5f7fa..226f13f9ef3 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -217,15 +217,13 @@ static bool intrin_profiles_compatible_p (intrin_binding_t *); initial value (in GCC tree form). This is optional for a variable. For a renamed entity, GNU_EXPR gives the object being renamed. - DEFINITION is nonzero if this call is intended for a definition. This is - used for separate compilation where it is necessary to know whether an - external declaration or a definition must be created if the GCC equivalent - was not created previously. The value of 1 is normally used for a nonzero - DEFINITION, but a value of 2 is used in special circumstances, defined in - the code. */ + DEFINITION is true if this call is intended for a definition. This is used + for separate compilation where it is necessary to know whether an external + declaration or a definition must be created if the GCC equivalent was not + created previously. */ tree -gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) +gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) { /* Contains the kind of the input GNAT node. */ const Entity_Kind kind = Ekind (gnat_entity); @@ -306,7 +304,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || (IN (Ekind (gnat_temp), Subprogram_Kind) && present_gnu_tree (gnat_temp) && (current_function_decl - == gnat_to_gnu_entity (gnat_temp, NULL_TREE, 0)))) + == gnat_to_gnu_entity (gnat_temp, NULL_TREE, false)))) { process_type (gnat_entity); return get_gnu_tree (gnat_entity); @@ -337,7 +335,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || No (Freeze_Node (Full_View (gnat_entity))))) { gnu_decl - = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0); + = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, false); save_gnu_tree (gnat_entity, NULL_TREE, false); save_gnu_tree (gnat_entity, gnu_decl, false); } @@ -485,12 +483,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_decl = gnat_to_gnu_entity (Original_Record_Component (gnat_entity), - gnu_expr, 0); + gnu_expr, false); saved = true; break; } - gnat_to_gnu_entity (Scope (gnat_entity), NULL_TREE, 0); + gnat_to_gnu_entity (Scope (gnat_entity), NULL_TREE, false); gnu_decl = get_gnu_tree (gnat_entity); saved = true; break; @@ -537,7 +535,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && Present (Full_View (gnat_entity))) { gnu_decl - = gnat_to_gnu_entity (Full_View (gnat_entity), gnu_expr, 0); + = gnat_to_gnu_entity (Full_View (gnat_entity), gnu_expr, false); saved = true; break; } @@ -598,7 +596,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { if (kind == E_Exception) gnu_expr = gnat_to_gnu_entity (Renamed_Entity (gnat_entity), - NULL_TREE, 0); + NULL_TREE, false); else gnu_expr = gnat_to_gnu_external (Renamed_Object (gnat_entity)); } @@ -1771,7 +1769,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity)) && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity)) || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity)))) - gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, 0); + gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, false); /* Set the precision to the Esize except for bit-packed arrays. */ if (Is_Packed_Array_Impl_Type (gnat_entity) @@ -1906,7 +1904,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_field_decl (get_identifier ("OBJECT"), gnu_field_type, gnu_type, NULL_TREE, bitsize_zero_node, 1, 0); - /* Do not emit debug info until after the parallel type is added. */ + /* We will output additional debug info manually below. */ finish_record_type (gnu_type, gnu_field, 2, false); compute_record_mode (gnu_type); TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1; @@ -1920,8 +1918,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) implementation type, the padded type is its debug type. */ if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type); - - rest_of_record_type_compilation (gnu_type); } } @@ -1946,9 +1942,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field_type = gnu_type; gnu_type = make_node (RECORD_TYPE); + TYPE_PADDING_P (gnu_type) = 1; TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "PAD"); - if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) - SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type); TYPE_PACKED (gnu_type) = 1; TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_field_type); TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_field_type); @@ -1964,9 +1959,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type, TYPE_SIZE (gnu_field_type), bitsize_zero_node, 0, 0); - finish_record_type (gnu_type, gnu_field, 2, debug_info_p); + finish_record_type (gnu_type, gnu_field, 2, false); compute_record_mode (gnu_type); - TYPE_PADDING_P (gnu_type) = 1; + + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (gnu_type, gnu_field_type); } break; @@ -1986,7 +1983,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity)) && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity)) || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity)))) - gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, 0); + gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, false); gnu_type = make_node (REAL_TYPE); TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity)); @@ -2739,7 +2736,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else { tree gnu_base_decl - = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, 0); + = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, + false); if (!DECL_ARTIFICIAL (gnu_base_decl) && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) add_parallel_type (gnu_type, @@ -2812,7 +2810,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_decl = gnat_to_gnu_entity (Packed_Array_Impl_Type (gnat_entity), - NULL_TREE, 0); + NULL_TREE, false); this_made_decl = true; gnu_type = TREE_TYPE (gnu_decl); @@ -3114,7 +3112,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (definition) gcc_assert (present_gnu_tree (gnat_uview)); else - gnat_to_gnu_entity (gnat_uview, NULL_TREE, 0); + gnat_to_gnu_entity (gnat_uview, NULL_TREE, false); gnu_parent = gnat_to_gnu_type (Parent_Subtype (gnat_uview)); @@ -3277,7 +3275,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr)); gnu_ref = gnat_to_gnu_entity (Original_Record_Component (gnat_discr), - NULL_TREE, 0); + NULL_TREE, false); /* GNU_REF must be an expression using a PLACEHOLDER_EXPR built just above for one of the stored discriminants. */ @@ -3321,7 +3319,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Ekind (gnat_temp) == E_Discriminant) && Is_Itype (Etype (gnat_temp)) && !present_gnu_tree (gnat_temp)) - gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0); + gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, false); /* If this is a record type associated with an exception definition, equate its fields to those of the standard exception type. This @@ -3346,7 +3344,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) since it may have constraints. */ if (gnat_equiv_type != gnat_entity) { - gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0); + gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false); maybe_present = true; break; } @@ -3361,7 +3359,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (Present (Cloned_Subtype (gnat_entity))) { gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), - NULL_TREE, 0); + NULL_TREE, false); maybe_present = true; break; } @@ -3700,10 +3698,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if ((Ekind (gnat_field) == E_Discriminant || Ekind (gnat_field) == E_Component) && !present_gnu_tree (Etype (gnat_field))) - gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0); + gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, false); - /* Do not emit debug info for the type yet since we're going to - modify it below. */ + /* We will output additional debug info manually below. */ finish_record_type (gnu_type, nreverse (gnu_field_list), 2, false); compute_record_mode (gnu_type); @@ -3749,9 +3746,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_variant_list.release (); gnu_subst_list.release (); - - /* Now we can finalize it. */ - rest_of_record_type_compilation (gnu_type); } /* Otherwise, go down all the components in the new type and make @@ -4084,7 +4078,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && No (Freeze_Node (Directly_Designated_Type (gnat_entity))) && !Is_Record_Type (Scope (Directly_Designated_Type (gnat_entity)))) gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity), - NULL_TREE, 0); + NULL_TREE, false); break; @@ -4125,7 +4119,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) (Directly_Designated_Type (gnat_entity))), Incomplete_Or_Private_Kind)) gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity), - NULL_TREE, 0); + NULL_TREE, false); } maybe_present = true; @@ -4246,16 +4240,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) const Entity_Id gnat_renamed = Renamed_Object (gnat_entity); if (Ekind (Alias (gnat_entity)) == E_Enumeration_Literal) - gnat_to_gnu_entity (Etype (Alias (gnat_entity)), NULL_TREE, 0); + gnat_to_gnu_entity (Etype (Alias (gnat_entity)), NULL_TREE, + false); - gnu_decl = gnat_to_gnu_entity (Alias (gnat_entity), gnu_expr, 0); + gnu_decl + = gnat_to_gnu_entity (Alias (gnat_entity), gnu_expr, false); /* Elaborate any Itypes in the parameters of this entity. */ for (gnat_temp = First_Formal_With_Extras (gnat_entity); Present (gnat_temp); gnat_temp = Next_Formal_With_Extras (gnat_temp)) if (Is_Itype (Etype (gnat_temp))) - gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0); + gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, false); /* Materialize renamed subprograms in the debugging information when the renamed object is compile time known. We can consider @@ -4419,11 +4415,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { post_error ("cannot return type whose size overflows", gnat_entity); - gnu_return_type = copy_node (gnu_return_type); + gnu_return_type = copy_type (gnu_return_type); TYPE_SIZE (gnu_return_type) = bitsize_zero_node; TYPE_SIZE_UNIT (gnu_return_type) = size_zero_node; - TYPE_MAIN_VARIANT (gnu_return_type) = gnu_return_type; - TYPE_NEXT_VARIANT (gnu_return_type) = NULL_TREE; } } @@ -4812,8 +4806,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } else { - gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), - NULL_TREE, 0); + gnu_decl + = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, false); maybe_present = true; } break; @@ -4838,7 +4832,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || (is_from_limited_with && !In_Extended_Main_Code_Unit (full_view))) { - gnu_decl = gnat_to_gnu_entity (full_view, NULL_TREE, 0); + gnu_decl = gnat_to_gnu_entity (full_view, NULL_TREE, false); maybe_present = true; break; } @@ -4856,7 +4850,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_Class_Wide_Type: /* Class-wide types are always transformed into their root type. */ - gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0); + gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false); maybe_present = true; break; @@ -4907,7 +4901,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Concurrent types are always transformed into their record type. */ else - gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0); + gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false); maybe_present = true; break; @@ -5480,7 +5474,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && Is_Itype (Original_Array_Type (gnat_entity)) && No (Freeze_Node (Original_Array_Type (gnat_entity))) && !present_gnu_tree (Original_Array_Type (gnat_entity))) - gnat_to_gnu_entity (Original_Array_Type (gnat_entity), NULL_TREE, 0); + gnat_to_gnu_entity (Original_Array_Type (gnat_entity), NULL_TREE, false); return gnu_decl; } @@ -5491,7 +5485,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnat_to_gnu_field_decl (Entity_Id gnat_entity) { - tree gnu_field = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0); + tree gnu_field = gnat_to_gnu_entity (gnat_entity, NULL_TREE, false); if (TREE_CODE (gnu_field) == COMPONENT_REF) gnu_field = TREE_OPERAND (gnu_field, 1); @@ -5511,7 +5505,7 @@ gnat_to_gnu_type (Entity_Id gnat_entity) if (Is_Generic_Type (gnat_entity) && type_annotate_only) return void_type_node; - gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0); + gnu_decl = gnat_to_gnu_entity (gnat_entity, NULL_TREE, false); gcc_assert (TREE_CODE (gnu_decl) == TYPE_DECL); return TREE_TYPE (gnu_decl); @@ -5703,8 +5697,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, tree gnu_comp_size; /* Try to get a smaller form of the component if needed. */ - if ((Is_Packed (gnat_array) - || Has_Component_Size_Clause (gnat_array)) + if ((Is_Packed (gnat_array) || Has_Component_Size_Clause (gnat_array)) && !Is_Bit_Packed_Array (gnat_array) && !Has_Aliased_Components (gnat_array) && !Strict_Alignment (gnat_type) diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 2b58d4eadb9..4fb2fc4f447 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -34,14 +34,12 @@ initial value (in GCC tree form). This is optional for variables. For renamed entities, GNU_EXPR gives the object being renamed. - DEFINITION is nonzero if this call is intended for a definition. This is - used for separate compilation where it necessary to know whether an - external declaration or a definition should be created if the GCC equivalent - was not created previously. The value of 1 is normally used for a nonzero - DEFINITION, but a value of 2 is used in special circumstances, defined in - the code. */ + DEFINITION is true if this call is intended for a definition. This is used + for separate compilation where it is necessary to know whether an external + declaration or a definition must be created if the GCC equivalent was not + created previously. */ extern tree gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, - int definition); + bool definition); /* Similar, but if the returned value is a COMPONENT_REF, return the FIELD_DECL. */ @@ -148,7 +146,8 @@ extern tree make_type_from_size (tree type, tree size_tree, bool for_biased); IS_COMPONENT_TYPE is true if this is being done for the component type of an array. IS_USER_TYPE is true if the original type needs to be completed. DEFINITION is true if this type is being defined. SET_RM_SIZE is true if - the RM size of the resulting type is to be set to SIZE too. */ + the RM size of the resulting type is to be set to SIZE too; in this case, + the padded type is canonicalized before being returned. */ extern tree maybe_pad_type (tree type, tree size, unsigned int align, Entity_Id gnat_entity, bool is_component_type, bool is_user_type, bool definition, @@ -620,14 +619,13 @@ extern void finish_fat_pointer_type (tree record_type, tree field_list); laid out already; only set the sizes and alignment. If REP_LEVEL is two, this record is derived from a parent record and thus inherits its layout; only make a pass on the fields to finalize them. DEBUG_INFO_P is true if - we need to write debug information about this type. */ + additional debug info needs to be output for this type. */ extern void finish_record_type (tree record_type, tree field_list, int rep_level, bool debug_info_p); -/* Wrap up compilation of RECORD_TYPE, i.e. output all the debug information - associated with it. It need not be invoked directly in most cases since - finish_record_type takes care of doing so, but this can be necessary if - a parallel type is to be attached to the record type. */ +/* Wrap up compilation of RECORD_TYPE, i.e. output additional debug info + associated with it. It need not be invoked directly in most cases as + finish_record_type takes care of doing so. */ extern void rest_of_record_type_compilation (tree record_type); /* Append PARALLEL_TYPE on the chain of parallel types for TYPE. */ diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 357d26f8d5d..e6442a8b44c 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1120,7 +1120,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) gnu_result = gnat_to_gnu (Expression (Declaration_Node (gnat_temp))); } else - gnu_result = gnat_to_gnu_entity (gnat_temp, NULL_TREE, 0); + gnu_result = gnat_to_gnu_entity (gnat_temp, NULL_TREE, false); /* Some objects (such as parameters passed by reference, globals of variable size, and renamed objects) actually represent the address @@ -3027,7 +3027,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node) gnu_loop_iv = NULL_TREE; /* Declare the iteration variable and set it to its initial value. */ - gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1); + gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, true); if (DECL_BY_REF_P (gnu_loop_var)) gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_loop_var); else if (use_iv) @@ -3792,7 +3792,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) gnu_cico_entry = TREE_CHAIN (gnu_cico_entry); /* Do any needed dereferences for by-ref objects. */ - gnu_decl = gnat_to_gnu_entity (gnat_param, NULL_TREE, 1); + gnu_decl = gnat_to_gnu_entity (gnat_param, NULL_TREE, true); gcc_assert (DECL_P (gnu_decl)); if (DECL_BY_REF_P (gnu_decl)) gnu_decl = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_decl); @@ -5193,7 +5193,7 @@ Exception_Handler_to_gnu_fe_sjlj (Node_Id gnat_node) if (Present (Renamed_Object (gnat_ex_id))) gnat_ex_id = Renamed_Object (gnat_ex_id); - gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, 0); + gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, false); this_choice = build_binary_op @@ -5248,7 +5248,7 @@ Exception_Handler_to_gnu_gcc (Node_Id gnat_node) if (Present (Renamed_Object (gnat_ex_id))) gnat_ex_id = Renamed_Object (gnat_ex_id); - gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, 0); + gnu_expr = gnat_to_gnu_entity (gnat_ex_id, NULL_TREE, false); gnu_etype = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr); } else @@ -5303,7 +5303,7 @@ Exception_Handler_to_gnu_gcc (Node_Id gnat_node) if (Present (Choice_Parameter (gnat_node))) { tree gnu_param - = gnat_to_gnu_entity (Choice_Parameter (gnat_node), NULL_TREE, 1); + = gnat_to_gnu_entity (Choice_Parameter (gnat_node), NULL_TREE, true); add_stmt (build_call_n_expr (set_exception_parameter_decl, 2, @@ -5406,7 +5406,7 @@ Compilation_Unit_to_gnu (Node_Id gnat_node) } /* Define the entity first so we set DECL_EXTERNAL. */ - gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0); + gnat_to_gnu_entity (gnat_entity, NULL_TREE, false); add_stmt (gnat_to_gnu (gnat_body)); } @@ -6045,7 +6045,7 @@ gnat_to_gnu (Node_Id gnat_node) } } else - gnat_to_gnu_entity (gnat_temp, gnu_expr, 1); + gnat_to_gnu_entity (gnat_temp, gnu_expr, true); break; case N_Object_Renaming_Declaration: @@ -6063,7 +6063,8 @@ gnat_to_gnu (Node_Id gnat_node) { tree gnu_temp = gnat_to_gnu_entity (gnat_temp, - gnat_to_gnu (Renamed_Object (gnat_temp)), 1); + gnat_to_gnu (Renamed_Object (gnat_temp)), + true); /* See case 2 of renaming in gnat_to_gnu_entity. */ if (TREE_SIDE_EFFECTS (gnu_temp)) gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_temp); @@ -6079,7 +6080,8 @@ gnat_to_gnu (Node_Id gnat_node) { tree gnu_temp = gnat_to_gnu_entity (gnat_temp, - gnat_to_gnu (Renamed_Entity (gnat_temp)), 1); + gnat_to_gnu (Renamed_Entity (gnat_temp)), + true); if (TREE_SIDE_EFFECTS (gnu_temp)) gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_temp); } @@ -6109,12 +6111,12 @@ gnat_to_gnu (Node_Id gnat_node) || Ekind (gnat_renamed) == E_Procedure) && !Is_Intrinsic_Subprogram (gnat_renaming) && !Is_Intrinsic_Subprogram (gnat_renamed)) - gnat_to_gnu_entity (gnat_renaming, gnat_to_gnu (gnat_renamed), 1); + gnat_to_gnu_entity (gnat_renaming, gnat_to_gnu (gnat_renamed), true); break; } case N_Implicit_Label_Declaration: - gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, 1); + gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, true); gnu_result = alloc_stmt_list (); break; @@ -7146,7 +7148,7 @@ gnat_to_gnu (Node_Id gnat_node) if (No (Freeze_Node (Defining_Entity (Specification (gnat_node))))) gnat_to_gnu_entity (Defining_Entity (Specification (gnat_node)), - NULL_TREE, 1); + NULL_TREE, true); gnu_result = alloc_stmt_list (); break; @@ -7168,7 +7170,7 @@ gnat_to_gnu (Node_Id gnat_node) gnat_temp = Next_Formal_With_Extras (gnat_temp)) if (Is_Itype (Etype (gnat_temp)) && !From_Limited_With (Etype (gnat_temp))) - gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0); + gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, false); /* Then the result type, set to Standard_Void_Type for procedures. */ { @@ -7176,7 +7178,7 @@ gnat_to_gnu (Node_Id gnat_node) = Etype (Defining_Entity (Specification (gnat_node))); if (Is_Itype (gnat_temp_type) && !From_Limited_With (gnat_temp_type)) - gnat_to_gnu_entity (Etype (gnat_temp_type), NULL_TREE, 0); + gnat_to_gnu_entity (Etype (gnat_temp_type), NULL_TREE, false); } gnu_result = alloc_stmt_list (); @@ -7253,7 +7255,7 @@ gnat_to_gnu (Node_Id gnat_node) break; case N_Single_Task_Declaration: - gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, 1); + gnat_to_gnu_entity (Defining_Entity (gnat_node), NULL_TREE, true); gnu_result = alloc_stmt_list (); break; @@ -7864,7 +7866,7 @@ static void push_exception_label_stack (vec **gnu_stack, Entity_Id gnat_label) { tree gnu_label = (Present (gnat_label) - ? gnat_to_gnu_entity (gnat_label, NULL_TREE, 0) + ? gnat_to_gnu_entity (gnat_label, NULL_TREE, false) : NULL_TREE); vec_safe_push (*gnu_stack, gnu_label); @@ -8470,7 +8472,7 @@ elaborate_all_entities_for_package (Entity_Id gnat_package) elaborate_all_entities_for_package (gnat_entity); } else - gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0); + gnat_to_gnu_entity (gnat_entity, NULL_TREE, false); } } @@ -8628,7 +8630,7 @@ process_freeze_entity (Node_Id gnat_node) && Present (Underlying_Full_View (full_view))) full_view = Underlying_Full_View (full_view); - gnu_new = gnat_to_gnu_entity (full_view, NULL_TREE, 1); + gnu_new = gnat_to_gnu_entity (full_view, NULL_TREE, true); /* Propagate back-annotations from full view to partial view. */ if (Unknown_Alignment (gnat_entity)) @@ -8653,7 +8655,7 @@ process_freeze_entity (Node_Id gnat_node) && present_gnu_tree (Declaration_Node (gnat_entity))) ? get_gnu_tree (Declaration_Node (gnat_entity)) : NULL_TREE; - gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, 1); + gnu_new = gnat_to_gnu_entity (gnat_entity, gnu_init, true); } if (IN (kind, Type_Kind) @@ -8745,7 +8747,7 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, if (Ekind (gnat_subprog_id) != E_Generic_Procedure && Ekind (gnat_subprog_id) != E_Generic_Function) - gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, 1); + gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, true); } } @@ -8760,7 +8762,7 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2, if (Ekind (gnat_subprog_id) != E_Subprogram_Body && Ekind (gnat_subprog_id) != E_Generic_Procedure && Ekind (gnat_subprog_id) != E_Generic_Function) - gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, 1); + gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, true); } /* Concurrent stubs stand for the corresponding subprogram bodies, @@ -9509,7 +9511,7 @@ process_type (Entity_Id gnat_entity) } /* Now fully elaborate the type. */ - gnu_new = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 1); + gnu_new = gnat_to_gnu_entity (gnat_entity, NULL_TREE, true); gcc_assert (TREE_CODE (gnu_new) == TYPE_DECL); /* If we have an old type and we've made pointers to this type, update those diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index d568dff8e01..db38701b436 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -239,17 +239,24 @@ static tree convert_to_fat_pointer (tree, tree); static unsigned int scale_by_factor_of (tree, unsigned int); static bool potential_alignment_gap (tree, tree, tree); -/* A linked list used as a queue to defer the initialization of the - DECL_CONTEXT attribute of ..._DECL nodes and of the TYPE_CONTEXT attribute - of ..._TYPE nodes. */ +/* Linked list used as a queue to defer the initialization of the DECL_CONTEXT + of ..._DECL nodes and of the TYPE_CONTEXT of ..._TYPE nodes. */ struct deferred_decl_context_node { - tree decl; /* The ..._DECL node to work on. */ - Entity_Id gnat_scope; /* The corresponding entity's Scope attribute. */ - int force_global; /* force_global value when pushing DECL. */ - vec types; /* A list of ..._TYPE nodes to propagate the - context to. */ - struct deferred_decl_context_node *next; /* The next queue item. */ + /* The ..._DECL node to work on. */ + tree decl; + + /* The corresponding entity's Scope. */ + Entity_Id gnat_scope; + + /* The value of force_global when DECL was pushed. */ + int force_global; + + /* The list of ..._TYPE nodes to propagate the context to. */ + vec types; + + /* The next queue item. */ + struct deferred_decl_context_node *next; }; static struct deferred_decl_context_node *deferred_decl_context_queue = NULL; @@ -1217,7 +1224,8 @@ lookup_and_insert_pad_type (tree type) IS_COMPONENT_TYPE is true if this is being done for the component type of an array. IS_USER_TYPE is true if the original type needs to be completed. DEFINITION is true if this type is being defined. SET_RM_SIZE is true if - the RM size of the resulting type is to be set to SIZE too. */ + the RM size of the resulting type is to be set to SIZE too; in this case, + the padded type is canonicalized before being returned. */ tree maybe_pad_type (tree type, tree size, unsigned int align, @@ -1280,8 +1288,6 @@ maybe_pad_type (tree type, tree size, unsigned int align, type and name. */ record = make_node (RECORD_TYPE); TYPE_PADDING_P (record) = 1; - if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) - SET_TYPE_DEBUG_TYPE (record, type); /* ??? Padding types around packed array implementation types will be considered as root types in the array descriptor language hook (see @@ -1337,9 +1343,12 @@ maybe_pad_type (tree type, tree size, unsigned int align, bitsize_zero_node, 0, 1); DECL_INTERNAL_P (field) = 1; - /* Do not emit debug info until after the auxiliary record is built. */ + /* We will output additional debug info manually below. */ finish_record_type (record, field, 1, false); + if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) + SET_TYPE_DEBUG_TYPE (record, type); + /* Set the RM size if requested. */ if (set_rm_size) { @@ -1409,8 +1418,6 @@ maybe_pad_type (tree type, tree size, unsigned int align, } } - rest_of_record_type_compilation (record); - built: /* If a simple size was explicitly given, maybe issue a warning. */ if (!size @@ -1672,7 +1679,7 @@ finish_fat_pointer_type (tree record_type, tree field_list) laid out already; only set the sizes and alignment. If REP_LEVEL is two, this record is derived from a parent record and thus inherits its layout; only make a pass on the fields to finalize them. DEBUG_INFO_P is true if - we need to write debug information about this type. */ + additional debug info needs to be output for this type. */ void finish_record_type (tree record_type, tree field_list, int rep_level, @@ -1927,10 +1934,9 @@ has_parallel_type (tree type) return DECL_PARALLEL_TYPE (decl) != NULL_TREE; } -/* Wrap up compilation of RECORD_TYPE, i.e. output all the debug information - associated with it. It need not be invoked directly in most cases since - finish_record_type takes care of doing so, but this can be necessary if - a parallel type is to be attached to the record type. */ +/* Wrap up compilation of RECORD_TYPE, i.e. output additional debug info + associated with it. It need not be invoked directly in most cases as + finish_record_type takes care of doing so. */ void rest_of_record_type_compilation (tree record_type) @@ -2072,7 +2078,7 @@ rest_of_record_type_compilation (tree record_type) field_type = build_pointer_type (field_type); if (align != 0 && TYPE_ALIGN (field_type) > align) { - field_type = copy_node (field_type); + field_type = copy_type (field_type); SET_TYPE_ALIGN (field_type, align); } var = true; @@ -2284,10 +2290,10 @@ copy_type (tree type) aliased with TREE_CHAIN. */ TYPE_STUB_DECL (new_type) = TYPE_STUB_DECL (type); - TYPE_POINTER_TO (new_type) = 0; - TYPE_REFERENCE_TO (new_type) = 0; + TYPE_POINTER_TO (new_type) = NULL_TREE; + TYPE_REFERENCE_TO (new_type) = NULL_TREE; TYPE_MAIN_VARIANT (new_type) = new_type; - TYPE_NEXT_VARIANT (new_type) = 0; + TYPE_NEXT_VARIANT (new_type) = NULL_TREE; TYPE_CANONICAL (new_type) = new_type; return new_type; @@ -3431,14 +3437,14 @@ gnat_signed_or_unsigned_type_for (int unsignedp, tree type_node) if (TREE_CODE (type_node) == INTEGER_TYPE && TYPE_MODULAR_P (type_node)) { - type = copy_node (type); + type = copy_type (type); TREE_TYPE (type) = type_node; } else if (TREE_TYPE (type_node) && TREE_CODE (TREE_TYPE (type_node)) == INTEGER_TYPE && TYPE_MODULAR_P (TREE_TYPE (type_node))) { - type = copy_node (type); + type = copy_type (type); TREE_TYPE (type) = TREE_TYPE (type_node); } diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index c1bb74da287..d5dd436d48e 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -560,8 +560,8 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs, if (TYPE_PRECISION (op_type) < precision || TYPE_UNSIGNED (op_type) != unsignedp) { - /* Copy the node so we ensure it can be modified to make it modular. */ - op_type = copy_node (gnat_type_for_size (precision, unsignedp)); + /* Copy the type so we ensure it can be modified to make it modular. */ + op_type = copy_type (gnat_type_for_size (precision, unsignedp)); modulus = convert (op_type, modulus); SET_TYPE_MODULUS (op_type, modulus); TYPE_MODULAR_P (op_type) = 1; @@ -577,7 +577,8 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs, possible size. */ if (op_code == MULT_EXPR) { - tree div_type = copy_node (gnat_type_for_size (needed_precision, 1)); + /* Copy the type so we ensure it can be modified to make it modular. */ + tree div_type = copy_type (gnat_type_for_size (needed_precision, 1)); modulus = convert (div_type, modulus); SET_TYPE_MODULUS (div_type, modulus); TYPE_MODULAR_P (div_type) = 1; @@ -1761,9 +1762,10 @@ build_goto_raise (tree label, int msg) /* If Local_Raise is present, build Local_Raise (Exception'Identity). */ if (Present (local_raise)) { - tree gnu_local_raise = gnat_to_gnu_entity (local_raise, NULL_TREE, 0); + tree gnu_local_raise + = gnat_to_gnu_entity (local_raise, NULL_TREE, false); tree gnu_exception_entity - = gnat_to_gnu_entity (Get_RT_Exception_Entity (msg), NULL_TREE, 0); + = gnat_to_gnu_entity (Get_RT_Exception_Entity (msg), NULL_TREE, false); tree gnu_call = build_call_n_expr (gnu_local_raise, 1, build_unary_op (ADDR_EXPR, NULL_TREE, -- 2.11.4.GIT