* *
* C Implementation File *
* *
- * Copyright (C) 1992-2012, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2013, 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- *
#include "coretypes.h"
#include "tm.h"
#include "tree.h"
+#include "stringpool.h"
+#include "stor-layout.h"
#include "flags.h"
#include "toplev.h"
#include "ggc.h"
#include "target.h"
#include "tree-inline.h"
+#include "diagnostic-core.h"
#include "ada.h"
#include "types.h"
#define Has_Stdcall_Convention(E) \
(!TARGET_64BIT && Convention (E) == Convention_Stdcall)
#define Has_Thiscall_Convention(E) \
- (!TARGET_64BIT && gnat_first_param_is_class (E))
+ (!TARGET_64BIT && is_cplusplus_method (E))
#else
#define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
-#define Has_Thiscall_Convention(E) (gnat_first_param_is_class (E))
+#define Has_Thiscall_Convention(E) (is_cplusplus_method (E))
#endif
#else
#define Has_Stdcall_Convention(E) 0
static int defer_incomplete_level = 0;
static struct incomplete *defer_incomplete_list;
-/* This variable is used to delay expanding From_With_Type types until the
+/* This variable is used to delay expanding From_Limited_With types until the
end of the spec. */
static struct incomplete *defer_limited_with;
tree replacement;
} subst_pair;
-DEF_VEC_O(subst_pair);
-DEF_VEC_ALLOC_O(subst_pair,heap);
typedef struct variant_desc_d {
/* The type of the variant. */
tree new_type;
} variant_desc;
-DEF_VEC_O(variant_desc);
-DEF_VEC_ALLOC_O(variant_desc,heap);
/* A hash table used to cache the result of annotate_value. */
static GTY ((if_marked ("tree_int_map_marked_p"),
param_is (struct tree_int_map))) htab_t annotate_value_cache;
-static bool gnat_first_param_is_class (Entity_Id) ATTRIBUTE_UNUSED;
static bool allocatable_size_p (tree, bool);
static void prepend_one_attribute_to (struct attrib **,
enum attr_type, tree, tree, Node_Id);
static bool compile_time_known_address_p (Node_Id);
static bool cannot_be_superflat_p (Node_Id);
static bool constructor_address_p (tree);
-static void components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
+static bool components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
bool, bool, bool, bool, bool, tree, tree *);
static Uint annotate_value (tree);
static void annotate_rep (Entity_Id, tree);
static tree build_position_list (tree, bool, tree, tree, unsigned int, tree);
-static VEC(subst_pair,heap) *build_subst_list (Entity_Id, Entity_Id, bool);
-static VEC(variant_desc,heap) *build_variant_list (tree,
- VEC(subst_pair,heap) *,
- VEC(variant_desc,heap) *);
+static vec<subst_pair> build_subst_list (Entity_Id, Entity_Id, bool);
+static vec<variant_desc> build_variant_list (tree,
+ vec<subst_pair> ,
+ vec<variant_desc> );
static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
static void set_rm_size (Uint, tree, Entity_Id);
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
static void check_ok_for_atomic (tree, Entity_Id, bool);
static tree create_field_decl_from (tree, tree, tree, tree, tree,
- VEC(subst_pair,heap) *);
+ vec<subst_pair> );
static tree create_rep_part (tree, tree, tree);
static tree get_rep_part (tree);
-static tree create_variant_part_from (tree, VEC(variant_desc,heap) *, tree,
- tree, VEC(subst_pair,heap) *);
-static void copy_and_substitute_in_size (tree, tree, VEC(subst_pair,heap) *);
+static tree create_variant_part_from (tree, vec<variant_desc> , tree,
+ tree, vec<subst_pair> );
+static void copy_and_substitute_in_size (tree, tree, vec<subst_pair> );
/* The relevant constituents of a subprogram binding to a GCC builtin. Used
to pass around calls performing profile compatibility checks. */
If we are defining the node, we should not have already processed it.
In that case, we will abort below when we try to save a new GCC tree
for this object. We also need to handle the case of getting a dummy
- type when a Full_View exists. */
+ type when a Full_View exists but be careful so as not to trigger its
+ premature elaboration. */
if ((!definition || (is_type && imported_p))
&& present_gnu_tree (gnat_entity))
{
if (TREE_CODE (gnu_decl) == TYPE_DECL
&& TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
&& IN (kind, Incomplete_Or_Private_Kind)
- && Present (Full_View (gnat_entity)))
+ && Present (Full_View (gnat_entity))
+ && (present_gnu_tree (Full_View (gnat_entity))
+ || No (Freeze_Node (Full_View (gnat_entity)))))
{
gnu_decl
= gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0);
return gnu_decl;
}
- /* If this is a numeric or enumeral type, or an access type, a nonzero
- Esize must be specified unless it was specified by the programmer. */
+ /* If this is a numeric or enumeral type, or an access type, a nonzero Esize
+ must be specified unless it was specified by the programmer. Exceptions
+ are for access-to-protected-subprogram types and all access subtypes, as
+ another GNAT type is used to lay out the GCC type for them. */
gcc_assert (!Unknown_Esize (gnat_entity)
|| Has_Size_Clause (gnat_entity)
|| (!IN (kind, Numeric_Kind)
&& (!IN (kind, Access_Kind)
|| kind == E_Access_Protected_Subprogram_Type
|| kind == E_Anonymous_Access_Protected_Subprogram_Type
- || kind == E_Access_Subtype)));
+ || kind == E_Access_Subtype
+ || type_annotate_only)));
/* The RM size must be specified for all discrete and fixed-point types. */
gcc_assert (!(IN (kind, Discrete_Or_Fixed_Point_Kind)
never be declared otherwise. This is necessary to ensure
that its subtrees are properly marked. */
if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
- create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
+ create_type_decl (TYPE_NAME (gnu_type), gnu_type, true,
debug_info_p, gnat_entity);
}
}
align_cap = get_mode_alignment (ptr_mode);
}
- if (!host_integerp (TYPE_SIZE (gnu_type), 1)
+ if (!tree_fits_uhwi_p (TYPE_SIZE (gnu_type))
|| compare_tree_int (TYPE_SIZE (gnu_type), size_cap) > 0)
align = 0;
else if (compare_tree_int (TYPE_SIZE (gnu_type), align_cap) > 0)
align = align_cap;
else
- align = ceil_pow2 (tree_low_cst (TYPE_SIZE (gnu_type), 1));
+ align = ceil_pow2 (tree_to_uhwi (TYPE_SIZE (gnu_type)));
/* But make sure not to under-align the object. */
if (align <= TYPE_ALIGN (gnu_type))
debug_info_p);
}
+ /* ??? If this is an object of CW type initialized to a value, try to
+ ensure that the object is sufficient aligned for this value, but
+ without pessimizing the allocation. This is a kludge necessary
+ because we don't support dynamic alignment. */
+ if (align == 0
+ && Ekind (Etype (gnat_entity)) == E_Class_Wide_Subtype
+ && No (Renamed_Object (gnat_entity))
+ && No (Address_Clause (gnat_entity)))
+ align = get_target_system_allocator_alignment () * BITS_PER_UNIT;
+
#ifdef MINIMUM_ATOMIC_ALIGNMENT
/* If the size is a constant and no alignment is specified, force
the alignment to be the minimum valid atomic alignment. The
necessary and can interfere with constant replacement. Finally,
do not do it for Out parameters since that creates an
size inconsistency with In parameters. */
- if (align == 0 && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type)
+ if (align == 0
+ && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type)
&& !FLOAT_TYPE_P (gnu_type)
&& !const_flag && No (Renamed_Object (gnat_entity))
&& !imported_p && No (Address_Clause (gnat_entity))
never be declared otherwise. This is necessary to ensure
that its subtrees are properly marked. */
if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
- create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
+ create_type_decl (TYPE_NAME (gnu_type), gnu_type, true,
debug_info_p, gnat_entity);
}
save_gnu_tree (gnat_entity, gnu_decl, true);
saved = true;
annotate_object (gnat_entity, gnu_type, NULL_TREE,
- false, false);
+ false);
/* This assertion will fail if the renamed object
isn't aligned enough as to make it possible to
honor the alignment set on the renaming. */
as we have a VAR_DECL for the pointer we make. */
}
- gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
- maybe_stable_expr);
+ if (type_annotate_only
+ && TREE_CODE (maybe_stable_expr) == ERROR_MARK)
+ gnu_expr = NULL_TREE;
+ else
+ gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
+ maybe_stable_expr);
gnu_size = NULL_TREE;
used_by_ref = true;
= TYPE_PADDING_P (gnu_type)
? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type)))
: TYPE_FIELDS (gnu_type);
- VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1);
+ vec<constructor_elt, va_gc> *v;
+ vec_alloc (v, 1);
tree t = build_template (TREE_TYPE (template_field),
TREE_TYPE (DECL_CHAIN (template_field)),
NULL_TREE);
global_bindings_p ()
|| !definition
|| static_p)
- || (gnu_size && !allocatable_size_p (gnu_size,
- global_bindings_p ()
- || !definition
- || static_p)))
+ || (gnu_size
+ && !allocatable_size_p (convert (sizetype,
+ size_binop
+ (CEIL_DIV_EXPR, gnu_size,
+ bitsize_unit_node)),
+ global_bindings_p ()
+ || !definition
+ || static_p)))
{
gnu_type = build_reference_type (gnu_type);
gnu_size = NULL_TREE;
= TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_alloc_type)));
if (TREE_CODE (gnu_expr) == CONSTRUCTOR
- && 1 == VEC_length (constructor_elt,
- CONSTRUCTOR_ELTS (gnu_expr)))
+ && 1 == vec_safe_length (CONSTRUCTOR_ELTS (gnu_expr)))
gnu_expr = 0;
else
gnu_expr
}
if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
- && TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_alloc_type)))
+ && !valid_constant_size_p (TYPE_SIZE_UNIT (gnu_alloc_type)))
post_error ("?`Storage_Error` will be raised at run time!",
gnat_entity);
tree gnu_new_type
= make_aligning_type (gnu_type, TYPE_ALIGN (gnu_type),
TYPE_SIZE_UNIT (gnu_type),
- BIGGEST_ALIGNMENT, 0);
+ BIGGEST_ALIGNMENT, 0, gnat_entity);
tree gnu_new_var
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
NULL_TREE, gnu_new_type, NULL_TREE, false,
just above, we have nothing to do here. */
if (!TYPE_IS_THIN_POINTER_P (gnu_type))
{
- gnu_size = NULL_TREE;
- used_by_ref = true;
+ tree gnu_unc_var
+ = create_var_decl (concat_name (gnu_entity_name, "UNC"),
+ NULL_TREE, gnu_type, gnu_expr,
+ const_flag, Is_Public (gnat_entity),
+ imported_p || !definition, static_p,
+ NULL, gnat_entity);
+ gnu_expr
+ = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
+ TREE_CONSTANT (gnu_expr) = 1;
- if (definition && !imported_p)
- {
- tree gnu_unc_var
- = create_var_decl (concat_name (gnu_entity_name, "UNC"),
- NULL_TREE, gnu_type, gnu_expr,
- const_flag, Is_Public (gnat_entity),
- false, static_p, NULL, gnat_entity);
- gnu_expr
- = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
- TREE_CONSTANT (gnu_expr) = 1;
- const_flag = true;
- }
- else
- {
- gnu_expr = NULL_TREE;
- const_flag = false;
- }
+ gnu_size = NULL_TREE;
+ used_by_ref = true;
+ const_flag = true;
}
gnu_type
&& const_flag
&& gnu_expr && TREE_CONSTANT (gnu_expr)
&& AGGREGATE_TYPE_P (gnu_type)
- && host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
+ && tree_fits_uhwi_p (TYPE_SIZE_UNIT (gnu_type))
&& !(TYPE_IS_PADDING_P (gnu_type)
- && !host_integerp (TYPE_SIZE_UNIT
- (TREE_TYPE (TYPE_FIELDS (gnu_type))), 1)))
+ && !tree_fits_uhwi_p (TYPE_SIZE_UNIT
+ (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
static_p = true;
/* Now create the variable or the constant and set various flags. */
/* If we are defining an Out parameter and optimization isn't enabled,
create a fake PARM_DECL for debugging purposes and make it point to
the VAR_DECL. Suppress debug info for the latter but make sure it
- will live on the stack so that it can be accessed from within the
+ will live in memory so that it can be accessed from within the
debugger through the PARM_DECL. */
- if (kind == E_Out_Parameter && definition && !optimize && debug_info_p)
+ if (kind == E_Out_Parameter
+ && definition
+ && debug_info_p
+ && !optimize
+ && !flag_generate_lto)
{
tree param = create_param_decl (gnu_entity_name, gnu_type, false);
gnat_pushdecl (param, gnat_entity);
/* If this is a renaming pointer, attach the renamed object to it and
register it if we are at the global level. Note that an external
constant is at the global level. */
- else if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+ if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
{
SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
if ((!definition && kind == E_Constant) || global_bindings_p ())
&& Has_Nested_Block_With_Handler (Scope (gnat_entity)))
TREE_ADDRESSABLE (gnu_decl) = 1;
+ /* If this is a local variable with non-BLKmode and aggregate type,
+ and optimization isn't enabled, then force it in memory so that
+ a register won't be allocated to it with possible subparts left
+ uninitialized and reaching the register allocator. */
+ else if (TREE_CODE (gnu_decl) == VAR_DECL
+ && !DECL_EXTERNAL (gnu_decl)
+ && !TREE_STATIC (gnu_decl)
+ && DECL_MODE (gnu_decl) != BLKmode
+ && AGGREGATE_TYPE_P (TREE_TYPE (gnu_decl))
+ && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (gnu_decl))
+ && !optimize)
+ TREE_ADDRESSABLE (gnu_decl) = 1;
+
/* If we are defining an object with variable size or an object with
fixed size that will be dynamically allocated, and we are using the
setjmp/longjmp exception mechanism, update the setjmp buffer. */
type of the object and not on the object directly, and makes it
possible to support all confirming representation clauses. */
annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size,
- used_by_ref, false);
+ used_by_ref);
}
break;
case E_Enumeration_Type:
/* A special case: for the types Character and Wide_Character in
Standard, we do not list all the literals. So if the literals
- are not specified, make this an unsigned type. */
+ are not specified, make this an unsigned integer type. */
if (No (First_Literal (gnat_entity)))
{
gnu_type = make_unsigned_type (esize);
This is needed by the DWARF-2 back-end to distinguish between
unsigned integer types and character types. */
TYPE_STRING_FLAG (gnu_type) = 1;
- break;
}
+ else
+ {
+ /* We have a list of enumeral constants in First_Literal. We make a
+ CONST_DECL for each one and build into GNU_LITERAL_LIST the list
+ to be placed into TYPE_FIELDS. Each node is itself a TREE_LIST
+ whose TREE_VALUE is the literal name and whose TREE_PURPOSE is the
+ value of the literal. But when we have a regular boolean type, we
+ simplify this a little by using a BOOLEAN_TYPE. */
+ const bool is_boolean = Is_Boolean_Type (gnat_entity)
+ && !Has_Non_Standard_Rep (gnat_entity);
+ const bool is_unsigned = Is_Unsigned_Type (gnat_entity);
+ tree gnu_list = NULL_TREE;
+ Entity_Id gnat_literal;
+
+ gnu_type = make_node (is_boolean ? BOOLEAN_TYPE : ENUMERAL_TYPE);
+ TYPE_PRECISION (gnu_type) = esize;
+ TYPE_UNSIGNED (gnu_type) = is_unsigned;
+ set_min_and_max_values_for_integral_type (gnu_type, esize,
+ TYPE_SIGN (gnu_type));
+ process_attributes (&gnu_type, &attr_list, true, gnat_entity);
+ layout_type (gnu_type);
+
+ for (gnat_literal = First_Literal (gnat_entity);
+ Present (gnat_literal);
+ gnat_literal = Next_Literal (gnat_literal))
+ {
+ tree gnu_value
+ = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type);
+ tree gnu_literal
+ = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
+ gnu_type, gnu_value, true, false, false,
+ false, NULL, gnat_literal);
+ /* Do not generate debug info for individual enumerators. */
+ DECL_IGNORED_P (gnu_literal) = 1;
+ save_gnu_tree (gnat_literal, gnu_literal, false);
+ gnu_list
+ = tree_cons (DECL_NAME (gnu_literal), gnu_value, gnu_list);
+ }
- {
- /* We have a list of enumeral constants in First_Literal. We make a
- CONST_DECL for each one and build into GNU_LITERAL_LIST the list to
- be placed into TYPE_FIELDS. Each node in the list is a TREE_LIST
- whose TREE_VALUE is the literal name and whose TREE_PURPOSE is the
- value of the literal. But when we have a regular boolean type, we
- simplify this a little by using a BOOLEAN_TYPE. */
- bool is_boolean = Is_Boolean_Type (gnat_entity)
- && !Has_Non_Standard_Rep (gnat_entity);
- tree gnu_literal_list = NULL_TREE;
- Entity_Id gnat_literal;
-
- if (Is_Unsigned_Type (gnat_entity))
- gnu_type = make_unsigned_type (esize);
- else
- gnu_type = make_signed_type (esize);
-
- TREE_SET_CODE (gnu_type, is_boolean ? BOOLEAN_TYPE : ENUMERAL_TYPE);
-
- for (gnat_literal = First_Literal (gnat_entity);
- Present (gnat_literal);
- gnat_literal = Next_Literal (gnat_literal))
- {
- tree gnu_value
- = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type);
- tree gnu_literal
- = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
- gnu_type, gnu_value, true, false, false,
- false, NULL, gnat_literal);
- /* Do not generate debug info for individual enumerators. */
- DECL_IGNORED_P (gnu_literal) = 1;
- save_gnu_tree (gnat_literal, gnu_literal, false);
- gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
- gnu_value, gnu_literal_list);
- }
-
- if (!is_boolean)
- TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
+ if (!is_boolean)
+ TYPE_VALUES (gnu_type) = nreverse (gnu_list);
- /* Note that the bounds are updated at the end of this function
- to avoid an infinite recursion since they refer to the type. */
- }
- goto discrete_type;
+ /* Note that the bounds are updated at the end of this function
+ to avoid an infinite recursion since they refer to the type. */
+ goto discrete_type;
+ }
+ break;
case E_Signed_Integer_Type:
case E_Ordinary_Fixed_Point_Type:
definition, true,
Needs_Debug_Info (gnat_entity))));
+ TYPE_BIASED_REPRESENTATION_P (gnu_type)
+ = Has_Biased_Representation (gnat_entity);
+
+ /* Inherit our alias set from what we're a subtype of. Subtypes
+ are not different types and a pointer can designate any instance
+ within a subtype hierarchy. */
+ relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
+
/* One of the above calls might have caused us to be elaborated,
so don't blow up if so. */
if (present_gnu_tree (gnat_entity))
break;
}
- TYPE_BIASED_REPRESENTATION_P (gnu_type)
- = Has_Biased_Representation (gnat_entity);
-
/* Attach the TYPE_STUB_DECL in case we have a parallel type. */
TYPE_STUB_DECL (gnu_type)
= create_type_stub_decl (gnu_entity_name, gnu_type);
- /* Inherit our alias set from what we're a subtype of. Subtypes
- are not different types and a pointer can designate any instance
- within a subtype hierarchy. */
- relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
-
/* For a packed array, make the original array type a parallel type. */
if (debug_info_p
&& Is_Packed_Array_Type (gnat_entity)
TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
/* Create a stripped-down declaration, mainly for debugging. */
- create_type_decl (gnu_entity_name, gnu_type, NULL, true,
- debug_info_p, gnat_entity);
+ create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
+ gnat_entity);
/* Now save it and build the enclosing record type. */
gnu_field_type = gnu_type;
}
/* If the type we are dealing with has got a smaller alignment than the
- natural one, we need to wrap it up in a record type and under-align
- the latter. We reuse the padding machinery for this purpose. */
+ natural one, we need to wrap it up in a record type and misalign the
+ latter; we reuse the padding machinery for this purpose. Note that,
+ even if the record type is marked as packed because of misalignment,
+ we don't pack the field so as to give it the size of the type. */
else if (align > 0)
{
tree gnu_field_type, gnu_field;
UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
/* Create a stripped-down declaration, mainly for debugging. */
- create_type_decl (gnu_entity_name, gnu_type, NULL, true,
- debug_info_p, gnat_entity);
+ create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
+ gnat_entity);
/* Now save it and build the enclosing record type. */
gnu_field_type = gnu_type;
a bitfield. */
gnu_field
= create_field_decl (get_identifier ("F"), gnu_field_type,
- gnu_type, NULL_TREE, bitsize_zero_node, 1, 0);
+ gnu_type, TYPE_SIZE (gnu_field_type),
+ bitsize_zero_node, 0, 0);
finish_record_type (gnu_type, gnu_field, 2, debug_info_p);
compute_record_mode (gnu_type);
break;
}
- {
- if (!definition
- && Present (Ancestor_Subtype (gnat_entity))
- && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
- && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
- || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
- gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity),
- gnu_expr, 0);
-
- gnu_type = make_node (REAL_TYPE);
- TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
- TYPE_PRECISION (gnu_type) = fp_size_to_prec (esize);
- TYPE_GCC_MIN_VALUE (gnu_type)
- = TYPE_GCC_MIN_VALUE (TREE_TYPE (gnu_type));
- TYPE_GCC_MAX_VALUE (gnu_type)
- = TYPE_GCC_MAX_VALUE (TREE_TYPE (gnu_type));
- layout_type (gnu_type);
-
- SET_TYPE_RM_MIN_VALUE
- (gnu_type,
- convert (TREE_TYPE (gnu_type),
- elaborate_expression (Type_Low_Bound (gnat_entity),
- gnat_entity, get_identifier ("L"),
- definition, true,
- Needs_Debug_Info (gnat_entity))));
-
- SET_TYPE_RM_MAX_VALUE
- (gnu_type,
- convert (TREE_TYPE (gnu_type),
- elaborate_expression (Type_High_Bound (gnat_entity),
- gnat_entity, get_identifier ("U"),
- definition, true,
- Needs_Debug_Info (gnat_entity))));
-
- /* One of the above calls might have caused us to be elaborated,
- so don't blow up if so. */
- if (present_gnu_tree (gnat_entity))
- {
- maybe_present = true;
- break;
- }
+ /* See the E_Signed_Integer_Subtype case for the rationale. */
+ if (!definition
+ && Present (Ancestor_Subtype (gnat_entity))
+ && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
+ && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
+ || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
+ gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, 0);
- /* Inherit our alias set from what we're a subtype of, as for
- integer subtypes. */
- relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
- }
- break;
+ gnu_type = make_node (REAL_TYPE);
+ TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
+ TYPE_PRECISION (gnu_type) = fp_size_to_prec (esize);
+ TYPE_GCC_MIN_VALUE (gnu_type)
+ = TYPE_GCC_MIN_VALUE (TREE_TYPE (gnu_type));
+ TYPE_GCC_MAX_VALUE (gnu_type)
+ = TYPE_GCC_MAX_VALUE (TREE_TYPE (gnu_type));
+ layout_type (gnu_type);
+
+ SET_TYPE_RM_MIN_VALUE
+ (gnu_type,
+ convert (TREE_TYPE (gnu_type),
+ elaborate_expression (Type_Low_Bound (gnat_entity),
+ gnat_entity, get_identifier ("L"),
+ definition, true,
+ Needs_Debug_Info (gnat_entity))));
+
+ SET_TYPE_RM_MAX_VALUE
+ (gnu_type,
+ convert (TREE_TYPE (gnu_type),
+ elaborate_expression (Type_High_Bound (gnat_entity),
+ gnat_entity, get_identifier ("U"),
+ definition, true,
+ Needs_Debug_Info (gnat_entity))));
+
+ /* Inherit our alias set from what we're a subtype of, as for
+ integer subtypes. */
+ relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
+
+ /* One of the above calls might have caused us to be elaborated,
+ so don't blow up if so. */
+ maybe_present = true;
+ break;
/* Array and String Types and Subtypes
debug_info_p);
TYPE_READONLY (gnu_template_type) = 1;
- /* Now build the array type. */
-
/* If Component_Size is not already specified, annotate it with the
size of the component. */
if (Unknown_Component_Size (gnat_entity))
for (index = ndim - 1; index >= 0; index--)
{
tem = build_nonshared_array_type (tem, gnu_index_types[index]);
+ if (Reverse_Storage_Order (gnat_entity))
+ sorry ("non-default Scalar_Storage_Order");
TYPE_MULTI_ARRAY_P (tem) = (index > 0);
if (array_type_has_nonaliased_component (tem, gnat_entity))
TYPE_NONALIASED_COMPONENT (tem) = 1;
+
+ /* If it is passed by reference, force BLKmode to ensure that
+ objects of this type will always be put in memory. */
+ if (TYPE_MODE (tem) != BLKmode
+ && Is_By_Reference_Type (gnat_entity))
+ SET_TYPE_MODE (tem, BLKmode);
}
/* If an alignment is specified, use it if valid. But ignore it
TYPE_SIZE_UNIT (tem));
}
- create_type_decl (create_concat_name (gnat_entity, "XUA"),
- tem, NULL, !Comes_From_Source (gnat_entity),
- debug_info_p, gnat_entity);
+ create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
+ !Comes_From_Source (gnat_entity), debug_info_p,
+ gnat_entity);
/* Give the fat pointer type a name. If this is a packed type, tell
the debugger how to interpret the underlying bits. */
gnat_name = Packed_Array_Type (gnat_entity);
else
gnat_name = gnat_entity;
- create_type_decl (create_concat_name (gnat_name, "XUP"),
- gnu_fat_type, NULL, !Comes_From_Source (gnat_entity),
- debug_info_p, gnat_entity);
+ create_type_decl (create_concat_name (gnat_name, "XUP"), gnu_fat_type,
+ !Comes_From_Source (gnat_entity), debug_info_p,
+ gnat_entity);
/* Create the type to be designated by thin pointers: a record type for
the array and its template. We used to shift the fields to have the
gnu_orig_max,
gnu_orig_min),
gnu_min,
- size_binop (PLUS_EXPR, gnu_max,
- size_one_node));
+ int_const_binop (PLUS_EXPR, gnu_max,
+ size_one_node));
}
/* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound
in all the other cases. Note that, here as well as above,
the condition used in the comparison must be equivalent to
the condition (length != 0). This is relied upon in order
- to optimize array comparisons in compare_arrays. */
+ to optimize array comparisons in compare_arrays. Moreover
+ we use int_const_binop for the shift by 1 if the bound is
+ constant to avoid any unwanted overflow. */
else
gnu_high
= build_cond_expr (sizetype,
gnu_orig_max,
gnu_orig_min),
gnu_max,
- size_binop (MINUS_EXPR, gnu_min,
- size_one_node));
+ TREE_CODE (gnu_min) == INTEGER_CST
+ ? int_const_binop (MINUS_EXPR, gnu_min,
+ size_one_node)
+ : size_binop (MINUS_EXPR, gnu_min,
+ size_one_node));
/* Reuse the index type for the range type. Then make an index
type with the size range in sizetype. */
TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
if (array_type_has_nonaliased_component (gnu_type, gnat_entity))
TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
+
+ /* See the E_Array_Type case for the rationale. */
+ if (TYPE_MODE (gnu_type) != BLKmode
+ && Is_By_Reference_Type (gnat_entity))
+ SET_TYPE_MODE (gnu_type, BLKmode);
}
/* Attach the TYPE_STUB_DECL in case we have a parallel type. */
/* First finish the type we had been making so that we output
debugging information for it. */
+ process_attributes (&gnu_type, &attr_list, false, gnat_entity);
if (Treat_As_Volatile (gnat_entity))
gnu_type
= build_qualified_type (gnu_type,
TYPE_QUALS (gnu_type)
| TYPE_QUAL_VOLATILE);
-
/* Make it artificial only if the base type was artificial too.
That's sort of "morally" true and will make it possible for
the debugger to look it up by name in DWARF, which is needed
in order to decode the packed array type. */
gnu_decl
- = create_type_decl (gnu_entity_name, gnu_type, attr_list,
+ = create_type_decl (gnu_entity_name, gnu_type,
!Comes_From_Source (Etype (gnat_entity))
&& !Comes_From_Source (gnat_entity),
debug_info_p, gnat_entity);
tree gnu_lower_bound
= convert (gnu_string_index_type,
gnat_to_gnu (String_Literal_Low_Bound (gnat_entity)));
- int length = UI_To_Int (String_Literal_Length (gnat_entity));
- tree gnu_length = ssize_int (length - 1);
+ tree gnu_length
+ = UI_To_gnu (String_Literal_Length (gnat_entity),
+ gnu_string_index_type);
tree gnu_upper_bound
= build_binary_op (PLUS_EXPR, gnu_string_index_type,
gnu_lower_bound,
- convert (gnu_string_index_type, gnu_length));
+ int_const_binop (MINUS_EXPR, gnu_length,
+ integer_one_node));
tree gnu_index_type
= create_index_type (convert (sizetype, gnu_lower_bound),
convert (sizetype, gnu_upper_bound),
{
Node_Id full_definition = Declaration_Node (gnat_entity);
Node_Id record_definition = Type_Definition (full_definition);
+ Node_Id gnat_constr;
Entity_Id gnat_field;
- tree gnu_field, gnu_field_list = NULL_TREE, gnu_get_parent;
+ tree gnu_field, gnu_field_list = NULL_TREE;
+ tree gnu_get_parent;
/* Set PACKED in keeping with gnat_to_gnu_field. */
- int packed
+ const int packed
= Is_Packed (gnat_entity)
? 1
: Component_Alignment (gnat_entity) == Calign_Storage_Unit
&& Known_RM_Size (gnat_entity)))
? -2
: 0;
- bool has_discr = Has_Discriminants (gnat_entity);
- bool has_rep = Has_Specified_Layout (gnat_entity);
- bool all_rep = has_rep;
- bool is_extension
+ const bool has_discr = Has_Discriminants (gnat_entity);
+ const bool has_rep = Has_Specified_Layout (gnat_entity);
+ const bool is_extension
= (Is_Tagged_Type (gnat_entity)
&& Nkind (record_definition) == N_Derived_Type_Definition);
- bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
+ const bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
+ bool all_rep = has_rep;
/* See if all fields have a rep clause. Stop when we find one
that doesn't. */
gnu_type = make_node (tree_code_for_record_type (gnat_entity));
TYPE_NAME (gnu_type) = gnu_entity_name;
TYPE_PACKED (gnu_type) = (packed != 0) || has_rep;
+ if (Reverse_Storage_Order (gnat_entity))
+ sorry ("non-default Scalar_Storage_Order");
+ process_attributes (&gnu_type, &attr_list, true, gnat_entity);
if (!definition)
{
if (Present (Parent_Subtype (gnat_entity)))
{
Entity_Id gnat_parent = Parent_Subtype (gnat_entity);
+ tree gnu_dummy_parent_type = make_node (RECORD_TYPE);
tree gnu_parent;
/* A major complexity here is that the parent subtype will
- reference our discriminants in its Discriminant_Constraint
- list. But those must reference the parent component of this
- record which is of the parent subtype we have not built yet!
+ reference our discriminants in its Stored_Constraint list.
+ But those must reference the parent component of this record
+ which is precisely of the parent subtype we have not built yet!
To break the circle we first build a dummy COMPONENT_REF which
represents the "get to the parent" operation and initialize
each of those discriminants to a COMPONENT_REF of the above
dummy parent referencing the corresponding discriminant of the
base type of the parent subtype. */
- gnu_get_parent = build3 (COMPONENT_REF, void_type_node,
+ gnu_get_parent = build3 (COMPONENT_REF, gnu_dummy_parent_type,
build0 (PLACEHOLDER_EXPR, gnu_type),
build_decl (input_location,
FIELD_DECL, NULL_TREE,
- void_type_node),
+ gnu_dummy_parent_type),
NULL_TREE);
if (has_discr)
}
}
+ /* If we have a derived untagged type that renames discriminants in
+ the root type, the (stored) discriminants are a just copy of the
+ discriminants of the root type. This means that any constraints
+ added by the renaming in the derivation are disregarded as far
+ as the layout of the derived type is concerned. To rescue them,
+ we change the type of the (stored) discriminants to a subtype
+ with the bounds of the type of the visible discriminants. */
+ if (has_discr
+ && !is_extension
+ && Stored_Constraint (gnat_entity) != No_Elist)
+ for (gnat_constr = First_Elmt (Stored_Constraint (gnat_entity));
+ gnat_constr != No_Elmt;
+ gnat_constr = Next_Elmt (gnat_constr))
+ if (Nkind (Node (gnat_constr)) == N_Identifier
+ /* Ignore access discriminants. */
+ && !Is_Access_Type (Etype (Node (gnat_constr)))
+ && Ekind (Entity (Node (gnat_constr))) == E_Discriminant)
+ {
+ Entity_Id gnat_discr = Entity (Node (gnat_constr));
+ tree gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr));
+ tree gnu_ref
+ = gnat_to_gnu_entity (Original_Record_Component (gnat_discr),
+ NULL_TREE, 0);
+
+ /* GNU_REF must be an expression using a PLACEHOLDER_EXPR built
+ just above for one of the stored discriminants. */
+ gcc_assert (TREE_TYPE (TREE_OPERAND (gnu_ref, 0)) == gnu_type);
+
+ if (gnu_discr_type != TREE_TYPE (gnu_ref))
+ {
+ const unsigned prec = TYPE_PRECISION (TREE_TYPE (gnu_ref));
+ tree gnu_subtype
+ = TYPE_UNSIGNED (TREE_TYPE (gnu_ref))
+ ? make_unsigned_type (prec) : make_signed_type (prec);
+ TREE_TYPE (gnu_subtype) = TREE_TYPE (gnu_ref);
+ TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
+ SET_TYPE_RM_MIN_VALUE (gnu_subtype,
+ TYPE_MIN_VALUE (gnu_discr_type));
+ SET_TYPE_RM_MAX_VALUE (gnu_subtype,
+ TYPE_MAX_VALUE (gnu_discr_type));
+ TREE_TYPE (gnu_ref)
+ = TREE_TYPE (TREE_OPERAND (gnu_ref, 1)) = gnu_subtype;
+ }
+ }
+
/* Add the fields into the record type and finish it up. */
components_to_record (gnu_type, Component_List (record_definition),
gnu_field_list, packed, definition, false,
/* If it is passed by reference, force BLKmode to ensure that objects
of this type will always be put in memory. */
- if (Is_By_Reference_Type (gnat_entity))
+ if (TYPE_MODE (gnu_type) != BLKmode
+ && Is_By_Reference_Type (gnat_entity))
SET_TYPE_MODE (gnu_type, BLKmode);
/* We used to remove the associations of the discriminants and _Parent
if (IN (Ekind (gnat_base_type), Record_Kind)
&& !Is_Unchecked_Union (gnat_base_type)
&& !Is_For_Access_Subtype (gnat_entity)
- && Is_Constrained (gnat_entity)
&& Has_Discriminants (gnat_entity)
- && Present (Discriminant_Constraint (gnat_entity))
+ && Is_Constrained (gnat_entity)
&& Stored_Constraint (gnat_entity) != No_Elist)
{
- VEC(subst_pair,heap) *gnu_subst_list
+ vec<subst_pair> gnu_subst_list
= build_subst_list (gnat_entity, gnat_base_type, definition);
tree gnu_unpad_base_type, gnu_rep_part, gnu_variant_part, t;
tree gnu_pos_list, gnu_field_list = NULL_TREE;
bool selected_variant = false;
Entity_Id gnat_field;
- VEC(variant_desc,heap) *gnu_variant_list;
+ vec<variant_desc> gnu_variant_list;
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = gnu_entity_name;
TYPE_PACKED (gnu_type) = TYPE_PACKED (gnu_base_type);
+ process_attributes (&gnu_type, &attr_list, true, gnat_entity);
/* Set the size, alignment and alias set of the new type to
match that of the old one, doing required substitutions. */
else
gnu_unpad_base_type = gnu_base_type;
- /* Look for a REP part in the base type. */
- gnu_rep_part = get_rep_part (gnu_unpad_base_type);
-
/* Look for a variant part in the base type. */
gnu_variant_part = get_variant_part (gnu_unpad_base_type);
if (gnu_variant_part)
{
variant_desc *v;
- unsigned ix;
+ unsigned int i;
gnu_variant_list
= build_variant_list (TREE_TYPE (gnu_variant_part),
- gnu_subst_list, NULL);
+ gnu_subst_list,
+ vNULL);
/* If all the qualifiers are unconditionally true, the
innermost variant is statically selected. */
selected_variant = true;
- FOR_EACH_VEC_ELT_REVERSE (variant_desc, gnu_variant_list,
- ix, v)
+ FOR_EACH_VEC_ELT (gnu_variant_list, i, v)
if (!integer_onep (v->qual))
{
selected_variant = false;
/* Otherwise, create the new variants. */
if (!selected_variant)
- FOR_EACH_VEC_ELT_REVERSE (variant_desc, gnu_variant_list,
- ix, v)
+ FOR_EACH_VEC_ELT (gnu_variant_list, i, v)
{
tree old_variant = v->type;
tree new_variant = make_node (RECORD_TYPE);
}
else
{
- gnu_variant_list = NULL;
+ gnu_variant_list.create (0);
selected_variant = false;
}
gnu_pos_list
= build_position_list (gnu_unpad_base_type,
- gnu_variant_list && !selected_variant,
+ gnu_variant_list.exists ()
+ && !selected_variant,
size_zero_node, bitsize_zero_node,
BIGGEST_ALIGNMENT, NULL_TREE);
gnu_size = DECL_SIZE (gnu_old_field);
if (RECORD_OR_UNION_TYPE_P (gnu_field_type)
&& !TYPE_FAT_POINTER_P (gnu_field_type)
- && host_integerp (TYPE_SIZE (gnu_field_type), 1))
+ && tree_fits_uhwi_p (TYPE_SIZE (gnu_field_type)))
gnu_field_type
= make_packable_type (gnu_field_type, true);
}
and put the field either in the new type if there is a
selected variant or in one of the new variants. */
if (gnu_context == gnu_unpad_base_type
- || (gnu_rep_part
+ || ((gnu_rep_part = get_rep_part (gnu_unpad_base_type))
&& gnu_context == TREE_TYPE (gnu_rep_part)))
gnu_cont_type = gnu_type;
else
{
variant_desc *v;
- unsigned ix;
+ unsigned int i;
t = NULL_TREE;
- FOR_EACH_VEC_ELT_REVERSE (variant_desc,
- gnu_variant_list, ix, v)
- if (v->type == gnu_context)
+ FOR_EACH_VEC_ELT (gnu_variant_list, i, v)
+ if (gnu_context == v->type
+ || ((gnu_rep_part = get_rep_part (v->type))
+ && gnu_context == TREE_TYPE (gnu_rep_part)))
{
t = v->type;
break;
/* If there is a variant list and no selected variant, we need
to create the nest of variant parts from the old nest. */
- if (gnu_variant_list && !selected_variant)
+ if (gnu_variant_list.exists () && !selected_variant)
{
tree new_variant_part
= create_variant_part_from (gnu_variant_part,
/* Do not emit debug info for the type yet since we're going to
modify it below. */
- gnu_field_list = nreverse (gnu_field_list);
- finish_record_type (gnu_type, gnu_field_list, 2, false);
+ finish_record_type (gnu_type, nreverse (gnu_field_list), 2,
+ false);
+ compute_record_mode (gnu_type);
/* See the E_Record_Type case for the rationale. */
- if (Is_By_Reference_Type (gnat_entity))
+ if (TYPE_MODE (gnu_type) != BLKmode
+ && Is_By_Reference_Type (gnat_entity))
SET_TYPE_MODE (gnu_type, BLKmode);
- else
- compute_record_mode (gnu_type);
TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
gnat_entity);
}
- VEC_free (variant_desc, heap, gnu_variant_list);
- VEC_free (subst_pair, heap, gnu_subst_list);
+ gnu_variant_list.release ();
+ gnu_subst_list.release ();
/* Now we can finalize it. */
rest_of_record_type_compilation (gnu_type);
gnu_type
= build_pointer_type
(make_dummy_type (Directly_Designated_Type (gnat_entity)));
- gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list,
+ gnu_decl = create_type_decl (gnu_entity_name, gnu_type,
!Comes_From_Source (gnat_entity),
debug_info_p, gnat_entity);
this_made_decl = true;
/* Whether it comes from a limited with. */
bool is_from_limited_with
= (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
- && From_With_Type (gnat_desig_equiv));
+ && From_Limited_With (gnat_desig_equiv));
/* The "full view" of the designated type. If this is an incomplete
entity from a limited with, treat its non-limited view as the full
view. Otherwise, if this is an incomplete or private type, use the
else
gnu_old_desig_type = TREE_TYPE (gnu_type);
- gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list,
+ process_attributes (&gnu_type, &attr_list, false, gnat_entity);
+ gnu_decl = create_type_decl (gnu_entity_name, gnu_type,
!Comes_From_Source (gnat_entity),
debug_info_p, gnat_entity);
this_made_decl = true;
tree gnu_stub_type = NULL_TREE, gnu_stub_name = NULL_TREE;
tree gnu_ext_name = create_concat_name (gnat_entity, NULL);
Entity_Id gnat_param;
- bool inline_flag = Is_Inlined (gnat_entity);
+ enum inline_status_t inline_status
+ = Has_Pragma_No_Inline (gnat_entity)
+ ? is_suppressed
+ : (Is_Inlined (gnat_entity) ? is_enabled : is_disabled);
bool public_flag = Is_Public (gnat_entity) || imported_p;
bool extern_flag
= (Is_Public (gnat_entity) && !definition) || imported_p;
gnu_return_type = void_type_node;
else
{
- gnu_return_type = gnat_to_gnu_type (gnat_return_type);
+ /* Ada 2012 (AI05-0151): Incomplete types coming from a limited
+ context may now appear in parameter and result profiles. If
+ we are only annotating types, break circularities here. */
+ if (type_annotate_only
+ && IN (Ekind (gnat_return_type), Incomplete_Kind)
+ && From_Limited_With (gnat_return_type)
+ && In_Extended_Main_Code_Unit
+ (Non_Limited_View (gnat_return_type))
+ && !present_gnu_tree (Non_Limited_View (gnat_return_type)))
+ gnu_return_type = ptr_void_type_node;
+ else
+ gnu_return_type = gnat_to_gnu_type (gnat_return_type);
/* If this function returns by reference, make the actual return
type the pointer type and make a note of that. */
if (gnu_return_type != orig_type
&& !DECL_P (TYPE_NAME (gnu_return_type)))
create_type_decl (TYPE_NAME (gnu_return_type),
- gnu_return_type, NULL, true,
- debug_info_p, gnat_entity);
+ gnu_return_type, true, debug_info_p,
+ gnat_entity);
return_by_invisi_ref_p = true;
}
a function that returns that type. This usage doesn't make
sense anyway, so give an error here. */
if (TYPE_SIZE_UNIT (gnu_return_type)
- && TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_return_type))
- && TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_return_type)))
+ && TREE_CODE (TYPE_SIZE_UNIT (gnu_return_type)) == INTEGER_CST
+ && !valid_constant_size_p (TYPE_SIZE_UNIT (gnu_return_type)))
{
post_error ("cannot return type whose size overflows",
gnat_entity);
Present (gnat_param);
gnat_param = Next_Formal_With_Extras (gnat_param), parmnum++)
{
+ Entity_Id gnat_param_type = Etype (gnat_param);
tree gnu_param_name = get_entity_name (gnat_param);
- tree gnu_param_type = gnat_to_gnu_type (Etype (gnat_param));
- tree gnu_param, gnu_field;
- bool copy_in_copy_out = false;
+ tree gnu_param_type, gnu_param, gnu_field;
Mechanism_Type mech = Mechanism (gnat_param);
+ bool copy_in_copy_out = false, fake_param_type;
+
+ /* Ada 2012 (AI05-0151): Incomplete types coming from a limited
+ context may now appear in parameter and result profiles. If
+ we are only annotating types, break circularities here. */
+ if (type_annotate_only
+ && IN (Ekind (gnat_param_type), Incomplete_Kind)
+ && From_Limited_With (Etype (gnat_param_type))
+ && In_Extended_Main_Code_Unit
+ (Non_Limited_View (gnat_param_type))
+ && !present_gnu_tree (Non_Limited_View (gnat_param_type)))
+ {
+ gnu_param_type = ptr_void_type_node;
+ fake_param_type = true;
+ }
+ else
+ {
+ gnu_param_type = gnat_to_gnu_type (gnat_param_type);
+ fake_param_type = false;
+ }
/* Builtins are expanded inline and there is no real call sequence
involved. So the type expected by the underlying expander is
mech = Default;
}
- gnu_param
- = gnat_to_gnu_param (gnat_param, mech, gnat_entity,
- Has_Foreign_Convention (gnat_entity),
- ©_in_copy_out);
+ /* Do not call gnat_to_gnu_param for a fake parameter type since
+ it will try to use the real type again. */
+ if (fake_param_type)
+ {
+ if (Ekind (gnat_param) == E_Out_Parameter)
+ gnu_param = NULL_TREE;
+ else
+ {
+ gnu_param
+ = create_param_decl (gnu_param_name, gnu_param_type,
+ false);
+ Set_Mechanism (gnat_param,
+ mech == Default ? By_Copy : mech);
+ if (Ekind (gnat_param) == E_In_Out_Parameter)
+ copy_in_copy_out = true;
+ }
+ }
+ else
+ gnu_param
+ = gnat_to_gnu_param (gnat_param, mech, gnat_entity,
+ Has_Foreign_Convention (gnat_entity),
+ ©_in_copy_out);
/* We are returned either a PARM_DECL or a type if no parameter
needs to be passed; in either case, adjust the type. */
}
else if (kind == E_Subprogram_Type)
- gnu_decl
- = create_type_decl (gnu_entity_name, gnu_type, attr_list,
- artificial_flag, debug_info_p, gnat_entity);
+ {
+ process_attributes (&gnu_type, &attr_list, false, gnat_entity);
+ gnu_decl
+ = create_type_decl (gnu_entity_name, gnu_type, artificial_flag,
+ debug_info_p, gnat_entity);
+ }
else
{
if (has_stub)
gnu_decl
= create_subprog_decl (gnu_entity_name, gnu_ext_name, gnu_type,
- gnu_param_list, inline_flag, public_flag,
- extern_flag, artificial_flag, attr_list,
- gnat_entity);
+ gnu_param_list, inline_status,
+ public_flag, extern_flag, artificial_flag,
+ attr_list, gnat_entity);
if (has_stub)
{
tree gnu_stub_decl
= create_subprog_decl (gnu_entity_name, gnu_stub_name,
gnu_stub_type, gnu_stub_param_list,
- inline_flag, true, extern_flag,
+ inline_status, true, extern_flag,
false, attr_list, gnat_entity);
SET_DECL_FUNCTION_STUB (gnu_decl, gnu_stub_decl);
}
full view, whichever is present. This is used in all the tests
below. */
Entity_Id full_view
- = (IN (kind, Incomplete_Kind) && From_With_Type (gnat_entity))
+ = (IN (kind, Incomplete_Kind) && From_Limited_With (gnat_entity))
? Non_Limited_View (gnat_entity)
: Present (Full_View (gnat_entity))
? Full_View (gnat_entity)
saved = true;
break;
+ case E_Abstract_State:
+ /* This is a SPARK annotation that only reaches here when compiling in
+ ASIS mode and has no characteristics to annotate. */
+ gcc_assert (type_annotate_only);
+ return error_mark_node;
+
default:
gcc_unreachable ();
}
handling alignment and possible padding. */
if (is_type && (!gnu_decl || this_made_decl))
{
+ /* Process the attributes, if not already done. Note that the type is
+ already defined so we cannot pass true for IN_PLACE here. */
+ process_attributes (&gnu_type, &attr_list, false, gnat_entity);
+
/* Tell the middle-end that objects of tagged types are guaranteed to
be properly aligned. This is necessary because conversions to the
class-wide type are translated into conversions to the root type,
/* Consider an alignment as suspicious if the alignment/size
ratio is greater or equal to the byte/bit ratio. */
- if (host_integerp (size, 1)
- && align >= TREE_INT_CST_LOW (size) * BITS_PER_UNIT)
+ if (tree_fits_uhwi_p (size)
+ && align >= tree_to_uhwi (size) * BITS_PER_UNIT)
post_error_ne ("?suspiciously large alignment specified for&",
Expression (Alignment_Clause (gnat_entity)),
gnat_entity);
}
}
else if (Is_Atomic (gnat_entity) && !gnu_size
- && host_integerp (TYPE_SIZE (gnu_type), 1)
+ && tree_fits_uhwi_p (TYPE_SIZE (gnu_type))
&& integer_pow2p (TYPE_SIZE (gnu_type)))
align = MIN (BIGGEST_ALIGNMENT,
- tree_low_cst (TYPE_SIZE (gnu_type), 1));
+ tree_to_uhwi (TYPE_SIZE (gnu_type)));
else if (Is_Atomic (gnat_entity) && gnu_size
- && host_integerp (gnu_size, 1)
+ && tree_fits_uhwi_p (gnu_size)
&& integer_pow2p (gnu_size))
- align = MIN (BIGGEST_ALIGNMENT, tree_low_cst (gnu_size, 1));
+ align = MIN (BIGGEST_ALIGNMENT, tree_to_uhwi (gnu_size));
/* See if we need to pad the type. If we did, and made a record,
the name of the new type may be changed. So get it back for
}
}
- /* If this is a record type or subtype, call elaborate_expression_1 on
+ /* If this is a record type or subtype, call elaborate_expression_2 on
any field position. Do this for both global and local types.
Skip any fields that we haven't made trees for to avoid problems with
class wide types. */
TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (gnu_type)) = 1;
if (!gnu_decl)
- gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list,
+ gnu_decl = create_type_decl (gnu_entity_name, gnu_type,
!Comes_From_Source (gnat_entity),
debug_info_p, gnat_entity);
else
to conflict with Comp2 and an alias set copy is required.
The language rules ensure the parent type is already frozen here. */
- if (Is_Derived_Type (gnat_entity))
+ if (Is_Derived_Type (gnat_entity) && !type_annotate_only)
{
tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_entity));
relate_alias_sets (gnu_type, gnu_parent_type,
return
create_subprog_decl (gnu_entity_name, gnu_ext_name, void_ftype, NULL_TREE,
- false, true, true, true, attr_list, gnat_entity);
+ is_disabled, true, true, true, attr_list, gnat_entity);
}
-/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY has
- a first parameter with a class or equivalent type.
+/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
+ a C++ imported method or equivalent.
We use the predicate on 32-bit x86/Windows to find out whether we need to
use the "thiscall" calling convention for GNAT_ENTITY. This convention is
- the one set for C++ methods (functions with METHOD_TYPE) by the back-end.
- Now in Ada primitive operations are regular subprograms (e.g. you can have
- common pointers to both) so we cannot compute an equivalent of METHOD_TYPE
- and so we set the calling convention in an uniform way. */
+ used for C++ methods (functions with METHOD_TYPE) by the back-end. */
-static bool
-gnat_first_param_is_class (Entity_Id gnat_entity)
+bool
+is_cplusplus_method (Entity_Id gnat_entity)
{
- Entity_Id gnat_param = First_Formal_With_Extras (gnat_entity);
- Entity_Id gnat_type;
- Node_Id node;
-
- if (No (gnat_param))
+ if (Convention (gnat_entity) != Convention_CPP)
return false;
- gnat_type = Underlying_Type (Etype (gnat_param));
+ /* This is the main case: C++ method imported as a primitive operation. */
+ if (Is_Dispatching_Operation (gnat_entity))
+ return true;
- /* This is the main case. Note that we must return the same value for
- regular tagged types and CW types since dispatching calls have a CW
- type on the caller side and a tagged type on the callee side. */
- if (Is_Tagged_Type (gnat_type))
- return True;
+ /* A thunk needs to be handled like its associated primitive operation. */
+ if (Is_Subprogram (gnat_entity) && Is_Thunk (gnat_entity))
+ return true;
/* C++ classes with no virtual functions can be imported as limited
record types, but we need to return true for the constructors. */
- if (Is_CPP_Class (gnat_type))
- return True;
-
- /* The language-level "protected" calling convention doesn't distinguish
- tagged protected types from non-tagged protected types (e.g. you can
- have common pointers to both) so we must use a single low-level calling
- convention for it. Since tagged protected types can be derived from
- simple limited interfaces, we need to pick the calling convention of
- the latters. */
- if (Is_Protected_Record_Type (gnat_type))
- return True;
-
- /* If this is the special E_Subprogram_Type built for the declaration of
- an access to protected subprogram type, the first parameter will have
- type Address, but we must return true to be consistent with above. */
- if (Is_Itype (gnat_entity)
- && Present (node = Associated_Node_For_Itype (gnat_entity))
- && Nkind (node) == N_Full_Type_Declaration
- && Ekind (Defining_Identifier (node)) == E_Access_Subprogram_Type
- && Present (node = Original_Access_Type (Defining_Identifier (node)))
- && (Ekind (node) == E_Access_Protected_Subprogram_Type
- || Ekind (node) == E_Anonymous_Access_Protected_Subprogram_Type))
- return True;
-
- return False;
+ if (Is_Constructor (gnat_entity))
+ return true;
+
+ /* This is set on the E_Subprogram_Type built for a dispatching call. */
+ if (Is_Dispatch_Table_Entity (gnat_entity))
+ return true;
+
+ return false;
}
-/* Finalize the processing of From_With_Type incomplete types. */
+/* Finalize the processing of From_Limited_With incomplete types. */
void
-finalize_from_with_types (void)
+finalize_from_limited_with (void)
{
struct incomplete *p, *next;
&& !Strict_Alignment (gnat_type)
&& RECORD_OR_UNION_TYPE_P (gnu_type)
&& !TYPE_FAT_POINTER_P (gnu_type)
- && host_integerp (TYPE_SIZE (gnu_type), 1))
+ && tree_fits_uhwi_p (TYPE_SIZE (gnu_type)))
gnu_type = make_packable_type (gnu_type, false);
if (Has_Atomic_Components (gnat_array))
declared otherwise. This is necessary to ensure that its subtrees
are properly marked. */
if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
- create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
- debug_info_p, gnat_array);
+ create_type_decl (TYPE_NAME (gnu_type), gnu_type, true, debug_info_p,
+ gnat_array);
}
if (Has_Volatile_Components (gnat_array))
/* The parameter can be indirectly modified if its address is taken. */
bool ro_param = in_param && !Address_Taken (gnat_param);
bool by_return = false, by_component_ptr = false;
- bool by_ref = false, by_double_ref = false;
+ bool by_ref = false;
tree gnu_param;
/* Copy-return is used only for the first parameter of a valued procedure.
gnu_param_type
= build_qualified_type (gnu_param_type, TYPE_QUAL_RESTRICT);
by_ref = true;
-
- /* In some ABIs, e.g. SPARC 32-bit, fat pointer types are themselves
- passed by reference. Pass them by explicit reference, this will
- generate more debuggable code at -O0. */
- if (TYPE_IS_FAT_POINTER_P (gnu_param_type)
- && targetm.calls.pass_by_reference (pack_cumulative_args (NULL),
- TYPE_MODE (gnu_param_type),
- gnu_param_type,
- true))
- {
- gnu_param_type = build_reference_type (gnu_param_type);
- by_double_ref = true;
- }
}
/* Pass In Out or Out parameters using copy-in copy-out mechanism. */
gnu_param = create_param_decl (gnu_param_name, gnu_param_type,
ro_param || by_ref || by_component_ptr);
DECL_BY_REF_P (gnu_param) = by_ref;
- DECL_BY_DOUBLE_REF_P (gnu_param) = by_double_ref;
DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
- DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
- mech == By_Short_Descriptor);
- /* Note that, in case of a parameter passed by double reference, the
- DECL_POINTS_TO_READONLY_P flag is meant for the second reference.
- The first reference always points to read-only, as it points to
- the second reference, i.e. the reference to the actual parameter. */
+ DECL_BY_DESCRIPTOR_P (gnu_param)
+ = (mech == By_Descriptor || mech == By_Short_Descriptor);
DECL_POINTS_TO_READONLY_P (gnu_param)
= (ro_param && (by_ref || by_component_ptr));
DECL_CAN_NEVER_BE_NULL_P (gnu_param) = Can_Never_Be_Null (gnat_param);
break;
}
- case E_Record_Type:
- {
- Node_Id full_definition = Declaration_Node (gnat_entity);
- Node_Id record_definition = Type_Definition (full_definition);
-
- /* If this is a record extension, go a level further to find the
- record definition. */
- if (Nkind (record_definition) == N_Derived_Type_Definition)
- record_definition = Record_Extension_Part (record_definition);
- }
- break;
-
case E_Record_Subtype:
case E_Private_Subtype:
case E_Limited_Private_Subtype:
case E_Record_Subtype_With_Private:
- if (Is_Constrained (gnat_entity)
- && Has_Discriminants (gnat_entity)
- && Present (Discriminant_Constraint (gnat_entity)))
+ if (Has_Discriminants (gnat_entity) && Is_Constrained (gnat_entity))
{
Node_Id gnat_discriminant_expr;
Entity_Id gnat_field;
Present (gnat_field);
gnat_field = Next_Discriminant (gnat_field),
gnat_discriminant_expr = Next_Elmt (gnat_discriminant_expr))
- /* ??? For now, ignore access discriminants. */
+ /* Ignore access discriminants. */
if (!Is_Access_Type (Etype (Node (gnat_discriminant_expr))))
elaborate_expression (Node (gnat_discriminant_expr),
gnat_entity, get_entity_name (gnat_field),
}
}
\f
-/* Return true if the size represented by GNU_SIZE can be handled by an
- allocation. If STATIC_P is true, consider only what can be done with a
+/* Return true if the size in units represented by GNU_SIZE can be handled by
+ an allocation. If STATIC_P is true, consider only what can be done with a
static allocation. */
static bool
allocatable_size_p (tree gnu_size, bool static_p)
{
- HOST_WIDE_INT our_size;
-
- /* If this is not a static allocation, the only case we want to forbid
- is an overflowing size. That will be converted into a raise a
- Storage_Error. */
- if (!static_p)
- return !(TREE_CODE (gnu_size) == INTEGER_CST
- && TREE_OVERFLOW (gnu_size));
-
- /* Otherwise, we need to deal with both variable sizes and constant
- sizes that won't fit in a host int. We use int instead of HOST_WIDE_INT
- since assemblers may not like very large sizes. */
- if (!host_integerp (gnu_size, 1))
- return false;
+ /* We can allocate a fixed size if it is a valid for the middle-end. */
+ if (TREE_CODE (gnu_size) == INTEGER_CST)
+ return valid_constant_size_p (gnu_size);
- our_size = tree_low_cst (gnu_size, 1);
- return (int) our_size == our_size;
+ /* We can allocate a variable size if this isn't a static allocation. */
+ else
+ return !static_p;
}
\f
/* Prepend to ATTR_LIST an entry for an attribute with provided TYPE,
expr_variable_p = false;
else
{
- /* Skip any conversions and simple arithmetics to see if the expression
- is based on a read-only variable.
+ /* Skip any conversions and simple constant arithmetics to see if the
+ expression is based on a read-only variable.
??? This really should remain read-only, but we have to think about
the typing of the tree here. */
- tree inner
- = skip_simple_arithmetic (remove_conversions (gnu_expr, true));
+ tree inner = remove_conversions (gnu_expr, true);
+
+ inner = skip_simple_constant_arithmetic (inner);
if (handled_component_p (inner))
{
use_variable = expr_variable_p
&& (expr_global_p
|| (!optimize
+ && definition
&& Is_Itype (gnat_entity)
&& Nkind (Associated_Node_For_Itype (gnat_entity))
== N_Loop_Parameter_Specification));
if (!needs_strict_alignment
&& RECORD_OR_UNION_TYPE_P (gnu_field_type)
&& !TYPE_FAT_POINTER_P (gnu_field_type)
- && host_integerp (TYPE_SIZE (gnu_field_type), 1)
+ && tree_fits_uhwi_p (TYPE_SIZE (gnu_field_type))
&& (packed == 1
|| (gnu_size
&& (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))
}
/* If this field needs strict alignment, check that the record is
- sufficiently aligned and that position and size are consistent
- with the alignment. But don't do it if we are just annotating
- types and the field's type is tagged, since tagged types aren't
- fully laid out in this mode. */
+ sufficiently aligned and that position and size are consistent with
+ the alignment. But don't do it if we are just annotating types and
+ the field's type is tagged, since tagged types aren't fully laid out
+ in this mode. Also, note that atomic implies volatile so the inner
+ test sequences ordering is significant here. */
if (needs_strict_alignment
&& !(type_annotate_only && Is_Tagged_Type (gnat_field_type)))
{
Last_Bit (Component_Clause (gnat_field)), gnat_field,
TYPE_SIZE (gnu_field_type));
+ else if (is_volatile)
+ post_error_ne_tree
+ ("volatile field& must be natural size of type{ (^)}",
+ Last_Bit (Component_Clause (gnat_field)), gnat_field,
+ TYPE_SIZE (gnu_field_type));
+
else if (Is_Aliased (gnat_field))
post_error_ne_tree
("size of aliased field& must be ^ bits",
Last_Bit (Component_Clause (gnat_field)), gnat_field,
TYPE_SIZE (gnu_field_type));
+ else
+ gcc_unreachable ();
+
gnu_size = NULL_TREE;
}
(TRUNC_MOD_EXPR, gnu_pos,
bitsize_int (TYPE_ALIGN (gnu_field_type)))))
{
- if (is_volatile)
+ if (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type))
+ post_error_ne_num
+ ("position of atomic field& must be multiple of ^ bits",
+ First_Bit (Component_Clause (gnat_field)), gnat_field,
+ TYPE_ALIGN (gnu_field_type));
+
+ else if (is_volatile)
post_error_ne_num
("position of volatile field& must be multiple of ^ bits",
First_Bit (Component_Clause (gnat_field)), gnat_field,
<= 0)
gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
+ /* Similarly if the field's type is a misaligned integral type, but
+ there is no restriction on the size as there is no justification. */
+ if (!needs_strict_alignment
+ && TYPE_IS_PADDING_P (gnu_field_type)
+ && INTEGRAL_TYPE_P (TREE_TYPE (TYPE_FIELDS (gnu_field_type))))
+ gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
+
gnu_field_type
= make_type_from_size (gnu_field_type, gnu_size,
Has_Biased_Representation (gnat_field));
are properly marked. */
if (gnu_field_type != orig_field_type
&& !DECL_P (TYPE_NAME (gnu_field_type)))
- create_type_decl (TYPE_NAME (gnu_field_type), gnu_field_type, NULL,
- true, debug_info_p, gnat_field);
+ create_type_decl (TYPE_NAME (gnu_field_type), gnu_field_type, true,
+ debug_info_p, gnat_field);
}
/* Otherwise (or if there was an error), don't specify a position. */
return gnu_field;
}
\f
+/* Return true if at least one member of COMPONENT_LIST needs strict
+ alignment. */
+
+static bool
+components_need_strict_alignment (Node_Id component_list)
+{
+ Node_Id component_decl;
+
+ for (component_decl = First_Non_Pragma (Component_Items (component_list));
+ Present (component_decl);
+ component_decl = Next_Non_Pragma (component_decl))
+ {
+ Entity_Id gnat_field = Defining_Entity (component_decl);
+
+ if (Is_Aliased (gnat_field))
+ return true;
+
+ if (Strict_Alignment (Etype (gnat_field)))
+ return true;
+ }
+
+ return false;
+}
+
/* Return true if TYPE is a type with variable size or a padding type with a
field of variable size or a record that has a field with such a type. */
return ret ? ret : (int) (DECL_UID (field1) - DECL_UID (field2));
}
-/* Translate and chain the GNAT_COMPONENT_LIST to the GNU_FIELD_LIST, set
- the result as the field list of GNU_RECORD_TYPE and finish it up. When
- called from gnat_to_gnu_entity during the processing of a record type
+/* Structure holding information for a given variant. */
+typedef struct vinfo
+{
+ /* The record type of the variant. */
+ tree type;
+
+ /* The name of the variant. */
+ tree name;
+
+ /* The qualifier of the variant. */
+ tree qual;
+
+ /* Whether the variant has a rep clause. */
+ bool has_rep;
+
+ /* Whether the variant is packed. */
+ bool packed;
+
+} vinfo_t;
+
+/* Translate and chain the GNAT_COMPONENT_LIST to the GNU_FIELD_LIST, set the
+ result as the field list of GNU_RECORD_TYPE and finish it up. Return true
+ if GNU_RECORD_TYPE has a rep clause which affects the layout (see below).
+ When called from gnat_to_gnu_entity during the processing of a record type
definition, the GCC node for the parent, if any, will be the single field
of GNU_RECORD_TYPE and the GCC nodes for the discriminants will be on the
GNU_FIELD_LIST. The other calls to this function are recursive calls for
P_GNU_REP_LIST, if nonzero, is a pointer to a list to which each field
with a rep clause is to be added; in this case, that is all that should
- be done with such fields. */
+ be done with such fields and the return value will be false. */
-static void
+static bool
components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
tree gnu_field_list, int packed, bool definition,
bool cancel_alignment, bool all_rep,
tree first_free_pos, tree *p_gnu_rep_list)
{
bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
+ bool variants_have_rep = all_rep;
bool layout_with_rep = false;
bool has_self_field = false;
bool has_aliased_after_self_field = false;
Node_Id component_decl, variant_part;
tree gnu_field, gnu_next, gnu_last;
- tree gnu_rep_part = NULL_TREE;
tree gnu_variant_part = NULL_TREE;
tree gnu_rep_list = NULL_TREE;
tree gnu_var_list = NULL_TREE;
"XVN");
tree gnu_union_type, gnu_union_name;
tree this_first_free_pos, gnu_variant_list = NULL_TREE;
+ bool union_field_needs_strict_alignment = false;
+ stack_vec <vinfo_t, 16> variant_types;
+ vinfo_t *gnu_variant;
+ unsigned int variants_align = 0;
+ unsigned int i;
if (TREE_CODE (gnu_name) == TYPE_DECL)
gnu_name = DECL_NAME (gnu_name);
}
}
+ /* We build the variants in two passes. The bulk of the work is done in
+ the first pass, that is to say translating the GNAT nodes, building
+ the container types and computing the associated properties. However
+ we cannot finish up the container types during this pass because we
+ don't know where the variant part will be placed until the end. */
for (variant = First_Non_Pragma (Variants (variant_part));
Present (variant);
variant = Next_Non_Pragma (variant))
{
tree gnu_variant_type = make_node (RECORD_TYPE);
- tree gnu_inner_name;
- tree gnu_qual;
+ tree gnu_inner_name, gnu_qual;
+ bool has_rep;
+ int field_packed;
+ vinfo_t vinfo;
Get_Variant_Encoding (variant);
gnu_inner_name = get_identifier_with_length (Name_Buffer, Name_Len);
/* Add the fields into the record type for the variant. Note that
we aren't sure to really use it at this point, see below. */
- components_to_record (gnu_variant_type, Component_List (variant),
- NULL_TREE, packed, definition,
- !all_rep_and_size, all_rep, unchecked_union,
- true, debug_info, true, reorder,
- this_first_free_pos,
- all_rep || this_first_free_pos
- ? NULL : &gnu_rep_list);
-
+ has_rep
+ = components_to_record (gnu_variant_type, Component_List (variant),
+ NULL_TREE, packed, definition,
+ !all_rep_and_size, all_rep,
+ unchecked_union,
+ true, debug_info, true, reorder,
+ this_first_free_pos,
+ all_rep || this_first_free_pos
+ ? NULL : &gnu_rep_list);
+
+ /* Translate the qualifier and annotate the GNAT node. */
gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant));
Set_Present_Expr (variant, annotate_value (gnu_qual));
+ /* Deal with packedness like in gnat_to_gnu_field. */
+ if (components_need_strict_alignment (Component_List (variant)))
+ {
+ field_packed = 0;
+ union_field_needs_strict_alignment = true;
+ }
+ else
+ field_packed
+ = adjust_packed (gnu_variant_type, gnu_record_type, packed);
+
+ /* Push this variant onto the stack for the second pass. */
+ vinfo.type = gnu_variant_type;
+ vinfo.name = gnu_inner_name;
+ vinfo.qual = gnu_qual;
+ vinfo.has_rep = has_rep;
+ vinfo.packed = field_packed;
+ variant_types.safe_push (vinfo);
+
+ /* Compute the global properties that will determine the placement of
+ the variant part. */
+ variants_have_rep |= has_rep;
+ if (!field_packed && TYPE_ALIGN (gnu_variant_type) > variants_align)
+ variants_align = TYPE_ALIGN (gnu_variant_type);
+ }
+
+ /* Round up the first free position to the alignment of the variant part
+ for the variants without rep clause. This will guarantee a consistent
+ layout independently of the placement of the variant part. */
+ if (variants_have_rep && variants_align > 0 && this_first_free_pos)
+ this_first_free_pos = round_up (this_first_free_pos, variants_align);
+
+ /* In the second pass, the container types are adjusted if necessary and
+ finished up, then the corresponding fields of the variant part are
+ built with their qualifier, unless this is an unchecked union. */
+ FOR_EACH_VEC_ELT (variant_types, i, gnu_variant)
+ {
+ tree gnu_variant_type = gnu_variant->type;
+ tree gnu_field_list = TYPE_FIELDS (gnu_variant_type);
+
/* If this is an Unchecked_Union whose fields are all in the variant
part and we have a single field with no representation clause or
placed at offset zero, use the field directly to match the layout
of C unions. */
if (TREE_CODE (gnu_record_type) == UNION_TYPE
- && (gnu_field = TYPE_FIELDS (gnu_variant_type)) != NULL_TREE
- && !DECL_CHAIN (gnu_field)
- && (!DECL_FIELD_OFFSET (gnu_field)
- || integer_zerop (bit_position (gnu_field))))
- DECL_CONTEXT (gnu_field) = gnu_union_type;
+ && gnu_field_list
+ && !DECL_CHAIN (gnu_field_list)
+ && (!DECL_FIELD_OFFSET (gnu_field_list)
+ || integer_zerop (bit_position (gnu_field_list))))
+ {
+ gnu_field = gnu_field_list;
+ DECL_CONTEXT (gnu_field) = gnu_record_type;
+ }
else
{
- /* Deal with packedness like in gnat_to_gnu_field. */
- int field_packed
- = adjust_packed (gnu_variant_type, gnu_record_type, packed);
-
- /* Finalize the record type now. We used to throw away
- empty records but we no longer do that because we need
- them to generate complete debug info for the variant;
- otherwise, the union type definition will be lacking
- the fields associated with these empty variants. */
- rest_of_record_type_compilation (gnu_variant_type);
+ /* Finalize the variant type now. We used to throw away empty
+ record types but we no longer do that because we need them to
+ generate complete debug info for the variant; otherwise, the
+ union type definition will be lacking the fields associated
+ with these empty variants. */
+ if (gnu_field_list && variants_have_rep && !gnu_variant->has_rep)
+ {
+ /* The variant part will be at offset 0 so we need to ensure
+ that the fields are laid out starting from the first free
+ position at this level. */
+ tree gnu_rep_type = make_node (RECORD_TYPE);
+ tree gnu_rep_part;
+ finish_record_type (gnu_rep_type, NULL_TREE, 0, debug_info);
+ gnu_rep_part
+ = create_rep_part (gnu_rep_type, gnu_variant_type,
+ this_first_free_pos);
+ DECL_CHAIN (gnu_rep_part) = gnu_field_list;
+ gnu_field_list = gnu_rep_part;
+ finish_record_type (gnu_variant_type, gnu_field_list, 0,
+ false);
+ }
+
+ if (debug_info)
+ rest_of_record_type_compilation (gnu_variant_type);
create_type_decl (TYPE_NAME (gnu_variant_type), gnu_variant_type,
- NULL, true, debug_info, gnat_component_list);
+ true, debug_info, gnat_component_list);
gnu_field
- = create_field_decl (gnu_inner_name, gnu_variant_type,
+ = create_field_decl (gnu_variant->name, gnu_variant_type,
gnu_union_type,
all_rep_and_size
? TYPE_SIZE (gnu_variant_type) : 0,
- all_rep_and_size
- ? bitsize_zero_node : 0,
- field_packed, 0);
+ variants_have_rep ? bitsize_zero_node : 0,
+ gnu_variant->packed, 0);
DECL_INTERNAL_P (gnu_field) = 1;
if (!unchecked_union)
- DECL_QUALIFIER (gnu_field) = gnu_qual;
+ DECL_QUALIFIER (gnu_field) = gnu_variant->qual;
}
DECL_CHAIN (gnu_field) = gnu_variant_list;
gcc_assert (unchecked_union
&& !gnu_field_list
&& !gnu_rep_list);
- return;
+ return variants_have_rep;
}
- create_type_decl (TYPE_NAME (gnu_union_type), gnu_union_type,
- NULL, true, debug_info, gnat_component_list);
+ create_type_decl (TYPE_NAME (gnu_union_type), gnu_union_type, true,
+ debug_info, gnat_component_list);
/* Deal with packedness like in gnat_to_gnu_field. */
- union_field_packed
- = adjust_packed (gnu_union_type, gnu_record_type, packed);
+ if (union_field_needs_strict_alignment)
+ union_field_packed = 0;
+ else
+ union_field_packed
+ = adjust_packed (gnu_union_type, gnu_record_type, packed);
gnu_variant_part
= create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
- all_rep ? TYPE_SIZE (gnu_union_type) : 0,
- all_rep || this_first_free_pos
- ? bitsize_zero_node : 0,
+ all_rep_and_size
+ ? TYPE_SIZE (gnu_union_type) : 0,
+ variants_have_rep ? bitsize_zero_node : 0,
union_field_packed, 0);
DECL_INTERNAL_P (gnu_variant_part) = 1;
}
}
- /* From now on, a zero FIRST_FREE_POS is totally useless. */
- if (first_free_pos && integer_zerop (first_free_pos))
- first_free_pos = NULL_TREE;
-
/* Scan GNU_FIELD_LIST and see if any fields have rep clauses and, if we are
permitted to reorder components, self-referential sizes or variable sizes.
If they do, pull them out and put them onto the appropriate list. We have
#undef MOVE_FROM_FIELD_LIST_TO
+ gnu_field_list = nreverse (gnu_field_list);
+
/* If permitted, we reorder the fields as follows:
1) all fixed length fields,
within the record and within each variant recursively. */
if (reorder)
gnu_field_list
- = chainon (nreverse (gnu_self_list),
- chainon (nreverse (gnu_var_list), gnu_field_list));
+ = chainon (gnu_field_list, chainon (gnu_var_list, gnu_self_list));
/* Otherwise, if there is an aliased field placed after a field whose length
depends on discriminants, we put all the fields of the latter sort, last.
We need to do this in case an object of this record type is mutable. */
else if (has_aliased_after_self_field)
- gnu_field_list = chainon (nreverse (gnu_self_list), gnu_field_list);
+ gnu_field_list = chainon (gnu_field_list, gnu_self_list);
/* If P_REP_LIST is nonzero, this means that we are asked to move the fields
in our REP list to the previous level because this level needs them in
record, before the others, if we also have fields without rep clause. */
else if (gnu_rep_list)
{
- tree gnu_rep_type
- = (gnu_field_list ? make_node (RECORD_TYPE) : gnu_record_type);
+ tree gnu_rep_type, gnu_rep_part;
int i, len = list_length (gnu_rep_list);
tree *gnu_arr = XALLOCAVEC (tree, len);
+ /* If all the fields have a rep clause, we can do a flat layout. */
+ layout_with_rep = !gnu_field_list
+ && (!gnu_variant_part || variants_have_rep);
+ gnu_rep_type
+ = layout_with_rep ? gnu_record_type : make_node (RECORD_TYPE);
+
for (gnu_field = gnu_rep_list, i = 0;
gnu_field;
gnu_field = DECL_CHAIN (gnu_field), i++)
DECL_CONTEXT (gnu_arr[i]) = gnu_rep_type;
}
- if (gnu_field_list)
+ if (layout_with_rep)
+ gnu_field_list = gnu_rep_list;
+ else
{
finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info);
Therefore, we force it as a minimal size on the REP part. */
gnu_rep_part
= create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos);
- }
- else
- {
- layout_with_rep = true;
- gnu_field_list = nreverse (gnu_rep_list);
- }
- }
- /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields without
- rep clause are laid out starting from this position. Therefore, if we
- have not already done so, we create a fake REP part with this size. */
- if (first_free_pos && !layout_with_rep && !gnu_rep_part)
- {
- tree gnu_rep_type = make_node (RECORD_TYPE);
- finish_record_type (gnu_rep_type, NULL_TREE, 0, debug_info);
- gnu_rep_part
- = create_rep_part (gnu_rep_type, gnu_record_type, first_free_pos);
+ /* Chain the REP part at the beginning of the field list. */
+ DECL_CHAIN (gnu_rep_part) = gnu_field_list;
+ gnu_field_list = gnu_rep_part;
+ }
}
- /* Now chain the REP part at the end of the reversed field list. */
- if (gnu_rep_part)
- gnu_field_list = chainon (gnu_field_list, gnu_rep_part);
-
- /* And the variant part at the beginning. */
+ /* Chain the variant part at the end of the field list. */
if (gnu_variant_part)
- {
- DECL_CHAIN (gnu_variant_part) = gnu_field_list;
- gnu_field_list = gnu_variant_part;
- }
+ gnu_field_list = chainon (gnu_field_list, gnu_variant_part);
if (cancel_alignment)
TYPE_ALIGN (gnu_record_type) = 0;
- finish_record_type (gnu_record_type, nreverse (gnu_field_list),
- layout_with_rep ? 1 : 0, false);
TYPE_ARTIFICIAL (gnu_record_type) = artificial;
- if (debug_info && !maybe_unused)
- rest_of_record_type_compilation (gnu_record_type);
+
+ finish_record_type (gnu_record_type, gnu_field_list, layout_with_rep ? 1 : 0,
+ debug_info && !maybe_unused);
+
+ return (gnu_rep_list && !p_gnu_rep_list) || variants_have_rep;
}
\f
/* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be
annotate_value (tree gnu_size)
{
TCode tcode;
- Node_Ref_Or_Val ops[3], ret;
+ Node_Ref_Or_Val ops[3], ret, pre_op1 = No_Uint;
struct tree_int_map in;
int i;
switch (TREE_CODE (gnu_size))
{
case INTEGER_CST:
- if (TREE_OVERFLOW (gnu_size))
- return No_Uint;
-
- /* This may come from a conversion from some smaller type, so ensure
- this is in bitsizetype. */
- gnu_size = convert (bitsizetype, gnu_size);
+ return TREE_OVERFLOW (gnu_size) ? No_Uint : UI_From_gnu (gnu_size);
- /* For a negative value, build NEGATE_EXPR of the opposite. Such values
- appear in expressions containing aligning patterns. Note that, since
- sizetype is sign-extended but nonetheless unsigned, we don't directly
- use tree_int_cst_sgn. */
- if (TREE_INT_CST_HIGH (gnu_size) < 0)
+ case COMPONENT_REF:
+ /* The only case we handle here is a simple discriminant reference. */
+ if (DECL_DISCRIMINANT_NUMBER (TREE_OPERAND (gnu_size, 1)))
{
- tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size);
- return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size));
- }
+ tree n = DECL_DISCRIMINANT_NUMBER (TREE_OPERAND (gnu_size, 1));
- return UI_From_gnu (gnu_size);
+ /* Climb up the chain of successive extensions, if any. */
+ while (TREE_CODE (TREE_OPERAND (gnu_size, 0)) == COMPONENT_REF
+ && DECL_NAME (TREE_OPERAND (TREE_OPERAND (gnu_size, 0), 1))
+ == parent_name_id)
+ gnu_size = TREE_OPERAND (gnu_size, 0);
- case COMPONENT_REF:
- /* The only case we handle here is a simple discriminant reference. */
- if (TREE_CODE (TREE_OPERAND (gnu_size, 0)) == PLACEHOLDER_EXPR
- && TREE_CODE (TREE_OPERAND (gnu_size, 1)) == FIELD_DECL
- && DECL_DISCRIMINANT_NUMBER (TREE_OPERAND (gnu_size, 1)))
- return Create_Node (Discrim_Val,
- annotate_value (DECL_DISCRIMINANT_NUMBER
- (TREE_OPERAND (gnu_size, 1))),
- No_Uint, No_Uint);
- else
- return No_Uint;
+ if (TREE_CODE (TREE_OPERAND (gnu_size, 0)) == PLACEHOLDER_EXPR)
+ return
+ Create_Node (Discrim_Val, annotate_value (n), No_Uint, No_Uint);
+ }
+
+ return No_Uint;
CASE_CONVERT: case NON_LVALUE_EXPR:
return annotate_value (TREE_OPERAND (gnu_size, 0));
case TRUTH_OR_EXPR: tcode = Truth_Or_Expr; break;
case TRUTH_XOR_EXPR: tcode = Truth_Xor_Expr; break;
case TRUTH_NOT_EXPR: tcode = Truth_Not_Expr; break;
- case BIT_AND_EXPR: tcode = Bit_And_Expr; break;
case LT_EXPR: tcode = Lt_Expr; break;
case LE_EXPR: tcode = Le_Expr; break;
case GT_EXPR: tcode = Gt_Expr; break;
case EQ_EXPR: tcode = Eq_Expr; break;
case NE_EXPR: tcode = Ne_Expr; break;
+ case BIT_AND_EXPR:
+ tcode = Bit_And_Expr;
+ /* For negative values, build NEGATE_EXPR of the opposite. Such values
+ appear in expressions containing aligning patterns. Note that, since
+ sizetype is unsigned, we have to jump through some hoops. */
+ if (TREE_CODE (TREE_OPERAND (gnu_size, 1)) == INTEGER_CST)
+ {
+ tree op1 = TREE_OPERAND (gnu_size, 1);
+ if (wi::neg_p (op1))
+ {
+ op1 = wide_int_to_tree (sizetype, wi::neg (op1));
+ pre_op1 = annotate_value (build1 (NEGATE_EXPR, sizetype, op1));
+ }
+ }
+ break;
+
case CALL_EXPR:
{
tree t = maybe_inline_call_in_expr (gnu_size);
for (i = 0; i < TREE_CODE_LENGTH (TREE_CODE (gnu_size)); i++)
{
- ops[i] = annotate_value (TREE_OPERAND (gnu_size, i));
+ if (i == 1 && pre_op1 != No_Uint)
+ ops[i] = pre_op1;
+ else
+ ops[i] = annotate_value (TREE_OPERAND (gnu_size, i));
if (ops[i] == No_Uint)
return No_Uint;
}
/* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
size and alignment used by Gigi. Prefer SIZE over TYPE_SIZE if non-null.
- BY_REF is true if the object is used by reference and BY_DOUBLE_REF is
- true if the object is used by double reference. */
+ BY_REF is true if the object is used by reference. */
void
-annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref,
- bool by_double_ref)
+annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
{
if (by_ref)
{
- if (by_double_ref)
- gnu_type = TREE_TYPE (gnu_type);
-
if (TYPE_IS_FAT_POINTER_P (gnu_type))
gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type);
else
return gnu_list;
}
-/* Return a VEC describing the substitutions needed to reflect the
+/* Return a list describing the substitutions needed to reflect the
discriminant substitutions from GNAT_TYPE to GNAT_SUBTYPE. They can
- be in any order. The values in an element of the VEC are in the form
+ be in any order. The values in an element of the list are in the form
of operands to SUBSTITUTE_IN_EXPR. DEFINITION is true if this is for
a definition of GNAT_SUBTYPE. */
-static VEC(subst_pair,heap) *
+static vec<subst_pair>
build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
{
- VEC(subst_pair,heap) *gnu_vec = NULL;
+ vec<subst_pair> gnu_list = vNULL;
Entity_Id gnat_discrim;
- Node_Id gnat_value;
+ Node_Id gnat_constr;
for (gnat_discrim = First_Stored_Discriminant (gnat_type),
- gnat_value = First_Elmt (Stored_Constraint (gnat_subtype));
+ gnat_constr = First_Elmt (Stored_Constraint (gnat_subtype));
Present (gnat_discrim);
gnat_discrim = Next_Stored_Discriminant (gnat_discrim),
- gnat_value = Next_Elmt (gnat_value))
+ gnat_constr = Next_Elmt (gnat_constr))
/* Ignore access discriminants. */
- if (!Is_Access_Type (Etype (Node (gnat_value))))
+ if (!Is_Access_Type (Etype (Node (gnat_constr))))
{
tree gnu_field = gnat_to_gnu_field_decl (gnat_discrim);
tree replacement = convert (TREE_TYPE (gnu_field),
elaborate_expression
- (Node (gnat_value), gnat_subtype,
+ (Node (gnat_constr), gnat_subtype,
get_entity_name (gnat_discrim),
definition, true, false));
- subst_pair *s = VEC_safe_push (subst_pair, heap, gnu_vec, NULL);
- s->discriminant = gnu_field;
- s->replacement = replacement;
+ subst_pair s = {gnu_field, replacement};
+ gnu_list.safe_push (s);
}
- return gnu_vec;
+ return gnu_list;
}
-/* Scan all fields in QUAL_UNION_TYPE and return a VEC describing the
+/* Scan all fields in QUAL_UNION_TYPE and return a list describing the
variants of QUAL_UNION_TYPE that are still relevant after applying
- the substitutions described in SUBST_LIST. VARIANT_LIST is a
- pre-existing VEC onto which newly created entries should be
- pushed. */
+ the substitutions described in SUBST_LIST. GNU_LIST is a pre-existing
+ list to be prepended to the newly created entries. */
-static VEC(variant_desc,heap) *
-build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list,
- VEC(variant_desc,heap) *variant_list)
+static vec<variant_desc>
+build_variant_list (tree qual_union_type, vec<subst_pair> subst_list,
+ vec<variant_desc> gnu_list)
{
tree gnu_field;
gnu_field = DECL_CHAIN (gnu_field))
{
tree qual = DECL_QUALIFIER (gnu_field);
- unsigned ix;
+ unsigned int i;
subst_pair *s;
- FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+ FOR_EACH_VEC_ELT (subst_list, i, s)
qual = SUBSTITUTE_IN_EXPR (qual, s->discriminant, s->replacement);
/* If the new qualifier is not unconditionally false, its variant may
still be accessed. */
if (!integer_zerop (qual))
{
- variant_desc *v;
tree variant_type = TREE_TYPE (gnu_field), variant_subpart;
+ variant_desc v = {variant_type, gnu_field, qual, NULL_TREE};
- v = VEC_safe_push (variant_desc, heap, variant_list, NULL);
- v->type = variant_type;
- v->field = gnu_field;
- v->qual = qual;
- v->new_type = NULL_TREE;
+ gnu_list.safe_push (v);
/* Recurse on the variant subpart of the variant, if any. */
variant_subpart = get_variant_part (variant_type);
if (variant_subpart)
- variant_list = build_variant_list (TREE_TYPE (variant_subpart),
- subst_list, variant_list);
+ gnu_list = build_variant_list (TREE_TYPE (variant_subpart),
+ subst_list, gnu_list);
/* If the new qualifier is unconditionally true, the subsequent
variants cannot be accessed. */
}
}
- return variant_list;
+ return gnu_list;
}
\f
/* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE
&& !VOID_TYPE_P (btin_return_type))
return true;
+ /* If return type is Address (integer type), map it to void *. */
+ if (Is_Descendent_Of_Address (Etype (inb->gnat_entity)))
+ ada_return_type = ptr_void_type_node;
+
/* Check return types compatibility otherwise. Note that this
handles void/void as well. */
if (intrin_types_incompatible_p (btin_return_type, ada_return_type))
static tree
create_field_decl_from (tree old_field, tree field_type, tree record_type,
tree size, tree pos_list,
- VEC(subst_pair,heap) *subst_list)
+ vec<subst_pair> subst_list)
{
tree t = TREE_VALUE (purpose_member (old_field, pos_list));
tree pos = TREE_VEC_ELT (t, 0), bitpos = TREE_VEC_ELT (t, 2);
- unsigned int offset_align = tree_low_cst (TREE_VEC_ELT (t, 1), 1);
+ unsigned int offset_align = tree_to_uhwi (TREE_VEC_ELT (t, 1));
tree new_pos, new_field;
- unsigned ix;
+ unsigned int i;
subst_pair *s;
if (CONTAINS_PLACEHOLDER_P (pos))
- FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+ FOR_EACH_VEC_ELT (subst_list, i, s)
pos = SUBSTITUTE_IN_EXPR (pos, s->discriminant, s->replacement);
/* If the position is now a constant, we can set it as the position of the
min_size = NULL_TREE;
field = create_field_decl (get_identifier ("REP"), rep_type, record_type,
- min_size, bitsize_zero_node, 0, 1);
+ min_size, NULL_TREE, 0, 1);
DECL_INTERNAL_P (field) = 1;
return field;
/* The REP part is the first field, internal, another record, and its name
starts with an 'R'. */
- if (DECL_INTERNAL_P (field)
+ if (field
+ && DECL_INTERNAL_P (field)
&& TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE
&& IDENTIFIER_POINTER (DECL_NAME (field)) [0] == 'R')
return field;
static tree
create_variant_part_from (tree old_variant_part,
- VEC(variant_desc,heap) *variant_list,
+ vec<variant_desc> variant_list,
tree record_type, tree pos_list,
- VEC(subst_pair,heap) *subst_list)
+ vec<subst_pair> subst_list)
{
tree offset = DECL_FIELD_OFFSET (old_variant_part);
tree old_union_type = TREE_TYPE (old_variant_part);
tree new_union_type, new_variant_part;
tree union_field_list = NULL_TREE;
variant_desc *v;
- unsigned ix;
+ unsigned int i;
/* First create the type of the variant part from that of the old one. */
new_union_type = make_node (QUAL_UNION_TYPE);
copy_and_substitute_in_size (new_union_type, old_union_type, subst_list);
/* Now finish up the new variants and populate the union type. */
- FOR_EACH_VEC_ELT_REVERSE (variant_desc, variant_list, ix, v)
+ FOR_EACH_VEC_ELT_REVERSE (variant_list, i, v)
{
tree old_field = v->field, new_field;
tree old_variant, old_variant_subpart, new_variant, field_list;
info thanks to the XVS type. */
finish_record_type (new_variant, nreverse (field_list), 2, false);
compute_record_mode (new_variant);
- create_type_decl (TYPE_NAME (new_variant), new_variant, NULL,
- true, false, Empty);
+ create_type_decl (TYPE_NAME (new_variant), new_variant, true, false,
+ Empty);
new_field
= create_field_decl_from (old_field, new_variant, new_union_type,
}
/* Finish up the union type and create the variant part. No need for debug
- info thanks to the XVS type. */
+ info thanks to the XVS type. Note that we don't reverse the field list
+ because VARIANT_LIST has been traversed in reverse order. */
finish_record_type (new_union_type, union_field_list, 2, false);
compute_record_mode (new_union_type);
- create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL,
- true, false, Empty);
+ create_type_decl (TYPE_NAME (new_union_type), new_union_type, true, false,
+ Empty);
new_variant_part
= create_field_decl_from (old_variant_part, new_union_type, record_type,
static void
copy_and_substitute_in_size (tree new_type, tree old_type,
- VEC(subst_pair,heap) *subst_list)
+ vec<subst_pair> subst_list)
{
- unsigned ix;
+ unsigned int i;
subst_pair *s;
TYPE_SIZE (new_type) = TYPE_SIZE (old_type);
relate_alias_sets (new_type, old_type, ALIAS_SET_COPY);
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (new_type)))
- FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+ FOR_EACH_VEC_ELT (subst_list, i, s)
TYPE_SIZE (new_type)
= SUBSTITUTE_IN_EXPR (TYPE_SIZE (new_type),
s->discriminant, s->replacement);
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (new_type)))
- FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+ FOR_EACH_VEC_ELT (subst_list, i, s)
TYPE_SIZE_UNIT (new_type)
= SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (new_type),
s->discriminant, s->replacement);
if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (new_type)))
- FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+ FOR_EACH_VEC_ELT (subst_list, i, s)
SET_TYPE_ADA_SIZE
(new_type, SUBSTITUTE_IN_EXPR (TYPE_ADA_SIZE (new_type),
s->discriminant, s->replacement));
projects / thirdparty / gcc.git / blobdiff