From c9d84d0e001228601fb96718a31f2a72ae3baee5 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 18 Nov 2010 18:48:54 +0000 Subject: [PATCH] decl.c (gnat_to_gnu_entity): Also use return-by-invisible-reference if the return type is By_Reference. * gcc-interface/decl.c (gnat_to_gnu_entity) : 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 --- gcc/ada/ChangeLog | 6 + gcc/ada/gcc-interface/decl.c | 197 +++++++++++++--------------- gcc/testsuite/ChangeLog | 5 + gcc/testsuite/gnat.dg/atomic4.adb | 12 ++ gcc/testsuite/gnat.dg/atomic4.ads | 23 ++++ gcc/testsuite/gnat.dg/volatile4.adb | 24 ++++ 6 files changed, 163 insertions(+), 104 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/atomic4.adb create mode 100644 gcc/testsuite/gnat.dg/atomic4.ads create mode 100644 gcc/testsuite/gnat.dg/volatile4.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b6210537a069..b1a8da7cdd44 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2010-11-18 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : 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 * gcc-interface/misc.c (gnat_parse_file): Take no arguments. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 718165386829..262ee5de9da4 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -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++) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 748d06ee39ce..7ef06b18ef61 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-11-18 Eric Botcazou + + * gnat.dg/atomic4.ad[sb]: New test. + * gnat.dg/volatile4.adb: Likewise. + 2010-11-18 Richard Henderson * gcc.target/i386/pr46470.c: Skip for 32-bit PIC. diff --git a/gcc/testsuite/gnat.dg/atomic4.adb b/gcc/testsuite/gnat.dg/atomic4.adb new file mode 100644 index 000000000000..99f4ee14c983 --- /dev/null +++ b/gcc/testsuite/gnat.dg/atomic4.adb @@ -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; diff --git a/gcc/testsuite/gnat.dg/atomic4.ads b/gcc/testsuite/gnat.dg/atomic4.ads new file mode 100644 index 000000000000..a0e95bbff467 --- /dev/null +++ b/gcc/testsuite/gnat.dg/atomic4.ads @@ -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; diff --git a/gcc/testsuite/gnat.dg/volatile4.adb b/gcc/testsuite/gnat.dg/volatile4.adb new file mode 100644 index 000000000000..fe2b30760ce6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/volatile4.adb @@ -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;