This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Housekeeping work in gigi (bis)
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Mon, 18 Jan 2016 12:28:17 +0100
- Subject: [Ada] Housekeeping work in gigi (bis)
- Authentication-results: sourceware.org; auth=none
In preparation for the implementation of the 'char' compatibility fix.
Tested on x86_64-suse-linux, applied on the mainline.
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.
--
Eric Botcazou
Index: gcc-interface/cuintp.c
===================================================================
--- gcc-interface/cuintp.c (revision 232465)
+++ gcc-interface/cuintp.c (working copy)
@@ -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
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,
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 232501)
+++ gcc-interface/decl.c (working copy)
@@ -1716,7 +1716,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
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_entit
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_entit
/* 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_entit
{
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));
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h (revision 232465)
+++ gcc-interface/gigi.h (working copy)
@@ -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_
/* 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, N
/* 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 t
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);
+}
Index: gcc-interface/misc.c
===================================================================
--- gcc-interface/misc.c (revision 232501)
+++ gcc-interface/misc.c (working copy)
@@ -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);
}
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 232501)
+++ gcc-interface/trans.c (working copy)
@@ -1555,12 +1555,12 @@ get_type_length (tree type, tree result_
build_binary_op (MINUS_EXPR, comp_type,
convert (comp_type, hb),
convert (comp_type, lb)),
- convert (comp_type, integer_one_node));
+ build_int_cst (comp_type, 1));
length
= build_cond_expr (result_type,
build_binary_op (GE_EXPR, boolean_type_node, hb, lb),
convert (result_type, length),
- convert (result_type, integer_zero_node));
+ build_int_cst (result_type, 0));
return length;
}
@@ -1637,7 +1637,7 @@ Attribute_to_gnu (Node_Id gnat_node, tre
gnu_result
= build_binary_op (attribute == Attr_Pred ? MINUS_EXPR : PLUS_EXPR,
gnu_result_type, gnu_expr,
- convert (gnu_result_type, integer_one_node));
+ build_int_cst (gnu_result_type, 1));
break;
case Attr_Address:
@@ -2508,22 +2508,6 @@ Case_Statement_to_gnu (Node_Id gnat_node
gnu_expr = gnat_to_gnu (Expression (gnat_node));
gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
- /* The range of values in a case statement is determined by the rules in
- RM 5.4(7-9). In almost all cases, this range is represented by the Etype
- of the expression. One exception arises in the case of a simple name that
- is parenthesized. This still has the Etype of the name, but since it is
- not a name, para 7 does not apply, and we need to go to the base type.
- This is the only case where parenthesization affects the dynamic
- semantics (i.e. the range of possible values at run time that is covered
- by the others alternative).
-
- Another exception is if the subtype of the expression is non-static. In
- that case, we also have to use the base type. */
- if (Paren_Count (Expression (gnat_node)) != 0
- || !Is_OK_Static_Subtype (Underlying_Type
- (Etype (Expression (gnat_node)))))
- gnu_expr = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
-
/* We build a SWITCH_EXPR that contains the code with interspersed
CASE_LABEL_EXPRs for each label. */
if (!Sloc_to_locus (End_Location (gnat_node), &end_locus))
@@ -2894,7 +2878,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node
Entity_Id gnat_type = Etype (gnat_loop_var);
tree gnu_type = get_unpadded_type (gnat_type);
tree gnu_base_type = get_base_type (gnu_type);
- tree gnu_one_node = convert (gnu_base_type, integer_one_node);
+ tree gnu_one_node = build_int_cst (gnu_base_type, 1);
tree gnu_loop_var, gnu_loop_iv, gnu_first, gnu_last, gnu_stmt;
enum tree_code update_code, test_code, shift_code;
bool reverse = Reverse_Present (gnat_loop_spec), use_iv = false;
@@ -2990,7 +2974,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node
gnu_first = convert (gnu_base_type, gnu_first);
gnu_last = convert (gnu_base_type, gnu_last);
- gnu_one_node = convert (gnu_base_type, integer_one_node);
+ gnu_one_node = build_int_cst (gnu_base_type, 1);
use_iv = true;
}
@@ -4682,12 +4666,14 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
&& (gnu_size = TYPE_SIZE (TREE_TYPE (gnu_actual)))
&& TREE_CODE (gnu_size) == INTEGER_CST
&& compare_tree_int (gnu_size, BITS_PER_WORD) <= 0)
- gnu_actual
- = unchecked_convert (DECL_ARG_TYPE (gnu_formal),
- convert (gnat_type_for_size
- (TREE_INT_CST_LOW (gnu_size), 1),
- integer_zero_node),
- false);
+ {
+ tree type_for_size
+ = gnat_type_for_size (TREE_INT_CST_LOW (gnu_size), 1);
+ gnu_actual
+ = unchecked_convert (DECL_ARG_TYPE (gnu_formal),
+ build_int_cst (type_for_size, 0),
+ false);
+ }
else
gnu_actual = convert (DECL_ARG_TYPE (gnu_formal), gnu_actual);
}
@@ -5497,10 +5483,9 @@ build_noreturn_cond (tree cond)
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
- branch to for the exception. */
+/* Subroutine of gnat_to_gnu to translate GNAT_NODE, an N_Raise_xxx_Error,
+ to a GCC tree and return it. GNU_RESULT_TYPE_P is a pointer to where
+ we should place the result type. */
static tree
Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
@@ -5514,13 +5499,13 @@ Raise_Error_to_gnu (Node_Id gnat_node, t
&& !get_exception_label (kind);
tree gnu_result = NULL_TREE, gnu_cond = NULL_TREE;
- *gnu_result_type_p = get_unpadded_type (Etype (gnat_node));
-
+ /* The following processing is not required for correctness. Its purpose is
+ to give more precise error messages and to record some information. */
switch (reason)
{
case CE_Access_Check_Failed:
if (with_extra_info)
- gnu_result = build_call_raise_column (reason, gnat_node);
+ gnu_result = build_call_raise_column (reason, gnat_node, kind);
break;
case CE_Index_Check_Failed:
@@ -5566,7 +5551,7 @@ Raise_Error_to_gnu (Node_Id gnat_node, t
&& Known_Esize (gnat_type)
&& UI_To_Int (Esize (gnat_type)) <= 32)
gnu_result
- = build_call_raise_range (reason, gnat_node, gnu_index,
+ = build_call_raise_range (reason, gnat_node, kind, gnu_index,
gnu_low_bound, gnu_high_bound);
/* If optimization is enabled and we are inside a loop, we try to
@@ -5636,11 +5621,14 @@ Raise_Error_to_gnu (Node_Id gnat_node, t
break;
}
+ /* The following processing does the common work. */
common:
if (!gnu_result)
gnu_result = build_call_raise (reason, gnat_node, kind);
set_expr_location_from_node (gnu_result, gnat_node);
+ *gnu_result_type_p = get_unpadded_type (Etype (gnat_node));
+
/* If the type is VOID, this is a statement, so we need to generate the code
for the call. Handle a condition, if there is one. */
if (VOID_TYPE_P (*gnu_result_type_p))
@@ -5864,8 +5852,8 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = DECL_INITIAL (get_gnu_tree (Entity (gnat_node)));
else
gnu_result
- = build_int_cst_type
- (gnu_result_type, UI_To_CC (Char_Literal_Value (gnat_node)));
+ = build_int_cst (gnu_result_type,
+ UI_To_CC (Char_Literal_Value (gnat_node)));
break;
case N_Real_Literal:
@@ -5893,7 +5881,7 @@ gnat_to_gnu (Node_Id gnat_node)
ur_realval, Round_Even, gnat_node);
if (UR_Is_Zero (ur_realval))
- gnu_result = convert (gnu_result_type, integer_zero_node);
+ gnu_result = build_real (gnu_result_type, dconst0);
else
{
REAL_VALUE_TYPE tmp;
@@ -6609,7 +6597,9 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result_type, gnu_lhs, gnu_rhs);
break;
- case N_Op_Or: case N_Op_And: case N_Op_Xor:
+ case N_Op_And:
+ case N_Op_Or:
+ case N_Op_Xor:
/* These can either be operations on booleans or on modular types.
Fall through for boolean types since that's the way GNU_CODES is
set up. */
@@ -6630,16 +6620,24 @@ gnat_to_gnu (Node_Id gnat_node)
/* ... fall through ... */
- case N_Op_Eq: case N_Op_Ne: case N_Op_Lt:
- case N_Op_Le: case N_Op_Gt: case N_Op_Ge:
- case N_Op_Add: case N_Op_Subtract: case N_Op_Multiply:
- case N_Op_Mod: case N_Op_Rem:
+ case N_Op_Eq:
+ case N_Op_Ne:
+ case N_Op_Lt:
+ case N_Op_Le:
+ case N_Op_Gt:
+ case N_Op_Ge:
+ case N_Op_Add:
+ case N_Op_Subtract:
+ case N_Op_Multiply:
+ case N_Op_Mod:
+ case N_Op_Rem:
case N_Op_Rotate_Left:
case N_Op_Rotate_Right:
case N_Op_Shift_Left:
case N_Op_Shift_Right:
case N_Op_Shift_Right_Arithmetic:
- case N_And_Then: case N_Or_Else:
+ case N_And_Then:
+ case N_Or_Else:
{
enum tree_code code = gnu_codes[kind];
bool ignore_lhs_overflow = false;
@@ -6682,8 +6680,7 @@ gnat_to_gnu (Node_Id gnat_node)
build_binary_op (MINUS_EXPR,
gnu_count_type,
gnu_max_shift,
- convert (gnu_count_type,
- integer_one_node)),
+ build_int_cst (gnu_count_type, 1)),
gnu_rhs);
}
@@ -6693,13 +6690,13 @@ gnat_to_gnu (Node_Id gnat_node)
the way down and causes a CE to be explicitly raised. */
if (kind == N_Op_Shift_Right && !TYPE_UNSIGNED (gnu_type))
{
- gnu_type = gnat_unsigned_type (gnu_type);
+ gnu_type = gnat_unsigned_type_for (gnu_type);
ignore_lhs_overflow = true;
}
else if (kind == N_Op_Shift_Right_Arithmetic
&& TYPE_UNSIGNED (gnu_type))
{
- gnu_type = gnat_signed_type (gnu_type);
+ gnu_type = gnat_signed_type_for (gnu_type);
ignore_lhs_overflow = true;
}
@@ -6715,13 +6712,12 @@ gnat_to_gnu (Node_Id gnat_node)
/* Instead of expanding overflow checks for addition, subtraction
and multiplication itself, the front end will leave this to
the back end when Backend_Overflow_Checks_On_Target is set.
- As the GCC back end itself does not know yet how to properly
+ As the back end itself does not know yet how to properly
do overflow checking, do it here. The goal is to push
the expansions further into the back end over time. */
- if (Do_Overflow_Check (gnat_node) && Backend_Overflow_Checks_On_Target
- && (kind == N_Op_Add
- || kind == N_Op_Subtract
- || kind == N_Op_Multiply)
+ if (Do_Overflow_Check (gnat_node)
+ && Backend_Overflow_Checks_On_Target
+ && (code == PLUS_EXPR || code == MINUS_EXPR || code == MULT_EXPR)
&& !TYPE_UNSIGNED (gnu_type)
&& !FLOAT_TYPE_P (gnu_type))
gnu_result = build_binary_op_trapv (code, gnu_type,
@@ -6746,7 +6742,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_rhs,
convert (TREE_TYPE (gnu_rhs),
TYPE_SIZE (gnu_type))),
- convert (gnu_type, integer_zero_node),
+ build_int_cst (gnu_type, 0),
gnu_result);
}
break;
@@ -6784,7 +6780,8 @@ gnat_to_gnu (Node_Id gnat_node)
/* ... fall through ... */
- case N_Op_Minus: case N_Op_Abs:
+ case N_Op_Minus:
+ case N_Op_Abs:
gnu_expr = gnat_to_gnu (Right_Opnd (gnat_node));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
@@ -7382,7 +7379,7 @@ gnat_to_gnu (Node_Id gnat_node)
true, true, NULL, gnat_node);
add_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_incoming_exc_ptr,
- convert (ptr_type_node, integer_zero_node)));
+ build_int_cst (ptr_type_node, 0)));
add_stmt (build_call_n_expr (reraise_zcx_decl, 1, gnu_expr));
gnat_poplevel ();
gnu_result = end_stmt_group ();
@@ -8861,7 +8858,7 @@ build_binary_op_trapv (enum tree_code co
tree rhs = gnat_protect_expr (right);
tree type_max = TYPE_MAX_VALUE (gnu_type);
tree type_min = TYPE_MIN_VALUE (gnu_type);
- tree zero = convert (gnu_type, integer_zero_node);
+ tree zero = build_int_cst (gnu_type, 0);
tree gnu_expr, rhs_lt_zero, tmp1, tmp2;
tree check_pos, check_neg, check;
@@ -9151,7 +9148,9 @@ emit_check (tree gnu_cond, tree gnu_expr
return
fold_build3 (COND_EXPR, TREE_TYPE (gnu_expr), gnu_cond,
build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_call,
- convert (TREE_TYPE (gnu_expr), integer_zero_node)),
+ SCALAR_FLOAT_TYPE_P (TREE_TYPE (gnu_expr))
+ ? build_real (TREE_TYPE (gnu_expr), dconst0)
+ : build_int_cst (TREE_TYPE (gnu_expr), 0)),
gnu_expr);
}
@@ -9207,17 +9206,21 @@ convert_with_check (Entity_Id gnat_type,
comparing them properly. Likewise, convert the upper bounds
to unsigned types. */
if (INTEGRAL_TYPE_P (gnu_in_basetype) && TYPE_UNSIGNED (gnu_in_basetype))
- gnu_in_lb = convert (gnat_signed_type (gnu_in_basetype), gnu_in_lb);
+ gnu_in_lb
+ = convert (gnat_signed_type_for (gnu_in_basetype), gnu_in_lb);
if (INTEGRAL_TYPE_P (gnu_in_basetype)
&& !TYPE_UNSIGNED (gnu_in_basetype))
- gnu_in_ub = convert (gnat_unsigned_type (gnu_in_basetype), gnu_in_ub);
+ gnu_in_ub
+ = convert (gnat_unsigned_type_for (gnu_in_basetype), gnu_in_ub);
if (INTEGRAL_TYPE_P (gnu_base_type) && TYPE_UNSIGNED (gnu_base_type))
- gnu_out_lb = convert (gnat_signed_type (gnu_base_type), gnu_out_lb);
+ gnu_out_lb
+ = convert (gnat_signed_type_for (gnu_base_type), gnu_out_lb);
if (INTEGRAL_TYPE_P (gnu_base_type) && !TYPE_UNSIGNED (gnu_base_type))
- gnu_out_ub = convert (gnat_unsigned_type (gnu_base_type), gnu_out_ub);
+ gnu_out_ub
+ = convert (gnat_unsigned_type_for (gnu_base_type), gnu_out_ub);
/* Check each bound separately and only if the result bound
is tighter than the bound on the input type. Note that all the
@@ -9301,7 +9304,7 @@ convert_with_check (Entity_Id gnat_type,
to be scheduled in parallel with retrieval of the constant and
conversion of the input to the calc_type (if necessary). */
- gnu_zero = convert (gnu_in_basetype, integer_zero_node);
+ gnu_zero = build_real (gnu_in_basetype, dconst0);
gnu_result = gnat_protect_expr (gnu_result);
gnu_conv = convert (calc_type, gnu_result);
gnu_comp
@@ -10122,9 +10125,6 @@ get_elaboration_procedure (void)
static void
init_code_table (void)
{
- gnu_codes[N_And_Then] = TRUTH_ANDIF_EXPR;
- gnu_codes[N_Or_Else] = TRUTH_ORIF_EXPR;
-
gnu_codes[N_Op_And] = TRUTH_AND_EXPR;
gnu_codes[N_Op_Or] = TRUTH_OR_EXPR;
gnu_codes[N_Op_Xor] = TRUTH_XOR_EXPR;
@@ -10147,6 +10147,8 @@ init_code_table (void)
gnu_codes[N_Op_Shift_Left] = LSHIFT_EXPR;
gnu_codes[N_Op_Shift_Right] = RSHIFT_EXPR;
gnu_codes[N_Op_Shift_Right_Arithmetic] = RSHIFT_EXPR;
+ gnu_codes[N_And_Then] = TRUTH_ANDIF_EXPR;
+ gnu_codes[N_Or_Else] = TRUTH_ORIF_EXPR;
}
#include "gt-ada-trans.h"
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 232501)
+++ gcc-interface/utils.c (working copy)
@@ -3354,35 +3354,13 @@ gnat_type_for_mode (machine_mode mode, i
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,
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,
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,
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 un
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 ();
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c (revision 232501)
+++ gcc-interface/utils2.c (working copy)
@@ -592,7 +592,7 @@ nonbinary_modular_operation (enum tree_c
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,
{
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,
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,
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_
/* 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_
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_I
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