Commit 3f13dd77 by Eric Botcazou Committed by Eric Botcazou

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
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> 2009-09-24 Dave Korn <dave.korn.cygwin@gmail.com>
* gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS): Simplify test for * gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS): Simplify test for
......
...@@ -210,8 +210,7 @@ do { \ ...@@ -210,8 +210,7 @@ do { \
TYPE_RM_VALUES (NODE) = make_tree_vec (3); \ TYPE_RM_VALUES (NODE) = make_tree_vec (3); \
/* ??? The field is not visited by the generic \ /* ??? The field is not visited by the generic \
code so we need to mark it manually. */ \ 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; \ TREE_VEC_ELT (TYPE_RM_VALUES (NODE), (N)) = tmp; \
} while (0) } while (0)
......
...@@ -62,9 +62,9 @@ ...@@ -62,9 +62,9 @@
enum { CAT (SUBTYPE,__First) = FIRST, \ enum { CAT (SUBTYPE,__First) = FIRST, \
CAT (SUBTYPE,__Last) = LAST }; CAT (SUBTYPE,__Last) = LAST };
/* The following definitions provide the equivalent of the Ada IN and NOT IN /* The following definition provides the equivalent of the Ada IN operator,
operators, assuming that the subtype involved has been defined using the assuming that the subtype involved has been defined using the SUBTYPE
SUBTYPE macro defined above. */ macro defined above. */
#define IN(VALUE,SUBTYPE) \ #define IN(VALUE,SUBTYPE) \
(((VALUE) >= (SUBTYPE) CAT (SUBTYPE,__First)) \ (((VALUE) >= (SUBTYPE) CAT (SUBTYPE,__First)) \
......
...@@ -898,11 +898,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -898,11 +898,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (stable) if (stable)
{ {
gnu_decl = maybe_stable_expr;
/* ??? No DECL_EXPR is created so we need to mark /* ??? No DECL_EXPR is created so we need to mark
the expression manually lest it is shared. */ the expression manually lest it is shared. */
if (global_bindings_p ()) 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); save_gnu_tree (gnat_entity, gnu_decl, true);
saved = true; saved = true;
annotate_object (gnat_entity, gnu_type, NULL_TREE, 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) ...@@ -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 /* ??? create_type_decl is not invoked on the inner types so
the MULT_EXPR node built above will never be marked. */ 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) ...@@ -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 the MULT_EXPR node built above may not be marked by the call
to create_type_decl below. */ to create_type_decl below. */
if (global_bindings_p ()) 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) ...@@ -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)); UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
} }
/* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding /* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding GCC type,
GCC type, set Component_Bit_Offset and Esize to the position and size set Component_Bit_Offset and Esize of the components to the position and
used by Gigi. */ size used by Gigi. */
static void static void
annotate_rep (Entity_Id gnat_entity, tree gnu_type) annotate_rep (Entity_Id gnat_entity, tree gnu_type)
{ {
tree gnu_list;
tree gnu_entry;
Entity_Id gnat_field; Entity_Id gnat_field;
tree gnu_list;
/* We operate by first making a list of all fields and their positions /* We operate by first making a list of all fields and their position (we
(we can get the sizes easily at any time) by a recursive call can get the size easily) and then update all the sizes in the tree. */
and then update all the sizes into the tree. */ gnu_list = compute_field_positions (gnu_type, NULL_TREE, size_zero_node,
gnu_list = compute_field_positions (gnu_type, NULL_TREE, bitsize_zero_node, BIGGEST_ALIGNMENT);
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)) gnat_field = Next_Entity (gnat_field))
if ((Ekind (gnat_field) == E_Component if (Ekind (gnat_field) == E_Component
|| (Ekind (gnat_field) == E_Discriminant || (Ekind (gnat_field) == E_Discriminant
&& !Is_Unchecked_Union (Scope (gnat_field))))) && !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), t = purpose_member (gnat_to_gnu_field_decl (gnat_field), gnu_list);
gnu_list); if (t)
if (gnu_entry)
{ {
if (type_annotate_only && Is_Tagged_Type (gnat_entity)) 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 generated, so we add the appropriate offset to each
component. For a component appearing in the current component. For a component appearing in the current
extension, the offset is the size of the parent. */ extension, the offset is the size of the parent. */
if (Is_Derived_Type (gnat_entity) if (Is_Derived_Type (gnat_entity)
&& Original_Record_Component (gnat_field) == gnat_field) && Original_Record_Component (gnat_field) == gnat_field)
parent_offset parent_offset
= UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))), = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
bitsizetype); bitsizetype);
else else
parent_offset = bitsize_int (POINTER_SIZE); parent_offset = bitsize_int (POINTER_SIZE);
} }
else
parent_offset = bitsize_zero_node;
Set_Component_Bit_Offset Set_Component_Bit_Offset
(gnat_field, (gnat_field,
annotate_value annotate_value
(size_binop (PLUS_EXPR, (size_binop (PLUS_EXPR,
bit_from_pos (TREE_PURPOSE (TREE_VALUE (gnu_entry)), bit_from_pos (TREE_PURPOSE (TREE_VALUE (t)),
TREE_VALUE (TREE_VALUE TREE_VALUE (TREE_VALUE
(TREE_VALUE (gnu_entry)))), (TREE_VALUE (t)))),
parent_offset))); parent_offset)));
Set_Esize (gnat_field, 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) else if (Is_Tagged_Type (gnat_entity) && Is_Derived_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. */ position is the same as in the parent type. */
Set_Component_Bit_Offset Set_Component_Bit_Offset
(gnat_field, (gnat_field,
Component_Bit_Offset (Original_Record_Component (gnat_field))); Component_Bit_Offset (Original_Record_Component (gnat_field)));
Set_Esize (gnat_field, Set_Esize (gnat_field,
Esize (Original_Record_Component (gnat_field))); Esize (Original_Record_Component (gnat_field)));
} }
} }
} }
/* Scan all fields in GNU_TYPE and build entries where TREE_PURPOSE is the /* 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 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 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, ...@@ -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_bitpos, unsigned int offset_align)
{ {
tree gnu_field; 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)) gnu_field = TREE_CHAIN (gnu_field))
{ {
tree gnu_our_bitpos = size_binop (PLUS_EXPR, gnu_bitpos, 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, ...@@ -7368,22 +7366,22 @@ compute_field_positions (tree gnu_type, tree gnu_list, tree gnu_pos,
unsigned int our_offset_align unsigned int our_offset_align
= MIN (offset_align, DECL_OFFSET_ALIGN (gnu_field)); = MIN (offset_align, DECL_OFFSET_ALIGN (gnu_field));
gnu_result gnu_list
= tree_cons (gnu_field, = tree_cons (gnu_field,
tree_cons (gnu_our_offset, tree_cons (gnu_our_offset,
tree_cons (size_int (our_offset_align), tree_cons (size_int (our_offset_align),
gnu_our_bitpos, NULL_TREE), gnu_our_bitpos, NULL_TREE),
NULL_TREE), NULL_TREE),
gnu_result); gnu_list);
if (DECL_INTERNAL_P (gnu_field)) if (DECL_INTERNAL_P (gnu_field))
gnu_result gnu_list
= compute_field_positions (TREE_TYPE (gnu_field), gnu_result, = compute_field_positions (TREE_TYPE (gnu_field), gnu_list,
gnu_our_offset, gnu_our_bitpos, gnu_our_offset, gnu_our_bitpos,
our_offset_align); our_offset_align);
} }
return gnu_result; return gnu_list;
} }
/* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE /* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE
......
...@@ -75,10 +75,19 @@ extern void set_block_for_group (tree); ...@@ -75,10 +75,19 @@ extern void set_block_for_group (tree);
Get SLOC from GNAT_ENTITY. */ Get SLOC from GNAT_ENTITY. */
extern void add_decl_expr (tree gnu_decl, Entity_Id 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 sized gimplified. We use this to indicate all variable sizes and
positions in global types may not be shared by any subprogram. */ 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 /* 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. */ 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, ...@@ -767,20 +776,6 @@ extern bool is_double_scalar_or_array (Entity_Id gnat_type,
component of an aggregate type. */ component of an aggregate type. */
extern bool type_for_nonaliased_component_p (tree gnu_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. */ /* Return the base type of TYPE. */
extern tree get_base_type (tree type); extern tree get_base_type (tree type);
......
...@@ -3454,64 +3454,55 @@ unchecked_conversion_lhs_nop (Node_Id gnat_node) ...@@ -3454,64 +3454,55 @@ unchecked_conversion_lhs_nop (Node_Id gnat_node)
return false; return false;
} }
/* This function is the driver of the GNAT to GCC tree transformation /* This function is the driver of the GNAT to GCC tree transformation process.
process. It is the entry point of the tree transformer. GNAT_NODE is the It is the entry point of the tree transformer. GNAT_NODE is the root of
root of some GNAT tree. Return the root of the corresponding GCC tree. some GNAT tree. Return the root of the corresponding GCC tree. If this
If this is an expression, return the GCC equivalent of the expression. If is an expression, return the GCC equivalent of the expression. If this
it is a statement, return the statement. In the case when called for a is a statement, return the statement or add it to the current statement
statement, it may also add statements to the current statement group, in group, in which case anything returned is to be interpreted as occurring
which case anything it returns is to be interpreted as occurring after after anything added. */
anything `it already added. */
tree tree
gnat_to_gnu (Node_Id gnat_node) gnat_to_gnu (Node_Id gnat_node)
{ {
const Node_Kind kind = Nkind (gnat_node);
bool went_into_elab_proc = false; bool went_into_elab_proc = false;
tree gnu_result = error_mark_node; /* Default to no value. */ tree gnu_result = error_mark_node; /* Default to no value. */
tree gnu_result_type = void_type_node; tree gnu_result_type = void_type_node;
tree gnu_expr; tree gnu_expr, gnu_lhs, gnu_rhs;
tree gnu_lhs, gnu_rhs;
Node_Id gnat_temp; Node_Id gnat_temp;
/* Save node number for error message and set location information. */ /* Save node number for error message and set location information. */
error_gnat_node = gnat_node; error_gnat_node = gnat_node;
Sloc_to_locus (Sloc (gnat_node), &input_location); Sloc_to_locus (Sloc (gnat_node), &input_location);
if (type_annotate_only /* If this node is a statement and we are only annotating types, return an
&& IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)) empty statement list. */
if (type_annotate_only && IN (kind, N_Statement_Other_Than_Procedure_Call))
return alloc_stmt_list (); return alloc_stmt_list ();
/* If this node is a non-static subexpression and we are only /* If this node is a non-static subexpression and we are only annotating
annotating types, make this into a NULL_EXPR. */ types, make this into a NULL_EXPR. */
if (type_annotate_only if (type_annotate_only
&& IN (Nkind (gnat_node), N_Subexpr) && IN (kind, N_Subexpr)
&& Nkind (gnat_node) != N_Identifier && kind != N_Identifier
&& !Compile_Time_Known_Value (gnat_node)) && !Compile_Time_Known_Value (gnat_node))
return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)), return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
build_call_raise (CE_Range_Check_Failed, gnat_node, build_call_raise (CE_Range_Check_Failed, gnat_node,
N_Raise_Constraint_Error)); N_Raise_Constraint_Error));
/* If this is a Statement and we are at top level, it must be part of the if ((IN (kind, N_Statement_Other_Than_Procedure_Call)
elaboration procedure, so mark us as being in that procedure and push our && !IN (kind, N_SCIL_Node)
context. && kind != N_Null_Statement)
|| kind == N_Procedure_Call_Statement
If we are in the elaboration procedure, check if we are violating a || kind == N_Label
No_Elaboration_Code restriction by having a statement there. */ || kind == N_Implicit_Label_Declaration
if ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call) || kind == N_Handled_Sequence_Of_Statements
&& Nkind (gnat_node) != N_Null_Statement || (IN (kind, N_Raise_xxx_Error) && Ekind (Etype (gnat_node)) == E_Void))
&& 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 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) if (!current_function_decl)
{ {
current_function_decl = TREE_VALUE (gnu_elab_proc_stack); current_function_decl = TREE_VALUE (gnu_elab_proc_stack);
...@@ -3520,18 +3511,19 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3520,18 +3511,19 @@ gnat_to_gnu (Node_Id gnat_node)
went_into_elab_proc = true; went_into_elab_proc = true;
} }
/* Don't check for a possible No_Elaboration_Code restriction violation /* If we are in the elaboration procedure, check if we are violating a
on N_Handled_Sequence_Of_Statements, as we want to signal an error on 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 every nested real statement instead. This also avoids triggering
spurious errors on dummy (empty) sequences created by the front-end spurious errors on dummy (empty) sequences created by the front-end
for package bodies in some cases. */ for package bodies in some cases. */
if (current_function_decl == TREE_VALUE (gnu_elab_proc_stack) 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); Check_Elaboration_Code_Allowed (gnat_node);
} }
switch (Nkind (gnat_node)) switch (kind)
{ {
/********************************/ /********************************/
/* Chapter 2: Lexical Elements */ /* Chapter 2: Lexical Elements */
...@@ -3743,8 +3735,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3743,8 +3735,7 @@ gnat_to_gnu (Node_Id gnat_node)
break; break;
if (Present (Expression (gnat_node)) if (Present (Expression (gnat_node))
&& !(Nkind (gnat_node) == N_Object_Declaration && !(kind == N_Object_Declaration && No_Initialization (gnat_node))
&& No_Initialization (gnat_node))
&& (!type_annotate_only && (!type_annotate_only
|| Compile_Time_Known_Value (Expression (gnat_node)))) || Compile_Time_Known_Value (Expression (gnat_node))))
{ {
...@@ -4136,7 +4127,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4136,7 +4127,7 @@ gnat_to_gnu (Node_Id gnat_node)
= convert_with_check (Etype (gnat_node), gnu_result, = convert_with_check (Etype (gnat_node), gnu_result,
Do_Overflow_Check (gnat_node), Do_Overflow_Check (gnat_node),
Do_Range_Check (Expression (gnat_node)), Do_Range_Check (Expression (gnat_node)),
Nkind (gnat_node) == N_Type_Conversion kind == N_Type_Conversion
&& Float_Truncate (gnat_node), gnat_node); && Float_Truncate (gnat_node), gnat_node);
break; break;
...@@ -4224,7 +4215,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4224,7 +4215,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_object, gnu_high)); gnu_object, gnu_high));
} }
if (Nkind (gnat_node) == N_Not_In) if (kind == N_Not_In)
gnu_result = invert_truthvalue (gnu_result); gnu_result = invert_truthvalue (gnu_result);
} }
break; break;
...@@ -4248,8 +4239,8 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4248,8 +4239,8 @@ gnat_to_gnu (Node_Id gnat_node)
Modular_Integer_Kind)) Modular_Integer_Kind))
{ {
enum tree_code code enum tree_code code
= (Nkind (gnat_node) == N_Op_Or ? BIT_IOR_EXPR = (kind == N_Op_Or ? BIT_IOR_EXPR
: Nkind (gnat_node) == N_Op_And ? BIT_AND_EXPR : kind == N_Op_And ? BIT_AND_EXPR
: BIT_XOR_EXPR); : BIT_XOR_EXPR);
gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node)); gnu_lhs = gnat_to_gnu (Left_Opnd (gnat_node));
...@@ -4273,7 +4264,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4273,7 +4264,7 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Op_Shift_Right_Arithmetic: 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[Nkind (gnat_node)]; enum tree_code code = gnu_codes[kind];
bool ignore_lhs_overflow = false; bool ignore_lhs_overflow = false;
tree gnu_type; tree gnu_type;
...@@ -4299,18 +4290,16 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4299,18 +4290,16 @@ gnat_to_gnu (Node_Id gnat_node)
/* If this is a shift whose count is not guaranteed to be correct, /* If this is a shift whose count is not guaranteed to be correct,
we need to adjust the shift count. */ we need to adjust the shift count. */
if (IN (Nkind (gnat_node), N_Op_Shift) if (IN (kind, N_Op_Shift) && !Shift_Count_OK (gnat_node))
&& !Shift_Count_OK (gnat_node))
{ {
tree gnu_count_type = get_base_type (TREE_TYPE (gnu_rhs)); tree gnu_count_type = get_base_type (TREE_TYPE (gnu_rhs));
tree gnu_max_shift tree gnu_max_shift
= convert (gnu_count_type, TYPE_SIZE (gnu_type)); = convert (gnu_count_type, TYPE_SIZE (gnu_type));
if (Nkind (gnat_node) == N_Op_Rotate_Left if (kind == N_Op_Rotate_Left || kind == N_Op_Rotate_Right)
|| Nkind (gnat_node) == N_Op_Rotate_Right)
gnu_rhs = build_binary_op (TRUNC_MOD_EXPR, gnu_count_type, gnu_rhs = build_binary_op (TRUNC_MOD_EXPR, gnu_count_type,
gnu_rhs, gnu_max_shift); 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 gnu_rhs
= build_binary_op = build_binary_op
(MIN_EXPR, gnu_count_type, (MIN_EXPR, gnu_count_type,
...@@ -4326,13 +4315,12 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4326,13 +4315,12 @@ gnat_to_gnu (Node_Id gnat_node)
so we may need to choose a different type. In this case, so we may need to choose a different type. In this case,
we have to ignore integer overflow lest it propagates all we have to ignore integer overflow lest it propagates all
the way down and causes a CE to be explicitly raised. */ the way down and causes a CE to be explicitly raised. */
if (Nkind (gnat_node) == N_Op_Shift_Right if (kind == N_Op_Shift_Right && !TYPE_UNSIGNED (gnu_type))
&& !TYPE_UNSIGNED (gnu_type))
{ {
gnu_type = gnat_unsigned_type (gnu_type); gnu_type = gnat_unsigned_type (gnu_type);
ignore_lhs_overflow = true; 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)) && TYPE_UNSIGNED (gnu_type))
{ {
gnu_type = gnat_signed_type (gnu_type); gnu_type = gnat_signed_type (gnu_type);
...@@ -4355,9 +4343,9 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4355,9 +4343,9 @@ gnat_to_gnu (Node_Id gnat_node)
do overflow checking, do it here. The goal is to push do overflow checking, do it here. The goal is to push
the expansions further into the back end over time. */ the expansions further into the back end over time. */
if (Do_Overflow_Check (gnat_node) && Backend_Overflow_Checks_On_Target if (Do_Overflow_Check (gnat_node) && Backend_Overflow_Checks_On_Target
&& (Nkind (gnat_node) == N_Op_Add && (kind == N_Op_Add
|| Nkind (gnat_node) == N_Op_Subtract || kind == N_Op_Subtract
|| Nkind (gnat_node) == N_Op_Multiply) || kind == N_Op_Multiply)
&& !TYPE_UNSIGNED (gnu_type) && !TYPE_UNSIGNED (gnu_type)
&& !FLOAT_TYPE_P (gnu_type)) && !FLOAT_TYPE_P (gnu_type))
gnu_result = build_binary_op_trapv (code, gnu_type, gnu_result = build_binary_op_trapv (code, gnu_type,
...@@ -4368,8 +4356,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4368,8 +4356,7 @@ gnat_to_gnu (Node_Id gnat_node)
/* If this is a logical shift with the shift count not verified, /* If this is a logical shift with the shift count not verified,
we must return zero if it is too large. We cannot compensate we must return zero if it is too large. We cannot compensate
above in this case. */ above in this case. */
if ((Nkind (gnat_node) == N_Op_Shift_Left if ((kind == N_Op_Shift_Left || kind == N_Op_Shift_Right)
|| Nkind (gnat_node) == N_Op_Shift_Right)
&& !Shift_Count_OK (gnat_node)) && !Shift_Count_OK (gnat_node))
gnu_result gnu_result
= build_cond_expr = build_cond_expr
...@@ -4391,9 +4378,8 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4391,9 +4378,8 @@ gnat_to_gnu (Node_Id gnat_node)
= gnat_to_gnu (Next (Next (First (Expressions (gnat_node))))); = gnat_to_gnu (Next (Next (First (Expressions (gnat_node)))));
gnu_result_type = get_unpadded_type (Etype (gnat_node)); gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result = build_cond_expr (gnu_result_type, gnu_result
gnat_truthvalue_conversion (gnu_cond), = build_cond_expr (gnu_result_type, gnu_cond, gnu_true, gnu_false);
gnu_true, gnu_false);
} }
break; break;
...@@ -4432,10 +4418,10 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -4432,10 +4418,10 @@ gnat_to_gnu (Node_Id gnat_node)
&& !TYPE_UNSIGNED (gnu_result_type) && !TYPE_UNSIGNED (gnu_result_type)
&& !FLOAT_TYPE_P (gnu_result_type)) && !FLOAT_TYPE_P (gnu_result_type))
gnu_result 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); gnu_result_type, gnu_expr, gnat_node);
else else
gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)], gnu_result = build_unary_op (gnu_codes[kind],
gnu_result_type, gnu_expr); gnu_result_type, gnu_expr);
break; break;
...@@ -5204,8 +5190,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -5204,8 +5190,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result_type = get_unpadded_type (Etype (gnat_node)); gnu_result_type = get_unpadded_type (Etype (gnat_node));
gnu_result gnu_result
= build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node, = build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node, kind);
Nkind (gnat_node));
/* If the type is VOID, this is a statement, so we need to /* If the type is VOID, this is a statement, so we need to
generate the code for the call. Handle a Condition, if there 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) ...@@ -5564,14 +5549,14 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
/* Mark everything as used to prevent node sharing with subprograms. /* Mark everything as used to prevent node sharing with subprograms.
Note that walk_tree knows how to deal with TYPE_DECL, but neither Note that walk_tree knows how to deal with TYPE_DECL, but neither
VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */ 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 if (TREE_CODE (gnu_decl) == VAR_DECL
|| TREE_CODE (gnu_decl) == CONST_DECL) || TREE_CODE (gnu_decl) == CONST_DECL)
{ {
mark_visited (&DECL_SIZE (gnu_decl)); MARK_VISITED (DECL_SIZE (gnu_decl));
mark_visited (&DECL_SIZE_UNIT (gnu_decl)); MARK_VISITED (DECL_SIZE_UNIT (gnu_decl));
mark_visited (&DECL_INITIAL (gnu_decl)); MARK_VISITED (DECL_INITIAL (gnu_decl));
} }
} }
else else
...@@ -5611,20 +5596,32 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity) ...@@ -5611,20 +5596,32 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
static tree static tree
mark_visited_r (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED) 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; *walk_subtrees = 0;
/* Don't mark a dummy type as visited because we want to mark its sizes /* Don't mark a dummy type as visited because we want to mark its sizes
and fields once it's filled in. */ and fields once it's filled in. */
else if (!TYPE_IS_DUMMY_P (*tp)) else if (!TYPE_IS_DUMMY_P (t))
TREE_VISITED (*tp) = 1; TREE_VISITED (t) = 1;
if (TYPE_P (*tp)) if (TYPE_P (t))
TYPE_SIZES_GIMPLIFIED (*tp) = 1; TYPE_SIZES_GIMPLIFIED (t) = 1;
return NULL_TREE; 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. */ /* Utility function to unshare expressions wrapped up in a SAVE_EXPR. */
static tree static tree
...@@ -5639,16 +5636,6 @@ unshare_save_expr (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED, ...@@ -5639,16 +5636,6 @@ unshare_save_expr (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
return NULL_TREE; 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 /* Add GNU_CLEANUP, a cleanup action, to the current code group and
set its location to that of GNAT_NODE if present. */ set its location to that of GNAT_NODE if present. */
......
...@@ -55,63 +55,6 @@ static tree compare_arrays (tree, tree, tree); ...@@ -55,63 +55,6 @@ static tree compare_arrays (tree, tree, tree);
static tree nonbinary_modular_operation (enum tree_code, tree, tree, tree); static tree nonbinary_modular_operation (enum tree_code, tree, tree, tree);
static tree build_simple_component_ref (tree, tree, tree, bool); 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. */ /* Return the base type of TYPE. */
tree tree
...@@ -970,15 +913,6 @@ build_binary_op (enum tree_code op_code, tree result_type, ...@@ -970,15 +913,6 @@ build_binary_op (enum tree_code op_code, tree result_type,
left_operand = convert (operation_type, left_operand); left_operand = convert (operation_type, left_operand);
break; 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_AND_EXPR:
case BIT_IOR_EXPR: case BIT_IOR_EXPR:
case BIT_XOR_EXPR: case BIT_XOR_EXPR:
...@@ -1120,7 +1054,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand) ...@@ -1120,7 +1054,7 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
case TRUTH_NOT_EXPR: case TRUTH_NOT_EXPR:
gcc_assert (result_type == base_type); gcc_assert (result_type == base_type);
result = invert_truthvalue (gnat_truthvalue_conversion (operand)); result = invert_truthvalue (operand);
break; break;
case ATTR_ADDR_EXPR: 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