[Ada] Remove range check generation code in gigi

Message ID 3440296.T00tQaKsYs@arcturus.home
State New
Headers show
Series
  • [Ada] Remove range check generation code in gigi
Related show

Commit Message

Eric Botcazou Aug. 30, 2019, 1:51 p.m.
The generation of range checks is now entirely done by the front-end proper so 
the code to that effect in gigi is obsolete and can be removed, but the patch 
implements a watchdog mechanism to make sure no check is lost in the process.

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


2019-08-30  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/gigi.h (gigi_checking_assert): New macro.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Type>:
	Remove redundant test and adjust comments.  Minor tweaks.
	* gcc-interface/trans.c (Call_to_gnu): Do not generate range checks,
	instead assert that the Do_Range_Check flag is not set.  Adjust call
	to convert_with_check.
	(gnat_to_gnu): Likewise.
	(assoc_to_constructor): Likewise.
	(pos_to_constructor): Likewise.  Remove GNAT_COMPONENT_TYPE parameter.
	(emit_range_check): Delete.
	(convert_with_check): Remove RANGE_P parameter and adjust.  Do a single
	overflow check for modular types.

-- 
Eric Botcazou

Patch

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 275062)
+++ gcc-interface/decl.c	(working copy)
@@ -447,13 +447,13 @@  gnat_to_gnu_entity (Entity_Id gnat_entity, tree gn
      If we are not defining it, it must be a type or an entity that is defined
      elsewhere or externally, otherwise we should have defined it already.  */
   gcc_assert (definition
-	      || type_annotate_only
 	      || is_type
 	      || kind == E_Discriminant
 	      || kind == E_Component
 	      || kind == E_Label
 	      || (kind == E_Constant && Present (Full_View (gnat_entity)))
-	      || Is_Public (gnat_entity));
+	      || Is_Public (gnat_entity)
+	      || type_annotate_only);
 
   /* Get the name of the entity and set up the line number and filename of
      the original definition for use in any decl we make.  Make sure we do
@@ -1758,34 +1758,29 @@  gnat_to_gnu_entity (Entity_Id gnat_entity, tree gn
 
     case E_Modular_Integer_Type:
       {
-	/* For modular types, make the unsigned type of the proper number
-	   of bits and then set up the modulus, if required.  */
-	tree gnu_modulus, gnu_high = NULL_TREE;
-
 	/* Packed Array Impl. Types are supposed to be subtypes only.  */
 	gcc_assert (!Is_Packed_Array_Impl_Type (gnat_entity));
 
+	/* For modular types, make the unsigned type of the proper number
+	   of bits and then set up the modulus, if required.  */
 	gnu_type = make_unsigned_type (esize);
 
-	/* Get the modulus in this type.  If it overflows, assume it is because
-	   it is equal to 2**Esize.  Note that there is no overflow checking
-	   done on unsigned type, so we detect the overflow by looking for
-	   a modulus of zero, which is otherwise invalid.  */
-	gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
+	/* Get the modulus in this type.  If the modulus overflows, assume
+	   that this is because it was equal to 2**Esize.  Note that there
+	   is no overflow checking done on unsigned types, so we detect the
+	   overflow by looking for a modulus of zero, which is invalid.  */
+	tree gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
 
+	/* If the modulus is not 2**Esize, then this also means that the upper
+	   bound of the type, i.e. modulus - 1, is not maximal, so we create an
+	   extra subtype to carry it and set the modulus on the base type.  */
 	if (!integer_zerop (gnu_modulus))
 	  {
+	    TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
 	    TYPE_MODULAR_P (gnu_type) = 1;
 	    SET_TYPE_MODULUS (gnu_type, gnu_modulus);
-	    gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
-				    build_int_cst (gnu_type, 1));
-	  }
-
-	/* If the upper bound is not maximal, make an extra subtype.  */
-	if (gnu_high
-	    && !tree_int_cst_equal (gnu_high, TYPE_MAX_VALUE (gnu_type)))
-	  {
-	    TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
+	    tree gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
+					 build_int_cst (gnu_type, 1));
 	    gnu_type
 	      = create_extra_subtype (gnu_type, TYPE_MIN_VALUE (gnu_type),
 				      gnu_high);
@@ -2987,8 +2982,8 @@  gnat_to_gnu_entity (Entity_Id gnat_entity, tree gn
 		|| Present (Record_Extension_Part (record_definition)))
 	      record_definition = Record_Extension_Part (record_definition);
 
-	    gcc_assert (type_annotate_only
-			|| Present (Parent_Subtype (gnat_entity)));
+	    gcc_assert (Present (Parent_Subtype (gnat_entity))
+		        || type_annotate_only);
 	  }
 
 	/* Make a node for the record.  If we are not defining the record,
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h	(revision 275062)
+++ gcc-interface/gigi.h	(working copy)
@@ -6,7 +6,7 @@ 
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2018, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2019, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -1054,6 +1054,12 @@  extern void enumerate_modes (void (*f) (const char
 }
 #endif
 
+/* Use gigi_checking_assert to test invariants in code generation mode.
+   It's effective only if the compiler is configured with more checking
+   than the release mode and can be disabled by means of -fchecking.  */
+#define gigi_checking_assert(EXPR) \
+  gcc_checking_assert ((EXPR) || type_annotate_only)
+
 /* If EXP's type is a VECTOR_TYPE, return EXP converted to the associated
    TYPE_REPRESENTATIVE_ARRAY.  */
 
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 275062)
+++ gcc-interface/trans.c	(working copy)
@@ -231,14 +231,13 @@  static enum gimplify_status gnat_gimplify_stmt (tr
 static void elaborate_all_entities (Node_Id);
 static void process_freeze_entity (Node_Id);
 static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
-static tree emit_range_check (tree, Node_Id, Node_Id);
 static tree emit_check (tree, tree, int, Node_Id);
 static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
 static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
-static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
+static tree convert_with_check (Entity_Id, tree, bool, bool, Node_Id);
 static bool addressable_p (tree, tree);
 static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
-static tree pos_to_constructor (Node_Id, tree, Entity_Id);
+static tree pos_to_constructor (Node_Id, tree);
 static void validate_unchecked_conversion (Node_Id);
 static Node_Id adjust_for_implicit_deref (Node_Id);
 static tree maybe_implicit_deref (tree);
@@ -5407,11 +5406,7 @@  Call_to_gnu (Node_Id gnat_node, tree *gnu_result_t
       else
 	gnu_actual = convert (gnu_actual_type, gnu_actual);
 
-      /* Make sure that the actual is in range of the formal's type.  */
-      if (Ekind (gnat_formal) != E_Out_Parameter
-	  && Do_Range_Check (gnat_actual))
-	gnu_actual
-	  = emit_range_check (gnu_actual, gnat_formal_type, gnat_actual);
+      gigi_checking_assert (!Do_Range_Check (gnat_actual));
 
       /* First see if the parameter is passed by reference.  */
       if (is_true_formal_parm && DECL_BY_REF_P (gnu_formal))
@@ -5655,12 +5650,15 @@  Call_to_gnu (Node_Id gnat_node, tree *gnu_result_t
 	       conversion node and not from the inner Expression.  */
 	    if (Nkind (gnat_actual) == N_Type_Conversion)
 	      {
+		const Node_Id gnat_expr = Expression (gnat_actual);
+
+		gigi_checking_assert (!Do_Range_Check (gnat_expr));
+
 		gnu_result
-		  = convert_with_check
-		    (Etype (Expression (gnat_actual)), gnu_result,
-		     Do_Overflow_Check (gnat_actual),
-		     Do_Range_Check (Expression (gnat_actual)),
-		     Float_Truncate (gnat_actual), gnat_actual);
+		  = convert_with_check (Etype (gnat_expr), gnu_result,
+					Do_Overflow_Check (gnat_actual),
+					Float_Truncate (gnat_actual),
+					gnat_actual);
 
 		if (!Is_Composite_Type (Underlying_Type (Etype (gnat_formal))))
 		  gnu_actual = convert (TREE_TYPE (gnu_result), gnu_actual);
@@ -5676,10 +5674,7 @@  Call_to_gnu (Node_Id gnat_node, tree *gnu_result_t
 					      No_Truncation (gnat_actual));
 	    else
 	      {
-		if (Do_Range_Check (gnat_actual))
-		  gnu_result
-		    = emit_range_check (gnu_result, Etype (gnat_actual),
-					gnat_actual);
+		gigi_checking_assert (!Do_Range_Check (gnat_actual));
 
 		if (!(!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
 		      && TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_result)))))
@@ -5736,11 +5731,7 @@  Call_to_gnu (Node_Id gnat_node, tree *gnu_result_t
 	  Node_Id gnat_parent = Parent (gnat_node);
 	  enum tree_code op_code;
 
-	  /* If range check is needed, emit code to generate it.  */
-	  if (Do_Range_Check (gnat_node))
-	    gnu_call
-	      = emit_range_check (gnu_call, Etype (Name (gnat_parent)),
-				  gnat_parent);
+	  gigi_checking_assert (!Do_Range_Check (gnat_node));
 
 	  /* ??? If the return type has variable size, then force the return
 	     slot optimization as we would not be able to create a temporary.
@@ -7043,10 +7034,9 @@  gnat_to_gnu (Node_Id gnat_node)
 	  && (!type_annotate_only
 	      || Compile_Time_Known_Value (Expression (gnat_node))))
 	{
+	  gigi_checking_assert (!Do_Range_Check (Expression (gnat_node)));
+
 	  gnu_expr = gnat_to_gnu (Expression (gnat_node));
-	  if (Do_Range_Check (Expression (gnat_node)))
-	    gnu_expr
-	      = emit_range_check (gnu_expr, Etype (gnat_temp), gnat_node);
 
 	  if (type_annotate_only && TREE_CODE (gnu_expr) == ERROR_MARK)
 	    gnu_expr = NULL_TREE;
@@ -7396,8 +7386,7 @@  gnat_to_gnu (Node_Id gnat_node)
 				    gnu_aggr_type);
 	else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE)
 	  gnu_result = pos_to_constructor (First (Expressions (gnat_node)),
-					   gnu_aggr_type,
-					   Component_Type (Etype (gnat_node)));
+					   gnu_aggr_type);
 	else if (TREE_CODE (gnu_aggr_type) == COMPLEX_TYPE)
 	  gnu_result
 	    = build_binary_op
@@ -7436,10 +7425,11 @@  gnat_to_gnu (Node_Id gnat_node)
       if (kind == N_Qualified_Expression && Is_Tagged_Type (Etype (gnat_node)))
 	used_types_insert (gnu_result_type);
 
+      gigi_checking_assert (!Do_Range_Check (Expression (gnat_node)));
+
       gnu_result
 	= convert_with_check (Etype (gnat_node), gnu_expr,
 			      Do_Overflow_Check (gnat_node),
-			      Do_Range_Check (Expression (gnat_node)),
 			      kind == N_Type_Conversion
 			      && Float_Truncate (gnat_node), gnat_node);
       break;
@@ -7749,10 +7739,9 @@  gnat_to_gnu (Node_Id gnat_node)
 
 	gnat_temp = Expression (gnat_node);
 
-	/* The Expression operand can either be an N_Identifier or
-	   Expanded_Name, which must represent a type, or a
-	   N_Qualified_Expression, which contains both the object type and an
-	   initial value for the object.  */
+	/* The expression can be either an N_Identifier or an Expanded_Name,
+	   which must represent a type, or a N_Qualified_Expression, which
+	   contains both the type and an initial value for the object.  */
 	if (Nkind (gnat_temp) == N_Identifier
 	    || Nkind (gnat_temp) == N_Expanded_Name)
 	  gnu_type = gnat_to_gnu_type (Entity (gnat_temp));
@@ -7765,10 +7754,9 @@  gnat_to_gnu (Node_Id gnat_node)
 	    gnu_init = gnat_to_gnu (Expression (gnat_temp));
 
 	    gnu_init = maybe_unconstrained_array (gnu_init);
-	    if (Do_Range_Check (Expression (gnat_temp)))
-	      gnu_init
-		= emit_range_check (gnu_init, gnat_desig_type, gnat_temp);
 
+	    gigi_checking_assert (!Do_Range_Check (Expression (gnat_temp)));
+
 	    if (Is_Elementary_Type (gnat_desig_type)
 		|| Is_Constrained (gnat_desig_type))
 	      gnu_type = gnat_to_gnu_type (gnat_desig_type);
@@ -7873,10 +7861,7 @@  gnat_to_gnu (Node_Id gnat_node)
 	  else
 	    gnu_rhs = maybe_unconstrained_array (gnat_to_gnu (gnat_expr));
 
-	  /* If range check is needed, emit code to generate it.  */
-	  if (Do_Range_Check (gnat_expr))
-	    gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)),
-					gnat_node);
+	  gigi_checking_assert (!Do_Range_Check (gnat_expr));
 
 	  /* If an outer atomic access is required on the LHS, build the load-
 	     modify-store sequence.  */
@@ -10086,58 +10071,6 @@  build_binary_op_trapv (enum tree_code code, tree g
   return emit_check (check, gnu_expr, CE_Overflow_Check_Failed, gnat_node);
 }
 
-/* Emit code for a range check.  GNU_EXPR is the expression to be checked,
-   GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against
-   which we have to check.  GNAT_NODE is the GNAT node conveying the source
-   location for which the error should be signaled.  */
-
-static tree
-emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id gnat_node)
-{
-  tree gnu_range_type = get_unpadded_type (gnat_range_type);
-  tree gnu_compare_type = get_base_type (TREE_TYPE (gnu_expr));
-
-  /* If GNU_EXPR has GNAT_RANGE_TYPE as its base type, no check is needed.
-     This can for example happen when translating 'Val or 'Value.  */
-  if (gnu_compare_type == gnu_range_type)
-    return gnu_expr;
-
-  /* Range checks can only be applied to types with ranges.  */
-  gcc_assert (INTEGRAL_TYPE_P (gnu_range_type)
-              || SCALAR_FLOAT_TYPE_P (gnu_range_type));
-
-  /* If GNU_EXPR has an integral type that is narrower than GNU_RANGE_TYPE,
-     we can't do anything since we might be truncating the bounds.  No
-     check is needed in this case.  */
-  if (INTEGRAL_TYPE_P (TREE_TYPE (gnu_expr))
-      && (TYPE_PRECISION (gnu_compare_type)
-	  < TYPE_PRECISION (get_base_type (gnu_range_type))))
-    return gnu_expr;
-
-  /* Checked expressions must be evaluated only once.  */
-  gnu_expr = gnat_protect_expr (gnu_expr);
-
-  /* Note that the form of the check is
-	(not (expr >= lo)) or (not (expr <= hi))
-     the reason for this slightly convoluted form is that NaNs
-     are not considered to be in range in the float case.  */
-  return emit_check
-    (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
-		      invert_truthvalue
-		      (build_binary_op (GE_EXPR, boolean_type_node,
-				        convert (gnu_compare_type, gnu_expr),
-				        convert (gnu_compare_type,
-						 TYPE_MIN_VALUE
-						 (gnu_range_type)))),
-		      invert_truthvalue
-		      (build_binary_op (LE_EXPR, boolean_type_node,
-					convert (gnu_compare_type, gnu_expr),
-					convert (gnu_compare_type,
-						 TYPE_MAX_VALUE
-						 (gnu_range_type))))),
-     gnu_expr, CE_Range_Check_Failed, gnat_node);
-}
-
 /* GNU_COND contains the condition corresponding to an index, overflow or
    range check of value GNU_EXPR.  Build a COND_EXPR that returns GNU_EXPR
    if GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.
@@ -10169,14 +10102,13 @@  emit_check (tree gnu_cond, tree gnu_expr, int reas
 }
 
 /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow
-   checks if OVERFLOW_P is true and range checks if RANGE_P is true.
-   If TRUNCATE_P true, do a float-to-integer conversion with truncation,
-   otherwise round.  GNAT_NODE is the GNAT node conveying the source location
-   for which the error should be signaled.  */
+   checks if OVERFLOW_P is true.  If TRUNCATE_P is true, do a fp-to-integer
+   conversion with truncation, otherwise round.  GNAT_NODE is the GNAT node
+   conveying the source location for which the error should be signaled.  */
 
 static tree
 convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
-		    bool range_p, bool truncate_p, Node_Id gnat_node)
+		    bool truncate_p, Node_Id gnat_node)
 {
   tree gnu_type = get_unpadded_type (gnat_type);
   tree gnu_base_type = get_base_type (gnu_type);
@@ -10187,8 +10119,7 @@  convert_with_check (Entity_Id gnat_type, tree gnu_
   /* If we are not doing any checks, the output is an integral type and the
      input is not a floating-point type, just do the conversion.  This is
      required for packed array types and is simpler in all cases anyway.   */
-  if (!range_p
-      && !overflow_p
+  if (!overflow_p
       && INTEGRAL_TYPE_P (gnu_base_type)
       && !FLOAT_TYPE_P (gnu_in_base_type))
     return convert (gnu_type, gnu_expr);
@@ -10221,7 +10152,13 @@  convert_with_check (Entity_Id gnat_type, tree gnu_
       tree gnu_in_lb = TYPE_MIN_VALUE (gnu_in_base_type);
       tree gnu_in_ub = TYPE_MAX_VALUE (gnu_in_base_type);
       tree gnu_out_lb = TYPE_MIN_VALUE (gnu_base_type);
-      tree gnu_out_ub = TYPE_MAX_VALUE (gnu_base_type);
+      tree gnu_out_ub
+	= (TREE_CODE (gnu_base_type) == INTEGER_TYPE
+	   && TYPE_MODULAR_P (gnu_base_type))
+	  ? fold_build2 (MINUS_EXPR, gnu_base_type,
+			 TYPE_MODULUS (gnu_base_type),
+			 build_int_cst (gnu_base_type, 1))
+	  : TYPE_MAX_VALUE (gnu_base_type);
 
       /* Convert the lower bounds to signed types, so we're sure we're
 	 comparing them properly.  Likewise, convert the upper bounds
@@ -10346,14 +10283,6 @@  convert_with_check (Entity_Id gnat_type, tree gnu_
   else
     gnu_result = convert (gnu_base_type, gnu_result);
 
-  /* Finally, do the range check if requested.  Note that if the result type
-     is a modular type, the range check is actually an overflow check.  */
-  if (range_p
-      || (overflow_p
-	  && TREE_CODE (gnu_base_type) == INTEGER_TYPE
-	  && TYPE_MODULAR_P (gnu_base_type)))
-    gnu_result = emit_range_check (gnu_result, gnat_type, gnat_node);
-
   return convert (gnu_type, gnu_result);
 }
 
@@ -10682,7 +10611,8 @@  assoc_to_constructor (Entity_Id gnat_entity, Node_
 
   for (; Present (gnat_assoc); gnat_assoc = Next (gnat_assoc))
     {
-      Node_Id gnat_field = First (Choices (gnat_assoc));
+      const Node_Id gnat_field = First (Choices (gnat_assoc));
+      const Node_Id gnat_expr = Expression (gnat_assoc);
       tree gnu_field = gnat_to_gnu_field_decl (Entity (gnat_field));
       tree gnu_expr = gnat_to_gnu (Expression (gnat_assoc));
 
@@ -10702,11 +10632,9 @@  assoc_to_constructor (Entity_Id gnat_entity, Node_
 	  && Is_Unchecked_Union (gnat_entity))
 	continue;
 
-      /* Before assigning a value in an aggregate make sure range checks
-	 are done if required.  Then convert to the type of the field.  */
-      if (Do_Range_Check (Expression (gnat_assoc)))
-	gnu_expr = emit_range_check (gnu_expr, Etype (gnat_field), Empty);
+      gigi_checking_assert (!Do_Range_Check (gnat_expr));
 
+      /* Convert to the type of the field.  */
       gnu_expr = convert (TREE_TYPE (gnu_field), gnu_expr);
 
       /* Add the field and expression to the list.  */
@@ -10727,13 +10655,10 @@  assoc_to_constructor (Entity_Id gnat_entity, Node_
 
 /* Build a possibly nested constructor for array aggregates.  GNAT_EXPR is
    the first element of an array aggregate.  It may itself be an aggregate.
-   GNU_ARRAY_TYPE is the GCC type corresponding to the array aggregate.
-   GNAT_COMPONENT_TYPE is the type of the array component; it is needed
-   for range checking.  */
+   GNU_ARRAY_TYPE is the GCC type corresponding to the array aggregate.  */
 
 static tree
-pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
-		    Entity_Id gnat_component_type)
+pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type)
 {
   tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
   vec<constructor_elt, va_gc> *gnu_expr_vec = NULL;
@@ -10749,8 +10674,7 @@  static tree
 	  && TREE_CODE (TREE_TYPE (gnu_array_type)) == ARRAY_TYPE
 	  && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_array_type)))
 	gnu_expr = pos_to_constructor (First (Expressions (gnat_expr)),
-				       TREE_TYPE (gnu_array_type),
-				       gnat_component_type);
+				       TREE_TYPE (gnu_array_type));
       else
 	{
 	  /* If the expression is a conversion to an unconstrained array type,
@@ -10762,10 +10686,7 @@  static tree
 	  else
 	    gnu_expr = gnat_to_gnu (gnat_expr);
 
-	  /* Before assigning the element to the array, make sure it is
-	     in range.  */
-	  if (Do_Range_Check (gnat_expr))
-	    gnu_expr = emit_range_check (gnu_expr, gnat_component_type, Empty);
+	  gigi_checking_assert (!Do_Range_Check (gnat_expr));
 	}
 
       CONSTRUCTOR_APPEND_ELT (gnu_expr_vec, gnu_index,