From 2056c5ede5306b0a0ad948d8409c5f7484ee65bf Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 30 Nov 2015 11:50:53 +0000 Subject: [PATCH] gigi.h (create_var_decl): Adjust prototype. * gcc-interface/gigi.h (create_var_decl): Adjust prototype. (create_subprog_decl): Likewise. * gcc-interface/decl.c (gnat_to_gnu_entity) : Rename static_p into static_flag and add volatile_flag local variable. Do not locally change the type of a volatile object, except for the pointed-to type if the object is handled by reference. Adjust calls to create_var_decl. : Likewise for const and noreturn subprograms. (get_minimal_subprog_decl): Adjust call to create_subprog_decl. (elaborate_expression_1): Adjust call to create_var_decl. (gnat_to_gnu_field): Minor tweak. * gcc-interface/trans.c (gigi): Adjust calls to create_var_decl and create_subprog_decl. (build_raise_check): Likewise. (Subprogram_Body_to_gnu): Likewise. (create_temporary): Likewise. (Handled_Sequence_Of_Statements_to_gnu): Likewise. (Exception_Handler_to_gnu_gcc): Likewise. (Compilation_Unit_to_gnu): Likewise. (gnat_to_gnu): Likewise. * gcc-interface/utils.c (maybe_pad_type): Likewise. (create_var_decl): Add VOLATILE_FLAG parameter and handle it. (create_subprog_decl): Add CONST_FLAG and VOLATILE_FLAG parameters and handle them. From-SVN: r231065 --- gcc/ada/ChangeLog | 27 ++++++++ gcc/ada/gcc-interface/decl.c | 123 ++++++++++++++++++---------------- gcc/ada/gcc-interface/gigi.h | 14 ++-- gcc/ada/gcc-interface/trans.c | 119 ++++++++++++++++---------------- gcc/ada/gcc-interface/utils.c | 56 +++++++++------- 5 files changed, 187 insertions(+), 152 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fa64fd5b110..34b12caa154 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2015-11-30 Eric Botcazou + + * gcc-interface/gigi.h (create_var_decl): Adjust prototype. + (create_subprog_decl): Likewise. + * gcc-interface/decl.c (gnat_to_gnu_entity) : Rename + static_p into static_flag and add volatile_flag local variable. + Do not locally change the type of a volatile object, except for the + pointed-to type if the object is handled by reference. Adjust calls + to create_var_decl. + : Likewise for const and noreturn subprograms. + (get_minimal_subprog_decl): Adjust call to create_subprog_decl. + (elaborate_expression_1): Adjust call to create_var_decl. + (gnat_to_gnu_field): Minor tweak. + * gcc-interface/trans.c (gigi): Adjust calls to create_var_decl and + create_subprog_decl. + (build_raise_check): Likewise. + (Subprogram_Body_to_gnu): Likewise. + (create_temporary): Likewise. + (Handled_Sequence_Of_Statements_to_gnu): Likewise. + (Exception_Handler_to_gnu_gcc): Likewise. + (Compilation_Unit_to_gnu): Likewise. + (gnat_to_gnu): Likewise. + * gcc-interface/utils.c (maybe_pad_type): Likewise. + (create_var_decl): Add VOLATILE_FLAG parameter and handle it. + (create_subprog_decl): Add CONST_FLAG and VOLATILE_FLAG parameters and + handle them. + 2015-11-30 Eric Botcazou * gcc-interface/gigi.h (is_simple_additive_expression): Declare. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 2450b5066b0..c72e9207fe0 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -598,7 +598,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Present (Renamed_Object (gnat_entity)) || imported_p)); bool inner_const_flag = const_flag; - bool static_p = Is_Statically_Allocated (gnat_entity); + bool static_flag = Is_Statically_Allocated (gnat_entity); + /* We implement RM 13.3(19) for exported and imported (non-constant) + objects by making them volatile. */ + bool volatile_flag + = (Treat_As_Volatile (gnat_entity) + || (!const_flag && (Is_Exported (gnat_entity) || imported_p))); bool mutable_p = false; bool used_by_ref = false; tree gnu_ext_name = NULL_TREE; @@ -1034,10 +1039,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type)) gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE); - gnu_type = build_reference_type (gnu_type); used_by_ref = true; const_flag = true; + volatile_flag = false; inner_const_flag = TREE_READONLY (gnu_expr); gnu_size = NULL_TREE; @@ -1068,21 +1073,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } } - /* Make a volatile version of this object's type if we are to make - the object volatile. We also implement RM 13.3(19) for exported - and imported (non-constant) objects by making them volatile. */ - if ((Treat_As_Volatile (gnat_entity) - || (!const_flag - && gnu_type != except_type_node - && (Is_Exported (gnat_entity) || imported_p))) - && !TYPE_VOLATILE (gnu_type)) - { - const int quals - = TYPE_QUAL_VOLATILE - | (Is_Atomic_Or_VFA (gnat_entity) ? TYPE_QUAL_ATOMIC : 0); - gnu_type = change_qualified_type (gnu_type, quals); - } - /* If we are defining an aliased object whose nominal subtype is unconstrained, the object is a record that contains both the template and the object. If there is an initializer, it will @@ -1142,13 +1132,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Convert the type of the object to a reference type that can alias everything as per RM 13.3(19). */ + if (volatile_flag && !TYPE_VOLATILE (gnu_type)) + gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE); gnu_type = build_reference_type_for_mode (gnu_type, ptr_mode, true); gnu_address = convert (gnu_type, gnu_address); used_by_ref = true; const_flag - = !Is_Public (gnat_entity) - || compile_time_known_address_p (gnat_expr); + = (!Is_Public (gnat_entity) + || compile_time_known_address_p (gnat_expr)); + volatile_flag = false; gnu_size = NULL_TREE; /* If this is an aliased object with an unconstrained array nominal @@ -1210,9 +1203,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { /* Convert the type of the object to a reference type that can alias everything as per RM 13.3(19). */ + if (volatile_flag && !TYPE_VOLATILE (gnu_type)) + gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE); gnu_type = build_reference_type_for_mode (gnu_type, ptr_mode, true); used_by_ref = true; + const_flag = false; + volatile_flag = false; gnu_size = NULL_TREE; /* No point in taking the address of an initializing expression @@ -1248,7 +1245,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (!allocatable_size_p (TYPE_SIZE_UNIT (gnu_type), global_bindings_p () || !definition - || static_p) + || static_flag) || (gnu_size && !allocatable_size_p (convert (sizetype, size_binop @@ -1256,11 +1253,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) bitsize_unit_node)), global_bindings_p () || !definition - || static_p))) + || static_flag))) { + if (volatile_flag && !TYPE_VOLATILE (gnu_type)) + gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE); gnu_type = build_reference_type (gnu_type); used_by_ref = true; const_flag = true; + volatile_flag = false; gnu_size = NULL_TREE; /* In case this was a aliased object whose nominal subtype is @@ -1314,7 +1314,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) a variable of "aligning type". */ if (definition && !global_bindings_p () - && !static_p + && !static_flag && !imported_p && TYPE_ALIGN (gnu_type) > BIGGEST_ALIGNMENT) { @@ -1326,9 +1326,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) BIGGEST_ALIGNMENT, 0, gnat_entity); tree gnu_new_var = create_var_decl (create_concat_name (gnat_entity, "ALIGN"), - NULL_TREE, gnu_new_type, NULL_TREE, false, - false, false, false, true, debug_info_p, - NULL, gnat_entity); + NULL_TREE, gnu_new_type, NULL_TREE, + false, false, false, false, false, + true, debug_info_p, NULL, gnat_entity); /* Initialize the aligned field if we have an initializer. */ if (gnu_expr) @@ -1351,6 +1351,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) used_by_ref = true; const_flag = true; + volatile_flag = false; gnu_size = NULL_TREE; } @@ -1375,13 +1376,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = 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, - true, debug_info_p, NULL, gnat_entity); + imported_p || !definition, static_flag, + volatile_flag, true, debug_info_p, + NULL, gnat_entity); gnu_expr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var); TREE_CONSTANT (gnu_expr) = 1; used_by_ref = true; const_flag = true; + volatile_flag = false; inner_const_flag = TREE_READONLY (gnu_unc_var); gnu_size = NULL_TREE; } @@ -1408,7 +1411,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If this is an aggregate constant initialized to a constant, force it to be statically allocated. This saves an initialization copy. */ - if (!static_p + if (!static_flag && const_flag && gnu_expr && TREE_CONSTANT (gnu_expr) && AGGREGATE_TYPE_P (gnu_type) @@ -1416,7 +1419,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !(TYPE_IS_PADDING_P (gnu_type) && !tree_fits_uhwi_p (TYPE_SIZE_UNIT (TREE_TYPE (TYPE_FIELDS (gnu_type)))))) - static_p = true; + static_flag = true; /* Deal with a pragma Linker_Section on a constant or variable. */ if ((kind == E_Constant || kind == E_Variable) @@ -1428,9 +1431,9 @@ 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_expr, const_flag, Is_Public (gnat_entity), - imported_p || !definition, static_p, - artificial_p, debug_info_p, attr_list, - gnat_entity, !renamed_obj); + imported_p || !definition, static_flag, + volatile_flag, artificial_p, debug_info_p, + attr_list, gnat_entity, !renamed_obj); 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); @@ -1481,9 +1484,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_corr_var = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, gnu_expr, true, Is_Public (gnat_entity), - !definition, static_p, artificial_p, - debug_info_p, attr_list, gnat_entity, - false); + !definition, static_flag, volatile_flag, + artificial_p, debug_info_p, attr_list, + gnat_entity, false); SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var); } @@ -1599,8 +1602,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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); + false, false, artificial_p, false, + NULL, gnat_literal); save_gnu_tree (gnat_literal, gnu_literal, false); gnu_list = tree_cons (DECL_NAME (gnu_literal), gnu_value, gnu_list); @@ -3583,8 +3586,9 @@ 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, true, - debug_info_p, NULL, gnat_entity); + false, false, false, false, false, + true, debug_info_p, + NULL, gnat_entity); } gnu_variant_list.release (); @@ -4090,10 +4094,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) Ada subprograms that can throw have side effects since they can trigger an "abnormal" transfer of control flow; thus they can be neither "const" nor "pure" in the back-end sense. */ - bool const_flag - = (Back_End_Exceptions () - && Is_Pure (gnat_entity)); - bool noreturn_flag = No_Return (gnat_entity); + bool const_flag = (Back_End_Exceptions () && Is_Pure (gnat_entity)); + bool volatile_flag = No_Return (gnat_entity); bool return_by_direct_ref_p = false; bool return_by_invisi_ref_p = false; bool return_unconstrained_p = false; @@ -4552,14 +4554,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (TREE_CODE (gnu_return_type) == VOID_TYPE || return_unconstrained_p) const_flag = false; - if (const_flag || noreturn_flag) - { - const int quals - = (const_flag ? TYPE_QUAL_CONST : 0) - | (noreturn_flag ? TYPE_QUAL_VOLATILE : 0); - gnu_type = change_qualified_type (gnu_type, quals); - } - /* If we have a builtin decl for that function, use it. Check if the profiles are compatible and warn if they are not. The checker is expected to post extra diagnostics in this case. */ @@ -4617,7 +4611,7 @@ 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, artificial_p, + extern_flag, false, false, artificial_p, debug_info_p, NULL, gnat_entity); DECL_BY_REF_P (gnu_decl) = 1; } @@ -4625,6 +4619,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else if (kind == E_Subprogram_Type) { process_attributes (&gnu_type, &attr_list, false, gnat_entity); + + if (const_flag || volatile_flag) + { + const int quals + = (const_flag ? TYPE_QUAL_CONST : 0) + | (volatile_flag ? TYPE_QUAL_VOLATILE : 0); + gnu_type = change_qualified_type (gnu_type, quals); + } + gnu_decl = create_type_decl (gnu_entity_name, gnu_type, artificial_p, debug_info_p, gnat_entity); @@ -4633,9 +4636,10 @@ 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_p, - debug_info_p, attr_list, gnat_entity); + gnu_param_list, inline_status, const_flag, + public_flag, extern_flag, volatile_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; @@ -5418,8 +5422,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, false, attr_list, - gnat_entity); + is_disabled, false, true, true, false, true, false, + attr_list, gnat_entity); } /* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is @@ -6311,7 +6315,8 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s, = 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); + expr_global_p, false, 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 @@ -6824,7 +6829,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, gnu_size, gnu_pos, packed, Is_Aliased (gnat_field)); Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field)); DECL_ALIASED_P (gnu_field) = Is_Aliased (gnat_field); - TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile; + TREE_SIDE_EFFECTS (gnu_field) = TREE_THIS_VOLATILE (gnu_field) = is_volatile; if (Ekind (gnat_field) == E_Discriminant) { diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index e98e7e6c8dd..a6c7d42844f 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -685,8 +685,10 @@ extern tree create_type_decl (tree name, tree type, bool artificial_p, EXTERN_FLAG is nonzero when processing an external variable declaration (as opposed to a definition: no storage is to be allocated for the variable). - STATIC_FLAG is only relevant when not at top level. In that case - it indicates whether to always allocate storage to the variable. + STATIC_FLAG is only relevant when not at top level and indicates whether + to always allocate storage to the variable. + + VOLATILE_FLAG is true if this variable is declared as volatile. ARTIFICIAL_P is true if the variable was generated by the compiler. @@ -696,6 +698,7 @@ extern tree create_type_decl (tree name, tree type, bool artificial_p, extern tree create_var_decl (tree name, tree asm_name, tree type, tree init, bool const_flag, bool public_flag, bool extern_flag, bool static_flag, + bool volatile_flag, bool artificial_p, bool debug_info_p, struct attrib *attr_list, Node_Id gnat_node, bool const_decl_allowed_p = true); @@ -725,8 +728,8 @@ extern tree create_label_decl (tree name, Node_Id gnat_node); the list of its parameters (a list of PARM_DECL nodes chained through the DECL_CHAIN field). - INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG and ATTR_LIST are used to set the - appropriate fields in the FUNCTION_DECL. + INLINE_STATUS, CONST_FLAG, PUBLIC_FLAG, EXTERN_FLAG, VOLATILE_FLAG as well + as 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. @@ -736,7 +739,8 @@ extern tree create_label_decl (tree name, Node_Id gnat_node); extern tree create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list, enum inline_status_t inline_status, - bool public_flag, bool extern_flag, + bool const_flag, bool public_flag, + bool extern_flag, bool volatile_flag, bool artificial_p, bool debug_info_p, struct attrib *attr_list, Node_Id gnat_node); diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 4c1e3aa54db..eda1b3a63e8 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -375,14 +375,14 @@ gigi (Node_Id gnat_root, t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node); 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, + boolean_type_node, t, true, false, false, false, false, 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, + boolean_type_node, t, true, false, false, false, false, true, false, NULL, gnat_literal); save_gnu_tree (gnat_literal, t, false); @@ -397,8 +397,8 @@ gigi (Node_Id gnat_root, malloc_decl = create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE, ftype, - NULL_TREE, is_disabled, true, true, true, false, - NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, + true, false, NULL, Empty); DECL_IS_MALLOC (malloc_decl) = 1; /* free is a function declaration tree for a function to free memory. */ @@ -407,8 +407,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, false, - NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, + true, false, NULL, Empty); /* This is used for 64-bit multiplication with overflow checking. */ int64_type = gnat_type_for_size (64, 0); @@ -416,8 +416,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, false, - NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, + true, false, NULL, Empty); /* Name of the _Parent field in tagged record types. */ parent_name_id = get_identifier (Get_Name_String (Name_uParent)); @@ -440,21 +440,24 @@ 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, false, NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, 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, false, NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, true, false, + NULL, Empty); get_excptr_decl = create_subprog_decl (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, false, NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, true, false, + NULL, Empty); not_handled_by_others_decl = get_identifier ("not_handled_by_others"); for (t = TYPE_FIELDS (except_type_node); t; t = DECL_CHAIN (t)) @@ -472,7 +475,8 @@ 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, false, NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, true, false, + NULL, Empty); DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL; DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP; @@ -482,42 +486,35 @@ 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, false, NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, 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; + /* Indicate that it never returns. */ raise_nodefer_decl = create_subprog_decl (get_identifier ("__gnat_raise_nodefer_with_msg"), NULL_TREE, build_function_type_list (void_type_node, build_pointer_type (except_type_node), NULL_TREE), - NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); - - /* Indicate that it never returns. */ - TREE_THIS_VOLATILE (raise_nodefer_decl) = 1; - TREE_SIDE_EFFECTS (raise_nodefer_decl) = 1; - TREE_TYPE (raise_nodefer_decl) - = build_qualified_type (TREE_TYPE (raise_nodefer_decl), - TYPE_QUAL_VOLATILE); + NULL_TREE, is_disabled, false, true, true, true, true, false, + NULL, Empty); + /* Indicate that these never return. */ reraise_zcx_decl = create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE, ftype, NULL_TREE, - is_disabled, true, true, true, false, + is_disabled, false, true, true, true, true, false, NULL, Empty); - /* Indicate that these never return. */ - TREE_THIS_VOLATILE (reraise_zcx_decl) = 1; - TREE_SIDE_EFFECTS (reraise_zcx_decl) = 1; - TREE_TYPE (reraise_zcx_decl) - = build_qualified_type (TREE_TYPE (reraise_zcx_decl), TYPE_QUAL_VOLATILE); 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, false, NULL, Empty); + NULL_TREE, is_disabled, false, true, true, false, true, false, + NULL, Empty); /* Hooks to call when entering/leaving an exception handler. */ ftype = build_function_type_list (void_type_node, ptr_type_node, NULL_TREE); @@ -525,19 +522,19 @@ 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, false, + is_disabled, false, true, true, false, true, false, NULL, Empty); end_handler_decl = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE, ftype, NULL_TREE, - is_disabled, true, true, true, false, + is_disabled, false, true, true, false, true, false, NULL, Empty); unhandled_except_decl = create_subprog_decl (get_identifier ("__gnat_unhandled_except_handler"), NULL_TREE, ftype, NULL_TREE, - is_disabled, true, true, true, false, + is_disabled, false, true, true, false, true, false, NULL, Empty); /* Dummy objects to materialize "others" and "all others" in the exception @@ -547,21 +544,21 @@ gigi (Node_Id gnat_root, = create_var_decl (get_identifier ("OTHERS"), get_identifier ("__gnat_others_value"), unsigned_char_type_node, NULL_TREE, - true, false, true, false, true, false, + true, false, true, false, 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, true, false, + true, false, true, false, 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, true, false, + true, false, true, false, false, true, false, NULL, Empty); /* If in no exception handlers mode, all raise statements are redirected to @@ -576,11 +573,8 @@ gigi (Node_Id gnat_root, build_pointer_type (unsigned_char_type_node), integer_type_node, NULL_TREE), - NULL_TREE, is_disabled, true, true, true, false, NULL, Empty); - TREE_THIS_VOLATILE (decl) = 1; - TREE_SIDE_EFFECTS (decl) = 1; - TREE_TYPE (decl) - = build_qualified_type (TREE_TYPE (decl), TYPE_QUAL_VOLATILE); + NULL_TREE, is_disabled, false, true, true, true, true, false, + NULL, Empty); for (i = 0; i < (int) ARRAY_SIZE (gnat_raise_decls); i++) gnat_raise_decls[i] = decl; } @@ -742,18 +736,13 @@ build_raise_check (int check, enum exception_info_kind kind) t, t, NULL_TREE); } + /* Indicate that it never returns. */ result - = create_subprog_decl (get_identifier (Name_Buffer), - NULL_TREE, ftype, NULL_TREE, - is_disabled, true, true, true, false, + = create_subprog_decl (get_identifier (Name_Buffer), NULL_TREE, + ftype, NULL_TREE, + is_disabled, false, true, true, true, true, false, NULL, Empty); - /* Indicate that it never returns. */ - TREE_THIS_VOLATILE (result) = 1; - TREE_SIDE_EFFECTS (result) = 1; - TREE_TYPE (result) - = build_qualified_type (TREE_TYPE (result), TYPE_QUAL_VOLATILE); - return result; } @@ -3827,9 +3816,9 @@ 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, true, false, - NULL, gnat_subprog_id); + gnu_return_type, NULL_TREE, + false, false, false, false, false, + true, false, NULL, gnat_subprog_id); TREE_VALUE (gnu_return_var_elmt) = gnu_return_var; } @@ -4230,9 +4219,11 @@ atomic_access_required_p (Node_Id gnat_node, bool *sync) static tree 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, - true, false, NULL, Empty); + tree gnu_temp + = create_var_decl (create_tmp_var_name (prefix), NULL_TREE, + type, NULL_TREE, + false, false, false, false, false, + true, false, NULL, Empty); return gnu_temp; } @@ -5008,7 +4999,7 @@ 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, true, false, + false, false, false, false, false, true, false, NULL, gnat_node); /* The __builtin_setjmp receivers will immediately reinstall it. Now @@ -5020,7 +5011,7 @@ 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, true, false, + false, false, false, false, false, true, false, NULL, gnat_node); set_block_jmpbuf_decl (gnu_jmpbuf_decl); @@ -5084,8 +5075,8 @@ 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, true, false, - NULL, gnat_node)); + false, false, false, false, false, + true, false, NULL, gnat_node)); /* Generate code for each handler. The N_Exception_Handler case does the real work and returns a COND_EXPR for each handler, which we chain @@ -5334,7 +5325,7 @@ Exception_Handler_to_gnu_gcc (Node_Id 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, + false, false, false, false, false, true, true, NULL, gnat_node); add_stmt_with_node (build_call_n_expr (begin_handler_decl, 1, @@ -5381,7 +5372,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, true, + NULL_TREE, void_ftype, NULL_TREE, + is_disabled, false, true, false, false, true, true, NULL, gnat_unit); struct elab_info *info; @@ -6410,7 +6402,8 @@ 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, true, NULL, gnat_node); + false, true, true, false, true, true, + NULL, gnat_node); gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attr); } @@ -7379,8 +7372,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, true, true, - NULL, gnat_node); + false, 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 f236907fc2b..10d3e22668a 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1369,7 +1369,7 @@ maybe_pad_type (tree type, tree size, unsigned int align, = 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); + false, true, true, NULL, gnat_entity); TYPE_SIZE_UNIT (record) = size_unit; } @@ -2335,8 +2335,10 @@ create_type_decl (tree name, tree type, bool artificial_p, bool debug_info_p, EXTERN_FLAG is true when processing an external variable declaration (as opposed to a definition: no storage is to be allocated for the variable). - STATIC_FLAG is only relevant when not at top level. In that case - it indicates whether to always allocate storage to the variable. + STATIC_FLAG is only relevant when not at top level and indicates whether + to always allocate storage to the variable. + + VOLATILE_FLAG is true if this variable is declared as volatile. ARTIFICIAL_P is true if the variable was generated by the compiler. @@ -2347,9 +2349,9 @@ create_type_decl (tree name, tree type, bool artificial_p, bool debug_info_p, tree create_var_decl (tree name, tree asm_name, tree type, tree init, bool const_flag, bool public_flag, bool extern_flag, - bool static_flag, bool artificial_p, bool debug_info_p, - struct attrib *attr_list, Node_Id gnat_node, - bool const_decl_allowed_p) + bool static_flag, bool volatile_flag, bool artificial_p, + bool debug_info_p, struct attrib *attr_list, + Node_Id gnat_node, bool const_decl_allowed_p) { /* Whether the object has static storage duration, either explicitly or by virtue of being declared at the global level. */ @@ -2406,16 +2408,6 @@ create_var_decl (tree name, tree asm_name, tree type, tree 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. */ - TREE_STATIC (var_decl) = !extern_flag && static_storage; - - /* The object is public if it is external or if it is declared public - and has static storage duration. */ - TREE_PUBLIC (var_decl) = extern_flag || (public_flag && static_storage); /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't try to fiddle with DECL_COMMON. However, on platforms that don't @@ -2441,8 +2433,20 @@ create_var_decl (tree name, tree asm_name, tree type, tree init, != null_pointer_node)) DECL_IGNORED_P (var_decl) = 1; - if (TYPE_VOLATILE (type)) - TREE_SIDE_EFFECTS (var_decl) = TREE_THIS_VOLATILE (var_decl) = 1; + TREE_CONSTANT (var_decl) = constant_p; + TREE_READONLY (var_decl) = const_flag; + + /* The object is public if it is external or if it is declared public + and has static storage duration. */ + TREE_PUBLIC (var_decl) = extern_flag || (public_flag && static_storage); + + /* We need to allocate static storage for an object with static storage + duration if it isn't external. */ + TREE_STATIC (var_decl) = !extern_flag && static_storage; + + TREE_SIDE_EFFECTS (var_decl) + = TREE_THIS_VOLATILE (var_decl) + = TYPE_VOLATILE (type) | volatile_flag; if (TREE_SIDE_EFFECTS (var_decl)) TREE_ADDRESSABLE (var_decl) = 1; @@ -3044,8 +3048,8 @@ create_label_decl (tree name, Node_Id gnat_node) the list of its parameters (a list of PARM_DECL nodes chained through the DECL_CHAIN field). - INLINE_STATUS, PUBLIC_FLAG, EXTERN_FLAG and ATTR_LIST are used to set the - appropriate fields in the FUNCTION_DECL. + INLINE_STATUS, CONST_FLAG, PUBLIC_FLAG, EXTERN_FLAG, VOLATILE_FLAG as well + as 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. @@ -3055,8 +3059,9 @@ create_label_decl (tree name, Node_Id gnat_node) tree create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list, - enum inline_status_t inline_status, bool public_flag, - bool extern_flag, bool artificial_p, bool debug_info_p, + enum inline_status_t inline_status, bool const_flag, + bool public_flag, bool extern_flag, bool volatile_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, name, type); @@ -3097,10 +3102,11 @@ create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list, if (!debug_info_p) DECL_IGNORED_P (subprog_decl) = 1; + TREE_READONLY (subprog_decl) = TYPE_READONLY (type) | const_flag; TREE_PUBLIC (subprog_decl) = public_flag; - TREE_READONLY (subprog_decl) = TYPE_READONLY (type); - TREE_THIS_VOLATILE (subprog_decl) = TYPE_VOLATILE (type); - TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (type); + TREE_SIDE_EFFECTS (subprog_decl) + = TREE_THIS_VOLATILE (subprog_decl) + = TYPE_VOLATILE (type) | volatile_flag; DECL_ARTIFICIAL (result_decl) = 1; DECL_IGNORED_P (result_decl) = 1; -- 2.30.2