This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Housekeeping work in gigi (16/n)
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Thu, 24 Sep 2009 15:38:45 +0200
- Subject: [Ada] Housekeeping work in gigi (16/n)
Tested on i586-suse-linux, applied on the mainline.
2009-09-24 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/ada.h: Fix outdated comment.
* gcc-interface/ada-tree.h (SET_TYPE_RM_VALUE): Use MARK_VISITED in
lieu of mark_visited.
* gcc-interface/gigi.h (mark_visited): Change type of parameter.
(MARK_VISITED): New macro.
(gnat_truthvalue_conversion): Delete.
* gcc-interface/decl.c (gnat_to_gnu_entity): Use MARK_VISITED in
lieu of mark_visited.
(annotate_rep): Fix formatting and tidy.
(compute_field_positions): Get rid of useless variable.
* gcc-interface/trans.c (gnat_to_gnu): Retrieve the Nkind of the GNAT
node only once. Use IN operator for the Nkind in more cases.
Remove calls to gnat_truthvalue_conversion.
(mark_visited): Change type of parameter and adjust.
(mark_visited_r): Dereference TP only once.
(add_decl_expr): Use MARK_VISITED in lieu of mark_visited.
* gcc-interface/utils2.c (gnat_truthvalue_conversion): Delete.
(build_binary_op): Remove calls to gnat_truthvalue_conversion.
(build_unary_op): Likewise.
--
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 152067)
+++ gcc-interface/decl.c (working copy)
@@ -898,11 +898,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
if (stable)
{
- gnu_decl = maybe_stable_expr;
/* ??? No DECL_EXPR is created so we need to mark
the expression manually lest it is shared. */
if (global_bindings_p ())
- mark_visited (&gnu_decl);
+ MARK_VISITED (maybe_stable_expr);
+ gnu_decl = maybe_stable_expr;
save_gnu_tree (gnat_entity, gnu_decl, true);
saved = true;
annotate_object (gnat_entity, gnu_type, NULL_TREE,
@@ -2465,7 +2465,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
/* ??? create_type_decl is not invoked on the inner types so
the MULT_EXPR node built above will never be marked. */
- mark_visited (&TYPE_SIZE_UNIT (gnu_arr_type));
+ MARK_VISITED (TYPE_SIZE_UNIT (gnu_arr_type));
}
}
@@ -4631,7 +4631,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
the MULT_EXPR node built above may not be marked by the call
to create_type_decl below. */
if (global_bindings_p ())
- mark_visited (&DECL_FIELD_OFFSET (gnu_field));
+ MARK_VISITED (DECL_FIELD_OFFSET (gnu_field));
}
}
@@ -7271,78 +7271,76 @@ annotate_object (Entity_Id gnat_entity,
UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
}
-/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding
- GCC type, set Component_Bit_Offset and Esize to the position and size
- used by Gigi. */
+/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding GCC type,
+ set Component_Bit_Offset and Esize of the components to the position and
+ size used by Gigi. */
static void
annotate_rep (Entity_Id gnat_entity, tree gnu_type)
{
- tree gnu_list;
- tree gnu_entry;
Entity_Id gnat_field;
+ tree gnu_list;
- /* We operate by first making a list of all fields and their positions
- (we can get the sizes easily at any time) by a recursive call
- and then update all the sizes into the tree. */
- gnu_list = compute_field_positions (gnu_type, NULL_TREE,
- size_zero_node, bitsize_zero_node,
- BIGGEST_ALIGNMENT);
+ /* We operate by first making a list of all fields and their position (we
+ can get the size easily) and then update all the sizes in the tree. */
+ gnu_list = compute_field_positions (gnu_type, NULL_TREE, size_zero_node,
+ bitsize_zero_node, BIGGEST_ALIGNMENT);
- for (gnat_field = First_Entity (gnat_entity); Present (gnat_field);
+ for (gnat_field = First_Entity (gnat_entity);
+ Present (gnat_field);
gnat_field = Next_Entity (gnat_field))
- if ((Ekind (gnat_field) == E_Component
- || (Ekind (gnat_field) == E_Discriminant
- && !Is_Unchecked_Union (Scope (gnat_field)))))
+ if (Ekind (gnat_field) == E_Component
+ || (Ekind (gnat_field) == E_Discriminant
+ && !Is_Unchecked_Union (Scope (gnat_field))))
{
- tree parent_offset = bitsize_zero_node;
+ tree parent_offset, t;
- gnu_entry = purpose_member (gnat_to_gnu_field_decl (gnat_field),
- gnu_list);
-
- if (gnu_entry)
+ t = purpose_member (gnat_to_gnu_field_decl (gnat_field), gnu_list);
+ if (t)
{
if (type_annotate_only && Is_Tagged_Type (gnat_entity))
{
- /* In this mode the tag and parent components have not been
+ /* In this mode the tag and parent components are not
generated, so we add the appropriate offset to each
component. For a component appearing in the current
extension, the offset is the size of the parent. */
- if (Is_Derived_Type (gnat_entity)
- && Original_Record_Component (gnat_field) == gnat_field)
- parent_offset
- = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
- bitsizetype);
- else
- parent_offset = bitsize_int (POINTER_SIZE);
+ if (Is_Derived_Type (gnat_entity)
+ && Original_Record_Component (gnat_field) == gnat_field)
+ parent_offset
+ = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
+ bitsizetype);
+ else
+ parent_offset = bitsize_int (POINTER_SIZE);
}
+ else
+ parent_offset = bitsize_zero_node;
- Set_Component_Bit_Offset
- (gnat_field,
- annotate_value
- (size_binop (PLUS_EXPR,
- bit_from_pos (TREE_PURPOSE (TREE_VALUE (gnu_entry)),
- TREE_VALUE (TREE_VALUE
- (TREE_VALUE (gnu_entry)))),
- parent_offset)));
+ Set_Component_Bit_Offset
+ (gnat_field,
+ annotate_value
+ (size_binop (PLUS_EXPR,
+ bit_from_pos (TREE_PURPOSE (TREE_VALUE (t)),
+ TREE_VALUE (TREE_VALUE
+ (TREE_VALUE (t)))),
+ parent_offset)));
Set_Esize (gnat_field,
- annotate_value (DECL_SIZE (TREE_PURPOSE (gnu_entry))));
+ annotate_value (DECL_SIZE (TREE_PURPOSE (t))));
}
- else if (Is_Tagged_Type (gnat_entity)
- && Is_Derived_Type (gnat_entity))
+ else if (Is_Tagged_Type (gnat_entity) && Is_Derived_Type (gnat_entity))
{
- /* If there is no gnu_entry, this is an inherited component whose
+ /* If there is no entry, this is an inherited component whose
position is the same as in the parent type. */
Set_Component_Bit_Offset
(gnat_field,
Component_Bit_Offset (Original_Record_Component (gnat_field)));
+
Set_Esize (gnat_field,
Esize (Original_Record_Component (gnat_field)));
}
}
}
-
+
/* Scan all fields in GNU_TYPE and build entries where TREE_PURPOSE is the
FIELD_DECL and TREE_VALUE a TREE_LIST with TREE_PURPOSE being the byte
position and TREE_VALUE being a TREE_LIST with TREE_PURPOSE the value to be
@@ -7356,9 +7354,9 @@ compute_field_positions (tree gnu_type,
tree gnu_bitpos, unsigned int offset_align)
{
tree gnu_field;
- tree gnu_result = gnu_list;
- for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field;
+ for (gnu_field = TYPE_FIELDS (gnu_type);
+ gnu_field;
gnu_field = TREE_CHAIN (gnu_field))
{
tree gnu_our_bitpos = size_binop (PLUS_EXPR, gnu_bitpos,
@@ -7368,22 +7366,22 @@ compute_field_positions (tree gnu_type,
unsigned int our_offset_align
= MIN (offset_align, DECL_OFFSET_ALIGN (gnu_field));
- gnu_result
+ gnu_list
= tree_cons (gnu_field,
tree_cons (gnu_our_offset,
tree_cons (size_int (our_offset_align),
gnu_our_bitpos, NULL_TREE),
NULL_TREE),
- gnu_result);
+ gnu_list);
if (DECL_INTERNAL_P (gnu_field))
- gnu_result
- = compute_field_positions (TREE_TYPE (gnu_field), gnu_result,
+ gnu_list
+ = compute_field_positions (TREE_TYPE (gnu_field), gnu_list,
gnu_our_offset, gnu_our_bitpos,
our_offset_align);
}
- return gnu_result;
+ return gnu_list;
}
/* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c (revision 152067)
+++ gcc-interface/utils2.c (working copy)
@@ -55,63 +55,6 @@ static tree compare_arrays (tree, tree,
static tree nonbinary_modular_operation (enum tree_code, tree, tree, tree);
static tree build_simple_component_ref (tree, tree, tree, bool);
-/* Prepare expr to be an argument of a TRUTH_NOT_EXPR or other logical
- operation.
-
- This preparation consists of taking the ordinary representation of
- an expression expr and producing a valid tree boolean expression
- describing whether expr is nonzero. We could simply always do
-
- build_binary_op (NE_EXPR, expr, integer_zero_node, 1),
-
- but we optimize comparisons, &&, ||, and !.
-
- The resulting type should always be the same as the input type.
- This function is simpler than the corresponding C version since
- the only possible operands will be things of Boolean type. */
-
-tree
-gnat_truthvalue_conversion (tree expr)
-{
- tree type = TREE_TYPE (expr);
-
- switch (TREE_CODE (expr))
- {
- case EQ_EXPR: case NE_EXPR: case LE_EXPR: case GE_EXPR:
- case LT_EXPR: case GT_EXPR:
- case TRUTH_ANDIF_EXPR:
- case TRUTH_ORIF_EXPR:
- case TRUTH_AND_EXPR:
- case TRUTH_OR_EXPR:
- case TRUTH_XOR_EXPR:
- case ERROR_MARK:
- return expr;
-
- case INTEGER_CST:
- return (integer_zerop (expr)
- ? build_int_cst (type, 0)
- : build_int_cst (type, 1));
-
- case REAL_CST:
- return (real_zerop (expr)
- ? fold_convert (type, integer_zero_node)
- : fold_convert (type, integer_one_node));
-
- case COND_EXPR:
- /* Distribute the conversion into the arms of a COND_EXPR. */
- {
- tree arg1 = gnat_truthvalue_conversion (TREE_OPERAND (expr, 1));
- tree arg2 = gnat_truthvalue_conversion (TREE_OPERAND (expr, 2));
- return fold_build3 (COND_EXPR, type, TREE_OPERAND (expr, 0),
- arg1, arg2);
- }
-
- default:
- return build_binary_op (NE_EXPR, type, expr,
- fold_convert (type, integer_zero_node));
- }
-}
-
/* Return the base type of TYPE. */
tree
@@ -970,15 +913,6 @@ build_binary_op (enum tree_code op_code,
left_operand = convert (operation_type, left_operand);
break;
- case TRUTH_ANDIF_EXPR:
- case TRUTH_ORIF_EXPR:
- case TRUTH_AND_EXPR:
- case TRUTH_OR_EXPR:
- case TRUTH_XOR_EXPR:
- left_operand = gnat_truthvalue_conversion (left_operand);
- right_operand = gnat_truthvalue_conversion (right_operand);
- goto common;
-
case BIT_AND_EXPR:
case BIT_IOR_EXPR:
case BIT_XOR_EXPR:
@@ -1120,7 +1054,7 @@ build_unary_op (enum tree_code op_code,
case TRUTH_NOT_EXPR:
gcc_assert (result_type == base_type);
- result = invert_truthvalue (gnat_truthvalue_conversion (operand));
+ result = invert_truthvalue (operand);
break;
case ATTR_ADDR_EXPR:
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h (revision 152067)
+++ gcc-interface/gigi.h (working copy)
@@ -75,10 +75,19 @@ extern void set_block_for_group (tree);
Get SLOC from GNAT_ENTITY. */
extern void add_decl_expr (tree gnu_decl, Entity_Id gnat_entity);
-/* Mark nodes rooted at *TP with TREE_VISITED and types as having their
+/* Mark nodes rooted at T with TREE_VISITED and types as having their
sized gimplified. We use this to indicate all variable sizes and
positions in global types may not be shared by any subprogram. */
-extern void mark_visited (tree *tp);
+extern void mark_visited (tree t);
+
+/* This macro calls the above function but short-circuits the common
+ case of a constant to save time and also checks for NULL. */
+
+#define MARK_VISITED(EXP) \
+do { \
+ if((EXP) && !TREE_CONSTANT (EXP)) \
+ mark_visited (EXP); \
+} while (0)
/* Finalize any From_With_Type incomplete types. We do this after processing
our compilation unit and after processing its spec, if this is a body. */
@@ -767,20 +776,6 @@ extern bool is_double_scalar_or_array (E
component of an aggregate type. */
extern bool type_for_nonaliased_component_p (tree gnu_type);
-/* Prepare expr to be an argument of a TRUTH_NOT_EXPR or other logical
- operation.
-
- This preparation consists of taking the ordinary
- representation of an expression EXPR and producing a valid tree
- boolean expression describing whether EXPR is nonzero. We could
- simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1),
- but we optimize comparisons, &&, ||, and !.
-
- The resulting type should always be the same as the input type.
- This function is simpler than the corresponding C version since
- the only possible operands will be things of Boolean type. */
-extern tree gnat_truthvalue_conversion (tree expr);
-
/* Return the base type of TYPE. */
extern tree get_base_type (tree type);
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 152067)
+++ gcc-interface/trans.c (working copy)
@@ -3454,64 +3454,55 @@ unchecked_conversion_lhs_nop (Node_Id gn
return false;
}
-/* This function is the driver of the GNAT to GCC tree transformation
- process. It is the entry point of the tree transformer. GNAT_NODE is the
- root of some GNAT tree. Return the root of the corresponding GCC tree.
- If this is an expression, return the GCC equivalent of the expression. If
- it is a statement, return the statement. In the case when called for a
- statement, it may also add statements to the current statement group, in
- which case anything it returns is to be interpreted as occurring after
- anything `it already added. */
+/* This function is the driver of the GNAT to GCC tree transformation process.
+ It is the entry point of the tree transformer. GNAT_NODE is the root of
+ some GNAT tree. Return the root of the corresponding GCC tree. If this
+ is an expression, return the GCC equivalent of the expression. If this
+ is a statement, return the statement or add it to the current statement
+ group, in which case anything returned is to be interpreted as occurring
+ after anything added. */
tree
gnat_to_gnu (Node_Id gnat_node)
{
+ const Node_Kind kind = Nkind (gnat_node);
bool went_into_elab_proc = false;
tree gnu_result = error_mark_node; /* Default to no value. */
tree gnu_result_type = void_type_node;
- tree gnu_expr;
- tree gnu_lhs, gnu_rhs;
+ tree gnu_expr, gnu_lhs, gnu_rhs;
Node_Id gnat_temp;
/* Save node number for error message and set location information. */
error_gnat_node = gnat_node;
Sloc_to_locus (Sloc (gnat_node), &input_location);
- if (type_annotate_only
- && IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call))
+ /* If this node is a statement and we are only annotating types, return an
+ empty statement list. */
+ if (type_annotate_only && IN (kind, N_Statement_Other_Than_Procedure_Call))
return alloc_stmt_list ();
- /* If this node is a non-static subexpression and we are only
- annotating types, make this into a NULL_EXPR. */
+ /* If this node is a non-static subexpression and we are only annotating
+ types, make this into a NULL_EXPR. */
if (type_annotate_only
- && IN (Nkind (gnat_node), N_Subexpr)
- && Nkind (gnat_node) != N_Identifier
+ && IN (kind, N_Subexpr)
+ && kind != N_Identifier
&& !Compile_Time_Known_Value (gnat_node))
return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
build_call_raise (CE_Range_Check_Failed, gnat_node,
N_Raise_Constraint_Error));
- /* If this is a Statement and we are at top level, it must be part of the
- elaboration procedure, so mark us as being in that procedure and push our
- context.
-
- If we are in the elaboration procedure, check if we are violating a
- No_Elaboration_Code restriction by having a statement there. */
- if ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
- && Nkind (gnat_node) != N_Null_Statement
- && Nkind (gnat_node) != N_SCIL_Dispatch_Table_Object_Init
- && Nkind (gnat_node) != N_SCIL_Dispatch_Table_Tag_Init
- && Nkind (gnat_node) != N_SCIL_Dispatching_Call
- && Nkind (gnat_node) != N_SCIL_Tag_Init)
- || Nkind (gnat_node) == N_Procedure_Call_Statement
- || Nkind (gnat_node) == N_Label
- || Nkind (gnat_node) == N_Implicit_Label_Declaration
- || Nkind (gnat_node) == N_Handled_Sequence_Of_Statements
- || ((Nkind (gnat_node) == N_Raise_Constraint_Error
- || Nkind (gnat_node) == N_Raise_Storage_Error
- || Nkind (gnat_node) == N_Raise_Program_Error)
- && (Ekind (Etype (gnat_node)) == E_Void)))
+ if ((IN (kind, N_Statement_Other_Than_Procedure_Call)
+ && !IN (kind, N_SCIL_Node)
+ && kind != N_Null_Statement)
+ || kind == N_Procedure_Call_Statement
+ || kind == N_Label
+ || kind == N_Implicit_Label_Declaration
+ || kind == N_Handled_Sequence_Of_Statements
+ || (IN (kind, N_Raise_xxx_Error) && Ekind (Etype (gnat_node)) == E_Void))
{
+ /* If this is a statement and we are at top level, it must be part of
+ the elaboration procedure, so mark us as being in that procedure
+ and push our context. */
if (!current_function_decl)
{
current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
@@ -3520,18 +3511,19 @@ gnat_to_gnu (Node_Id gnat_node)
went_into_elab_proc = true;
}
- /* Don't check for a possible No_Elaboration_Code restriction violation
- on N_Handled_Sequence_Of_Statements, as we want to signal an error on
+ /* If we are in the elaboration procedure, check if we are violating a
+ No_Elaboration_Code restriction by having a statement there. Don't
+ check for a possible No_Elaboration_Code restriction violation on
+ N_Handled_Sequence_Of_Statements, as we want to signal an error on
every nested real statement instead. This also avoids triggering
spurious errors on dummy (empty) sequences created by the front-end
for package bodies in some cases. */
-
if (current_function_decl == TREE_VALUE (gnu_elab_proc_stack)
- && Nkind (gnat_node) != N_Handled_Sequence_Of_Statements)
+ && kind != N_Handled_Sequence_Of_Statements)
Check_Elaboration_Code_Allowed (gnat_node);
}
- switch (Nkind (gnat_node))
+ switch (kind)
{
/********************************/
/* Chapter 2: Lexical Elements */
@@ -3743,8 +3735,7 @@ gnat_to_gnu (Node_Id gnat_node)
break;
if (Present (Expression (gnat_node))
- && !(Nkind (gnat_node) == N_Object_Declaration
- && No_Initialization (gnat_node))
+ && !(kind == N_Object_Declaration && No_Initialization (gnat_node))
&& (!type_annotate_only
|| Compile_Time_Known_Value (Expression (gnat_node))))
{
@@ -4136,7 +4127,7 @@ gnat_to_gnu (Node_Id gnat_node)
= convert_with_check (Etype (gnat_node), gnu_result,
Do_Overflow_Check (gnat_node),
Do_Range_Check (Expression (gnat_node)),
- Nkind (gnat_node) == N_Type_Conversion
+ kind == N_Type_Conversion
&& Float_Truncate (gnat_node), gnat_node);
break;
@@ -4224,7 +4215,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_object, gnu_high));
}
- if (Nkind (gnat_node) == N_Not_In)
+ if (kind == N_Not_In)
gnu_result = invert_truthvalue (gnu_result);
}
break;
@@ -4248,8 +4239,8 @@ gnat_to_gnu (Node_Id gnat_node)
Modular_Integer_Kind))
{
enum tree_code code
- = (Nkind (gnat_node) == N_Op_Or ? BIT_IOR_EXPR
- : Nkind (gnat_node) == N_Op_And ? BIT_AND_EXPR
+ = (kind == N_Op_Or ? BIT_IOR_EXPR
+ : kind == N_Op_And ? BIT_AND_EXPR
: BIT_XOR_EXPR);
gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node));
@@ -4273,7 +4264,7 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Op_Shift_Right_Arithmetic:
case N_And_Then: case N_Or_Else:
{
- enum tree_code code = gnu_codes[Nkind (gnat_node)];
+ enum tree_code code = gnu_codes[kind];
bool ignore_lhs_overflow = false;
tree gnu_type;
@@ -4299,18 +4290,16 @@ gnat_to_gnu (Node_Id gnat_node)
/* If this is a shift whose count is not guaranteed to be correct,
we need to adjust the shift count. */
- if (IN (Nkind (gnat_node), N_Op_Shift)
- && !Shift_Count_OK (gnat_node))
+ if (IN (kind, N_Op_Shift) && !Shift_Count_OK (gnat_node))
{
tree gnu_count_type = get_base_type (TREE_TYPE (gnu_rhs));
tree gnu_max_shift
= convert (gnu_count_type, TYPE_SIZE (gnu_type));
- if (Nkind (gnat_node) == N_Op_Rotate_Left
- || Nkind (gnat_node) == N_Op_Rotate_Right)
+ if (kind == N_Op_Rotate_Left || kind == N_Op_Rotate_Right)
gnu_rhs = build_binary_op (TRUNC_MOD_EXPR, gnu_count_type,
gnu_rhs, gnu_max_shift);
- else if (Nkind (gnat_node) == N_Op_Shift_Right_Arithmetic)
+ else if (kind == N_Op_Shift_Right_Arithmetic)
gnu_rhs
= build_binary_op
(MIN_EXPR, gnu_count_type,
@@ -4326,13 +4315,12 @@ gnat_to_gnu (Node_Id gnat_node)
so we may need to choose a different type. In this case,
we have to ignore integer overflow lest it propagates all
the way down and causes a CE to be explicitly raised. */
- if (Nkind (gnat_node) == N_Op_Shift_Right
- && !TYPE_UNSIGNED (gnu_type))
+ if (kind == N_Op_Shift_Right && !TYPE_UNSIGNED (gnu_type))
{
gnu_type = gnat_unsigned_type (gnu_type);
ignore_lhs_overflow = true;
}
- else if (Nkind (gnat_node) == N_Op_Shift_Right_Arithmetic
+ else if (kind == N_Op_Shift_Right_Arithmetic
&& TYPE_UNSIGNED (gnu_type))
{
gnu_type = gnat_signed_type (gnu_type);
@@ -4355,9 +4343,9 @@ gnat_to_gnu (Node_Id gnat_node)
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
- && (Nkind (gnat_node) == N_Op_Add
- || Nkind (gnat_node) == N_Op_Subtract
- || Nkind (gnat_node) == N_Op_Multiply)
+ && (kind == N_Op_Add
+ || kind == N_Op_Subtract
+ || kind == N_Op_Multiply)
&& !TYPE_UNSIGNED (gnu_type)
&& !FLOAT_TYPE_P (gnu_type))
gnu_result = build_binary_op_trapv (code, gnu_type,
@@ -4368,8 +4356,7 @@ gnat_to_gnu (Node_Id gnat_node)
/* If this is a logical shift with the shift count not verified,
we must return zero if it is too large. We cannot compensate
above in this case. */
- if ((Nkind (gnat_node) == N_Op_Shift_Left
- || Nkind (gnat_node) == N_Op_Shift_Right)
+ if ((kind == N_Op_Shift_Left || kind == N_Op_Shift_Right)
&& !Shift_Count_OK (gnat_node))
gnu_result
= build_cond_expr
@@ -4391,9 +4378,8 @@ gnat_to_gnu (Node_Id gnat_node)
= gnat_to_gnu (Next (Next (First (Expressions (gnat_node)))));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
- gnu_result = build_cond_expr (gnu_result_type,
- gnat_truthvalue_conversion (gnu_cond),
- gnu_true, gnu_false);
+ gnu_result
+ = build_cond_expr (gnu_result_type, gnu_cond, gnu_true, gnu_false);
}
break;
@@ -4432,10 +4418,10 @@ gnat_to_gnu (Node_Id gnat_node)
&& !TYPE_UNSIGNED (gnu_result_type)
&& !FLOAT_TYPE_P (gnu_result_type))
gnu_result
- = build_unary_op_trapv (gnu_codes[Nkind (gnat_node)],
+ = build_unary_op_trapv (gnu_codes[kind],
gnu_result_type, gnu_expr, gnat_node);
else
- gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)],
+ gnu_result = build_unary_op (gnu_codes[kind],
gnu_result_type, gnu_expr);
break;
@@ -5204,8 +5190,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result
- = build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node,
- Nkind (gnat_node));
+ = build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node, kind);
/* If the type is VOID, this is a statement, so we need to
generate the code for the call. Handle a Condition, if there
@@ -5564,14 +5549,14 @@ add_decl_expr (tree gnu_decl, Entity_Id
/* Mark everything as used to prevent node sharing with subprograms.
Note that walk_tree knows how to deal with TYPE_DECL, but neither
VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */
- mark_visited (&gnu_stmt);
+ MARK_VISITED (gnu_stmt);
if (TREE_CODE (gnu_decl) == VAR_DECL
|| TREE_CODE (gnu_decl) == CONST_DECL)
{
- mark_visited (&DECL_SIZE (gnu_decl));
- mark_visited (&DECL_SIZE_UNIT (gnu_decl));
- mark_visited (&DECL_INITIAL (gnu_decl));
+ MARK_VISITED (DECL_SIZE (gnu_decl));
+ MARK_VISITED (DECL_SIZE_UNIT (gnu_decl));
+ MARK_VISITED (DECL_INITIAL (gnu_decl));
}
}
else
@@ -5611,20 +5596,32 @@ add_decl_expr (tree gnu_decl, Entity_Id
static tree
mark_visited_r (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
{
- if (TREE_VISITED (*tp))
+ tree t = *tp;
+
+ if (TREE_VISITED (t))
*walk_subtrees = 0;
/* Don't mark a dummy type as visited because we want to mark its sizes
and fields once it's filled in. */
- else if (!TYPE_IS_DUMMY_P (*tp))
- TREE_VISITED (*tp) = 1;
+ else if (!TYPE_IS_DUMMY_P (t))
+ TREE_VISITED (t) = 1;
- if (TYPE_P (*tp))
- TYPE_SIZES_GIMPLIFIED (*tp) = 1;
+ if (TYPE_P (t))
+ TYPE_SIZES_GIMPLIFIED (t) = 1;
return NULL_TREE;
}
+/* Mark nodes rooted at T with TREE_VISITED and types as having their
+ sized gimplified. We use this to indicate all variable sizes and
+ positions in global types may not be shared by any subprogram. */
+
+void
+mark_visited (tree t)
+{
+ walk_tree (&t, mark_visited_r, NULL, NULL);
+}
+
/* Utility function to unshare expressions wrapped up in a SAVE_EXPR. */
static tree
@@ -5639,16 +5636,6 @@ unshare_save_expr (tree *tp, int *walk_s
return NULL_TREE;
}
-/* Mark nodes rooted at *TP with TREE_VISITED and types as having their
- sized gimplified. We use this to indicate all variable sizes and
- positions in global types may not be shared by any subprogram. */
-
-void
-mark_visited (tree *tp)
-{
- walk_tree (tp, mark_visited_r, NULL, NULL);
-}
-
/* Add GNU_CLEANUP, a cleanup action, to the current code group and
set its location to that of GNAT_NODE if present. */
Index: gcc-interface/ada-tree.h
===================================================================
--- gcc-interface/ada-tree.h (revision 152067)
+++ gcc-interface/ada-tree.h (working copy)
@@ -210,8 +210,7 @@ do { \
TYPE_RM_VALUES (NODE) = make_tree_vec (3); \
/* ??? The field is not visited by the generic \
code so we need to mark it manually. */ \
- if (!TREE_CONSTANT (tmp)) \
- mark_visited (&tmp); \
+ MARK_VISITED (tmp); \
TREE_VEC_ELT (TYPE_RM_VALUES (NODE), (N)) = tmp; \
} while (0)
Index: gcc-interface/ada.h
===================================================================
--- gcc-interface/ada.h (revision 152067)
+++ gcc-interface/ada.h (working copy)
@@ -62,9 +62,9 @@
enum { CAT (SUBTYPE,__First) = FIRST, \
CAT (SUBTYPE,__Last) = LAST };
-/* The following definitions provide the equivalent of the Ada IN and NOT IN
- operators, assuming that the subtype involved has been defined using the
- SUBTYPE macro defined above. */
+/* The following definition provides the equivalent of the Ada IN operator,
+ assuming that the subtype involved has been defined using the SUBTYPE
+ macro defined above. */
#define IN(VALUE,SUBTYPE) \
(((VALUE) >= (SUBTYPE) CAT (SUBTYPE,__First)) \