From: Eric Botcazou Date: Fri, 30 Aug 2019 15:22:34 +0000 (+0000) Subject: ada-tree.h (DECL_FORCED_BY_REF_P): New macro. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1edbeb153d802dbac524d7177d72d173278183f1;p=gcc.git ada-tree.h (DECL_FORCED_BY_REF_P): New macro. * gcc-interface/ada-tree.h (DECL_FORCED_BY_REF_P): New macro. * gcc-interface/decl.c (gnat_to_gnu_param): Set it on parameters whose mechanism was forced to by-reference. * gcc-interface/trans.c (Call_to_gnu): Do not issue a warning about a misaligned actual parameter if it is based on a CONSTRUCTOR. Remove obsolete warning for users of Starlet. Issue a warning if a temporary is make around the call for a parameter with DECL_FORCED_BY_REF_P set. (addressable_p): Return true for REAL_CST and ADDR_EXPR. From-SVN: r275198 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f4c510d9fff..bb43565467d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2019-08-30 Eric Botcazou + + * gcc-interface/ada-tree.h (DECL_FORCED_BY_REF_P): New macro. + * gcc-interface/decl.c (gnat_to_gnu_param): Set it on parameters + whose mechanism was forced to by-reference. + * gcc-interface/trans.c (Call_to_gnu): Do not issue a warning about a + misaligned actual parameter if it is based on a CONSTRUCTOR. Remove + obsolete warning for users of Starlet. Issue a warning if a temporary + is make around the call for a parameter with DECL_FORCED_BY_REF_P set. + (addressable_p): Return true for REAL_CST and ADDR_EXPR. + 2019-08-30 Eric Botcazou * gcc-interface/trans.c (gnat_to_gnu): Do not set the location on an diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 2029b7c1a52..acea5d157ef 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -482,6 +482,9 @@ do { \ value of a function call or 'reference to a function call. */ #define DECL_RETURN_VALUE_P(NODE) DECL_LANG_FLAG_5 (VAR_DECL_CHECK (NODE)) +/* Nonzero in a PARM_DECL if its mechanism was forced to by-reference. */ +#define DECL_FORCED_BY_REF_P(NODE) DECL_LANG_FLAG_5 (PARM_DECL_CHECK (NODE)) + /* In a FIELD_DECL corresponding to a discriminant, contains the discriminant number. */ #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE)) diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 5fce2ad772d..85a5e76724f 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5208,6 +5208,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, bool ro_param = in_param && !Address_Taken (gnat_param); bool by_return = false, by_component_ptr = false; bool by_ref = false; + bool forced_by_ref = false; bool restricted_aliasing_p = false; location_t saved_location = input_location; tree gnu_param; @@ -5235,7 +5236,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, /* Or else, see if a Mechanism was supplied that forced this parameter to be passed one way or another. */ else if (mech == Default || mech == By_Copy || mech == By_Reference) - ; + forced_by_ref + = (mech == By_Reference + && !foreign + && !TYPE_IS_BY_REFERENCE_P (gnu_param_type) + && !Is_Aliased (gnat_param)); /* Positive mechanism means by copy for sufficiently small parameters. */ else if (mech > 0) @@ -5368,6 +5373,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, gnu_param = create_param_decl (gnu_param_name, gnu_param_type); TREE_READONLY (gnu_param) = ro_param || by_ref || by_component_ptr; DECL_BY_REF_P (gnu_param) = by_ref; + DECL_FORCED_BY_REF_P (gnu_param) = forced_by_ref; DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr; DECL_POINTS_TO_READONLY_P (gnu_param) = (ro_param && (by_ref || by_component_ptr)); diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index e7064c6e72e..4d2fa93ffce 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -5257,30 +5257,20 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, /* Do not issue warnings for CONSTRUCTORs since this is not a copy but sort of an instantiation for them. */ - if (TREE_CODE (gnu_name) == CONSTRUCTOR) + if (TREE_CODE (remove_conversions (gnu_name, true)) == CONSTRUCTOR) ; - /* If the type is passed by reference, a copy is not allowed. */ - else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type)) + /* If the formal is passed by reference, a copy is not allowed. */ + else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type) + || Is_Aliased (gnat_formal)) post_error ("misaligned actual cannot be passed by reference", gnat_actual); - /* For users of Starlet we issue a warning because the interface - apparently assumes that by-ref parameters outlive the procedure - invocation. The code still will not work as intended, but we - cannot do much better since low-level parts of the back-end - would allocate temporaries at will because of the misalignment - if we did not do so here. */ - else if (Is_Valued_Procedure (Entity (Name (gnat_node)))) - { - post_error - ("?possible violation of implicit assumption", gnat_actual); - post_error_ne - ("?made by pragma Import_Valued_Procedure on &", gnat_actual, - Entity (Name (gnat_node))); - post_error_ne ("?because of misalignment of &", gnat_actual, - gnat_formal); - } + /* If the mechanism was forced to by-ref, a copy is not allowed but + we issue only a warning because this case is not strict Ada. */ + else if (DECL_FORCED_BY_REF_P (gnu_formal)) + post_error ("misaligned actual cannot be passed by reference??", + gnat_actual); /* If the actual type of the object is already the nominal type, we have nothing to do, except if the size is self-referential @@ -10394,6 +10384,7 @@ addressable_p (tree gnu_expr, tree gnu_type) case STRING_CST: case INTEGER_CST: + case REAL_CST: /* Taking the address yields a pointer to the constant pool. */ return true; @@ -10403,6 +10394,7 @@ addressable_p (tree gnu_expr, tree gnu_type) return TREE_STATIC (gnu_expr) ? true : false; case NULL_EXPR: + case ADDR_EXPR: case SAVE_EXPR: case CALL_EXPR: case PLUS_EXPR: