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=ea8eb914877d6ed9ac3aa16e6eb64df5696374a3;hb=3525e494177a4b6ac7f70f897da01b875a3ce5a5;hpb=26bf15882943451d03e435a3f8cd5a951aa1266a diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ea8eb914877..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,6 +180,7 @@ 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 create_variant_part_from (tree, VEC(variant_desc,heap) *, tree, tree, VEC(subst_pair,heap) *); @@ -777,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 @@ -888,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); @@ -949,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); @@ -1010,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; } @@ -1042,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; @@ -1361,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)); @@ -1417,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 @@ -1433,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 ()) @@ -1937,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 @@ -1957,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. */ @@ -2115,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]); @@ -3044,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. */ @@ -3191,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); @@ -3229,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 @@ -3300,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 @@ -3316,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 @@ -3327,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; @@ -3337,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 @@ -3711,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 @@ -4067,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 @@ -4183,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) { @@ -4246,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); } @@ -4255,9 +4359,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_field_decl (gnu_param_name, gnu_param_type, gnu_return_type, NULL_TREE, NULL_TREE, 0, 0); - /* Set a minimum alignment to speed up accesses. */ - if (DECL_ALIGN (gnu_field) < TYPE_ALIGN (gnu_return_type)) - DECL_ALIGN (gnu_field) = TYPE_ALIGN (gnu_return_type); Sloc_to_locus (Sloc (gnat_param), &DECL_SOURCE_LOCATION (gnu_field)); DECL_CHAIN (gnu_field) = gnu_field_list; @@ -4317,6 +4418,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) (&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 @@ -4560,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: @@ -4596,10 +4702,9 @@ 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 @@ -4643,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 @@ -5172,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 @@ -5212,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 @@ -5276,6 +5452,7 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity) } gcc_assert (Present (gnat_equiv) || type_annotate_only); + return gnat_equiv; } @@ -5298,7 +5475,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition, && !Is_Bit_Packed_Array (gnat_array) && !Has_Aliased_Components (gnat_array) && !Strict_Alignment (gnat_type) - && TREE_CODE (gnu_type) == RECORD_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); @@ -5505,7 +5682,15 @@ 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 @@ -5566,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) @@ -6084,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 @@ -6152,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; @@ -6354,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); @@ -6366,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)) @@ -6530,9 +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 - && !TREE_ADDRESSABLE (type) + && !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 @@ -6745,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 @@ -6830,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 @@ -6850,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))) { @@ -6932,10 +7116,10 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, TYPE_ALIGN (gnu_field_type)); else if (Strict_Alignment (gnat_field_type)) - post_error_ne_num - ("position of & with aliased or tagged components not multiple of ^ bits", - First_Bit (Component_Clause (gnat_field)), gnat_field, - TYPE_ALIGN (gnu_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 (); @@ -6943,9 +7127,6 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, 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 @@ -6958,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 @@ -7018,6 +7206,7 @@ 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)); + 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) @@ -7027,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; @@ -7042,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 @@ -7091,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 @@ -7098,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. */ @@ -7106,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; @@ -7162,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; } } @@ -7187,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); @@ -7195,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 { @@ -7212,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)) @@ -7233,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); @@ -7246,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. */ @@ -7330,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 @@ -7370,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; @@ -7405,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, @@ -7418,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 @@ -7453,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 { @@ -7466,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 @@ -7868,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); @@ -8085,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); } @@ -8125,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; @@ -8571,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 @@ -8579,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; @@ -8625,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 @@ -8659,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 @@ -8939,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); @@ -8973,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); }