* *
* 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"
#include "ada-tree.h"
#include "gigi.h"
-/* Convention_Stdcall should be processed in a specific way on 32 bits
- Windows targets only. The macro below is a helper to avoid having to
- check for a Windows specific attribute throughout this unit. */
+/* "stdcall" and "thiscall" conventions should be processed in a specific way
+ on 32-bit x86/Windows only. The macros below are helpers to avoid having
+ to check for a Windows specific attribute throughout this unit. */
#if TARGET_DLLIMPORT_DECL_ATTRIBUTES
#ifdef TARGET_64BIT
#define Has_Stdcall_Convention(E) \
(!TARGET_64BIT && Convention (E) == Convention_Stdcall)
+#define Has_Thiscall_Convention(E) \
+ (!TARGET_64BIT && is_cplusplus_method (E))
#else
#define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
+#define Has_Thiscall_Convention(E) (is_cplusplus_method (E))
#endif
#else
#define Has_Stdcall_Convention(E) 0
+#define Has_Thiscall_Convention(E) 0
#endif
/* Stack realignment is necessary for functions with foreign conventions when
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;
-/* These variables are used to defer finalizing types. The element of the
- list is the TYPE_DECL associated with the type. */
-static int defer_finalize_level = 0;
-static VEC (tree,heap) *defer_finalize_list;
-
typedef struct subst_pair_d {
tree discriminant;
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. */
/* The value of the qualifier. */
tree qual;
- /* The record associated with this variant. */
- tree record;
+ /* The type of the variant after transformation. */
+ 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;
-enum alias_set_op
-{
- ALIAS_SET_COPY,
- ALIAS_SET_SUBSET,
- ALIAS_SET_SUPERSET
-};
-
-static void relate_alias_sets (tree, tree, enum alias_set_op);
-
static bool allocatable_size_p (tree, bool);
static void prepend_one_attribute_to (struct attrib **,
enum attr_type, tree, tree, Node_Id);
static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool);
static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool,
unsigned int);
-static tree make_packable_type (tree, bool);
static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);
static tree gnat_to_gnu_param (Entity_Id, Mechanism_Type, Entity_Id, bool,
bool *);
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,
- bool, bool, bool, bool, tree, tree *);
+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 tree make_type_from_size (tree, tree, bool);
static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
-static unsigned int ceil_alignment (unsigned HOST_WIDE_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 void rest_of_type_decl_compilation_no_defer (tree);
+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)
another compilation unit) public entities, show we are at global level
for the purpose of computing scopes. Don't do this for components or
discriminants since the relevant test is whether or not the record is
- being defined. Don't do this for constants either as we'll look into
- their defining expression in the local context. */
+ being defined. */
if (!definition
&& kind != E_Component
&& kind != E_Discriminant
- && kind != E_Constant
&& Is_Public (gnat_entity)
&& !Is_Statically_Allocated (gnat_entity))
force_global++, this_global = true;
prepend_attributes (First_Subtype (Base_Type (gnat_entity)),
&attr_list);
- /* Compute a default value for the size of the type. */
- if (Known_Esize (gnat_entity)
- && UI_Is_In_Int_Range (Esize (gnat_entity)))
+ /* Compute a default value for the size of an elementary type. */
+ if (Known_Esize (gnat_entity) && Is_Elementary_Type (gnat_entity))
{
unsigned int max_esize;
+
+ gcc_assert (UI_Is_In_Int_Range (Esize (gnat_entity)));
esize = UI_To_Int (Esize (gnat_entity));
if (IN (kind, Float_Kind))
!= N_Allocator)
{
bool went_into_elab_proc = false;
+ int save_force_global = force_global;
/* The expression may contain N_Expression_With_Actions nodes and
thus object declarations from other units. In this case, even
current_function_decl = get_elaboration_procedure ();
went_into_elab_proc = true;
}
+ force_global = 0;
gnat_pushlevel ();
gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity)));
gnat_zaplevel ();
+ force_global = save_force_global;
if (went_into_elab_proc)
current_function_decl = NULL_TREE;
}
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);
}
}
gnu_size = max_size (TYPE_SIZE (gnu_type), true);
mutable_p = true;
}
+
+ /* If we are at global level and the size isn't constant, call
+ elaborate_expression_1 to make a variable for it rather than
+ calculating it each time. */
+ if (global_bindings_p () && !TREE_CONSTANT (gnu_size))
+ gnu_size = elaborate_expression_1 (gnu_size, gnat_entity,
+ get_identifier ("SIZE"),
+ definition, false);
}
/* If the size is zero byte, make it one byte since some linkers have
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_alignment (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))
tree orig_type = gnu_type;
gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
- false, false, definition,
- gnu_size ? true : false);
+ false, false, definition, true);
/* If a padding record was made, declare it now since it will
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);
}
gnu_type = TREE_TYPE (gnu_expr);
}
+ /* Or else, if the renamed object has an unconstrained type with
+ default discriminant, use the padded type. */
+ else if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_expr))
+ && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_expr)))
+ == gnu_type
+ && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+ gnu_type = TREE_TYPE (gnu_expr);
+
/* Case 1: If this is a constant renaming stemming from a function
call, treat it as a normal object whose initial value is what
is being renamed. RM 3.3 says that the result of evaluating a
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)
&& present_gnu_tree (Original_Array_Type (gnat_entity)))
- add_parallel_type (TYPE_STUB_DECL (gnu_type),
+ add_parallel_type (gnu_type,
gnat_to_gnu_type
(Original_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;
{
/* Make the original array type a parallel type. */
if (present_gnu_tree (Original_Array_Type (gnat_entity)))
- add_parallel_type (TYPE_STUB_DECL (gnu_type),
+ add_parallel_type (gnu_type,
gnat_to_gnu_type
(Original_Array_Type (gnat_entity)));
}
/* 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
const bool convention_fortran_p
= (Convention (gnat_entity) == Convention_Fortran);
const int ndim = Number_Dimensions (gnat_entity);
- tree gnu_template_type = make_node (RECORD_TYPE);
- tree gnu_ptr_template = build_pointer_type (gnu_template_type);
+ tree gnu_template_type;
+ tree gnu_ptr_template;
tree gnu_template_reference, gnu_template_fields, gnu_fat_type;
tree *gnu_index_types = XALLOCAVEC (tree, ndim);
tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
TYPE_NAME (gnu_fat_type) = NULL_TREE;
/* Save the contents of the dummy type for update_pointer_to. */
TYPE_POINTER_TO (gnu_type) = copy_type (gnu_fat_type);
+ gnu_ptr_template =
+ TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)));
+ gnu_template_type = TREE_TYPE (gnu_ptr_template);
}
else
- gnu_fat_type = make_node (RECORD_TYPE);
+ {
+ gnu_fat_type = make_node (RECORD_TYPE);
+ gnu_template_type = make_node (RECORD_TYPE);
+ gnu_ptr_template = build_pointer_type (gnu_template_type);
+ }
/* Make a node for the array. If we are not defining the array
suppress expanding incomplete types. */
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 the type to be used as what a thin pointer designates:
- a record type for the object and its template with the fields
- shifted to have the template at a negative offset. */
+ 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
+ template at a negative offset, but this was somewhat of a kludge; we
+ now shift thin pointer values explicitly but only those which have a
+ TYPE_UNCONSTRAINED_ARRAY attached to the designated RECORD_TYPE. */
tem = build_unc_object_type (gnu_template_type, tem,
create_concat_name (gnat_name, "XUT"),
debug_info_p);
- shift_unc_components_for_thin_pointers (tem);
SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type);
TYPE_OBJECT_RECORD_TYPE (gnu_type) = tem;
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. */
}
finish_record_type (gnu_bound_rec, gnu_field_list, 0, true);
- add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec);
+ add_parallel_type (gnu_type, gnu_bound_rec);
}
/* If this is a packed array type, make the original array type a
{
if (Is_Packed_Array_Type (gnat_entity)
&& present_gnu_tree (Original_Array_Type (gnat_entity)))
- add_parallel_type (TYPE_STUB_DECL (gnu_type),
+ add_parallel_type (gnu_type,
gnat_to_gnu_type
(Original_Array_Type (gnat_entity)));
else
tree gnu_base_decl
= gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, 0);
if (!DECL_ARTIFICIAL (gnu_base_decl))
- add_parallel_type (TYPE_STUB_DECL (gnu_type),
+ add_parallel_type (gnu_type,
TREE_TYPE (TREE_TYPE (gnu_base_decl)));
}
}
/* 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 (Known_Alignment (gnat_entity))
TYPE_ALIGN (gnu_type)
= validate_alignment (Alignment (gnat_entity), gnat_entity, 0);
- else if (Is_Atomic (gnat_entity))
- TYPE_ALIGN (gnu_type)
- = esize >= BITS_PER_WORD ? BITS_PER_WORD : ceil_alignment (esize);
+ else if (Is_Atomic (gnat_entity) && Known_Esize (gnat_entity))
+ {
+ unsigned int size = UI_To_Int (Esize (gnat_entity));
+ TYPE_ALIGN (gnu_type)
+ = size >= BITS_PER_WORD ? BITS_PER_WORD : ceil_pow2 (size);
+ }
/* If a type needs strict alignment, the minimum size will be the
type size instead of the RM size (see validate_size). Cap the
alignment, lest it causes this type size to become too large. */
- else if (Strict_Alignment (gnat_entity)
- && Known_RM_Size (gnat_entity))
+ else if (Strict_Alignment (gnat_entity) && Known_RM_Size (gnat_entity))
{
unsigned int raw_size = UI_To_Int (RM_Size (gnat_entity));
unsigned int raw_align = raw_size & -raw_size;
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,
- all_rep, is_unchecked_union, debug_info_p,
+ all_rep, is_unchecked_union,
+ !Comes_From_Source (gnat_entity), debug_info_p,
false, OK_To_Reorder_Components (gnat_entity),
all_rep ? NULL_TREE : bitsize_zero_node, NULL);
/* 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);
+ tree suffix
+ = concat_name (DECL_NAME (gnu_variant_part),
+ IDENTIFIER_POINTER
+ (DECL_NAME (v->field)));
TYPE_NAME (new_variant)
- = DECL_NAME (TYPE_NAME (old_variant));
+ = concat_name (TYPE_NAME (gnu_type),
+ IDENTIFIER_POINTER (suffix));
copy_and_substitute_in_size (new_variant, old_variant,
gnu_subst_list);
- v->record = new_variant;
+ v->new_type = new_variant;
}
}
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 (selected_variant)
gnu_cont_type = gnu_type;
else
- gnu_cont_type = v->record;
+ gnu_cont_type = v->new_type;
}
else
/* The front-end may pass us "ghost" components if
/* 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);
0, 0),
0, true);
- add_parallel_type (TYPE_STUB_DECL (gnu_type),
- gnu_subtype_marker);
+ add_parallel_type (gnu_type, gnu_subtype_marker);
if (definition
&& TREE_CODE (gnu_size_unit) != INTEGER_CST
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;
care of those situations. */
if (defer_incomplete_level == 0 && !is_from_limited_with)
{
- defer_finalize_level++;
update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_desig_type),
gnat_to_gnu_type (gnat_desig_equiv));
- defer_finalize_level--;
}
else
{
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. */
return_by_invisi_ref_p = true;
/* Likewise, if the return type is itself By_Reference. */
- else if (TREE_ADDRESSABLE (gnu_return_type))
+ else if (TYPE_IS_BY_REFERENCE_P (gnu_return_type))
return_by_invisi_ref_p = true;
/* If the type is a padded type and the underlying type would not
mechanism to avoid copying too much data when it returns. */
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_return_type)))
{
+ tree orig_type = gnu_return_type;
+
gnu_return_type
= maybe_pad_type (gnu_return_type,
max_size (TYPE_SIZE (gnu_return_type),
/* Declare it now since it will never be declared otherwise.
This is necessary to ensure that its subtrees are properly
marked. */
- create_type_decl (TYPE_NAME (gnu_return_type), gnu_return_type,
- NULL, true, debug_info_p, gnat_entity);
+ if (gnu_return_type != orig_type
+ && !DECL_P (TYPE_NAME (gnu_return_type)))
+ create_type_decl (TYPE_NAME (gnu_return_type),
+ 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. */
(&attr_list, ATTR_MACHINE_ATTRIBUTE,
get_identifier ("stdcall"), NULL_TREE,
gnat_entity);
+ else if (Has_Thiscall_Convention (gnat_entity))
+ prepend_one_attribute_to
+ (&attr_list, ATTR_MACHINE_ATTRIBUTE,
+ get_identifier ("thiscall"), NULL_TREE,
+ gnat_entity);
/* If we should request stack realignment for a foreign convention
subprogram, do so. Note that this applies to task entry points in
}
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,
|| Is_Class_Wide_Equivalent_Type (gnat_entity))
TYPE_ALIGN_OK (gnu_type) = 1;
- /* If the type is passed by reference, objects of this type must be
- fully addressable and cannot be copied. */
- if (Is_By_Reference_Type (gnat_entity))
- TREE_ADDRESSABLE (gnu_type) = 1;
+ /* Record whether the type is passed by reference. */
+ if (!VOID_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity))
+ TYPE_BY_REFERENCE_P (gnu_type) = 1;
/* ??? Don't set the size for a String_Literal since it is either
confirming or we don't handle it properly (if the low bound is
if (operand_equal_p (TYPE_SIZE (gnu_type), gnu_size, 0)
&& operand_equal_p (rm_size (gnu_type), gnu_size, 0))
- gnu_size = 0;
+ gnu_size = NULL_TREE;
}
/* If the alignment hasn't already been processed and this is
/* 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
gnu_entity_name = DECL_NAME (gnu_entity_name);
}
+ /* Now set the RM size of the type. We cannot do it before padding
+ because we need to accept arbitrary RM sizes on integral types. */
set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity);
/* If we are at global level, GCC will have applied variable_size to
}
}
- /* 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,
if (CONTAINS_PLACEHOLDER_P (gnu_size))
gnu_size = max_size (gnu_size, true);
- if (type_annotate_only && Is_Tagged_Type (gnat_entity))
+ /* If we are just annotating types and the type is tagged, the tag
+ and the parent components are not generated by the front-end so
+ sizes must be adjusted if there is no representation clause. */
+ if (type_annotate_only
+ && Is_Tagged_Type (gnat_entity)
+ && !VOID_TYPE_P (gnu_type)
+ && (!TYPE_FIELDS (gnu_type)
+ || integer_zerop (bit_position (TYPE_FIELDS (gnu_type)))))
{
- /* In this mode, the tag and the parent components are not
- generated by the front-end so the sizes must be adjusted. */
tree pointer_size = bitsize_int (POINTER_SIZE), offset;
Uint uint_size;
if (Is_Derived_Type (gnat_entity))
{
- offset = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))),
- bitsizetype);
- Set_Alignment (gnat_entity,
- Alignment (Etype (Base_Type (gnat_entity))));
+ Entity_Id gnat_parent = Etype (Base_Type (gnat_entity));
+ offset = UI_To_gnu (Esize (gnat_parent), bitsizetype);
+ Set_Alignment (gnat_entity, Alignment (gnat_parent));
}
else
offset = pointer_size;
+ if (TYPE_FIELDS (gnu_type))
+ offset
+ = round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type)));
+
gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
- gnu_size = size_binop (MULT_EXPR, pointer_size,
- size_binop (CEIL_DIV_EXPR,
- gnu_size,
- pointer_size));
+ gnu_size = round_up (gnu_size, POINTER_SIZE);
uint_size = annotate_value (gnu_size);
Set_Esize (gnat_entity, uint_size);
Set_RM_Size (gnat_entity, uint_size);
}
/* If we really have a ..._DECL node, set a couple of flags on it. But we
- cannot do so if we are reusing the ..._DECL node made for an alias or a
- renamed object as the predicates don't apply to it but to GNAT_ENTITY. */
+ cannot do so if we are reusing the ..._DECL node made for an equivalent
+ type or an alias or a renamed object as the predicates don't apply to it
+ but to GNAT_ENTITY. */
if (DECL_P (gnu_decl)
+ && !(is_type && gnat_equiv_type != gnat_entity)
&& !Present (Alias (gnat_entity))
&& !(Present (Renamed_Object (gnat_entity)) && saved))
{
/* Enumeration types have specific RM bounds. */
SET_TYPE_RM_MIN_VALUE (gnu_scalar_type, gnu_low_bound);
SET_TYPE_RM_MAX_VALUE (gnu_scalar_type, gnu_high_bound);
-
- /* Write full debugging information. */
- rest_of_type_decl_compilation (gnu_decl);
}
-
else
{
/* Floating-point types don't have specific RM bounds. */
p = defer_incomplete_list;
defer_incomplete_list = NULL;
- /* For finalization, however, all types must be complete so we
- cannot do the same because deferred incomplete types may end up
- referencing each other. Process them all recursively first. */
- defer_finalize_level++;
-
for (; p; p = next)
{
next = p->next;
gnat_to_gnu_type (p->full_type));
free (p);
}
-
- defer_finalize_level--;
- }
-
- /* If all the deferred incomplete types have been processed, we can proceed
- with the finalization of the deferred types. */
- if (defer_incomplete_level == 0
- && defer_finalize_level == 0
- && defer_finalize_list)
- {
- unsigned int i;
- tree t;
-
- FOR_EACH_VEC_ELT (tree, defer_finalize_list, i, t)
- rest_of_type_decl_compilation_no_defer (t);
-
- VEC_free (tree, heap, defer_finalize_list);
}
/* If we are not defining this type, see if it's on one of the lists of
prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE,
get_identifier ("stdcall"), NULL_TREE,
gnat_entity);
+ else if (Has_Thiscall_Convention (gnat_entity))
+ prepend_one_attribute_to (&attr_list, ATTR_MACHINE_ATTRIBUTE,
+ get_identifier ("thiscall"), NULL_TREE,
+ gnat_entity);
if (No (Interface_Name (gnat_entity)) && gnu_ext_name == gnu_entity_name)
gnu_ext_name = NULL_TREE;
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);
}
-\f
-/* Wrap up compilation of DECL, a TYPE_DECL, possibly deferring it.
- Every TYPE_DECL generated for a type definition must be passed
- to this function once everything else has been done for it. */
-void
-rest_of_type_decl_compilation (tree decl)
-{
- /* We need to defer finalizing the type if incomplete types
- are being deferred or if they are being processed. */
- if (defer_incomplete_level != 0 || defer_finalize_level != 0)
- VEC_safe_push (tree, heap, defer_finalize_list, decl);
- else
- rest_of_type_decl_compilation_no_defer (decl);
-}
+/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
+ a C++ imported method or equivalent.
-/* Same as above but without deferring the compilation. This
- function should not be invoked directly on a TYPE_DECL. */
+ 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
+ used for C++ methods (functions with METHOD_TYPE) by the back-end. */
-static void
-rest_of_type_decl_compilation_no_defer (tree decl)
+bool
+is_cplusplus_method (Entity_Id gnat_entity)
{
- const int toplev = global_bindings_p ();
- tree t = TREE_TYPE (decl);
+ if (Convention (gnat_entity) != Convention_CPP)
+ return false;
- rest_of_decl_compilation (decl, toplev, 0);
+ /* This is the main case: C++ method imported as a primitive operation. */
+ if (Is_Dispatching_Operation (gnat_entity))
+ return true;
- /* Now process all the variants. This is needed for STABS. */
- for (t = TYPE_MAIN_VARIANT (t); t; t = TYPE_NEXT_VARIANT (t))
- {
- if (t == TREE_TYPE (decl))
- continue;
+ /* A thunk needs to be handled like its associated primitive operation. */
+ if (Is_Subprogram (gnat_entity) && Is_Thunk (gnat_entity))
+ return true;
- if (!TYPE_STUB_DECL (t))
- TYPE_STUB_DECL (t) = create_type_stub_decl (DECL_NAME (decl), t);
+ /* C++ classes with no virtual functions can be imported as limited
+ record types, but we need to return true for the constructors. */
+ if (Is_Constructor (gnat_entity))
+ return true;
- rest_of_type_compilation (t, toplev);
- }
+ /* 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.
/* VMS descriptors are themselves passed by reference. */
if (mech == By_Short_Descriptor ||
- (mech == By_Descriptor && TARGET_ABI_OPEN_VMS && !TARGET_MALLOC64))
+ (mech == By_Descriptor && TARGET_ABI_OPEN_VMS && !flag_vms_malloc64))
gnu_param_type
= build_pointer_type (build_vms_descriptor32 (gnu_param_type,
Mechanism (gnat_param),
parameters whose type isn't by-ref and for which the mechanism hasn't
been forced to by-ref are restrict-qualified in the C sense. */
bool restrict_p
- = !TREE_ADDRESSABLE (gnu_param_type) && mech != By_Reference;
+ = !TYPE_IS_BY_REFERENCE_P (gnu_param_type) && mech != By_Reference;
gnu_param_type = build_reference_type (gnu_param_type);
if (restrict_p)
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
-/* Mark GNAT_ENTITY as going out of scope at this point. Recursively mark
- any entities on its entity chain similarly. */
-
-void
-mark_out_of_scope (Entity_Id gnat_entity)
-{
- Entity_Id gnat_sub_entity;
- unsigned int kind = Ekind (gnat_entity);
-
- /* If this has an entity list, process all in the list. */
- if (IN (kind, Class_Wide_Kind) || IN (kind, Concurrent_Kind)
- || IN (kind, Private_Kind)
- || kind == E_Block || kind == E_Entry || kind == E_Entry_Family
- || kind == E_Function || kind == E_Generic_Function
- || kind == E_Generic_Package || kind == E_Generic_Procedure
- || kind == E_Loop || kind == E_Operator || kind == E_Package
- || kind == E_Package_Body || kind == E_Procedure
- || kind == E_Record_Type || kind == E_Record_Subtype
- || kind == E_Subprogram_Body || kind == E_Subprogram_Type)
- for (gnat_sub_entity = First_Entity (gnat_entity);
- Present (gnat_sub_entity);
- gnat_sub_entity = Next_Entity (gnat_sub_entity))
- if (Scope (gnat_sub_entity) == gnat_entity
- && gnat_sub_entity != gnat_entity)
- mark_out_of_scope (gnat_sub_entity);
-
- /* Now clear this if it has been defined, but only do so if it isn't
- a subprogram or parameter. We could refine this, but it isn't
- worth it. If this is statically allocated, it is supposed to
- hang around out of cope. */
- if (present_gnu_tree (gnat_entity) && !Is_Statically_Allocated (gnat_entity)
- && kind != E_Procedure && kind != E_Function && !IN (kind, Formal_Kind))
- {
- save_gnu_tree (gnat_entity, NULL_TREE, true);
- save_gnu_tree (gnat_entity, error_mark_node, true);
- }
-}
-\f
-/* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP.
- If this is a multi-dimensional array type, do this recursively.
-
- OP may be
- - ALIAS_SET_COPY: the new set is made a copy of the old one.
- - ALIAS_SET_SUPERSET: the new set is made a superset of the old one.
- - ALIAS_SET_SUBSET: the new set is made a subset of the old one. */
-
-static void
-relate_alias_sets (tree gnu_new_type, tree gnu_old_type, enum alias_set_op op)
-{
- /* Remove any padding from GNU_OLD_TYPE. It doesn't matter in the case
- of a one-dimensional array, since the padding has the same alias set
- as the field type, but if it's a multi-dimensional array, we need to
- see the inner types. */
- while (TREE_CODE (gnu_old_type) == RECORD_TYPE
- && (TYPE_JUSTIFIED_MODULAR_P (gnu_old_type)
- || TYPE_PADDING_P (gnu_old_type)))
- gnu_old_type = TREE_TYPE (TYPE_FIELDS (gnu_old_type));
-
- /* Unconstrained array types are deemed incomplete and would thus be given
- alias set 0. Retrieve the underlying array type. */
- if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE)
- gnu_old_type
- = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type))));
- if (TREE_CODE (gnu_new_type) == UNCONSTRAINED_ARRAY_TYPE)
- gnu_new_type
- = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_new_type))));
-
- if (TREE_CODE (gnu_new_type) == ARRAY_TYPE
- && TREE_CODE (TREE_TYPE (gnu_new_type)) == ARRAY_TYPE
- && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_new_type)))
- relate_alias_sets (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type), op);
-
- switch (op)
- {
- case ALIAS_SET_COPY:
- /* The alias set shouldn't be copied between array types with different
- aliasing settings because this can break the aliasing relationship
- between the array type and its element type. */
-#ifndef ENABLE_CHECKING
- if (flag_strict_aliasing)
-#endif
- gcc_assert (!(TREE_CODE (gnu_new_type) == ARRAY_TYPE
- && TREE_CODE (gnu_old_type) == ARRAY_TYPE
- && TYPE_NONALIASED_COMPONENT (gnu_new_type)
- != TYPE_NONALIASED_COMPONENT (gnu_old_type)));
-
- TYPE_ALIAS_SET (gnu_new_type) = get_alias_set (gnu_old_type);
- break;
-
- case ALIAS_SET_SUBSET:
- case ALIAS_SET_SUPERSET:
- {
- alias_set_type old_set = get_alias_set (gnu_old_type);
- alias_set_type new_set = get_alias_set (gnu_new_type);
-
- /* Do nothing if the alias sets conflict. This ensures that we
- never call record_alias_subset several times for the same pair
- or at all for alias set 0. */
- if (!alias_sets_conflict_p (old_set, new_set))
- {
- if (op == ALIAS_SET_SUBSET)
- record_alias_subset (old_set, new_set);
- else
- record_alias_subset (new_set, old_set);
- }
- }
- break;
-
- default:
- gcc_unreachable ();
- }
-
- record_component_aliases (gnu_new_type);
-}
-\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));
unit_align);
}
\f
-/* Create a record type that contains a SIZE bytes long field of TYPE with a
- starting bit position so that it is aligned to ALIGN bits, and leaving at
- least ROOM bytes free before the field. BASE_ALIGN is the alignment the
- record is guaranteed to get. */
-
-tree
-make_aligning_type (tree type, unsigned int align, tree size,
- unsigned int base_align, int room)
-{
- /* We will be crafting a record type with one field at a position set to be
- the next multiple of ALIGN past record'address + room bytes. We use a
- record placeholder to express record'address. */
- tree record_type = make_node (RECORD_TYPE);
- tree record = build0 (PLACEHOLDER_EXPR, record_type);
-
- tree record_addr_st
- = convert (sizetype, build_unary_op (ADDR_EXPR, NULL_TREE, record));
-
- /* The diagram below summarizes the shape of what we manipulate:
-
- <--------- pos ---------->
- { +------------+-------------+-----------------+
- record =>{ |############| ... | field (type) |
- { +------------+-------------+-----------------+
- |<-- room -->|<- voffset ->|<---- size ----->|
- o o
- | |
- record_addr vblock_addr
-
- Every length is in sizetype bytes there, except "pos" which has to be
- set as a bit position in the GCC tree for the record. */
- tree room_st = size_int (room);
- tree vblock_addr_st = size_binop (PLUS_EXPR, record_addr_st, room_st);
- tree voffset_st, pos, field;
-
- tree name = TYPE_NAME (type);
-
- if (TREE_CODE (name) == TYPE_DECL)
- name = DECL_NAME (name);
- name = concat_name (name, "ALIGN");
- TYPE_NAME (record_type) = name;
-
- /* Compute VOFFSET and then POS. The next byte position multiple of some
- alignment after some address is obtained by "and"ing the alignment minus
- 1 with the two's complement of the address. */
- voffset_st = size_binop (BIT_AND_EXPR,
- fold_build1 (NEGATE_EXPR, sizetype, vblock_addr_st),
- size_int ((align / BITS_PER_UNIT) - 1));
-
- /* POS = (ROOM + VOFFSET) * BIT_PER_UNIT, in bitsizetype. */
- pos = size_binop (MULT_EXPR,
- convert (bitsizetype,
- size_binop (PLUS_EXPR, room_st, voffset_st)),
- bitsize_unit_node);
-
- /* Craft the GCC record representation. We exceptionally do everything
- manually here because 1) our generic circuitry is not quite ready to
- handle the complex position/size expressions we are setting up, 2) we
- have a strong simplifying factor at hand: we know the maximum possible
- value of voffset, and 3) we have to set/reset at least the sizes in
- accordance with this maximum value anyway, as we need them to convey
- what should be "alloc"ated for this type.
-
- Use -1 as the 'addressable' indication for the field to prevent the
- creation of a bitfield. We don't need one, it would have damaging
- consequences on the alignment computation, and create_field_decl would
- make one without this special argument, for instance because of the
- complex position expression. */
- field = create_field_decl (get_identifier ("F"), type, record_type, size,
- pos, 1, -1);
- TYPE_FIELDS (record_type) = field;
-
- TYPE_ALIGN (record_type) = base_align;
- TYPE_USER_ALIGN (record_type) = 1;
-
- TYPE_SIZE (record_type)
- = size_binop (PLUS_EXPR,
- size_binop (MULT_EXPR, convert (bitsizetype, size),
- bitsize_unit_node),
- bitsize_int (align + room * BITS_PER_UNIT));
- TYPE_SIZE_UNIT (record_type)
- = size_binop (PLUS_EXPR, size,
- size_int (room + align / BITS_PER_UNIT));
-
- SET_TYPE_MODE (record_type, BLKmode);
- relate_alias_sets (record_type, type, ALIAS_SET_COPY);
-
- /* Declare it now since it will never be declared otherwise. This is
- necessary to ensure that its subtrees are properly marked. */
- create_type_decl (name, record_type, NULL, true, false, Empty);
-
- return record_type;
-}
-\f
-/* Return the result of rounding T up to ALIGN. */
-
-static inline unsigned HOST_WIDE_INT
-round_up_to_align (unsigned HOST_WIDE_INT t, unsigned int align)
-{
- t += align - 1;
- t /= align;
- t *= align;
- return t;
-}
-
-/* TYPE is a RECORD_TYPE, UNION_TYPE or QUAL_UNION_TYPE that is being used
- as the field type of a packed record if IN_RECORD is true, or as the
- component type of a packed array if IN_RECORD is false. See if we can
- rewrite it either as a type that has a non-BLKmode, which we can pack
- tighter in the packed record case, or as a smaller type. If so, return
- the new type. If not, return the original type. */
-
-static tree
-make_packable_type (tree type, bool in_record)
-{
- unsigned HOST_WIDE_INT size = tree_low_cst (TYPE_SIZE (type), 1);
- unsigned HOST_WIDE_INT new_size;
- tree new_type, old_field, field_list = NULL_TREE;
-
- /* No point in doing anything if the size is zero. */
- if (size == 0)
- return type;
-
- new_type = make_node (TREE_CODE (type));
-
- /* Copy the name and flags from the old type to that of the new.
- Note that we rely on the pointer equality created here for
- TYPE_NAME to look through conversions in various places. */
- TYPE_NAME (new_type) = TYPE_NAME (type);
- TYPE_JUSTIFIED_MODULAR_P (new_type) = TYPE_JUSTIFIED_MODULAR_P (type);
- TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type);
- if (TREE_CODE (type) == RECORD_TYPE)
- TYPE_PADDING_P (new_type) = TYPE_PADDING_P (type);
-
- /* If we are in a record and have a small size, set the alignment to
- try for an integral mode. Otherwise set it to try for a smaller
- type with BLKmode. */
- if (in_record && size <= MAX_FIXED_MODE_SIZE)
- {
- TYPE_ALIGN (new_type) = ceil_alignment (size);
- new_size = round_up_to_align (size, TYPE_ALIGN (new_type));
- }
- else
- {
- unsigned HOST_WIDE_INT align;
-
- /* Do not try to shrink the size if the RM size is not constant. */
- if (TYPE_CONTAINS_TEMPLATE_P (type)
- || !host_integerp (TYPE_ADA_SIZE (type), 1))
- return type;
-
- /* Round the RM size up to a unit boundary to get the minimal size
- for a BLKmode record. Give up if it's already the size. */
- new_size = TREE_INT_CST_LOW (TYPE_ADA_SIZE (type));
- new_size = round_up_to_align (new_size, BITS_PER_UNIT);
- if (new_size == size)
- return type;
-
- align = new_size & -new_size;
- TYPE_ALIGN (new_type) = MIN (TYPE_ALIGN (type), align);
- }
-
- TYPE_USER_ALIGN (new_type) = 1;
-
- /* Now copy the fields, keeping the position and size as we don't want
- to change the layout by propagating the packedness downwards. */
- for (old_field = TYPE_FIELDS (type); old_field;
- old_field = DECL_CHAIN (old_field))
- {
- tree new_field_type = TREE_TYPE (old_field);
- tree new_field, new_size;
-
- if (RECORD_OR_UNION_TYPE_P (new_field_type)
- && !TYPE_FAT_POINTER_P (new_field_type)
- && host_integerp (TYPE_SIZE (new_field_type), 1))
- new_field_type = make_packable_type (new_field_type, true);
-
- /* However, for the last field in a not already packed record type
- that is of an aggregate type, we need to use the RM size in the
- packable version of the record type, see finish_record_type. */
- if (!DECL_CHAIN (old_field)
- && !TYPE_PACKED (type)
- && RECORD_OR_UNION_TYPE_P (new_field_type)
- && !TYPE_FAT_POINTER_P (new_field_type)
- && !TYPE_CONTAINS_TEMPLATE_P (new_field_type)
- && TYPE_ADA_SIZE (new_field_type))
- new_size = TYPE_ADA_SIZE (new_field_type);
- else
- new_size = DECL_SIZE (old_field);
-
- new_field
- = create_field_decl (DECL_NAME (old_field), new_field_type, new_type,
- new_size, bit_position (old_field),
- TYPE_PACKED (type),
- !DECL_NONADDRESSABLE_P (old_field));
-
- DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field);
- SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field);
- if (TREE_CODE (new_type) == QUAL_UNION_TYPE)
- DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field);
-
- DECL_CHAIN (new_field) = field_list;
- field_list = new_field;
- }
-
- finish_record_type (new_type, nreverse (field_list), 2, false);
- relate_alias_sets (new_type, type, ALIAS_SET_COPY);
- SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
- DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
-
- /* If this is a padding record, we never want to make the size smaller
- than what was specified. For QUAL_UNION_TYPE, also copy the size. */
- if (TYPE_IS_PADDING_P (type) || TREE_CODE (type) == QUAL_UNION_TYPE)
- {
- TYPE_SIZE (new_type) = TYPE_SIZE (type);
- TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type);
- new_size = size;
- }
- else
- {
- TYPE_SIZE (new_type) = bitsize_int (new_size);
- TYPE_SIZE_UNIT (new_type)
- = size_int ((new_size + BITS_PER_UNIT - 1) / BITS_PER_UNIT);
- }
-
- if (!TYPE_CONTAINS_TEMPLATE_P (type))
- SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (type));
-
- compute_record_mode (new_type);
-
- /* Try harder to get a packable type if necessary, for example
- in case the record itself contains a BLKmode field. */
- if (in_record && TYPE_MODE (new_type) == BLKmode)
- SET_TYPE_MODE (new_type,
- mode_for_size_tree (TYPE_SIZE (new_type), MODE_INT, 1));
-
- /* If neither the mode nor the size has shrunk, return the old type. */
- if (TYPE_MODE (new_type) == BLKmode && new_size >= size)
- return type;
-
- return new_type;
-}
-\f
-/* Ensure that TYPE has SIZE and ALIGN. Make and return a new padded type
- if needed. We have already verified that SIZE and TYPE are large enough.
- GNAT_ENTITY is used to name the resulting record and to issue a warning.
- IS_COMPONENT_TYPE is true if this is being done for the component type
- of an array. IS_USER_TYPE is true if we must complete the original type.
- DEFINITION is true if this type is being defined. SAME_RM_SIZE is true
- if the RM size of the resulting type is to be set to SIZE too; otherwise,
- it's set to the RM size of the original type. */
-
-tree
-maybe_pad_type (tree type, tree size, unsigned int align,
- Entity_Id gnat_entity, bool is_component_type,
- bool is_user_type, bool definition, bool same_rm_size)
-{
- tree orig_rm_size = same_rm_size ? NULL_TREE : rm_size (type);
- tree orig_size = TYPE_SIZE (type);
- tree record, field;
-
- /* If TYPE is a padded type, see if it agrees with any size and alignment
- we were given. If so, return the original type. Otherwise, strip
- off the padding, since we will either be returning the inner type
- or repadding it. If no size or alignment is specified, use that of
- the original padded type. */
- if (TYPE_IS_PADDING_P (type))
- {
- if ((!size
- || operand_equal_p (round_up (size,
- MAX (align, TYPE_ALIGN (type))),
- round_up (TYPE_SIZE (type),
- MAX (align, TYPE_ALIGN (type))),
- 0))
- && (align == 0 || align == TYPE_ALIGN (type)))
- return type;
-
- if (!size)
- size = TYPE_SIZE (type);
- if (align == 0)
- align = TYPE_ALIGN (type);
-
- type = TREE_TYPE (TYPE_FIELDS (type));
- orig_size = TYPE_SIZE (type);
- }
-
- /* If the size is either not being changed or is being made smaller (which
- is not done here and is only valid for bitfields anyway), show the size
- isn't changing. Likewise, clear the alignment if it isn't being
- changed. Then return if we aren't doing anything. */
- if (size
- && (operand_equal_p (size, orig_size, 0)
- || (TREE_CODE (orig_size) == INTEGER_CST
- && tree_int_cst_lt (size, orig_size))))
- size = NULL_TREE;
-
- if (align == TYPE_ALIGN (type))
- align = 0;
-
- if (align == 0 && !size)
- return type;
-
- /* If requested, complete the original type and give it a name. */
- if (is_user_type)
- create_type_decl (get_entity_name (gnat_entity), type,
- NULL, !Comes_From_Source (gnat_entity),
- !(TYPE_NAME (type)
- && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
- && DECL_IGNORED_P (TYPE_NAME (type))),
- gnat_entity);
-
- /* We used to modify the record in place in some cases, but that could
- generate incorrect debugging information. So make a new record
- type and name. */
- record = make_node (RECORD_TYPE);
- TYPE_PADDING_P (record) = 1;
-
- if (Present (gnat_entity))
- TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
-
- TYPE_VOLATILE (record)
- = Present (gnat_entity) && Treat_As_Volatile (gnat_entity);
-
- TYPE_ALIGN (record) = align;
- TYPE_SIZE (record) = size ? size : orig_size;
- TYPE_SIZE_UNIT (record)
- = convert (sizetype,
- size_binop (CEIL_DIV_EXPR, TYPE_SIZE (record),
- bitsize_unit_node));
-
- /* If we are changing the alignment and the input type is a record with
- BLKmode and a small constant size, try to make a form that has an
- integral mode. This might allow the padding record to also have an
- integral mode, which will be much more efficient. There is no point
- in doing so if a size is specified unless it is also a small constant
- size and it is incorrect to do so if we cannot guarantee that the mode
- will be naturally aligned since the field must always be addressable.
-
- ??? This might not always be a win when done for a stand-alone object:
- since the nominal and the effective type of the object will now have
- different modes, a VIEW_CONVERT_EXPR will be required for converting
- between them and it might be hard to overcome afterwards, including
- at the RTL level when the stand-alone object is accessed as a whole. */
- if (align != 0
- && RECORD_OR_UNION_TYPE_P (type)
- && TYPE_MODE (type) == BLKmode
- && !TREE_ADDRESSABLE (type)
- && TREE_CODE (orig_size) == INTEGER_CST
- && !TREE_OVERFLOW (orig_size)
- && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0
- && (!size
- || (TREE_CODE (size) == INTEGER_CST
- && compare_tree_int (size, MAX_FIXED_MODE_SIZE) <= 0)))
- {
- tree packable_type = make_packable_type (type, true);
- if (TYPE_MODE (packable_type) != BLKmode
- && align >= TYPE_ALIGN (packable_type))
- type = packable_type;
- }
-
- /* Now create the field with the original size. */
- field = create_field_decl (get_identifier ("F"), type, record, orig_size,
- bitsize_zero_node, 0, 1);
- DECL_INTERNAL_P (field) = 1;
-
- /* Do not emit debug info until after the auxiliary record is built. */
- finish_record_type (record, field, 1, false);
-
- /* Set the same size for its RM size if requested; otherwise reuse
- the RM size of the original type. */
- SET_TYPE_ADA_SIZE (record, same_rm_size ? size : orig_rm_size);
-
- /* Unless debugging information isn't being written for the input type,
- write a record that shows what we are a subtype of and also make a
- variable that indicates our size, if still variable. */
- if (TREE_CODE (orig_size) != INTEGER_CST
- && TYPE_NAME (record)
- && TYPE_NAME (type)
- && !(TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
- && DECL_IGNORED_P (TYPE_NAME (type))))
- {
- tree marker = make_node (RECORD_TYPE);
- tree name = TYPE_NAME (record);
- tree orig_name = TYPE_NAME (type);
-
- if (TREE_CODE (name) == TYPE_DECL)
- name = DECL_NAME (name);
-
- if (TREE_CODE (orig_name) == TYPE_DECL)
- orig_name = DECL_NAME (orig_name);
-
- TYPE_NAME (marker) = concat_name (name, "XVS");
- finish_record_type (marker,
- create_field_decl (orig_name,
- build_reference_type (type),
- marker, NULL_TREE, NULL_TREE,
- 0, 0),
- 0, true);
-
- add_parallel_type (TYPE_STUB_DECL (record), marker);
-
- if (definition && size && TREE_CODE (size) != INTEGER_CST)
- TYPE_SIZE_UNIT (marker)
- = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
- TYPE_SIZE_UNIT (record), false, false, false,
- false, NULL, gnat_entity);
- }
-
- rest_of_record_type_compilation (record);
-
- /* If the size was widened explicitly, maybe give a warning. Take the
- original size as the maximum size of the input if there was an
- unconstrained record involved and round it up to the specified alignment,
- if one was specified. */
- if (CONTAINS_PLACEHOLDER_P (orig_size))
- orig_size = max_size (orig_size, true);
-
- if (align)
- orig_size = round_up (orig_size, align);
-
- if (Present (gnat_entity)
- && size
- && TREE_CODE (size) != MAX_EXPR
- && TREE_CODE (size) != COND_EXPR
- && !operand_equal_p (size, orig_size, 0)
- && !(TREE_CODE (size) == INTEGER_CST
- && TREE_CODE (orig_size) == INTEGER_CST
- && (TREE_OVERFLOW (size)
- || TREE_OVERFLOW (orig_size)
- || tree_int_cst_lt (size, orig_size))))
- {
- Node_Id gnat_error_node = Empty;
-
- if (Is_Packed_Array_Type (gnat_entity))
- gnat_entity = Original_Array_Type (gnat_entity);
-
- if ((Ekind (gnat_entity) == E_Component
- || Ekind (gnat_entity) == E_Discriminant)
- && Present (Component_Clause (gnat_entity)))
- gnat_error_node = Last_Bit (Component_Clause (gnat_entity));
- else if (Present (Size_Clause (gnat_entity)))
- gnat_error_node = Expression (Size_Clause (gnat_entity));
-
- /* Generate message only for entities that come from source, since
- if we have an entity created by expansion, the message will be
- generated for some other corresponding source entity. */
- if (Comes_From_Source (gnat_entity))
- {
- if (Present (gnat_error_node))
- post_error_ne_tree ("{^ }bits of & unused?",
- gnat_error_node, gnat_entity,
- size_diffop (size, orig_size));
- else if (is_component_type)
- post_error_ne_tree ("component of& padded{ by ^ bits}?",
- gnat_entity, gnat_entity,
- size_diffop (size, orig_size));
- }
- }
-
- return record;
-}
-\f
/* Given a GNU tree and a GNAT list of choices, generate an expression to test
the value passed against the list of choices. */
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, ensure the record is
- sufficiently aligned and that that position and size are
- consistent with the alignment. */
- if (needs_strict_alignment)
+ /* 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. 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)))
{
TYPE_ALIGN (gnu_record_type)
= MAX (TYPE_ALIGN (gnu_record_type), TYPE_ALIGN (gnu_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
UNCHECKED_UNION is true if we are building this type for a record with a
Pragma Unchecked_Union.
+ ARTIFICIAL is true if this is a type that was generated by the compiler.
+
DEBUG_INFO is true if we need to write debug information about the type.
MAYBE_UNUSED is true if this type may be unused in the end; this doesn't
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,
- bool unchecked_union, bool debug_info,
- bool maybe_unused, bool reorder,
+ bool unchecked_union, bool artificial,
+ bool debug_info, bool maybe_unused, bool reorder,
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,
- 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, debug_info && !maybe_unused);
+ TYPE_ARTIFICIAL (gnu_record_type) = artificial;
+
+ 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
{
tree parent_offset;
- if (type_annotate_only && Is_Tagged_Type (gnat_entity))
+ /* If we are just annotating types and the type is tagged, the tag
+ and the parent components are not generated by the front-end so
+ we need to add the appropriate offset to each component without
+ representation clause. */
+ if (type_annotate_only
+ && Is_Tagged_Type (gnat_entity)
+ && No (Component_Clause (gnat_field)))
{
- /* In this mode the tag and parent components are not
- generated, so we add the appropriate offset to each
- component. For a component appearing in the current
- extension, the offset is the size of the parent. */
+ /* For a component appearing in the current extension, the
+ offset is the size of the parent. */
if (Is_Derived_Type (gnat_entity)
&& Original_Record_Component (gnat_field) == gnat_field)
parent_offset
bitsizetype);
else
parent_offset = bitsize_int (POINTER_SIZE);
+
+ if (TYPE_FIELDS (gnu_type))
+ parent_offset
+ = round_up (parent_offset,
+ DECL_ALIGN (TYPE_FIELDS (gnu_type)));
}
else
parent_offset = bitsize_zero_node;
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->record = 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
SET_TYPE_ADA_SIZE (gnu_type, size);
}
\f
-/* Given a type TYPE, return a new type whose size is appropriate for SIZE.
- If TYPE is the best type, return it. Otherwise, make a new type. We
- only support new integral and pointer types. FOR_BIASED is true if
- we are making a biased type. */
-
-static tree
-make_type_from_size (tree type, tree size_tree, bool for_biased)
-{
- unsigned HOST_WIDE_INT size;
- bool biased_p;
- tree new_type;
-
- /* If size indicates an error, just return TYPE to avoid propagating
- the error. Likewise if it's too large to represent. */
- if (!size_tree || !host_integerp (size_tree, 1))
- return type;
-
- size = tree_low_cst (size_tree, 1);
-
- switch (TREE_CODE (type))
- {
- case INTEGER_TYPE:
- case ENUMERAL_TYPE:
- case BOOLEAN_TYPE:
- biased_p = (TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type));
-
- /* Integer types with precision 0 are forbidden. */
- if (size == 0)
- size = 1;
-
- /* Only do something if the type is not a packed array type and
- doesn't already have the proper size. */
- if (TYPE_PACKED_ARRAY_TYPE_P (type)
- || (TYPE_PRECISION (type) == size && biased_p == for_biased))
- break;
-
- biased_p |= for_biased;
- if (size > LONG_LONG_TYPE_SIZE)
- size = LONG_LONG_TYPE_SIZE;
-
- if (TYPE_UNSIGNED (type) || biased_p)
- new_type = make_unsigned_type (size);
- else
- new_type = make_signed_type (size);
- TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type;
- SET_TYPE_RM_MIN_VALUE (new_type,
- convert (TREE_TYPE (new_type),
- TYPE_MIN_VALUE (type)));
- SET_TYPE_RM_MAX_VALUE (new_type,
- convert (TREE_TYPE (new_type),
- TYPE_MAX_VALUE (type)));
- /* Copy the name to show that it's essentially the same type and
- not a subrange type. */
- TYPE_NAME (new_type) = TYPE_NAME (type);
- TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
- SET_TYPE_RM_SIZE (new_type, bitsize_int (size));
- return new_type;
-
- case RECORD_TYPE:
- /* Do something if this is a fat pointer, in which case we
- may need to return the thin pointer. */
- if (TYPE_FAT_POINTER_P (type) && size < POINTER_SIZE * 2)
- {
- enum machine_mode p_mode = mode_for_size (size, MODE_INT, 0);
- if (!targetm.valid_pointer_mode (p_mode))
- p_mode = ptr_mode;
- return
- build_pointer_type_for_mode
- (TYPE_OBJECT_RECORD_TYPE (TYPE_UNCONSTRAINED_ARRAY (type)),
- p_mode, 0);
- }
- break;
-
- case POINTER_TYPE:
- /* Only do something if this is a thin pointer, in which case we
- may need to return the fat pointer. */
- if (TYPE_IS_THIN_POINTER_P (type) && size >= POINTER_SIZE * 2)
- return
- build_pointer_type (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)));
- break;
-
- default:
- break;
- }
-
- return type;
-}
-\f
/* ALIGNMENT is a Uint giving the alignment specified for GNAT_ENTITY,
a type or object whose present alignment is ALIGN. If this alignment is
valid, return it. Otherwise, give an error and return ALIGN. */
return align;
}
-
-/* Return the smallest alignment not less than SIZE. */
-
-static unsigned int
-ceil_alignment (unsigned HOST_WIDE_INT size)
-{
- return (unsigned int) 1 << (floor_log2 (size - 1) + 1);
-}
\f
/* Verify that OBJECT, a type or decl, is something we can implement
atomically. If not, give an error for GNAT_ENTITY. COMP_P is true
&& !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);
- TYPE_NAME (new_union_type) = DECL_NAME (TYPE_NAME (old_union_type));
+ TYPE_NAME (new_union_type)
+ = concat_name (TYPE_NAME (record_type),
+ IDENTIFIER_POINTER (DECL_NAME (old_variant_part)));
/* If the position of the variant part is constant, subtract it from the
size of the type of the parent to get the new size. This manual CSE
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;
continue;
/* Retrieve the list of fields already added to the new variant. */
- new_variant = v->record;
+ new_variant = v->new_type;
field_list = TYPE_FIELDS (new_variant);
/* If the old variant had a variant subpart, we need to create a new
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