git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

ada-tree.h (DECL_GLOBAL_NONCONSTANT_RENAMING_P): Delete 

* gcc-interface/ada-tree.h (DECL_GLOBAL_NONCONSTANT_RENAMING_P): Delete
	(DECL_RENAMED_OBJECT): Adjust comment.
	* gcc-interface/gigi.h (record_global_nonconstant_renaming): Delete.
	(invalidate_global_nonconstant_renamings): Likewise.
	(gnat_constant_reference_p): Likewise.
	(rewrite_fn): New function type.
	(gnat_rewrite_reference): Declare.
	(call_is_atomic_load): New inline predicate.
	* gcc-interface/decl.c (elaborate_reference_1): New function.
	(elaborate_reference): Likewise.
	(gnat_to_gnu_entity): Call elaborate_reference to elaborate renamings
	and simplify associated code.  Set const_flag to true consistently in
 	conjunction with used_by_ref.
	* gcc-interface/trans.c (Identifier_to_gnu): Always replace renaming
	pointers by renamed objects.
	(outer_atomic_access_required_p): Deal with renamings.
	(Compilation_Unit_to_gnu): Do not call
	invalidate_global_nonconstant_renamings.
	(gnat_to_gnu) <N_Object_Renaming_Declaration>: Adjust comment.
	(gnat_gimplify_expr): Deal with atomic loads.
	* gcc-interface/utils.c (global_nonconstant_renamings): Delete.
	(destroy_gnat_utils): Do not call
	invalidate_global_nonconstant_renamings.
	(record_global_nonconstant_renaming): Delete.
	(invalidate_global_nonconstant_renamings): Likewise.
	* gcc-interface/utils2.c (call_is_atomic_load): Move to gigi.h.
	(build_load_modify_store): Build a copy of the destination.
	(gnat_stabilize_reference_1): Adjust.
	(gnat_stabilize_reference): Call gnat_stabilize_reference_1 through
	gnat_rewrite_reference and move bulk of code to...
	(gnat_rewrite_reference): ...here.  New global function.
	(gnat_constant_reference_p): Delete.

From-SVN: r223709
This commit is contained in:
Eric Botcazou 2015-05-26 19:40:18 +00:00 committed by Eric Botcazou
parent 7194767cdf
commit 241125b2a1
7 changed files with 236 additions and 198 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
gcc/ada/ChangeLog
View File

@ -1,3 +1,38 @@
2015-05-26 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/ada-tree.h (DECL_GLOBAL_NONCONSTANT_RENAMING_P): Delete
(DECL_RENAMED_OBJECT): Adjust comment.
* gcc-interface/gigi.h (record_global_nonconstant_renaming): Delete.
(invalidate_global_nonconstant_renamings): Likewise.
(gnat_constant_reference_p): Likewise.
(rewrite_fn): New function type.
(gnat_rewrite_reference): Declare.
(call_is_atomic_load): New inline predicate.
* gcc-interface/decl.c (elaborate_reference_1): New function.
(elaborate_reference): Likewise.
(gnat_to_gnu_entity): Call elaborate_reference to elaborate renamings
and simplify associated code. Set const_flag to true consistently in
conjunction with used_by_ref.
* gcc-interface/trans.c (Identifier_to_gnu): Always replace renaming
pointers by renamed objects.
(outer_atomic_access_required_p): Deal with renamings.
(Compilation_Unit_to_gnu): Do not call
invalidate_global_nonconstant_renamings.
(gnat_to_gnu) <N_Object_Renaming_Declaration>: Adjust comment.
(gnat_gimplify_expr): Deal with atomic loads.
* gcc-interface/utils.c (global_nonconstant_renamings): Delete.
(destroy_gnat_utils): Do not call
invalidate_global_nonconstant_renamings.
(record_global_nonconstant_renaming): Delete.
(invalidate_global_nonconstant_renamings): Likewise.
* gcc-interface/utils2.c (call_is_atomic_load): Move to gigi.h.
(build_load_modify_store): Build a copy of the destination.
(gnat_stabilize_reference_1): Adjust.
(gnat_stabilize_reference): Call gnat_stabilize_reference_1 through
gnat_rewrite_reference and move bulk of code to...
(gnat_rewrite_reference): ...here. New global function.
(gnat_constant_reference_p): Delete.
2015-05-26 Eric Botcazou <ebotcazou@adacore.com> 2015-05-26 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (gnat_stabilize_reference): Adjust prototype. * gcc-interface/gigi.h (gnat_stabilize_reference): Adjust prototype.

7
gcc/ada/gcc-interface/ada-tree.h
View File

@ -394,10 +394,6 @@ do { \
is readonly. */ is readonly. */
#define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE) #define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE)
/* Nonzero in a VAR_DECL if it is a global non-constant renaming. */
#define DECL_GLOBAL_NONCONSTANT_RENAMING_P(NODE) \
DECL_LANG_FLAG_5 (VAR_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))
@ -439,8 +435,7 @@ do { \
SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X) SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X)
/* In a VAR_DECL without the DECL_LOOP_PARM_P flag set and that is a renaming /* In a VAR_DECL without the DECL_LOOP_PARM_P flag set and that is a renaming
pointer, points to the object being renamed, if any. Note that this object pointer, points to the object being renamed, if any. */
is guaranteed to be protected against multiple evaluations. */
#define DECL_RENAMED_OBJECT(NODE) \ #define DECL_RENAMED_OBJECT(NODE) \
GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE)) GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))
#define SET_DECL_RENAMED_OBJECT(NODE, X) \ #define SET_DECL_RENAMED_OBJECT(NODE, X) \

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

@ -179,6 +179,7 @@ static bool type_has_variable_size (tree);
static tree elaborate_expression_1 (tree, Entity_Id, const char *, bool, bool); static tree elaborate_expression_1 (tree, Entity_Id, const char *, bool, bool);
static tree elaborate_expression_2 (tree, Entity_Id, const char *, bool, bool, static tree elaborate_expression_2 (tree, Entity_Id, const char *, bool, bool,
unsigned int); unsigned int);
static tree elaborate_reference (tree, Entity_Id, bool);
static tree gnat_to_gnu_component_type (Entity_Id, bool, bool); static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);
static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool, static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
bool *); bool *);
@ -557,11 +558,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
break; break;
} }
/* If we have an external constant that we are not defining, get the /* If we have a constant that we are not defining, get the expression it
expression that is was defined to represent. We may throw it away was defined to represent. This is necessary to avoid generating dumb
later if it is not a constant. But do not retrieve the expression elaboration code in simple cases, but we may throw it away later if it
if it is an allocator because the designated type might be dummy is not a constant. But do not retrieve it if it is an allocator since
at this point. */ the designated type might still be dummy at this point. */
if (!definition if (!definition
&& !No_Initialization (Declaration_Node (gnat_entity)) && !No_Initialization (Declaration_Node (gnat_entity))
&& Present (Expression (Declaration_Node (gnat_entity))) && Present (Expression (Declaration_Node (gnat_entity)))
@ -995,32 +996,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
before the call to "=". */ before the call to "=". */
if (TREE_CODE (inner) == TRUTH_ANDIF_EXPR) if (TREE_CODE (inner) == TRUTH_ANDIF_EXPR)
inner = TREE_OPERAND (inner, 1); inner = TREE_OPERAND (inner, 1);
if (TREE_CODE (inner) == CALL_EXPR if ((TREE_CODE (inner) == CALL_EXPR
|| TREE_CODE (inner) == NULL_EXPR && !call_is_atomic_load (inner))
|| TREE_CODE (inner) == CONSTRUCTOR || TREE_CODE (inner) == NULL_EXPR
|| TREE_CODE (inner) == CONSTRUCTOR
|| CONSTANT_CLASS_P (inner)) || CONSTANT_CLASS_P (inner))
; ;
/* Case 2: if the renaming entity need not be materialized, use /* Case 2: if the renaming entity need not be materialized, use
the stabilized renamed expression for the renaming. At the the elaborated renamed expression for the renaming. But this
global level, we can do this only if we know no SAVE_EXPRs means that the caller is responsible for evaluating the address
need be made, because otherwise the expression would be tied of the renaming at the correct spot in the definition case to
to a specific elaboration routine. */ instantiate the SAVE_EXPRs. */
else if (!Materialize_Entity (gnat_entity) else if (!Materialize_Entity (gnat_entity))
&& (!global_bindings_p ()
|| (staticp (gnu_expr)
&& !TREE_SIDE_EFFECTS (gnu_expr))))
{ {
gnu_decl = gnat_stabilize_reference (gnu_expr, true); gnu_decl
= elaborate_reference (gnu_expr, gnat_entity, definition);
/* ??? No DECL_EXPR is created so we need to mark /* No DECL_EXPR will be created so the expression needs to be
the expression manually lest it is shared. */ marked manually because it will likely be shared. */
if (global_bindings_p ()) if (global_bindings_p ())
MARK_VISITED (gnu_decl); MARK_VISITED (gnu_decl);
/* This assertion will fail if the renamed object isn't /* This assertion will fail if the renamed object isn't aligned
aligned enough as to make it possible to honor the enough as to make it possible to honor the alignment set on
alignment set on the renaming. */ the renaming. */
if (align) if (align)
{ {
unsigned int ralign = DECL_P (gnu_decl) unsigned int ralign = DECL_P (gnu_decl)
@ -1036,52 +1036,41 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
} }
/* Case 3: otherwise, make a constant pointer to the object we /* Case 3: otherwise, make a constant pointer to the object we
are to rename and attach the object to the pointer after it are renaming and attach the object to the pointer after it is
is stabilized. elaborated. The object will be referenced directly instead
of indirectly via the pointer to avoid aliasing problems with
From the proper scope, attached objects will be referenced non-addressable entities. The pointer is called a "renaming"
directly instead of indirectly via the pointer to avoid pointer in this case. Note that we also need to preserve the
subtle aliasing problems with non-addressable entities. volatility of the renamed object through the indirection. */
They have to be stable because we must not evaluate the
variables in the expression every time the renaming is used.
The pointer is called a "renaming" pointer in this case.
Note that we need to preserve the volatility of the renamed
object through the indirection. */
else else
{ {
if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type)) if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type))
gnu_type gnu_type
= change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE); = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
gnu_type = build_reference_type (gnu_type); gnu_type = build_reference_type (gnu_type);
inner_const_flag = TREE_READONLY (gnu_expr); used_by_ref = true;
const_flag = true; const_flag = true;
inner_const_flag = TREE_READONLY (gnu_expr);
gnu_size = NULL_TREE;
/* Stabilize and attach the expression to the pointer. renamed_obj
= elaborate_reference (gnu_expr, gnat_entity, definition);
Note that this might introduce SAVE_EXPRs and we don't /* If we are not defining the entity, the expression will not
check whether we are at the global level or not. This be attached through DECL_INITIAL so it needs to be marked
is fine since we are building a pointer initializer and manually because it will likely be shared. Likewise for a
neither the pointer nor the initializing expression can dereference as it will be folded by the ADDR_EXPR below. */
be accessed before the pointer elaboration has taken if ((!definition || TREE_CODE (renamed_obj) == INDIRECT_REF)
place in a correct program. && global_bindings_p ())
MARK_VISITED (renamed_obj);
These SAVE_EXPRs will be evaluated at the right place
by either the evaluation of the initializer for the
non-global case or the elaboration code for the global
case, and will be attached to the elaboration procedure
in the latter case. */
renamed_obj = gnat_stabilize_reference (gnu_expr, true);
if (type_annotate_only if (type_annotate_only
&& TREE_CODE (renamed_obj) == ERROR_MARK) && TREE_CODE (renamed_obj) == ERROR_MARK)
gnu_expr = NULL_TREE; gnu_expr = NULL_TREE;
else else
gnu_expr gnu_expr
= build_unary_op (ADDR_EXPR, gnu_type, renamed_obj); = build_unary_op (ADDR_EXPR, gnu_type, renamed_obj);
gnu_size = NULL_TREE;
used_by_ref = true;
} }
} }
@ -1173,9 +1162,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
save_gnu_tree (gnat_entity, NULL_TREE, false); save_gnu_tree (gnat_entity, NULL_TREE, false);
/* Ignore the size. It's either meaningless or was handled
above. */
gnu_size = NULL_TREE;
/* Convert the type of the object to a reference type that can /* Convert the type of the object to a reference type that can
alias everything as per 13.3(19). */ alias everything as per 13.3(19). */
gnu_type gnu_type
@ -1185,6 +1171,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
const_flag const_flag
= !Is_Public (gnat_entity) = !Is_Public (gnat_entity)
|| compile_time_known_address_p (gnat_expr); || compile_time_known_address_p (gnat_expr);
gnu_size = NULL_TREE;
/* If this is a deferred constant, the initializer is attached to /* If this is a deferred constant, the initializer is attached to
the full view. */ the full view. */
@ -1221,6 +1208,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
alias everything as per 13.3(19). */ alias everything as per 13.3(19). */
gnu_type gnu_type
= build_reference_type_for_mode (gnu_type, ptr_mode, true); = build_reference_type_for_mode (gnu_type, ptr_mode, true);
used_by_ref = true;
gnu_size = NULL_TREE; gnu_size = NULL_TREE;
/* No point in taking the address of an initializing expression /* No point in taking the address of an initializing expression
@ -1241,8 +1229,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
const_flag = true; const_flag = true;
} }
} }
used_by_ref = true;
} }
/* If we are at top level and this object is of variable size, /* If we are at top level and this object is of variable size,
@ -1269,8 +1255,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| static_p))) || static_p)))
{ {
gnu_type = build_reference_type (gnu_type); gnu_type = build_reference_type (gnu_type);
gnu_size = NULL_TREE;
used_by_ref = true; used_by_ref = true;
const_flag = true;
gnu_size = NULL_TREE;
/* In case this was a aliased object whose nominal subtype is /* In case this was a aliased object whose nominal subtype is
unconstrained, the pointer above will be a thin pointer and unconstrained, the pointer above will be a thin pointer and
@ -1313,13 +1300,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_expr gnu_expr
= build_allocator (gnu_alloc_type, gnu_expr, gnu_type, = build_allocator (gnu_alloc_type, gnu_expr, gnu_type,
Empty, Empty, gnat_entity, mutable_p); Empty, Empty, gnat_entity, mutable_p);
const_flag = true;
} }
else else
{ gnu_expr = NULL_TREE;
gnu_expr = NULL_TREE;
const_flag = false;
}
} }
/* If this object would go into the stack and has an alignment larger /* If this object would go into the stack and has an alignment larger
@ -1357,9 +1340,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
build_component_ref (gnu_new_var, NULL_TREE, build_component_ref (gnu_new_var, NULL_TREE,
TYPE_FIELDS (gnu_new_type), false)); TYPE_FIELDS (gnu_new_type), false));
gnu_size = NULL_TREE;
used_by_ref = true; used_by_ref = true;
const_flag = true; const_flag = true;
gnu_size = NULL_TREE;
} }
/* If this is an aliased object with an unconstrained nominal subtype, /* If this is an aliased object with an unconstrained nominal subtype,
@ -1389,10 +1372,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var); = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
TREE_CONSTANT (gnu_expr) = 1; TREE_CONSTANT (gnu_expr) = 1;
gnu_size = NULL_TREE;
used_by_ref = true; used_by_ref = true;
inner_const_flag = TREE_READONLY (gnu_unc_var);
const_flag = true; const_flag = true;
inner_const_flag = TREE_READONLY (gnu_unc_var);
gnu_size = NULL_TREE;
} }
gnu_type gnu_type
@ -1481,20 +1464,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
else if (kind == E_Loop_Parameter) else if (kind == E_Loop_Parameter)
DECL_LOOP_PARM_P (gnu_decl) = 1; DECL_LOOP_PARM_P (gnu_decl) = 1;
/* If this is a renaming pointer, attach the renamed object to it and /* If this is a renaming pointer, attach the renamed object to it. */
register it if we are at the global level and the renamed object
is a non-constant reference. */
if (renamed_obj) if (renamed_obj)
{ SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
if (global_bindings_p ()
&& !gnat_constant_reference_p (renamed_obj))
{
DECL_GLOBAL_NONCONSTANT_RENAMING_P (gnu_decl) = 1;
record_global_nonconstant_renaming (gnu_decl);
}
}
/* If this is a constant and we are defining it or it generates a real /* If this is a constant and we are defining it or it generates a real
symbol at the object level and we are referencing it, we may want symbol at the object level and we are referencing it, we may want
@ -6109,7 +6081,7 @@ prepend_attributes (struct attrib **attr_list, Entity_Id gnat_entity)
/* Given a GNAT tree GNAT_EXPR, for an expression which is a value within a /* Given a GNAT tree GNAT_EXPR, for an expression which is a value within a
type definition (either a bound or a discriminant value) for GNAT_ENTITY, type definition (either a bound or a discriminant value) for GNAT_ENTITY,
return the GCC tree to use for that expression. S is the suffix to use return the GCC tree to use for that expression. S is the suffix to use
if a variable needs to be created and DEFINITION is true if this is made if a variable needs to be created and DEFINITION is true if this is done
for a definition of GNAT_ENTITY. If NEED_VALUE is true, we need a result; for a definition of GNAT_ENTITY. If NEED_VALUE is true, we need a result;
otherwise, we are just elaborating the expression for side-effects. If otherwise, we are just elaborating the expression for side-effects. If
NEED_DEBUG is true, we need a variable for debugging purposes even if it NEED_DEBUG is true, we need a variable for debugging purposes even if it
@ -6250,6 +6222,50 @@ elaborate_expression_2 (tree gnu_expr, Entity_Id gnat_entity, const char *s,
need_debug), need_debug),
unit_align); unit_align);
} }
/* Structure to hold internal data for elaborate_reference. */
struct er_data
{
Entity_Id entity;
bool definition;
};
/* Wrapper function around elaborate_expression_1 for elaborate_reference. */
static tree
elaborate_reference_1 (tree ref, void *data, int n)
{
struct er_data *er = (struct er_data *)data;
char suffix[16];
/* This is what elaborate_expression_1 does if NEED_DEBUG is false. */
if (TREE_CONSTANT (ref))
return ref;
/* If this is a COMPONENT_REF of a fat pointer, elaborate the entire fat
pointer. This may be more efficient, but will also allow us to more
easily find the match for the PLACEHOLDER_EXPR. */
if (TREE_CODE (ref) == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (ref, 0))))
return build3 (COMPONENT_REF, TREE_TYPE (ref),
elaborate_reference_1 (TREE_OPERAND (ref, 0), data, n),
TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
sprintf (suffix, "EXP%d", n);
return
elaborate_expression_1 (ref, er->entity, suffix, er->definition, false);
}
/* Elaborate the reference REF to be used as renamed object for GNAT_ENTITY.
DEFINITION is true if this is done for a definition of GNAT_ENTITY. */
static tree
elaborate_reference (tree ref, Entity_Id gnat_entity, bool definition)
{
struct er_data er = { gnat_entity, definition };
return gnat_rewrite_reference (ref, elaborate_reference_1, &er);
}
/* Given a GNU tree and a GNAT list of choices, generate an expression to test /* Given a GNU tree and a GNAT list of choices, generate an expression to test
the value passed against the list of choices. */ the value passed against the list of choices. */

32
gcc/ada/gcc-interface/gigi.h
View File

@ -712,12 +712,6 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
const_flag, public_flag, extern_flag, \ const_flag, public_flag, extern_flag, \
static_flag, false, attr_list, gnat_node) static_flag, false, attr_list, gnat_node)
/* Record DECL as a global non-constant renaming. */
extern void record_global_nonconstant_renaming (tree decl);
/* Invalidate the global non-constant renamings. */
extern void invalidate_global_nonconstant_renamings (void);
/* Return a FIELD_DECL node. FIELD_NAME is the field's name, FIELD_TYPE is /* Return a FIELD_DECL node. FIELD_NAME is the field's name, FIELD_TYPE is
its type and RECORD_TYPE is the type of the enclosing record. If SIZE is its type and RECORD_TYPE is the type of the enclosing record. If SIZE is
nonzero, it is the specified size of the field. If POS is nonzero, it is nonzero, it is the specified size of the field. If POS is nonzero, it is
@ -968,15 +962,19 @@ extern tree gnat_protect_expr (tree exp);
force evaluation of everything. */ force evaluation of everything. */
extern tree gnat_stabilize_reference (tree ref, bool force); extern tree gnat_stabilize_reference (tree ref, bool force);
/* Rewrite reference REF and call FUNC on each expression within REF in the
process. DATA is passed unmodified to FUNC and N is bumped each time it
is passed to FUNC, so FUNC is guaranteed to see a given N only once per
reference to be rewritten. */
typedef tree (*rewrite_fn) (tree, void *, int);
extern tree gnat_rewrite_reference (tree ref, rewrite_fn func, void *data,
int n = 1);
/* This is equivalent to get_inner_reference in expr.c but it returns the /* This is equivalent to get_inner_reference in expr.c but it returns the
ultimate containing object only if the reference (lvalue) is constant, ultimate containing object only if the reference (lvalue) is constant,
i.e. if it doesn't depend on the context in which it is evaluated. */ i.e. if it doesn't depend on the context in which it is evaluated. */
extern tree get_inner_constant_reference (tree exp); extern tree get_inner_constant_reference (tree exp);
/* Return true if REF is a constant reference, i.e. a reference (lvalue) that
doesn't depend on the context in which it is evaluated. */
extern bool gnat_constant_reference_p (tree ref);
/* If EXPR is an expression that is invariant in the current function, in the /* If EXPR is an expression that is invariant in the current function, in the
sense that it can be evaluated anywhere in the function and any number of sense that it can be evaluated anywhere in the function and any number of
times, return EXPR or an equivalent expression. Otherwise return NULL. */ times, return EXPR or an equivalent expression. Otherwise return NULL. */
@ -1073,3 +1071,17 @@ ceil_pow2 (unsigned HOST_WIDE_INT x)
{ {
return (unsigned HOST_WIDE_INT) 1 << (floor_log2 (x - 1) + 1); return (unsigned HOST_WIDE_INT) 1 << (floor_log2 (x - 1) + 1);
} }
/* Return true if EXP, a CALL_EXPR, is an atomic load. */
static inline bool
call_is_atomic_load (tree exp)
{
tree fndecl = get_callee_fndecl (exp);
if (!(fndecl && DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL))
return false;
enum built_in_function code = DECL_FUNCTION_CODE (fndecl);
return BUILT_IN_ATOMIC_LOAD_N <= code && code <= BUILT_IN_ATOMIC_LOAD_16;
}

67
gcc/ada/gcc-interface/trans.c
View File

@ -1163,15 +1163,10 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
true, false))) true, false)))
gnu_result = DECL_INITIAL (gnu_result); gnu_result = DECL_INITIAL (gnu_result);
/* If it's a renaming pointer and not a global non-constant renaming or /* If it's a renaming pointer, get to the renamed object. */
we are at the global level, the we can reference the renamed object
directly, since it is either constant or has been protected against
multiple evaluations. */
if (TREE_CODE (gnu_result) == VAR_DECL if (TREE_CODE (gnu_result) == VAR_DECL
&& !DECL_LOOP_PARM_P (gnu_result) && !DECL_LOOP_PARM_P (gnu_result)
&& DECL_RENAMED_OBJECT (gnu_result) && DECL_RENAMED_OBJECT (gnu_result))
&& (!DECL_GLOBAL_NONCONSTANT_RENAMING_P (gnu_result)
|| global_bindings_p ()))
gnu_result = DECL_RENAMED_OBJECT (gnu_result); gnu_result = DECL_RENAMED_OBJECT (gnu_result);
/* Otherwise, do the final dereference. */ /* Otherwise, do the final dereference. */
@ -3975,16 +3970,32 @@ outer_atomic_access_required_p (Node_Id gnat_node)
{ {
gnat_node = gnat_strip_type_conversion (gnat_node); gnat_node = gnat_strip_type_conversion (gnat_node);
while (Nkind (gnat_node) == N_Indexed_Component while (true)
|| Nkind (gnat_node) == N_Selected_Component
|| Nkind (gnat_node) == N_Slice)
{ {
gnat_node = gnat_strip_type_conversion (Prefix (gnat_node)); switch (Nkind (gnat_node))
if (node_has_volatile_full_access (gnat_node)) {
return true; case N_Identifier:
case N_Expanded_Name:
if (No (Renamed_Object (Entity (gnat_node))))
return false;
gnat_node
= gnat_strip_type_conversion (Renamed_Object (Entity (gnat_node)));
break;
case N_Indexed_Component:
case N_Selected_Component:
case N_Slice:
gnat_node = gnat_strip_type_conversion (Prefix (gnat_node));
if (node_has_volatile_full_access (gnat_node))
return true;
break;
default:
return false;
}
} }
return false; gcc_unreachable ();
} }
/* Return true if GNAT_NODE requires atomic access and set SYNC according to /* Return true if GNAT_NODE requires atomic access and set SYNC according to
@ -5290,11 +5301,6 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
info->gnat_node = gnat_node; info->gnat_node = gnat_node;
elab_info_list = info; elab_info_list = info;
/* Invalidate the global non-constant renamings. This is necessary because
stabilization of the renamed entities may create SAVE_EXPRs which have
been tied to a specific elaboration routine just above. */
invalidate_global_nonconstant_renamings ();
/* Force the processing for all nodes that remain in the queue. */ /* Force the processing for all nodes that remain in the queue. */
process_deferred_decl_context (true); process_deferred_decl_context (true);
} }
@ -5838,8 +5844,7 @@ gnat_to_gnu (Node_Id gnat_node)
tree gnu_temp tree gnu_temp
= gnat_to_gnu_entity (gnat_temp, = gnat_to_gnu_entity (gnat_temp,
gnat_to_gnu (Renamed_Object (gnat_temp)), 1); gnat_to_gnu (Renamed_Object (gnat_temp)), 1);
/* We need to make sure that the side-effects of the renamed object /* See case 2 of renaming in gnat_to_gnu_entity. */
are evaluated at this point, so we evaluate its address. */
if (TREE_SIDE_EFFECTS (gnu_temp)) if (TREE_SIDE_EFFECTS (gnu_temp))
gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_temp); gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_temp);
} }
@ -7933,6 +7938,26 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
return GS_ALL_DONE; return GS_ALL_DONE;
} }
/* Replace atomic loads with their first argument. That's necessary
because the gimplifier would create a temporary otherwise. */
if (TREE_SIDE_EFFECTS (op))
while (handled_component_p (op) || CONVERT_EXPR_P (op))
{
tree inner = TREE_OPERAND (op, 0);
if (TREE_CODE (inner) == CALL_EXPR && call_is_atomic_load (inner))
{
tree t = CALL_EXPR_ARG (inner, 0);
if (TREE_CODE (t) == NOP_EXPR)
t = TREE_OPERAND (t, 0);
if (TREE_CODE (t) == ADDR_EXPR)
TREE_OPERAND (op, 0) = TREE_OPERAND (t, 0);
else
TREE_OPERAND (op, 0) = build_fold_indirect_ref (t);
}
else
op = inner;
}
return GS_UNHANDLED; return GS_UNHANDLED;
case VIEW_CONVERT_EXPR: case VIEW_CONVERT_EXPR:

33
gcc/ada/gcc-interface/utils.c
View File

@ -233,9 +233,6 @@ static GTY(()) vec<tree, va_gc> *global_decls;
/* An array of builtin function declarations. */ /* An array of builtin function declarations. */
static GTY(()) vec<tree, va_gc> *builtin_decls; static GTY(()) vec<tree, va_gc> *builtin_decls;
/* An array of global non-constant renamings. */
static GTY(()) vec<tree, va_gc> *global_nonconstant_renamings;
/* A chain of unused BLOCK nodes. */ /* A chain of unused BLOCK nodes. */
static GTY((deletable)) tree free_block_chain; static GTY((deletable)) tree free_block_chain;
@ -322,9 +319,6 @@ destroy_gnat_utils (void)
/* Destroy the hash table of padded types. */ /* Destroy the hash table of padded types. */
pad_type_hash_table->empty (); pad_type_hash_table->empty ();
pad_type_hash_table = NULL; pad_type_hash_table = NULL;
/* Invalidate the global non-constant renamings. */
invalidate_global_nonconstant_renamings ();
} }
/* GNAT_ENTITY is a GNAT tree node for an entity. Associate GNU_DECL, a GCC /* GNAT_ENTITY is a GNAT tree node for an entity. Associate GNU_DECL, a GCC
@ -2717,33 +2711,6 @@ process_attributes (tree *node, struct attrib **attr_list, bool in_place,
*attr_list = NULL; *attr_list = NULL;
} }
/* Record DECL as a global non-constant renaming. */
void
record_global_nonconstant_renaming (tree decl)
{
gcc_assert (!DECL_LOOP_PARM_P (decl) && DECL_RENAMED_OBJECT (decl));
vec_safe_push (global_nonconstant_renamings, decl);
}
/* Invalidate the global non-constant renamings, lest their renamed object
contains SAVE_EXPRs tied to an elaboration routine. */
void
invalidate_global_nonconstant_renamings (void)
{
unsigned int i;
tree iter;
if (global_nonconstant_renamings == NULL)
return;
FOR_EACH_VEC_ELT (*global_nonconstant_renamings, i, iter)
SET_DECL_RENAMED_OBJECT (iter, NULL_TREE);
vec_free (global_nonconstant_renamings);
}
/* Return true if VALUE is a known to be a multiple of FACTOR, which must be /* Return true if VALUE is a known to be a multiple of FACTOR, which must be
a power of 2. */ a power of 2. */

82
gcc/ada/gcc-interface/utils2.c
View File

@ -738,27 +738,15 @@ build_atomic_store (tree dest, tree src, bool sync)
return build_call_expr (t, 3, addr, src, mem_model); return build_call_expr (t, 3, addr, src, mem_model);
} }
/* Return true if EXP, a CALL_EXPR, is an atomic load. */
static bool
call_is_atomic_load (tree exp)
{
tree fndecl = get_callee_fndecl (exp);
if (!(fndecl && DECL_BUILT_IN_CLASS (fndecl) == BUILT_IN_NORMAL))
return false;
enum built_in_function code = DECL_FUNCTION_CODE (fndecl);
return BUILT_IN_ATOMIC_LOAD_N <= code && code <= BUILT_IN_ATOMIC_LOAD_16;
}
/* Build a load-modify-store sequence from SRC to DEST. GNAT_NODE is used for /* Build a load-modify-store sequence from SRC to DEST. GNAT_NODE is used for
the location of the sequence. Note that, even if the load and the store are the location of the sequence. Note that, even though the load and the store
both atomic, the sequence itself is not atomic. */ are both atomic, the sequence itself is not atomic. */
tree tree
build_load_modify_store (tree dest, tree src, Node_Id gnat_node) build_load_modify_store (tree dest, tree src, Node_Id gnat_node)
{ {
/* We will be modifying DEST below so we build a copy. */
dest = copy_node (dest);
tree ref = dest; tree ref = dest;
while (handled_component_p (ref)) while (handled_component_p (ref))
@ -812,6 +800,7 @@ build_load_modify_store (tree dest, tree src, Node_Id gnat_node)
} }
} }
TREE_OPERAND (ref, 0) = copy_node (TREE_OPERAND (ref, 0));
ref = TREE_OPERAND (ref, 0); ref = TREE_OPERAND (ref, 0);
} }
@ -2674,8 +2663,9 @@ gnat_protect_expr (tree exp)
argument to force evaluation of everything. */ argument to force evaluation of everything. */
static tree static tree
gnat_stabilize_reference_1 (tree e, bool force) gnat_stabilize_reference_1 (tree e, void *data, int n)
{ {
const bool force = *(bool *)data;
enum tree_code code = TREE_CODE (e); enum tree_code code = TREE_CODE (e);
tree type = TREE_TYPE (e); tree type = TREE_TYPE (e);
tree result; tree result;
@ -2698,7 +2688,7 @@ gnat_stabilize_reference_1 (tree e, bool force)
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0)))) && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
result result
= build3 (code, type, = build3 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force), gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n),
TREE_OPERAND (e, 1), TREE_OPERAND (e, 2)); TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
/* If the expression has side-effects, then encase it in a SAVE_EXPR /* If the expression has side-effects, then encase it in a SAVE_EXPR
so that it will only be evaluated once. */ so that it will only be evaluated once. */
@ -2714,15 +2704,15 @@ gnat_stabilize_reference_1 (tree e, bool force)
/* Recursively stabilize each operand. */ /* Recursively stabilize each operand. */
result result
= build2 (code, type, = build2 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force), gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n),
gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force)); gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), data, n));
break; break;
case tcc_unary: case tcc_unary:
/* Recursively stabilize each operand. */ /* Recursively stabilize each operand. */
result result
= build1 (code, type, = build1 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force)); gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), data, n));
break; break;
default: default:
@ -2742,6 +2732,17 @@ gnat_stabilize_reference_1 (tree e, bool force)
tree tree
gnat_stabilize_reference (tree ref, bool force) gnat_stabilize_reference (tree ref, bool force)
{
return gnat_rewrite_reference (ref, gnat_stabilize_reference_1, &force);
}
/* Rewrite reference REF and call FUNC on each expression within REF in the
process. DATA is passed unmodified to FUNC and N is bumped each time it
is passed to FUNC, so FUNC is guaranteed to see a given N only once per
reference to be rewritten. */
tree
gnat_rewrite_reference (tree ref, rewrite_fn func, void *data, int n)
{ {
tree type = TREE_TYPE (ref); tree type = TREE_TYPE (ref);
enum tree_code code = TREE_CODE (ref); enum tree_code code = TREE_CODE (ref);
@ -2762,25 +2763,26 @@ gnat_stabilize_reference (tree ref, bool force)
case VIEW_CONVERT_EXPR: case VIEW_CONVERT_EXPR:
result result
= build1 (code, type, = build1 (code, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force)); gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data,
n));
break; break;
case INDIRECT_REF: case INDIRECT_REF:
case UNCONSTRAINED_ARRAY_REF: case UNCONSTRAINED_ARRAY_REF:
result = build1 (code, type, result = build1 (code, type, func (TREE_OPERAND (ref, 0), data, n));
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
force));
break; break;
case COMPONENT_REF: case COMPONENT_REF:
result = build3 (COMPONENT_REF, type, result = build3 (COMPONENT_REF, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
data, n),
TREE_OPERAND (ref, 1), NULL_TREE); TREE_OPERAND (ref, 1), NULL_TREE);
break; break;
case BIT_FIELD_REF: case BIT_FIELD_REF:
result = build3 (BIT_FIELD_REF, type, result = build3 (BIT_FIELD_REF, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), gnat_rewrite_reference (TREE_OPERAND (ref, 0), func,
data, n),
TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2)); TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2));
break; break;
@ -2788,8 +2790,9 @@ gnat_stabilize_reference (tree ref, bool force)
case ARRAY_RANGE_REF: case ARRAY_RANGE_REF:
result result
= build4 (code, type, = build4 (code, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), gnat_rewrite_reference (TREE_OPERAND (ref, 0), func, data,
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1), force), n + 1),
func (TREE_OPERAND (ref, 1), data, n),
TREE_OPERAND (ref, 2), TREE_OPERAND (ref, 3)); TREE_OPERAND (ref, 2), TREE_OPERAND (ref, 3));
break; break;
@ -2804,9 +2807,10 @@ gnat_stabilize_reference (tree ref, bool force)
t = TREE_OPERAND (t, 0); t = TREE_OPERAND (t, 0);
if (TREE_CODE (t) == ADDR_EXPR) if (TREE_CODE (t) == ADDR_EXPR)
t = build1 (ADDR_EXPR, TREE_TYPE (t), t = build1 (ADDR_EXPR, TREE_TYPE (t),
gnat_stabilize_reference (TREE_OPERAND (t, 0), force)); gnat_rewrite_reference (TREE_OPERAND (t, 0), func, data,
n));
else else
t = gnat_stabilize_reference_1 (t, force); t = func (t, data, n);
t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t); t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t);
result = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2, result = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2,
@ -2895,22 +2899,6 @@ done:
return exp; return exp;
} }
/* Return true if REF is a constant reference, i.e. a reference (lvalue) that
doesn't depend on the context in which it is evaluated. */
bool
gnat_constant_reference_p (tree ref)
{
if (handled_component_p (ref))
{
ref = get_inner_constant_reference (ref);
if (!ref)
return false;
}
return DECL_P (ref);
}
/* If EXPR is an expression that is invariant in the current function, in the /* If EXPR is an expression that is invariant in the current function, in the
sense that it can be evaluated anywhere in the function and any number of sense that it can be evaluated anywhere in the function and any number of
times, return EXPR or an equivalent expression. Otherwise return NULL. */ times, return EXPR or an equivalent expression. Otherwise return NULL. */