* *
****************************************************************************/
-/* We have attribute handlers using C specific format specifiers in warning
- messages. Make sure they are properly recognized. */
-#define GCC_DIAG_STYLE __gcc_cdiag__
-
#include "config.h"
#include "system.h"
#include "coretypes.h"
#include "tm.h"
#include "tree.h"
#include "flags.h"
-#include "defaults.h"
#include "toplev.h"
+#include "rtl.h"
#include "output.h"
#include "ggc.h"
#include "debug.h"
#include "convert.h"
#include "target.h"
#include "function.h"
+#include "langhooks.h"
+#include "pointer-set.h"
#include "cgraph.h"
+#include "tree-dump.h"
#include "tree-inline.h"
#include "tree-iterator.h"
#include "gimple.h"
-#include "tree-dump.h"
-#include "pointer-set.h"
-#include "langhooks.h"
-#include "rtl.h"
#include "ada.h"
#include "types.h"
#include "ada-tree.h"
#include "gigi.h"
-#ifndef MAX_FIXED_MODE_SIZE
-#define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode)
-#endif
-
#ifndef MAX_BITS_PER_WORD
#define MAX_BITS_PER_WORD BITS_PER_WORD
#endif
/* If nonzero, pretend we are allocating at global level. */
int force_global;
+/* The default alignment of "double" floating-point types, i.e. floating
+ point types whose size is equal to 64 bits, or 0 if this alignment is
+ not specifically capped. */
+int double_float_alignment;
+
+/* The default alignment of "double" or larger scalar types, i.e. scalar
+ types whose size is greater or equal to 64 bits, or 0 if this alignment
+ is not specifically capped. */
+int double_scalar_alignment;
+
/* Tree nodes for the various types and decls we create. */
tree gnat_std_decls[(int) ADT_LAST];
static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *);
static tree handle_malloc_attribute (tree *, tree, tree, int, bool *);
static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *);
+static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *);
+static tree handle_vector_type_attribute (tree *, tree, tree, int, bool *);
/* Fake handler for attributes we don't properly support, typically because
they'd require dragging a lot of the common-c front-end circuitry. */
{ "sentinel", 0, 1, false, true, true, handle_sentinel_attribute },
{ "noreturn", 0, 0, true, false, false, handle_noreturn_attribute },
{ "malloc", 0, 0, true, false, false, handle_malloc_attribute },
- { "type generic", 0, 0, false, true, true, handle_type_generic_attribute },
+ { "type generic", 0, 0, false, true, true, handle_type_generic_attribute },
+
+ { "vector_size", 1, 1, false, true, false, handle_vector_size_attribute },
+ { "vector_type", 0, 0, false, true, false, handle_vector_type_attribute },
+ { "may_alias", 0, 0, false, true, false, NULL },
/* ??? format and format_arg are heavy and not supported, which actually
prevents support for stdio builtins, which we however declare as part
/* For each binding contour we allocate a binding_level structure to indicate
the binding depth. */
-struct gnat_binding_level GTY((chain_next ("%h.chain")))
-{
+struct GTY((chain_next ("%h.chain"))) gnat_binding_level {
/* The binding level containing this one (the enclosing binding level). */
struct gnat_binding_level *chain;
/* The BLOCK node for this level. */
static tree merge_sizes (tree, tree, tree, bool, bool);
static tree compute_related_constant (tree, tree);
static tree split_plus (tree, tree *);
-static void gnat_gimplify_function (tree);
static tree float_type_for_precision (int, enum machine_mode);
static tree convert_to_fat_pointer (tree, tree);
static tree convert_to_thin_pointer (tree, tree);
/* Enter a new binding level. */
void
-gnat_pushlevel ()
+gnat_pushlevel (void)
{
struct gnat_binding_level *newlevel = NULL;
/* Get the jmpbuf_decl, if any, for the current binding level. */
tree
-get_block_jmpbuf_decl ()
+get_block_jmpbuf_decl (void)
{
return current_binding_level->jmpbuf_decl;
}
/* Exit a binding level. Set any BLOCK into the current code group. */
void
-gnat_poplevel ()
+gnat_poplevel (void)
{
struct gnat_binding_level *level = current_binding_level;
tree block = level->block;
{
DECL_CONTEXT (decl) = current_function_decl;
- /* Functions imported in another function are not really nested. */
- if (TREE_CODE (decl) == FUNCTION_DECL && TREE_PUBLIC (decl))
- DECL_NO_STATIC_CHAIN (decl) = 1;
+ /* Functions imported in another function are not really nested.
+ For really nested functions mark them initially as needing
+ a static chain for uses of that flag before unnesting;
+ lower_nested_functions will then recompute it. */
+ if (TREE_CODE (decl) == FUNCTION_DECL && !TREE_PUBLIC (decl))
+ DECL_STATIC_CHAIN (decl) = 1;
}
TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node));
if (!(TYPE_NAME (t) && TREE_CODE (TYPE_NAME (t)) == TYPE_DECL))
;
- else if (TYPE_FAT_POINTER_P (t))
+ else if (TYPE_IS_FAT_POINTER_P (t))
{
tree tt = build_variant_type_copy (t);
TYPE_NAME (tt) = decl;
TREE_USED (tt) = TREE_USED (t);
TREE_TYPE (decl) = tt;
- DECL_ORIGINAL_TYPE (decl) = t;
+ if (DECL_ORIGINAL_TYPE (TYPE_NAME (t)))
+ DECL_ORIGINAL_TYPE (decl) = DECL_ORIGINAL_TYPE (TYPE_NAME (t));
+ else
+ DECL_ORIGINAL_TYPE (decl) = t;
t = NULL_TREE;
+ DECL_ARTIFICIAL (decl) = 0;
}
else if (DECL_ARTIFICIAL (TYPE_NAME (t)) && !DECL_ARTIFICIAL (decl))
;
set_sizetype (size_type_node);
/* In Ada, we use an unsigned 8-bit type for the default boolean type. */
- boolean_type_node = make_node (BOOLEAN_TYPE);
- TYPE_PRECISION (boolean_type_node) = 1;
- fixup_unsigned_type (boolean_type_node);
- TYPE_RM_SIZE (boolean_type_node) = bitsize_int (1);
+ boolean_type_node = make_unsigned_type (8);
+ TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE);
+ SET_TYPE_RM_MAX_VALUE (boolean_type_node,
+ build_int_cst (boolean_type_node, 1));
+ SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1));
build_common_tree_nodes_2 (0);
+ boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
ptr_void_type_node = build_pointer_type (void_type_node);
}
void
record_builtin_type (const char *name, tree type)
{
- tree type_decl = build_decl (TYPE_DECL, get_identifier (name), type);
+ tree type_decl = build_decl (input_location,
+ TYPE_DECL, get_identifier (name), type);
gnat_pushdecl (type_decl, Empty);
debug_hooks->type_decl (type_decl, false);
}
\f
-/* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST,
+/* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST,
finish constructing the record or union type. If REP_LEVEL is zero, this
record has no representation clause and so will be entirely laid out here.
If REP_LEVEL is one, this record has a representation clause and has been
laid out already; only set the sizes and alignment. If REP_LEVEL is two,
this record is derived from a parent record and thus inherits its layout;
- only make a pass on the fields to finalize them. If DO_NOT_FINALIZE is
- true, the record type is expected to be modified afterwards so it will
- not be sent to the back-end for finalization. */
+ only make a pass on the fields to finalize them. DEBUG_INFO_P is true if
+ we need to write debug information about this type. */
void
-finish_record_type (tree record_type, tree fieldlist, int rep_level,
- bool do_not_finalize)
+finish_record_type (tree record_type, tree field_list, int rep_level,
+ bool debug_info_p)
{
enum tree_code code = TREE_CODE (record_type);
tree name = TYPE_NAME (record_type);
bool had_align = TYPE_ALIGN (record_type) != 0;
tree field;
- TYPE_FIELDS (record_type) = fieldlist;
+ TYPE_FIELDS (record_type) = field_list;
/* Always attach the TYPE_STUB_DECL for a record type. It is required to
generate debug info and have a parallel type. */
handled yet, and adjust DECL_NONADDRESSABLE_P accordingly. */
if (code == QUAL_UNION_TYPE)
- fieldlist = nreverse (fieldlist);
+ field_list = nreverse (field_list);
- for (field = fieldlist; field; field = TREE_CHAIN (field))
+ for (field = field_list; field; field = TREE_CHAIN (field))
{
tree type = TREE_TYPE (field);
tree pos = bit_position (field);
if ((TREE_CODE (type) == RECORD_TYPE
|| TREE_CODE (type) == UNION_TYPE
|| TREE_CODE (type) == QUAL_UNION_TYPE)
- && !TYPE_IS_FAT_POINTER_P (type)
+ && !TYPE_FAT_POINTER_P (type)
&& !TYPE_CONTAINS_TEMPLATE_P (type)
&& TYPE_ADA_SIZE (type))
this_ada_size = TYPE_ADA_SIZE (type);
DECL_BIT_FIELD (field) = 0;
}
- /* If we still have DECL_BIT_FIELD set at this point, we know the field
- is technically not addressable. Except that it can actually be
- addressed if the field is BLKmode and happens to be properly
- aligned. */
- DECL_NONADDRESSABLE_P (field)
- |= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
+ /* If we still have DECL_BIT_FIELD set at this point, we know that the
+ field is technically not addressable. Except that it can actually
+ be addressed if it is BLKmode and happens to be properly aligned. */
+ if (DECL_BIT_FIELD (field)
+ && !(DECL_MODE (field) == BLKmode
+ && value_factor_p (pos, BITS_PER_UNIT)))
+ DECL_NONADDRESSABLE_P (field) = 1;
/* A type must be as aligned as its most aligned field that is not
a bit-field. But this is already enforced by layout_type. */
}
if (code == QUAL_UNION_TYPE)
- nreverse (fieldlist);
-
- /* If the type is discriminated, it can be used to access all its
- constrained subtypes, so force structural equality checks. */
- if (CONTAINS_PLACEHOLDER_P (size))
- SET_TYPE_STRUCTURAL_EQUALITY (record_type);
+ nreverse (field_list);
if (rep_level < 2)
{
/* If this is a padding record, we never want to make the size smaller
than what was specified in it, if any. */
- if (TREE_CODE (record_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type))
+ if (TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type))
size = TYPE_SIZE (record_type);
/* Now set any of the values we've just computed that apply. */
- if (!TYPE_IS_FAT_POINTER_P (record_type)
+ if (!TYPE_FAT_POINTER_P (record_type)
&& !TYPE_CONTAINS_TEMPLATE_P (record_type))
SET_TYPE_ADA_SIZE (record_type, ada_size);
}
}
- if (!do_not_finalize)
+ if (debug_info_p)
rest_of_record_type_compilation (record_type);
}
-/* Wrap up compilation of RECORD_TYPE, i.e. most notably output all
- the debug information associated with it. It need not be invoked
- directly in most cases since finish_record_type takes care of doing
- so, unless explicitly requested not to through DO_NOT_FINALIZE. */
+/* Wrap up compilation of RECORD_TYPE, i.e. output all the debug information
+ associated with it. It need not be invoked directly in most cases since
+ finish_record_type takes care of doing so, but this can be necessary if
+ a parallel type is to be attached to the record type. */
void
rest_of_record_type_compilation (tree record_type)
{
- tree fieldlist = TYPE_FIELDS (record_type);
+ tree field_list = TYPE_FIELDS (record_type);
tree field;
enum tree_code code = TREE_CODE (record_type);
bool var_size = false;
- for (field = fieldlist; field; field = TREE_CHAIN (field))
+ for (field = field_list; field; field = TREE_CHAIN (field))
{
/* We need to make an XVE/XVU record if any field has variable size,
whether or not the record does. For example, if we have a union,
that tells the debugger how the record is laid out. See
exp_dbug.ads. But don't do this for records that are padding
since they confuse GDB. */
- if (var_size
- && !(TREE_CODE (record_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (record_type)))
+ if (var_size && !TYPE_IS_PADDING_P (record_type))
{
tree new_record_type
= make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
? UNION_TYPE : TREE_CODE (record_type));
- tree orig_name = TYPE_NAME (record_type);
- tree orig_id
- = (TREE_CODE (orig_name) == TYPE_DECL ? DECL_NAME (orig_name)
- : orig_name);
- tree new_id
- = concat_id_with_name (orig_id,
- TREE_CODE (record_type) == QUAL_UNION_TYPE
- ? "XVU" : "XVE");
+ tree orig_name = TYPE_NAME (record_type), new_name;
tree last_pos = bitsize_zero_node;
- tree old_field;
- tree prev_old_field = 0;
+ tree old_field, prev_old_field = NULL_TREE;
- TYPE_NAME (new_record_type) = new_id;
+ if (TREE_CODE (orig_name) == TYPE_DECL)
+ orig_name = DECL_NAME (orig_name);
+
+ new_name
+ = concat_name (orig_name, TREE_CODE (record_type) == QUAL_UNION_TYPE
+ ? "XVU" : "XVE");
+ TYPE_NAME (new_record_type) = new_name;
TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
TYPE_STUB_DECL (new_record_type)
- = create_type_stub_decl (new_id, new_record_type);
+ = create_type_stub_decl (new_name, new_record_type);
DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
= DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
TYPE_SIZE (new_record_type) = size_int (TYPE_ALIGN (record_type));
else
strcpy (suffix, "XVL");
- field_name = concat_id_with_name (field_name, suffix);
+ field_name = concat_name (field_name, suffix);
}
new_field = create_field_decl (field_name, field_type,
bool has_rep)
{
tree type = TREE_TYPE (last_size);
- tree new;
+ tree new_size;
if (!special || TREE_CODE (size) != COND_EXPR)
{
- new = size_binop (PLUS_EXPR, first_bit, size);
+ new_size = size_binop (PLUS_EXPR, first_bit, size);
if (has_rep)
- new = size_binop (MAX_EXPR, last_size, new);
+ new_size = size_binop (MAX_EXPR, last_size, new_size);
}
else
- new = fold_build3 (COND_EXPR, type, TREE_OPERAND (size, 0),
- integer_zerop (TREE_OPERAND (size, 1))
- ? last_size : merge_sizes (last_size, first_bit,
- TREE_OPERAND (size, 1),
- 1, has_rep),
- integer_zerop (TREE_OPERAND (size, 2))
- ? last_size : merge_sizes (last_size, first_bit,
- TREE_OPERAND (size, 2),
- 1, has_rep));
+ new_size = fold_build3 (COND_EXPR, type, TREE_OPERAND (size, 0),
+ integer_zerop (TREE_OPERAND (size, 1))
+ ? last_size : merge_sizes (last_size, first_bit,
+ TREE_OPERAND (size, 1),
+ 1, has_rep),
+ integer_zerop (TREE_OPERAND (size, 2))
+ ? last_size : merge_sizes (last_size, first_bit,
+ TREE_OPERAND (size, 2),
+ 1, has_rep));
/* We don't need any NON_VALUE_EXPRs and they can confuse us (especially
when fed through substitute_in_expr) into thinking that a constant
size is not constant. */
- while (TREE_CODE (new) == NON_LVALUE_EXPR)
- new = TREE_OPERAND (new, 0);
+ while (TREE_CODE (new_size) == NON_LVALUE_EXPR)
+ new_size = TREE_OPERAND (new_size, 0);
- return new;
+ return new_size;
}
/* Utility function of above to see if OP0 and OP1, both of SIZETYPE, are
tree
copy_type (tree type)
{
- tree new = copy_node (type);
+ tree new_type = copy_node (type);
+
+ /* Unshare the language-specific data. */
+ if (TYPE_LANG_SPECIFIC (type))
+ {
+ TYPE_LANG_SPECIFIC (new_type) = NULL;
+ SET_TYPE_LANG_SPECIFIC (new_type, GET_TYPE_LANG_SPECIFIC (type));
+ }
+
+ /* And the contents of the language-specific slot if needed. */
+ if ((INTEGRAL_TYPE_P (type) || TREE_CODE (type) == REAL_TYPE)
+ && TYPE_RM_VALUES (type))
+ {
+ TYPE_RM_VALUES (new_type) = NULL_TREE;
+ SET_TYPE_RM_SIZE (new_type, TYPE_RM_SIZE (type));
+ SET_TYPE_RM_MIN_VALUE (new_type, TYPE_RM_MIN_VALUE (type));
+ SET_TYPE_RM_MAX_VALUE (new_type, TYPE_RM_MAX_VALUE (type));
+ }
/* copy_node clears this field instead of copying it, because it is
aliased with TREE_CHAIN. */
- TYPE_STUB_DECL (new) = TYPE_STUB_DECL (type);
+ TYPE_STUB_DECL (new_type) = TYPE_STUB_DECL (type);
- TYPE_POINTER_TO (new) = 0;
- TYPE_REFERENCE_TO (new) = 0;
- TYPE_MAIN_VARIANT (new) = new;
- TYPE_NEXT_VARIANT (new) = 0;
+ TYPE_POINTER_TO (new_type) = 0;
+ TYPE_REFERENCE_TO (new_type) = 0;
+ TYPE_MAIN_VARIANT (new_type) = new_type;
+ TYPE_NEXT_VARIANT (new_type) = 0;
- return new;
+ return new_type;
}
\f
-/* Return an INTEGER_TYPE of SIZETYPE with range MIN to MAX and whose
- TYPE_INDEX_TYPE is INDEX. GNAT_NODE is used for the position of
- the decl. */
+/* Return a subtype of sizetype with range MIN to MAX and whose
+ TYPE_INDEX_TYPE is INDEX. GNAT_NODE is used for the position
+ of the associated TYPE_DECL. */
tree
create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
/* First build a type for the desired range. */
tree type = build_index_2_type (min, max);
- /* If this type has the TYPE_INDEX_TYPE we want, return it. Otherwise, if it
- doesn't have TYPE_INDEX_TYPE set, set it to INDEX. If TYPE_INDEX_TYPE
- is set, but not to INDEX, make a copy of this type with the requested
- index type. Note that we have no way of sharing these types, but that's
- only a small hole. */
+ /* If this type has the TYPE_INDEX_TYPE we want, return it. */
if (TYPE_INDEX_TYPE (type) == index)
return type;
- else if (TYPE_INDEX_TYPE (type))
+
+ /* Otherwise, if TYPE_INDEX_TYPE is set, make a copy. Note that we have
+ no way of sharing these types, but that's only a small hole. */
+ if (TYPE_INDEX_TYPE (type))
type = copy_type (type);
SET_TYPE_INDEX_TYPE (type, index);
create_type_decl (NULL_TREE, type, NULL, true, false, gnat_node);
+
return type;
}
+
+/* Return a subtype of TYPE with range MIN to MAX. If TYPE is NULL,
+ sizetype is used. */
+
+tree
+create_range_type (tree type, tree min, tree max)
+{
+ tree range_type;
+
+ if (type == NULL_TREE)
+ type = sizetype;
+
+ /* First build a type with the base range. */
+ range_type
+ = build_range_type (type, TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type));
+
+ min = convert (type, min);
+ max = convert (type, max);
+
+ /* If this type has the TYPE_RM_{MIN,MAX}_VALUE we want, return it. */
+ if (TYPE_RM_MIN_VALUE (range_type)
+ && TYPE_RM_MAX_VALUE (range_type)
+ && operand_equal_p (TYPE_RM_MIN_VALUE (range_type), min, 0)
+ && operand_equal_p (TYPE_RM_MAX_VALUE (range_type), max, 0))
+ return range_type;
+
+ /* Otherwise, if TYPE_RM_{MIN,MAX}_VALUE is set, make a copy. */
+ if (TYPE_RM_MIN_VALUE (range_type) || TYPE_RM_MAX_VALUE (range_type))
+ range_type = copy_type (range_type);
+
+ /* Then set the actual range. */
+ SET_TYPE_RM_MIN_VALUE (range_type, min);
+ SET_TYPE_RM_MAX_VALUE (range_type, max);
+
+ return range_type;
+}
\f
/* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of a type.
TYPE_NAME gives the name of the type and TYPE is a ..._TYPE node giving
/* Using a named TYPE_DECL ensures that a type name marker is emitted in
STABS while setting DECL_ARTIFICIAL ensures that no DW_TAG_typedef is
emitted in DWARF. */
- tree type_decl = build_decl (TYPE_DECL, type_name, type);
+ tree type_decl = build_decl (input_location,
+ TYPE_DECL, type_name, type);
DECL_ARTIFICIAL (type_decl) = 1;
return type_decl;
}
DECL_NAME (type_decl) = type_name;
}
else
- type_decl = build_decl (TYPE_DECL, type_name, type);
+ type_decl = build_decl (input_location,
+ TYPE_DECL, type_name, type);
DECL_ARTIFICIAL (type_decl) = artificial_p;
gnat_pushdecl (type_decl, gnat_node);
if (code == UNCONSTRAINED_ARRAY_TYPE || !debug_info_p)
DECL_IGNORED_P (type_decl) = 1;
else if (code != ENUMERAL_TYPE
- && (code != RECORD_TYPE || TYPE_IS_FAT_POINTER_P (type))
+ && (code != RECORD_TYPE || TYPE_FAT_POINTER_P (type))
&& !((code == POINTER_TYPE || code == REFERENCE_TYPE)
&& TYPE_IS_DUMMY_P (TREE_TYPE (type)))
&& !(code == RECORD_TYPE
/* The actual DECL node. CONST_DECL was initially intended for enumerals
and may be used for scalars in general but not for aggregates. */
tree var_decl
- = build_decl ((constant_p && const_decl_allowed_p
+ = build_decl (input_location,
+ (constant_p && const_decl_allowed_p
&& !AGGREGATE_TYPE_P (type)) ? CONST_DECL : VAR_DECL,
var_name, type);
that is, not violating a No_Elaboration_Code restriction. */
if (global_bindings_p () && var_init != 0 && ! init_const)
Check_Elaboration_Code_Allowed (gnat_node);
+ DECL_INITIAL (var_decl) = var_init;
+ TREE_READONLY (var_decl) = const_flag;
+ DECL_EXTERNAL (var_decl) = extern_flag;
+ TREE_PUBLIC (var_decl) = public_flag || extern_flag;
+ TREE_CONSTANT (var_decl) = constant_p;
+ TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl)
+ = TYPE_VOLATILE (type);
/* Ada doesn't feature Fortran-like COMMON variables so we shouldn't
try to fiddle with DECL_COMMON. However, on platforms that don't
go in DATA instead, thus increasing the size of the executable. */
if (!flag_no_common
&& TREE_CODE (var_decl) == VAR_DECL
+ && TREE_PUBLIC (var_decl)
&& !have_global_bss_p ())
DECL_COMMON (var_decl) = 1;
- DECL_INITIAL (var_decl) = var_init;
- TREE_READONLY (var_decl) = const_flag;
- DECL_EXTERNAL (var_decl) = extern_flag;
- TREE_PUBLIC (var_decl) = public_flag || extern_flag;
- TREE_CONSTANT (var_decl) = constant_p;
- TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl)
- = TYPE_VOLATILE (type);
/* If it's public and not external, always allocate storage for it.
At the global binding level we need to allocate static storage for the
TREE_STATIC (var_decl)
= !extern_flag && (public_flag || static_flag || global_bindings_p ());
- if (asm_name && VAR_OR_FUNCTION_DECL_P (var_decl))
- SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
+ /* For an external constant whose initializer is not absolute, do not emit
+ debug info. In DWARF this would mean a global relocation in a read-only
+ section which runs afoul of the PE-COFF runtime relocation mechanism. */
+ if (extern_flag
+ && constant_p
+ && initializer_constant_valid_p (var_init, TREE_TYPE (var_init))
+ != null_pointer_node)
+ DECL_IGNORED_P (var_decl) = 1;
- process_attributes (var_decl, attr_list);
+ if (TREE_CODE (var_decl) == VAR_DECL)
+ {
+ if (asm_name)
+ SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
+ process_attributes (var_decl, attr_list);
+ }
/* Add this decl to the current binding level. */
gnat_pushdecl (var_decl, gnat_node);
}
}
-/* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
- type, and RECORD_TYPE is the type of the parent. PACKED is nonzero if
- this field is in a record type with a "pragma pack". If SIZE is nonzero
- it is the specified size for this field. If POS is nonzero, it is the bit
- position. If ADDRESSABLE is nonzero, it means we are allowed to take
- the address of this field for aliasing purposes. If it is negative, we
- should not make a bitfield, which is used by make_aligning_type. */
+/* 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. PACKED is
+ 1 if the enclosing record is packed, -1 if it has Component_Alignment of
+ Storage_Unit. If SIZE is nonzero, it is the specified size of the field.
+ If POS is nonzero, it is the bit position. If ADDRESSABLE is nonzero, it
+ means we are allowed to take the address of the field; if it is negative,
+ we should not make a bitfield, which is used by make_aligning_type. */
tree
create_field_decl (tree field_name, tree field_type, tree record_type,
int packed, tree size, tree pos, int addressable)
{
- tree field_decl = build_decl (FIELD_DECL, field_name, field_type);
+ tree field_decl = build_decl (input_location,
+ FIELD_DECL, field_name, field_type);
DECL_CONTEXT (field_decl) = record_type;
TREE_READONLY (field_decl) = TYPE_READONLY (field_type);
else if (packed == 1)
{
size = rm_size (field_type);
-
- /* For a constant size larger than MAX_FIXED_MODE_SIZE, round up to
- byte. */
- if (TREE_CODE (size) == INTEGER_CST
- && compare_tree_int (size, MAX_FIXED_MODE_SIZE) > 0)
- size = round_up (size, BITS_PER_UNIT);
+ if (TYPE_MODE (field_type) == BLKmode)
+ size = round_up (size, BITS_PER_UNIT);
}
/* If we may, according to ADDRESSABLE, make a bitfield if a size is
DECL_BIT_FIELD (field_decl) = 1;
DECL_SIZE (field_decl) = size;
if (!packed && !pos)
- DECL_ALIGN (field_decl)
- = (TYPE_ALIGN (record_type) != 0
- ? MIN (TYPE_ALIGN (record_type), TYPE_ALIGN (field_type))
- : TYPE_ALIGN (field_type));
+ {
+ if (TYPE_ALIGN (record_type) != 0
+ && TYPE_ALIGN (record_type) < TYPE_ALIGN (field_type))
+ DECL_ALIGN (field_decl) = TYPE_ALIGN (record_type);
+ else
+ DECL_ALIGN (field_decl) = TYPE_ALIGN (field_type);
+ }
}
DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed;
return field_decl;
}
\f
-/* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
- PARAM_TYPE is its type. READONLY is true if the parameter is
- readonly (either an In parameter or an address of a pass-by-ref
- parameter). */
+/* Return a PARM_DECL node. PARAM_NAME is the name of the parameter and
+ PARAM_TYPE is its type. READONLY is true if the parameter is readonly
+ (either an In parameter or an address of a pass-by-ref parameter). */
tree
create_param_decl (tree param_name, tree param_type, bool readonly)
{
- tree param_decl = build_decl (PARM_DECL, param_name, param_type);
-
- /* Honor targetm.calls.promote_prototypes(), as not doing so can
- lead to various ABI violations. */
- if (targetm.calls.promote_prototypes (param_type)
- && (TREE_CODE (param_type) == INTEGER_TYPE
- || TREE_CODE (param_type) == ENUMERAL_TYPE
- || TREE_CODE (param_type) == BOOLEAN_TYPE)
+ tree param_decl = build_decl (input_location,
+ PARM_DECL, param_name, param_type);
+
+ /* Honor TARGET_PROMOTE_PROTOTYPES like the C compiler, as not doing so
+ can lead to various ABI violations. */
+ if (targetm.calls.promote_prototypes (NULL_TREE)
+ && INTEGRAL_TYPE_P (param_type)
&& TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
{
/* We have to be careful about biased types here. Make a subtype
if (TREE_CODE (param_type) == INTEGER_TYPE
&& TYPE_BIASED_REPRESENTATION_P (param_type))
{
- param_type
- = copy_type (build_range_type (integer_type_node,
- TYPE_MIN_VALUE (param_type),
- TYPE_MAX_VALUE (param_type)));
-
- TYPE_BIASED_REPRESENTATION_P (param_type) = 1;
+ tree subtype
+ = make_unsigned_type (TYPE_PRECISION (integer_type_node));
+ TREE_TYPE (subtype) = integer_type_node;
+ TYPE_BIASED_REPRESENTATION_P (subtype) = 1;
+ SET_TYPE_RM_MIN_VALUE (subtype, TYPE_MIN_VALUE (param_type));
+ SET_TYPE_RM_MAX_VALUE (subtype, TYPE_MAX_VALUE (param_type));
+ param_type = subtype;
}
else
param_type = integer_type_node;
}
}
\f
-/* Record a global renaming pointer. */
+/* Record DECL as a global renaming pointer. */
void
record_global_renaming_pointer (tree decl)
tree
create_label_decl (tree label_name)
{
- tree label_decl = build_decl (LABEL_DECL, label_name, void_type_node);
+ tree label_decl = build_decl (input_location,
+ LABEL_DECL, label_name, void_type_node);
DECL_CONTEXT (label_decl) = current_function_decl;
DECL_MODE (label_decl) = VOIDmode;
struct attrib *attr_list, Node_Id gnat_node)
{
tree return_type = TREE_TYPE (subprog_type);
- tree subprog_decl = build_decl (FUNCTION_DECL, subprog_name, subprog_type);
+ tree subprog_decl = build_decl (input_location,
+ FUNCTION_DECL, subprog_name, subprog_type);
/* If this is a non-inline function nested inside an inlined external
function, we cannot honor both requests without cloning the nested
TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type);
DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag;
DECL_ARGUMENTS (subprog_decl) = param_decl_list;
- DECL_RESULT (subprog_decl) = build_decl (RESULT_DECL, 0, return_type);
+ DECL_RESULT (subprog_decl) = build_decl (input_location,
+ RESULT_DECL, 0, return_type);
DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
to be declared as the "main" function literally by default. Ada
program entry points are typically declared with a different name
within the binder generated file, exported as 'main' to satisfy the
- system expectations. Redirect main_identifier_node in this case. */
+ system expectations. Force main_identifier_node in this case. */
if (asm_name == main_identifier_node)
- main_identifier_node = DECL_NAME (subprog_decl);
+ DECL_NAME (subprog_decl) = main_identifier_node;
}
process_attributes (subprog_decl, attr_list);
pointer_set_destroy (p_set);
}
-/* Finish the definition of the current subprogram BODY and compile it all the
- way to assembler language output. ELAB_P tells if this is called for an
- elaboration routine, to be entirely discarded if empty. */
+/* Finish the definition of the current subprogram BODY and finalize it. */
void
-end_subprog_body (tree body, bool elab_p)
+end_subprog_body (tree body)
{
tree fndecl = current_function_decl;
/* Perform the required pre-gimplification transformations on the tree. */
gnat_genericize (fndecl);
- /* We do different things for nested and non-nested functions.
- ??? This should be in cgraph. */
- if (!DECL_CONTEXT (fndecl))
- {
- gnat_gimplify_function (fndecl);
+ /* Dump functions before gimplification. */
+ dump_function (TDI_original, fndecl);
- /* If this is an empty elaboration proc, just discard the node.
- Otherwise, compile further. */
- if (elab_p && empty_body_p (gimple_body (fndecl)))
- cgraph_remove_node (cgraph_node (fndecl));
- else
- cgraph_finalize_function (fndecl, false);
- }
+ /* ??? This special handling of nested functions is probably obsolete. */
+ if (!DECL_CONTEXT (fndecl))
+ cgraph_finalize_function (fndecl, false);
else
/* Register this function with cgraph just far enough to get it
added to our parent's nested function list. */
(void) cgraph_node (fndecl);
}
-/* Convert FNDECL's code to GIMPLE and handle any nested functions. */
-
-static void
-gnat_gimplify_function (tree fndecl)
-{
- struct cgraph_node *cgn;
-
- dump_function (TDI_original, fndecl);
- gimplify_function_tree (fndecl);
- dump_function (TDI_generic, fndecl);
-
- /* Convert all nested functions to GIMPLE now. We do things in this order
- so that items like VLA sizes are expanded properly in the context of the
- correct function. */
- cgn = cgraph_node (fndecl);
- for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
- gnat_gimplify_function (cgn->decl);
-}
-
tree
gnat_builtin_function (tree decl)
{
{
if (mode == BLKmode)
return NULL_TREE;
- else if (mode == VOIDmode)
+
+ if (mode == VOIDmode)
return void_type_node;
- else if (COMPLEX_MODE_P (mode))
+
+ if (COMPLEX_MODE_P (mode))
return NULL_TREE;
- else if (SCALAR_FLOAT_MODE_P (mode))
+
+ if (SCALAR_FLOAT_MODE_P (mode))
return float_type_for_precision (GET_MODE_PRECISION (mode), mode);
- else if (SCALAR_INT_MODE_P (mode))
+
+ if (SCALAR_INT_MODE_P (mode))
return gnat_type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
- else
- return NULL_TREE;
+
+ if (VECTOR_MODE_P (mode))
+ {
+ enum machine_mode inner_mode = GET_MODE_INNER (mode);
+ tree inner_type = gnat_type_for_mode (inner_mode, unsignedp);
+ if (inner_type)
+ return build_vector_type_for_mode (inner_type, mode);
+ }
+
+ return NULL_TREE;
}
/* Return the unsigned version of a TYPE_NODE, a scalar type. */
if ((code = TREE_CODE (t1)) != TREE_CODE (t2))
return 0;
+ /* Vector types are also compatible if they have the same number of subparts
+ and the same form of (scalar) element type. */
+ if (code == VECTOR_TYPE
+ && TYPE_VECTOR_SUBPARTS (t1) == TYPE_VECTOR_SUBPARTS (t2)
+ && TREE_CODE (TREE_TYPE (t1)) == TREE_CODE (TREE_TYPE (t2))
+ && TYPE_PRECISION (TREE_TYPE (t1)) == TYPE_PRECISION (TREE_TYPE (t2)))
+ return 1;
+
/* Array types are also compatible if they are constrained and have
the same component type and the same domain. */
if (code == ARRAY_TYPE
/* Padding record types are also compatible if they pad the same
type and have the same constant size. */
if (code == RECORD_TYPE
- && TYPE_IS_PADDING_P (t1) && TYPE_IS_PADDING_P (t2)
+ && TYPE_PADDING_P (t1) && TYPE_PADDING_P (t2)
&& TREE_TYPE (TYPE_FIELDS (t1)) == TREE_TYPE (TYPE_FIELDS (t2))
&& tree_int_cst_equal (TYPE_SIZE (t1), TYPE_SIZE (t2)))
return 1;
case tcc_vl_exp:
if (code == CALL_EXPR)
{
- tree *argarray;
- int i, n = call_expr_nargs (exp);
- gcc_assert (n > 0);
+ tree t, *argarray;
+ int n, i;
+ t = maybe_inline_call_in_expr (exp);
+ if (t)
+ return max_size (t, max_p);
+
+ n = call_expr_nargs (exp);
+ gcc_assert (n > 0);
argarray = (tree *) alloca (n * sizeof (tree));
for (i = 0; i < n; i++)
argarray[i] = max_size (CALL_EXPR_ARG (exp, i), max_p);
tree field;
while (TREE_CODE (array_type) == RECORD_TYPE
- && (TYPE_IS_PADDING_P (array_type)
+ && (TYPE_PADDING_P (array_type)
|| TYPE_JUSTIFIED_MODULAR_P (array_type)))
array_type = TREE_TYPE (TYPE_FIELDS (array_type));
tree record_type = make_node (RECORD_TYPE);
tree pointer32_type;
tree field_list = 0;
- int class;
+ int klass;
int dtype = 0;
tree inner_type;
int ndim;
{
case By_Descriptor_A:
case By_Short_Descriptor_A:
- class = 4;
+ klass = 4;
break;
case By_Descriptor_NCA:
case By_Short_Descriptor_NCA:
- class = 10;
+ klass = 10;
break;
case By_Descriptor_SB:
case By_Short_Descriptor_SB:
- class = 15;
+ klass = 15;
break;
case By_Descriptor:
case By_Short_Descriptor:
case By_Descriptor_S:
case By_Short_Descriptor_S:
default:
- class = 1;
+ klass = 1;
break;
}
field_list = chainon (field_list,
make_descriptor_field ("CLASS",
gnat_type_for_size (8, 1),
- record_type, size_int (class)));
+ record_type, size_int (klass)));
/* Of course this will crash at run-time if the address space is not
within the low 32 bits, but there is nothing else we can do. */
}
TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC");
- finish_record_type (record_type, field_list, 0, true);
+ finish_record_type (record_type, field_list, 0, false);
return record_type;
}
tree record64_type = make_node (RECORD_TYPE);
tree pointer64_type;
tree field_list64 = 0;
- int class;
+ int klass;
int dtype = 0;
tree inner_type;
int ndim;
switch (mech)
{
case By_Descriptor_A:
- class = 4;
+ klass = 4;
break;
case By_Descriptor_NCA:
- class = 10;
+ klass = 10;
break;
case By_Descriptor_SB:
- class = 15;
+ klass = 15;
break;
case By_Descriptor:
case By_Descriptor_S:
default:
- class = 1;
+ klass = 1;
break;
}
field_list64 = chainon (field_list64,
make_descriptor_field ("CLASS",
gnat_type_for_size (8, 1),
- record64_type, size_int (class)));
+ record64_type, size_int (klass)));
field_list64 = chainon (field_list64,
make_descriptor_field ("MBMO",
}
TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64");
- finish_record_type (record64_type, field_list64, 0, true);
+ finish_record_type (record64_type, field_list64, 0, false);
return record64_type;
}
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
/* The CLASS field is the 3rd field in the descriptor. */
- tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
+ tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
/* The POINTER field is the 6th field in the descriptor. */
- tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (class)));
+ tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
/* Retrieve the value of the POINTER field. */
tree gnu_expr64
if (POINTER_TYPE_P (gnu_type))
return convert (gnu_type, gnu_expr64);
- else if (TYPE_FAT_POINTER_P (gnu_type))
+ else if (TYPE_IS_FAT_POINTER_P (gnu_type))
{
tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
tree template_type = TREE_TYPE (p_bounds_type);
tree min_field = TYPE_FIELDS (template_type);
tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
- tree template, template_addr, aflags, dimct, t, u;
+ tree template_tree, template_addr, aflags, dimct, t, u;
/* See the head comment of build_vms_descriptor. */
- int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
+ int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
tree lfield, ufield;
/* Convert POINTER to the type of the P_ARRAY field. */
gnu_expr64 = convert (p_array_type, gnu_expr64);
- switch (iclass)
+ switch (iklass)
{
case 1: /* Class S */
case 15: /* Class SB */
/* Build {1, LENGTH} template; LENGTH64 is the 5th field. */
- t = TREE_CHAIN (TREE_CHAIN (class));
+ t = TREE_CHAIN (TREE_CHAIN (klass));
t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
t = tree_cons (min_field,
convert (TREE_TYPE (min_field), integer_one_node),
tree_cons (max_field,
convert (TREE_TYPE (max_field), t),
NULL_TREE));
- template = gnat_build_constructor (template_type, t);
- template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
+ template_tree = gnat_build_constructor (template_type, t);
+ template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree);
/* For class S, we are done. */
- if (iclass == 1)
+ if (iklass == 1)
break;
/* Test that we really have a SB descriptor, like DEC Ada. */
- t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL);
- u = convert (TREE_TYPE (class), DECL_INITIAL (class));
+ t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL);
+ u = convert (TREE_TYPE (klass), DECL_INITIAL (klass));
u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
/* If so, there is already a template in the descriptor and
it is located right after the POINTER field. The fields are
t = tree_cons (TYPE_FIELDS (template_type), lfield,
tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
ufield, NULL_TREE));
- template = gnat_build_constructor (template_type, t);
+ template_tree = gnat_build_constructor (template_type, t);
/* Otherwise use the {1, LENGTH} template we build above. */
template_addr = build3 (COND_EXPR, p_bounds_type, u,
build_unary_op (ADDR_EXPR, p_bounds_type,
- template),
+ template_tree),
template_addr);
break;
t = tree_cons (TYPE_FIELDS (template_type), lfield,
tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
ufield, NULL_TREE));
- template = gnat_build_constructor (template_type, t);
- template = build3 (COND_EXPR, p_bounds_type, u,
+ template_tree = gnat_build_constructor (template_type, t);
+ template_tree = build3 (COND_EXPR, template_type, u,
build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error),
- template);
- template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
+ template_tree);
+ template_addr
+ = build_unary_op (ADDR_EXPR, p_bounds_type, template_tree);
break;
case 10: /* Class NCA */
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
/* The CLASS field is the 3rd field in the descriptor. */
- tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
+ tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
/* The POINTER field is the 4th field in the descriptor. */
- tree pointer = TREE_CHAIN (class);
+ tree pointer = TREE_CHAIN (klass);
/* Retrieve the value of the POINTER field. */
tree gnu_expr32
if (POINTER_TYPE_P (gnu_type))
return convert (gnu_type, gnu_expr32);
- else if (TYPE_FAT_POINTER_P (gnu_type))
+ else if (TYPE_IS_FAT_POINTER_P (gnu_type))
{
tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
tree template_type = TREE_TYPE (p_bounds_type);
tree min_field = TYPE_FIELDS (template_type);
tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
- tree template, template_addr, aflags, dimct, t, u;
+ tree template_tree, template_addr, aflags, dimct, t, u;
/* See the head comment of build_vms_descriptor. */
- int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
+ int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
/* Convert POINTER to the type of the P_ARRAY field. */
gnu_expr32 = convert (p_array_type, gnu_expr32);
- switch (iclass)
+ switch (iklass)
{
case 1: /* Class S */
case 15: /* Class SB */
tree_cons (max_field,
convert (TREE_TYPE (max_field), t),
NULL_TREE));
- template = gnat_build_constructor (template_type, t);
- template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
+ template_tree = gnat_build_constructor (template_type, t);
+ template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree);
/* For class S, we are done. */
- if (iclass == 1)
+ if (iklass == 1)
break;
/* Test that we really have a SB descriptor, like DEC Ada. */
- t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL);
- u = convert (TREE_TYPE (class), DECL_INITIAL (class));
+ t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL);
+ u = convert (TREE_TYPE (klass), DECL_INITIAL (klass));
u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
/* If so, there is already a template in the descriptor and
it is located right after the POINTER field. */
t = TREE_CHAIN (pointer);
- template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ template_tree
+ = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
/* Otherwise use the {1, LENGTH} template we build above. */
template_addr = build3 (COND_EXPR, p_bounds_type, u,
build_unary_op (ADDR_EXPR, p_bounds_type,
- template),
+ template_tree),
template_addr);
break;
/* There is already a template in the descriptor and it is
located at the start of block 3 (12th field). */
t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
- template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
- template = build3 (COND_EXPR, p_bounds_type, u,
+ template_tree
+ = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
+ template_tree = build3 (COND_EXPR, TREE_TYPE (t), u,
build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error),
- template);
- template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
+ template_tree);
+ template_addr
+ = build_unary_op (ADDR_EXPR, p_bounds_type, template_tree);
break;
case 10: /* Class NCA */
gnat_poplevel ();
allocate_struct_function (gnu_stub_decl, false);
- end_subprog_body (gnu_body, false);
+ end_subprog_body (gnu_body);
}
\f
/* Build a type to be used to represent an aliased object whose nominal
finish_record_type (type,
chainon (chainon (NULL_TREE, template_field),
array_field),
- 0, false);
+ 0, true);
return type;
}
{
tree template_type;
- gcc_assert (TYPE_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type));
+ gcc_assert (TYPE_IS_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type));
template_type
- = (TYPE_FAT_POINTER_P (thin_fat_ptr_type)
+ = (TYPE_IS_FAT_POINTER_P (thin_fat_ptr_type)
? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type))))
: TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type))));
return build_unc_object_type (template_type, object_type, name);
/* Now deal with the unconstrained array case. In this case the "pointer"
is actually a RECORD_TYPE where both fields are pointers to dummy nodes.
Turn them into pointers to the correct types using update_pointer_to. */
- else if (!TYPE_FAT_POINTER_P (ptr))
+ else if (!TYPE_IS_FAT_POINTER_P (ptr))
gcc_unreachable ();
else
TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
= TREE_TYPE (new_type) = ptr;
+ /* And show the original pointer NEW_PTR to the debugger. This is the
+ counterpart of the equivalent processing in gnat_pushdecl when the
+ unconstrained array type is frozen after access types to it. Note
+ that update_pointer_to can be invoked multiple times on the same
+ couple of types because of the type variants. */
+ if (TYPE_NAME (ptr)
+ && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL
+ && !DECL_ORIGINAL_TYPE (TYPE_NAME (ptr)))
+ {
+ DECL_ORIGINAL_TYPE (TYPE_NAME (ptr)) = new_ptr;
+ DECL_ARTIFICIAL (TYPE_NAME (ptr)) = 0;
+ }
for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))));
tree p_array_type = TREE_TYPE (TYPE_FIELDS (type));
tree etype = TREE_TYPE (expr);
- tree template;
+ tree template_tree;
/* If EXPR is null, make a fat pointer that contains null pointers to the
template and array. */
NULL_TREE)));
/* If EXPR is a thin pointer, make template and data from the record.. */
- else if (TYPE_THIN_POINTER_P (etype))
+ else if (TYPE_IS_THIN_POINTER_P (etype))
{
tree fields = TYPE_FIELDS (TREE_TYPE (etype));
else
expr = build1 (INDIRECT_REF, TREE_TYPE (etype), expr);
- template = build_component_ref (expr, NULL_TREE, fields, false);
+ template_tree = build_component_ref (expr, NULL_TREE, fields, false);
expr = build_unary_op (ADDR_EXPR, NULL_TREE,
build_component_ref (expr, NULL_TREE,
TREE_CHAIN (fields), false));
/* Otherwise, build the constructor for the template. */
else
- template = build_template (template_type, TREE_TYPE (etype), expr);
+ template_tree = build_template (template_type, TREE_TYPE (etype), expr);
/* The final result is a constructor for the fat pointer.
tree_cons (TYPE_FIELDS (type),
convert (p_array_type, expr),
tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
- build_unary_op (ADDR_EXPR, NULL_TREE, template),
+ build_unary_op (ADDR_EXPR, NULL_TREE,
+ template_tree),
NULL_TREE)));
}
\f
static tree
convert_to_thin_pointer (tree type, tree expr)
{
- if (!TYPE_FAT_POINTER_P (TREE_TYPE (expr)))
+ if (!TYPE_IS_FAT_POINTER_P (TREE_TYPE (expr)))
expr
= convert_to_fat_pointer
(TREE_TYPE (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type))), expr);
as an unchecked conversion. Likewise if one is a mere variant of the
other, so we avoid a pointless unpad/repad sequence. */
else if (code == RECORD_TYPE && ecode == RECORD_TYPE
- && TYPE_IS_PADDING_P (type) && TYPE_IS_PADDING_P (etype)
+ && TYPE_PADDING_P (type) && TYPE_PADDING_P (etype)
&& (!TREE_CONSTANT (TYPE_SIZE (type))
|| !TREE_CONSTANT (TYPE_SIZE (etype))
|| gnat_types_compatible_p (type, etype)
== TYPE_NAME (TREE_TYPE (TYPE_FIELDS (etype)))))
;
- /* If the output type has padding, convert to the inner type and
- make a constructor to build the record. */
- else if (code == RECORD_TYPE && TYPE_IS_PADDING_P (type))
+ /* If the output type has padding, convert to the inner type and make a
+ constructor to build the record, unless a variable size is involved. */
+ else if (code == RECORD_TYPE && TYPE_PADDING_P (type))
{
/* If we previously converted from another type and our type is
of variable size, remove the conversion to avoid the need for
- variable-size temporaries. Likewise for a conversion between
+ variable-sized temporaries. Likewise for a conversion between
original and packable version. */
if (TREE_CODE (expr) == VIEW_CONVERT_EXPR
&& (!TREE_CONSTANT (TYPE_SIZE (type))
/* If we are just removing the padding from expr, convert the original
object if we have variable size in order to avoid the need for some
- variable-size temporaries. Likewise if the padding is a mere variant
+ variable-sized temporaries. Likewise if the padding is a variant
of the other, so we avoid a pointless unpad/repad sequence. */
if (TREE_CODE (expr) == COMPONENT_REF
- && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0)))
&& (!TREE_CONSTANT (TYPE_SIZE (type))
|| gnat_types_compatible_p (type,
== TYPE_NAME (TREE_TYPE (TYPE_FIELDS (type))))))
return convert (type, TREE_OPERAND (expr, 0));
- /* If the result type is a padded type with a self-referentially-sized
- field and the expression type is a record, do this as an
- unchecked conversion. */
- else if (TREE_CODE (etype) == RECORD_TYPE
- && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
- return unchecked_convert (type, expr, false);
+ /* If the inner type is of self-referential size and the expression type
+ is a record, do this as an unchecked conversion. But first pad the
+ expression if possible to have the same size on both sides. */
+ if (TREE_CODE (etype) == RECORD_TYPE
+ && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
+ {
+ if (TREE_CONSTANT (TYPE_SIZE (etype)))
+ expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
+ false, false, false, true), expr);
+ return unchecked_convert (type, expr, false);
+ }
- else
- return
- gnat_build_constructor (type,
- tree_cons (TYPE_FIELDS (type),
- convert (TREE_TYPE
- (TYPE_FIELDS (type)),
- expr),
- NULL_TREE));
+ /* If we are converting between array types with variable size, do the
+ final conversion as an unchecked conversion, again to avoid the need
+ for some variable-sized temporaries. If valid, this conversion is
+ very likely purely technical and without real effects. */
+ if (TREE_CODE (etype) == ARRAY_TYPE
+ && TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE
+ && !TREE_CONSTANT (TYPE_SIZE (etype))
+ && !TREE_CONSTANT (TYPE_SIZE (type)))
+ return unchecked_convert (type,
+ convert (TREE_TYPE (TYPE_FIELDS (type)),
+ expr),
+ false);
+
+ return
+ gnat_build_constructor (type,
+ tree_cons (TYPE_FIELDS (type),
+ convert (TREE_TYPE
+ (TYPE_FIELDS (type)),
+ expr),
+ NULL_TREE));
}
/* If the input type has padding, remove it and convert to the output type.
The conditions ordering is arranged to ensure that the output type is not
a padding type here, as it is not clear whether the conversion would
always be correct if this was to happen. */
- else if (ecode == RECORD_TYPE && TYPE_IS_PADDING_P (etype))
+ else if (ecode == RECORD_TYPE && TYPE_PADDING_P (etype))
{
tree unpadded;
}
break;
+ case VECTOR_CST:
+ /* If we are converting a VECTOR_CST to a mere variant type, just make
+ a new one in the proper type. */
+ if (code == ecode && gnat_types_compatible_p (type, etype))
+ {
+ expr = copy_node (expr);
+ TREE_TYPE (expr) = type;
+ return expr;
+ }
+
case CONSTRUCTOR:
/* If we are converting a CONSTRUCTOR to a mere variant type, just make
a new one in the proper type. */
unsigned HOST_WIDE_INT idx;
tree index, value;
+ /* Whether we need to clear TREE_CONSTANT et al. on the output
+ constructor when we convert in place. */
+ bool clear_constant = false;
+
FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
{
constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
break;
elt->index = field;
elt->value = convert (TREE_TYPE (field), value);
+
+ /* If packing has made this field a bitfield and the input
+ value couldn't be emitted statically any more, we need to
+ clear TREE_CONSTANT on our output. */
+ if (!clear_constant && TREE_CONSTANT (expr)
+ && !CONSTRUCTOR_BITFIELD_P (efield)
+ && CONSTRUCTOR_BITFIELD_P (field)
+ && !initializer_constant_valid_for_bitfield_p (value))
+ clear_constant = true;
+
efield = TREE_CHAIN (efield);
field = TREE_CHAIN (field);
}
+ /* If we have been able to match and convert all the input fields
+ to their output type, convert in place now. We'll fallback to a
+ view conversion downstream otherwise. */
if (idx == len)
{
expr = copy_node (expr);
TREE_TYPE (expr) = type;
CONSTRUCTOR_ELTS (expr) = v;
+ if (clear_constant)
+ TREE_CONSTANT (expr) = TREE_STATIC (expr) = false;
return expr;
}
}
+
+ /* Likewise for a conversion between array type and vector type with a
+ compatible representative array. */
+ else if (code == VECTOR_TYPE
+ && ecode == ARRAY_TYPE
+ && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
+ etype))
+ {
+ VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr);
+ unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e);
+ VEC(constructor_elt,gc) *v;
+ unsigned HOST_WIDE_INT ix;
+ tree value;
+
+ /* Build a VECTOR_CST from a *constant* array constructor. */
+ if (TREE_CONSTANT (expr))
+ {
+ bool constant_p = true;
+
+ /* Iterate through elements and check if all constructor
+ elements are *_CSTs. */
+ FOR_EACH_CONSTRUCTOR_VALUE (e, ix, value)
+ if (!CONSTANT_CLASS_P (value))
+ {
+ constant_p = false;
+ break;
+ }
+
+ if (constant_p)
+ return build_vector_from_ctor (type,
+ CONSTRUCTOR_ELTS (expr));
+ }
+
+ /* Otherwise, build a regular vector constructor. */
+ v = VEC_alloc (constructor_elt, gc, len);
+ FOR_EACH_CONSTRUCTOR_VALUE (e, ix, value)
+ {
+ constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
+ elt->index = NULL_TREE;
+ elt->value = value;
+ }
+ expr = copy_node (expr);
+ TREE_TYPE (expr) = type;
+ CONSTRUCTOR_ELTS (expr) = v;
+ return expr;
+ }
break;
case UNCONSTRAINED_ARRAY_REF:
if (type == TREE_TYPE (op0))
return op0;
- /* Otherwise, if we're converting between two aggregate types, we
- might be allowed to substitute the VIEW_CONVERT_EXPR target type
- in place or to just convert the inner expression. */
- if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
+ /* Otherwise, if we're converting between two aggregate or vector
+ types, we might be allowed to substitute the VIEW_CONVERT_EXPR
+ target type in place or to just convert the inner expression. */
+ if ((AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
+ || (VECTOR_TYPE_P (type) && VECTOR_TYPE_P (etype)))
{
/* If we are converting between mere variants, we can just
substitute the VIEW_CONVERT_EXPR in place. */
/* Otherwise, we may just bypass the input view conversion unless
one of the types is a fat pointer, which is handled by
specialized code below which relies on exact type matching. */
- else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
+ else if (!TYPE_IS_FAT_POINTER_P (type)
+ && !TYPE_IS_FAT_POINTER_P (etype))
return convert (type, op0);
}
}
|| TREE_CODE (type) == UNION_TYPE)
&& (TREE_CODE (etype) == RECORD_TYPE
|| TREE_CODE (etype) == UNION_TYPE)
- && !TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
+ && !TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype))
return build_unary_op (INDIRECT_REF, NULL_TREE,
convert (build_pointer_type (type),
TREE_OPERAND (expr, 0)));
}
/* Check for converting to a pointer to an unconstrained array. */
- if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
+ if (TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype))
return convert_to_fat_pointer (type, expr);
- /* If we are converting between two aggregate types that are mere
- variants, just make a VIEW_CONVERT_EXPR. */
- else if (code == ecode
- && AGGREGATE_TYPE_P (type)
- && gnat_types_compatible_p (type, etype))
+ /* If we are converting between two aggregate or vector types that are mere
+ variants, just make a VIEW_CONVERT_EXPR. Likewise when we are converting
+ to a vector type from its representative array type. */
+ else if ((code == ecode
+ && (AGGREGATE_TYPE_P (type) || VECTOR_TYPE_P (type))
+ && gnat_types_compatible_p (type, etype))
+ || (code == VECTOR_TYPE
+ && ecode == ARRAY_TYPE
+ && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
+ etype)))
return build1 (VIEW_CONVERT_EXPR, type, expr);
/* In all other cases of related types, make a NOP_EXPR. */
/* If converting between two pointers to records denoting
both a template and type, adjust if needed to account
for any differing offsets, since one might be negative. */
- if (TYPE_THIN_POINTER_P (etype) && TYPE_THIN_POINTER_P (type))
+ if (TYPE_IS_THIN_POINTER_P (etype) && TYPE_IS_THIN_POINTER_P (type))
{
tree bit_diff
= size_diffop (bit_position (TYPE_FIELDS (TREE_TYPE (etype))),
}
/* If converting to a thin pointer, handle specially. */
- if (TYPE_THIN_POINTER_P (type)
+ if (TYPE_IS_THIN_POINTER_P (type)
&& TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)))
return convert_to_thin_pointer (type, expr);
/* If converting fat pointer to normal pointer, get the pointer to the
array and then convert it. */
- else if (TYPE_FAT_POINTER_P (etype))
+ else if (TYPE_IS_FAT_POINTER_P (etype))
expr = build_component_ref (expr, get_identifier ("P_ARRAY"),
NULL_TREE, false);
return unchecked_convert (type, expr, false);
case UNCONSTRAINED_ARRAY_TYPE:
+ /* If the input is a VECTOR_TYPE, convert to the representative
+ array type first. */
+ if (ecode == VECTOR_TYPE)
+ {
+ expr = convert (TYPE_REPRESENTATIVE_ARRAY (etype), expr);
+ etype = TREE_TYPE (expr);
+ ecode = TREE_CODE (etype);
+ }
+
/* If EXPR is a constrained array, take its address, convert it to a
fat pointer, and then dereference it. Likewise if EXPR is a
record containing both a template and a constrained array.
break;
case COMPONENT_REF:
- if (TREE_CODE (TREE_TYPE (TREE_OPERAND (exp, 0))) == RECORD_TYPE
- && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
+ if (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
return remove_conversions (TREE_OPERAND (exp, 0), true_address);
break;
maybe_unconstrained_array (tree exp)
{
enum tree_code code = TREE_CODE (exp);
- tree new;
+ tree new_exp;
switch (TREE_CODE (TREE_TYPE (exp)))
{
case UNCONSTRAINED_ARRAY_TYPE:
if (code == UNCONSTRAINED_ARRAY_REF)
{
- new
+ new_exp
= build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (exp, 0),
get_identifier ("P_ARRAY"),
NULL_TREE, false));
- TREE_READONLY (new) = TREE_STATIC (new) = TREE_READONLY (exp);
- return new;
+ TREE_READONLY (new_exp) = TREE_STATIC (new_exp)
+ = TREE_READONLY (exp);
+ return new_exp;
}
else if (code == NULL_EXPR)
case RECORD_TYPE:
/* If this is a padded type, convert to the unpadded type and see if
it contains a template. */
- if (TYPE_IS_PADDING_P (TREE_TYPE (exp)))
+ if (TYPE_PADDING_P (TREE_TYPE (exp)))
{
- new = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
- if (TREE_CODE (TREE_TYPE (new)) == RECORD_TYPE
- && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new)))
+ new_exp = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
+ if (TREE_CODE (TREE_TYPE (new_exp)) == RECORD_TYPE
+ && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new_exp)))
return
- build_component_ref (new, NULL_TREE,
- TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new))),
+ build_component_ref (new_exp, NULL_TREE,
+ TREE_CHAIN
+ (TYPE_FIELDS (TREE_TYPE (new_exp))),
0);
}
else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
return exp;
}
+
+/* If EXP's type is a VECTOR_TYPE, return EXP converted to the associated
+ TYPE_REPRESENTATIVE_ARRAY. */
+
+tree
+maybe_vector_array (tree exp)
+{
+ tree etype = TREE_TYPE (exp);
+
+ if (VECTOR_TYPE_P (etype))
+ exp = convert (TYPE_REPRESENTATIVE_ARRAY (etype), exp);
+
+ return exp;
+}
\f
/* Return true if EXPR is an expression that can be folded as an operand
- of a VIEW_CONVERT_EXPR. See the head comment of unchecked_convert for
- the rationale. */
+ of a VIEW_CONVERT_EXPR. See ada-tree.h for a complete rationale. */
static bool
can_fold_for_view_convert_p (tree expr)
we expect the 8 bits at Vbits'Address to always contain Value, while
their original location depends on the endianness, at Value'Address
- on a little-endian architecture but not on a big-endian one.
-
- ??? There is a problematic discrepancy between what is called precision
- here (and more generally throughout gigi) for integral types and what is
- called precision in the middle-end. In the former case it's the RM size
- as given by TYPE_RM_SIZE (or rm_size) whereas it's TYPE_PRECISION in the
- latter case, the hitch being that they are not equal when they matter,
- that is when the number of value bits is not equal to the type's size:
- TYPE_RM_SIZE does give the number of value bits but TYPE_PRECISION is set
- to the size. The sole exception are BOOLEAN_TYPEs for which both are 1.
-
- The consequence is that gigi must duplicate code bridging the gap between
- the type's size and its precision that exists for TYPE_PRECISION in the
- middle-end, because the latter knows nothing about TYPE_RM_SIZE, and be
- wary of transformations applied in the middle-end based on TYPE_PRECISION
- because this value doesn't reflect the actual precision for Ada. */
+ on a little-endian architecture but not on a big-endian one. */
tree
unchecked_convert (tree type, tree expr, bool notrunc_p)
if ((((INTEGRAL_TYPE_P (type)
&& !(TREE_CODE (type) == INTEGER_TYPE
&& TYPE_VAX_FLOATING_POINT_P (type)))
- || (POINTER_TYPE_P (type) && ! TYPE_THIN_POINTER_P (type))
+ || (POINTER_TYPE_P (type) && ! TYPE_IS_THIN_POINTER_P (type))
|| (TREE_CODE (type) == RECORD_TYPE
&& TYPE_JUSTIFIED_MODULAR_P (type)))
&& ((INTEGRAL_TYPE_P (etype)
&& !(TREE_CODE (etype) == INTEGER_TYPE
&& TYPE_VAX_FLOATING_POINT_P (etype)))
- || (POINTER_TYPE_P (etype) && !TYPE_THIN_POINTER_P (etype))
+ || (POINTER_TYPE_P (etype) && !TYPE_IS_THIN_POINTER_P (etype))
|| (TREE_CODE (etype) == RECORD_TYPE
&& TYPE_JUSTIFIED_MODULAR_P (etype))))
|| TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
expr = convert (rtype, expr);
expr = build1 (NOP_EXPR, type, expr);
}
-
- /* We have another special case: if we are unchecked converting either
- a subtype or a type with limited range into a base type, we need to
- ensure that VRP doesn't propagate range information because this
- conversion may be done precisely to validate that the object is
- within the range it is supposed to have. */
- else if (TREE_CODE (expr) != INTEGER_CST
- && TREE_CODE (type) == INTEGER_TYPE && !TREE_TYPE (type)
- && ((TREE_CODE (etype) == INTEGER_TYPE && TREE_TYPE (etype))
- || TREE_CODE (etype) == ENUMERAL_TYPE
- || TREE_CODE (etype) == BOOLEAN_TYPE))
- {
- /* The optimization barrier is a VIEW_CONVERT_EXPR node; moreover,
- in order not to be deemed an useless type conversion, it must
- be from subtype to base type.
-
- Therefore we first do the bulk of the conversion to a subtype of
- the final type. And this conversion must itself not be deemed
- useless if the source type is not a subtype because, otherwise,
- the final VIEW_CONVERT_EXPR will be deemed so as well. That's
- why we toggle the unsigned flag in this conversion, which is
- harmless since the final conversion is only a reinterpretation
- of the bit pattern.
-
- ??? This may raise addressability and/or aliasing issues because
- VIEW_CONVERT_EXPR gets gimplified as an lvalue, thus causing the
- address of its operand to be taken if it is deemed addressable
- and not already in GIMPLE form. */
- tree rtype
- = gnat_type_for_mode (TYPE_MODE (type), !TYPE_UNSIGNED (etype));
- rtype = copy_type (rtype);
- TYPE_MAIN_VARIANT (rtype) = rtype;
- TREE_TYPE (rtype) = type;
- expr = convert (rtype, expr);
- expr = build1 (VIEW_CONVERT_EXPR, type, expr);
- }
-
else
expr = convert (type, expr);
}
expr = unchecked_convert (type, expr, notrunc_p);
}
- /* We have a special case when we are converting between two
- unconstrained array types. In that case, take the address,
- convert the fat pointer types, and dereference. */
+ /* We have a special case when we are converting between two unconstrained
+ array types. In that case, take the address, convert the fat pointer
+ types, and dereference. */
else if (TREE_CODE (etype) == UNCONSTRAINED_ARRAY_TYPE
&& TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
expr = build_unary_op (INDIRECT_REF, NULL_TREE,
build1 (VIEW_CONVERT_EXPR, TREE_TYPE (type),
build_unary_op (ADDR_EXPR, NULL_TREE,
expr)));
+
+ /* Another special case is when we are converting to a vector type from its
+ representative array type; this a regular conversion. */
+ else if (TREE_CODE (type) == VECTOR_TYPE
+ && TREE_CODE (etype) == ARRAY_TYPE
+ && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
+ etype))
+ expr = convert (type, expr);
+
else
{
expr = maybe_unconstrained_array (expr);
return expr;
}
\f
-/* Return the appropriate GCC tree code for the specified GNAT type,
+/* Return the appropriate GCC tree code for the specified GNAT_TYPE,
the latter being a record type as predicated by Is_Record_Type. */
enum tree_code
return UNION_TYPE;
}
+/* Return true if GNAT_TYPE is a "double" floating-point type, i.e. whose
+ size is equal to 64 bits, or an array of such a type. Set ALIGN_CLAUSE
+ according to the presence of an alignment clause on the type or, if it
+ is an array, on the component type. */
+
+bool
+is_double_float_or_array (Entity_Id gnat_type, bool *align_clause)
+{
+ gnat_type = Underlying_Type (gnat_type);
+
+ *align_clause = Present (Alignment_Clause (gnat_type));
+
+ if (Is_Array_Type (gnat_type))
+ {
+ gnat_type = Underlying_Type (Component_Type (gnat_type));
+ if (Present (Alignment_Clause (gnat_type)))
+ *align_clause = true;
+ }
+
+ if (!Is_Floating_Point_Type (gnat_type))
+ return false;
+
+ if (UI_To_Int (Esize (gnat_type)) != 64)
+ return false;
+
+ return true;
+}
+
+/* Return true if GNAT_TYPE is a "double" or larger scalar type, i.e. whose
+ size is greater or equal to 64 bits, or an array of such a type. Set
+ ALIGN_CLAUSE according to the presence of an alignment clause on the
+ type or, if it is an array, on the component type. */
+
+bool
+is_double_scalar_or_array (Entity_Id gnat_type, bool *align_clause)
+{
+ gnat_type = Underlying_Type (gnat_type);
+
+ *align_clause = Present (Alignment_Clause (gnat_type));
+
+ if (Is_Array_Type (gnat_type))
+ {
+ gnat_type = Underlying_Type (Component_Type (gnat_type));
+ if (Present (Alignment_Clause (gnat_type)))
+ *align_clause = true;
+ }
+
+ if (!Is_Scalar_Type (gnat_type))
+ return false;
+
+ if (UI_To_Int (Esize (gnat_type)) < 64)
+ return false;
+
+ return true;
+}
+
/* Return true if GNU_TYPE is suitable as the type of a non-aliased
component of an aggregate type. */
{
/* Proceed to optimize and emit assembly.
FIXME: shouldn't be the front end's responsibility to call this. */
- cgraph_optimize ();
+ cgraph_finalize_compilation_unit ();
/* Emit debug info for all global declarations. */
emit_debug_global_declarations (VEC_address (tree, global_decls),
va_start (list, n);
for (i = 0; i < n; ++i)
{
- builtin_type a = va_arg (list, builtin_type);
+ builtin_type a = (builtin_type) va_arg (list, int);
t = builtin_types[a];
if (t == error_mark_node)
goto egress;
/* ??? TODO: Support types. */
else
{
- warning (OPT_Wattributes, "%qE attribute ignored", name);
+ warning (OPT_Wattributes, "%qs attribute ignored",
+ IDENTIFIER_POINTER (name));
*no_add_attrs = true;
}
if (!params)
{
warning (OPT_Wattributes,
- "%qE attribute requires prototypes with named arguments", name);
+ "%qs attribute requires prototypes with named arguments",
+ IDENTIFIER_POINTER (name));
*no_add_attrs = true;
}
else
if (VOID_TYPE_P (TREE_VALUE (params)))
{
warning (OPT_Wattributes,
- "%qE attribute only applies to variadic functions", name);
+ "%qs attribute only applies to variadic functions",
+ IDENTIFIER_POINTER (name));
*no_add_attrs = true;
}
}
TYPE_READONLY (TREE_TYPE (type)), 1));
else
{
- warning (OPT_Wattributes, "%qE attribute ignored", name);
+ warning (OPT_Wattributes, "%qs attribute ignored",
+ IDENTIFIER_POINTER (name));
*no_add_attrs = true;
}
DECL_IS_MALLOC (*node) = 1;
else
{
- warning (OPT_Wattributes, "%qE attribute ignored", name);
+ warning (OPT_Wattributes, "%qs attribute ignored",
+ IDENTIFIER_POINTER (name));
*no_add_attrs = true;
}
return NULL_TREE;
}
+/* Handle a "vector_size" attribute; arguments as in
+ struct attribute_spec.handler. */
+
+static tree
+handle_vector_size_attribute (tree *node, tree name, tree args,
+ int ARG_UNUSED (flags),
+ bool *no_add_attrs)
+{
+ unsigned HOST_WIDE_INT vecsize, nunits;
+ enum machine_mode orig_mode;
+ tree type = *node, new_type, size;
+
+ *no_add_attrs = true;
+
+ size = TREE_VALUE (args);
+
+ if (!host_integerp (size, 1))
+ {
+ warning (OPT_Wattributes, "%qs attribute ignored",
+ IDENTIFIER_POINTER (name));
+ return NULL_TREE;
+ }
+
+ /* Get the vector size (in bytes). */
+ vecsize = tree_low_cst (size, 1);
+
+ /* We need to provide for vector pointers, vector arrays, and
+ functions returning vectors. For example:
+
+ __attribute__((vector_size(16))) short *foo;
+
+ In this case, the mode is SI, but the type being modified is
+ HI, so we need to look further. */
+
+ while (POINTER_TYPE_P (type)
+ || TREE_CODE (type) == FUNCTION_TYPE
+ || TREE_CODE (type) == METHOD_TYPE
+ || TREE_CODE (type) == ARRAY_TYPE
+ || TREE_CODE (type) == OFFSET_TYPE)
+ type = TREE_TYPE (type);
+
+ /* Get the mode of the type being modified. */
+ orig_mode = TYPE_MODE (type);
+
+ if ((!INTEGRAL_TYPE_P (type)
+ && !SCALAR_FLOAT_TYPE_P (type)
+ && !FIXED_POINT_TYPE_P (type))
+ || (!SCALAR_FLOAT_MODE_P (orig_mode)
+ && GET_MODE_CLASS (orig_mode) != MODE_INT
+ && !ALL_SCALAR_FIXED_POINT_MODE_P (orig_mode))
+ || !host_integerp (TYPE_SIZE_UNIT (type), 1)
+ || TREE_CODE (type) == BOOLEAN_TYPE)
+ {
+ error ("invalid vector type for attribute %qs",
+ IDENTIFIER_POINTER (name));
+ return NULL_TREE;
+ }
+
+ if (vecsize % tree_low_cst (TYPE_SIZE_UNIT (type), 1))
+ {
+ error ("vector size not an integral multiple of component size");
+ return NULL;
+ }
+
+ if (vecsize == 0)
+ {
+ error ("zero vector size");
+ return NULL;
+ }
+
+ /* Calculate how many units fit in the vector. */
+ nunits = vecsize / tree_low_cst (TYPE_SIZE_UNIT (type), 1);
+ if (nunits & (nunits - 1))
+ {
+ error ("number of components of the vector not a power of two");
+ return NULL_TREE;
+ }
+
+ new_type = build_vector_type (type, nunits);
+
+ /* Build back pointers if needed. */
+ *node = lang_hooks.types.reconstruct_complex_type (*node, new_type);
+
+ return NULL_TREE;
+}
+
+/* Handle a "vector_type" attribute; arguments as in
+ struct attribute_spec.handler. */
+
+static tree
+handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args),
+ int ARG_UNUSED (flags),
+ bool *no_add_attrs)
+{
+ /* Vector representative type and size. */
+ tree rep_type = *node;
+ tree rep_size = TYPE_SIZE_UNIT (rep_type);
+ tree rep_name;
+
+ /* Vector size in bytes and number of units. */
+ unsigned HOST_WIDE_INT vec_bytes, vec_units;
+
+ /* Vector element type and mode. */
+ tree elem_type;
+ enum machine_mode elem_mode;
+
+ *no_add_attrs = true;
+
+ /* Get the representative array type, possibly nested within a
+ padding record e.g. for alignment purposes. */
+
+ if (TYPE_IS_PADDING_P (rep_type))
+ rep_type = TREE_TYPE (TYPE_FIELDS (rep_type));
+
+ if (TREE_CODE (rep_type) != ARRAY_TYPE)
+ {
+ error ("attribute %qs applies to array types only",
+ IDENTIFIER_POINTER (name));
+ return NULL_TREE;
+ }
+
+ /* Silently punt on variable sizes. We can't make vector types for them,
+ need to ignore them on front-end generated subtypes of unconstrained
+ bases, and this attribute is for binding implementors, not end-users, so
+ we should never get there from legitimate explicit uses. */
+
+ if (!host_integerp (rep_size, 1))
+ return NULL_TREE;
+
+ /* Get the element type/mode and check this is something we know
+ how to make vectors of. */
+
+ elem_type = TREE_TYPE (rep_type);
+ elem_mode = TYPE_MODE (elem_type);
+
+ if ((!INTEGRAL_TYPE_P (elem_type)
+ && !SCALAR_FLOAT_TYPE_P (elem_type)
+ && !FIXED_POINT_TYPE_P (elem_type))
+ || (!SCALAR_FLOAT_MODE_P (elem_mode)
+ && GET_MODE_CLASS (elem_mode) != MODE_INT
+ && !ALL_SCALAR_FIXED_POINT_MODE_P (elem_mode))
+ || !host_integerp (TYPE_SIZE_UNIT (elem_type), 1))
+ {
+ error ("invalid element type for attribute %qs",
+ IDENTIFIER_POINTER (name));
+ return NULL_TREE;
+ }
+
+ /* Sanity check the vector size and element type consistency. */
+
+ vec_bytes = tree_low_cst (rep_size, 1);
+
+ if (vec_bytes % tree_low_cst (TYPE_SIZE_UNIT (elem_type), 1))
+ {
+ error ("vector size not an integral multiple of component size");
+ return NULL;
+ }
+
+ if (vec_bytes == 0)
+ {
+ error ("zero vector size");
+ return NULL;
+ }
+
+ vec_units = vec_bytes / tree_low_cst (TYPE_SIZE_UNIT (elem_type), 1);
+ if (vec_units & (vec_units - 1))
+ {
+ error ("number of components of the vector not a power of two");
+ return NULL_TREE;
+ }
+
+ /* Build the vector type and replace. */
+
+ *node = build_vector_type (elem_type, vec_units);
+ rep_name = TYPE_NAME (rep_type);
+ if (TREE_CODE (rep_name) == TYPE_DECL)
+ rep_name = DECL_NAME (rep_name);
+ TYPE_NAME (*node) = rep_name;
+ TYPE_REPRESENTATIVE_ARRAY (*node) = rep_type;
+
+ return NULL_TREE;
+}
+
/* ----------------------------------------------------------------------- *
* BUILTIN FUNCTIONS *
* ----------------------------------------------------------------------- */
OSDN Git Service
