error_gnat_node = Empty;
}
\f
-/* Returns a positive value if GNAT_NODE requires an lvalue for an
- operand of OPERAND_TYPE, whose aliasing is specified by ALIASED,
- zero otherwise. This is int instead of bool to facilitate usage
- in non purely binary logic contexts. */
+/* Return a positive value if an lvalue is required for GNAT_NODE.
+ GNU_TYPE is the type that will be used for GNAT_NODE in the
+ translated GNU tree. ALIASED indicates whether the underlying
+ object represented by GNAT_NODE is aliased in the Ada sense.
+
+ The function climbs up the GNAT tree starting from the node and
+ returns 1 upon encountering a node that effectively requires an
+ lvalue downstream. It returns int instead of bool to facilitate
+ usage in non purely binary logic contexts. */
static int
-lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
+lvalue_required_p (Node_Id gnat_node, tree gnu_type, int aliased)
{
- switch (Nkind (gnat_node))
+ Node_Id gnat_parent = Parent (gnat_node), gnat_temp;
+
+ switch (Nkind (gnat_parent))
{
case N_Reference:
return 1;
case N_Attribute_Reference:
{
- unsigned char id = Get_Attribute_Id (Attribute_Name (gnat_node));
+ unsigned char id = Get_Attribute_Id (Attribute_Name (gnat_parent));
return id == Attr_Address
|| id == Attr_Access
|| id == Attr_Unchecked_Access
case N_Parameter_Association:
case N_Function_Call:
case N_Procedure_Call_Statement:
- return must_pass_by_ref (operand_type)
- || default_pass_by_ref (operand_type);
+ return (must_pass_by_ref (gnu_type) || default_pass_by_ref (gnu_type));
case N_Indexed_Component:
- {
- Node_Id gnat_temp;
- /* ??? Consider that referencing an indexed component with a
- non-constant index forces the whole aggregate to memory.
- Note that N_Integer_Literal is conservative, any static
- expression in the RM sense could probably be accepted. */
- for (gnat_temp = First (Expressions (gnat_node));
- Present (gnat_temp);
- gnat_temp = Next (gnat_temp))
- if (Nkind (gnat_temp) != N_Integer_Literal)
- return 1;
- }
+ /* Only the array expression can require an lvalue. */
+ if (Prefix (gnat_parent) != gnat_node)
+ return 0;
+
+ /* ??? Consider that referencing an indexed component with a
+ non-constant index forces the whole aggregate to memory.
+ Note that N_Integer_Literal is conservative, any static
+ expression in the RM sense could probably be accepted. */
+ for (gnat_temp = First (Expressions (gnat_parent));
+ Present (gnat_temp);
+ gnat_temp = Next (gnat_temp))
+ if (Nkind (gnat_temp) != N_Integer_Literal)
+ return 1;
/* ... fall through ... */
case N_Slice:
- aliased |= Has_Aliased_Components (Etype (Prefix (gnat_node)));
- return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
+ /* Only the array expression can require an lvalue. */
+ if (Prefix (gnat_parent) != gnat_node)
+ return 0;
+
+ aliased |= Has_Aliased_Components (Etype (gnat_node));
+ return lvalue_required_p (gnat_parent, gnu_type, aliased);
case N_Selected_Component:
- aliased |= Is_Aliased (Entity (Selector_Name (gnat_node)));
- return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
+ aliased |= Is_Aliased (Entity (Selector_Name (gnat_parent)));
+ return lvalue_required_p (gnat_parent, gnu_type, aliased);
case N_Object_Renaming_Declaration:
/* We need to make a real renaming only if the constant object is
attached to the CONST_DECL. */
return (aliased != 0
/* This should match the constant case of the renaming code. */
- || Is_Composite_Type (Etype (Name (gnat_node)))
- || Nkind (Name (gnat_node)) == N_Identifier);
+ || Is_Composite_Type (Etype (Name (gnat_parent)))
+ || Nkind (Name (gnat_parent)) == N_Identifier);
default:
return 0;
}
/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
- to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to
- where we should place the result type. */
+ to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer
+ to where we should place the result type. */
static tree
Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
{
- tree gnu_result_type;
- tree gnu_result;
Node_Id gnat_temp, gnat_temp_type;
+ tree gnu_result, gnu_result_type;
- /* Whether the parent of gnat_node requires an lvalue. Needed in
- specific circumstances only, so evaluated lazily. < 0 means unknown,
- > 0 means known true, 0 means known false. */
- int parent_requires_lvalue = -1;
+ /* Whether we should require an lvalue for GNAT_NODE. Needed in
+ specific circumstances only, so evaluated lazily. < 0 means
+ unknown, > 0 means known true, 0 means known false. */
+ int require_lvalue = -1;
/* If GNAT_NODE is a constant, whether we should use the initialization
value instead of the constant entity, typically for scalars with an
gnu_result_type = get_unpadded_type (gnat_temp_type);
/* If this is a non-imported scalar constant with an address clause,
- retrieve the value instead of a pointer to be dereferenced unless the
- parent requires an lvalue. This is generally more efficient and
- actually required if this is a static expression because it might be used
+ retrieve the value instead of a pointer to be dereferenced unless
+ an lvalue is required. This is generally more efficient and actually
+ required if this is a static expression because it might be used
in a context where a dereference is inappropriate, such as a case
statement alternative or a record discriminant. There is no possible
volatile-ness shortciruit here since Volatile constants must be imported
&& !Is_Imported (gnat_temp)
&& Present (Address_Clause (gnat_temp)))
{
- parent_requires_lvalue
- = lvalue_required_p (Parent (gnat_node), gnu_result_type,
- Is_Aliased (gnat_temp));
- use_constant_initializer = !parent_requires_lvalue;
+ require_lvalue = lvalue_required_p (gnat_node, gnu_result_type,
+ Is_Aliased (gnat_temp));
+ use_constant_initializer = !require_lvalue;
}
if (use_constant_initializer)
of places and the need of elaboration code if this Id is used as
an initializer itself. */
if (TREE_CONSTANT (gnu_result)
- && DECL_P (gnu_result) && DECL_INITIAL (gnu_result))
+ && DECL_P (gnu_result)
+ && DECL_INITIAL (gnu_result))
{
tree object
= (TREE_CODE (gnu_result) == CONST_DECL
? DECL_CONST_CORRESPONDING_VAR (gnu_result) : gnu_result);
- /* If there is a corresponding variable, we only want to return the CST
- value if the parent doesn't require an lvalue. Evaluate this now if
- we have not already done so. */
- if (object && parent_requires_lvalue < 0)
- parent_requires_lvalue
- = lvalue_required_p (Parent (gnat_node), gnu_result_type,
- Is_Aliased (gnat_temp));
+ /* If there is a corresponding variable, we only want to return
+ the CST value if an lvalue is not required. Evaluate this
+ now if we have not already done so. */
+ if (object && require_lvalue < 0)
+ require_lvalue = lvalue_required_p (gnat_node, gnu_result_type,
+ Is_Aliased (gnat_temp));
- if (!object || !parent_requires_lvalue)
+ if (!object || !require_lvalue)
gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
}
OSDN Git Service
