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

 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.
 	(gnat_handle_option): Remove obsolete ATTRIBUTE_UNUSED markers.
 	(gnat_init_options): Minor tweak.

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))

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;
 }

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<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,

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

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);
 	}
     }
 

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<constructor_elt, va_gc> *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<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));
@@ -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)

gcc/testsuite/ChangeLog

 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.
 
 2015-11-18  Nathan Sidwell  <nathan@codesourcery.com>

gcc/testsuite/gnat.dg/loop_optimization19.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/loop_optimization20.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/loop_optimization21.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/loop_optimization21.ads

+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;