gigi.h (build_call_raise_column): Adjust prototype.

	* gcc-interface/gigi.h (build_call_raise_column): Adjust prototype.
	(build_call_raise_range): Likewise.
	(gnat_unsigned_type): Delete.
	(gnat_signed_type): Likewise.
	(gnat_signed_or_unsigned_type_for): New prototype.
	(gnat_unsigned_type_for): New inline function.
	(gnat_signed_type_for): Likewise.
	* gcc-interface/cuintp.c (build_cst_from_int): Call build_int_cst.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Likewise.
	(gnat_to_gnu_entity) <E_Array_Type>: Always translate the index types
	and compute their base type from that.
	<E_Array_Subtype>: Remove duplicate declaration.
	* gcc-interface/misc.c (get_array_bit_stride): Call build_int_cst.
	* gcc-interface/trans.c (get_type_length): Likewise.
	(Attribute_to_gnu): Likewise.
	(Loop_Statement_to_gnu): Likewise.
	(Call_to_gnu): Likewise.
	(gnat_to_gnu): Call build_real, build_int_cst, gnat_unsigned_type_for
	and gnat_signed_type_for.  Minor tweaks.
	(build_binary_op_trapv): Likewise.
	(emit_check): Likewise.
	(convert_with_check): Likewise.
	(Raise_Error_to_gnu): Adjust calls to the build_call_raise family of
	functions.  Minor tweaks.
	(Case_Statement_to_gnu): Remove dead code.
	(gnat_to_gnu): Call gnat_unsigned_type_for and gnat_signed_type_for.
	(init_code_table): Minor reordering.
	* gcc-interface/utils.c (gnat_unsigned_type): Delete.
	(gnat_signed_type): Likewise.
	(gnat_signed_or_unsigned_type_for): New function.
	(unchecked_convert): Use directly the size in the test for precision
	vs size adjustments.
	(install_builtin_elementary_types): Call gnat_signed_type_for.
	* gcc-interface/utils2.c (nonbinary_modular_operation): Call
	build_int_cst.
	(build_goto_raise): New function taken from...
	(build_call_raise): ...here.  Call it.
	(build_call_raise_column): Add KIND parameter and call it.
	(build_call_raise_range): Likewise.

From-SVN: r232503

gcc/ada/ChangeLog

 2016-01-18  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/gigi.h (build_call_raise_column): Adjust prototype.
+	(build_call_raise_range): Likewise.
+	(gnat_unsigned_type): Delete.
+	(gnat_signed_type): Likewise.
+	(gnat_signed_or_unsigned_type_for): New prototype.
+	(gnat_unsigned_type_for): New inline function.
+	(gnat_signed_type_for): Likewise.
+	* gcc-interface/cuintp.c (build_cst_from_int): Call build_int_cst.
+	* gcc-interface/decl.c (gnat_to_gnu_entity): Likewise.
+	(gnat_to_gnu_entity) <E_Array_Type>: Always translate the index types
+	and compute their base type from that.
+	<E_Array_Subtype>: Remove duplicate declaration.
+	* gcc-interface/misc.c (get_array_bit_stride): Call build_int_cst.
+	* gcc-interface/trans.c (get_type_length): Likewise.
+	(Attribute_to_gnu): Likewise.
+	(Loop_Statement_to_gnu): Likewise.
+	(Call_to_gnu): Likewise.
+	(gnat_to_gnu): Call build_real, build_int_cst, gnat_unsigned_type_for
+	and gnat_signed_type_for.  Minor tweaks.
+	(build_binary_op_trapv): Likewise.
+	(emit_check): Likewise.
+	(convert_with_check): Likewise.
+	(Raise_Error_to_gnu): Adjust calls to the build_call_raise family of
+	functions.  Minor tweaks.
+	(Case_Statement_to_gnu): Remove dead code.
+	(gnat_to_gnu): Call gnat_unsigned_type_for and gnat_signed_type_for.
+	(init_code_table): Minor reordering.
+	* gcc-interface/utils.c (gnat_unsigned_type): Delete.
+	(gnat_signed_type): Likewise.
+	(gnat_signed_or_unsigned_type_for): New function.
+	(unchecked_convert): Use directly the size in the test for precision
+	vs size adjustments.
+	(install_builtin_elementary_types): Call gnat_signed_type_for.
+	* gcc-interface/utils2.c (nonbinary_modular_operation): Call
+	build_int_cst.
+	(build_goto_raise): New function taken from...
+	(build_call_raise): ...here.  Call it.
+	(build_call_raise_column): Add KIND parameter and call it.
+	(build_call_raise_range): Likewise.
+
+2016-01-18  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/ada-tree.h (TYPE_IMPLEMENTS_PACKED_ARRAY_P): Rename to
 	(TYPE_IMPL_PACKED_ARRAY_P): ...this.
 	(TYPE_CAN_HAVE_DEBUG_TYPE_P): Do not test TYPE_DEBUG_TYPE.

gcc/ada/gcc-interface/cuintp.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2015, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2016, 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- *
@@ -52,8 +52,8 @@
    the integer value itself.  The origin of the Uints_Ptr table is adjusted so
    that a Uint value of Uint_Bias indexes the first element.
 
-   First define a utility function that operates like build_int_cst_type for
-   integral types and does a conversion for floating-point types.  */
+   First define a utility function that is build_int_cst for integral types and
+   does a conversion for floating-point types.  */
 
 static tree
 build_cst_from_int (tree type, HOST_WIDE_INT low)
@@ -61,7 +61,7 @@ build_cst_from_int (tree type, HOST_WIDE_INT low)
   if (SCALAR_FLOAT_TYPE_P (type))
     return convert (type, build_int_cst (gnat_type_for_size (32, 0), low));
   else
-    return build_int_cst_type (type, low);
+    return build_int_cst (type, low);
 }
 
 /* Similar to UI_To_Int, but return a GCC INTEGER_CST or REAL_CST node,

gcc/ada/gcc-interface/decl.c

@@ -1716,7 +1716,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    TYPE_MODULAR_P (gnu_type) = 1;
 	    SET_TYPE_MODULUS (gnu_type, gnu_modulus);
 	    gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
-				    convert (gnu_type, integer_one_node));
+				    build_int_cst (gnu_type, 1));
 	  }
 
 	/* If the upper bound is not maximal, make an extra subtype.  */
@@ -2113,8 +2113,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	     gnat_index = Next_Index (gnat_index))
 	  {
 	    char field_name[16];
-	    tree gnu_index_base_type
-	      = get_unpadded_type (Base_Type (Etype (gnat_index)));
+	    tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
+	    tree gnu_index_base_type = get_base_type (gnu_index_type);
 	    tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max;
 	    tree gnu_min, gnu_max, gnu_high;
 
@@ -2173,7 +2173,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    /* Update the maximum size of the array in elements.  */
 	    if (gnu_max_size)
 	      {
-		tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
 		tree gnu_min
 		  = convert (sizetype, TYPE_MIN_VALUE (gnu_index_type));
 		tree gnu_max
@@ -2495,8 +2494,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		{
 		  tree gnu_base_min = convert (sizetype, gnu_base_orig_min);
 		  tree gnu_base_max = convert (sizetype, gnu_base_orig_max);
-		  tree gnu_base_index_base_type
-		    = get_base_type (gnu_base_index_type);
 		  tree gnu_base_base_min
 		    = convert (sizetype,
 			       TYPE_MIN_VALUE (gnu_base_index_base_type));

gcc/ada/gcc-interface/gigi.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2015, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2016, 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- *
@@ -538,11 +538,9 @@ extern tree gnat_type_for_mode (machine_mode mode, int unsignedp);
 /* Perform final processing on global declarations.  */
 extern void gnat_write_global_declarations (void);
 
-/* Return the unsigned version of a TYPE_NODE, a scalar type.  */
-extern tree gnat_unsigned_type (tree type_node);
-
-/* Return the signed version of a TYPE_NODE, a scalar type.  */
-extern tree gnat_signed_type (tree type_node);
+/* Return the signed or unsigned version of TYPE_NODE, a scalar type, the
+   signedness being specified by UNSIGNEDP.  */
+extern tree gnat_signed_or_unsigned_type_for (int unsignedp, tree type_node);
 
 /* Return 1 if the types T1 and T2 are compatible, i.e. if they can be
    transparently converted to each other.  */
@@ -898,11 +896,11 @@ extern tree build_call_raise (int msg, Node_Id gnat_node, char kind);
 
 /* Similar to build_call_raise, with extra information about the column
    where the check failed.  */
-extern tree build_call_raise_column (int msg, Node_Id gnat_node);
+extern tree build_call_raise_column (int msg, Node_Id gnat_node, char kind);
 
 /* Similar to build_call_raise_column, for an index or range check exception ,
    with extra information of the form "INDEX out of range FIRST..LAST".  */
-extern tree build_call_raise_range (int msg, Node_Id gnat_node,
+extern tree build_call_raise_range (int msg, Node_Id gnat_node, char kind,
 				    tree index, tree first, tree last);
 
 /* Return a CONSTRUCTOR of TYPE whose elements are V.  This is not the
@@ -1120,3 +1118,19 @@ return_type_with_variable_size_p (tree type)
 
   return false;
 }
+
+/* Return the unsigned version of TYPE_NODE, a scalar type.  */
+
+static inline tree
+gnat_unsigned_type_for (tree type_node)
+{
+  return gnat_signed_or_unsigned_type_for (1, type_node);
+}
+
+/* Return the signed version of TYPE_NODE, a scalar type.  */
+
+static inline tree
+gnat_signed_type_for (tree type_node)
+{
+  return gnat_signed_or_unsigned_type_for (0, type_node);
+}

gcc/ada/gcc-interface/misc.c

@@ -1035,7 +1035,7 @@ get_array_bit_stride (tree comp_type)
     {
       stride = fold_convert (bitsizetype, stride);
       stride = build_binary_op (MULT_EXPR, bitsizetype,
-				stride, build_int_cstu (bitsizetype, 8));
+				stride, build_int_cst (bitsizetype, 8));
     }
 
   for (int i = 0; i < info.ndimensions; ++i)
@@ -1053,10 +1053,10 @@ get_array_bit_stride (tree comp_type)
 			       fold_convert (sbitsizetype,
 					     info.dimen[i].lower_bound)),
       count = build_binary_op (PLUS_EXPR, sbitsizetype,
-			       count, build_int_cstu (sbitsizetype, 1));
+			       count, build_int_cst (sbitsizetype, 1));
       count = build_binary_op (MAX_EXPR, sbitsizetype,
 			       count,
-			       build_int_cstu (sbitsizetype, 0));
+			       build_int_cst (sbitsizetype, 0));
       count = fold_convert (bitsizetype, count);
       stride = build_binary_op (MULT_EXPR, bitsizetype, stride, count);
     }

gcc/ada/gcc-interface/utils.c

@@ -3354,35 +3354,13 @@ gnat_type_for_mode (machine_mode mode, int unsignedp)
   return NULL_TREE;
 }
 
-/* Return the unsigned version of a TYPE_NODE, a scalar type.  */
+/* Return the signed or unsigned version of TYPE_NODE, a scalar type, the
+   signedness being specified by UNSIGNEDP.  */
 
 tree
-gnat_unsigned_type (tree type_node)
+gnat_signed_or_unsigned_type_for (int unsignedp, tree type_node)
 {
-  tree type = gnat_type_for_size (TYPE_PRECISION (type_node), 1);
-
-  if (TREE_CODE (type_node) == INTEGER_TYPE && TYPE_MODULAR_P (type_node))
-    {
-      type = copy_node (type);
-      TREE_TYPE (type) = type_node;
-    }
-  else if (TREE_TYPE (type_node)
-	   && TREE_CODE (TREE_TYPE (type_node)) == INTEGER_TYPE
-	   && TYPE_MODULAR_P (TREE_TYPE (type_node)))
-    {
-      type = copy_node (type);
-      TREE_TYPE (type) = TREE_TYPE (type_node);
-    }
-
-  return type;
-}
-
-/* Return the signed version of a TYPE_NODE, a scalar type.  */
-
-tree
-gnat_signed_type (tree type_node)
-{
-  tree type = gnat_type_for_size (TYPE_PRECISION (type_node), 0);
+  tree type = gnat_type_for_size (TYPE_PRECISION (type_node), unsignedp);
 
   if (TREE_CODE (type_node) == INTEGER_TYPE && TYPE_MODULAR_P (type_node))
     {
@@ -4936,8 +4914,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      are no considerations of precision or size involved.  */
   else if (INTEGRAL_TYPE_P (type)
 	   && TYPE_RM_SIZE (type)
-	   && (0 != compare_tree_int (TYPE_RM_SIZE (type),
-				      GET_MODE_BITSIZE (TYPE_MODE (type)))
+	   && (tree_int_cst_compare (TYPE_RM_SIZE (type),
+				     TYPE_SIZE (type)) < 0
 	       || (AGGREGATE_TYPE_P (etype)
 		   && TYPE_REVERSE_STORAGE_ORDER (etype))))
     {
@@ -4973,8 +4951,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      type with reverse storage order and we also proceed similarly.  */
   else if (INTEGRAL_TYPE_P (etype)
 	   && TYPE_RM_SIZE (etype)
-	   && (0 != compare_tree_int (TYPE_RM_SIZE (etype),
-				      GET_MODE_BITSIZE (TYPE_MODE (etype)))
+	   && (tree_int_cst_compare (TYPE_RM_SIZE (etype),
+				     TYPE_SIZE (etype)) < 0
 	       || (AGGREGATE_TYPE_P (type)
 		   && TYPE_REVERSE_STORAGE_ORDER (type))))
     {
@@ -5094,26 +5072,25 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      is an integral type of the same precision and signedness or if the output
      is a biased type or if both the input and output are unsigned.  */
   if (!notrunc_p
-      && INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type)
-      && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
-      && 0 != compare_tree_int (TYPE_RM_SIZE (type),
-				GET_MODE_BITSIZE (TYPE_MODE (type)))
+      && INTEGRAL_TYPE_P (type)
+      && TYPE_RM_SIZE (type)
+      && tree_int_cst_compare (TYPE_RM_SIZE (type), TYPE_SIZE (type)) < 0
       && !(INTEGRAL_TYPE_P (etype)
 	   && TYPE_UNSIGNED (type) == TYPE_UNSIGNED (etype)
-	   && operand_equal_p (TYPE_RM_SIZE (type),
-			       (TYPE_RM_SIZE (etype) != 0
-				? TYPE_RM_SIZE (etype) : TYPE_SIZE (etype)),
-			       0))
+	   && tree_int_cst_compare (TYPE_RM_SIZE (type),
+				    TYPE_RM_SIZE (etype)
+				    ? TYPE_RM_SIZE (etype)
+				    : TYPE_SIZE (etype)) == 0)
+      && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
       && !(TYPE_UNSIGNED (type) && TYPE_UNSIGNED (etype)))
     {
       tree base_type
-	= gnat_type_for_mode (TYPE_MODE (type), TYPE_UNSIGNED (type));
+	= gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (type)),
+			      TYPE_UNSIGNED (type));
       tree shift_expr
 	= convert (base_type,
 		   size_binop (MINUS_EXPR,
-			       bitsize_int
-			       (GET_MODE_BITSIZE (TYPE_MODE (type))),
-			       TYPE_RM_SIZE (type)));
+			       TYPE_SIZE (type), TYPE_RM_SIZE (type)));
       expr
 	= convert (type,
 		   build_binary_op (RSHIFT_EXPR, base_type,
@@ -5434,7 +5411,7 @@ builtin_type_for_size (int size, bool unsignedp)
 static void
 install_builtin_elementary_types (void)
 {
-  signed_size_type_node = gnat_signed_type (size_type_node);
+  signed_size_type_node = gnat_signed_type_for (size_type_node);
   pid_type_node = integer_type_node;
   void_list_node = build_void_list_node ();
 

gcc/ada/gcc-interface/utils2.c

@@ -592,7 +592,7 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
       result = gnat_protect_expr (result);
       result = fold_build3 (COND_EXPR, op_type,
 			    fold_build2 (LT_EXPR, boolean_type_node, result,
-					 convert (op_type, integer_zero_node)),
+					 build_int_cst (op_type, 0)),
 			    fold_build2 (PLUS_EXPR, op_type, result, modulus),
 			    result);
     }
@@ -1601,8 +1601,8 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
 	      {
 		if (integer_pow2p (fold_build2 (PLUS_EXPR, operation_type,
 						modulus,
-						convert (operation_type,
-							 integer_one_node))))
+						build_int_cst (operation_type,
+							       1))))
 		  result = fold_build2 (BIT_XOR_EXPR, operation_type,
 					operand, modulus);
 		else
@@ -1613,9 +1613,8 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
 				      fold_build2 (NE_EXPR,
 						   boolean_type_node,
 						   operand,
-						   convert
-						     (operation_type,
-						      integer_zero_node)),
+						   build_int_cst
+						   (operation_type, 0)),
 				      result, operand);
 	      }
 	    else
@@ -1626,8 +1625,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
 		   that constant for nonbinary modulus.  */
 
 		tree cnst = fold_build2 (MINUS_EXPR, operation_type, modulus,
-					 convert (operation_type,
-						  integer_one_node));
+					 build_int_cst (operation_type, 1));
 
 		if (mod_pow2)
 		  result = fold_build2 (BIT_XOR_EXPR, operation_type,
@@ -1748,6 +1746,32 @@ build_call_n_expr (tree fndecl, int n, ...)
   return fn;
 }
 
+/* Build a goto to LABEL for a raise, with an optional call to Local_Raise.
+   MSG gives the exception's identity for the call to Local_Raise, if any.  */
+
+static tree
+build_goto_raise (tree label, int msg)
+{
+  tree gnu_result = build1 (GOTO_EXPR, void_type_node, label);
+  Entity_Id local_raise = Get_Local_Raise_Call_Entity ();
+
+  /* If Local_Raise is present, build Local_Raise (Exception'Identity).  */
+  if (Present (local_raise))
+    {
+      tree gnu_local_raise = gnat_to_gnu_entity (local_raise, NULL_TREE, 0);
+      tree gnu_exception_entity
+	= gnat_to_gnu_entity (Get_RT_Exception_Entity (msg), NULL_TREE, 0);
+      tree gnu_call
+	= build_call_n_expr (gnu_local_raise, 1,
+			     build_unary_op (ADDR_EXPR, NULL_TREE,
+					     gnu_exception_entity));
+      gnu_result
+	= build2 (COMPOUND_EXPR, void_type_node, gnu_call, gnu_result);
+    }
+
+  return gnu_result;
+}
+
 /* Expand the SLOC of GNAT_NODE, if present, into tree location information
    pointed to by FILENAME, LINE and COL.  Fall back to the current location
    if GNAT_NODE is absent or has no SLOC.  */
@@ -1803,27 +1827,7 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
 
   /* If this is to be done as a goto, handle that case.  */
   if (label)
-    {
-      Entity_Id local_raise = Get_Local_Raise_Call_Entity ();
-      tree gnu_result = build1 (GOTO_EXPR, void_type_node, label);
-
-      /* If Local_Raise is present, build Local_Raise (Exception'Identity).  */
-      if (Present (local_raise))
-	{
-	  tree gnu_local_raise
-	    = gnat_to_gnu_entity (local_raise, NULL_TREE, 0);
-	  tree gnu_exception_entity
-	    = gnat_to_gnu_entity (Get_RT_Exception_Entity (msg), NULL_TREE, 0);
-	  tree gnu_call
-	    = build_call_n_expr (gnu_local_raise, 1,
-				 build_unary_op (ADDR_EXPR, NULL_TREE,
-						 gnu_exception_entity));
-	  gnu_result
-	    = build2 (COMPOUND_EXPR, void_type_node, gnu_call, gnu_result);
-	}
-
-      return gnu_result;
-    }
+    return build_goto_raise (label, msg);
 
   expand_sloc (gnat_node, &filename, &line, NULL);
 
@@ -1839,11 +1843,16 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
    where the check failed.  */
 
 tree
-build_call_raise_column (int msg, Node_Id gnat_node)
+build_call_raise_column (int msg, Node_Id gnat_node, char kind)
 {
   tree fndecl = gnat_raise_decls_ext[msg];
+  tree label = get_exception_label (kind);
   tree filename, line, col;
 
+  /* If this is to be done as a goto, handle that case.  */
+  if (label)
+    return build_goto_raise (label, msg);
+
   expand_sloc (gnat_node, &filename, &line, &col);
 
   return
@@ -1858,12 +1867,17 @@ build_call_raise_column (int msg, Node_Id gnat_node)
    with extra information of the form "INDEX out of range FIRST..LAST".  */
 
 tree
-build_call_raise_range (int msg, Node_Id gnat_node,
+build_call_raise_range (int msg, Node_Id gnat_node, char kind,
 			tree index, tree first, tree last)
 {
   tree fndecl = gnat_raise_decls_ext[msg];
+  tree label = get_exception_label (kind);
   tree filename, line, col;
 
+  /* If this is to be done as a goto, handle that case.  */
+  if (label)
+    return build_goto_raise (label, msg);
+
   expand_sloc (gnat_node, &filename, &line, &col);
 
   return