Commit 1edbeb15 by Eric Botcazou Committed by Eric Botcazou

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
parent 5e017b1e
2019-08-30 Eric Botcazou <ebotcazou@adacore.com> 2019-08-30 Eric Botcazou <ebotcazou@adacore.com>
* 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 <ebotcazou@adacore.com>
* gcc-interface/trans.c (gnat_to_gnu): Do not set the location on an * gcc-interface/trans.c (gnat_to_gnu): Do not set the location on an
expression used for a tag. expression used for a tag.
......
...@@ -482,6 +482,9 @@ do { \ ...@@ -482,6 +482,9 @@ do { \
value of a function call or 'reference to a function call. */ 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)) #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 /* In a FIELD_DECL corresponding to a discriminant, contains the
discriminant number. */ discriminant number. */
#define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE)) #define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
......
...@@ -5208,6 +5208,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, ...@@ -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 ro_param = in_param && !Address_Taken (gnat_param);
bool by_return = false, by_component_ptr = false; bool by_return = false, by_component_ptr = false;
bool by_ref = false; bool by_ref = false;
bool forced_by_ref = false;
bool restricted_aliasing_p = false; bool restricted_aliasing_p = false;
location_t saved_location = input_location; location_t saved_location = input_location;
tree gnu_param; tree gnu_param;
...@@ -5235,7 +5236,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, ...@@ -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 /* Or else, see if a Mechanism was supplied that forced this parameter
to be passed one way or another. */ to be passed one way or another. */
else if (mech == Default || mech == By_Copy || mech == By_Reference) 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. */ /* Positive mechanism means by copy for sufficiently small parameters. */
else if (mech > 0) else if (mech > 0)
...@@ -5368,6 +5373,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, ...@@ -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); gnu_param = create_param_decl (gnu_param_name, gnu_param_type);
TREE_READONLY (gnu_param) = ro_param || by_ref || by_component_ptr; TREE_READONLY (gnu_param) = ro_param || by_ref || by_component_ptr;
DECL_BY_REF_P (gnu_param) = by_ref; 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_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
DECL_POINTS_TO_READONLY_P (gnu_param) DECL_POINTS_TO_READONLY_P (gnu_param)
= (ro_param && (by_ref || by_component_ptr)); = (ro_param && (by_ref || by_component_ptr));
......
...@@ -5257,30 +5257,20 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, ...@@ -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 /* Do not issue warnings for CONSTRUCTORs since this is not a copy
but sort of an instantiation for them. */ 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. */ /* If the formal is passed by reference, a copy is not allowed. */
else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type)) else if (TYPE_IS_BY_REFERENCE_P (gnu_formal_type)
|| Is_Aliased (gnat_formal))
post_error ("misaligned actual cannot be passed by reference", post_error ("misaligned actual cannot be passed by reference",
gnat_actual); gnat_actual);
/* For users of Starlet we issue a warning because the interface /* If the mechanism was forced to by-ref, a copy is not allowed but
apparently assumes that by-ref parameters outlive the procedure we issue only a warning because this case is not strict Ada. */
invocation. The code still will not work as intended, but we else if (DECL_FORCED_BY_REF_P (gnu_formal))
cannot do much better since low-level parts of the back-end post_error ("misaligned actual cannot be passed by reference??",
would allocate temporaries at will because of the misalignment gnat_actual);
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 actual type of the object is already the nominal type, /* If the actual type of the object is already the nominal type,
we have nothing to do, except if the size is self-referential we have nothing to do, except if the size is self-referential
...@@ -10394,6 +10384,7 @@ addressable_p (tree gnu_expr, tree gnu_type) ...@@ -10394,6 +10384,7 @@ addressable_p (tree gnu_expr, tree gnu_type)
case STRING_CST: case STRING_CST:
case INTEGER_CST: case INTEGER_CST:
case REAL_CST:
/* Taking the address yields a pointer to the constant pool. */ /* Taking the address yields a pointer to the constant pool. */
return true; return true;
...@@ -10403,6 +10394,7 @@ addressable_p (tree gnu_expr, tree gnu_type) ...@@ -10403,6 +10394,7 @@ addressable_p (tree gnu_expr, tree gnu_type)
return TREE_STATIC (gnu_expr) ? true : false; return TREE_STATIC (gnu_expr) ? true : false;
case NULL_EXPR: case NULL_EXPR:
case ADDR_EXPR:
case SAVE_EXPR: case SAVE_EXPR:
case CALL_EXPR: case CALL_EXPR:
case PLUS_EXPR: case PLUS_EXPR:
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment