X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=gcc%2Fada%2Fgcc-interface%2Fdecl.c;h=643012f0ac75f212944f5f67e5c20ebd2ebfb082;hp=7a18d32752ae71828a2356a71a144f3d23cacb16;hb=3525e494177a4b6ac7f70f897da01b875a3ce5a5;hpb=d4fc4962ee46d1a7566838ec87e7fc84999fbaae diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 7a18d32752a..643012f0ac7 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2011, Free Software Foundation, Inc. * + * Copyright (C) 1992-2012, 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- * @@ -50,19 +50,23 @@ #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 @@ -120,8 +124,8 @@ typedef struct variant_desc_d { /* 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); @@ -145,7 +149,7 @@ static void prepend_one_attribute_to (struct attrib **, enum attr_type, tree, tree, Node_Id); static void prepend_attributes (Entity_Id, struct attrib **); static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool); -static bool is_variable_size (tree); +static bool type_has_variable_size (tree); static tree elaborate_expression_1 (tree, Entity_Id, tree, bool, bool); static tree elaborate_expression_2 (tree, Entity_Id, tree, bool, bool, unsigned int); @@ -160,7 +164,7 @@ 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 *); + 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); @@ -176,8 +180,8 @@ 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) *); +static tree create_rep_part (tree, tree, tree); static tree get_rep_part (tree); -static tree get_variant_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) *); @@ -407,8 +411,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (esize > max_esize) esize = max_esize; } - else - esize = LONG_LONG_TYPE_SIZE; } switch (kind) @@ -780,6 +782,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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 @@ -820,16 +830,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && No (Address_Clause (gnat_entity)))) && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST) { - /* No point in jumping through all the hoops needed in order + unsigned int size_cap, align_cap; + + /* No point in promoting the alignment if this doesn't prevent + BLKmode access to the object, in particular block copy, as + this will for example disable the NRV optimization for it. + No point in jumping through all the hoops needed in order to support BIGGEST_ALIGNMENT if we don't really have to. So we cap to the smallest alignment that corresponds to a known efficient memory access pattern of the target. */ - unsigned int align_cap = Is_Atomic (gnat_entity) - ? BIGGEST_ALIGNMENT - : get_mode_alignment (ptr_mode); + if (Is_Atomic (gnat_entity)) + { + size_cap = UINT_MAX; + align_cap = BIGGEST_ALIGNMENT; + } + else + { + size_cap = MAX_FIXED_MODE_SIZE; + align_cap = get_mode_alignment (ptr_mode); + } if (!host_integerp (TYPE_SIZE (gnu_type), 1) - || compare_tree_int (TYPE_SIZE (gnu_type), align_cap) >= 0) + || 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)); @@ -877,10 +901,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && Is_Array_Type (Etype (gnat_entity)) && !type_annotate_only) { - tree gnu_fat - = TREE_TYPE (gnat_to_gnu_type (Base_Type (Etype (gnat_entity)))); + tree gnu_array + = gnat_to_gnu_type (Base_Type (Etype (gnat_entity))); gnu_type - = build_unc_object_type_from_ptr (gnu_fat, gnu_type, + = build_unc_object_type_from_ptr (TREE_TYPE (gnu_array), + gnu_type, concat_name (gnu_entity_name, "UNC"), debug_info_p); @@ -938,10 +963,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if ((TREE_CODE (gnu_expr) == COMPONENT_REF && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))) /* Strip useless conversions around the object. */ - || (TREE_CODE (gnu_expr) == NOP_EXPR - && gnat_types_compatible_p - (TREE_TYPE (gnu_expr), - TREE_TYPE (TREE_OPERAND (gnu_expr, 0))))) + || gnat_useless_type_conversion (gnu_expr)) { gnu_expr = TREE_OPERAND (gnu_expr, 0); gnu_type = TREE_TYPE (gnu_expr); @@ -999,6 +1021,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) saved = true; annotate_object (gnat_entity, gnu_type, NULL_TREE, 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. */ + if (align) + { + unsigned int renamed_align + = DECL_P (gnu_decl) + ? DECL_ALIGN (gnu_decl) + : TYPE_ALIGN (TREE_TYPE (gnu_decl)); + gcc_assert (renamed_align >= align); + } break; } @@ -1031,6 +1064,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) entity is always accessed indirectly through it. */ else { + /* We need to preserve the volatileness of the renamed + object through the indirection. */ + if (TREE_THIS_VOLATILE (gnu_expr) + && !TYPE_VOLATILE (gnu_type)) + gnu_type + = build_qualified_type (gnu_type, + (TYPE_QUALS (gnu_type) + | TYPE_QUAL_VOLATILE)); gnu_type = build_reference_type (gnu_type); inner_const_flag = TREE_READONLY (gnu_expr); const_flag = true; @@ -1127,13 +1168,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) is a padded record whose field is of self-referential size. In the former case, converting will generate unnecessary evaluations of the CONSTRUCTOR to compute the size and in the latter case, we - want to only copy the actual data. */ + want to only copy the actual data. Also don't convert to a record + type with a variant part from a record type without one, to keep + the object simpler. */ if (gnu_expr && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) && !(TYPE_IS_PADDING_P (gnu_type) && CONTAINS_PLACEHOLDER_P - (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))) + (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))) + && !(TREE_CODE (gnu_type) == RECORD_TYPE + && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE + && get_variant_part (gnu_type) != NULL_TREE + && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE)) gnu_expr = convert (gnu_type, gnu_expr); /* If this is a pointer that doesn't have an initializing expression, @@ -1344,6 +1391,49 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) const_flag = true; } + /* If this is an aliased object with an unconstrained nominal subtype, + we make its type a thin reference, i.e. the reference counterpart + of a thin pointer, so that it points to the array part. This is + aimed at making it easier for the debugger to decode the object. + Note that we have to do that this late because of the couple of + allocation adjustments that might be made just above. */ + if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) + && Is_Array_Type (Etype (gnat_entity)) + && !type_annotate_only) + { + tree gnu_array + = gnat_to_gnu_type (Base_Type (Etype (gnat_entity))); + + /* In case the object with the template has already been allocated + just above, we have nothing to do here. */ + if (!TYPE_IS_THIN_POINTER_P (gnu_type)) + { + gnu_size = NULL_TREE; + used_by_ref = true; + + 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_type + = build_reference_type (TYPE_OBJECT_RECORD_TYPE (gnu_array)); + } + if (const_flag) gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type) | TYPE_QUAL_CONST)); @@ -1353,13 +1443,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) is a padded record whose field is of self-referential size. In the former case, converting will generate unnecessary evaluations of the CONSTRUCTOR to compute the size and in the latter case, we - want to only copy the actual data. */ + want to only copy the actual data. Also don't convert to a record + type with a variant part from a record type without one, to keep + the object simpler. */ if (gnu_expr && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE && !CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) && !(TYPE_IS_PADDING_P (gnu_type) && CONTAINS_PLACEHOLDER_P - (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))) + (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))) + && !(TREE_CODE (gnu_type) == RECORD_TYPE + && TREE_CODE (TREE_TYPE (gnu_expr)) == RECORD_TYPE + && get_variant_part (gnu_type) != NULL_TREE + && get_variant_part (TREE_TYPE (gnu_expr)) == NULL_TREE)) gnu_expr = convert (gnu_type, gnu_expr); /* If this name is external or there was a name specified, use it, @@ -1394,6 +1490,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnat_entity); DECL_BY_REF_P (gnu_decl) = used_by_ref; DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag; + DECL_CAN_NEVER_BE_NULL_P (gnu_decl) = Can_Never_Be_Null (gnat_entity); /* 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 @@ -1410,10 +1507,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TREE_ADDRESSABLE (gnu_decl) = 1; } + /* If this is a loop parameter, set the corresponding flag. */ + else if (kind == E_Loop_Parameter) + DECL_LOOP_PARM_P (gnu_decl) = 1; + /* 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. */ - if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj) + else 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 ()) @@ -1483,8 +1584,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || (flag_stack_check == GENERIC_STACK_CHECK && compare_tree_int (DECL_SIZE_UNIT (gnu_decl), STACK_CHECK_MAX_VAR_SIZE) > 0))) - add_stmt_with_node (build_call_1_expr - (update_setjmp_buf_decl, + add_stmt_with_node (build_call_n_expr + (update_setjmp_buf_decl, 1, build_unary_op (ADDR_EXPR, NULL_TREE, get_block_jmpbuf_decl ())), gnat_entity); @@ -1914,14 +2015,26 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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); tree gnu_max_size = size_one_node, gnu_max_size_unit, tem, t; Entity_Id gnat_index, gnat_name; int index; + tree comp_type; + + /* Create the type for the component now, as it simplifies breaking + type reference loops. */ + comp_type + = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p); + if (present_gnu_tree (gnat_entity)) + { + /* As a side effect, the type may have been translated. */ + maybe_present = true; + break; + } /* We complete an existing dummy fat pointer type in place. This both avoids further complex adjustments in update_pointer_to and yields @@ -1934,9 +2047,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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. */ @@ -1986,6 +2106,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_template_reference = build_unary_op (INDIRECT_REF, gnu_template_type, tem); TREE_READONLY (gnu_template_reference) = 1; + TREE_THIS_NOTRAP (gnu_template_reference) = 1; /* Now create the GCC type for each index and add the fields for that index to the template. */ @@ -2091,29 +2212,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) debug_info_p); TYPE_READONLY (gnu_template_type) = 1; - /* Now make the array of arrays and update the pointer to the array - in the fat pointer. Note that it is the first field. */ - tem - = gnat_to_gnu_component_type (gnat_entity, definition, debug_info_p); + /* 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)) - Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (tem))); + Set_Component_Size (gnat_entity, + annotate_value (TYPE_SIZE (comp_type))); /* Compute the maximum size of the array in units and bits. */ if (gnu_max_size) { gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size, - TYPE_SIZE_UNIT (tem)); + TYPE_SIZE_UNIT (comp_type)); gnu_max_size = size_binop (MULT_EXPR, convert (bitsizetype, gnu_max_size), - TYPE_SIZE (tem)); + TYPE_SIZE (comp_type)); } else gnu_max_size_unit = NULL_TREE; /* Now build the array type. */ + tem = comp_type; for (index = ndim - 1; index >= 0; index--) { tem = build_nonshared_array_type (tem, gnu_index_types[index]); @@ -2774,7 +2894,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ? -1 : (Known_Alignment (gnat_entity) || (Strict_Alignment (gnat_entity) - && Known_Static_Esize (gnat_entity))) + && Known_RM_Size (gnat_entity))) ? -2 : 0; bool has_discr = Has_Discriminants (gnat_entity); @@ -2825,8 +2945,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If both a size and rep clause was specified, put the size in the record type now so that it can get the proper mode. */ - if (has_rep && Known_Esize (gnat_entity)) - TYPE_SIZE (gnu_type) = UI_To_gnu (Esize (gnat_entity), sizetype); + if (has_rep && Known_RM_Size (gnat_entity)) + TYPE_SIZE (gnu_type) + = UI_To_gnu (RM_Size (gnat_entity), bitsizetype); /* Always set the alignment here so that it can be used to set the mode, if it is making the alignment stricter. If @@ -2843,9 +2964,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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_Static_Esize (gnat_entity)) + && Known_RM_Size (gnat_entity)) { - unsigned int raw_size = UI_To_Int (Esize (gnat_entity)); + unsigned int raw_size = UI_To_Int (RM_Size (gnat_entity)); unsigned int raw_align = raw_size & -raw_size; if (raw_align < BIGGEST_ALIGNMENT) TYPE_ALIGN (gnu_type) = raw_align; @@ -3019,9 +3140,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* 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), - NULL); + 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. */ @@ -3166,9 +3288,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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); @@ -3204,11 +3323,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) { 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 @@ -3275,7 +3399,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) == INTEGER_CST) { gnu_size = DECL_SIZE (gnu_old_field); - if (TREE_CODE (gnu_field_type) == RECORD_TYPE + if (RECORD_OR_UNION_TYPE_P (gnu_field_type) && !TYPE_FAT_POINTER_P (gnu_field_type) && host_integerp (TYPE_SIZE (gnu_field_type), 1)) gnu_field_type @@ -3291,7 +3415,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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 @@ -3302,7 +3426,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) t = NULL_TREE; FOR_EACH_VEC_ELT_REVERSE (variant_desc, gnu_variant_list, ix, v) - if (v->type == gnu_context) + if (gnu_context == v->type + || ((gnu_rep_part = get_rep_part (v->type)) + && gnu_context == TREE_TYPE (gnu_rep_part))) { t = v->type; break; @@ -3312,7 +3438,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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 @@ -3488,8 +3614,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) fill it in later. */ if (!definition && defer_incomplete_level != 0) { - struct incomplete *p - = (struct incomplete *) xmalloc (sizeof (struct incomplete)); + struct incomplete *p = XNEW (struct incomplete); gnu_type = build_pointer_type @@ -3687,7 +3812,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; } - /* If we have not done it yet, build the pointer type the usual way. */ + /* If we haven't done it yet, build the pointer type the usual way. */ if (!gnu_type) { /* Modify the designated type if we are pointing only to constant @@ -3814,15 +3939,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_Access_Subtype: /* We treat this as identical to its base type; any constraint is - meaningful only to the front end. + meaningful only to the front-end. The designated type must be elaborated as well, if it does not have its own freeze node. Designated (sub)types created for constrained components of records with discriminants are - not frozen by the front end and thus not elaborated by gigi, + not frozen by the front-end and thus not elaborated by gigi, because their use may appear before the base type is frozen, and because it is not clear that they are needed anywhere in - Gigi. With the current model, there is no correct place where + gigi. With the current model, there is no correct place where they could be elaborated. */ gnu_type = gnat_to_gnu_type (Etype (gnat_entity)); @@ -3836,20 +3961,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) elaborate it later. */ if (!definition && defer_incomplete_level != 0) { - struct incomplete *p - = (struct incomplete *) xmalloc (sizeof (struct incomplete)); - tree gnu_ptr_type - = build_pointer_type - (make_dummy_type (Directly_Designated_Type (gnat_entity))); + struct incomplete *p = XNEW (struct incomplete); - p->old_type = TREE_TYPE (gnu_ptr_type); + p->old_type + = make_dummy_type (Directly_Designated_Type (gnat_entity)); p->full_type = Directly_Designated_Type (gnat_entity); p->next = defer_incomplete_list; defer_incomplete_list = p; } else if (!IN (Ekind (Base_Type - (Directly_Designated_Type (gnat_entity))), - Incomplete_Or_Private_Kind)) + (Directly_Designated_Type (gnat_entity))), + Incomplete_Or_Private_Kind)) gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity), NULL_TREE, 0); } @@ -3934,6 +4056,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) bool public_flag = Is_Public (gnat_entity) || imported_p; bool extern_flag = (Is_Public (gnat_entity) && !definition) || imported_p; + bool artificial_flag = !Comes_From_Source (gnat_entity); /* The semantics of "pure" in Ada essentially matches that of "const" in the back-end. In particular, both properties are orthogonal to the "nothrow" property if the EH circuitry is explicit in the @@ -4045,7 +4168,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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 @@ -4068,6 +4191,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) max_size (TYPE_SIZE (gnu_return_type), true), 0, gnat_entity, false, false, false, true); + + /* 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); + return_by_invisi_ref_p = true; } @@ -4154,7 +4284,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* The failure of this assertion will very likely come from an order of elaboration issue for the type of the parameter. */ gcc_assert (kind == E_Subprogram_Type - || !TYPE_IS_DUMMY_P (gnu_param_type)); + || !TYPE_IS_DUMMY_P (gnu_param_type) + || type_annotate_only); if (gnu_param) { @@ -4217,7 +4348,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_return_type = gnu_new_ret_type; TYPE_NAME (gnu_return_type) = get_identifier ("RETURN"); - /* Set a default alignment to speed up accesses. */ + /* Set a default alignment to speed up accesses. But we + shouldn't increase the size of the structure too much, + lest it doesn't fit in return registers anymore. */ TYPE_ALIGN (gnu_return_type) = get_mode_alignment (ptr_mode); } @@ -4235,23 +4368,61 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } } - /* Do not compute record for out parameters if subprogram is - stubbed since structures are incomplete for the back-end. */ - if (gnu_field_list && Convention (gnat_entity) != Convention_Stubbed) - finish_record_type (gnu_return_type, nreverse (gnu_field_list), - 0, debug_info_p); + if (gnu_cico_list) + { + /* If we have a CICO list but it has only one entry, we convert + this function into a function that returns this object. */ + if (list_length (gnu_cico_list) == 1) + gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list)); + + /* Do not finalize the return type if the subprogram is stubbed + since structures are incomplete for the back-end. */ + else if (Convention (gnat_entity) != Convention_Stubbed) + { + finish_record_type (gnu_return_type, nreverse (gnu_field_list), + 0, false); + + /* Try to promote the mode of the return type if it is passed + in registers, again to speed up accesses. */ + if (TYPE_MODE (gnu_return_type) == BLKmode + && !targetm.calls.return_in_memory (gnu_return_type, + NULL_TREE)) + { + unsigned int size + = TREE_INT_CST_LOW (TYPE_SIZE (gnu_return_type)); + unsigned int i = BITS_PER_UNIT; + enum machine_mode mode; + + while (i < size) + i <<= 1; + mode = mode_for_size (i, MODE_INT, 0); + if (mode != BLKmode) + { + SET_TYPE_MODE (gnu_return_type, mode); + TYPE_ALIGN (gnu_return_type) + = GET_MODE_ALIGNMENT (mode); + TYPE_SIZE (gnu_return_type) + = bitsize_int (GET_MODE_BITSIZE (mode)); + TYPE_SIZE_UNIT (gnu_return_type) + = size_int (GET_MODE_SIZE (mode)); + } + } - /* If we have a CICO list but it has only one entry, we convert - this function into a function that simply returns that one - object. */ - if (list_length (gnu_cico_list) == 1) - gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_cico_list)); + if (debug_info_p) + rest_of_record_type_compilation (gnu_return_type); + } + } if (Has_Stdcall_Convention (gnat_entity)) 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 we should request stack realignment for a foreign convention subprogram, do so. Note that this applies to task entry points in @@ -4369,9 +4540,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } else if (kind == E_Subprogram_Type) - gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list, - !Comes_From_Source (gnat_entity), - debug_info_p, gnat_entity); + gnu_decl + = create_type_decl (gnu_entity_name, gnu_type, attr_list, + artificial_flag, debug_info_p, gnat_entity); else { if (has_stub) @@ -4379,21 +4550,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_stub_name = gnu_ext_name; gnu_ext_name = create_concat_name (gnat_entity, "internal"); public_flag = false; + artificial_flag = true; } - gnu_decl = create_subprog_decl (gnu_entity_name, gnu_ext_name, - gnu_type, gnu_param_list, - inline_flag, public_flag, - extern_flag, attr_list, - gnat_entity); + 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); 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, attr_list, - gnat_entity); + inline_flag, true, extern_flag, + false, attr_list, gnat_entity); SET_DECL_FUNCTION_STUB (gnu_decl, gnu_stub_decl); } @@ -4495,7 +4666,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) break; case E_Label: - gnu_decl = create_label_decl (gnu_entity_name); + gnu_decl = create_label_decl (gnu_entity_name, gnat_entity); break; case E_Block: @@ -4531,18 +4702,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || 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 non-constant). */ if (!gnu_size && kind != E_String_Literal_Subtype) - gnu_size = validate_size (Esize (gnat_entity), gnu_type, gnat_entity, - TYPE_DECL, false, - Has_Size_Clause (gnat_entity)); + { + Uint gnat_size = Known_Esize (gnat_entity) + ? Esize (gnat_entity) : RM_Size (gnat_entity); + gnu_size + = validate_size (gnat_size, gnu_type, gnat_entity, TYPE_DECL, + false, Has_Size_Clause (gnat_entity)); + } /* If a size was specified, see if we can make a new type of that size by rearranging the type, for example from a fat to a thin pointer. */ @@ -4574,13 +4748,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree size; /* If a size was specified, take it into account. Otherwise - use the RM size for records as the type size has already - been adjusted to the alignment. */ + use the RM size for records or unions as the type size has + already been adjusted to the alignment. */ if (gnu_size) size = gnu_size; - else if ((TREE_CODE (gnu_type) == RECORD_TYPE - || TREE_CODE (gnu_type) == UNION_TYPE - || TREE_CODE (gnu_type) == QUAL_UNION_TYPE) + else if (RECORD_OR_UNION_TYPE_P (gnu_type) && !TYPE_FAT_POINTER_P (gnu_type)) size = rm_size (gnu_type); else @@ -4918,14 +5090,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* If we really have a ..._DECL node, set a couple of flags on it. But we - cannot do that if we are reusing the ..._DECL node made for a renamed - object, since the predicates don't apply to it but to GNAT_ENTITY. */ - if (DECL_P (gnu_decl) && !(Present (Renamed_Object (gnat_entity)) && saved)) + 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. */ + if (DECL_P (gnu_decl) + && !Present (Alias (gnat_entity)) + && !(Present (Renamed_Object (gnat_entity)) && saved)) { if (!Comes_From_Source (gnat_entity)) DECL_ARTIFICIAL (gnu_decl) = 1; - if (!debug_info_p && TREE_CODE (gnu_decl) != FUNCTION_DECL) + if (!debug_info_p) DECL_IGNORED_P (gnu_decl) = 1; } @@ -4960,9 +5134,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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. Since this has both a - typedef and a tag, avoid outputting the name twice. */ - DECL_ARTIFICIAL (gnu_decl) = 1; + /* Write full debugging information. */ rest_of_type_decl_compilation (gnu_decl); } @@ -5103,6 +5275,46 @@ get_unpadded_type (Entity_Id gnat_entity) return type; } + +/* Return the DECL associated with the public subprogram GNAT_ENTITY but whose + type has been changed to that of the parameterless procedure, except if an + alias is already present, in which case it is returned instead. */ + +tree +get_minimal_subprog_decl (Entity_Id gnat_entity) +{ + tree gnu_entity_name, gnu_ext_name; + struct attrib *attr_list = NULL; + + /* See the E_Function/E_Procedure case of gnat_to_gnu_entity for the model + of the handling applied here. */ + + while (Present (Alias (gnat_entity))) + { + gnat_entity = Alias (gnat_entity); + if (present_gnu_tree (gnat_entity)) + return get_gnu_tree (gnat_entity); + } + + gnu_entity_name = get_entity_name (gnat_entity); + gnu_ext_name = create_concat_name (gnat_entity, NULL); + + if (Has_Stdcall_Convention (gnat_entity)) + 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); +} /* Wrap up compilation of DECL, a TYPE_DECL, possibly deferring it. Every TYPE_DECL generated for a type definition must be passed @@ -5143,6 +5355,39 @@ rest_of_type_decl_compilation_no_defer (tree decl) } } +/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is + a C++ imported method or equivalent. + + We use the predicate on 32-bit x86/Windows to find out whether we need to + use the "thiscall" calling convention for GNAT_ENTITY. This convention is + used for C++ methods (functions with METHOD_TYPE) by the back-end. */ + +bool +is_cplusplus_method (Entity_Id gnat_entity) +{ + if (Convention (gnat_entity) != Convention_CPP) + return False; + + /* This is the main case: C++ method imported as a primitive operation. */ + if (Is_Dispatching_Operation (gnat_entity)) + return True; + + /* A thunk needs to be handled like its associated primitive operation. */ + if (Is_Subprogram (gnat_entity) && Is_Thunk (gnat_entity)) + return True; + + /* C++ classes with no virtual functions can be imported as limited + record types, but we need to return true for the constructors. */ + if (Is_Constructor (gnat_entity)) + return True; + + /* This is set on the E_Subprogram_Type built for a dispatching call. */ + if (Is_Dispatch_Table_Entity (gnat_entity)) + return True; + + return False; +} + /* Finalize the processing of From_With_Type incomplete types. */ void @@ -5207,6 +5452,7 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity) } gcc_assert (Present (gnat_equiv) || type_annotate_only); + return gnat_equiv; } @@ -5219,7 +5465,8 @@ static tree gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, bool debug_info_p) { - tree gnu_type = gnat_to_gnu_type (Component_Type (gnat_array)); + const Entity_Id gnat_type = Component_Type (gnat_array); + tree gnu_type = gnat_to_gnu_type (gnat_type); tree gnu_comp_size; /* Try to get a smaller form of the component if needed. */ @@ -5227,8 +5474,8 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, || Has_Component_Size_Clause (gnat_array)) && !Is_Bit_Packed_Array (gnat_array) && !Has_Aliased_Components (gnat_array) - && !Strict_Alignment (Component_Type (gnat_array)) - && TREE_CODE (gnu_type) == RECORD_TYPE + && !Strict_Alignment (gnat_type) + && RECORD_OR_UNION_TYPE_P (gnu_type) && !TYPE_FAT_POINTER_P (gnu_type) && host_integerp (TYPE_SIZE (gnu_type), 1)) gnu_type = make_packable_type (gnu_type, false); @@ -5291,7 +5538,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, debug_info_p, gnat_array); } - if (Has_Volatile_Components (Base_Type (gnat_array))) + if (Has_Volatile_Components (gnat_array)) gnu_type = build_qualified_type (gnu_type, TYPE_QUALS (gnu_type) | TYPE_QUAL_VOLATILE); @@ -5435,14 +5682,22 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, || (!foreign && default_pass_by_ref (gnu_param_type))))) { + /* We take advantage of 6.2(12) by considering that references built for + 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 + = !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 (NULL, + && targetm.calls.pass_by_reference (pack_cumulative_args (NULL), TYPE_MODE (gnu_param_type), gnu_param_type, true)) @@ -5496,8 +5751,13 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech, 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_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); /* Save the alternate descriptor type, if any. */ if (gnu_param_type_alt) @@ -6014,7 +6274,8 @@ static tree elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name, bool definition, bool need_debug) { - const bool expr_global_p = Is_Public (gnat_entity) || global_bindings_p (); + const bool expr_public_p = Is_Public (gnat_entity); + const bool expr_global_p = expr_public_p || global_bindings_p (); bool expr_variable_p, use_variable; /* In most cases, we won't see a naked FIELD_DECL because a discriminant @@ -6082,11 +6343,10 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name, if (use_variable || need_debug) { tree gnu_decl - = create_var_decl (create_concat_name (gnat_entity, - IDENTIFIER_POINTER (gnu_name)), - NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, - !need_debug, Is_Public (gnat_entity), - !definition, expr_global_p, NULL, gnat_entity); + = create_var_decl_1 + (create_concat_name (gnat_entity, IDENTIFIER_POINTER (gnu_name)), + NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, true, expr_public_p, + !definition, expr_global_p, !need_debug, NULL, gnat_entity); if (use_variable) return gnu_decl; @@ -6284,9 +6544,7 @@ make_packable_type (tree type, bool in_record) tree new_field_type = TREE_TYPE (old_field); tree new_field, new_size; - if ((TREE_CODE (new_field_type) == RECORD_TYPE - || TREE_CODE (new_field_type) == UNION_TYPE - || TREE_CODE (new_field_type) == QUAL_UNION_TYPE) + 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); @@ -6296,9 +6554,7 @@ make_packable_type (tree type, bool in_record) packable version of the record type, see finish_record_type. */ if (!DECL_CHAIN (old_field) && !TYPE_PACKED (type) - && (TREE_CODE (new_field_type) == RECORD_TYPE - || TREE_CODE (new_field_type) == UNION_TYPE - || TREE_CODE (new_field_type) == QUAL_UNION_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)) @@ -6323,6 +6579,8 @@ make_packable_type (tree type, bool in_record) 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. */ @@ -6458,8 +6716,9 @@ maybe_pad_type (tree type, tree size, unsigned int align, 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 - && TREE_CODE (type) == RECORD_TYPE + && RECORD_OR_UNION_TYPE_P (type) && TYPE_MODE (type) == BLKmode + && !TYPE_BY_REFERENCE_P (type) && TREE_CODE (orig_size) == INTEGER_CST && !TREE_OVERFLOW (orig_size) && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0 @@ -6583,7 +6842,7 @@ choices_to_gnu (tree operand, Node_Id choices) { Node_Id choice; Node_Id gnat_temp; - tree result = integer_zero_node; + tree result = boolean_false_node; tree this_test, low = 0, high = 0, single = 0; for (choice = First (choices); Present (choice); choice = Next (choice)) @@ -6648,7 +6907,7 @@ choices_to_gnu (tree operand, Node_Id choices) break; case N_Others_Choice: - this_test = integer_one_node; + this_test = boolean_true_node; break; default: @@ -6672,7 +6931,7 @@ adjust_packed (tree field_type, tree record_type, int packed) because we cannot create temporaries of non-fixed size in case we need to take the address of the field. See addressable_p and the notes on the addressability issues for further details. */ - if (is_variable_size (field_type)) + if (type_has_variable_size (field_type)) return 0; /* If the alignment of the record is specified and the field type @@ -6704,12 +6963,16 @@ static tree gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, bool definition, bool debug_info_p) { + const Entity_Id gnat_field_type = Etype (gnat_field); + tree gnu_field_type = gnat_to_gnu_type (gnat_field_type); tree gnu_field_id = get_entity_name (gnat_field); - tree gnu_field_type = gnat_to_gnu_type (Etype (gnat_field)); tree gnu_field, gnu_size, gnu_pos; + bool is_volatile + = (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type)); bool needs_strict_alignment - = (Is_Aliased (gnat_field) || Strict_Alignment (Etype (gnat_field)) - || Treat_As_Volatile (gnat_field)); + = (is_volatile + || Is_Aliased (gnat_field) + || Strict_Alignment (gnat_field_type)); /* If this field requires strict alignment, we cannot pack it because it would very likely be under-aligned in the record. */ @@ -6721,11 +6984,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, /* If a size is specified, use it. Otherwise, if the record type is packed, use the official RM size. See "Handling of Type'Size Values" in Einfo for further details. */ - if (Known_Static_Esize (gnat_field)) + if (Known_Esize (gnat_field)) gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field, FIELD_DECL, false, true); else if (packed == 1) - gnu_size = validate_size (RM_Size (Etype (gnat_field)), gnu_field_type, + gnu_size = validate_size (RM_Size (gnat_field_type), gnu_field_type, gnat_field, FIELD_DECL, false, true); else gnu_size = NULL_TREE; @@ -6753,7 +7016,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, effects on the outer record type. A typical case is a field known to be byte-aligned and not to share a byte with another field. */ if (!needs_strict_alignment - && TREE_CODE (gnu_field_type) == RECORD_TYPE + && RECORD_OR_UNION_TYPE_P (gnu_field_type) && !TYPE_FAT_POINTER_P (gnu_field_type) && host_integerp (TYPE_SIZE (gnu_field_type), 1) && (packed == 1 @@ -6773,10 +7036,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, } } - /* If we are packing the record and the field is BLKmode, round the - size up to a byte boundary. */ - if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size) - gnu_size = round_up (gnu_size, BITS_PER_UNIT); + if (Is_Atomic (gnat_field)) + check_ok_for_atomic (gnu_field_type, gnat_field, false); if (Present (Component_Clause (gnat_field))) { @@ -6817,7 +7078,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, if (gnu_size && !operand_equal_p (gnu_size, TYPE_SIZE (gnu_field_type), 0)) { - if (Is_Atomic (gnat_field) || Is_Atomic (Etype (gnat_field))) + if (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type)) post_error_ne_tree ("atomic field& must be natural size of type{ (^)}", Last_Bit (Component_Clause (gnat_field)), gnat_field, @@ -6829,7 +7090,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, Last_Bit (Component_Clause (gnat_field)), gnat_field, TYPE_SIZE (gnu_field_type)); - else if (Strict_Alignment (Etype (gnat_field))) + else if (Strict_Alignment (gnat_field_type)) post_error_ne_tree ("size of & with aliased or tagged components not ^ bits", Last_Bit (Component_Clause (gnat_field)), gnat_field, @@ -6842,33 +7103,30 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, (TRUNC_MOD_EXPR, gnu_pos, bitsize_int (TYPE_ALIGN (gnu_field_type))))) { - if (Is_Aliased (gnat_field)) - post_error_ne_num - ("position of aliased field& must be multiple of ^ bits", - First_Bit (Component_Clause (gnat_field)), gnat_field, - TYPE_ALIGN (gnu_field_type)); - - else if (Treat_As_Volatile (gnat_field)) + if (is_volatile) post_error_ne_num ("position of volatile field& must be multiple of ^ bits", First_Bit (Component_Clause (gnat_field)), gnat_field, TYPE_ALIGN (gnu_field_type)); - else if (Strict_Alignment (Etype (gnat_field))) + else if (Is_Aliased (gnat_field)) post_error_ne_num - ("position of & with aliased or tagged components not multiple of ^ bits", + ("position of aliased field& must be multiple of ^ bits", First_Bit (Component_Clause (gnat_field)), gnat_field, TYPE_ALIGN (gnu_field_type)); + else if (Strict_Alignment (gnat_field_type)) + post_error_ne + ("position of & is not compatible with alignment required " + "by its components", + First_Bit (Component_Clause (gnat_field)), gnat_field); + else gcc_unreachable (); gnu_pos = NULL_TREE; } } - - if (Is_Atomic (gnat_field)) - check_ok_for_atomic (gnu_field_type, gnat_field, false); } /* If the record has rep clauses and this is the tag field, make a rep @@ -6881,7 +7139,14 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, } else - gnu_pos = NULL_TREE; + { + gnu_pos = NULL_TREE; + + /* If we are packing the record and the field is BLKmode, round the + size up to a byte boundary. */ + if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size) + gnu_size = round_up (gnu_size, BITS_PER_UNIT); + } /* We need to make the size the maximum for the type if it is self-referential and an unconstrained type. In that case, we can't @@ -6889,7 +7154,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, if (TREE_CODE (gnu_field_type) == RECORD_TYPE && !gnu_size && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_field_type)) - && !Is_Constrained (Underlying_Type (Etype (gnat_field)))) + && !Is_Constrained (Underlying_Type (gnat_field_type))) { gnu_size = max_size (TYPE_SIZE (gnu_field_type), true); packed = 0; @@ -6941,7 +7206,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type, gnu_size, gnu_pos, packed, Is_Aliased (gnat_field)); Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field)); - TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field); + DECL_ALIASED_P (gnu_field) = Is_Aliased (gnat_field); + TREE_THIS_VOLATILE (gnu_field) = TREE_SIDE_EFFECTS (gnu_field) = is_volatile; if (Ekind (gnat_field) == E_Discriminant) DECL_DISCRIMINANT_NUMBER (gnu_field) @@ -6950,11 +7216,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, return gnu_field; } -/* Return true if TYPE is a type with variable size, a padding type with a - field of variable size or is a record that has a field such a field. */ +/* 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. */ static bool -is_variable_size (tree type) +type_has_variable_size (tree type) { tree field; @@ -6965,18 +7231,72 @@ is_variable_size (tree type) && !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type)))) return true; - if (TREE_CODE (type) != RECORD_TYPE - && TREE_CODE (type) != UNION_TYPE - && TREE_CODE (type) != QUAL_UNION_TYPE) + if (!RECORD_OR_UNION_TYPE_P (type)) return false; for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) - if (is_variable_size (TREE_TYPE (field))) + if (type_has_variable_size (TREE_TYPE (field))) return true; return false; } +/* Return true if FIELD is an artificial field. */ + +static bool +field_is_artificial (tree field) +{ + /* These fields are generated by the front-end proper. */ + if (IDENTIFIER_POINTER (DECL_NAME (field)) [0] == '_') + return true; + + /* These fields are generated by gigi. */ + if (DECL_INTERNAL_P (field)) + return true; + + return false; +} + +/* Return true if FIELD is a non-artificial aliased field. */ + +static bool +field_is_aliased (tree field) +{ + if (field_is_artificial (field)) + return false; + + return DECL_ALIASED_P (field); +} + +/* Return true if FIELD is a non-artificial field with self-referential + size. */ + +static bool +field_has_self_size (tree field) +{ + if (field_is_artificial (field)) + return false; + + if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST) + return false; + + return CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (field))); +} + +/* Return true if FIELD is a non-artificial field with variable size. */ + +static bool +field_has_variable_size (tree field) +{ + if (field_is_artificial (field)) + return false; + + if (DECL_SIZE (field) && TREE_CODE (DECL_SIZE (field)) == INTEGER_CST) + return false; + + return TREE_CODE (TYPE_SIZE (TREE_TYPE (field))) != INTEGER_CST; +} + /* qsort comparer for the bit positions of two record components. */ static int @@ -7014,6 +7334,8 @@ compare_field_bitpos (const PTR rt1, const PTR rt2) 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 @@ -7021,6 +7343,10 @@ compare_field_bitpos (const PTR rt1, const PTR rt2) REORDER is true if we are permitted to reorder components of this type. + FIRST_FREE_POS, if nonzero, is the first (lowest) free field position in + the outer record type down to this variant level. It is nonzero only if + all the fields down to this level have a rep clause and ALL_REP is false. + 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. */ @@ -7029,14 +7355,17 @@ static void 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, - tree *p_gnu_rep_list) + 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 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; @@ -7085,6 +7414,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_field_list = gnu_field; if (!gnu_last) gnu_last = gnu_field; + + /* And record information for the final layout. */ + if (field_has_self_size (gnu_field)) + has_self_field = true; + else if (has_self_field && field_is_aliased (gnu_field)) + has_aliased_after_self_field = true; } } @@ -7110,7 +7445,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, = concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))), "XVN"); tree gnu_union_type, gnu_union_name; - tree gnu_variant_list = NULL_TREE; + tree this_first_free_pos, gnu_variant_list = NULL_TREE; if (TREE_CODE (gnu_name) == TYPE_DECL) gnu_name = DECL_NAME (gnu_name); @@ -7118,12 +7453,10 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_union_name = concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name)); - /* Reuse an enclosing union if all fields are in the variant part - and there is no representation clause on the record, to match - the layout of C unions. There is an associated check below. */ - if (!gnu_field_list - && TREE_CODE (gnu_record_type) == UNION_TYPE - && !TYPE_PACKED (gnu_record_type)) + /* Reuse the enclosing union if this is an Unchecked_Union whose fields + are all in the variant part, to match the layout of C unions. There + is an associated check below. */ + if (TREE_CODE (gnu_record_type) == UNION_TYPE) gnu_union_type = gnu_record_type; else { @@ -7135,6 +7468,29 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type); } + /* If all the fields down to this level have a rep clause, find out + whether all the fields at this level also have one. If so, then + compute the new first free position to be passed downward. */ + this_first_free_pos = first_free_pos; + if (this_first_free_pos) + { + for (gnu_field = gnu_field_list; + gnu_field; + gnu_field = DECL_CHAIN (gnu_field)) + if (DECL_FIELD_OFFSET (gnu_field)) + { + tree pos = bit_position (gnu_field); + if (!tree_int_cst_lt (pos, this_first_free_pos)) + this_first_free_pos + = size_binop (PLUS_EXPR, pos, DECL_SIZE (gnu_field)); + } + else + { + this_first_free_pos = NULL_TREE; + break; + } + } + for (variant = First_Non_Pragma (Variants (variant_part)); Present (variant); variant = Next_Non_Pragma (variant)) @@ -7156,8 +7512,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, TYPE_PACKED (gnu_variant_type) = TYPE_PACKED (gnu_record_type); /* Similarly, if the outer record has a size specified and all - fields have record rep clauses, we can propagate the size - into the variant part. */ + the fields have a rep clause, we can propagate the size. */ if (all_rep_and_size) { TYPE_SIZE (gnu_variant_type) = TYPE_SIZE (gnu_record_type); @@ -7169,20 +7524,25 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, 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, &gnu_rep_list); + !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); gnu_qual = choices_to_gnu (gnu_discr, Discrete_Choices (variant)); - Set_Present_Expr (variant, annotate_value (gnu_qual)); - /* If this is an Unchecked_Union and we have exactly one field, - use this field directly to match the layout of C unions. */ - if (unchecked_union - && TYPE_FIELDS (gnu_variant_type) - && !DECL_CHAIN (TYPE_FIELDS (gnu_variant_type))) - gnu_field = 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; else { /* Deal with packedness like in gnat_to_gnu_field. */ @@ -7253,15 +7613,18 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, 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 ? bitsize_zero_node : 0, + all_rep || this_first_free_pos + ? bitsize_zero_node : 0, union_field_packed, 0); DECL_INTERNAL_P (gnu_variant_part) = 1; - DECL_CHAIN (gnu_variant_part) = gnu_field_list; - gnu_field_list = gnu_variant_part; } } + /* 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 @@ -7293,34 +7656,17 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, continue; } - if (reorder) + if ((reorder || has_aliased_after_self_field) + && field_has_self_size (gnu_field)) { - /* Pull out the variant part and put it onto GNU_SELF_LIST. */ - if (gnu_field == gnu_variant_part) - { - MOVE_FROM_FIELD_LIST_TO (gnu_self_list); - continue; - } - - /* Skip internal fields and fields with fixed size. */ - if (!DECL_INTERNAL_P (gnu_field) - && !(DECL_SIZE (gnu_field) - && TREE_CODE (DECL_SIZE (gnu_field)) == INTEGER_CST)) - { - tree type_size = TYPE_SIZE (TREE_TYPE (gnu_field)); - - if (CONTAINS_PLACEHOLDER_P (type_size)) - { - MOVE_FROM_FIELD_LIST_TO (gnu_self_list); - continue; - } + MOVE_FROM_FIELD_LIST_TO (gnu_self_list); + continue; + } - if (TREE_CODE (type_size) != INTEGER_CST) - { - MOVE_FROM_FIELD_LIST_TO (gnu_var_list); - continue; - } - } + if (reorder && field_has_variable_size (gnu_field)) + { + MOVE_FROM_FIELD_LIST_TO (gnu_var_list); + continue; } gnu_last = gnu_field; @@ -7328,7 +7674,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, #undef MOVE_FROM_FIELD_LIST_TO - /* If permitted, we reorder the components as follows: + /* If permitted, we reorder the fields as follows: 1) all fixed length fields, 2) all fields whose length doesn't depend on discriminants, @@ -7341,14 +7687,20 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, = chainon (nreverse (gnu_self_list), chainon (nreverse (gnu_var_list), gnu_field_list)); - /* If we have any fields in our rep'ed field list and it is not the case that - all the fields in the record have rep clauses and P_REP_LIST is nonzero, - set it and ignore these fields. */ - if (gnu_rep_list && p_gnu_rep_list && !all_rep) + /* 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); + + /* 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 + order to do a correct layout, i.e. avoid having overlapping fields. */ + if (p_gnu_rep_list && gnu_rep_list) *p_gnu_rep_list = chainon (*p_gnu_rep_list, gnu_rep_list); /* Otherwise, sort the fields by bit position and put them into their own - record, before the others, if we also have fields without rep clauses. */ + record, before the others, if we also have fields without rep clause. */ else if (gnu_rep_list) { tree gnu_rep_type @@ -7376,11 +7728,12 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, if (gnu_field_list) { finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info); - gnu_field - = create_field_decl (get_identifier ("REP"), gnu_rep_type, - gnu_record_type, NULL_TREE, NULL_TREE, 0, 1); - DECL_INTERNAL_P (gnu_field) = 1; - gnu_field_list = chainon (gnu_field_list, gnu_field); + + /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields + without rep clause are laid out starting from this position. + 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 { @@ -7389,11 +7742,36 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_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); + } + + /* 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. */ + if (gnu_variant_part) + { + DECL_CHAIN (gnu_variant_part) = gnu_field_list; + 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); + layout_with_rep ? 1 : 0, false); + TYPE_ARTIFICIAL (gnu_record_type) = artificial; + if (debug_info && !maybe_unused) + rest_of_record_type_compilation (gnu_record_type); } /* Given GNU_SIZE, a GCC tree representing a size, return a Uint to be @@ -7405,23 +7783,26 @@ annotate_value (tree gnu_size) { TCode tcode; Node_Ref_Or_Val ops[3], ret; - struct tree_int_map **h = NULL; + struct tree_int_map in; int i; /* See if we've already saved the value for this node. */ if (EXPR_P (gnu_size)) { - struct tree_int_map in; + struct tree_int_map *e; + if (!annotate_value_cache) annotate_value_cache = htab_create_ggc (512, tree_int_map_hash, tree_int_map_eq, 0); in.base.from = gnu_size; - h = (struct tree_int_map **) - htab_find_slot (annotate_value_cache, &in, INSERT); + e = (struct tree_int_map *) + htab_find (annotate_value_cache, &in); - if (*h) - return (Node_Ref_Or_Val) (*h)->to; + if (e) + return (Node_Ref_Or_Val) e->to; } + else + in.base.from = NULL_TREE; /* If we do not return inside this switch, TCODE will be set to the code to use for a Create_Node operand and LEN (set above) will be @@ -7522,8 +7903,17 @@ annotate_value (tree gnu_size) ret = Create_Node (tcode, ops[0], ops[1], ops[2]); /* Save the result in the cache. */ - if (h) + if (in.base.from) { + struct tree_int_map **h; + /* We can't assume the hash table data hasn't moved since the + initial look up, so we have to search again. Allocating and + inserting an entry at that point would be an alternative, but + then we'd better discard the entry if we decided not to cache + it. */ + h = (struct tree_int_map **) + htab_find_slot (annotate_value_cache, &in, INSERT); + gcc_assert (!*h); *h = ggc_alloc_tree_int_map (); (*h)->base.from = gnu_size; (*h)->to = ret; @@ -7779,7 +8169,7 @@ build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list, v->type = variant_type; v->field = gnu_field; v->qual = qual; - v->record = NULL_TREE; + v->new_type = NULL_TREE; /* Recurse on the variant subpart of the variant, if any. */ variant_subpart = get_variant_part (variant_type); @@ -7996,9 +8386,7 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity) SET_TYPE_RM_SIZE (gnu_type, size); /* ...or the Ada size for record and union types. */ - else if ((TREE_CODE (gnu_type) == RECORD_TYPE - || TREE_CODE (gnu_type) == UNION_TYPE - || TREE_CODE (gnu_type) == QUAL_UNION_TYPE) + else if (RECORD_OR_UNION_TYPE_P (gnu_type) && !TYPE_FAT_POINTER_P (gnu_type)) SET_TYPE_ADA_SIZE (gnu_type, size); } @@ -8036,7 +8424,7 @@ make_type_from_size (tree type, tree size_tree, bool for_biased) /* 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) + if (TYPE_IS_PACKED_ARRAY_TYPE_P (type) || (TYPE_PRECISION (type) == size && biased_p == for_biased)) break; @@ -8318,23 +8706,27 @@ intrin_types_incompatible_p (tree t1, tree t2) static bool intrin_arglists_compatible_p (intrin_binding_t * inb) { - tree ada_args = TYPE_ARG_TYPES (inb->ada_fntype); - tree btin_args = TYPE_ARG_TYPES (inb->btin_fntype); + function_args_iterator ada_iter, btin_iter; + + function_args_iter_init (&ada_iter, inb->ada_fntype); + function_args_iter_init (&btin_iter, inb->btin_fntype); /* Sequence position of the last argument we checked. */ int argpos = 0; - while (ada_args != 0 || btin_args != 0) + while (1) { - tree ada_type, btin_type; + tree ada_type = function_args_iter_cond (&ada_iter); + tree btin_type = function_args_iter_cond (&btin_iter); + + /* If we've exhausted both lists simultaneously, we're done. */ + if (ada_type == NULL_TREE && btin_type == NULL_TREE) + break; /* If one list is shorter than the other, they fail to match. */ - if (ada_args == 0 || btin_args == 0) + if (ada_type == NULL_TREE || btin_type == NULL_TREE) return false; - ada_type = TREE_VALUE (ada_args); - btin_type = TREE_VALUE (btin_args); - /* If we're done with the Ada args and not with the internal builtin args, or the other way around, complain. */ if (ada_type == void_type_node @@ -8361,8 +8753,9 @@ intrin_arglists_compatible_p (intrin_binding_t * inb) return false; } - ada_args = TREE_CHAIN (ada_args); - btin_args = TREE_CHAIN (btin_args); + + function_args_iter_next (&ada_iter); + function_args_iter_next (&btin_iter); } return true; @@ -8477,6 +8870,24 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type, return new_field; } +/* Create the REP part of RECORD_TYPE with REP_TYPE. If MIN_SIZE is nonzero, + it is the minimal size the REP_PART must have. */ + +static tree +create_rep_part (tree rep_type, tree record_type, tree min_size) +{ + tree field; + + if (min_size && !tree_int_cst_lt (TYPE_SIZE (rep_type), min_size)) + min_size = NULL_TREE; + + field = create_field_decl (get_identifier ("REP"), rep_type, record_type, + min_size, bitsize_zero_node, 0, 1); + DECL_INTERNAL_P (field) = 1; + + return field; +} + /* Return the REP part of RECORD_TYPE, if any. Otherwise return NULL. */ static tree @@ -8485,10 +8896,11 @@ get_rep_part (tree record_type) tree field = TYPE_FIELDS (record_type); /* The REP part is the first field, internal, another record, and its name - doesn't start with an underscore (i.e. is not generated by the FE). */ - if (DECL_INTERNAL_P (field) + starts with an 'R'. */ + if (field + && DECL_INTERNAL_P (field) && TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE - && IDENTIFIER_POINTER (DECL_NAME (field)) [0] != '_') + && IDENTIFIER_POINTER (DECL_NAME (field)) [0] == 'R') return field; return NULL_TREE; @@ -8496,7 +8908,7 @@ get_rep_part (tree record_type) /* Return the variant part of RECORD_TYPE, if any. Otherwise return NULL. */ -static tree +tree get_variant_part (tree record_type) { tree field; @@ -8531,7 +8943,9 @@ create_variant_part_from (tree old_variant_part, /* 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 @@ -8565,7 +8979,7 @@ create_variant_part_from (tree old_variant_part, 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 @@ -8845,10 +9259,8 @@ rm_size (tree gnu_type) rm_size (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))), DECL_SIZE (TYPE_FIELDS (gnu_type))); - /* For record types, we store the size explicitly. */ - if ((TREE_CODE (gnu_type) == RECORD_TYPE - || TREE_CODE (gnu_type) == UNION_TYPE - || TREE_CODE (gnu_type) == QUAL_UNION_TYPE) + /* For record or union types, we store the size explicitly. */ + if (RECORD_OR_UNION_TYPE_P (gnu_type) && !TYPE_FAT_POINTER_P (gnu_type) && TYPE_ADA_SIZE (gnu_type)) return TYPE_ADA_SIZE (gnu_type); @@ -8879,7 +9291,7 @@ create_concat_name (Entity_Id gnat_entity, const char *suffix) if (suffix) { - String_Template temp = {1, strlen (suffix)}; + String_Template temp = {1, (int) strlen (suffix)}; Fat_Pointer fp = {suffix, &temp}; Get_External_Name_With_Suffix (gnat_entity, fp); }