diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 75940fe0e48..6b89f7f65cc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -7,6 +7,7 @@ * gnat_ugn.texi: Document --test-duration option for gnattest. 2014-07-31 Javier Miranda + Eric Botcazou * opt.ads (Back_End_Inlining): New variable which controls activation of inlining by back-end expansion. @@ -26,6 +27,8 @@ * fe.h Import Back_End_Inlining variable. * gcc-interface/utils.c (create_subprog_decl): If Back_End_Inlining is enabled then declare attribute "always inline" + * gcc-interface/decl.c, gcc-interface/trans.c, + gcc-interface/gigi.h: Add handling of Inline_Always pragma. 2014-07-31 Robert Dewar diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 10eb6cc2538..795eea3a04f 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -4146,7 +4146,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) enum inline_status_t inline_status = Has_Pragma_No_Inline (gnat_entity) ? is_suppressed - : (Is_Inlined (gnat_entity) ? is_enabled : is_disabled); + : Has_Pragma_Inline_Always (gnat_entity) + ? is_required + : (Is_Inlined (gnat_entity) ? is_enabled : is_disabled); bool public_flag = Is_Public (gnat_entity) || imported_p; bool extern_flag = (Is_Public (gnat_entity) && !definition) || imported_p; @@ -4701,6 +4703,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } else { + /* ??? When only the spec of a package is provided, downgrade + is_required to is_enabled to avoid issuing an error later. */ + if (inline_status == is_required) + { + Node_Id gnat_body = Parent (Declaration_Node (gnat_entity)); + if (Nkind (gnat_body) != N_Subprogram_Body + && No (Corresponding_Body (gnat_body))) + inline_status = is_enabled; + } + if (has_stub) { gnu_stub_name = gnu_ext_name; @@ -5178,8 +5190,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) The language rules ensure the parent type is already frozen here. */ if (Is_Derived_Type (gnat_entity) && !type_annotate_only) { - tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_entity)); - relate_alias_sets (gnu_type, gnu_parent_type, + Entity_Id gnat_parent_type = Underlying_Type (Etype (gnat_entity)); + /* For packed array subtypes, the implementation type is used. */ + if (kind == E_Array_Subtype + && Present (Packed_Array_Impl_Type (gnat_parent_type))) + gnat_parent_type = Packed_Array_Impl_Type (gnat_parent_type); + relate_alias_sets (gnu_type, gnat_to_gnu_type (gnat_parent_type), Is_Composite_Type (gnat_entity) ? ALIAS_SET_COPY : ALIAS_SET_SUPERSET); } diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index f038910e316..0e4befbab73 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -5051,6 +5051,7 @@ Compilation_Unit_to_gnu (Node_Id gnat_node) const bool body_p = (Nkind (gnat_unit) == N_Package_Body || Nkind (gnat_unit) == N_Subprogram_Body); const Entity_Id gnat_unit_entity = Defining_Entity (gnat_unit); + Entity_Id gnat_entity; Node_Id gnat_pragma; /* Make the decl for the elaboration procedure. */ tree gnu_elab_proc_decl @@ -5099,33 +5100,31 @@ Compilation_Unit_to_gnu (Node_Id gnat_node) /* Process the unit itself. */ add_stmt (gnat_to_gnu (gnat_unit)); - /* If we can inline, generate code for all the inlined subprograms. */ - if (optimize) + /* Generate code for all the inlined subprograms. */ + for (gnat_entity = First_Inlined_Subprogram (gnat_node); + Present (gnat_entity); + gnat_entity = Next_Inlined_Subprogram (gnat_entity)) { - Entity_Id gnat_entity; + Node_Id gnat_body; - for (gnat_entity = First_Inlined_Subprogram (gnat_node); - Present (gnat_entity); - gnat_entity = Next_Inlined_Subprogram (gnat_entity)) + /* Without optimization, process only the required subprograms. */ + if (!optimize && !Has_Pragma_Inline_Always (gnat_entity)) + continue; + + gnat_body = Parent (Declaration_Node (gnat_entity)); + if (Nkind (gnat_body) != N_Subprogram_Body) { - Node_Id gnat_body = Parent (Declaration_Node (gnat_entity)); + /* ??? This happens when only the spec of a package is provided. */ + if (No (Corresponding_Body (gnat_body))) + continue; - if (Nkind (gnat_body) != N_Subprogram_Body) - { - /* ??? This really should always be present. */ - if (No (Corresponding_Body (gnat_body))) - continue; - gnat_body - = Parent (Declaration_Node (Corresponding_Body (gnat_body))); - } - - if (Present (gnat_body)) - { - /* Define the entity first so we set DECL_EXTERNAL. */ - gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0); - add_stmt (gnat_to_gnu (gnat_body)); - } + gnat_body + = Parent (Declaration_Node (Corresponding_Body (gnat_body))); } + + /* Define the entity first so we set DECL_EXTERNAL. */ + gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0); + add_stmt (gnat_to_gnu (gnat_body)); } /* Process any pragmas and actions following the unit. */ @@ -5818,8 +5817,18 @@ gnat_to_gnu (Node_Id gnat_node) TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))), gnat_temp); - gnu_result = build_binary_op (ARRAY_REF, NULL_TREE, - gnu_result, gnu_expr); + gnu_result + = build_binary_op (ARRAY_REF, NULL_TREE, gnu_result, gnu_expr); + + /* Array accesses are bound-checked so they cannot trap, but this + is valid only if they are not hoisted ahead of the check. We + need to mark them as no-trap to get decent loop optimizations + in the presence of -fnon-call-exceptions, so we do it when we + know that the original expression had no side-effects. */ + if (TREE_CODE (gnu_result) == ARRAY_REF + && !(Nkind (gnat_temp) == N_Identifier + && Ekind (Entity (gnat_temp)) == E_Constant)) + TREE_THIS_NOTRAP (gnu_result) = 1; } gnu_result_type = get_unpadded_type (Etype (gnat_node)); @@ -9349,6 +9358,7 @@ set_gnu_expr_location_from_node (tree node, Node_Id gnat_node) { CASE_CONVERT: case NON_LVALUE_EXPR: + case SAVE_EXPR: break; case COMPOUND_EXPR: