diff options
Diffstat (limited to 'gcc/ada/gcc-interface/trans.c')
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 267 |
1 files changed, 209 insertions, 58 deletions
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); |