* *
* C Implementation File *
* *
- * Copyright (C) 1992-2009, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2010, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
* *
****************************************************************************/
-/* 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 "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
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. */
{ "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
TYPE_DUMMY_P (gnu_type) = 1;
TYPE_STUB_DECL (gnu_type)
= create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type);
- if (AGGREGATE_TYPE_P (gnu_type))
- TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_type);
+ if (Is_By_Reference_Type (gnat_type))
+ TREE_ADDRESSABLE (gnu_type) = 1;
SET_DUMMY_NODE (gnat_underlying, gnu_type);
{
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))
;
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. */
if (rep_level > 0)
{
TYPE_ALIGN (record_type) = MAX (BITS_PER_UNIT, TYPE_ALIGN (record_type));
- SET_TYPE_MODE (record_type, BLKmode);
if (!had_size_unit)
TYPE_SIZE_UNIT (record_type) = size_zero_node;
+
if (!had_size)
TYPE_SIZE (record_type) = bitsize_zero_node;
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);
}
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
return bitsize_zero_node;
}
\f
-/* Return a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
- subprogram. If it is void_type_node, then we are dealing with a procedure,
- otherwise we are dealing with a function. PARAM_DECL_LIST is a list of
- PARM_DECL nodes that are the subprogram arguments. CICO_LIST is the
- copy-in/copy-out list to be stored into TYPE_CICO_LIST.
- RETURNS_UNCONSTRAINED is true if the function returns an unconstrained
- object. RETURNS_BY_REF is true if the function returns by reference.
- RETURNS_BY_TARGET_PTR is true if the function is to be passed (as its
- first parameter) the address of the place to copy its result. */
+/* Return a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
+ subprogram. If it is VOID_TYPE, then we are dealing with a procedure,
+ otherwise we are dealing with a function. PARAM_DECL_LIST is a list of
+ PARM_DECL nodes that are the subprogram parameters. CICO_LIST is the
+ copy-in/copy-out list to be stored into the TYPE_CICO_LIST field.
+ RETURN_UNCONSTRAINED_P is true if the function returns an unconstrained
+ object. RETURN_BY_DIRECT_REF_P is true if the function returns by direct
+ reference. RETURN_BY_INVISI_REF_P is true if the function returns by
+ invisible reference. */
tree
create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
- bool returns_unconstrained, bool returns_by_ref,
- bool returns_by_target_ptr)
+ bool return_unconstrained_p, bool return_by_direct_ref_p,
+ bool return_by_invisi_ref_p)
{
/* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
- the subprogram formal parameters. This list is generated by traversing the
- input list of PARM_DECL nodes. */
- tree param_type_list = NULL;
- tree param_decl;
- tree type;
+ the subprogram formal parameters. This list is generated by traversing
+ the input list of PARM_DECL nodes. */
+ tree param_type_list = NULL_TREE;
+ tree t, type;
- for (param_decl = param_decl_list; param_decl;
- param_decl = TREE_CHAIN (param_decl))
- param_type_list = tree_cons (NULL_TREE, TREE_TYPE (param_decl),
- param_type_list);
+ for (t = param_decl_list; t; t = TREE_CHAIN (t))
+ param_type_list = tree_cons (NULL_TREE, TREE_TYPE (t), param_type_list);
/* The list of the function parameter types has to be terminated by the void
type to signal to the back-end that we are not dealing with a variable
- parameter subprogram, but that the subprogram has a fixed number of
- parameters. */
+ parameter subprogram, but that it has a fixed number of parameters. */
param_type_list = tree_cons (NULL_TREE, void_type_node, param_type_list);
- /* The list of argument types has been created in reverse
- so nreverse it. */
+ /* The list of argument types has been created in reverse so reverse it. */
param_type_list = nreverse (param_type_list);
type = build_function_type (return_type, param_type_list);
- /* TYPE may have been shared since GCC hashes types. If it has a CICO_LIST
- or the new type should, make a copy of TYPE. Likewise for
- RETURNS_UNCONSTRAINED and RETURNS_BY_REF. */
- if (TYPE_CI_CO_LIST (type) || cico_list
- || TYPE_RETURNS_UNCONSTRAINED_P (type) != returns_unconstrained
- || TYPE_RETURNS_BY_REF_P (type) != returns_by_ref
- || TYPE_RETURNS_BY_TARGET_PTR_P (type) != returns_by_target_ptr)
- type = copy_type (type);
+ /* TYPE may have been shared since GCC hashes types. If it has a different
+ CICO_LIST, make a copy. Likewise for the various flags. */
+ if (TYPE_CI_CO_LIST (type) != cico_list
+ || TYPE_RETURN_UNCONSTRAINED_P (type) != return_unconstrained_p
+ || TYPE_RETURN_BY_DIRECT_REF_P (type) != return_by_direct_ref_p
+ || TREE_ADDRESSABLE (type) != return_by_invisi_ref_p)
+ {
+ type = copy_type (type);
+ TYPE_CI_CO_LIST (type) = cico_list;
+ TYPE_RETURN_UNCONSTRAINED_P (type) = return_unconstrained_p;
+ TYPE_RETURN_BY_DIRECT_REF_P (type) = return_by_direct_ref_p;
+ TREE_ADDRESSABLE (type) = return_by_invisi_ref_p;
+ }
- TYPE_CI_CO_LIST (type) = cico_list;
- TYPE_RETURNS_UNCONSTRAINED_P (type) = returns_unconstrained;
- TYPE_RETURNS_BY_REF_P (type) = returns_by_ref;
- TYPE_RETURNS_BY_TARGET_PTR_P (type) = returns_by_target_ptr;
return type;
}
\f
{
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) = TYPE_STUB_DECL (type);
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
/* At the global level, an initializer requiring code to be generated
produces elaboration statements. Check that such statements are allowed,
that is, not violating a No_Elaboration_Code restriction. */
- if (global_bindings_p () && var_init != 0 && ! init_const)
+ 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
support global BSS sections, uninitialized global variables would
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
!= null_pointer_node)
DECL_IGNORED_P (var_decl) = 1;
- if (asm_name && VAR_OR_FUNCTION_DECL_P (var_decl))
- SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
-
- 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);
}
}
-/* Return 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,
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
bool public_flag, bool extern_flag,
struct attrib *attr_list, Node_Id gnat_node)
{
- tree return_type = TREE_TYPE (subprog_type);
- tree subprog_decl = build_decl (input_location,
- FUNCTION_DECL, subprog_name, subprog_type);
+ tree subprog_decl = build_decl (input_location, FUNCTION_DECL, subprog_name,
+ subprog_type);
+ tree result_decl = build_decl (input_location, RESULT_DECL, NULL_TREE,
+ TREE_TYPE (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 (input_location,
- RESULT_DECL, 0, return_type);
- DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
- DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
-
- /* TREE_ADDRESSABLE is set on the result type to request the use of the
- target by-reference return mechanism. This is not supported all the
- way down to RTL expansion with GCC 4, which ICEs on temporary creation
- attempts with such a type and expects DECL_BY_REFERENCE to be set on
- the RESULT_DECL instead - see gnat_genericize for more details. */
- if (TREE_ADDRESSABLE (TREE_TYPE (DECL_RESULT (subprog_decl))))
- {
- tree result_decl = DECL_RESULT (subprog_decl);
- TREE_ADDRESSABLE (TREE_TYPE (result_decl)) = 0;
- DECL_BY_REFERENCE (result_decl) = 1;
- }
+ DECL_ARTIFICIAL (result_decl) = 1;
+ DECL_IGNORED_P (result_decl) = 1;
+ DECL_BY_REFERENCE (result_decl) = TREE_ADDRESSABLE (subprog_type);
+ DECL_RESULT (subprog_decl) = result_decl;
if (asm_name)
{
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);
get_pending_sizes ();
}
-
-/* Helper for the genericization callback. Return a dereference of VAL
- if it is of a reference type. */
-
-static tree
-convert_from_reference (tree val)
-{
- tree value_type, ref;
-
- if (TREE_CODE (TREE_TYPE (val)) != REFERENCE_TYPE)
- return val;
-
- value_type = TREE_TYPE (TREE_TYPE (val));
- ref = build1 (INDIRECT_REF, value_type, val);
-
- /* See if what we reference is CONST or VOLATILE, which requires
- looking into array types to get to the component type. */
-
- while (TREE_CODE (value_type) == ARRAY_TYPE)
- value_type = TREE_TYPE (value_type);
-
- TREE_READONLY (ref)
- = (TYPE_QUALS (value_type) & TYPE_QUAL_CONST);
- TREE_THIS_VOLATILE (ref)
- = (TYPE_QUALS (value_type) & TYPE_QUAL_VOLATILE);
-
- TREE_SIDE_EFFECTS (ref)
- = (TREE_THIS_VOLATILE (ref) || TREE_SIDE_EFFECTS (val));
-
- return ref;
-}
-
-/* Helper for the genericization callback. Returns true if T denotes
- a RESULT_DECL with DECL_BY_REFERENCE set. */
-
-static inline bool
-is_byref_result (tree t)
-{
- return (TREE_CODE (t) == RESULT_DECL && DECL_BY_REFERENCE (t));
-}
-
-
-/* Tree walking callback for gnat_genericize. Currently ...
-
- o Adjust references to the function's DECL_RESULT if it is marked
- DECL_BY_REFERENCE and so has had its type turned into a reference
- type at the end of the function compilation. */
-
-static tree
-gnat_genericize_r (tree *stmt_p, int *walk_subtrees, void *data)
-{
- /* This implementation is modeled after what the C++ front-end is
- doing, basis of the downstream passes behavior. */
-
- tree stmt = *stmt_p;
- struct pointer_set_t *p_set = (struct pointer_set_t*) data;
-
- /* If we have a direct mention of the result decl, dereference. */
- if (is_byref_result (stmt))
- {
- *stmt_p = convert_from_reference (stmt);
- *walk_subtrees = 0;
- return NULL;
- }
-
- /* Otherwise, no need to walk the same tree twice. */
- if (pointer_set_contains (p_set, stmt))
- {
- *walk_subtrees = 0;
- return NULL_TREE;
- }
-
- /* If we are taking the address of what now is a reference, just get the
- reference value. */
- if (TREE_CODE (stmt) == ADDR_EXPR
- && is_byref_result (TREE_OPERAND (stmt, 0)))
- {
- *stmt_p = convert (TREE_TYPE (stmt), TREE_OPERAND (stmt, 0));
- *walk_subtrees = 0;
- }
-
- /* Don't dereference an by-reference RESULT_DECL inside a RETURN_EXPR. */
- else if (TREE_CODE (stmt) == RETURN_EXPR
- && TREE_OPERAND (stmt, 0)
- && is_byref_result (TREE_OPERAND (stmt, 0)))
- *walk_subtrees = 0;
-
- /* Don't look inside trees that cannot embed references of interest. */
- else if (IS_TYPE_OR_DECL_P (stmt))
- *walk_subtrees = 0;
-
- pointer_set_insert (p_set, *stmt_p);
-
- return NULL;
-}
-
-/* Perform lowering of Ada trees to GENERIC. In particular:
-
- o Turn a DECL_BY_REFERENCE RESULT_DECL into a real by-reference decl
- and adjust all the references to this decl accordingly. */
-
-static void
-gnat_genericize (tree fndecl)
-{
- /* Prior to GCC 4, an explicit By_Reference result mechanism for a function
- was handled by simply setting TREE_ADDRESSABLE on the result type.
- Everything required to actually pass by invisible ref using the target
- mechanism (e.g. extra parameter) was handled at RTL expansion time.
-
- This doesn't work with GCC 4 any more for several reasons. First, the
- gimplification process might need the creation of temporaries of this
- type, and the gimplifier ICEs on such attempts. Second, the middle-end
- now relies on a different attribute for such cases (DECL_BY_REFERENCE on
- RESULT/PARM_DECLs), and expects the user invisible by-reference-ness to
- be explicitly accounted for by the front-end in the function body.
-
- We achieve the complete transformation in two steps:
-
- 1/ create_subprog_decl performs early attribute tweaks: it clears
- TREE_ADDRESSABLE from the result type and sets DECL_BY_REFERENCE on
- the result decl. The former ensures that the bit isn't set in the GCC
- tree saved for the function, so prevents ICEs on temporary creation.
- The latter we use here to trigger the rest of the processing.
-
- 2/ This function performs the type transformation on the result decl
- and adjusts all the references to this decl from the function body
- accordingly.
-
- Clearing TREE_ADDRESSABLE from the type differs from the C++ front-end
- strategy, which escapes the gimplifier temporary creation issues by
- creating it's own temporaries using TARGET_EXPR nodes. Our way relies
- on simple specific support code in aggregate_value_p to look at the
- target function result decl explicitly. */
-
- struct pointer_set_t *p_set;
- tree decl_result = DECL_RESULT (fndecl);
-
- if (!DECL_BY_REFERENCE (decl_result))
- return;
-
- /* Make the DECL_RESULT explicitly by-reference and adjust all the
- occurrences in the function body using the common tree-walking facility.
- We want to see every occurrence of the result decl to adjust the
- referencing tree, so need to use our own pointer set to control which
- trees should be visited again or not. */
-
- p_set = pointer_set_create ();
-
- TREE_TYPE (decl_result) = build_reference_type (TREE_TYPE (decl_result));
- TREE_ADDRESSABLE (decl_result) = 0;
- relayout_decl (decl_result);
-
- walk_tree (&DECL_SAVED_TREE (fndecl), gnat_genericize_r, p_set, NULL);
-
- pointer_set_destroy (p_set);
-}
-
/* Finish the definition of the current subprogram BODY and finalize it. */
void
if (type_annotate_only)
return;
- /* Perform the required pre-gimplification transformations on the tree. */
- gnat_genericize (fndecl);
-
/* Dump functions before gimplification. */
dump_function (TDI_original, fndecl);
{
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;
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));
}
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;
}
}
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;
}
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)));
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)));
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);
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));
- expr = save_expr (expr);
+ expr = gnat_protect_expr (expr);
if (TREE_CODE (expr) == ADDR_EXPR)
expr = TREE_OPERAND (expr, 0);
else
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);
tree
convert (tree type, tree expr)
{
- enum tree_code code = TREE_CODE (type);
tree etype = TREE_TYPE (expr);
enum tree_code ecode = TREE_CODE (etype);
+ enum tree_code code = TREE_CODE (type);
- /* If EXPR is already the right type, we are done. */
- if (type == etype)
+ /* If the expression is already of the right type, we are done. */
+ if (etype == type)
return expr;
/* If both input and output have padding and are of variable size, do this
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)
/* 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_IS_PADDING_P (type))
+ 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-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. */
- if (TREE_CODE (etype) == RECORD_TYPE
+ /* 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 (ecode == RECORD_TYPE
&& CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
- return unchecked_convert (type, expr, false);
+ {
+ 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);
+ }
/* 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
+ if (ecode == ARRAY_TYPE
&& TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE
&& !TREE_CONSTANT (TYPE_SIZE (etype))
&& !TREE_CONSTANT (TYPE_SIZE (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. */
return expr;
}
- /* Likewise for a conversion between original and packable version, but
- we have to work harder in order to preserve type consistency. */
+ /* Likewise for a conversion between original and packable version, or
+ conversion between types of the same size and with the same list of
+ fields, but we have to work harder to preserve type consistency. */
if (code == ecode
&& code == RECORD_TYPE
- && TYPE_NAME (type) == TYPE_NAME (etype))
+ && (TYPE_NAME (type) == TYPE_NAME (etype)
+ || tree_int_cst_equal (TYPE_SIZE (type), TYPE_SIZE (etype))))
+
{
VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr);
unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e);
FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
{
- constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
- /* We expect only simple constructors. Otherwise, punt. */
- if (!(index == efield || index == DECL_ORIGINAL_FIELD (efield)))
+ constructor_elt *elt;
+ /* We expect only simple constructors. */
+ if (!SAME_FIELD_P (index, efield))
+ break;
+ /* The field must be the same. */
+ if (!SAME_FIELD_P (efield, field))
break;
+ elt = VEC_quick_push (constructor_elt, v, NULL);
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)
+ if (!clear_constant
+ && TREE_CONSTANT (expr)
&& !CONSTRUCTOR_BITFIELD_P (efield)
&& CONSTRUCTOR_BITFIELD_P (field)
&& !initializer_constant_valid_for_bitfield_p (value))
TREE_TYPE (expr) = type;
CONSTRUCTOR_ELTS (expr) = v;
if (clear_constant)
- TREE_CONSTANT (expr) = TREE_STATIC (expr) = false;
+ TREE_CONSTANT (expr) = TREE_STATIC (expr) = 0;
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);
}
}
break;
- case INDIRECT_REF:
- /* If both types are record types, just convert the pointer and
- make a new INDIRECT_REF.
-
- ??? Disable this for now since it causes problems with the
- code in build_binary_op for MODIFY_EXPR which wants to
- strip off conversions. But that code really is a mess and
- we need to do this a much better way some time. */
- if (0
- && (TREE_CODE (type) == RECORD_TYPE
- || 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))
- return build_unary_op (INDIRECT_REF, NULL_TREE,
- convert (build_pointer_type (type),
- TREE_OPERAND (expr, 0)));
- break;
-
default:
break;
}
/* 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);
+ /* If we are converting between tagged types, try to upcast properly. */
+ else if (ecode == RECORD_TYPE && code == RECORD_TYPE
+ && TYPE_ALIGN_OK (etype) && TYPE_ALIGN_OK (type))
+ {
+ tree child_etype = etype;
+ do {
+ tree field = TYPE_FIELDS (child_etype);
+ if (DECL_NAME (field) == parent_name_id && TREE_TYPE (field) == type)
+ return build_component_ref (expr, NULL_TREE, field, false);
+ child_etype = TREE_TYPE (field);
+ } while (TREE_CODE (child_etype) == RECORD_TYPE);
+ }
+
/* In all other cases of related types, make a NOP_EXPR. */
else if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)
|| (code == INTEGER_CST && ecode == INTEGER_CST
/* 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;
build_component_ref (TREE_OPERAND (exp, 0),
get_identifier ("P_ARRAY"),
NULL_TREE, false));
- TREE_READONLY (new_exp) = TREE_STATIC (new_exp)
- = TREE_READONLY (exp);
+ TREE_READONLY (new_exp) = TREE_READONLY (exp);
return new_exp;
}
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_exp = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
if (TREE_CODE (TREE_TYPE (new_exp)) == RECORD_TYPE
build_component_ref (new_exp, NULL_TREE,
TREE_CHAIN
(TYPE_FIELDS (TREE_TYPE (new_exp))),
- 0);
+ false);
}
else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
return
build_component_ref (exp, NULL_TREE,
- TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))), 0);
+ TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))),
+ false);
break;
default:
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 ada-tree.h for a complete rationale. */
unchecked_convert (tree type, tree expr, bool notrunc_p)
{
tree etype = TREE_TYPE (expr);
+ enum tree_code ecode = TREE_CODE (etype);
+ enum tree_code code = TREE_CODE (type);
- /* If the expression is already the right type, we are done. */
+ /* If the expression is already of the right type, we are done. */
if (etype == type)
return expr;
/* If both types types are integral just do a normal conversion.
Likewise for a conversion to an unconstrained array. */
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))
- || (TREE_CODE (type) == RECORD_TYPE
- && TYPE_JUSTIFIED_MODULAR_P (type)))
+ && !(code == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (type)))
+ || (POINTER_TYPE_P (type) && ! TYPE_IS_THIN_POINTER_P (type))
+ || (code == 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))
- || (TREE_CODE (etype) == RECORD_TYPE
- && TYPE_JUSTIFIED_MODULAR_P (etype))))
- || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
+ && !(ecode == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (etype)))
+ || (POINTER_TYPE_P (etype) && !TYPE_IS_THIN_POINTER_P (etype))
+ || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype))))
+ || code == UNCONSTRAINED_ARRAY_TYPE)
{
- if (TREE_CODE (etype) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (etype))
+ if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
{
tree ntype = copy_type (etype);
TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
expr = build1 (NOP_EXPR, ntype, expr);
}
- if (TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type))
+ if (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
{
tree rtype = copy_type (type);
TYPE_BIASED_REPRESENTATION_P (rtype) = 0;
layout_type (rec_type);
expr = unchecked_convert (rec_type, expr, notrunc_p);
- expr = build_component_ref (expr, NULL_TREE, field, 0);
+ expr = build_component_ref (expr, NULL_TREE, field, false);
}
/* Similarly if we are converting from an integral type whose precision
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. */
- else if (TREE_CODE (etype) == UNCONSTRAINED_ARRAY_TYPE
- && TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
+ /* 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 (ecode == code && code == 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 (code == VECTOR_TYPE
+ && ecode == ARRAY_TYPE
+ && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
+ etype))
+ expr = convert (type, expr);
+
else
{
expr = maybe_unconstrained_array (expr);
etype = TREE_TYPE (expr);
+ ecode = TREE_CODE (etype);
if (can_fold_for_view_convert_p (expr))
expr = fold_build1 (VIEW_CONVERT_EXPR, type, expr);
else
is a biased type or if both the input and output are unsigned. */
if (!notrunc_p
&& INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type)
- && !(TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type))
+ && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
&& 0 != compare_tree_int (TYPE_RM_SIZE (type),
GET_MODE_BITSIZE (TYPE_MODE (type)))
&& !(INTEGRAL_TYPE_P (etype)
0))
&& !(TYPE_UNSIGNED (type) && TYPE_UNSIGNED (etype)))
{
- tree base_type = gnat_type_for_mode (TYPE_MODE (type),
- TYPE_UNSIGNED (type));
+ tree base_type
+ = gnat_type_for_mode (TYPE_MODE (type), TYPE_UNSIGNED (type));
tree shift_expr
= convert (base_type,
size_binop (MINUS_EXPR,
static tree
builtin_type_for_size (int size, bool unsignedp)
{
- tree type = lang_hooks.types.type_for_size (size, unsignedp);
+ tree type = gnat_type_for_size (size, unsignedp);
return type ? type : error_mark_node;
}
/* ??? 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;
}
if (!host_integerp (size, 1))
{
- warning (OPT_Wattributes, "%qE attribute ignored", name);
+ warning (OPT_Wattributes, "%qs attribute ignored",
+ IDENTIFIER_POINTER (name));
return NULL_TREE;
}
|| !host_integerp (TYPE_SIZE_UNIT (type), 1)
|| TREE_CODE (type) == BOOLEAN_TYPE)
{
- error ("invalid vector type for attribute %qE", name);
+ error ("invalid vector type for attribute %qs",
+ IDENTIFIER_POINTER (name));
return NULL_TREE;
}
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
