+2016-02-29 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/ada-tree.h (DECL_RETURN_VALUE_P): New macro.
+ * gcc-interface/gigi.h (gigi): Remove useless attribute.
+ (gnat_gimplify_expr): Likewise.
+ (gnat_to_gnu_external): Declare.
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: Factor out
+ code dealing with the expression of external constants into...
+ Invoke gnat_to_gnu_external instead.
+ <E_Variable>: Invoke gnat_to_gnu_external to translate renamed objects
+ when not for a definition. Deal with COMPOUND_EXPR and variables with
+ DECL_RETURN_VALUE_P set for renamings and with the case of a dangling
+ 'reference to a function call in a renaming. Remove obsolete test and
+ adjust associated comment.
+ * gcc-interface/trans.c (Call_to_gnu): Set DECL_RETURN_VALUE_P on the
+ temporaries created to hold the return value, if any.
+ (gnat_to_gnu_external): ...this. New function.
+ * gcc-interface/utils.c (create_var_decl): Detect a constant created
+ to hold 'reference to function call.
+ * gcc-interface/utils2.c (build_unary_op) <ADDR_EXPR>: Add folding
+ for COMPOUND_EXPR in the DECL_RETURN_VALUE_P case.
+
2016-02-17 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch4.adb (Expand_N_Indexed_Component): Active synchronization if
a discriminant of a discriminated type without default expression. */
#define DECL_INVARIANT_P(NODE) DECL_LANG_FLAG_4 (FIELD_DECL_CHECK (NODE))
+/* Nonzero in a VAR_DECL if it is a temporary created to hold the return
+ 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))
+
/* In a FIELD_DECL corresponding to a discriminant, contains the
discriminant number. */
#define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
&& Present (Expression (Declaration_Node (gnat_entity)))
&& Nkind (Expression (Declaration_Node (gnat_entity)))
!= N_Allocator)
- {
- bool went_into_elab_proc = false;
- int save_force_global = force_global;
-
/* The expression may contain N_Expression_With_Actions nodes and
- thus object declarations from other units. In this case, even
- though the expression will eventually be discarded since not a
- constant, the declarations would be stuck either in the global
- varpool or in the current scope. Therefore we force the local
- context and create a fake scope that we'll zap at the end. */
- if (!current_function_decl)
- {
- current_function_decl = get_elaboration_procedure ();
- went_into_elab_proc = true;
- }
- force_global = 0;
- gnat_pushlevel ();
-
- gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity)));
-
- gnat_zaplevel ();
- force_global = save_force_global;
- if (went_into_elab_proc)
- current_function_decl = NULL_TREE;
- }
+ thus object declarations from other units. Discard them. */
+ gnu_expr
+ = gnat_to_gnu_external (Expression (Declaration_Node (gnat_entity)));
/* ... fall through ... */
tree renamed_obj = NULL_TREE;
tree gnu_object_size;
+ /* We need to translate the renamed object even though we are only
+ referencing the renaming. But it may contain a call for which
+ we'll generate a temporary to hold the return value and which
+ is part of the definition of the renaming, so discard it. */
if (Present (Renamed_Object (gnat_entity)) && !definition)
{
if (kind == E_Exception)
gnu_expr = gnat_to_gnu_entity (Renamed_Entity (gnat_entity),
NULL_TREE, 0);
else
- gnu_expr = gnat_to_gnu (Renamed_Object (gnat_entity));
+ gnu_expr = gnat_to_gnu_external (Renamed_Object (gnat_entity));
}
/* Get the type after elaborating the renamed object. */
inner = TREE_OPERAND (inner, 0);
/* Expand_Dispatching_Call can prepend a comparison of the tags
before the call to "=". */
- if (TREE_CODE (inner) == TRUTH_ANDIF_EXPR)
+ if (TREE_CODE (inner) == TRUTH_ANDIF_EXPR
+ || TREE_CODE (inner) == COMPOUND_EXPR)
inner = TREE_OPERAND (inner, 1);
if ((TREE_CODE (inner) == CALL_EXPR
&& !call_is_atomic_load (inner))
|| TREE_CODE (inner) == ADDR_EXPR
|| TREE_CODE (inner) == NULL_EXPR
|| TREE_CODE (inner) == CONSTRUCTOR
- || CONSTANT_CLASS_P (inner))
+ || CONSTANT_CLASS_P (inner)
+ /* We need to detect the case where a temporary is created to
+ hold the return value, since we cannot safely rename it at
+ top level as it lives only in the elaboration routine. */
+ || (TREE_CODE (inner) == VAR_DECL
+ && DECL_RETURN_VALUE_P (inner))
+ /* We also need to detect the case where the front-end creates
+ a dangling 'reference to a function call at top level and
+ substitutes it in the renaming, for example:
+
+ q__b : boolean renames r__f.e (1);
+
+ can be rewritten into:
+
+ q__R1s : constant q__A2s := r__f'reference;
+ [...]
+ q__b : boolean renames q__R1s.all.e (1);
+
+ We cannot safely rename the rewritten expression since the
+ underlying object lives only in the elaboration routine. */
+ || (TREE_CODE (inner) == INDIRECT_REF
+ && (inner
+ = remove_conversions (TREE_OPERAND (inner, 0), true))
+ && TREE_CODE (inner) == VAR_DECL
+ && DECL_RETURN_VALUE_P (inner)))
;
/* Case 2: if the renaming entity need not be materialized, use
means that the caller is responsible for evaluating the address
of the renaming in the correct place for the definition case to
instantiate the SAVE_EXPRs. */
- else if (TREE_CODE (inner) != COMPOUND_EXPR
- && !Materialize_Entity (gnat_entity))
+ else if (!Materialize_Entity (gnat_entity))
{
tree init = NULL_TREE;
&init);
/* We cannot evaluate the first arm of a COMPOUND_EXPR in the
- correct place for this case, hence the above test. */
+ correct place for this case. */
gcc_assert (!init);
/* No DECL_EXPR will be created so the expression needs to be
structures and then generates code. */
extern void gigi (Node_Id gnat_root,
int max_gnat_node,
- int number_name ATTRIBUTE_UNUSED,
+ int number_name,
struct Node *nodes_ptr,
struct Flags *Flags_Ptr,
Node_Id *next_node_ptr,
#endif
/* GNAT_NODE is the root of some GNAT tree. Return the root of the
- GCC tree corresponding to that GNAT tree. Normally, no code is generated;
- we just return an equivalent tree which is used elsewhere to generate
- code. */
+ GCC tree corresponding to that GNAT tree. */
extern tree gnat_to_gnu (Node_Id gnat_node);
+/* Similar to gnat_to_gnu, but discard any object that might be created in
+ the course of the translation of GNAT_NODE, which must be an "external"
+ expression in the sense that it will be elaborated elsewhere. */
+extern tree gnat_to_gnu_external (Node_Id gnat_node);
+
/* GNU_STMT is a statement. We generate code for that statement. */
extern void gnat_expand_stmt (tree gnu_stmt);
/* Generate GIMPLE in place for the expression at *EXPR_P. */
-extern int gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
- gimple_seq *post_p ATTRIBUTE_UNUSED);
+extern int gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *);
/* Do the processing for the declaration of a GNAT_ENTITY, a type. If
a separate Freeze node exists, delay the bulk of the processing. Otherwise
&& TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_target)))
== INTEGER_CST))
&& TREE_CODE (TYPE_SIZE (gnu_result_type)) != INTEGER_CST)))
- gnu_retval = create_temporary ("R", gnu_result_type);
+ {
+ gnu_retval = create_temporary ("R", gnu_result_type);
+ DECL_RETURN_VALUE_P (gnu_retval) = 1;
+ }
/* Create the list of the actual parameters as GCC expects it, namely a
chain of TREE_LIST nodes in which the TREE_VALUE field of each node
we need to create a temporary for the return value because we must
preserve it before copying back at the very end. */
if (!in_param && returning_value && !gnu_retval)
- gnu_retval = create_temporary ("R", gnu_result_type);
+ {
+ gnu_retval = create_temporary ("R", gnu_result_type);
+ DECL_RETURN_VALUE_P (gnu_retval) = 1;
+ }
/* If we haven't pushed a binding level, push a new one. This will
narrow the lifetime of the temporary we are about to make as much
return gnu_result;
}
+
+/* Similar to gnat_to_gnu, but discard any object that might be created in
+ the course of the translation of GNAT_NODE, which must be an "external"
+ expression in the sense that it will be elaborated elsewhere. */
+
+tree
+gnat_to_gnu_external (Node_Id gnat_node)
+{
+ const int save_force_global = force_global;
+ bool went_into_elab_proc = false;
+
+ /* Force the local context and create a fake scope that we zap
+ at the end so declarations will not be stuck either in the
+ global varpool or in the current scope. */
+ if (!current_function_decl)
+ {
+ current_function_decl = get_elaboration_procedure ();
+ went_into_elab_proc = true;
+ }
+ force_global = 0;
+ gnat_pushlevel ();
+
+ tree gnu_result = gnat_to_gnu (gnat_node);
+
+ gnat_zaplevel ();
+ force_global = save_force_global;
+ if (went_into_elab_proc)
+ current_function_decl = NULL_TREE;
+
+ return gnu_result;
+}
\f
/* Subroutine of above to push the exception label stack. GNU_STACK is
a pointer to the stack to update and GNAT_LABEL, if present, is the
&& !AGGREGATE_TYPE_P (type)) ? CONST_DECL : VAR_DECL,
name, type);
+ /* Detect constants created by the front-end to hold 'reference to function
+ calls for stabilization purposes. This is needed for renaming. */
+ if (const_flag && init && POINTER_TYPE_P (type))
+ {
+ tree inner = init;
+ if (TREE_CODE (inner) == COMPOUND_EXPR)
+ inner = TREE_OPERAND (inner, 1);
+ inner = remove_conversions (inner, true);
+ if (TREE_CODE (inner) == ADDR_EXPR
+ && ((TREE_CODE (TREE_OPERAND (inner, 0)) == CALL_EXPR
+ && !call_is_atomic_load (TREE_OPERAND (inner, 0)))
+ || (TREE_CODE (TREE_OPERAND (inner, 0)) == VAR_DECL
+ && DECL_RETURN_VALUE_P (TREE_OPERAND (inner, 0)))))
+ DECL_RETURN_VALUE_P (var_decl) = 1;
+ }
+
/* If this is external, throw away any initializations (they will be done
elsewhere) unless this is a constant for which we would like to remain
able to get the initializer. If we are defining a global here, leave a
since the middle-end cannot handle it. But we don't it in the
general case because it may introduce aliasing issues if the
first operand is an indirect assignment and the second operand
- the corresponding address, e.g. for an allocator. */
- if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
+ the corresponding address, e.g. for an allocator. However do
+ it for a return value to expose it for later recognition. */
+ if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE
+ || (TREE_CODE (TREE_OPERAND (operand, 1)) == VAR_DECL
+ && DECL_RETURN_VALUE_P (TREE_OPERAND (operand, 1))))
{
result = build_unary_op (ADDR_EXPR, result_type,
TREE_OPERAND (operand, 1));
+2016-02-29 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/renaming8.adb: New test.
+ * gnat.dg/renaming8_pkg1.ads: New helper.
+ * gnat.dg/renaming8_pkg2.ad[sb]: Likewise.
+ * gnat.dg/renaming8_pkg3.ad[sb]: Likewise.
+
2016-02-29 Richard Biener <rguenther@suse.de>
PR tree-optimization/69720
--- /dev/null
+-- { dg-do run }
+-- { dg-options "-gnatp" }
+
+with Renaming8_Pkg1; use Renaming8_Pkg1;
+
+procedure Renaming8 is
+begin
+ if not B then
+ raise Program_Error;
+ end if;
+end;
--- /dev/null
+with Renaming8_Pkg2; use Renaming8_Pkg2;
+
+package Renaming8_Pkg1 is
+
+ B: Boolean renames F.E(1);
+
+end Renaming8_Pkg1;
--- /dev/null
+package body Renaming8_Pkg2 is
+
+ function F return Rec is
+ begin
+ return (E => (others => True));
+ end;
+
+end Renaming8_Pkg2;
--- /dev/null
+with Renaming8_Pkg3; use Renaming8_Pkg3;
+
+package Renaming8_Pkg2 is
+
+ type Arr is array (Positive range 1 .. Last_Index) of Boolean;
+
+ type Rec is record
+ E : Arr;
+ end record;
+
+ function F return Rec;
+
+end Renaming8_Pkg2;
--- /dev/null
+package body Renaming8_Pkg3 is
+
+ function Last_Index return Integer is
+ begin
+ return 16;
+ end;
+
+end Renaming8_Pkg3;
--- /dev/null
+package Renaming8_Pkg3 is
+
+ function Last_Index return Integer;
+
+end Renaming8_Pkg3;
projects / platform / upstream / linaro-gcc.git / commitdiff