+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
* *
****************************************************************************/
-/* 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;
+ (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). */
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
#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. */
/* 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. */
#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)
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.
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);
+ Entity_Id gnat_ind_subtype;
+ Entity_Id gnat_ind_base_subtype;
int ndim = Number_Dimensions (gnat_entity);
- int firstdim
+ int first_dim
= (Convention (gnat_entity) == Convention_Fortran) ? ndim - 1 : 0;
- int nextdim
+ int next_dim
= (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;
+ 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");
/* 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))
{
/* 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);
break;
else
{
- int index;
- int array_dim = Number_Dimensions (gnat_entity);
+ 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)
- ? array_dim - 1 : 0);
+ = (Convention (gnat_entity) == Convention_Fortran) ? 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 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;
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))
&& !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,
}
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,
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);
/* 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;
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);
|| 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
{
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);
/* 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);
(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,
/* 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));
}
projects / thirdparty / gcc.git / commitdiff
