Commit 7c20033e by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Tidy flow of control.

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Subtype>: Tidy
	flow of control.
	Avoid useless work when processing the Treat_As_Volatile flag.

From-SVN: r151535
parent d5df7223
2009-09-08 Eric Botcazou <ebotcazou@adacore.com> 2009-09-08 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Subtype>: Tidy
flow of control.
Avoid useless work when processing the Treat_As_Volatile flag.
2009-09-08 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/targtyps.c: Reorder include directives. * gcc-interface/targtyps.c: Reorder include directives.
2009-09-07 Laurent GUERBY <laurent@guerby.net> 2009-09-07 Laurent GUERBY <laurent@guerby.net>
......
...@@ -2093,7 +2093,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2093,7 +2093,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* This is the actual data type for array variables. Multidimensional /* This is the actual data type for array variables. Multidimensional
arrays are implemented as arrays of arrays. Note that arrays which arrays are implemented as arrays of arrays. Note that arrays which
have sparse enumeration subtypes as index components create sparse have sparse enumeration subtypes as index components create sparse
arrays, which is obviously space inefficient but so much easier to arrays, which is obviously space inefficient but so much easier to
code for now. code for now.
...@@ -2105,7 +2105,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2105,7 +2105,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type = gnat_to_gnu_type (Etype (gnat_entity)); gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
if (!Is_Constrained (gnat_entity)) if (!Is_Constrained (gnat_entity))
break; ;
else else
{ {
Entity_Id gnat_index, gnat_base_index; Entity_Id gnat_index, gnat_base_index;
...@@ -2538,105 +2538,104 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2538,105 +2538,104 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Set our alias set to that of our base type. This gives all /* Set our alias set to that of our base type. This gives all
array subtypes the same alias set. */ array subtypes the same alias set. */
relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY); relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY);
}
/* If this is a packed type, make this type the same as the packed
array type, but do some adjusting in the type first. */
if (Present (Packed_Array_Type (gnat_entity)))
{
Entity_Id gnat_index;
tree gnu_inner_type;
/* First finish the type we had been making so that we output /* If this is a packed type, make this type the same as the packed
debugging information for it. */ array type, but do some adjusting in the type first. */
gnu_type if (Present (Packed_Array_Type (gnat_entity)))
= build_qualified_type (gnu_type,
(TYPE_QUALS (gnu_type)
| (TYPE_QUAL_VOLATILE
* Treat_As_Volatile (gnat_entity))));
/* Make it artificial only if the base type was artificial as well.
That's sort of "morally" true and will make it possible for the
debugger to look it up by name in DWARF, which is necessary in
order to decode the packed array type. */
gnu_decl
= create_type_decl (gnu_entity_name, gnu_type, attr_list,
!Comes_From_Source (gnat_entity)
&& !Comes_From_Source (Etype (gnat_entity)),
debug_info_p, gnat_entity);
/* Save it as our equivalent in case the call below elaborates
this type again. */
save_gnu_tree (gnat_entity, gnu_decl, false);
gnu_decl = gnat_to_gnu_entity (Packed_Array_Type (gnat_entity),
NULL_TREE, 0);
this_made_decl = true;
gnu_type = TREE_TYPE (gnu_decl);
save_gnu_tree (gnat_entity, NULL_TREE, false);
gnu_inner_type = gnu_type;
while (TREE_CODE (gnu_inner_type) == RECORD_TYPE
&& (TYPE_JUSTIFIED_MODULAR_P (gnu_inner_type)
|| TYPE_IS_PADDING_P (gnu_inner_type)))
gnu_inner_type = TREE_TYPE (TYPE_FIELDS (gnu_inner_type));
/* We need to attach the index type to the type we just made so
that the actual bounds can later be put into a template. */
if ((TREE_CODE (gnu_inner_type) == ARRAY_TYPE
&& !TYPE_ACTUAL_BOUNDS (gnu_inner_type))
|| (TREE_CODE (gnu_inner_type) == INTEGER_TYPE
&& !TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner_type)))
{ {
if (TREE_CODE (gnu_inner_type) == INTEGER_TYPE) Entity_Id gnat_index;
tree gnu_inner;
/* First finish the type we had been making so that we output
debugging information for it. */
if (Treat_As_Volatile (gnat_entity))
gnu_type
= build_qualified_type (gnu_type,
TYPE_QUALS (gnu_type)
| TYPE_QUAL_VOLATILE);
/* Make it artificial only if the base type was artificial too.
That's sort of "morally" true and will make it possible for
the debugger to look it up by name in DWARF, which is needed
in order to decode the packed array type. */
gnu_decl
= create_type_decl (gnu_entity_name, gnu_type, attr_list,
!Comes_From_Source (Etype (gnat_entity))
&& !Comes_From_Source (gnat_entity),
debug_info_p, gnat_entity);
/* Save it as our equivalent in case the call below elaborates
this type again. */
save_gnu_tree (gnat_entity, gnu_decl, false);
gnu_decl = gnat_to_gnu_entity (Packed_Array_Type (gnat_entity),
NULL_TREE, 0);
this_made_decl = true;
gnu_type = TREE_TYPE (gnu_decl);
save_gnu_tree (gnat_entity, NULL_TREE, false);
gnu_inner = gnu_type;
while (TREE_CODE (gnu_inner) == RECORD_TYPE
&& (TYPE_JUSTIFIED_MODULAR_P (gnu_inner)
|| TYPE_IS_PADDING_P (gnu_inner)))
gnu_inner = TREE_TYPE (TYPE_FIELDS (gnu_inner));
/* We need to attach the index type to the type we just made so
that the actual bounds can later be put into a template. */
if ((TREE_CODE (gnu_inner) == ARRAY_TYPE
&& !TYPE_ACTUAL_BOUNDS (gnu_inner))
|| (TREE_CODE (gnu_inner) == INTEGER_TYPE
&& !TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner)))
{ {
/* The TYPE_ACTUAL_BOUNDS field is overloaded with the if (TREE_CODE (gnu_inner) == INTEGER_TYPE)
TYPE_MODULUS for modular types so we make an extra
subtype if necessary. */
if (TYPE_MODULAR_P (gnu_inner_type))
{ {
tree gnu_subtype /* The TYPE_ACTUAL_BOUNDS field is overloaded with the
= make_unsigned_type (TYPE_PRECISION (gnu_inner_type)); TYPE_MODULUS for modular types so we make an extra
TREE_TYPE (gnu_subtype) = gnu_inner_type; subtype if necessary. */
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1; if (TYPE_MODULAR_P (gnu_inner))
SET_TYPE_RM_MIN_VALUE (gnu_subtype, {
TYPE_MIN_VALUE (gnu_inner_type)); tree gnu_subtype
SET_TYPE_RM_MAX_VALUE (gnu_subtype, = make_unsigned_type (TYPE_PRECISION (gnu_inner));
TYPE_MAX_VALUE (gnu_inner_type)); TREE_TYPE (gnu_subtype) = gnu_inner;
gnu_inner_type = gnu_subtype; TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
} SET_TYPE_RM_MIN_VALUE (gnu_subtype,
TYPE_MIN_VALUE (gnu_inner));
TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner_type) = 1; SET_TYPE_RM_MAX_VALUE (gnu_subtype,
TYPE_MAX_VALUE (gnu_inner));
gnu_inner = gnu_subtype;
}
TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner) = 1;
#ifdef ENABLE_CHECKING #ifdef ENABLE_CHECKING
/* Check for other cases of overloading. */ /* Check for other cases of overloading. */
gcc_assert (!TYPE_ACTUAL_BOUNDS (gnu_inner_type)); gcc_assert (!TYPE_ACTUAL_BOUNDS (gnu_inner));
#endif #endif
} }
for (gnat_index = First_Index (gnat_entity); for (gnat_index = First_Index (gnat_entity);
Present (gnat_index); gnat_index = Next_Index (gnat_index)) Present (gnat_index);
SET_TYPE_ACTUAL_BOUNDS gnat_index = Next_Index (gnat_index))
(gnu_inner_type, SET_TYPE_ACTUAL_BOUNDS
tree_cons (NULL_TREE, (gnu_inner,
get_unpadded_type (Etype (gnat_index)), tree_cons (NULL_TREE,
TYPE_ACTUAL_BOUNDS (gnu_inner_type))); get_unpadded_type (Etype (gnat_index)),
TYPE_ACTUAL_BOUNDS (gnu_inner)));
if (Convention (gnat_entity) != Convention_Fortran)
SET_TYPE_ACTUAL_BOUNDS if (Convention (gnat_entity) != Convention_Fortran)
(gnu_inner_type, SET_TYPE_ACTUAL_BOUNDS
nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner_type))); (gnu_inner, nreverse (TYPE_ACTUAL_BOUNDS (gnu_inner)));
if (TREE_CODE (gnu_type) == RECORD_TYPE if (TREE_CODE (gnu_type) == RECORD_TYPE
&& TYPE_JUSTIFIED_MODULAR_P (gnu_type)) && TYPE_JUSTIFIED_MODULAR_P (gnu_type))
TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner_type; TREE_TYPE (TYPE_FIELDS (gnu_type)) = gnu_inner;
}
} }
}
/* Abort if packed array with no packed array type field set. */
else
gcc_assert (!Is_Packed (gnat_entity));
else
/* Abort if packed array with no Packed_Array_Type field set. */
gcc_assert (!Is_Packed (gnat_entity));
}
break; break;
case E_String_Literal_Subtype: case E_String_Literal_Subtype:
...@@ -4634,10 +4633,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4634,10 +4633,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
} }
} }
gnu_type = build_qualified_type (gnu_type, if (Treat_As_Volatile (gnat_entity))
(TYPE_QUALS (gnu_type) gnu_type
| (TYPE_QUAL_VOLATILE = build_qualified_type (gnu_type,
* Treat_As_Volatile (gnat_entity)))); TYPE_QUALS (gnu_type) | TYPE_QUAL_VOLATILE);
if (Is_Atomic (gnat_entity)) if (Is_Atomic (gnat_entity))
check_ok_for_atomic (gnu_type, gnat_entity, false); check_ok_for_atomic (gnu_type, gnat_entity, false);
......
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