mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 20:01:28 +08:00
Code Issues Packages Projects Releases Wiki Activity

decl.c (gnat_to_gnu_entity): Also use return-by-invisible-reference if the return type is By_Reference.

Browse Source 
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>: Also
	use return-by-invisible-reference if the return type is By_Reference.
	Tidy up and skip the processing of the return type if it is void.

From-SVN: r166916
This commit is contained in:
Eric Botcazou 2010-11-18 18:48:54 +00:00 committed by Eric Botcazou
parent 69ecd18fb9
commit c9d84d0e00
6 changed files with 163 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -1,3 +1,9 @@
2010-11-18 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>: Also
use return-by-invisible-reference if the return type is By_Reference.
Tidy up and skip the processing of the return type if it is void.
2010-11-17 Joseph Myers <joseph@codesourcery.com>
* gcc-interface/misc.c (gnat_parse_file): Take no arguments.

197
gcc/ada/gcc-interface/decl.c
View File

@ -3827,9 +3827,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Subprogram Entities
The following access functions are defined for subprograms (functions
or procedures):
The following access functions are defined for subprograms:
Etype Return type or Standard_Void_Type.
First_Formal The first formal parameter.
Is_Imported Indicates that the subprogram has appeared in
an INTERFACE or IMPORT pragma. For now we
@ -3837,10 +3837,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
Is_Exported Likewise but for an EXPORT pragma.
Is_Inlined True if the subprogram is to be inlined.
In addition for function subprograms we have:
Etype Return type of the function.
Each parameter is first checked by calling must_pass_by_ref on its
type to determine if it is passed by reference. For parameters which
are copied in, if they are Ada In Out or Out parameters, their return
@ -3873,18 +3869,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
case E_Function:
case E_Procedure:
{
/* The type returned by a function or else Standard_Void_Type for a
procedure. */
Entity_Id gnat_return_type = Etype (gnat_entity);
tree gnu_return_type;
/* The first GCC parameter declaration (a PARM_DECL node). The
PARM_DECL nodes are chained through the TREE_CHAIN field, so this
actually is the head of this parameter list. */
tree gnu_param_list = NULL_TREE;
/* Likewise for the stub associated with an exported procedure. */
tree gnu_stub_param_list = NULL_TREE;
/* The type returned by a function. If the subprogram is a procedure
this type should be void_type_node. */
tree gnu_return_type = void_type_node;
/* List of fields in return type of procedure with copy-in copy-out
parameters. */
tree gnu_field_list = NULL_TREE;
/* Non-null for subprograms containing parameters passed by copy-in
copy-out (Ada In Out or Out parameters not passed by reference),
in which case it is the list of nodes used to specify the values
@ -3894,6 +3888,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
corresponding to that field. This list will be saved in the
TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create. */
tree gnu_cico_list = NULL_TREE;
/* List of fields in return type of procedure with copy-in copy-out
parameters. */
tree gnu_field_list = NULL_TREE;
/* If an import pragma asks to map this subprogram to a GCC builtin,
this is the builtin DECL node. */
tree gnu_builtin_decl = NULL_TREE;
@ -3905,7 +3902,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
bool public_flag = Is_Public (gnat_entity) || imported_p;
bool extern_flag
= (Is_Public (gnat_entity) && !definition) || imported_p;
/* The semantics of "pure" in Ada essentially matches that of "const"
in the back-end. In particular, both properties are orthogonal to
the "nothrow" property if the EH circuitry is explicit in the
@ -3917,7 +3913,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
bool const_flag
= (Exception_Mechanism == Back_End_Exceptions
&& Is_Pure (gnat_entity));
bool volatile_flag = No_Return (gnat_entity);
bool return_by_direct_ref_p = false;
bool return_by_invisi_ref_p = false;
@ -3942,8 +3937,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (Ekind (Alias (gnat_entity)) == E_Enumeration_Literal)
gnat_to_gnu_entity (Etype (Alias (gnat_entity)), NULL_TREE, 0);
gnu_decl = gnat_to_gnu_entity (Alias (gnat_entity),
gnu_expr, 0);
gnu_decl = gnat_to_gnu_entity (Alias (gnat_entity), gnu_expr, 0);
/* Elaborate any Itypes in the parameters of this entity. */
for (gnat_temp = First_Formal_With_Extras (gnat_entity);
@ -3978,97 +3972,92 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
In the current state we neither warn nor err, and calls will just
be handled as for regular subprograms. */
if (kind == E_Function || kind == E_Subprogram_Type)
gnu_return_type = gnat_to_gnu_type (Etype (gnat_entity));
/* If this function returns by reference, make the actual return
type of this function the pointer and mark the decl. */
if (Returns_By_Ref (gnat_entity))
/* Look into the return type and get its associated GCC tree. If it
is not void, compute various flags for the subprogram type. */
if (Ekind (gnat_return_type) == E_Void)
gnu_return_type = void_type_node;
else
{
gnu_return_type = build_pointer_type (gnu_return_type);
return_by_direct_ref_p = true;
gnu_return_type = gnat_to_gnu_type (gnat_return_type);
/* If this function returns by reference, make the actual return
type the pointer type and make a note of that. */
if (Returns_By_Ref (gnat_entity))
{
gnu_return_type = build_pointer_type (gnu_return_type);
return_by_direct_ref_p = true;
}
/* If we are supposed to return an unconstrained array type, make
the actual return type the fat pointer type. */
else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
{
gnu_return_type = TREE_TYPE (gnu_return_type);
return_unconstrained_p = true;
}
/* Likewise, if the return type requires a transient scope, the
return value will be allocated on the secondary stack so the
actual return type is the pointer type. */
else if (Requires_Transient_Scope (gnat_return_type))
{
gnu_return_type = build_pointer_type (gnu_return_type);
return_unconstrained_p = true;
}
/* If the Mechanism is By_Reference, ensure this function uses the
target's by-invisible-reference mechanism, which may not be the
same as above (e.g. it might be passing an extra parameter). */
else if (kind == E_Function
&& Mechanism (gnat_entity) == By_Reference)
return_by_invisi_ref_p = true;
/* Likewise, if the return type is itself By_Reference. */
else if (TREE_ADDRESSABLE (gnu_return_type))
return_by_invisi_ref_p = true;
/* If the type is a padded type and the underlying type would not
be passed by reference or the function has a foreign convention,
return the underlying type. */
else if (TYPE_IS_PADDING_P (gnu_return_type)
&& (!default_pass_by_ref
(TREE_TYPE (TYPE_FIELDS (gnu_return_type)))
|| Has_Foreign_Convention (gnat_entity)))
gnu_return_type = TREE_TYPE (TYPE_FIELDS (gnu_return_type));
/* If the return type is unconstrained, that means it must have a
maximum size. Use the padded type as the effective return type.
And ensure the function uses the target's by-invisible-reference
mechanism to avoid copying too much data when it returns. */
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
{
gnu_return_type
= maybe_pad_type (gnu_return_type,
max_size (TYPE_SIZE (gnu_return_type),
true),
0, gnat_entity, false, false, false, true);
return_by_invisi_ref_p = true;
}
/* If the return type has a size that overflows, we cannot have
a function that returns that type. This usage doesn't make
sense anyway, so give an error here. */
if (TYPE_SIZE_UNIT (gnu_return_type)
&& TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type))
&& TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_return_type)))
{
post_error ("cannot return type whose size overflows",
gnat_entity);
gnu_return_type = copy_node (gnu_return_type);
TYPE_SIZE (gnu_return_type) = bitsize_zero_node;
TYPE_SIZE_UNIT (gnu_return_type) = size_zero_node;
TYPE_MAIN_VARIANT (gnu_return_type) = gnu_return_type;
TYPE_NEXT_VARIANT (gnu_return_type) = NULL_TREE;
}
}
/* If the Mechanism is By_Reference, ensure this function uses the
target's by-invisible-reference mechanism, which may not be the
same as above (e.g. it might be passing an extra parameter).
Prior to GCC 4, this was handled by just setting TREE_ADDRESSABLE
on the result type. Everything required to pass by invisible
reference using the target's mechanism (e.g. an extra parameter)
was handled at RTL expansion time.
This doesn't work with GCC 4 any more for several reasons. First,
the gimplification process might need to create temporaries of this
type and the gimplifier ICEs on such attempts; that's why the flag
is now set on the function type instead. Second, the middle-end
now also relies on a different attribute, DECL_BY_REFERENCE on the
RESULT_DECL, and expects the by-invisible-reference-ness to be made
explicit in the function body. */
else if (kind == E_Function && Mechanism (gnat_entity) == By_Reference)
return_by_invisi_ref_p = true;
/* If we are supposed to return an unconstrained array, actually return
a fat pointer and make a note of that. */
else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
{
gnu_return_type = TREE_TYPE (gnu_return_type);
return_unconstrained_p = true;
}
/* If the type requires a transient scope, the result is allocated
on the secondary stack, so the result type of the function is
just a pointer. */
else if (Requires_Transient_Scope (Etype (gnat_entity)))
{
gnu_return_type = build_pointer_type (gnu_return_type);
return_unconstrained_p = true;
}
/* If the type is a padded type and the underlying type would not
be passed by reference or this function has a foreign convention,
return the underlying type. */
else if (TYPE_IS_PADDING_P (gnu_return_type)
&& (!default_pass_by_ref (TREE_TYPE
(TYPE_FIELDS (gnu_return_type)))
|| Has_Foreign_Convention (gnat_entity)))
gnu_return_type = TREE_TYPE (TYPE_FIELDS (gnu_return_type));
/* If the return type is unconstrained, that means it must have a
maximum size. Use the padded type as the effective return type.
And ensure the function uses the target's by-invisible-reference
mechanism to avoid copying too much data when it returns. */
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
{
gnu_return_type
= maybe_pad_type (gnu_return_type,
max_size (TYPE_SIZE (gnu_return_type), true),
0, gnat_entity, false, false, false, true);
return_by_invisi_ref_p = true;
}
/* If the return type has a size that overflows, we cannot have
a function that returns that type. This usage doesn't make
sense anyway, so give an error here. */
if (TYPE_SIZE_UNIT (gnu_return_type)
&& TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type))
&& TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_return_type)))
{
post_error ("cannot return type whose size overflows",
gnat_entity);
gnu_return_type = copy_node (gnu_return_type);
TYPE_SIZE (gnu_return_type) = bitsize_zero_node;
TYPE_SIZE_UNIT (gnu_return_type) = size_zero_node;
TYPE_MAIN_VARIANT (gnu_return_type) = gnu_return_type;
TYPE_NEXT_VARIANT (gnu_return_type) = NULL_TREE;
}
/* Look at all our parameters and get the type of
each. While doing this, build a copy-out structure if
we need one. */
/* Loop over the parameters and get their associated GCC tree.
While doing this, build a copy-out structure if we need one. */
/* Loop over the parameters and get their associated GCC tree. While
doing this, build a copy-in copy-out structure if we need one. */
for (gnat_param = First_Formal_With_Extras (gnat_entity), parmnum = 0;
Present (gnat_param);
gnat_param = Next_Formal_With_Extras (gnat_param), parmnum++)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2010-11-18 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/atomic4.ad[sb]: New test.
* gnat.dg/volatile4.adb: Likewise.
2010-11-18 Richard Henderson <rth@redhat.com>
* gcc.target/i386/pr46470.c: Skip for 32-bit PIC.

12
gcc/testsuite/gnat.dg/atomic4.adb Normal file
View File

@ -0,0 +1,12 @@
-- { dg-do compile }
-- { dg-options "-O -gnatn" }
package body Atomic4 is
procedure Next (Self : in out Reader'Class) is
begin
Self.Current_Reference := Self.Reference_Stack.Last_Element;
Self.Reference_Stack.Delete_Last;
end Next;
end Atomic4;

23
gcc/testsuite/gnat.dg/atomic4.ads Normal file
View File

@ -0,0 +1,23 @@
with Ada.Containers.Vectors;
package Atomic4 is
type String is limited null record;
type String_Access is access all String;
pragma Atomic (String_Access);
type Reference is record
Text : String_Access;
end record;
package Reference_Vectors is
new Ada.Containers.Vectors (Natural, Reference);
type Reader is tagged limited record
Current_Reference : Reference;
Reference_Stack : Reference_Vectors.Vector;
end record;
procedure Next (Self : in out Reader'Class);
end Atomic4;

24
gcc/testsuite/gnat.dg/volatile4.adb Normal file
View File

@ -0,0 +1,24 @@
-- { dg-do run }
procedure Volatile4 is
type My_Int is new Integer;
pragma Volatile (My_Int);
type Rec is record
I : My_Int;
end record;
function F (R : Rec) return Rec is
begin
return R;
end;
R : Rec := (I => 0);
begin
R := F (R);
if R.I /= 0 then
raise Program_Error;
end if;
end;