* 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
+2015-11-18 Eric Botcazou <ebotcazou@adacore.com>
+
+ * 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 <ebotcazou@adacore.com>
* gcc-interface/misc.c: Move global variables to the top of the file.
#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))
else
gnu_expr
= build_component_ref
- (gnu_expr, NULL_TREE,
+ (gnu_expr,
DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))),
false);
}
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);
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;
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;
}
/* 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,
ADT_others_decl,
ADT_all_others_decl,
ADT_unhandled_others_decl,
+
ADT_LAST};
/* Define kind of exception information associated with raise statements. */
#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]
same as build_constructor in the language-independent tree.c. */
extern tree gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *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,
#include "gimple-expr.h"
#include "stringpool.h"
#include "cgraph.h"
+#include "predict.h"
#include "diagnostic.h"
#include "alias.h"
#include "fold-const.h"
tree high_bound;
tree type;
tree invariant_cond;
+ tree inserted_cond;
};
typedef struct range_check_info_d *range_check_info;
= 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)));
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
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);
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
? 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)
{
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
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;
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
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. */
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);
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
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);
}
(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);
}
process_deferred_decl_context (true);
}
\f
+/* 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
= 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)))
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
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
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));
}
}
/* 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);
}
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. */
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);
}
/* 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));
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));
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;
&& 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;
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);
}
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);
}
}
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,
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,
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);
return result;
}
\f
-/* 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;
}
&& 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<constructor_elt, va_gc> *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));
= 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);
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));
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
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)
{
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:
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:
|| 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)
+2015-11-18 Eric Botcazou <ebotcazou@adacore.com>
+
+ * 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 <ebotcazou@adacore.com>
* gnat.dg/opt52.adb: New test.
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+-- { 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" } }
--- /dev/null
+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;
projects / gcc.git / commitdiff