Commit b1b2b511 by Eric Botcazou Committed by Eric Botcazou

trans.c (gnat_to_gnu): Fix formatting.

	* gcc-interface/trans.c (gnat_to_gnu) <N_Aggregate>: Fix formatting.
	<N_Allocator>: Use properly typed constants.
	(extract_values): Move around.
	(pos_to_constructor): Minor tweaks.
	(Sloc_to_locus): Fix formatting.
	* gcc-interface/utils.c (process_deferred_decl_context): Minor tweaks.
	* gcc-interface/gigi.h (MARK_VISITED): Remove blank line.
	(Gigi_Equivalent_Type): Adjust head comment.
	* gcc-interface/decl.c (Gigi_Equivalent_Type): Likewise.

From-SVN: r248050
parent 04bc3c93
2017-05-15 Eric Botcazou <ebotcazou@adacore.com> 2017-05-15 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (gnat_to_gnu) <N_Aggregate>: Fix formatting.
<N_Allocator>: Use properly typed constants.
(extract_values): Move around.
(pos_to_constructor): Minor tweaks.
(Sloc_to_locus): Fix formatting.
* gcc-interface/utils.c (process_deferred_decl_context): Minor tweaks.
* gcc-interface/gigi.h (MARK_VISITED): Remove blank line.
(Gigi_Equivalent_Type): Adjust head comment.
* gcc-interface/decl.c (Gigi_Equivalent_Type): Likewise.
2017-05-15 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: When there * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: When there
is a representation clause on an extension, propagate the alignment of is a representation clause on an extension, propagate the alignment of
the parent type only if the platform requires strict alignment. the parent type only if the platform requires strict alignment.
......
...@@ -3270,12 +3270,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -3270,12 +3270,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
} }
/* If we have a derived untagged type that renames discriminants in /* If we have a derived untagged type that renames discriminants in
the root type, the (stored) discriminants are just a copy of the the parent type, the (stored) discriminants are just a copy of the
discriminants of the root type. This means that any constraints discriminants of the parent type. This means that any constraints
added by the renaming in the derivation are disregarded as far added by the renaming in the derivation are disregarded as far as
as the layout of the derived type is concerned. To rescue them, the layout of the derived type is concerned. To rescue them, we
we change the type of the (stored) discriminants to a subtype change the type of the (stored) discriminants to a subtype with
with the bounds of the type of the visible discriminants. */ the bounds of the type of the visible discriminants. */
if (has_discr if (has_discr
&& !is_extension && !is_extension
&& Stored_Constraint (gnat_entity) != No_Elist) && Stored_Constraint (gnat_entity) != No_Elist)
...@@ -4967,12 +4967,10 @@ finalize_from_limited_with (void) ...@@ -4967,12 +4967,10 @@ finalize_from_limited_with (void)
} }
} }
/* Return the equivalent type to be used for GNAT_ENTITY, if it's a /* Return the equivalent type to be used for GNAT_ENTITY, if it's a kind
kind of type (such E_Task_Type) that has a different type which Gigi of type (such E_Task_Type) that has a different type which Gigi uses
uses for its representation. If the type does not have a special type for its representation. If the type does not have a special type for
for its representation, return GNAT_ENTITY. If a type is supposed to its representation, return GNAT_ENTITY. */
exist, but does not, abort unless annotating types, in which case
return Empty. If GNAT_ENTITY is Empty, return Empty. */
Entity_Id Entity_Id
Gigi_Equivalent_Type (Entity_Id gnat_entity) Gigi_Equivalent_Type (Entity_Id gnat_entity)
......
...@@ -88,7 +88,6 @@ extern void mark_visited (tree t); ...@@ -88,7 +88,6 @@ extern void mark_visited (tree t);
/* This macro calls the above function but short-circuits the common /* This macro calls the above function but short-circuits the common
case of a constant to save time and also checks for NULL. */ case of a constant to save time and also checks for NULL. */
#define MARK_VISITED(EXP) \ #define MARK_VISITED(EXP) \
do { \ do { \
if((EXP) && !CONSTANT_CLASS_P (EXP)) \ if((EXP) && !CONSTANT_CLASS_P (EXP)) \
...@@ -98,12 +97,10 @@ do { \ ...@@ -98,12 +97,10 @@ do { \
/* Finalize the processing of From_Limited_With incomplete types. */ /* Finalize the processing of From_Limited_With incomplete types. */
extern void finalize_from_limited_with (void); extern void finalize_from_limited_with (void);
/* Return the equivalent type to be used for GNAT_ENTITY, if it's a /* Return the equivalent type to be used for GNAT_ENTITY, if it's a kind
kind of type (such E_Task_Type) that has a different type which Gigi of type (such E_Task_Type) that has a different type which Gigi uses
uses for its representation. If the type does not have a special type for its representation. If the type does not have a special type for
for its representation, return GNAT_ENTITY. If a type is supposed to its representation, return GNAT_ENTITY. */
exist, but does not, abort unless annotating types, in which case
return Empty. If GNAT_ENTITY is Empty, return Empty. */
extern Entity_Id Gigi_Equivalent_Type (Entity_Id gnat_entity); extern Entity_Id Gigi_Equivalent_Type (Entity_Id gnat_entity);
/* Given GNAT_ENTITY, elaborate all expressions that are required to /* Given GNAT_ENTITY, elaborate all expressions that are required to
......
...@@ -237,7 +237,6 @@ static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id); ...@@ -237,7 +237,6 @@ static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id); static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
static bool addressable_p (tree, tree); static bool addressable_p (tree, tree);
static tree assoc_to_constructor (Entity_Id, Node_Id, tree); static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
static tree extract_values (tree, tree);
static tree pos_to_constructor (Node_Id, tree, Entity_Id); static tree pos_to_constructor (Node_Id, tree, Entity_Id);
static void validate_unchecked_conversion (Node_Id); static void validate_unchecked_conversion (Node_Id);
static tree maybe_implicit_deref (tree); static tree maybe_implicit_deref (tree);
...@@ -6497,8 +6496,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -6497,8 +6496,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_aggr_type = TYPE_REPRESENTATIVE_ARRAY (gnu_result_type); gnu_aggr_type = TYPE_REPRESENTATIVE_ARRAY (gnu_result_type);
if (Null_Record_Present (gnat_node)) if (Null_Record_Present (gnat_node))
gnu_result = gnat_build_constructor (gnu_aggr_type, gnu_result = gnat_build_constructor (gnu_aggr_type, NULL);
NULL);
else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE
|| TREE_CODE (gnu_aggr_type) == UNION_TYPE) || TREE_CODE (gnu_aggr_type) == UNION_TYPE)
...@@ -6858,7 +6856,7 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -6858,7 +6856,7 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Allocator: case N_Allocator:
{ {
tree gnu_init = 0; tree gnu_init = NULL_TREE;
tree gnu_type; tree gnu_type;
bool ignore_init_type = false; bool ignore_init_type = false;
...@@ -9658,6 +9656,55 @@ process_type (Entity_Id gnat_entity) ...@@ -9658,6 +9656,55 @@ process_type (Entity_Id gnat_entity)
} }
} }
/* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting of the
associations that are from RECORD_TYPE. If we see an internal record, make
a recursive call to fill it in as well. */
static tree
extract_values (tree values, tree record_type)
{
vec<constructor_elt, va_gc> *v = NULL;
tree field;
for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field))
{
tree tem, value = NULL_TREE;
/* _Parent is an internal field, but may have values in the aggregate,
so check for values first. */
if ((tem = purpose_member (field, values)))
{
value = TREE_VALUE (tem);
TREE_ADDRESSABLE (tem) = 1;
}
else if (DECL_INTERNAL_P (field))
{
value = extract_values (values, TREE_TYPE (field));
if (TREE_CODE (value) == CONSTRUCTOR
&& vec_safe_is_empty (CONSTRUCTOR_ELTS (value)))
value = NULL_TREE;
}
else
/* If we have a record subtype, the names will match, but not the
actual FIELD_DECLs. */
for (tem = values; tem; tem = TREE_CHAIN (tem))
if (DECL_NAME (TREE_PURPOSE (tem)) == DECL_NAME (field))
{
value = convert (TREE_TYPE (field), TREE_VALUE (tem));
TREE_ADDRESSABLE (tem) = 1;
}
if (!value)
continue;
CONSTRUCTOR_APPEND_ELT (v, field, value);
}
return gnat_build_constructor (record_type, v);
}
/* GNAT_ENTITY is the type of the resulting constructor, GNAT_ASSOC is the /* GNAT_ENTITY is the type of the resulting constructor, GNAT_ASSOC is the
front of the Component_Associations of an N_Aggregate and GNU_TYPE is the front of the Component_Associations of an N_Aggregate and GNU_TYPE is the
GCC type of the corresponding record type. Return the CONSTRUCTOR. */ GCC type of the corresponding record type. Return the CONSTRUCTOR. */
...@@ -9728,11 +9775,12 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, ...@@ -9728,11 +9775,12 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
Entity_Id gnat_component_type) Entity_Id gnat_component_type)
{ {
tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type)); tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
tree gnu_expr;
vec<constructor_elt, va_gc> *gnu_expr_vec = NULL; vec<constructor_elt, va_gc> *gnu_expr_vec = NULL;
for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr)) for (; Present (gnat_expr); gnat_expr = Next (gnat_expr))
{ {
tree gnu_expr;
/* If the expression is itself an array aggregate then first build the /* If the expression is itself an array aggregate then first build the
innermost constructor if it is part of our array (multi-dimensional innermost constructor if it is part of our array (multi-dimensional
case). */ case). */
...@@ -9763,55 +9811,6 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type, ...@@ -9763,55 +9811,6 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
return gnat_build_constructor (gnu_array_type, gnu_expr_vec); return gnat_build_constructor (gnu_array_type, gnu_expr_vec);
} }
/* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting of the
associations that are from RECORD_TYPE. If we see an internal record, make
a recursive call to fill it in as well. */
static tree
extract_values (tree values, tree record_type)
{
tree field, tem;
vec<constructor_elt, va_gc> *v = NULL;
for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field))
{
tree value = 0;
/* _Parent is an internal field, but may have values in the aggregate,
so check for values first. */
if ((tem = purpose_member (field, values)))
{
value = TREE_VALUE (tem);
TREE_ADDRESSABLE (tem) = 1;
}
else if (DECL_INTERNAL_P (field))
{
value = extract_values (values, TREE_TYPE (field));
if (TREE_CODE (value) == CONSTRUCTOR
&& vec_safe_is_empty (CONSTRUCTOR_ELTS (value)))
value = 0;
}
else
/* If we have a record subtype, the names will match, but not the
actual FIELD_DECLs. */
for (tem = values; tem; tem = TREE_CHAIN (tem))
if (DECL_NAME (TREE_PURPOSE (tem)) == DECL_NAME (field))
{
value = convert (TREE_TYPE (field), TREE_VALUE (tem));
TREE_ADDRESSABLE (tem) = 1;
}
if (!value)
continue;
CONSTRUCTOR_APPEND_ELT (v, field, value);
}
return gnat_build_constructor (record_type, v);
}
/* Process a N_Validate_Unchecked_Conversion node. */ /* Process a N_Validate_Unchecked_Conversion node. */
static void static void
...@@ -9915,8 +9914,8 @@ Sloc_to_locus (Source_Ptr Sloc, location_t *locus, bool clear_column) ...@@ -9915,8 +9914,8 @@ Sloc_to_locus (Source_Ptr Sloc, location_t *locus, bool clear_column)
line = 1; line = 1;
/* Translate the location. */ /* Translate the location. */
*locus = linemap_position_for_line_and_column (line_table, map, *locus
line, column); = linemap_position_for_line_and_column (line_table, map, line, column);
return true; return true;
} }
......
...@@ -2992,7 +2992,7 @@ process_deferred_decl_context (bool force) ...@@ -2992,7 +2992,7 @@ process_deferred_decl_context (bool force)
struct deferred_decl_context_node **it = &deferred_decl_context_queue; struct deferred_decl_context_node **it = &deferred_decl_context_queue;
struct deferred_decl_context_node *node; struct deferred_decl_context_node *node;
while (*it != NULL) while (*it)
{ {
bool processed = false; bool processed = false;
tree context = NULL_TREE; tree context = NULL_TREE;
...@@ -3058,7 +3058,6 @@ process_deferred_decl_context (bool force) ...@@ -3058,7 +3058,6 @@ process_deferred_decl_context (bool force)
} }
} }
/* Return VALUE scaled by the biggest power-of-2 factor of EXPR. */ /* Return VALUE scaled by the biggest power-of-2 factor of EXPR. */
static unsigned int static unsigned int
......
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