From 642357660ae1f36651519fb41f81a997f5fdae53 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 18 Nov 2015 21:55:11 +0000 Subject: [PATCH] ada-tree.h (DECL_INVARIANT_P): New macro. * gcc-interface/ada-tree.h (DECL_INVARIANT_P): New macro. * gcc-interface/gigi.h (enum standard_datatypes): Remove ADT_longjmp_decl and add ADT_not_handled_by_others_decl. (longjmp_decl): Delete. (not_handled_by_others_decl): New macro. (build_simple_component_ref): Delete. (build_component_ref): Adjust prototype. * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to build_component_ref. (gnat_to_gnu_field): Set DECL_INVARIANT_P on discriminants without default value. * gcc-interface/trans.c (gigi): Reorder initialization sequence and add not_handled_by_others_decl. (Attribute_to_gnu): Adjust calls to build_component_ref. (Subprogram_Body_to_gnu): Likewise. (Call_to_gnu): Likewise. (Exception_Handler_to_gnu_sjlj): Likewise. (gnat_to_gnu): Likewise. (range_check_info_d): Add inserted_cond field. (Loop_Statement_to_gnu): Make two passes on the recorded range checks. (build_noreturn_cond): New static function. (Raise_Error_to_gnu): Record range checks in loops at -O1 and above. (make_invariant): New static function. (Loop_Statement_to_gnu): Use it to compute invariant expressions for the loop bounds if possible, but do not require it if loop unswitching is enabled. * gcc-interface/utils.c (convert_to_fat_pointer): Likewise. (convert): Likewise. (maybe_unconstrained_array): Likewise. Call it instead of build_simple_component_ref and add guard for CONSTRUCTORs. (unchecked_convert): Likewise. * gcc-interface/utils2.c (compare_fat_pointers): Likewise. (build_simple_component_ref): Remove COMPONENT parameter, unify code dealing with VIEW_CONVERT_EXPR and make it more general, remove special treatment for CONSTRUCTORs of template types. (build_component_ref): Remove COMPONENT parameter and adjust call to build_simple_component_ref. (maybe_wrap_malloc): Likewise. (build_allocator): Likewise. (gnat_invariant_expr): Look through overflow checks, deal with addition and subtraction of constants and take into account DECL_INVARIANT_P for the COMPONENT_REF case. From-SVN: r230575 --- gcc/ada/ChangeLog | 45 +++ gcc/ada/gcc-interface/ada-tree.h | 8 +- gcc/ada/gcc-interface/decl.c | 18 +- gcc/ada/gcc-interface/gigi.h | 27 +- gcc/ada/gcc-interface/trans.c | 353 +++++++++++------- gcc/ada/gcc-interface/utils.c | 44 ++- gcc/ada/gcc-interface/utils2.c | 225 +++++------ gcc/testsuite/ChangeLog | 6 + gcc/testsuite/gnat.dg/loop_optimization19.adb | 45 +++ gcc/testsuite/gnat.dg/loop_optimization20.adb | 35 ++ gcc/testsuite/gnat.dg/loop_optimization21.adb | 20 + gcc/testsuite/gnat.dg/loop_optimization21.ads | 9 + 12 files changed, 519 insertions(+), 316 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/loop_optimization19.adb create mode 100644 gcc/testsuite/gnat.dg/loop_optimization20.adb create mode 100644 gcc/testsuite/gnat.dg/loop_optimization21.adb create mode 100644 gcc/testsuite/gnat.dg/loop_optimization21.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2f8dfc99650..9ae6c801ed0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,48 @@ +2015-11-18 Eric Botcazou + + * gcc-interface/ada-tree.h (DECL_INVARIANT_P): New macro. + * gcc-interface/gigi.h (enum standard_datatypes): Remove + ADT_longjmp_decl and add ADT_not_handled_by_others_decl. + (longjmp_decl): Delete. + (not_handled_by_others_decl): New macro. + (build_simple_component_ref): Delete. + (build_component_ref): Adjust prototype. + * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust calls to + build_component_ref. + (gnat_to_gnu_field): Set DECL_INVARIANT_P on discriminants + without default value. + * gcc-interface/trans.c (gigi): Reorder initialization sequence + and add not_handled_by_others_decl. + (Attribute_to_gnu): Adjust calls to build_component_ref. + (Subprogram_Body_to_gnu): Likewise. + (Call_to_gnu): Likewise. + (Exception_Handler_to_gnu_sjlj): Likewise. + (gnat_to_gnu): Likewise. + (range_check_info_d): Add inserted_cond field. + (Loop_Statement_to_gnu): Make two passes on the recorded range checks. + (build_noreturn_cond): New static function. + (Raise_Error_to_gnu): Record range checks in loops at -O1 and above. + (make_invariant): New static function. + (Loop_Statement_to_gnu): Use it to compute invariant expressions for + the loop bounds if possible, but do not require it if loop unswitching + is enabled. + * gcc-interface/utils.c (convert_to_fat_pointer): Likewise. + (convert): Likewise. + (maybe_unconstrained_array): Likewise. Call it instead of + build_simple_component_ref and add guard for CONSTRUCTORs. + (unchecked_convert): Likewise. + * gcc-interface/utils2.c (compare_fat_pointers): Likewise. + (build_simple_component_ref): Remove COMPONENT parameter, unify + code dealing with VIEW_CONVERT_EXPR and make it more general, + remove special treatment for CONSTRUCTORs of template types. + (build_component_ref): Remove COMPONENT parameter and adjust call + to build_simple_component_ref. + (maybe_wrap_malloc): Likewise. + (build_allocator): Likewise. + (gnat_invariant_expr): Look through overflow checks, deal with + addition and subtraction of constants and take into account + DECL_INVARIANT_P for the COMPONENT_REF case. + 2015-11-18 Eric Botcazou * gcc-interface/misc.c: Move global variables to the top of the file. diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 686445125f1..4e368f00dad 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -405,10 +405,14 @@ do { \ #define DECL_ELABORATION_PROC_P(NODE) \ DECL_LANG_FLAG_3 (FUNCTION_DECL_CHECK (NODE)) -/* Nonzero in a DECL if it is made for a pointer that points to something which - is readonly. */ +/* Nonzero in a CONST_DECL, VAR_DECL or PARM_DECL if it is made for a pointer + that points to something which is readonly. */ #define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE) +/* Nonzero in a FIELD_DECL if it is invariant once set, for example if it is + a discriminant of a discriminated type without default expression. */ +#define DECL_INVARIANT_P(NODE) DECL_LANG_FLAG_4 (FIELD_DECL_CHECK (NODE)) + /* In a FIELD_DECL corresponding to a discriminant, contains the discriminant number. */ #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE)) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 883b2755df4..75e9e33b13e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1291,7 +1291,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else gnu_expr = build_component_ref - (gnu_expr, NULL_TREE, + (gnu_expr, DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))), false); } @@ -1335,8 +1335,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) add_stmt_with_node (build_binary_op (INIT_EXPR, NULL_TREE, build_component_ref - (gnu_new_var, NULL_TREE, - TYPE_FIELDS (gnu_new_type), false), + (gnu_new_var, TYPE_FIELDS (gnu_new_type), + false), gnu_expr), gnat_entity); @@ -1345,8 +1345,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_expr = build_unary_op (ADDR_EXPR, NULL_TREE, - build_component_ref (gnu_new_var, NULL_TREE, - TYPE_FIELDS (gnu_new_type), false)); + build_component_ref (gnu_new_var, TYPE_FIELDS (gnu_new_type), + false)); TREE_CONSTANT (gnu_expr) = 1; used_by_ref = true; @@ -6778,8 +6778,12 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile; if (Ekind (gnat_field) == E_Discriminant) - DECL_DISCRIMINANT_NUMBER (gnu_field) - = UI_To_gnu (Discriminant_Number (gnat_field), sizetype); + { + DECL_INVARIANT_P (gnu_field) + = No (Discriminant_Default_Value (gnat_field)); + DECL_DISCRIMINANT_NUMBER (gnu_field) + = UI_To_gnu (Discriminant_Number (gnat_field), sizetype); + } return gnu_field; } diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index e6fff1e777c..46ec42e4fd8 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -408,17 +408,18 @@ enum standard_datatypes /* Identifier for the name of the Exception_Data type. */ ADT_exception_data_name_id, - /* Types and decls used by our temporary exception mechanism. See - init_gigi_decls for details. */ + /* Types and decls used by the SJLJ exception mechanism. */ ADT_jmpbuf_type, ADT_jmpbuf_ptr_type, ADT_get_jmpbuf_decl, ADT_set_jmpbuf_decl, ADT_get_excptr_decl, + ADT_not_handled_by_others_decl, ADT_setjmp_decl, - ADT_longjmp_decl, ADT_update_setjmp_buf_decl, ADT_raise_nodefer_decl, + + /* Types and decls used by the ZCX exception mechanism. */ ADT_reraise_zcx_decl, ADT_set_exception_parameter_decl, ADT_begin_handler_decl, @@ -427,6 +428,7 @@ enum standard_datatypes ADT_others_decl, ADT_all_others_decl, ADT_unhandled_others_decl, + ADT_LAST}; /* Define kind of exception information associated with raise statements. */ @@ -475,13 +477,14 @@ extern GTY(()) tree gnat_raise_decls_ext[(int) LAST_REASON_CODE + 1]; #define get_jmpbuf_decl gnat_std_decls[(int) ADT_get_jmpbuf_decl] #define set_jmpbuf_decl gnat_std_decls[(int) ADT_set_jmpbuf_decl] #define get_excptr_decl gnat_std_decls[(int) ADT_get_excptr_decl] +#define not_handled_by_others_decl \ + gnat_std_decls[(int) ADT_not_handled_by_others_decl] #define setjmp_decl gnat_std_decls[(int) ADT_setjmp_decl] -#define longjmp_decl gnat_std_decls[(int) ADT_longjmp_decl] #define update_setjmp_buf_decl gnat_std_decls[(int) ADT_update_setjmp_buf_decl] #define raise_nodefer_decl gnat_std_decls[(int) ADT_raise_nodefer_decl] #define reraise_zcx_decl gnat_std_decls[(int) ADT_reraise_zcx_decl] #define set_exception_parameter_decl \ - gnat_std_decls[(int) ADT_set_exception_parameter_decl] + gnat_std_decls[(int) ADT_set_exception_parameter_decl] #define begin_handler_decl gnat_std_decls[(int) ADT_begin_handler_decl] #define others_decl gnat_std_decls[(int) ADT_others_decl] #define all_others_decl gnat_std_decls[(int) ADT_all_others_decl] @@ -896,16 +899,10 @@ extern tree build_call_raise_range (int msg, Node_Id gnat_node, same as build_constructor in the language-independent tree.c. */ extern tree gnat_build_constructor (tree type, vec *v); -/* Return a COMPONENT_REF to access a field that is given by COMPONENT, - an IDENTIFIER_NODE giving the name of the field, FIELD, a FIELD_DECL, - for the field, or both. Don't fold the result if NO_FOLD_P. */ -extern tree build_simple_component_ref (tree record_variable, tree component, - tree field, bool no_fold_p); - -/* Likewise, but generate a Constraint_Error if the reference could not be - found. */ -extern tree build_component_ref (tree record_variable, tree component, - tree field, bool no_fold_p); +/* Return a COMPONENT_REF to access FIELD in RECORD, or NULL_EXPR and generate + a Constraint_Error if the field is not found in the record. Don't fold the + result if NO_FOLD is true. */ +extern tree build_component_ref (tree record, tree field, bool no_fold); /* Build a GCC tree to call an allocation or deallocation function. If GNU_OBJ is nonzero, it is an object to deallocate. Otherwise, diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 0d100193baa..5f2c1dcddcc 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -33,6 +33,7 @@ #include "gimple-expr.h" #include "stringpool.h" #include "cgraph.h" +#include "predict.h" #include "diagnostic.h" #include "alias.h" #include "fold-const.h" @@ -181,6 +182,7 @@ struct GTY(()) range_check_info_d { tree high_bound; tree type; tree invariant_cond; + tree inserted_cond; }; typedef struct range_check_info_d *range_check_info; @@ -423,6 +425,8 @@ gigi (Node_Id gnat_root, = get_identifier ("system__standard_library__exception_data"); /* Make the types and functions used for exception processing. */ + except_type_node = gnat_to_gnu_type (Base_Type (standard_exception_type)); + jmpbuf_type = build_array_type (gnat_type_for_mode (Pmode, 0), build_index_type (size_int (5))); @@ -443,6 +447,22 @@ gigi (Node_Id gnat_root, NULL_TREE), NULL_TREE, is_disabled, true, true, 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); + + not_handled_by_others_decl = get_identifier ("not_handled_by_others"); + for (t = TYPE_FIELDS (except_type_node); t; t = DECL_CHAIN (t)) + if (DECL_NAME (t) == not_handled_by_others_decl) + { + not_handled_by_others_decl = t; + break; + } + gcc_assert (DECL_P (not_handled_by_others_decl)); + /* setjmp returns an integer and has one operand, which is a pointer to a jmpbuf. */ setjmp_decl @@ -464,6 +484,39 @@ gigi (Node_Id gnat_root, DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL; DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF; + 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); + + reraise_zcx_decl + = create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE, + ftype, NULL_TREE, + is_disabled, 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); + /* Hooks to call when entering/leaving an exception handler. */ ftype = build_function_type_list (void_type_node, ptr_type_node, NULL_TREE); @@ -485,16 +538,29 @@ gigi (Node_Id gnat_root, is_disabled, true, true, true, false, NULL, Empty); - reraise_zcx_decl - = create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE, - ftype, NULL_TREE, - is_disabled, 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); + /* Dummy objects to materialize "others" and "all others" in the exception + tables. These are exported by a-exexpr-gcc.adb, so see this unit for + the types to use. */ + others_decl + = create_var_decl (get_identifier ("OTHERS"), + get_identifier ("__gnat_others_value"), + 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, 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, + NULL, Empty); /* If in no exception handlers mode, all raise statements are redirected to __gnat_last_chance_handler. No need to redefine raise_nodefer_decl since @@ -530,39 +596,6 @@ gigi (Node_Id gnat_root, ? exception_range : exception_column); } - /* Set the types that GCC and Gigi use from the front end. */ - except_type_node = gnat_to_gnu_type (Base_Type (standard_exception_type)); - - /* Make other functions used for exception processing. */ - 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); - - 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); - - 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); - /* Build the special descriptor type and its null node if needed. */ if (TARGET_VTABLE_USES_DESCRIPTORS) { @@ -596,30 +629,6 @@ gigi (Node_Id gnat_root, longest_float_type_node = get_unpadded_type (Base_Type (standard_long_long_float)); - /* Dummy objects to materialize "others" and "all others" in the exception - tables. These are exported by a-exexpr-gcc.adb, so see this unit for - the types to use. */ - others_decl - = create_var_decl (get_identifier ("OTHERS"), - get_identifier ("__gnat_others_value"), - 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, 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, - NULL, Empty); - main_identifier_node = get_identifier ("main"); /* Install the builtins we might need, either internally or as @@ -2450,8 +2459,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) gnu_result = build_compound_expr (gnu_result_type, asm_expr, - build_component_ref (rec_val, NULL_TREE, - field, false)); + build_component_ref (rec_val, field, + false)); } break; @@ -2718,6 +2727,24 @@ can_be_lower_p (tree val1, tree val2) return tree_int_cst_lt (val1, val2); } +/* Replace EXPR1 and EXPR2 by invariant expressions if possible. Return + true if both expressions have been replaced and false otherwise. */ + +static bool +make_invariant (tree *expr1, tree *expr2) +{ + tree inv_expr1 = gnat_invariant_expr (*expr1); + tree inv_expr2 = gnat_invariant_expr (*expr2); + + if (inv_expr1) + *expr1 = inv_expr1; + + if (inv_expr2) + *expr2 = inv_expr2; + + return inv_expr1 && inv_expr2; +} + /* Helper function for walk_tree, used by independent_iterations_p below. */ static tree @@ -3082,48 +3109,60 @@ Loop_Statement_to_gnu (Node_Id gnat_node) the LOOP_STMT to it, finish it and make it the "loop". */ if (Present (gnat_iter_scheme) && No (Condition (gnat_iter_scheme))) { - struct range_check_info_d *rci; - unsigned n_checks = vec_safe_length (gnu_loop_info->checks); - unsigned int i; - - /* First, if we have computed a small number of invariant conditions for - range checks applied to the iteration variable, then initialize these - conditions in front of the loop. Otherwise, leave them set to true. - - ??? The heuristics need to be improved, by taking into account the - following datapoints: - - loop unswitching is disabled for big loops. The cap is the - parameter PARAM_MAX_UNSWITCH_INSNS (50). - - loop unswitching can only be applied a small number of times - to a given loop. The cap is PARAM_MAX_UNSWITCH_LEVEL (3). - - the front-end quickly generates useless or redundant checks - that can be entirely optimized away in the end. */ - if (1 <= n_checks && n_checks <= 4) - FOR_EACH_VEC_ELT (*gnu_loop_info->checks, i, rci) - { - tree low_ok - = rci->low_bound - ? build_binary_op (GE_EXPR, boolean_type_node, - convert (rci->type, gnu_low), - rci->low_bound) - : boolean_true_node; - - tree high_ok - = rci->high_bound - ? build_binary_op (LE_EXPR, boolean_type_node, - convert (rci->type, gnu_high), - rci->high_bound) - : boolean_true_node; - - tree range_ok - = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, - low_ok, high_ok); - - TREE_OPERAND (rci->invariant_cond, 0) - = build_unary_op (TRUTH_NOT_EXPR, boolean_type_node, range_ok); - - add_stmt_with_node_force (rci->invariant_cond, gnat_node); - } + /* First, if we have computed invariant conditions for range (or index) + checks applied to the iteration variable, find out whether they can + be evaluated to false at compile time; otherwise, if there are not + too many of them, combine them with the original checks. If loop + unswitching is enabled, do not require the loop bounds to be also + invariant, as their evaluation will still be ahead of the loop. */ + if (vec_safe_length (gnu_loop_info->checks) > 0 + && (make_invariant (&gnu_low, &gnu_high) || flag_unswitch_loops)) + { + struct range_check_info_d *rci; + unsigned int i, n_remaining_checks = 0; + + FOR_EACH_VEC_ELT (*gnu_loop_info->checks, i, rci) + { + tree low_ok + = rci->low_bound + ? build_binary_op (GE_EXPR, boolean_type_node, + convert (rci->type, gnu_low), + rci->low_bound) + : boolean_true_node; + + tree high_ok + = rci->high_bound + ? build_binary_op (LE_EXPR, boolean_type_node, + convert (rci->type, gnu_high), + rci->high_bound) + : boolean_true_node; + + tree range_ok + = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node, + low_ok, high_ok); + + rci->invariant_cond + = build_unary_op (TRUTH_NOT_EXPR, boolean_type_node, range_ok); + + if (rci->invariant_cond == boolean_false_node) + TREE_OPERAND (rci->inserted_cond, 0) = rci->invariant_cond; + else + n_remaining_checks++; + } + + /* Note that loop unswitching can only be applied a small number of + times to a given loop (PARAM_MAX_UNSWITCH_LEVEL default to 3). */ + if (0 < n_remaining_checks && n_remaining_checks <= 3 + && optimize > 1 && !optimize_size) + FOR_EACH_VEC_ELT (*gnu_loop_info->checks, i, rci) + if (rci->invariant_cond != boolean_false_node) + { + TREE_OPERAND (rci->inserted_cond, 0) = rci->invariant_cond; + + if (flag_unswitch_loops) + add_stmt_with_node_force (rci->inserted_cond, gnat_node); + } + } /* Second, if loop vectorization is enabled and the iterations of the loop can easily be proved as independent, mark the loop. */ @@ -3865,8 +3904,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) for (t = TREE_CHAIN (gnu_cico_list); t; t = TREE_CHAIN (t)) { tree gnu_field_deref - = build_component_ref (gnu_ret_deref, NULL_TREE, - TREE_PURPOSE (t), true); + = build_component_ref (gnu_ret_deref, TREE_PURPOSE (t), true); gnu_result = build2 (MODIFY_EXPR, void_type_node, gnu_field_deref, TREE_VALUE (t)); add_stmt_with_node (gnu_result, gnat_end_label); @@ -4698,8 +4736,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, tree gnu_result = length == 1 ? gnu_call - : build_component_ref (gnu_call, NULL_TREE, - TREE_PURPOSE (gnu_cico_list), false); + : build_component_ref (gnu_call, TREE_PURPOSE (gnu_cico_list), + false); /* If the actual is a conversion, get the inner expression, which will be the real destination, and convert the result to the @@ -4786,8 +4824,8 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, if (TYPE_CI_CO_LIST (gnu_subprog_type)) { tree gnu_elmt = TYPE_CI_CO_LIST (gnu_subprog_type); - gnu_call = build_component_ref (gnu_call, NULL_TREE, - TREE_PURPOSE (gnu_elmt), false); + gnu_call + = build_component_ref (gnu_call, TREE_PURPOSE (gnu_elmt), false); gnu_result_type = TREE_TYPE (gnu_call); } @@ -5142,7 +5180,7 @@ Exception_Handler_to_gnu_sjlj (Node_Id gnat_node) (build_unary_op (INDIRECT_REF, NULL_TREE, gnu_except_ptr_stack->last ()), - get_identifier ("not_handled_by_others"), NULL_TREE, + not_handled_by_others_decl, false)), integer_zero_node); } @@ -5396,6 +5434,31 @@ Compilation_Unit_to_gnu (Node_Id gnat_node) process_deferred_decl_context (true); } +/* Mark COND, a boolean expression, as predicating a call to a noreturn + function, i.e. predict that it is very likely false, and return it. + + The compiler will automatically predict the last edge leading to a call + to a noreturn function as very unlikely taken. This function makes it + possible to expand the prediction to predecessors in case the condition + is made up of several short-circuit operators. */ + +static tree +build_noreturn_cond (tree cond) +{ + tree fn = builtin_decl_explicit (BUILT_IN_EXPECT); + tree arg_types = TYPE_ARG_TYPES (TREE_TYPE (fn)); + tree pred_type = TREE_VALUE (arg_types); + tree expected_type = TREE_VALUE (TREE_CHAIN (arg_types)); + + tree t = build_call_expr (fn, 3, + fold_convert (pred_type, cond), + build_int_cst (expected_type, 0), + build_int_cst (integer_type_node, + PRED_NORETURN)); + + return build1 (NOP_EXPR, boolean_type_node, t); +} + /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Raise_xxx_Error, to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to where we should place the result type. LABEL_P is true if there is a label to @@ -5467,18 +5530,29 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) = build_call_raise_range (reason, gnat_node, gnu_index, gnu_low_bound, gnu_high_bound); - /* If loop unswitching is enabled, we try to compute invariant - conditions for checks applied to iteration variables, i.e. - conditions that are both independent of the variable and - necessary in order for the check to fail in the course of - some iteration, and prepend them to the original condition - of the checks. This will make it possible later for the - loop unswitching pass to replace the loop with two loops, - one of which has the checks eliminated and the other has - the original checks reinstated, and a run time selection. - The former loop will be suitable for vectorization. */ + /* If optimization is enabled and we are inside a loop, we try to + compute invariant conditions for checks applied to the iteration + variable, i.e. conditions that are independent of the variable + and necessary in order for the checks to fail in the course of + some iteration. If we succeed, we consider an alternative: + + 1. If loop unswitching is enabled, we prepend these conditions + to the original conditions of the checks. This will make it + possible for the loop unswitching pass to replace the loop + with two loops, one of which has the checks eliminated and + the other has the original checks reinstated, and a prologue + implementing a run-time selection. The former loop will be + for example suitable for vectorization. + + 2. Otherwise, we instead append the conditions to the original + conditions of the checks. At worse, if the conditions cannot + be evaluated at compile time, they will be evaluated as true + at run time only when the checks have already failed, thus + contributing negatively only to the size of the executable. + But the hope is that these invariant conditions be evaluated + at compile time to false, thus taking away the entire checks + with them. */ if (optimize - && flag_unswitch_loops && inside_loop_p () && (!gnu_low_bound || (gnu_low_bound = gnat_invariant_expr (gnu_low_bound))) @@ -5490,14 +5564,21 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) rci->low_bound = gnu_low_bound; rci->high_bound = gnu_high_bound; rci->type = get_unpadded_type (gnat_type); - rci->invariant_cond = build1 (SAVE_EXPR, boolean_type_node, - boolean_true_node); + rci->inserted_cond + = build1 (SAVE_EXPR, boolean_type_node, boolean_true_node); vec_safe_push (loop->checks, rci); loop->has_checks = true; - gnu_cond = build_binary_op (TRUTH_ANDIF_EXPR, - boolean_type_node, - rci->invariant_cond, - gnat_to_gnu (gnat_cond)); + gnu_cond = build_noreturn_cond (gnat_to_gnu (gnat_cond)); + if (flag_unswitch_loops) + gnu_cond = build_binary_op (TRUTH_ANDIF_EXPR, + boolean_type_node, + rci->inserted_cond, + gnu_cond); + else + gnu_cond = build_binary_op (TRUTH_ANDIF_EXPR, + boolean_type_node, + gnu_cond, + rci->inserted_cond); } /* Or else, if aggressive loop optimizations are enabled, we just @@ -6256,7 +6337,7 @@ gnat_to_gnu (Node_Id gnat_node) gnu_field = gnat_to_gnu_field_decl (gnat_field); gnu_result - = build_component_ref (gnu_prefix, NULL_TREE, gnu_field, + = build_component_ref (gnu_prefix, gnu_field, (Nkind (Parent (gnat_node)) == N_Attribute_Reference) && lvalue_required_for_attribute_p diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index b032ae03df7..aa2fdf24055 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -3970,11 +3970,9 @@ convert_to_fat_pointer (tree type, tree expr) expr = build_unary_op (INDIRECT_REF, NULL_TREE, expr); template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, - build_component_ref (expr, NULL_TREE, field, - false)); + build_component_ref (expr, field, false)); expr = build_unary_op (ADDR_EXPR, NULL_TREE, - build_component_ref (expr, NULL_TREE, - DECL_CHAIN (field), + build_component_ref (expr, DECL_CHAIN (field), false)); } } @@ -4110,8 +4108,7 @@ convert (tree type, tree expr) /* Otherwise, build an explicit component reference. */ else - unpadded - = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (etype), false); + unpadded = build_component_ref (expr, TYPE_FIELDS (etype), false); return convert (type, unpadded); } @@ -4132,8 +4129,8 @@ convert (tree type, tree expr) if (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype) && code != UNCONSTRAINED_ARRAY_TYPE && TYPE_MAIN_VARIANT (type) != TYPE_MAIN_VARIANT (etype)) - return convert (type, build_component_ref (expr, NULL_TREE, - TYPE_FIELDS (etype), false)); + return + convert (type, build_component_ref (expr, TYPE_FIELDS (etype), false)); /* If converting to a type that contains a template, convert to the data type and then build the template. */ @@ -4393,7 +4390,7 @@ convert (tree type, tree expr) do { tree field = TYPE_FIELDS (child_etype); if (DECL_NAME (field) == parent_name_id && TREE_TYPE (field) == type) - return build_component_ref (expr, NULL_TREE, field, false); + return build_component_ref (expr, field, false); child_etype = TREE_TYPE (field); } while (TREE_CODE (child_etype) == RECORD_TYPE); } @@ -4489,8 +4486,7 @@ convert (tree type, tree expr) /* If converting fat pointer to normal or thin pointer, get the pointer to the array and then convert it. */ if (TYPE_IS_FAT_POINTER_P (etype)) - expr - = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (etype), false); + expr = build_component_ref (expr, TYPE_FIELDS (etype), false); return fold (convert_to_pointer (type, expr)); @@ -4715,13 +4711,11 @@ maybe_unconstrained_array (tree exp) tree op1 = build_unary_op (INDIRECT_REF, NULL_TREE, build_component_ref (TREE_OPERAND (exp, 1), - NULL_TREE, TYPE_FIELDS (type), false)); tree op2 = build_unary_op (INDIRECT_REF, NULL_TREE, build_component_ref (TREE_OPERAND (exp, 2), - NULL_TREE, TYPE_FIELDS (type), false)); @@ -4732,8 +4726,8 @@ maybe_unconstrained_array (tree exp) else { exp = build_unary_op (INDIRECT_REF, NULL_TREE, - build_component_ref (exp, NULL_TREE, - TYPE_FIELDS (type), + build_component_ref (exp, + TYPE_FIELDS (type), false)); TREE_READONLY (exp) = read_only; TREE_THIS_NOTRAP (exp) = no_trap; @@ -4754,18 +4748,23 @@ maybe_unconstrained_array (tree exp) && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (TYPE_FIELDS (type)))) { exp = convert (TREE_TYPE (TYPE_FIELDS (type)), exp); + code = TREE_CODE (exp); type = TREE_TYPE (exp); } if (TYPE_CONTAINS_TEMPLATE_P (type)) { - exp = build_simple_component_ref (exp, NULL_TREE, - DECL_CHAIN (TYPE_FIELDS (type)), - false); + /* If the array initializer is a box, return NULL_TREE. */ + if (code == CONSTRUCTOR && CONSTRUCTOR_NELTS (exp) < 2) + return NULL_TREE; + + exp = build_component_ref (exp, DECL_CHAIN (TYPE_FIELDS (type)), + false); + type = TREE_TYPE (exp); /* If the array type is padded, convert to the unpadded type. */ - if (exp && TYPE_IS_PADDING_P (TREE_TYPE (exp))) - exp = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp); + if (TYPE_IS_PADDING_P (type)) + exp = convert (TREE_TYPE (TYPE_FIELDS (type)), exp); } break; @@ -4915,7 +4914,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) finish_record_type (rec_type, field, 1, false); expr = unchecked_convert (rec_type, expr, notrunc_p); - expr = build_component_ref (expr, NULL_TREE, field, false); + expr = build_component_ref (expr, field, false); expr = fold_build1 (NOP_EXPR, type, expr); } @@ -4986,8 +4985,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty, false, false, false, true); expr = unchecked_convert (rec_type, expr, notrunc_p); - expr = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (rec_type), - false); + expr = build_component_ref (expr, TYPE_FIELDS (rec_type), false); } } diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 73a9b10d26f..79e9b2f26da 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -467,8 +467,7 @@ compare_fat_pointers (location_t loc, tree result_type, tree p1, tree p2) if (TREE_CODE (p1) == CONSTRUCTOR) p1_array = CONSTRUCTOR_ELT (p1, 0)->value; else - p1_array = build_component_ref (p1, NULL_TREE, - TYPE_FIELDS (TREE_TYPE (p1)), true); + p1_array = build_component_ref (p1, TYPE_FIELDS (TREE_TYPE (p1)), true); p1_array_is_null = fold_build2_loc (loc, EQ_EXPR, result_type, p1_array, @@ -478,8 +477,7 @@ compare_fat_pointers (location_t loc, tree result_type, tree p1, tree p2) if (TREE_CODE (p2) == CONSTRUCTOR) p2_array = CONSTRUCTOR_ELT (p2, 0)->value; else - p2_array = build_component_ref (p2, NULL_TREE, - TYPE_FIELDS (TREE_TYPE (p2)), true); + p2_array = build_component_ref (p2, TYPE_FIELDS (TREE_TYPE (p2)), true); p2_array_is_null = fold_build2_loc (loc, EQ_EXPR, result_type, p2_array, @@ -500,15 +498,15 @@ compare_fat_pointers (location_t loc, tree result_type, tree p1, tree p2) p1_bounds = CONSTRUCTOR_ELT (p1, 1)->value; else p1_bounds - = build_component_ref (p1, NULL_TREE, - DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (p1))), true); + = build_component_ref (p1, DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (p1))), + true); if (TREE_CODE (p2) == CONSTRUCTOR) p2_bounds = CONSTRUCTOR_ELT (p2, 1)->value; else p2_bounds - = build_component_ref (p2, NULL_TREE, - DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (p2))), true); + = build_component_ref (p2, DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (p2))), + true); same_bounds = fold_build2_loc (loc, EQ_EXPR, result_type, p1_bounds, p2_bounds); @@ -1942,80 +1940,65 @@ gnat_build_constructor (tree type, vec *v) return result; } -/* Return a COMPONENT_REF to access a field that is given by COMPONENT, - an IDENTIFIER_NODE giving the name of the field, or FIELD, a FIELD_DECL, - for the field. Don't fold the result if NO_FOLD_P is true. +/* Return a COMPONENT_REF to access FIELD in RECORD, or NULL_TREE if the field + is not found in the record. Don't fold the result if NO_FOLD is true. */ - We also handle the fact that we might have been passed a pointer to the - actual record and know how to look for fields in variant parts. */ - -tree -build_simple_component_ref (tree record_variable, tree component, tree field, - bool no_fold_p) +static tree +build_simple_component_ref (tree record, tree field, bool no_fold) { - tree record_type = TYPE_MAIN_VARIANT (TREE_TYPE (record_variable)); - tree base, ref; + tree type = TYPE_MAIN_VARIANT (TREE_TYPE (record)); + tree ref; - gcc_assert (RECORD_OR_UNION_TYPE_P (record_type) - && COMPLETE_TYPE_P (record_type) - && (component == NULL_TREE) != (field == NULL_TREE)); - - /* If no field was specified, look for a field with the specified name in - the current record only. */ - if (!field) - for (field = TYPE_FIELDS (record_type); - field; - field = DECL_CHAIN (field)) - if (DECL_NAME (field) == component) - break; + gcc_assert (RECORD_OR_UNION_TYPE_P (type) && COMPLETE_TYPE_P (type)); - if (!field) - return NULL_TREE; + /* Try to fold a conversion from another record or union type unless the type + contains a placeholder as it might be needed for a later substitution. */ + if (TREE_CODE (record) == VIEW_CONVERT_EXPR + && RECORD_OR_UNION_TYPE_P (TREE_TYPE (TREE_OPERAND (record, 0))) + && !type_contains_placeholder_p (type)) + { + tree op = TREE_OPERAND (record, 0); + + /* If this is an unpadding operation, convert the underlying object to + the unpadded type directly. */ + if (TYPE_IS_PADDING_P (type) && field == TYPE_FIELDS (type)) + return convert (TREE_TYPE (field), op); + + /* Otherwise try to access FIELD directly in the underlying type, but + make sure that the form of the reference doesn't change too much; + this can happen for an unconstrained bit-packed array type whose + constrained form can be an integer type. */ + ref = build_simple_component_ref (op, field, no_fold); + if (ref && TREE_CODE (TREE_TYPE (ref)) == TREE_CODE (TREE_TYPE (field))) + return ref; + } /* If this field is not in the specified record, see if we can find a field in the specified record whose original field is the same as this one. */ - if (DECL_CONTEXT (field) != record_type) + if (DECL_CONTEXT (field) != type) { tree new_field; /* First loop through normal components. */ - for (new_field = TYPE_FIELDS (record_type); + for (new_field = TYPE_FIELDS (type); new_field; new_field = DECL_CHAIN (new_field)) if (SAME_FIELD_P (field, new_field)) break; - /* Next, see if we're looking for an inherited component in an extension. - If so, look through the extension directly, unless the type contains - a placeholder, as it might be needed for a later substitution. */ - if (!new_field - && TREE_CODE (record_variable) == VIEW_CONVERT_EXPR - && TYPE_ALIGN_OK (record_type) - && !type_contains_placeholder_p (record_type) - && TREE_CODE (TREE_TYPE (TREE_OPERAND (record_variable, 0))) - == RECORD_TYPE - && TYPE_ALIGN_OK (TREE_TYPE (TREE_OPERAND (record_variable, 0)))) - { - ref = build_simple_component_ref (TREE_OPERAND (record_variable, 0), - NULL_TREE, field, no_fold_p); - if (ref) - return ref; - } - /* Next, loop through DECL_INTERNAL_P components if we haven't found the component in the first search. Doing this search in two steps is required to avoid hidden homonymous fields in the _Parent field. */ if (!new_field) - for (new_field = TYPE_FIELDS (record_type); + for (new_field = TYPE_FIELDS (type); new_field; new_field = DECL_CHAIN (new_field)) - if (DECL_INTERNAL_P (new_field)) + if (DECL_INTERNAL_P (new_field) + && RECORD_OR_UNION_TYPE_P (TREE_TYPE (new_field))) { tree field_ref - = build_simple_component_ref (record_variable, - NULL_TREE, new_field, no_fold_p); - ref = build_simple_component_ref (field_ref, NULL_TREE, field, - no_fold_p); + = build_simple_component_ref (record, new_field, no_fold); + ref = build_simple_component_ref (field_ref, field, no_fold); if (ref) return ref; } @@ -2033,95 +2016,49 @@ build_simple_component_ref (tree record_variable, tree component, tree field, && TREE_OVERFLOW (DECL_FIELD_OFFSET (field))) return NULL_TREE; - /* We have found a suitable field. Before building the COMPONENT_REF, get - the base object of the record variable if possible. */ - base = record_variable; - - if (TREE_CODE (record_variable) == VIEW_CONVERT_EXPR) - { - tree inner_variable = TREE_OPERAND (record_variable, 0); - tree inner_type = TYPE_MAIN_VARIANT (TREE_TYPE (inner_variable)); - - /* Look through a conversion between type variants. This is transparent - as far as the field is concerned. */ - if (inner_type == record_type) - base = inner_variable; - - /* Look through a conversion between original and packable version, but - the field needs to be adjusted in this case. */ - else if (RECORD_OR_UNION_TYPE_P (inner_type) - && TYPE_NAME (inner_type) == TYPE_NAME (record_type)) - { - tree new_field; - - for (new_field = TYPE_FIELDS (inner_type); - new_field; - new_field = DECL_CHAIN (new_field)) - if (SAME_FIELD_P (field, new_field)) - break; - if (new_field) - { - field = new_field; - base = inner_variable; - } - } - } - - ref = build3 (COMPONENT_REF, TREE_TYPE (field), base, field, NULL_TREE); + ref = build3 (COMPONENT_REF, TREE_TYPE (field), record, field, NULL_TREE); - if (TREE_READONLY (record_variable) + if (TREE_READONLY (record) || TREE_READONLY (field) - || TYPE_READONLY (record_type)) + || TYPE_READONLY (type)) TREE_READONLY (ref) = 1; - if (TREE_THIS_VOLATILE (record_variable) + if (TREE_THIS_VOLATILE (record) || TREE_THIS_VOLATILE (field) - || TYPE_VOLATILE (record_type)) + || TYPE_VOLATILE (type)) TREE_THIS_VOLATILE (ref) = 1; - if (no_fold_p) + if (no_fold) return ref; /* The generic folder may punt in this case because the inner array type can be self-referential, but folding is in fact not problematic. */ - if (TREE_CODE (base) == CONSTRUCTOR - && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (base))) + if (TREE_CODE (record) == CONSTRUCTOR + && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (record))) { - unsigned int len = CONSTRUCTOR_NELTS (base); - gcc_assert (len > 0); - - if (field == CONSTRUCTOR_ELT (base, 0)->index) - return CONSTRUCTOR_ELT (base, 0)->value; - - if (len > 1) - { - if (field == CONSTRUCTOR_ELT (base, 1)->index) - return CONSTRUCTOR_ELT (base, 1)->value; - } - else - return NULL_TREE; - + vec *elts = CONSTRUCTOR_ELTS (record); + unsigned HOST_WIDE_INT idx; + tree index, value; + FOR_EACH_CONSTRUCTOR_ELT (elts, idx, index, value) + if (index == field) + return value; return ref; } return fold (ref); } -/* Likewise, but generate a Constraint_Error if the reference could not be - found. */ +/* Likewise, but return NULL_EXPR and generate a Constraint_Error if the + field is not found in the record. */ tree -build_component_ref (tree record_variable, tree component, tree field, - bool no_fold_p) +build_component_ref (tree record, tree field, bool no_fold) { - tree ref = build_simple_component_ref (record_variable, component, field, - no_fold_p); + tree ref = build_simple_component_ref (record, field, no_fold); if (ref) return ref; - /* If FIELD was specified, assume this is an invalid user field so raise - Constraint_Error. Otherwise, we have no type to return so abort. */ - gcc_assert (field); + /* Assume this is an invalid user field so raise Constraint_Error. */ return build1 (NULL_EXPR, TREE_TYPE (field), build_call_raise (CE_Discriminant_Check_Failed, Empty, N_Raise_Constraint_Error)); @@ -2230,8 +2167,8 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node) = build_unary_op (INDIRECT_REF, NULL_TREE, aligning_record_addr); tree aligning_field - = build_component_ref (aligning_record, NULL_TREE, - TYPE_FIELDS (aligning_type), false); + = build_component_ref (aligning_record, TYPE_FIELDS (aligning_type), + false); tree aligning_field_addr = build_unary_op (ADDR_EXPR, NULL_TREE, aligning_field); @@ -2416,7 +2353,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, else storage_init = build_binary_op (INIT_EXPR, NULL_TREE, - build_component_ref (storage_deref, NULL_TREE, + build_component_ref (storage_deref, TYPE_FIELDS (storage_type), false), build_template (template_type, type, NULL_TREE)); @@ -2883,10 +2820,11 @@ done: tree gnat_invariant_expr (tree expr) { - tree type = TREE_TYPE (expr), t; + const tree type = TREE_TYPE (expr); expr = remove_conversions (expr, false); + /* Look through temporaries created to capture values. */ while ((TREE_CODE (expr) == CONST_DECL || (TREE_CODE (expr) == VAR_DECL && TREE_READONLY (expr))) && decl_function_context (expr) == current_function_decl @@ -2908,7 +2846,27 @@ gnat_invariant_expr (tree expr) if (TREE_CONSTANT (expr)) return fold_convert (type, expr); - t = expr; + /* Skip overflow checks since they don't change the invariantness. */ + if (TREE_CODE (expr) == COND_EXPR + && TREE_CODE (COND_EXPR_THEN (expr)) == COMPOUND_EXPR + && TREE_CODE (TREE_OPERAND (COND_EXPR_THEN (expr), 0)) == CALL_EXPR + && get_callee_fndecl (TREE_OPERAND (COND_EXPR_THEN (expr), 0)) + == gnat_raise_decls[CE_Overflow_Check_Failed]) + expr = COND_EXPR_ELSE (expr); + + /* Deal with addition or subtraction of constants. */ + if (TREE_CODE (expr) == PLUS_EXPR || TREE_CODE (expr) == MINUS_EXPR) + { + tree op0 = gnat_invariant_expr (TREE_OPERAND (expr, 0)); + tree op1 = TREE_OPERAND (expr, 1); + if (op0 && TREE_CONSTANT (op1)) + return fold_build2 (TREE_CODE (expr), type, op0, op1); + else + return NULL_TREE; + } + + bool invariant_p = false; + tree t = expr; while (true) { @@ -2917,6 +2875,7 @@ gnat_invariant_expr (tree expr) case COMPONENT_REF: if (TREE_OPERAND (t, 2) != NULL_TREE) return NULL_TREE; + invariant_p |= DECL_INVARIANT_P (TREE_OPERAND (t, 1)); break; case ARRAY_REF: @@ -2928,16 +2887,16 @@ gnat_invariant_expr (tree expr) break; case BIT_FIELD_REF: - case VIEW_CONVERT_EXPR: case REALPART_EXPR: case IMAGPART_EXPR: + case VIEW_CONVERT_EXPR: + CASE_CONVERT: break; case INDIRECT_REF: - if (!TREE_READONLY (t) - || TREE_SIDE_EFFECTS (t) - || !TREE_THIS_NOTRAP (t)) + if ((!invariant_p && !TREE_READONLY (t)) || TREE_SIDE_EFFECTS (t)) return NULL_TREE; + invariant_p = false; break; default: @@ -2956,7 +2915,7 @@ object: || decl_function_context (t) != current_function_decl)) return fold_convert (type, expr); - if (!TREE_READONLY (t)) + if (!invariant_p && !TREE_READONLY (t)) return NULL_TREE; if (TREE_CODE (t) == PARM_DECL) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d9d30e461ef..edd201f209b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2015-11-18 Eric Botcazou + + * gnat.dg/loop_optimization19.adb: New test. + * gnat.dg/loop_optimization20.adb: Likewise. + * gnat.dg/loop_optimization21.ad[sb]: Likewise. + 2015-11-18 Eric Botcazou * gnat.dg/opt52.adb: New test. diff --git a/gcc/testsuite/gnat.dg/loop_optimization19.adb b/gcc/testsuite/gnat.dg/loop_optimization19.adb new file mode 100644 index 00000000000..434a7b8d3f9 --- /dev/null +++ b/gcc/testsuite/gnat.dg/loop_optimization19.adb @@ -0,0 +1,45 @@ +-- { dg-do compile } +-- { dg-options "-O -fdump-tree-optimized" } + +procedure Loop_Optimization19 is + + type Array_T is array (Positive range <>) of Integer; + type Obj_T (Length : Natural) is + record + Elements : Array_T (1 .. Length); + end record; + + type T is access Obj_T; + + function Equal (S1, S2 : T) return Boolean; + pragma No_Inline (Equal); + + function Equal (S1, S2 : T) return Boolean is + begin + if S1.Length = S2.Length then + for I in 1 .. S1.Length loop + if S1.Elements (I) /= S2.Elements (I) then + return False; + end if; + end loop; + return True; + else + return False; + end if; + end Equal; + + A : T := new Obj_T (Length => 10); + B : T := new Obj_T (Length => 20); + C : T := new Obj_T (Length => 30); + +begin + if Equal (A, B) then + raise Program_Error; + else + if Equal (B, C) then + raise Program_Error; + end if; + end if; +end; + +-- { dg-final { scan-tree-dump-not "Index_Check" "optimized" } } diff --git a/gcc/testsuite/gnat.dg/loop_optimization20.adb b/gcc/testsuite/gnat.dg/loop_optimization20.adb new file mode 100644 index 00000000000..729799e605a --- /dev/null +++ b/gcc/testsuite/gnat.dg/loop_optimization20.adb @@ -0,0 +1,35 @@ +-- { dg-do compile } +-- { dg-options "-O -fdump-tree-optimized" } + +procedure Loop_Optimization20 is + + type Array_T is array (Positive range <>) of Integer; + type Obj_T (Length : Natural) is + record + Elements : Array_T (1 .. Length); + end record; + + type T is access Obj_T; + + function Is_Null (S1 : Obj_T) return Boolean; + pragma No_Inline (Is_Null); + + function Is_Null (S1 : Obj_T) return Boolean is + begin + for I in 1 .. S1.Length loop + if S1.Elements (I) /= 0 then + return False; + end if; + end loop; + return True; + end; + + A : T := new Obj_T'(Length => 10, Elements => (others => 0)); + +begin + if not Is_Null (A.all) then + raise Program_Error; + end if; +end; + +-- { dg-final { scan-tree-dump-not "Index_Check" "optimized" } } diff --git a/gcc/testsuite/gnat.dg/loop_optimization21.adb b/gcc/testsuite/gnat.dg/loop_optimization21.adb new file mode 100644 index 00000000000..957b715ff7d --- /dev/null +++ b/gcc/testsuite/gnat.dg/loop_optimization21.adb @@ -0,0 +1,20 @@ +-- { dg-do compile } +-- { dg-options "-O -fdump-tree-optimized" } + +package body Loop_Optimization21 is + + function Min (X : in Item_Vector) return Item is + Tmp_Min : Item; + begin + Tmp_Min := X (X'First); + for I in X'First + 1 .. X'Last loop + if X (I) <= Tmp_Min then + Tmp_Min := X (I); + end if; + end loop; + return Tmp_Min; + end Min; + +end Loop_Optimization21; + +-- { dg-final { scan-tree-dump-times "Index_Check" 1 "optimized" } } diff --git a/gcc/testsuite/gnat.dg/loop_optimization21.ads b/gcc/testsuite/gnat.dg/loop_optimization21.ads new file mode 100644 index 00000000000..4510b0e9c92 --- /dev/null +++ b/gcc/testsuite/gnat.dg/loop_optimization21.ads @@ -0,0 +1,9 @@ +package Loop_Optimization21 is + + type Item is new Float; + + type Item_Vector is array (Positive range <>) of Item; + + function Min (X : Item_Vector) return Item; + +end Loop_Optimization21; -- 2.30.2