procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

trans.c (lvalue_required_p): Take base node directly instead of its parent.

Browse source 
* trans.c (lvalue_required_p): Take base node directly instead
	of its parent.  Rename second parameter to 'gnu_type'.
	<N_Indexed_Component>: Return 0 if the node isn't the prefix.
	<N_Slice>: Likewise.
	(Identifier_to_gnu): Rename parent_requires_lvalue to require_lvalue.
	Adjust calls to lvalue_required_p.

From-SVN: r130626
This commit is contained in:
Eric Botcazou 2007-12-05 17:00:07 +00:00 • committed by Eric Botcazou
parent e37ab97325
commit 0ec479dcfb
4 changed files with 94 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/ada/ChangeLog
View file

@ -1,3 +1,12 @@
2007-12-05 Eric Botcazou <ebotcazou@adacore.com>
* trans.c (lvalue_required_p): Take base node directly instead
of its parent. Rename second parameter to 'gnu_type'.
<N_Indexed_Component>: Return 0 if the node isn't the prefix.
<N_Slice>: Likewise.
(Identifier_to_gnu): Rename parent_requires_lvalue to require_lvalue.
Adjust calls to lvalue_required_p.
2007-12-05 Samuel Tardieu <sam@rfc1149.net>
PR ada/21489

111
gcc/ada/trans.c
View file

@ -379,22 +379,29 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
error_gnat_node = Empty;
}
/* 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
@ -404,32 +411,36 @@ lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
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
@ -439,8 +450,8 @@ lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
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;
@ -450,20 +461,19 @@ lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
}
/* 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
@ -539,9 +549,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
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
@ -550,10 +560,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
&& !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)
@ -646,21 +655,21 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
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));
}

4
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,7 @@
2007-12-05 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/elab1.ads: New test.
2007-12-05 Uros Bizjak <ubizjak@gmail.com>
PR target/34312

21
gcc/testsuite/gnat.dg/specs/elab1.ads Normal file
View file

@ -0,0 +1,21 @@
-- { dg-do compile }
pragma Restrictions(No_Elaboration_Code);
with System;
package Elab1 is
type Ptrs_Type is array (Integer range 1 .. 2) of System.Address;
type Vars_Array is array (Integer range 1 .. 2) of Integer;
Vars : Vars_Array;
Val1 : constant Integer := 1;
Val2 : constant Integer := 2;
Ptrs : constant Ptrs_Type :=
(1 => Vars (Val1)'Address,
2 => Vars (Val2)'Address);
end Elab1;