diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 137 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 49 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.c | 2 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 109 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 99 |
5 files changed, 206 insertions, 190 deletions
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index a17eab6dbfb..af2d11ed50a 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -244,6 +244,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) const Entity_Kind kind = Ekind (gnat_entity); /* True if this is a type. */ const bool is_type = IN (kind, Type_Kind); + /* True if this is an artificial entity. */ + const bool artificial_p = !Comes_From_Source (gnat_entity); /* True if debug info is requested for this entity. */ const bool debug_info_p = Needs_Debug_Info (gnat_entity); /* True if this entity is to be considered as imported. */ @@ -1348,8 +1350,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_new_var = create_var_decl (create_concat_name (gnat_entity, "ALIGN"), NULL_TREE, gnu_new_type, NULL_TREE, false, - false, false, false, NULL, gnat_entity); - DECL_ARTIFICIAL (gnu_new_var) = 1; + false, false, false, true, debug_info_p, + NULL, gnat_entity); /* Initialize the aligned field if we have an initializer. */ if (gnu_expr) @@ -1389,12 +1391,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) just above, we have nothing to do here. */ if (!TYPE_IS_THIN_POINTER_P (gnu_type)) { + /* This variable is a GNAT encoding used by Workbench: let it + go through the debugging information but mark it as + artificial: users are not interested in it. */ tree gnu_unc_var = create_var_decl (concat_name (gnu_entity_name, "UNC"), NULL_TREE, gnu_type, gnu_expr, const_flag, Is_Public (gnat_entity), imported_p || !definition, static_p, - NULL, gnat_entity); + true, debug_info_p, NULL, gnat_entity); gnu_expr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var); TREE_CONSTANT (gnu_expr) = 1; @@ -1448,7 +1453,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_var_decl_1 (gnu_entity_name, gnu_ext_name, gnu_type, gnu_expr, const_flag, Is_Public (gnat_entity), imported_p || !definition, static_p, - !renamed_obj, attr_list, gnat_entity); + artificial_p, debug_info_p, !renamed_obj, + attr_list, gnat_entity); DECL_BY_REF_P (gnu_decl) = used_by_ref; DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag; DECL_CAN_NEVER_BE_NULL_P (gnu_decl) = Can_Never_Be_Null (gnat_entity); @@ -1497,19 +1503,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Is_Aliased (Etype (gnat_entity)))) { tree gnu_corr_var - = create_true_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, - gnu_expr, true, Is_Public (gnat_entity), - !definition, static_p, attr_list, - gnat_entity); + = create_var_decl_1 (gnu_entity_name, gnu_ext_name, gnu_type, + gnu_expr, true, Is_Public (gnat_entity), + !definition, static_p, artificial_p, + debug_info_p, false, attr_list, + gnat_entity); SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); - - /* As debugging information will be generated for the variable, - do not generate debugging information for the constant. */ - if (debug_info_p) - DECL_IGNORED_P (gnu_decl) = 1; - else - DECL_IGNORED_P (gnu_corr_var) = 1; } /* If this is a constant, even if we don't need a true variable, we @@ -1618,12 +1618,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { tree gnu_value = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type); + /* Do not generate debug info for individual enumerators. */ tree gnu_literal = create_var_decl (get_entity_name (gnat_literal), NULL_TREE, gnu_type, gnu_value, true, false, false, + false, !Comes_From_Source (gnat_literal), false, NULL, gnat_literal); - /* Do not generate debug info for individual enumerators. */ - DECL_IGNORED_P (gnu_literal) = 1; save_gnu_tree (gnat_literal, gnu_literal, false); gnu_list = tree_cons (DECL_NAME (gnu_literal), gnu_value, gnu_list); @@ -1731,12 +1731,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) SET_TYPE_RM_MIN_VALUE (gnu_type, elaborate_expression (Type_Low_Bound (gnat_entity), gnat_entity, "L", definition, true, - Needs_Debug_Info (gnat_entity))); + debug_info_p)); SET_TYPE_RM_MAX_VALUE (gnu_type, elaborate_expression (Type_High_Bound (gnat_entity), gnat_entity, "U", definition, true, - Needs_Debug_Info (gnat_entity))); + debug_info_p)); TYPE_BIASED_REPRESENTATION_P (gnu_type) = Has_Biased_Representation (gnat_entity); @@ -1911,12 +1911,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) SET_TYPE_RM_MIN_VALUE (gnu_type, elaborate_expression (Type_Low_Bound (gnat_entity), gnat_entity, "L", definition, true, - Needs_Debug_Info (gnat_entity))); + debug_info_p)); SET_TYPE_RM_MAX_VALUE (gnu_type, elaborate_expression (Type_High_Bound (gnat_entity), gnat_entity, "U", definition, true, - Needs_Debug_Info (gnat_entity))); + debug_info_p)); /* Inherit our alias set from what we're a subtype of, as for integer subtypes. */ @@ -2215,8 +2215,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } create_type_decl (create_concat_name (gnat_entity, "XUA"), tem, - !Comes_From_Source (gnat_entity), debug_info_p, - gnat_entity); + artificial_p, debug_info_p, gnat_entity); /* Give the fat pointer type a name. If this is a packed array, tell the debugger how to interpret the underlying bits. */ @@ -2225,8 +2224,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else gnat_name = gnat_entity; create_type_decl (create_concat_name (gnat_name, "XUP"), gnu_fat_type, - !Comes_From_Source (gnat_entity), debug_info_p, - gnat_entity); + artificial_p, debug_info_p, gnat_entity); /* Create the type to be designated by thin pointers: a record type for the array and its template. We used to shift the fields to have the @@ -2672,8 +2670,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_decl = create_type_decl (gnu_entity_name, gnu_type, !Comes_From_Source (Etype (gnat_entity)) - && !Comes_From_Source (gnat_entity), - debug_info_p, gnat_entity); + && artificial_p, debug_info_p, + gnat_entity); /* Save it as our equivalent in case the call below elaborates this type again. */ @@ -3174,7 +3172,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) components_to_record (gnu_type, Component_List (record_definition), gnu_field_list, packed, definition, false, all_rep, is_unchecked_union, - !Comes_From_Source (gnat_entity), debug_info_p, + artificial_p, debug_info_p, false, OK_To_Reorder_Components (gnat_entity), all_rep ? NULL_TREE : bitsize_zero_node, NULL); @@ -3605,8 +3603,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_var_decl (create_concat_name (gnat_entity, "XVZ"), NULL_TREE, sizetype, gnu_size_unit, - false, false, false, false, NULL, - gnat_entity); + false, false, false, false, true, + debug_info_p, NULL, gnat_entity); } gnu_variant_list.release (); @@ -3665,8 +3663,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = build_pointer_type (make_dummy_type (Directly_Designated_Type (gnat_entity))); gnu_decl = create_type_decl (gnu_entity_name, gnu_type, - !Comes_From_Source (gnat_entity), - debug_info_p, gnat_entity); + artificial_p, debug_info_p, + gnat_entity); this_made_decl = true; gnu_type = TREE_TYPE (gnu_decl); save_gnu_tree (gnat_entity, gnu_decl, false); @@ -3920,8 +3918,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) process_attributes (&gnu_type, &attr_list, false, gnat_entity); gnu_decl = create_type_decl (gnu_entity_name, gnu_type, - !Comes_From_Source (gnat_entity), - debug_info_p, gnat_entity); + artificial_p, debug_info_p, + gnat_entity); this_made_decl = true; gnu_type = TREE_TYPE (gnu_decl); save_gnu_tree (gnat_entity, gnu_decl, false); @@ -4104,7 +4102,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || imported_p || (Convention (gnat_entity) == Convention_Intrinsic && Has_Pragma_Inline_Always (gnat_entity))); - bool artificial_flag = !Comes_From_Source (gnat_entity); /* The semantics of "pure" in Ada essentially matches that of "const" in the back-end. In particular, both properties are orthogonal to the "nothrow" property if the EH circuitry is explicit in the @@ -4242,12 +4239,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type))) { tree orig_type = gnu_return_type; + tree max_return_size + = max_size (TYPE_SIZE (gnu_return_type), true); + + /* If the size overflows to 0, set it to an arbitrary positive + value so that assignments in the type are preserved. Their + actual size is independent of this positive value. */ + if (TREE_CODE (max_return_size) == INTEGER_CST + && TREE_OVERFLOW (max_return_size) + && integer_zerop (max_return_size)) + { + max_return_size = copy_node (bitsize_unit_node); + TREE_OVERFLOW (max_return_size) = 1; + } gnu_return_type - = maybe_pad_type (gnu_return_type, - max_size (TYPE_SIZE (gnu_return_type), - true), - 0, gnat_entity, false, false, definition, + = maybe_pad_type (gnu_return_type, max_return_size, 0, + gnat_entity, false, false, definition, true); /* Declare it now since it will never be declared otherwise. @@ -4600,7 +4608,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_decl = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_address, false, Is_Public (gnat_entity), - extern_flag, false, NULL, gnat_entity); + extern_flag, false, artificial_p, + debug_info_p, NULL, gnat_entity); DECL_BY_REF_P (gnu_decl) = 1; } @@ -4608,7 +4617,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { process_attributes (&gnu_type, &attr_list, false, gnat_entity); gnu_decl - = create_type_decl (gnu_entity_name, gnu_type, artificial_flag, + = create_type_decl (gnu_entity_name, gnu_type, artificial_p, debug_info_p, gnat_entity); } else @@ -4616,8 +4625,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_decl = create_subprog_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_param_list, inline_status, - public_flag, extern_flag, artificial_flag, - attr_list, gnat_entity); + public_flag, extern_flag, artificial_p, + debug_info_p, attr_list, gnat_entity); /* This is unrelated to the stub built right above. */ DECL_STUBBED_P (gnu_decl) = Convention (gnat_entity) == Convention_Stubbed; @@ -5009,8 +5018,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (!gnu_decl) gnu_decl = create_type_decl (gnu_entity_name, gnu_type, - !Comes_From_Source (gnat_entity), - debug_info_p, gnat_entity); + artificial_p, debug_info_p, + gnat_entity); else { TREE_TYPE (gnu_decl) = gnu_type; @@ -5174,29 +5183,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type))); } - /* If we really have a ..._DECL node, set a couple of flags on it. But we - cannot do so if we are reusing the ..._DECL node made for an equivalent - type or an alias or a renamed object as the predicates don't apply to it - but to GNAT_ENTITY. */ - if (DECL_P (gnu_decl) - && !(is_type && gnat_equiv_type != gnat_entity) - && !Present (Alias (gnat_entity)) - && !(Present (Renamed_Object (gnat_entity)) && saved)) - { - /* ??? DECL_ARTIFICIAL, and possibly DECL_IGNORED_P below, should - be set before calling rest_of_decl_compilation above (through - create_var_decl_1). This is because rest_of_decl_compilation - calls the debugging backend and will create a DIE without - DW_AT_artificial. - - This is currently causing gnat.dg/specs/debug1.ads to FAIL. */ - if (!Comes_From_Source (gnat_entity)) - DECL_ARTIFICIAL (gnu_decl) = 1; - - if (!debug_info_p) - DECL_IGNORED_P (gnu_decl) = 1; - } - /* If we haven't already, associate the ..._DECL node that we just made with the input GNAT entity node. */ if (!saved) @@ -5385,7 +5371,8 @@ get_minimal_subprog_decl (Entity_Id gnat_entity) return create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE, - is_disabled, true, true, true, attr_list, gnat_entity); + is_disabled, true, true, true, false, attr_list, + gnat_entity); } /* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is @@ -6250,14 +6237,10 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s, new variable must not be tagged "external", as we used to do here as soon as DEFINITION was false. */ tree gnu_decl - = create_var_decl_1 (create_concat_name (gnat_entity, s), NULL_TREE, - TREE_TYPE (gnu_expr), gnu_expr, true, - expr_public_p, !definition && expr_global_p, - expr_global_p, !need_debug, NULL, gnat_entity); - - /* Whether or not gnat_entity comes from source, this variable is a - compilation artifact. */ - DECL_ARTIFICIAL (gnu_decl) = 1; + = create_var_decl (create_concat_name (gnat_entity, s), NULL_TREE, + TREE_TYPE (gnu_expr), gnu_expr, true, + expr_public_p, !definition && expr_global_p, + expr_global_p, true, need_debug, NULL, gnat_entity); /* Using this variable at debug time (if need_debug is true) requires a proper location. The back-end will compute a location for this diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index b85f3512d40..118ce33ccd0 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -599,7 +599,7 @@ extern void build_dummy_unc_pointer_types (Entity_Id gnat_desig_type, tree gnu_desig_type); /* Record TYPE as a builtin type for Ada. NAME is the name of the type. - ARTIFICIAL_P is true if it's a type that was generated by the compiler. */ + ARTIFICIAL_P is true if the type was generated by the compiler. */ extern void record_builtin_type (const char *name, tree type, bool artificial_p); @@ -660,10 +660,10 @@ extern tree create_range_type (tree type, tree min, tree max); extern tree create_type_stub_decl (tree type_name, tree type); /* Return a TYPE_DECL node. TYPE_NAME gives the name of the type and TYPE - is a ..._TYPE node giving its data type. ARTIFICIAL_P is true if this - is a declaration that was generated by the compiler. DEBUG_INFO_P is - true if we need to write debug information about this type. GNAT_NODE - is used for the position of the decl. */ + is a ..._TYPE node giving its data type. ARTIFICIAL_P is true if the + declaration was generated by the compiler. DEBUG_INFO_P is true if we + need to write debug information about this type. GNAT_NODE is used for + the position of the decl. */ extern tree create_type_decl (tree type_name, tree type, bool artificial_p, bool debug_info_p, Node_Id gnat_node); @@ -686,32 +686,28 @@ extern tree create_type_decl (tree type_name, tree type, bool artificial_p, STATIC_FLAG is only relevant when not at top level. In that case it indicates whether to always allocate storage to the variable. + ARTIFICIAL_P is true if the variable was generated by the compiler. + + DEBUG_INFO_P is true if we need to write debug information for it. + GNAT_NODE is used for the position of the decl. */ extern tree create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, bool const_flag, bool public_flag, bool extern_flag, - bool static_flag, bool const_decl_allowed_p, - struct attrib *attr_list, Node_Id gnat_node); + bool static_flag, bool artificial_p, bool debug_info_p, + bool const_decl_allowed_p, struct attrib *attr_list, + Node_Id gnat_node); /* Wrapper around create_var_decl_1 for cases where we don't care whether a VAR or a CONST decl node is created. */ #define create_var_decl(var_name, asm_name, type, var_init, \ const_flag, public_flag, extern_flag, \ - static_flag, attr_list, gnat_node) \ + static_flag, artificial_p, debug_info_p,\ + attr_list, gnat_node) \ create_var_decl_1 (var_name, asm_name, type, var_init, \ const_flag, public_flag, extern_flag, \ - static_flag, true, attr_list, gnat_node) - -/* Wrapper around create_var_decl_1 for cases where a VAR_DECL node is - required. The primary intent is for DECL_CONST_CORRESPONDING_VARs, which - must be VAR_DECLs and on which we want TREE_READONLY set to have them - possibly assigned to a readonly data section. */ -#define create_true_var_decl(var_name, asm_name, type, var_init, \ - const_flag, public_flag, extern_flag, \ - static_flag, attr_list, gnat_node) \ - create_var_decl_1 (var_name, asm_name, type, var_init, \ - const_flag, public_flag, extern_flag, \ - static_flag, false, attr_list, gnat_node) + static_flag, artificial_p, debug_info_p, \ + true, attr_list, gnat_node) /* Return a FIELD_DECL node. FIELD_NAME is the field's name, FIELD_TYPE is its type and RECORD_TYPE is the type of the enclosing record. If SIZE is @@ -739,14 +735,19 @@ extern tree create_label_decl (tree label_name, Node_Id gnat_node); node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of PARM_DECL nodes chained through the DECL_CHAIN field). - INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are - used to set the appropriate fields in the FUNCTION_DECL. GNAT_NODE is - used for the position of the decl. */ + INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG and ATTR_LIST are used to set the + appropriate fields in the FUNCTION_DECL. + + ARTIFICIAL_P is true if the subprogram was generated by the compiler. + + DEBUG_INFO_P is true if we need to write debug information for it. + + GNAT_NODE is used for the position of the decl. */ extern tree create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type, tree param_decl_list, enum inline_status_t inline_status, bool public_flag, bool extern_flag, - bool artificial_flag, + bool artificial_p, bool debug_info_p, struct attrib *attr_list, Node_Id gnat_node); /* Process the attributes in ATTR_LIST for NODE, which is either a DECL or diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index cc1f92345cc..55d40dd5527 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -1002,6 +1002,8 @@ gnat_init_ts (void) #define LANG_HOOKS_DEEP_UNSHARING true #undef LANG_HOOKS_INIT_TS #define LANG_HOOKS_INIT_TS gnat_init_ts +#undef LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL +#define LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL hook_bool_const_tree_false struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 85a77ea5faf..bf15955e4df 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -390,16 +390,14 @@ gigi (Node_Id gnat_root, gcc_assert (t == boolean_false_node); t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE, boolean_type_node, t, true, false, false, false, - NULL, gnat_literal); - DECL_IGNORED_P (t) = 1; + true, false, NULL, gnat_literal); save_gnu_tree (gnat_literal, t, false); gnat_literal = Next_Literal (gnat_literal); t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node); gcc_assert (t == boolean_true_node); t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE, boolean_type_node, t, true, false, false, false, - NULL, gnat_literal); - DECL_IGNORED_P (t) = 1; + true, false, NULL, gnat_literal); save_gnu_tree (gnat_literal, t, false); void_ftype = build_function_type_list (void_type_node, NULL_TREE); @@ -412,7 +410,8 @@ gigi (Node_Id gnat_root, memory. */ malloc_decl = create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE, - ftype, NULL_TREE, is_disabled, true, true, true, + ftype, + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); DECL_IS_MALLOC (malloc_decl) = 1; @@ -422,8 +421,8 @@ gigi (Node_Id gnat_root, build_function_type_list (void_type_node, ptr_type_node, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, - Empty); + NULL_TREE, is_disabled, true, true, true, false, + NULL, Empty); /* This is used for 64-bit multiplication with overflow checking. */ int64_type = gnat_type_for_size (64, 0); @@ -431,8 +430,8 @@ gigi (Node_Id gnat_root, = create_subprog_decl (get_identifier ("__gnat_mulv64"), NULL_TREE, build_function_type_list (int64_type, int64_type, int64_type, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, - Empty); + NULL_TREE, is_disabled, true, true, true, false, + NULL, Empty); /* Name of the _Parent field in tagged record types. */ parent_name_id = get_identifier (Get_Name_String (Name_uParent)); @@ -453,16 +452,14 @@ gigi (Node_Id gnat_root, = create_subprog_decl (get_identifier ("system__soft_links__get_jmpbuf_address_soft"), NULL_TREE, build_function_type_list (jmpbuf_ptr_type, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, Empty); - DECL_IGNORED_P (get_jmpbuf_decl) = 1; + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); set_jmpbuf_decl = create_subprog_decl (get_identifier ("system__soft_links__set_jmpbuf_address_soft"), NULL_TREE, build_function_type_list (void_type_node, jmpbuf_ptr_type, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, Empty); - DECL_IGNORED_P (set_jmpbuf_decl) = 1; + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); /* setjmp returns an integer and has one operand, which is a pointer to a jmpbuf. */ @@ -471,7 +468,7 @@ gigi (Node_Id gnat_root, (get_identifier ("__builtin_setjmp"), NULL_TREE, build_function_type_list (integer_type_node, jmpbuf_ptr_type, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL; DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP; @@ -481,7 +478,7 @@ gigi (Node_Id gnat_root, = create_subprog_decl (get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE, build_function_type_list (void_type_node, jmpbuf_ptr_type, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL; DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF; @@ -490,29 +487,28 @@ gigi (Node_Id gnat_root, begin_handler_decl = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE, - ftype, NULL_TREE, is_disabled, true, true, true, + ftype, NULL_TREE, + is_disabled, true, true, true, false, NULL, Empty); - DECL_IGNORED_P (begin_handler_decl) = 1; end_handler_decl = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE, - ftype, NULL_TREE, is_disabled, true, true, true, + ftype, NULL_TREE, + is_disabled, true, true, true, false, NULL, Empty); - DECL_IGNORED_P (end_handler_decl) = 1; unhandled_except_decl = create_subprog_decl (get_identifier ("__gnat_unhandled_except_handler"), - NULL_TREE, - ftype, NULL_TREE, is_disabled, true, true, true, + NULL_TREE, ftype, NULL_TREE, + is_disabled, true, true, true, false, NULL, Empty); - DECL_IGNORED_P (unhandled_except_decl) = 1; reraise_zcx_decl = create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE, - ftype, NULL_TREE, is_disabled, true, true, true, + ftype, NULL_TREE, + is_disabled, true, true, true, false, NULL, Empty); /* Indicate that these never return. */ - DECL_IGNORED_P (reraise_zcx_decl) = 1; TREE_THIS_VOLATILE (reraise_zcx_decl) = 1; TREE_SIDE_EFFECTS (reraise_zcx_decl) = 1; TREE_TYPE (reraise_zcx_decl) @@ -530,7 +526,7 @@ gigi (Node_Id gnat_root, build_pointer_type (unsigned_char_type_node), integer_type_node, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); TREE_THIS_VOLATILE (decl) = 1; TREE_SIDE_EFFECTS (decl) = 1; TREE_TYPE (decl) @@ -561,15 +557,14 @@ gigi (Node_Id gnat_root, (get_identifier ("system__soft_links__get_gnat_exception"), NULL_TREE, build_function_type_list (build_pointer_type (except_type_node), NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, Empty); - DECL_IGNORED_P (get_excptr_decl) = 1; + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); set_exception_parameter_decl = create_subprog_decl (get_identifier ("__gnat_set_exception_parameter"), NULL_TREE, build_function_type_list (void_type_node, ptr_type_node, ptr_type_node, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); raise_nodefer_decl = create_subprog_decl @@ -577,7 +572,7 @@ gigi (Node_Id gnat_root, build_function_type_list (void_type_node, build_pointer_type (except_type_node), NULL_TREE), - NULL_TREE, is_disabled, true, true, true, NULL, Empty); + NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); /* Indicate that it never returns. */ TREE_THIS_VOLATILE (raise_nodefer_decl) = 1; @@ -625,20 +620,23 @@ gigi (Node_Id gnat_root, others_decl = create_var_decl (get_identifier ("OTHERS"), get_identifier ("__gnat_others_value"), - unsigned_char_type_node, - NULL_TREE, true, false, true, false, NULL, Empty); + unsigned_char_type_node, NULL_TREE, + true, false, true, false, true, false, + NULL, Empty); all_others_decl = create_var_decl (get_identifier ("ALL_OTHERS"), get_identifier ("__gnat_all_others_value"), - unsigned_char_type_node, - NULL_TREE, true, false, true, false, NULL, Empty); + unsigned_char_type_node, NULL_TREE, + true, false, true, false, true, false, + NULL, Empty); unhandled_others_decl = create_var_decl (get_identifier ("UNHANDLED_OTHERS"), get_identifier ("__gnat_unhandled_others_value"), - unsigned_char_type_node, - NULL_TREE, true, false, true, false, NULL, Empty); + unsigned_char_type_node, NULL_TREE, + true, false, true, false, true, false, + NULL, Empty); main_identifier_node = get_identifier ("main"); @@ -750,7 +748,8 @@ build_raise_check (int check, enum exception_info_kind kind) result = create_subprog_decl (get_identifier (Name_Buffer), NULL_TREE, ftype, NULL_TREE, - is_disabled, true, true, true, NULL, Empty); + is_disabled, true, true, true, false, + NULL, Empty); /* Indicate that it never returns. */ TREE_THIS_VOLATILE (result) = 1; @@ -3664,7 +3663,8 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) gnu_return_var = create_var_decl (get_identifier ("RETVAL"), NULL_TREE, gnu_return_type, NULL_TREE, false, false, - false, false, NULL, gnat_subprog_id); + false, false, true, false, + NULL, gnat_subprog_id); TREE_VALUE (gnu_return_var_elmt) = gnu_return_var; } @@ -4068,10 +4068,7 @@ create_temporary (const char *prefix, tree type) { tree gnu_temp = create_var_decl (create_tmp_var_name (prefix), NULL_TREE, type, NULL_TREE, false, false, false, false, - NULL, Empty); - DECL_ARTIFICIAL (gnu_temp) = 1; - DECL_IGNORED_P (gnu_temp) = 1; - + true, false, NULL, Empty); return gnu_temp; } @@ -4847,8 +4844,8 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) = create_var_decl (get_identifier ("JMPBUF_SAVE"), NULL_TREE, jmpbuf_ptr_type, build_call_n_expr (get_jmpbuf_decl, 0), - false, false, false, false, NULL, gnat_node); - DECL_ARTIFICIAL (gnu_jmpsave_decl) = 1; + false, false, false, false, true, false, + NULL, gnat_node); /* The __builtin_setjmp receivers will immediately reinstall it. Now because of the unstructured form of EH used by setjmp_longjmp, there @@ -4859,8 +4856,8 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) = create_var_decl (get_identifier ("JMP_BUF"), NULL_TREE, jmpbuf_type, NULL_TREE, - false, false, false, false, NULL, gnat_node); - DECL_ARTIFICIAL (gnu_jmpbuf_decl) = 1; + false, false, false, false, true, false, + NULL, gnat_node); set_block_jmpbuf_decl (gnu_jmpbuf_decl); @@ -4917,7 +4914,7 @@ Handled_Sequence_Of_Statements_to_gnu (Node_Id gnat_node) create_var_decl (get_identifier ("EXCEPT_PTR"), NULL_TREE, build_pointer_type (except_type_node), build_call_n_expr (get_excptr_decl, 0), - false, false, false, false, + false, false, false, false, true, false, NULL, gnat_node)); /* Generate code for each handler. The N_Exception_Handler case does the @@ -5163,10 +5160,11 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node) = build_call_expr (builtin_decl_explicit (BUILT_IN_EH_POINTER), 1, integer_zero_node); prev_gnu_incoming_exc_ptr = gnu_incoming_exc_ptr; - gnu_incoming_exc_ptr = create_var_decl (get_identifier ("EXPTR"), NULL_TREE, - ptr_type_node, gnu_current_exc_ptr, - false, false, false, false, - NULL, gnat_node); + gnu_incoming_exc_ptr + = create_var_decl (get_identifier ("EXPTR"), NULL_TREE, + ptr_type_node, gnu_current_exc_ptr, + false, false, false, false, true, true, + NULL, gnat_node); add_stmt_with_node (build_call_n_expr (begin_handler_decl, 1, gnu_incoming_exc_ptr), @@ -5212,8 +5210,8 @@ Compilation_Unit_to_gnu (Node_Id gnat_node) tree gnu_elab_proc_decl = create_subprog_decl (create_concat_name (gnat_unit_entity, body_p ? "elabb" : "elabs"), - NULL_TREE, void_ftype, NULL_TREE, is_disabled, true, false, true, NULL, - gnat_unit); + NULL_TREE, void_ftype, NULL_TREE, is_disabled, true, false, true, true, + NULL, gnat_unit); struct elab_info *info; vec_safe_push (gnu_elab_proc_stack, gnu_elab_proc_decl); @@ -6127,7 +6125,7 @@ gnat_to_gnu (Node_Id gnat_node) (Entity (Prefix (gnat_node)), attr == Attr_Elab_Body ? "elabb" : "elabs"), NULL_TREE, void_ftype, NULL_TREE, is_disabled, - true, true, true, NULL, gnat_node); + true, true, true, true, NULL, gnat_node); gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attr); } @@ -6861,7 +6859,7 @@ gnat_to_gnu (Node_Id gnat_node) tree gnu_ret_deref = build_unary_op (INDIRECT_REF, TREE_TYPE (gnu_ret_val), gnu_ret_obj); - gnu_result = build2 (MODIFY_EXPR, void_type_node, + gnu_result = build2 (INIT_EXPR, void_type_node, gnu_ret_deref, gnu_ret_val); add_stmt_with_node (gnu_result, gnat_node); gnu_ret_val = NULL_TREE; @@ -7087,7 +7085,8 @@ gnat_to_gnu (Node_Id gnat_node) deallocated. */ gnu_expr = create_var_decl (get_identifier ("SAVED_EXPTR"), NULL_TREE, ptr_type_node, gnu_incoming_exc_ptr, - false, false, false, false, NULL, gnat_node); + false, false, false, false, true, true, + NULL, gnat_node); add_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_incoming_exc_ptr, convert (ptr_type_node, integer_zero_node))); diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index e4b96d7b120..fbdf4733833 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1377,8 +1377,25 @@ maybe_pad_type (tree type, tree size, unsigned int align, && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL && DECL_IGNORED_P (TYPE_NAME (type)))) { - tree marker = make_node (RECORD_TYPE); tree name = TYPE_IDENTIFIER (record); + tree size_unit = TYPE_SIZE_UNIT (record); + + /* A variable that holds the size is required even with no encoding since + it will be referenced by debugging information attributes. At global + level, we need a single variable across all translation units. */ + if (size + && TREE_CODE (size) != INTEGER_CST + && (definition || global_bindings_p ())) + { + size_unit + = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype, + size_unit, true, global_bindings_p (), + !definition && global_bindings_p (), false, + true, true, NULL, gnat_entity); + TYPE_SIZE_UNIT (record) = size_unit; + } + + tree marker = make_node (RECORD_TYPE); tree orig_name = TYPE_IDENTIFIER (type); TYPE_NAME (marker) = concat_name (name, "XVS"); @@ -1388,14 +1405,9 @@ maybe_pad_type (tree type, tree size, unsigned int align, marker, NULL_TREE, NULL_TREE, 0, 0), 0, true); + TYPE_SIZE_UNIT (marker) = size_unit; add_parallel_type (record, marker); - - if (definition && size && TREE_CODE (size) != INTEGER_CST) - TYPE_SIZE_UNIT (marker) - = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype, - TYPE_SIZE_UNIT (record), false, false, false, - false, NULL, gnat_entity); } rest_of_record_type_compilation (record); @@ -1537,7 +1549,7 @@ relate_alias_sets (tree gnu_new_type, tree gnu_old_type, enum alias_set_op op) } /* Record TYPE as a builtin type for Ada. NAME is the name of the type. - ARTIFICIAL_P is true if it's a type that was generated by the compiler. */ + ARTIFICIAL_P is true if the type was generated by the compiler. */ void record_builtin_type (const char *name, tree type, bool artificial_p) @@ -2241,9 +2253,6 @@ create_range_type (tree type, tree min, tree max) tree create_type_stub_decl (tree type_name, tree type) { - /* Using a named TYPE_DECL ensures that a type name marker is emitted in - STABS while setting DECL_ARTIFICIAL ensures that no DW_TAG_typedef is - emitted in DWARF. */ tree type_decl = build_decl (input_location, TYPE_DECL, type_name, type); DECL_ARTIFICIAL (type_decl) = 1; TYPE_ARTIFICIAL (type) = 1; @@ -2251,10 +2260,10 @@ create_type_stub_decl (tree type_name, tree type) } /* Return a TYPE_DECL node. TYPE_NAME gives the name of the type and TYPE - is a ..._TYPE node giving its data type. ARTIFICIAL_P is true if this - is a declaration that was generated by the compiler. DEBUG_INFO_P is - true if we need to write debug information about this type. GNAT_NODE - is used for the position of the decl. */ + is a ..._TYPE node giving its data type. ARTIFICIAL_P is true if the + declaration was generated by the compiler. DEBUG_INFO_P is true if we + need to write debug information about this type. GNAT_NODE is used for + the position of the decl. */ tree create_type_decl (tree type_name, tree type, bool artificial_p, @@ -2322,13 +2331,18 @@ create_type_decl (tree type_name, tree type, bool artificial_p, STATIC_FLAG is only relevant when not at top level. In that case it indicates whether to always allocate storage to the variable. + ARTIFICIAL_P is true if the variable was generated by the compiler. + + DEBUG_INFO_P is true if we need to write debug information for it. + GNAT_NODE is used for the position of the decl. */ tree create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, bool const_flag, bool public_flag, bool extern_flag, - bool static_flag, bool const_decl_allowed_p, - struct attrib *attr_list, Node_Id gnat_node) + bool static_flag, bool artificial_p, bool debug_info_p, + bool const_decl_allowed_p, struct attrib *attr_list, + Node_Id gnat_node) { /* Whether the object has static storage duration, either explicitly or by virtue of being declared at the global level. */ @@ -2379,10 +2393,14 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, if (var_init && !init_const && global_bindings_p ()) Check_Elaboration_Code_Allowed (gnat_node); - DECL_INITIAL (var_decl) = var_init; - TREE_READONLY (var_decl) = const_flag; + /* Attach the initializer, if any. */ + DECL_INITIAL (var_decl) = var_init; + + /* Directly set some flags. */ + DECL_ARTIFICIAL (var_decl) = artificial_p; DECL_EXTERNAL (var_decl) = extern_flag; TREE_CONSTANT (var_decl) = constant_p; + TREE_READONLY (var_decl) = const_flag; /* We need to allocate static storage for an object with static storage duration if it isn't external. */ @@ -2402,14 +2420,18 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, && !have_global_bss_p ()) DECL_COMMON (var_decl) = 1; - /* For an external constant whose initializer is not absolute, do not emit - debug info. In DWARF this would mean a global relocation in a read-only - section which runs afoul of the PE-COFF run-time relocation mechanism. */ - if (extern_flag - && constant_p - && var_init - && initializer_constant_valid_p (var_init, TREE_TYPE (var_init)) - != null_pointer_node) + /* Do not emit debug info for a CONST_DECL if optimization isn't enabled, + since we will create an associated variable. Likewise for an external + constant whose initializer is not absolute, because this would mean a + global relocation in a read-only section which runs afoul of the PE-COFF + run-time relocation mechanism. */ + if (!debug_info_p + || (TREE_CODE (var_decl) == CONST_DECL && !optimize) + || (extern_flag + && constant_p + && var_init + && initializer_constant_valid_p (var_init, TREE_TYPE (var_init)) + != null_pointer_node)) DECL_IGNORED_P (var_decl) = 1; if (TYPE_VOLATILE (type)) @@ -3023,15 +3045,21 @@ create_label_decl (tree label_name, Node_Id gnat_node) node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of PARM_DECL nodes chained through the DECL_CHAIN field). - INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG, ARTIFICIAL_FLAG and ATTR_LIST are - used to set the appropriate fields in the FUNCTION_DECL. GNAT_NODE is - used for the position of the decl. */ + INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG and ATTR_LIST are used to set the + appropriate fields in the FUNCTION_DECL. + + ARTIFICIAL_P is true if the subprogram was generated by the compiler. + + DEBUG_INFO_P is true if we need to write debug information for it. + + GNAT_NODE is used for the position of the decl. */ tree create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type, tree param_decl_list, enum inline_status_t inline_status, - bool public_flag, bool extern_flag, bool artificial_flag, - struct attrib *attr_list, Node_Id gnat_node) + bool public_flag, bool extern_flag, bool artificial_p, + bool debug_info_p, struct attrib *attr_list, + Node_Id gnat_node) { tree subprog_decl = build_decl (input_location, FUNCTION_DECL, subprog_name, subprog_type); @@ -3039,7 +3067,7 @@ create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type, TREE_TYPE (subprog_type)); DECL_ARGUMENTS (subprog_decl) = param_decl_list; - DECL_ARTIFICIAL (subprog_decl) = artificial_flag; + DECL_ARTIFICIAL (subprog_decl) = artificial_p; DECL_EXTERNAL (subprog_decl) = extern_flag; switch (inline_status) @@ -3062,13 +3090,16 @@ create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type, case is_enabled: DECL_DECLARED_INLINE_P (subprog_decl) = 1; - DECL_NO_INLINE_WARNING_P (subprog_decl) = artificial_flag; + DECL_NO_INLINE_WARNING_P (subprog_decl) = artificial_p; break; default: gcc_unreachable (); } + if (!debug_info_p) + DECL_IGNORED_P (subprog_decl) = 1; + TREE_PUBLIC (subprog_decl) = public_flag; TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type); TREE_THIS_VOLATILE (subprog_decl) = TYPE_VOLATILE (subprog_type); |