ada-tree.h (union lang_tree_node): Use standard idiom.
* gcc-interface/ada-tree.h (union lang_tree_node): Use standard idiom. (SET_TYPE_LANG_SPECIFIC): Likewise. Fix formatting. (SET_DECL_LANG_SPECIFIC): Likewise. Reorder macros. * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>: Update comment about use of build_range_type. <E_Array_Type, E_Array_Subtype>: Use consistent naming convention. <E_Array_Subtype>: Rework comments about TYPE_ACTUAL_BOUNDS and add check for other cases of overloading. * gcc-interface/trans.c (gigi): Use size_int in lieu of build_int_cst. * gcc-interface/utils2.c (build_call_raise): Fix off-by-one error. Use size_int in lieu of build_int_cst. (build_call_alloc_dealloc): Use build_index_2_type in lieu of build_range_type. From-SVN: r146639
This commit is contained in:
Eric Botcazou
Eric Botcazou
parent
4782dfa72f
commit
26383c648f
5 changed files with 133 additions and 104 deletions
|
|
@ -1,3 +1,20 @@
|
|||
2009-04-23 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/ada-tree.h (union lang_tree_node): Use standard idiom.
|
||||
(SET_TYPE_LANG_SPECIFIC): Likewise. Fix formatting.
|
||||
(SET_DECL_LANG_SPECIFIC): Likewise.
|
||||
Reorder macros.
|
||||
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
|
||||
Update comment about use of build_range_type.
|
||||
<E_Array_Type, E_Array_Subtype>: Use consistent naming convention.
|
||||
<E_Array_Subtype>: Rework comments about TYPE_ACTUAL_BOUNDS and add
|
||||
check for other cases of overloading.
|
||||
* gcc-interface/trans.c (gigi): Use size_int in lieu of build_int_cst.
|
||||
* gcc-interface/utils2.c (build_call_raise): Fix off-by-one error.
|
||||
Use size_int in lieu of build_int_cst.
|
||||
(build_call_alloc_dealloc): Use build_index_2_type in lieu of
|
||||
build_range_type.
|
||||
|
||||
2009-04-22 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/utils2.c (build_binary_op) <PLUS_EXPR>: If operation's
|
||||
|
|
|
|||
|
|
@ -23,33 +23,39 @@
|
|||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* Ada uses the lang_decl and lang_type fields to hold a tree. */
|
||||
/* The resulting tree type. */
|
||||
union GTY((desc ("0"),
|
||||
chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.t)"))) lang_tree_node
|
||||
chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
|
||||
lang_tree_node
|
||||
{
|
||||
union tree_node GTY((tag ("0"))) t;
|
||||
union tree_node GTY((tag ("0"),
|
||||
desc ("tree_node_structure (&%h)"))) generic;
|
||||
};
|
||||
struct GTY(()) lang_decl {tree t; };
|
||||
struct GTY(()) lang_type {tree t; };
|
||||
|
||||
/* Define macros to get and set the tree in TYPE_ and DECL_LANG_SPECIFIC. */
|
||||
/* Ada uses the lang_decl and lang_type fields to hold a tree. */
|
||||
struct GTY(()) lang_type { tree t; };
|
||||
struct GTY(()) lang_decl { tree t; };
|
||||
|
||||
/* Macros to get and set the tree in TYPE_LANG_SPECIFIC. */
|
||||
#define GET_TYPE_LANG_SPECIFIC(NODE) \
|
||||
(TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t : NULL_TREE)
|
||||
#define SET_TYPE_LANG_SPECIFIC(NODE, X) \
|
||||
(TYPE_LANG_SPECIFIC (NODE) \
|
||||
= (TYPE_LANG_SPECIFIC (NODE) \
|
||||
? TYPE_LANG_SPECIFIC (NODE) : GGC_NEW (struct lang_type))) \
|
||||
->t = X;
|
||||
|
||||
#define SET_TYPE_LANG_SPECIFIC(NODE, X) \
|
||||
(TYPE_LANG_SPECIFIC (NODE) \
|
||||
= (TYPE_LANG_SPECIFIC (NODE) \
|
||||
? TYPE_LANG_SPECIFIC (NODE) : GGC_NEW (struct lang_type)))->t = (X)
|
||||
|
||||
/* Macros to get and set the tree in DECL_LANG_SPECIFIC. */
|
||||
#define GET_DECL_LANG_SPECIFIC(NODE) \
|
||||
(DECL_LANG_SPECIFIC (NODE) ? DECL_LANG_SPECIFIC (NODE)->t : NULL_TREE)
|
||||
#define SET_DECL_LANG_SPECIFIC(NODE, VALUE) \
|
||||
(DECL_LANG_SPECIFIC (NODE) \
|
||||
= (DECL_LANG_SPECIFIC (NODE) \
|
||||
? DECL_LANG_SPECIFIC (NODE) : GGC_NEW (struct lang_decl))) \
|
||||
->t = VALUE;
|
||||
|
||||
/* Flags added to GCC type nodes. */
|
||||
#define SET_DECL_LANG_SPECIFIC(NODE, X) \
|
||||
(DECL_LANG_SPECIFIC (NODE) \
|
||||
= (DECL_LANG_SPECIFIC (NODE) \
|
||||
? DECL_LANG_SPECIFIC (NODE) : GGC_NEW (struct lang_decl)))->t = (X)
|
||||
|
||||
|
||||
/* Flags added to type nodes. */
|
||||
|
||||
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is a
|
||||
record being used as a fat pointer (only true for RECORD_TYPE). */
|
||||
|
|
@ -161,29 +167,46 @@ struct GTY(()) lang_type {tree t; };
|
|||
mechanism refer to the routine gnat_to_gnu_entity. */
|
||||
#define TYPE_CI_CO_LIST(NODE) TYPE_LANG_SLOT_1 (FUNCTION_TYPE_CHECK (NODE))
|
||||
|
||||
/* For integral types, this is the RM Size of the type. */
|
||||
/* For integral types, this is the RM size of the type. */
|
||||
#define TYPE_RM_SIZE(NODE) \
|
||||
TYPE_LANG_SLOT_1 (TREE_CHECK3 (NODE, ENUMERAL_TYPE, BOOLEAN_TYPE, INTEGER_TYPE))
|
||||
|
||||
/* In an UNCONSTRAINED_ARRAY_TYPE, points to the record containing both
|
||||
the template and object.
|
||||
|
||||
??? We also put this on an ENUMERAL_TYPE that's dummy. Technically,
|
||||
this is a conflict on the minval field, but there doesn't seem to be
|
||||
simple fix, so we'll live with this kludge for now. */
|
||||
#define TYPE_OBJECT_RECORD_TYPE(NODE) \
|
||||
(TREE_CHECK2 ((NODE), UNCONSTRAINED_ARRAY_TYPE, ENUMERAL_TYPE)->type.minval)
|
||||
|
||||
/* For an INTEGER_TYPE with TYPE_MODULAR_P, this is the value of the
|
||||
modulus. */
|
||||
#define TYPE_MODULUS(NODE) GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
|
||||
#define SET_TYPE_MODULUS(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
|
||||
|
||||
/* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, points to
|
||||
/* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, this is the
|
||||
Digits_Value. */
|
||||
#define TYPE_DIGITS_VALUE(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
|
||||
#define SET_TYPE_DIGITS_VALUE(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
|
||||
|
||||
/* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, this is
|
||||
the type corresponding to the Ada index type. */
|
||||
#define TYPE_INDEX_TYPE(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
|
||||
#define SET_TYPE_INDEX_TYPE(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
|
||||
|
||||
/* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, stores the
|
||||
Digits_Value. */
|
||||
#define TYPE_DIGITS_VALUE(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
|
||||
#define SET_TYPE_DIGITS_VALUE(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
|
||||
/* For an INTEGER_TYPE with TYPE_HAS_ACTUAL_BOUNDS_P or an ARRAY_TYPE, this is
|
||||
the index type that should be used when the actual bounds are required for
|
||||
a template. This is used in the case of packed arrays. */
|
||||
#define TYPE_ACTUAL_BOUNDS(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE))
|
||||
#define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE), X)
|
||||
|
||||
/* For a RECORD_TYPE that is a fat pointer, point to the type for the
|
||||
unconstrained object. Likewise for a RECORD_TYPE that is pointed
|
||||
|
|
@ -201,22 +224,8 @@ struct GTY(()) lang_type {tree t; };
|
|||
#define SET_TYPE_ADA_SIZE(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_CHECK (NODE), X)
|
||||
|
||||
/* For an INTEGER_TYPE with TYPE_HAS_ACTUAL_BOUNDS_P or an ARRAY_TYPE, this is
|
||||
the index type that should be used when the actual bounds are required for
|
||||
a template. This is used in the case of packed arrays. */
|
||||
#define TYPE_ACTUAL_BOUNDS(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE))
|
||||
#define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE), X)
|
||||
|
||||
/* In an UNCONSTRAINED_ARRAY_TYPE, points to the record containing both
|
||||
the template and object.
|
||||
|
||||
??? We also put this on an ENUMERAL_TYPE that's dummy. Technically,
|
||||
this is a conflict on the minval field, but there doesn't seem to be
|
||||
simple fix, so we'll live with this kludge for now. */
|
||||
#define TYPE_OBJECT_RECORD_TYPE(NODE) \
|
||||
(TREE_CHECK2 ((NODE), UNCONSTRAINED_ARRAY_TYPE, ENUMERAL_TYPE)->type.minval)
|
||||
/* Flags added to decl nodes. */
|
||||
|
||||
/* Nonzero in a FUNCTION_DECL that represents a stubbed function
|
||||
discriminant. */
|
||||
|
|
@ -251,6 +260,10 @@ struct GTY(()) lang_type {tree t; };
|
|||
/* Nonzero in a VAR_DECL if it is a pointer renaming a global object. */
|
||||
#define DECL_RENAMING_GLOBAL_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))
|
||||
|
||||
/* In a CONST_DECL, points to a VAR_DECL that is allocatable to
|
||||
memory. Used when a scalar constant is aliased or has its
|
||||
address taken. */
|
||||
|
|
@ -293,11 +306,8 @@ struct GTY(()) lang_type {tree t; };
|
|||
#define SET_DECL_PARM_ALT_TYPE(NODE, X) \
|
||||
SET_DECL_LANG_SPECIFIC (PARM_DECL_CHECK (NODE), X)
|
||||
|
||||
/* In a FIELD_DECL corresponding to a discriminant, contains the
|
||||
discriminant number. */
|
||||
#define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
|
||||
|
||||
/* Define fields and macros for statements. */
|
||||
/* Fields and macros for statements. */
|
||||
#define IS_ADA_STMT(NODE) \
|
||||
(STATEMENT_CLASS_P (NODE) && TREE_CODE (NODE) >= STMT_STMT)
|
||||
|
||||
|
|
|
|||
|
|
@ -1521,10 +1521,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
case E_Ordinary_Fixed_Point_Subtype:
|
||||
case E_Decimal_Fixed_Point_Subtype:
|
||||
|
||||
/* For integral subtypes, we make a new INTEGER_TYPE. Note hat we do
|
||||
/* For integral subtypes, we make a new INTEGER_TYPE. Note that we do
|
||||
not want to call build_range_type since we would like each subtype
|
||||
node to be distinct. This will be important when memory aliasing
|
||||
is implemented.
|
||||
node to be distinct. ??? Historically this was in preparation for
|
||||
when memory aliasing is implemented. But that's obsolete now given
|
||||
the call to relate_alias_sets below.
|
||||
|
||||
The TREE_TYPE field of the INTEGER_TYPE points to the base type;
|
||||
this fact is used by the arithmetic conversion functions.
|
||||
|
|
@ -1768,25 +1769,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
case E_String_Type:
|
||||
case E_Array_Type:
|
||||
{
|
||||
tree gnu_template_fields = NULL_TREE;
|
||||
tree gnu_template_type = make_node (RECORD_TYPE);
|
||||
tree gnu_ptr_template = build_pointer_type (gnu_template_type);
|
||||
tree gnu_fat_type = make_node (RECORD_TYPE);
|
||||
int ndim = Number_Dimensions (gnat_entity);
|
||||
int firstdim
|
||||
= (Convention (gnat_entity) == Convention_Fortran) ? ndim - 1 : 0;
|
||||
int nextdim
|
||||
= (Convention (gnat_entity) == Convention_Fortran) ? - 1 : 1;
|
||||
int index;
|
||||
tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree *));
|
||||
tree *gnu_temp_fields = (tree *) alloca (ndim * sizeof (tree *));
|
||||
tree gnu_comp_size = 0;
|
||||
tree gnu_max_size = size_one_node;
|
||||
tree gnu_max_size_unit;
|
||||
Entity_Id gnat_ind_subtype;
|
||||
Entity_Id gnat_ind_base_subtype;
|
||||
int ndim = Number_Dimensions (gnat_entity);
|
||||
int first_dim
|
||||
= (Convention (gnat_entity) == Convention_Fortran) ? ndim - 1 : 0;
|
||||
int next_dim
|
||||
= (Convention (gnat_entity) == Convention_Fortran) ? - 1 : 1;
|
||||
int index;
|
||||
tree gnu_template_fields = NULL_TREE;
|
||||
tree gnu_template_type = make_node (RECORD_TYPE);
|
||||
tree gnu_template_reference;
|
||||
tree tem;
|
||||
tree gnu_ptr_template = build_pointer_type (gnu_template_type);
|
||||
tree gnu_fat_type = make_node (RECORD_TYPE);
|
||||
tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree));
|
||||
tree *gnu_temp_fields = (tree *) alloca (ndim * sizeof (tree));
|
||||
tree gnu_max_size = size_one_node, gnu_max_size_unit;
|
||||
tree gnu_comp_size, tem;
|
||||
|
||||
TYPE_NAME (gnu_template_type)
|
||||
= create_concat_name (gnat_entity, "XUB");
|
||||
|
|
@ -1829,11 +1828,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
|
||||
/* Now create the GCC type for each index and add the fields for
|
||||
that index to the template. */
|
||||
for (index = firstdim, gnat_ind_subtype = First_Index (gnat_entity),
|
||||
for (index = first_dim, gnat_ind_subtype = First_Index (gnat_entity),
|
||||
gnat_ind_base_subtype
|
||||
= First_Index (Implementation_Base_Type (gnat_entity));
|
||||
index < ndim && index >= 0;
|
||||
index += nextdim,
|
||||
index += next_dim,
|
||||
gnat_ind_subtype = Next_Index (gnat_ind_subtype),
|
||||
gnat_ind_base_subtype = Next_Index (gnat_ind_base_subtype))
|
||||
{
|
||||
|
|
@ -1932,7 +1931,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
|
||||
/* If the component type is a RECORD_TYPE that has a self-referential
|
||||
size, use the maximum size. */
|
||||
if (!gnu_comp_size && TREE_CODE (tem) == RECORD_TYPE
|
||||
if (!gnu_comp_size
|
||||
&& TREE_CODE (tem) == RECORD_TYPE
|
||||
&& CONTAINS_PLACEHOLDER_P (TYPE_SIZE (tem)))
|
||||
gnu_comp_size = max_size (TYPE_SIZE (tem), true);
|
||||
|
||||
|
|
@ -2059,20 +2059,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
break;
|
||||
else
|
||||
{
|
||||
int index;
|
||||
int array_dim = Number_Dimensions (gnat_entity);
|
||||
int first_dim
|
||||
= ((Convention (gnat_entity) == Convention_Fortran)
|
||||
? array_dim - 1 : 0);
|
||||
int next_dim
|
||||
= (Convention (gnat_entity) == Convention_Fortran) ? -1 : 1;
|
||||
Entity_Id gnat_ind_subtype;
|
||||
Entity_Id gnat_ind_base_subtype;
|
||||
int dim = Number_Dimensions (gnat_entity);
|
||||
int first_dim
|
||||
= (Convention (gnat_entity) == Convention_Fortran) ? dim - 1 : 0;
|
||||
int next_dim
|
||||
= (Convention (gnat_entity) == Convention_Fortran) ? -1 : 1;
|
||||
int index;
|
||||
tree gnu_base_type = gnu_type;
|
||||
tree *gnu_index_type = (tree *) alloca (array_dim * sizeof (tree *));
|
||||
tree gnu_comp_size = NULL_TREE;
|
||||
tree gnu_max_size = size_one_node;
|
||||
tree gnu_max_size_unit;
|
||||
tree *gnu_index_type = (tree *) alloca (dim * sizeof (tree));
|
||||
tree gnu_max_size = size_one_node, gnu_max_size_unit;
|
||||
bool need_index_type_struct = false;
|
||||
bool max_overflow = false;
|
||||
|
||||
|
|
@ -2084,7 +2081,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
for (index = first_dim, gnat_ind_subtype = First_Index (gnat_entity),
|
||||
gnat_ind_base_subtype
|
||||
= First_Index (Implementation_Base_Type (gnat_entity));
|
||||
index < array_dim && index >= 0;
|
||||
index < dim && index >= 0;
|
||||
index += next_dim,
|
||||
gnat_ind_subtype = Next_Index (gnat_ind_subtype),
|
||||
gnat_ind_base_subtype = Next_Index (gnat_ind_base_subtype))
|
||||
|
|
@ -2273,7 +2270,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
&& !Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
|
||||
{
|
||||
gnu_type = gnat_to_gnu_type (Original_Array_Type (gnat_entity));
|
||||
for (index = array_dim - 1; index >= 0; index--)
|
||||
for (index = dim - 1; index >= 0; index--)
|
||||
gnu_type = TREE_TYPE (gnu_type);
|
||||
|
||||
/* One of the above calls might have caused us to be elaborated,
|
||||
|
|
@ -2286,6 +2283,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
}
|
||||
else
|
||||
{
|
||||
tree gnu_comp_size;
|
||||
|
||||
gnu_type = gnat_to_gnu_type (Component_Type (gnat_entity));
|
||||
|
||||
/* One of the above calls might have caused us to be elaborated,
|
||||
|
|
@ -2352,7 +2351,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
convert (bitsizetype, gnu_max_size),
|
||||
TYPE_SIZE (gnu_type));
|
||||
|
||||
for (index = array_dim - 1; index >= 0; index --)
|
||||
for (index = dim - 1; index >= 0; index --)
|
||||
{
|
||||
gnu_type = build_array_type (gnu_type, gnu_index_type[index]);
|
||||
TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
|
||||
|
|
@ -2368,7 +2367,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
/* If we are at file level and this is a multi-dimensional array, we
|
||||
need to make a variable corresponding to the stride of the
|
||||
inner dimensions. */
|
||||
if (global_bindings_p () && array_dim > 1)
|
||||
if (global_bindings_p () && dim > 1)
|
||||
{
|
||||
tree gnu_str_name = get_identifier ("ST");
|
||||
tree gnu_arr_type;
|
||||
|
|
@ -2419,7 +2418,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
TYPE_NAME (gnu_bound_rec)
|
||||
= create_concat_name (gnat_entity, "XA");
|
||||
|
||||
for (index = array_dim - 1; index >= 0; index--)
|
||||
for (index = dim - 1; index >= 0; index--)
|
||||
{
|
||||
tree gnu_index = TYPE_INDEX_TYPE (gnu_index_type[index]);
|
||||
tree gnu_index_name = TYPE_NAME (gnu_index);
|
||||
|
|
@ -2505,9 +2504,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
|| TYPE_IS_PADDING_P (gnu_inner_type)))
|
||||
gnu_inner_type = TREE_TYPE (TYPE_FIELDS (gnu_inner_type));
|
||||
|
||||
/* We need to point the type we just made to our index type so
|
||||
the actual bounds can be put into a template. */
|
||||
|
||||
/* 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
|
||||
|
|
@ -2515,32 +2513,39 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
{
|
||||
if (TREE_CODE (gnu_inner_type) == INTEGER_TYPE)
|
||||
{
|
||||
/* The TYPE_ACTUAL_BOUNDS field is also used for the modulus.
|
||||
If it is, we need to make another type. */
|
||||
/* The TYPE_ACTUAL_BOUNDS field is overloaded with the
|
||||
TYPE_MODULUS for modular types so we make an extra
|
||||
subtype if necessary. */
|
||||
if (TYPE_MODULAR_P (gnu_inner_type))
|
||||
{
|
||||
tree gnu_subtype;
|
||||
|
||||
gnu_subtype = make_node (INTEGER_TYPE);
|
||||
|
||||
tree gnu_subtype = make_node (INTEGER_TYPE);
|
||||
TREE_TYPE (gnu_subtype) = gnu_inner_type;
|
||||
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
|
||||
|
||||
TYPE_UNSIGNED (gnu_subtype) = 1;
|
||||
TYPE_PRECISION (gnu_subtype)
|
||||
= TYPE_PRECISION (gnu_inner_type);
|
||||
TYPE_MIN_VALUE (gnu_subtype)
|
||||
= TYPE_MIN_VALUE (gnu_inner_type);
|
||||
TYPE_MAX_VALUE (gnu_subtype)
|
||||
= TYPE_MAX_VALUE (gnu_inner_type);
|
||||
TYPE_PRECISION (gnu_subtype)
|
||||
= TYPE_PRECISION (gnu_inner_type);
|
||||
TYPE_UNSIGNED (gnu_subtype)
|
||||
= TYPE_UNSIGNED (gnu_inner_type);
|
||||
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
|
||||
layout_type (gnu_subtype);
|
||||
|
||||
gnu_inner_type = gnu_subtype;
|
||||
}
|
||||
|
||||
TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner_type) = 1;
|
||||
|
||||
#ifdef ENABLE_CHECKING
|
||||
/* Check for other cases of overloading. */
|
||||
gcc_assert (!TYPE_ACTUAL_BOUNDS (gnu_inner_type));
|
||||
#endif
|
||||
}
|
||||
|
||||
/* ??? This is necessary to make sure that the container is
|
||||
allocated with a null tree upfront; otherwise, it could
|
||||
be allocated with an uninitialized tree that is accessed
|
||||
before being set below. See ada-tree.h for details. */
|
||||
SET_TYPE_ACTUAL_BOUNDS (gnu_inner_type, NULL_TREE);
|
||||
|
||||
for (gnat_index = First_Index (gnat_entity);
|
||||
|
|
|
|||
|
|
@ -405,7 +405,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
|
|||
/* Make the types and functions used for exception processing. */
|
||||
jmpbuf_type
|
||||
= build_array_type (gnat_type_for_mode (Pmode, 0),
|
||||
build_index_type (build_int_cst (NULL_TREE, 5)));
|
||||
build_index_type (size_int (5)));
|
||||
record_builtin_type ("JMPBUF_T", jmpbuf_type);
|
||||
jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
|
||||
|
||||
|
|
|
|||
|
|
@ -1591,15 +1591,14 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
|
|||
(Get_Source_File_Index (Sloc (gnat_node))))))
|
||||
: ref_filename;
|
||||
|
||||
len = strlen (str) + 1;
|
||||
len = strlen (str);
|
||||
filename = build_string (len, str);
|
||||
line_number
|
||||
= (gnat_node != Empty && Sloc (gnat_node) != No_Location)
|
||||
? Get_Logical_Line_Number (Sloc(gnat_node)) : input_line;
|
||||
|
||||
TREE_TYPE (filename)
|
||||
= build_array_type (char_type_node,
|
||||
build_index_type (build_int_cst (NULL_TREE, len)));
|
||||
= build_array_type (char_type_node, build_index_type (size_int (len)));
|
||||
|
||||
return
|
||||
build_call_2_expr (fndecl,
|
||||
|
|
@ -1928,14 +1927,12 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
|
|||
/* If the size is a constant, we can put it in the fixed portion of
|
||||
the stack frame to avoid the need to adjust the stack pointer. */
|
||||
{
|
||||
tree gnu_range
|
||||
= build_range_type (NULL_TREE, size_one_node, gnu_size);
|
||||
tree gnu_array_type = build_array_type (char_type_node, gnu_range);
|
||||
tree gnu_index = build_index_2_type (size_one_node, gnu_size);
|
||||
tree gnu_array_type = build_array_type (char_type_node, gnu_index);
|
||||
tree gnu_decl
|
||||
= create_var_decl (get_identifier ("RETVAL"), NULL_TREE,
|
||||
gnu_array_type, NULL_TREE, false, false, false,
|
||||
false, NULL, gnat_node);
|
||||
|
||||
return convert (ptr_void_type_node,
|
||||
build_unary_op (ADDR_EXPR, NULL_TREE, gnu_decl));
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue