Skip to content

R
riscv-gcc-1
Commit 3f13dd77 by Eric Botcazou Committed by Eric Botcazou
Options

ada.h: Fix outdated comment. 

	* 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.

From-SVN: r152121
parent 6356f38f
Showing with 162 additions and 227 deletions
gcc/ada/ChangeLog
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.
2009-09-24 Dave Korn <dave.korn.cygwin@gmail.com>
* gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS): Simplify test for
......
gcc/ada/gcc-interface/ada-tree.h
......@@ -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)
......
gcc/ada/gcc-interface/ada.h
......@@ -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)) \
......
gcc/ada/gcc-interface/decl.c
......@@ -898,11 +898,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
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_entity, tree gnu_expr, int definition)
/* ??? 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_entity, tree gnu_expr, int definition)
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, tree gnu_type, tree size, bool by_ref)
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_list, tree gnu_pos,
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, tree gnu_list, tree gnu_pos,
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
......
gcc/ada/gcc-interface/gigi.h
......@@ -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 (Entity_Id gnat_type,
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);
......
gcc/ada/gcc-interface/trans.c
......@@ -3454,64 +3454,55 @@ unchecked_conversion_lhs_nop (Node_Id gnat_node)
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 gnat_entity)
/* 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 gnat_entity)
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_subtrees ATTRIBUTE_UNUSED,
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. */
......
gcc/ada/gcc-interface/utils2.c
......@@ -55,63 +55,6 @@ static tree compare_arrays (tree, 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, tree result_type,
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, tree result_type, tree operand)
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:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment