diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/ada-tree.h | 16 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 6 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 9 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.c | 8 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 267 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 88 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils2.c | 87 |
7 files changed, 415 insertions, 66 deletions
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index d10fcf0..c408de3 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -355,6 +355,9 @@ do { \ /* Nonzero in a DECL if it is made for a pointer that can never be null. */ #define DECL_CAN_NEVER_BE_NULL_P(NODE) DECL_LANG_FLAG_2 (NODE) +/* Nonzero in a VAR_DECL if it is made for a loop parameter. */ +#define DECL_LOOP_PARM_P(NODE) DECL_LANG_FLAG_3 (VAR_DECL_CHECK (NODE)) + /* Nonzero in a FIELD_DECL that is a dummy built for some internal reason. */ #define DECL_INTERNAL_P(NODE) DECL_LANG_FLAG_3 (FIELD_DECL_CHECK (NODE)) @@ -409,9 +412,16 @@ do { \ || (DECL_ORIGINAL_FIELD (FIELD1) \ && (DECL_ORIGINAL_FIELD (FIELD1) == DECL_ORIGINAL_FIELD (FIELD2)))) -/* In a VAR_DECL, points to the object being renamed if the VAR_DECL is a - renaming pointer, otherwise 0. Note that this object is guaranteed to - be protected against multiple evaluations. */ +/* In a VAR_DECL with the DECL_LOOP_PARM_P flag set, points to the special + induction variable that is built under certain circumstances, if any. */ +#define DECL_INDUCTION_VAR(NODE) \ + GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE)) +#define SET_DECL_INDUCTION_VAR(NODE, X) \ + SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X) + +/* In a VAR_DECL without the DECL_LOOP_PARM_P flag set and that is a renaming + pointer, points to the object being renamed, if any. Note that this object + is guaranteed to be protected against multiple evaluations. */ #define DECL_RENAMED_OBJECT(NODE) \ GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE)) #define SET_DECL_RENAMED_OBJECT(NODE, X) \ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index feb353b..81f891f 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1431,10 +1431,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TREE_ADDRESSABLE (gnu_decl) = 1; } + /* If this is a loop parameter, set the corresponding flag. */ + else if (kind == E_Loop_Parameter) + DECL_LOOP_PARM_P (gnu_decl) = 1; + /* If this is a renaming pointer, attach the renamed object to it and register it if we are at the global level. Note that an external constant is at the global level. */ - if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj) + else if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj) { SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj); if ((!definition && kind == E_Constant) || global_bindings_p ()) diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index f7f9b09..1439261 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -492,6 +492,10 @@ extern bool fntype_same_flags_p (const_tree, tree, bool, bool, bool); not permitted by the language being compiled. */ extern tree convert (tree type, tree expr); +/* Create an expression whose value is that of EXPR converted to the common + index type, which is sizetype. */ +extern tree convert_to_index_type (tree expr); + /* Routines created solely for the tree translator's sake. Their prototypes can be changed as desired. */ @@ -916,6 +920,11 @@ extern tree gnat_protect_expr (tree exp); through something we don't know how to stabilize. */ extern tree gnat_stabilize_reference (tree ref, bool force, bool *success); +/* If EXPR is an expression that is invariant in the current function, in the + sense that it can be evaluated anywhere in the function and any number of + times, return EXPR or an equivalent expression. Otherwise return NULL. */ +extern tree gnat_invariant_expr (tree expr); + /* Implementation of the builtin_function langhook. */ extern tree gnat_builtin_function (tree decl); diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index f651af5..9b66712 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -394,8 +394,12 @@ gnat_print_decl (FILE *file, tree node, int indent) break; case VAR_DECL: - print_node (file, "renamed object", DECL_RENAMED_OBJECT (node), - indent + 4); + if (DECL_LOOP_PARM_P (node)) + print_node (file, "induction var", DECL_INDUCTION_VAR (node), + indent + 4); + else + print_node (file, "renamed object", DECL_RENAMED_OBJECT (node), + indent + 4); break; default: diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 858810a..cd84dc7 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -189,8 +189,33 @@ static GTY(()) VEC(tree,gc) *gnu_return_label_stack; parameters. See processing for N_Subprogram_Body. */ static GTY(()) VEC(tree,gc) *gnu_return_var_stack; -/* Stack of LOOP_STMT nodes. */ -static GTY(()) VEC(tree,gc) *gnu_loop_label_stack; +/* Structure used to record information for a range check. */ +struct GTY(()) range_check_info_d { + tree low_bound; + tree high_bound; + tree type; + tree invariant_cond; +}; + +typedef struct range_check_info_d *range_check_info; + +DEF_VEC_P(range_check_info); +DEF_VEC_ALLOC_P(range_check_info,gc); + +/* Structure used to record information for a loop. */ +struct GTY(()) loop_info_d { + tree label; + tree loop_var; + VEC(range_check_info,gc) *checks; +}; + +typedef struct loop_info_d *loop_info; + +DEF_VEC_P(loop_info); +DEF_VEC_ALLOC_P(loop_info,gc); + +/* Stack of loop_info structures associated with LOOP_STMT nodes. */ +static GTY(()) VEC(loop_info,gc) *gnu_loop_stack; /* The stacks for N_{Push,Pop}_*_Label. */ static GTY(()) VEC(tree,gc) *gnu_constraint_error_label_stack; @@ -1008,6 +1033,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result); if (TREE_CODE (gnu_result) == INDIRECT_REF) TREE_THIS_NOTRAP (gnu_result) = 1; + + if (read_only) + TREE_READONLY (gnu_result) = 1; } /* If it's a PARM_DECL to foreign convention subprogram, convert it. */ @@ -1024,6 +1052,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) we can reference the renamed object directly, since the renamed expression has been protected against multiple evaluations. */ if (TREE_CODE (gnu_result) == VAR_DECL + && !DECL_LOOP_PARM_P (gnu_result) && DECL_RENAMED_OBJECT (gnu_result) && (!DECL_RENAMING_GLOBAL_P (gnu_result) || global_bindings_p ())) gnu_result = DECL_RENAMED_OBJECT (gnu_result); @@ -2114,6 +2143,44 @@ Case_Statement_to_gnu (Node_Id gnat_node) return gnu_result; } +/* Find out whether VAR is an iteration variable of an enclosing loop in the + current function. If so, push a range_check_info structure onto the stack + of this enclosing loop and return it. Otherwise, return NULL. */ + +static struct range_check_info_d * +push_range_check_info (tree var) +{ + struct loop_info_d *iter = NULL; + unsigned int i; + + if (VEC_empty (loop_info, gnu_loop_stack)) + return NULL; + + while (CONVERT_EXPR_P (var) || TREE_CODE (var) == VIEW_CONVERT_EXPR) + var = TREE_OPERAND (var, 0); + + if (TREE_CODE (var) != VAR_DECL) + return NULL; + + if (decl_function_context (var) != current_function_decl) + return NULL; + + for (i = VEC_length (loop_info, gnu_loop_stack) - 1; + VEC_iterate (loop_info, gnu_loop_stack, i, iter); + i--) + if (var == iter->loop_var) + break; + + if (iter) + { + struct range_check_info_d *rci = ggc_alloc_range_check_info_d (); + VEC_safe_push (range_check_info, gc, iter->checks, rci); + return rci; + } + + return NULL; +} + /* Return true if VAL (of type TYPE) can equal the minimum value if MAX is false, or the maximum value if MAX is true, of TYPE. */ @@ -2181,10 +2248,15 @@ static tree Loop_Statement_to_gnu (Node_Id gnat_node) { const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node); + struct loop_info_d *gnu_loop_info = ggc_alloc_cleared_loop_info_d (); tree gnu_loop_stmt = build4 (LOOP_STMT, void_type_node, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE); tree gnu_loop_label = create_artificial_label (input_location); - tree gnu_cond_expr = NULL_TREE, gnu_result; + tree gnu_cond_expr = NULL_TREE, gnu_low = NULL_TREE, gnu_high = NULL_TREE; + tree gnu_result; + + /* Push the loop_info structure associated with the LOOP_STMT. */ + VEC_safe_push (loop_info, gc, gnu_loop_stack, gnu_loop_info); /* Set location information for statement and end label. */ set_expr_location_from_node (gnu_loop_stmt, gnat_node); @@ -2192,9 +2264,8 @@ Loop_Statement_to_gnu (Node_Id gnat_node) &DECL_SOURCE_LOCATION (gnu_loop_label)); LOOP_STMT_LABEL (gnu_loop_stmt) = gnu_loop_label; - /* Save the end label of this LOOP_STMT in a stack so that a corresponding - N_Exit_Statement can find it. */ - VEC_safe_push (tree, gc, gnu_loop_label_stack, gnu_loop_label); + /* Save the label so that a corresponding N_Exit_Statement can find it. */ + gnu_loop_info->label = gnu_loop_label; /* Set the condition under which the loop must keep going. For the case "LOOP .... END LOOP;" the condition is always true. */ @@ -2214,14 +2285,15 @@ Loop_Statement_to_gnu (Node_Id gnat_node) Entity_Id gnat_loop_var = Defining_Entity (gnat_loop_spec); Entity_Id gnat_type = Etype (gnat_loop_var); tree gnu_type = get_unpadded_type (gnat_type); - tree gnu_low = TYPE_MIN_VALUE (gnu_type); - tree gnu_high = TYPE_MAX_VALUE (gnu_type); tree gnu_base_type = get_base_type (gnu_type); tree gnu_one_node = convert (gnu_base_type, integer_one_node); tree gnu_loop_var, gnu_loop_iv, gnu_first, gnu_last, gnu_stmt; enum tree_code update_code, test_code, shift_code; bool reverse = Reverse_Present (gnat_loop_spec), use_iv = false; + gnu_low = TYPE_MIN_VALUE (gnu_type); + gnu_high = TYPE_MAX_VALUE (gnu_type); + /* We must disable modulo reduction for the iteration variable, if any, in order for the loop comparison to be effective. */ if (reverse) @@ -2296,17 +2368,20 @@ Loop_Statement_to_gnu (Node_Id gnat_node) ; /* Otherwise, use the do-while form with the help of a special - induction variable in the (unsigned version of) the base - type, in order to have wrap-around arithmetics for it. */ + induction variable in the unsigned version of the base type + or the unsigned version of the size type, whichever is the + largest, in order to have wrap-around arithmetics for it. */ else { - if (!TYPE_UNSIGNED (gnu_base_type)) - { - gnu_base_type = gnat_unsigned_type (gnu_base_type); - gnu_first = convert (gnu_base_type, gnu_first); - gnu_last = convert (gnu_base_type, gnu_last); - gnu_one_node = convert (gnu_base_type, integer_one_node); - } + if (TYPE_PRECISION (gnu_base_type) + > TYPE_PRECISION (size_type_node)) + gnu_base_type = gnat_unsigned_type (gnu_base_type); + else + gnu_base_type = size_type_node; + + gnu_first = convert (gnu_base_type, gnu_first); + gnu_last = convert (gnu_base_type, gnu_last); + gnu_one_node = convert (gnu_base_type, integer_one_node); use_iv = true; } @@ -2379,6 +2454,12 @@ Loop_Statement_to_gnu (Node_Id gnat_node) gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1); if (DECL_BY_REF_P (gnu_loop_var)) gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_loop_var); + else if (use_iv) + { + gcc_assert (DECL_LOOP_PARM_P (gnu_loop_var)); + SET_DECL_INDUCTION_VAR (gnu_loop_var, gnu_loop_iv); + } + gnu_loop_info->loop_var = gnu_loop_var; /* Do all the arithmetics in the base type. */ gnu_loop_var = convert (gnu_base_type, gnu_loop_var); @@ -2437,6 +2518,45 @@ 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_length (range_check_info, 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 (i = 0; + VEC_iterate (range_check_info, gnu_loop_info->checks, i, rci); + i++) + { + tree low_ok + = build_binary_op (GE_EXPR, boolean_type_node, + convert (rci->type, gnu_low), + rci->low_bound); + tree high_ok + = build_binary_op (LE_EXPR, boolean_type_node, + convert (rci->type, gnu_high), + rci->high_bound); + 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); + } + add_stmt (gnu_loop_stmt); gnat_poplevel (); gnu_loop_stmt = end_stmt_group (); @@ -2453,7 +2573,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node) else gnu_result = gnu_loop_stmt; - VEC_pop (tree, gnu_loop_label_stack); + VEC_pop (loop_info, gnu_loop_stack); return gnu_result; } @@ -5588,7 +5708,7 @@ gnat_to_gnu (Node_Id gnat_node) ? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE), (Present (Name (gnat_node)) ? get_gnu_tree (Entity (Name (gnat_node))) - : VEC_last (tree, gnu_loop_label_stack))); + : VEC_last (loop_info, gnu_loop_stack)->label)); break; case N_Return_Statement: @@ -6174,7 +6294,11 @@ gnat_to_gnu (Node_Id gnat_node) case N_Raise_Storage_Error: { const int reason = UI_To_Int (Reason (gnat_node)); - const Node_Id cond = Condition (gnat_node); + const Node_Id gnat_cond = Condition (gnat_node); + const bool with_extra_info = Exception_Extra_Info + && !No_Exception_Handlers_Set () + && !get_exception_label (kind); + tree gnu_cond = NULL_TREE; if (type_annotate_only) { @@ -6184,43 +6308,66 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result_type = get_unpadded_type (Etype (gnat_node)); - if (Exception_Extra_Info - && !No_Exception_Handlers_Set () - && !get_exception_label (kind) - && VOID_TYPE_P (gnu_result_type) - && Present (cond)) - switch (reason) - { - case CE_Access_Check_Failed: + switch (reason) + { + case CE_Access_Check_Failed: + if (with_extra_info) gnu_result = build_call_raise_column (reason, gnat_node); - break; + break; - case CE_Index_Check_Failed: - case CE_Range_Check_Failed: - case CE_Invalid_Data: - if (Nkind (cond) == N_Op_Not - && Nkind (Right_Opnd (cond)) == N_In - && Nkind (Right_Opnd (Right_Opnd (cond))) == N_Range) - { - Node_Id op = Right_Opnd (cond); /* N_In node */ - Node_Id index = Left_Opnd (op); - Node_Id range = Right_Opnd (op); - Node_Id type = Etype (index); - if (Is_Type (type) - && Known_Esize (type) - && UI_To_Int (Esize (type)) <= 32) - gnu_result - = build_call_raise_range (reason, gnat_node, - gnat_to_gnu (index), - gnat_to_gnu - (Low_Bound (range)), - gnat_to_gnu - (High_Bound (range))); - } - break; + case CE_Index_Check_Failed: + case CE_Range_Check_Failed: + case CE_Invalid_Data: + if (Present (gnat_cond) + && Nkind (gnat_cond) == N_Op_Not + && Nkind (Right_Opnd (gnat_cond)) == N_In + && Nkind (Right_Opnd (Right_Opnd (gnat_cond))) == N_Range) + { + Node_Id gnat_index = Left_Opnd (Right_Opnd (gnat_cond)); + Node_Id gnat_type = Etype (gnat_index); + Node_Id gnat_range = Right_Opnd (Right_Opnd (gnat_cond)); + tree gnu_index = gnat_to_gnu (gnat_index); + tree gnu_low_bound = gnat_to_gnu (Low_Bound (gnat_range)); + tree gnu_high_bound = gnat_to_gnu (High_Bound (gnat_range)); + struct range_check_info_d *rci; + + if (with_extra_info + && Known_Esize (gnat_type) + && UI_To_Int (Esize (gnat_type)) <= 32) + gnu_result + = 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 (flag_unswitch_loops + && (gnu_low_bound = gnat_invariant_expr (gnu_low_bound)) + && (gnu_high_bound = gnat_invariant_expr (gnu_high_bound)) + && (rci = push_range_check_info (gnu_index))) + { + rci->low_bound = gnu_low_bound; + rci->high_bound = gnu_high_bound; + rci->type = gnat_to_gnu_type (gnat_type); + rci->invariant_cond = build1 (SAVE_EXPR, boolean_type_node, + boolean_true_node); + gnu_cond = build_binary_op (TRUTH_ANDIF_EXPR, + boolean_type_node, + rci->invariant_cond, + gnat_to_gnu (gnat_cond)); + } + } + break; - default: - break; + default: + break; } if (gnu_result == error_mark_node) @@ -6232,10 +6379,14 @@ gnat_to_gnu (Node_Id gnat_node) the code for the call. Handle a condition, if there is one. */ if (VOID_TYPE_P (gnu_result_type)) { - if (Present (cond)) - gnu_result - = build3 (COND_EXPR, void_type_node, gnat_to_gnu (cond), - gnu_result, alloc_stmt_list ()); + if (Present (gnat_cond)) + { + if (!gnu_cond) + gnu_cond = gnat_to_gnu (gnat_cond); + gnu_result + = build3 (COND_EXPR, void_type_node, gnu_cond, gnu_result, + alloc_stmt_list ()); + } } else gnu_result = build1 (NULL_EXPR, gnu_result_type, gnu_result); diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 7c7e7c6c..c4cfde7 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -1771,7 +1771,7 @@ process_attributes (tree decl, struct attrib *attr_list) void record_global_renaming_pointer (tree decl) { - gcc_assert (DECL_RENAMED_OBJECT (decl)); + gcc_assert (!DECL_LOOP_PARM_P (decl) && DECL_RENAMED_OBJECT (decl)); VEC_safe_push (tree, gc, global_renaming_pointers, decl); } @@ -4247,6 +4247,92 @@ convert (tree type, tree expr) gcc_unreachable (); } } + +/* Create an expression whose value is that of EXPR converted to the common + index type, which is sizetype. EXPR is supposed to be in the base type + of the GNAT index type. Calling it is equivalent to doing + + convert (sizetype, expr) + + but we try to distribute the type conversion with the knowledge that EXPR + cannot overflow in its type. This is a best-effort approach and we fall + back to the above expression as soon as difficulties are encountered. + + This is necessary to overcome issues that arise when the GNAT base index + type and the GCC common index type (sizetype) don't have the same size, + which is quite frequent on 64-bit architectures. In this case, and if + the GNAT base index type is signed but the iteration type of the loop has + been forced to unsigned, the loop scalar evolution engine cannot compute + a simple evolution for the general induction variables associated with the + array indices, because it will preserve the wrap-around semantics in the + unsigned type of their "inner" part. As a result, many loop optimizations + are blocked. + + The solution is to use a special (basic) induction variable that is at + least as large as sizetype, and to express the aforementioned general + induction variables in terms of this induction variable, eliminating + the problematic intermediate truncation to the GNAT base index type. + This is possible as long as the original expression doesn't overflow + and if the middle-end hasn't introduced artificial overflows in the + course of the various simplification it can make to the expression. */ + +tree +convert_to_index_type (tree expr) +{ + enum tree_code code = TREE_CODE (expr); + tree type = TREE_TYPE (expr); + + /* If the type is unsigned, overflow is allowed so we cannot be sure that + EXPR doesn't overflow. Keep it simple if optimization is disabled. */ + if (TYPE_UNSIGNED (type) || !optimize) + return convert (sizetype, expr); + + switch (code) + { + case VAR_DECL: + /* The main effect of the function: replace a loop parameter with its + associated special induction variable. */ + if (DECL_LOOP_PARM_P (expr) && DECL_INDUCTION_VAR (expr)) + expr = DECL_INDUCTION_VAR (expr); + break; + + CASE_CONVERT: + { + tree otype = TREE_TYPE (TREE_OPERAND (expr, 0)); + /* Bail out as soon as we suspect some sort of type frobbing. */ + if (TYPE_PRECISION (type) != TYPE_PRECISION (otype) + || TYPE_UNSIGNED (type) != TYPE_UNSIGNED (otype)) + break; + } + + /* ... fall through ... */ + + case NON_LVALUE_EXPR: + return fold_build1 (code, sizetype, + convert_to_index_type (TREE_OPERAND (expr, 0))); + + case PLUS_EXPR: + case MINUS_EXPR: + case MULT_EXPR: + return fold_build2 (code, sizetype, + convert_to_index_type (TREE_OPERAND (expr, 0)), + convert_to_index_type (TREE_OPERAND (expr, 1))); + + case COMPOUND_EXPR: + return fold_build2 (code, sizetype, TREE_OPERAND (expr, 0), + convert_to_index_type (TREE_OPERAND (expr, 1))); + + case COND_EXPR: + return fold_build3 (code, sizetype, TREE_OPERAND (expr, 0), + convert_to_index_type (TREE_OPERAND (expr, 1)), + convert_to_index_type (TREE_OPERAND (expr, 2))); + + default: + break; + } + + return convert (sizetype, expr); +} /* Remove all conversions that are done in EXP. This includes converting from a padded type or to a justified modular type. If TRUE_ADDRESS diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index cf290a3..4679ea8 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -798,7 +798,7 @@ build_binary_op (enum tree_code op_code, tree result_type, /* Then convert the right operand to its base type. This will prevent unneeded sign conversions when sizetype is wider than integer. */ right_operand = convert (right_base_type, right_operand); - right_operand = convert (sizetype, right_operand); + right_operand = convert_to_index_type (right_operand); modulus = NULL_TREE; break; @@ -2598,3 +2598,88 @@ gnat_stabilize_reference (tree ref, bool force, bool *success) return result; } + +/* If EXPR is an expression that is invariant in the current function, in the + sense that it can be evaluated anywhere in the function and any number of + times, return EXPR or an equivalent expression. Otherwise return NULL. */ + +tree +gnat_invariant_expr (tree expr) +{ + tree type = TREE_TYPE (expr), t; + + STRIP_NOPS (expr); + + while ((TREE_CODE (expr) == CONST_DECL + || (TREE_CODE (expr) == VAR_DECL && TREE_READONLY (expr))) + && decl_function_context (expr) == current_function_decl + && DECL_INITIAL (expr)) + { + expr = DECL_INITIAL (expr); + STRIP_NOPS (expr); + } + + if (TREE_CONSTANT (expr)) + return fold_convert (type, expr); + + t = expr; + + while (true) + { + switch (TREE_CODE (t)) + { + case COMPONENT_REF: + if (TREE_OPERAND (t, 2) != NULL_TREE) + return NULL_TREE; + break; + + case ARRAY_REF: + case ARRAY_RANGE_REF: + if (!TREE_CONSTANT (TREE_OPERAND (t, 1)) + || TREE_OPERAND (t, 2) != NULL_TREE + || TREE_OPERAND (t, 3) != NULL_TREE) + return NULL_TREE; + break; + + case BIT_FIELD_REF: + case VIEW_CONVERT_EXPR: + case REALPART_EXPR: + case IMAGPART_EXPR: + break; + + case INDIRECT_REF: + if (!TREE_READONLY (t) + || TREE_SIDE_EFFECTS (t) + || !TREE_THIS_NOTRAP (t)) + return NULL_TREE; + break; + + default: + goto object; + } + + t = TREE_OPERAND (t, 0); + } + +object: + if (TREE_SIDE_EFFECTS (t)) + return NULL_TREE; + + if (TREE_CODE (t) == CONST_DECL + && (DECL_EXTERNAL (t) + || decl_function_context (t) != current_function_decl)) + return fold_convert (type, expr); + + if (!TREE_READONLY (t)) + return NULL_TREE; + + if (TREE_CODE (t) == PARM_DECL) + return fold_convert (type, expr); + + if (TREE_CODE (t) == VAR_DECL + && (DECL_EXTERNAL (t) + || decl_function_context (t) != current_function_decl)) + return fold_convert (type, expr); + + return NULL_TREE; +} |