From patchwork Mon Nov 30 11:50:59 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Eric Botcazou X-Patchwork-Id: 549963 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 6656D1401F0 for ; Mon, 30 Nov 2015 22:51:29 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=J+y6Zjlx; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; q=dns; s=default; b=CJA5nw6hHq02E7U1 SkJTSk5RUxVvfWXse7lyRW8MRnto8729r2dp4c925skejG+H1O1j/qkGCUYSIYEr Tr4e5/kH27eu/aZGGA/y9plJ4Ej6AyKaxwzXgGiNBkykWWCIfUVOp8rJwUkq3cnn vzpqtISZS4m/Fr7MUB4eBdnC1rQ= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:date:message-id:mime-version:content-type :content-transfer-encoding; s=default; bh=+DAQ/BYoEDwAvbMCp+UX2C rtSis=; b=J+y6ZjlxtMfBDLnhOe86hHl6ab9eh8ouVBDSf8iCrgqwPCzhw1LEQf GR2lFYSnNuK5GppK9vP8ClEgJomMtDxqPiPVauA8wsKFudWzUEeNG+AYB7mc2P90 wCG3uZoo9Z86b1dhTzZ05RMbzlDk+u0QCSLA9Xtw0EhTt+JxAjitE= Received: (qmail 92891 invoked by alias); 30 Nov 2015 11:51:20 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 92881 invoked by uid 89); 30 Nov 2015 11:51:19 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.1 required=5.0 tests=AWL, BAYES_50, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 X-HELO: smtp.eu.adacore.com Received: from mel.act-europe.fr (HELO smtp.eu.adacore.com) (194.98.77.210) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Mon, 30 Nov 2015 11:51:15 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 0523330001ED for ; Mon, 30 Nov 2015 12:51:13 +0100 (CET) Received: from smtp.eu.adacore.com ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id AWVrjvzkWvMN for ; Mon, 30 Nov 2015 12:51:12 +0100 (CET) Received: from polaris.localnet (bon31-6-88-161-99-133.fbx.proxad.net [88.161.99.133]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by smtp.eu.adacore.com (Postfix) with ESMTPSA id 9DA1130001E9 for ; Mon, 30 Nov 2015 12:51:12 +0100 (CET) From: Eric Botcazou To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix volatile flag setting in gigi Date: Mon, 30 Nov 2015 12:50:59 +0100 Message-ID: <3855583.VSxlX06PjC@polaris> User-Agent: KMail/4.14.9 (Linux/3.16.7-29-desktop; KDE/4.14.9; x86_64; ; ) MIME-Version: 1.0 This fixes the volatile flag issue recently reported by Jan. Tested on x86_64-suse-linux, applied on the mainline. 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. Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 231062) +++ gcc-interface/decl.c (working copy) @@ -598,7 +598,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entit || 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_entit 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_entit } } - /* 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_entit /* 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_entit { /* 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_entit 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_entit 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_entit 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_entit 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_entit 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_entit = 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_entit /* 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_entit && !(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_entit 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_entit 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_entit 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_entit = 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_entit 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_entit 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_entit 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_entit 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_entit { 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 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, E = 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, 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) { Index: gcc-interface/gigi.h =================================================================== --- gcc-interface/gigi.h (revision 231064) +++ gcc-interface/gigi.h (working copy) @@ -685,8 +685,10 @@ extern tree create_type_decl (tree name, 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, 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 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 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); Index: gcc-interface/trans.c =================================================================== --- gcc-interface/trans.c (revision 231064) +++ gcc-interface/trans.c (working copy) @@ -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 excep 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_nod 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_n 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 (N = 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 (N = 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 (N 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 gn 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_no 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))); Index: gcc-interface/utils.c =================================================================== --- gcc-interface/utils.c (revision 231062) +++ gcc-interface/utils.c (working copy) @@ -1369,7 +1369,7 @@ maybe_pad_type (tree type, tree size, un = 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, 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, 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_nam /* 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_nam != 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 gn 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 gn 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 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;