public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Ada] Remove more redundant checks in loops
@ 2015-11-18 21:55 Eric Botcazou
  0 siblings, 0 replies; only message in thread
From: Eric Botcazou @ 2015-11-18 21:55 UTC (permalink / raw)
  To: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 2735 bytes --]

This improves the infrastructure present in gigi to remove redundant checks, 
i.e. checks that can never fail at run time, in loops, either directly or by 
exposing more opportunities for the GIMPLE optimizers.  The patch is large but 
it also cleans up the GENERIC code generated by gigi, in particular removes a 
bunch of superfluous VIEW_CONVERT_EXPRs, so it's worth having IMO.

Tested on x86_64-suse-linux, applied on the mainline.


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>

	* gnat.dg/loop_optimization19.adb: New test.
	* gnat.dg/loop_optimization20.adb: Likewise.
	* gnat.dg/loop_optimization21.ad[sb]: Likewise.

-- 
Eric Botcazou

[-- Attachment #2: loop_optimization19.adb --]
[-- Type: text/x-adasrc, Size: 985 bytes --]

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

[-- Attachment #3: loop_optimization20.adb --]
[-- Type: text/x-adasrc, Size: 774 bytes --]

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

[-- Attachment #4: loop_optimization21.adb --]
[-- Type: text/x-adasrc, Size: 463 bytes --]

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

[-- Attachment #5: loop_optimization21.ads --]
[-- Type: text/x-adasrc, Size: 189 bytes --]

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;

[-- Attachment #6: p.diff --]
[-- Type: text/x-patch, Size: 43798 bytes --]

Index: gcc-interface/ada-tree.h
===================================================================
--- gcc-interface/ada-tree.h	(revision 230557)
+++ gcc-interface/ada-tree.h	(working copy)
@@ -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))
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 230560)
+++ gcc-interface/decl.c	(working copy)
@@ -1291,7 +1291,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 		    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_entit
 	      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_entit
 	    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_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;
 }
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h	(revision 230557)
+++ gcc-interface/gigi.h	(working copy)
@@ -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
 #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
    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,
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 230558)
+++ gcc-interface/trans.c	(working copy)
@@ -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, tre
 
 	  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);
+      /* 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;
 
-	    TREE_OPERAND (rci->invariant_cond, 0)
-	      = build_unary_op (TRUTH_NOT_EXPR, boolean_type_node, range_ok);
+	  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);
 
-	    add_stmt_with_node_force (rci->invariant_cond, gnat_node);
-	  }
+	      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_nod
 	  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 *gn
 	    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 *gn
       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 g
 		  (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_no
   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
@@ -5467,18 +5530,29 @@ Raise_Error_to_gnu (Node_Id gnat_node, t
 	      = 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, t
 	      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
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 230557)
+++ gcc-interface/utils.c	(working copy)
@@ -3970,11 +3970,9 @@ convert_to_fat_pointer (tree type, tree
 	  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,
       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,
 	  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);
 	}
     }
 
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c	(revision 230557)
+++ gcc-interface/utils2.c	(working copy)
@@ -467,8 +467,7 @@ compare_fat_pointers (location_t loc, tr
   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, tr
   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, tr
     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<c
   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));
+  gcc_assert (RECORD_OR_UNION_TYPE_P (type) && COMPLETE_TYPE_P (type));
 
-  /* 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;
-
-  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_
       && 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;
+  ref = build3 (COMPONENT_REF, TREE_TYPE (field), record, field, NULL_TREE);
 
-	  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);
-
-  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
 	= 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, t
       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)

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2015-11-18 21:55 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-11-18 21:55 [Ada] Remove more redundant checks in loops Eric Botcazou

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).