diff options
Diffstat (limited to 'gcc/ada/decl.c')
| -rw-r--r-- | gcc/ada/decl.c | 866 |
1 files changed, 575 insertions, 291 deletions
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 1225ba169a5..dd4b427c2e0 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -6,8 +6,7 @@ * * * C Implementation File * * * - * * - * Copyright (C) 1992-2002, Free Software Foundation, Inc. * + * Copyright (C) 1992-2003, 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- * @@ -89,6 +88,7 @@ static int allocatable_size_p PARAMS ((tree, int)); static struct attrib *build_attr_list PARAMS ((Entity_Id)); static tree elaborate_expression PARAMS ((Node_Id, Entity_Id, tree, int, int, int)); +static int is_variable_size PARAMS ((tree)); static tree elaborate_expression_1 PARAMS ((Node_Id, Entity_Id, tree, tree, int, int)); static tree make_packable_type PARAMS ((tree)); @@ -335,10 +335,15 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* If we have an external constant that we are not defining, get the expression that is was defined to represent. We may throw that expression away later if it is not a - constant. */ + constant. + Do not retrieve the expression if it is an aggregate, because + in complex instantiation contexts it may not be expanded */ + if (! definition && Present (Expression (Declaration_Node (gnat_entity))) - && ! No_Initialization (Declaration_Node (gnat_entity))) + && ! No_Initialization (Declaration_Node (gnat_entity)) + && Nkind (Expression (Declaration_Node (gnat_entity))) + != N_Aggregate) gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity))); /* Ignore deferred constant definitions; they are processed fully in the @@ -407,11 +412,12 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) extended record types), just return the inherited entity, which must be a FIELD_DECL. Likewise for discriminants. For discriminants of untagged records which have explicit - girder discriminants, return the entity for the corresponding - girder discriminant. Also use Original_Record_Component + stored discriminants, return the entity for the corresponding + stored discriminant. Also use Original_Record_Component if the record has a private extension. */ if ((Base_Type (gnat_record) == gnat_record + || Ekind (Scope (gnat_entity)) == E_Private_Subtype || Ekind (Scope (gnat_entity)) == E_Record_Subtype_With_Private || Ekind (Scope (gnat_entity)) == E_Record_Type_With_Private) && Present (Original_Record_Component (gnat_entity)) @@ -424,20 +430,20 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) break; } - /* If the enclosing record has explicit girder discriminants, + /* If the enclosing record has explicit stored discriminants, then it is an untagged record. If the Corresponding_Discriminant is not empty then this must be a renamed discriminant and its Original_Record_Component must point to the corresponding explicit - girder discriminant (i.e., we should have taken the previous + stored discriminant (i.e., we should have taken the previous branch). */ else if (Present (Corresponding_Discriminant (gnat_entity)) && Is_Tagged_Type (gnat_record)) { - /* A tagged record has no explicit girder discriminants. */ + /* A tagged record has no explicit stored discriminants. */ if (First_Discriminant (gnat_record) - != First_Girder_Discriminant (gnat_record)) + != First_Stored_Discriminant (gnat_record)) gigi_abort (119); gnu_decl @@ -447,16 +453,16 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) break; } - /* If the enclosing record has explicit girder discriminants, + /* If the enclosing record has explicit stored discriminants, then it is an untagged record. If the Corresponding_Discriminant is not empty then this must be a renamed discriminant and its Original_Record_Component must point to the corresponding explicit - girder discriminant (i.e., we should have taken the first + stored discriminant (i.e., we should have taken the first branch). */ else if (Present (Corresponding_Discriminant (gnat_entity)) && (First_Discriminant (gnat_record) - != First_Girder_Discriminant (gnat_record))) + != First_Stored_Discriminant (gnat_record))) gigi_abort (120); /* Otherwise, if we are not defining this and we have no GCC type @@ -468,9 +474,14 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) type and we have an Original_Record_Component, use it. This is a workaround for major problems in protected type handling. */ - if (Is_Protected_Type (Scope (Scope (gnat_entity))) + + Entity_Id Scop = Scope (Scope (gnat_entity)); + if ((Is_Protected_Type (Scop) + || (Is_Private_Type (Scop) + && Present (Full_View (Scop)) + && Is_Protected_Type (Full_View (Scop)))) && Present (Original_Record_Component (gnat_entity))) - { + { gnu_decl = gnat_to_gnu_entity (Original_Record_Component (gnat_entity), @@ -572,21 +583,14 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) this may end up with an indirect allocation. */ if (No (Renamed_Object (gnat_entity)) - && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE (gnu_type))) + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) { if (gnu_expr != 0 && kind == E_Constant) { gnu_size = TYPE_SIZE (TREE_TYPE (gnu_expr)); - if (TREE_CODE (gnu_size) != INTEGER_CST - && contains_placeholder_p (gnu_size)) - { - gnu_size = TYPE_SIZE (TREE_TYPE (gnu_expr)); - if (TREE_CODE (gnu_size) != INTEGER_CST - && contains_placeholder_p (gnu_size)) - gnu_size = build (WITH_RECORD_EXPR, bitsizetype, - gnu_size, gnu_expr); - } + if (CONTAINS_PLACEHOLDER_P (gnu_size)) + gnu_size = build (WITH_RECORD_EXPR, bitsizetype, + gnu_size, gnu_expr); } /* We may have no GNU_EXPR because No_Initialization is @@ -603,14 +607,20 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) gnu_size = max_size (TYPE_SIZE (gnu_type), 1); } - /* If the size is zero bytes, make it one byte since some linkers - have trouble with zero-sized objects. But if this will have a - template, that will make it nonzero. */ + /* If the size is zero bytes, make it one byte since some linkers have + trouble with zero-sized objects. If the object will have a + template, that will make it nonzero so don't bother. Also avoid + doing that for an object renaming or an object with an address + clause, as we would lose useful information on the view size + (e.g. for null array slices) and we are not allocating the object + here anyway. */ if (((gnu_size != 0 && integer_zerop (gnu_size)) || (TYPE_SIZE (gnu_type) != 0 && integer_zerop (TYPE_SIZE (gnu_type)))) && (! Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) - || ! Is_Array_Type (Etype (gnat_entity)))) + || ! Is_Array_Type (Etype (gnat_entity))) + && ! Present (Renamed_Object (gnat_entity)) + && ! Present (Address_Clause (gnat_entity))) gnu_size = bitsize_unit_node; /* If an alignment is specified, use it if valid. Note that @@ -644,25 +654,6 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) + 1)); } -#ifdef MINIMUM_ATOMIC_ALIGNMENT - /* If the size is a constant and no alignment is specified, force - the alignment to be the minimum valid atomic alignment. The - restriction on constant size avoids problems with variable-size - temporaries; if the size is variable, there's no issue with - atomic access. Also don't do this for a constant, since it isn't - necessary and can interfere with constant replacement. Finally, - do not do it for Out parameters since that creates an - size inconsistency with In parameters. */ - if (align == 0 && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type) - && ! FLOAT_TYPE_P (gnu_type) - && ! const_flag && No (Renamed_Object (gnat_entity)) - && ! imported_p && No (Address_Clause (gnat_entity)) - && kind != E_Out_Parameter - && (gnu_size != 0 ? TREE_CODE (gnu_size) == INTEGER_CST - : TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST)) - align = MINIMUM_ATOMIC_ALIGNMENT; -#endif - /* If the object is set to have atomic components, find the component type and validate it. @@ -691,22 +682,6 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) if (Is_Atomic (gnat_entity)) check_ok_for_atomic (gnu_type, gnat_entity, 0); - /* Make a new type with the desired size and alignment, if needed. */ - gnu_type = maybe_pad_type (gnu_type, gnu_size, align, - gnat_entity, "PAD", 0, definition, 1); - - /* Make a volatile version of this object's type if we are to - make the object volatile. Note that 13.3(19) says that we - should treat other types of objects as volatile as well. */ - if ((Is_Volatile (gnat_entity) - || Is_Exported (gnat_entity) - || Is_Imported (gnat_entity) - || Present (Address_Clause (gnat_entity))) - && ! TYPE_VOLATILE (gnu_type)) - gnu_type = build_qualified_type (gnu_type, - (TYPE_QUALS (gnu_type) - | TYPE_QUAL_VOLATILE)); - /* If this is an aliased object with an unconstrained nominal subtype, make a type that includes the template. */ if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity)) @@ -724,6 +699,41 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) "UNC")); } +#ifdef MINIMUM_ATOMIC_ALIGNMENT + /* If the size is a constant and no alignment is specified, force + the alignment to be the minimum valid atomic alignment. The + restriction on constant size avoids problems with variable-size + temporaries; if the size is variable, there's no issue with + atomic access. Also don't do this for a constant, since it isn't + necessary and can interfere with constant replacement. Finally, + do not do it for Out parameters since that creates an + size inconsistency with In parameters. */ + if (align == 0 && MINIMUM_ATOMIC_ALIGNMENT > TYPE_ALIGN (gnu_type) + && ! FLOAT_TYPE_P (gnu_type) + && ! const_flag && No (Renamed_Object (gnat_entity)) + && ! imported_p && No (Address_Clause (gnat_entity)) + && kind != E_Out_Parameter + && (gnu_size != 0 ? TREE_CODE (gnu_size) == INTEGER_CST + : TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST)) + align = MINIMUM_ATOMIC_ALIGNMENT; +#endif + + /* Make a new type with the desired size and alignment, if needed. */ + gnu_type = maybe_pad_type (gnu_type, gnu_size, align, + gnat_entity, "PAD", 0, definition, 1); + + /* Make a volatile version of this object's type if we are to + make the object volatile. Note that 13.3(19) says that we + should treat other types of objects as volatile as well. */ + if ((Treat_As_Volatile (gnat_entity) + || Is_Exported (gnat_entity) + || Is_Imported (gnat_entity) + || Present (Address_Clause (gnat_entity))) + && ! TYPE_VOLATILE (gnu_type)) + gnu_type = build_qualified_type (gnu_type, + (TYPE_QUALS (gnu_type) + | TYPE_QUAL_VOLATILE)); + /* Convert the expression to the type of the object except in the case where the object's type is unconstrained or the object's type is a padded record whose field is of self-referential size. In @@ -732,11 +742,10 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) want to only copy the actual data. */ if (gnu_expr != 0 && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE - && ! (TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE (gnu_type))) + && ! CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) && ! (TREE_CODE (gnu_type) == RECORD_TYPE && TYPE_IS_PADDING_P (gnu_type) - && (contains_placeholder_p + && (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))) gnu_expr = convert (gnu_type, gnu_expr); @@ -809,23 +818,38 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) been converted to the right type, but we need to create the template if there is no initializer. */ else if (definition && TREE_CODE (gnu_type) == RECORD_TYPE - && TYPE_CONTAINS_TEMPLATE_P (gnu_type) + && (TYPE_CONTAINS_TEMPLATE_P (gnu_type) + /* Beware that padding might have been introduced + via maybe_pad_type above. */ + || (TYPE_IS_PADDING_P (gnu_type) + && TREE_CODE (TREE_TYPE (TYPE_FIELDS (gnu_type))) + == RECORD_TYPE + && TYPE_CONTAINS_TEMPLATE_P + (TREE_TYPE (TYPE_FIELDS (gnu_type))))) && gnu_expr == 0) - gnu_expr - = gnat_build_constructor + { + tree template_field + = TYPE_IS_PADDING_P (gnu_type) + ? TYPE_FIELDS (TREE_TYPE (TYPE_FIELDS (gnu_type))) + : TYPE_FIELDS (gnu_type); + + gnu_expr + = gnat_build_constructor (gnu_type, tree_cons - (TYPE_FIELDS (gnu_type), - build_template - (TREE_TYPE (TYPE_FIELDS (gnu_type)), - TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))), - NULL_TREE), + (template_field, + build_template (TREE_TYPE (template_field), + TREE_TYPE (TREE_CHAIN (template_field)), + NULL_TREE), NULL_TREE)); + } /* If this is a pointer and it does not have an initializing - expression, initialize it to NULL. */ + expression, initialize it to NULL, unless the obect is + imported. */ if (definition && (POINTER_TYPE_P (gnu_type) || TYPE_FAT_POINTER_P (gnu_type)) + && !Is_Imported (gnat_entity) && gnu_expr == 0) gnu_expr = integer_zero_node; @@ -932,7 +956,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) gnat_entity); gnu_expr = build_allocator (gnu_alloc_type, gnu_expr, - gnu_type, 0, 0); + gnu_type, 0, 0, gnat_entity); } else { @@ -955,17 +979,20 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) TYPE_SIZE_UNIT (gnu_type)); tree gnu_new_var; - if (gnu_expr != 0) - gnu_expr - = gnat_build_constructor (gnu_new_type, - tree_cons (TYPE_FIELDS (gnu_new_type), - gnu_expr, NULL_TREE)); set_lineno (gnat_entity, 1); gnu_new_var = create_var_decl (create_concat_name (gnat_entity, "ALIGN"), NULL_TREE, gnu_new_type, gnu_expr, 0, 0, 0, 0, 0); + if (gnu_expr != 0) + expand_expr_stmt + (build_binary_op + (MODIFY_EXPR, NULL_TREE, + build_component_ref (gnu_new_var, NULL_TREE, + TYPE_FIELDS (gnu_new_type)), + gnu_expr)); + gnu_type = build_reference_type (gnu_type); gnu_expr = build_unary_op @@ -986,11 +1013,10 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) want to only copy the actual data. */ if (gnu_expr != 0 && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE - && ! (TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE (gnu_type))) + && ! CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) && ! (TREE_CODE (gnu_type) == RECORD_TYPE && TYPE_IS_PADDING_P (gnu_type) - && (contains_placeholder_p + && (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type))))))) gnu_expr = convert (gnu_type, gnu_expr); @@ -1046,7 +1072,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) || Address_Taken (gnat_entity) || Is_Aliased (gnat_entity) || Is_Aliased (Etype (gnat_entity)))) - SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, + SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type, gnu_expr, 0, Is_Public (gnat_entity), 0, static_p, 0)); @@ -1250,7 +1276,6 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) gnu_type = make_node (INTEGER_TYPE); if (Is_Packed_Array_Type (gnat_entity)) { - esize = UI_To_Int (RM_Size (gnat_entity)); TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1; } @@ -1322,7 +1347,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) { gnu_type = make_signed_type (esize); TYPE_VAX_FLOATING_POINT_P (gnu_type) = 1; - SET_TYPE_DIGITS_VALUE (gnu_type, + SET_TYPE_DIGITS_VALUE (gnu_type, UI_To_Int (Digits_Value (gnat_entity))); break; } @@ -1561,8 +1586,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* If the component type is a RECORD_TYPE that has a self-referential size, use the maxium size. */ if (gnu_comp_size == 0 && TREE_CODE (tem) == RECORD_TYPE - && TREE_CODE (TYPE_SIZE (tem)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE (tem))) + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (tem))) gnu_comp_size = max_size (TYPE_SIZE (tem), 1); if (! Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size != 0) @@ -1594,8 +1618,14 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) { tem = build_array_type (tem, gnu_index_types[index]); TYPE_MULTI_ARRAY_P (tem) = (index > 0); + + /* ??? For now, we say that any component of aggregate type is + addressable because the front end may take 'Reference of it. + But we have to make it addressable if it must be passed by + reference or it that is the default. */ TYPE_NONALIASED_COMPONENT (tem) - = ! Has_Aliased_Components (gnat_entity); + = (! Has_Aliased_Components (gnat_entity) + && ! AGGREGATE_TYPE_P (TREE_TYPE (tem))); } /* If an alignment is specified, use it if valid. But ignore it for @@ -1805,15 +1835,13 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) if ((TREE_CODE (gnu_min) == INTEGER_CST && ! TREE_OVERFLOW (gnu_min) && ! operand_equal_p (gnu_min, gnu_base_base_min, 0)) - || (TREE_CODE (gnu_min) != INTEGER_CST - && ! contains_placeholder_p (gnu_min))) + || ! CONTAINS_PLACEHOLDER_P (gnu_min)) gnu_base_min = gnu_min; if ((TREE_CODE (gnu_max) == INTEGER_CST && ! TREE_OVERFLOW (gnu_max) && ! operand_equal_p (gnu_max, gnu_base_base_max, 0)) - || (TREE_CODE (gnu_max) != INTEGER_CST - && ! contains_placeholder_p (gnu_max))) + || ! CONTAINS_PLACEHOLDER_P (gnu_max)) gnu_base_max = gnu_max; if ((TREE_CODE (gnu_base_min) == INTEGER_CST @@ -1879,8 +1907,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* If the component type is a RECORD_TYPE that has a self-referential size, use the maxium size. */ if (gnu_comp_size == 0 && TREE_CODE (gnu_type) == RECORD_TYPE - && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE (gnu_type))) + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) gnu_comp_size = max_size (TYPE_SIZE (gnu_type), 1); if (! Is_Bit_Packed_Array (gnat_entity) && gnu_comp_size != 0) @@ -1911,8 +1938,13 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) { gnu_type = build_array_type (gnu_type, gnu_index_type[index]); TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0); + /* ??? For now, we say that any component of aggregate type is + addressable because the front end may take 'Reference. + But we have to make it addressable if it must be passed by + reference or it that is the default. */ TYPE_NONALIASED_COMPONENT (gnu_type) - = ! Has_Aliased_Components (gnat_entity); + = (! Has_Aliased_Components (gnat_entity) + && ! AGGREGATE_TYPE_P (TREE_TYPE (gnu_type))); } /* If we are at file level and this is a multi-dimensional array, we @@ -1975,8 +2007,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* If our size depends on a placeholder and the maximum size doesn't overflow, use it. */ - if (TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE (gnu_type)) + if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) && ! (TREE_CODE (gnu_max_size) == INTEGER_CST && TREE_OVERFLOW (gnu_max_size)) && ! (TREE_CODE (gnu_max_size_unit) == INTEGER_CST @@ -2009,7 +2040,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type) | (TYPE_QUAL_VOLATILE - * Is_Volatile (gnat_entity)))); + * Treat_As_Volatile (gnat_entity)))); set_lineno (gnat_entity, 0); gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, ! Comes_From_Source (gnat_entity), @@ -2104,7 +2135,8 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) tree gnu_string_array_type = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_string_type)))); tree gnu_string_index_type - = TREE_TYPE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_string_array_type))); + = get_base_type (TREE_TYPE (TYPE_INDEX_TYPE + (TYPE_DOMAIN (gnu_string_array_type)))); tree gnu_lower_bound = convert (gnu_string_index_type, gnat_to_gnu (String_Literal_Low_Bound (gnat_entity))); @@ -2167,7 +2199,6 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) (Type_Definition (Declaration_Node (gnat_entity))))))))); - break; } @@ -2212,10 +2243,23 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* Make a node for the record. If we are not defining the record, suppress expanding incomplete types and save the node as the type - for GNAT_ENTITY. We use the same RECORD_TYPE as was made - for a dummy type and then show it's no longer a dummy. */ + for GNAT_ENTITY. We use the same RECORD_TYPE as for a dummy type + and reset TYPE_DUMMY_P to show it's no longer a dummy. + + It is very tempting to delay resetting this bit until we are done + with completing the type, e.g. to let possible intermediate + elaboration of access types designating the record know it is not + complete and arrange for update_pointer_to to fix things up later. + + It would be wrong, however, because dummy types are expected only + to be created for Ada incomplete or private types, which is not + what we have here. Doing so would make other parts of gigi think + we are dealing with a really incomplete or private type, and have + nasty side effects, typically on the generation of the associated + debugging information. */ gnu_type = make_dummy_type (gnat_entity); TYPE_DUMMY_P (gnu_type) = 0; + if (TREE_CODE (TYPE_NAME (gnu_type)) == TYPE_DECL && debug_info_p) DECL_IGNORED_P (TYPE_NAME (gnu_type)) = 0; @@ -2242,13 +2286,15 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* Always set the alignment here so that it can be used to set the mode, if it is making the alignment stricter. If it is invalid, it will be checked again below. If this is to - be Atomic, choose a default alignment of a word. */ - + be Atomic, choose a default alignment of a word unless we know + the size and it's smaller. */ if (Known_Alignment (gnat_entity)) TYPE_ALIGN (gnu_type) = validate_alignment (Alignment (gnat_entity), gnat_entity, 0); else if (Is_Atomic (gnat_entity)) - TYPE_ALIGN (gnu_type) = BITS_PER_WORD; + TYPE_ALIGN (gnu_type) + = (esize >= BITS_PER_WORD ? BITS_PER_WORD + : 1 << ((floor_log2 (esize) - 1) + 1)); /* If we have a Parent_Subtype, make a field for the parent. If this record has rep clauses, force the position to zero. */ @@ -2270,9 +2316,9 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) NULL_TREE)); if (Has_Discriminants (gnat_entity)) - for (gnat_field = First_Girder_Discriminant (gnat_entity); + for (gnat_field = First_Stored_Discriminant (gnat_entity); Present (gnat_field); - gnat_field = Next_Girder_Discriminant (gnat_field)) + gnat_field = Next_Stored_Discriminant (gnat_field)) if (Present (Corresponding_Discriminant (gnat_field))) save_gnu_tree (gnat_field, @@ -2301,9 +2347,9 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* Add the fields for the discriminants into the record. */ if (! Is_Unchecked_Union (gnat_entity) && Has_Discriminants (gnat_entity)) - for (gnat_field = First_Girder_Discriminant (gnat_entity); + for (gnat_field = First_Stored_Discriminant (gnat_entity); Present (gnat_field); - gnat_field = Next_Girder_Discriminant (gnat_field)) + gnat_field = Next_Stored_Discriminant (gnat_field)) { /* If this is a record extension and this discriminant is the renaming of another discriminant, we've already @@ -2340,8 +2386,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) gnu_field_list, packed, definition, 0, 0, all_rep); - TYPE_DUMMY_P (gnu_type) = 0; - TYPE_VOLATILE (gnu_type) = Is_Volatile (gnat_entity); + TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity); TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_entity); /* If this is an extension type, reset the tree for any @@ -2349,9 +2394,9 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) for non-inherited discriminants. */ if (! Is_Unchecked_Union (gnat_entity) && Has_Discriminants (gnat_entity)) - for (gnat_field = First_Girder_Discriminant (gnat_entity); + for (gnat_field = First_Stored_Discriminant (gnat_entity); Present (gnat_field); - gnat_field = Next_Girder_Discriminant (gnat_field)) + gnat_field = Next_Stored_Discriminant (gnat_field)) { if (Present (Parent_Subtype (gnat_entity)) && Present (Corresponding_Discriminant (gnat_field))) @@ -2367,10 +2412,21 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* If it is a tagged record force the type to BLKmode to insure that these objects will always be placed in memory. Do the same thing for limited record types. */ - if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity)) TYPE_MODE (gnu_type) = BLKmode; + /* If this is a derived type, we must make the alias set of this type + the same as that of the type we are derived from. We assume here + that the other type is already frozen. */ + if (Etype (gnat_entity) != gnat_entity + && ! (Is_Private_Type (Etype (gnat_entity)) + && Full_View (Etype (gnat_entity)) == gnat_entity)) + { + TYPE_ALIAS_SET (gnu_type) + = get_alias_set (gnat_to_gnu_type (Etype (gnat_entity))); + record_component_aliases (gnu_type); + } + /* Fill in locations of fields. */ annotate_rep (gnat_entity, gnu_type); @@ -2394,7 +2450,8 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) if (Present (Equivalent_Type (gnat_entity))) { - gnu_type = gnat_to_gnu_type (Equivalent_Type (gnat_entity)); + gnu_decl = gnat_to_gnu_entity (Equivalent_Type (gnat_entity), + NULL_TREE, 0); maybe_present = 1; break; } @@ -2460,7 +2517,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) && ! Is_For_Access_Subtype (gnat_entity) && ! Is_Unchecked_Union (gnat_base_type) && Is_Constrained (gnat_entity) - && Girder_Constraint (gnat_entity) != No_Elist + && Stored_Constraint (gnat_entity) != No_Elist && Present (Discriminant_Constraint (gnat_entity))) { Entity_Id gnat_field; @@ -2543,8 +2600,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) gnu_field_type = make_packable_type (gnu_field_type); } - if (TREE_CODE (gnu_pos) != INTEGER_CST - && contains_placeholder_p (gnu_pos)) + if (CONTAINS_PLACEHOLDER_P (gnu_pos)) for (gnu_temp = gnu_subst_list; gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp)) gnu_pos = substitute_in_expr (gnu_pos, @@ -2581,7 +2637,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) = DECL_INTERNAL_P (gnu_old_field); SET_DECL_ORIGINAL_FIELD (gnu_field, (DECL_ORIGINAL_FIELD (gnu_old_field) != 0 - ? DECL_ORIGINAL_FIELD (gnu_old_field) + ? DECL_ORIGINAL_FIELD (gnu_old_field) : gnu_old_field)); DECL_DISCRIMINANT_NUMBER (gnu_field) = DECL_DISCRIMINANT_NUMBER (gnu_old_field); @@ -2597,14 +2653,14 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* Now set the size, alignment and alias set of the new type to match that of the old one, doing any substitutions, as above. */ - TYPE_ALIAS_SET (gnu_type) = get_alias_set (gnu_base_type); TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type); TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_base_type); TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type); SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type)); + TYPE_ALIAS_SET (gnu_type) = get_alias_set (gnu_base_type); + record_component_aliases (gnu_type); - if (TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE (gnu_type))) + if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) for (gnu_temp = gnu_subst_list; gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp)) TYPE_SIZE (gnu_type) @@ -2612,8 +2668,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) TREE_PURPOSE (gnu_temp), TREE_VALUE (gnu_temp)); - if (TREE_CODE (TYPE_SIZE_UNIT (gnu_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE_UNIT (gnu_type))) + if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (gnu_type))) for (gnu_temp = gnu_subst_list; gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp)) TYPE_SIZE_UNIT (gnu_type) @@ -2622,8 +2677,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) TREE_VALUE (gnu_temp)); if (TYPE_ADA_SIZE (gnu_type) != 0 - && TREE_CODE (TYPE_ADA_SIZE (gnu_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_ADA_SIZE (gnu_type))) + && CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type))) for (gnu_temp = gnu_subst_list; gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp)) SET_TYPE_ADA_SIZE (gnu_type, @@ -2663,7 +2717,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) 0, 0); } - TYPE_VOLATILE (gnu_type) = Is_Volatile (gnat_entity); + TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity); TYPE_NAME (gnu_type) = gnu_entity_id; TYPE_STUB_DECL (gnu_type) = pushdecl (build_decl (TYPE_DECL, TYPE_NAME (gnu_type), @@ -2897,17 +2951,43 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) break; } - /* If we have a GCC type for the designated type, possibly - modify it if we are pointing only to constant objects and then - make a pointer to it. Don't do this for unconstrained arrays. */ + /* If we have a GCC type for the designated type, possibly modify it + if we are pointing only to constant objects and then make a pointer + to it. Don't do this for unconstrained arrays. */ if (gnu_type == 0 && gnu_desig_type != 0) { if (Is_Access_Constant (gnat_entity) && TREE_CODE (gnu_desig_type) != UNCONSTRAINED_ARRAY_TYPE) - gnu_desig_type - = build_qualified_type (gnu_desig_type, - (TYPE_QUALS (gnu_desig_type) - | TYPE_QUAL_CONST)); + { + gnu_desig_type + = build_qualified_type + (gnu_desig_type, + TYPE_QUALS (gnu_desig_type) | TYPE_QUAL_CONST); + + /* Some extra processing is required if we are building a + pointer to an incomplete type (in the GCC sense). We might + have such a type if we just made a dummy, or directly out + of the call to gnat_to_gnu_type above if we are processing + an access type for a record component designating the + record type itself. */ + if (! COMPLETE_TYPE_P (gnu_desig_type)) + { + /* We must ensure that the pointer to variant we make will + be processed by update_pointer_to when the initial type + is completed. Pretend we made a dummy and let further + processing act as usual. */ + made_dummy = 1; + + /* We must ensure that update_pointer_to will not retrieve + the dummy variant when building a properly qualified + version of the complete type. We take advantage of the + fact that get_qualified_type is requiring TYPE_NAMEs to + match to influence build_qualified_type and then also + update_pointer_to here. */ + TYPE_NAME (gnu_desig_type) + = create_concat_name (gnat_desig_type, "INCOMPLETE_CST"); + } + } gnu_type = build_pointer_type (gnu_desig_type); } @@ -2938,8 +3018,22 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) this_made_decl = saved = 1; if (defer_incomplete_level == 0) - update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type), - gnat_to_gnu_type (gnat_desig_type)); + { + update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type), + gnat_to_gnu_type (gnat_desig_type)); + /* Note that the call to gnat_to_gnu_type here might have + updated gnu_old_type directly, in which case it is not a + dummy type any more when we get into update_pointer_to. + + This may happen for instance when the designated type is a + record type, because their elaboration starts with an + initial node from make_dummy_type, which may yield the same + node as the one we got. + + Besides, variants of this non-dummy type might have been + created along the way. update_pointer_to is expected to + properly take care of those situations. */ + } else { struct incomplete *p @@ -3006,6 +3100,10 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) p->next = defer_incomplete_list; defer_incomplete_list = p; } + else if + (IN (Ekind (Base_Type (Directly_Designated_Type (gnat_entity))), + Incomplete_Or_Private_Kind)) + { ;} else gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity), NULL_TREE, 0); @@ -3091,7 +3189,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) int volatile_flag = No_Return (gnat_entity); int returns_by_ref = 0; int returns_unconstrained = 0; - tree gnu_ext_name = NULL_TREE; + tree gnu_ext_name = create_concat_name (gnat_entity, 0); int has_copy_in_out = 0; int parmnum; @@ -3130,10 +3228,19 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) if (Returns_By_Ref (gnat_entity)) { returns_by_ref = 1; - gnu_return_type = build_pointer_type (gnu_return_type); } + /* If the Mechanism is By_Reference, ensure the return type uses + the machine's by-reference mechanism, which may not the same + as above (e.g., it might be by passing a fake parameter). */ + else if (kind == E_Function + && Mechanism (gnat_entity) == By_Reference) + { + gnu_return_type = copy_type (gnu_return_type); + TREE_ADDRESSABLE (gnu_return_type) = 1; + } + /* If we are supposed to return an unconstrained array, actually return a fat pointer and make a note of that. Return a pointer to an unconstrained record of variable size. */ @@ -3143,9 +3250,9 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) returns_unconstrained = 1; } - /* If the type requires a transient scope, the result is allocated - on the secondary stack, so the result type of the function is - just a pointer. */ + /* If the type requires a transient scope, the result is allocated + on the secondary stack, so the result type of the function is + just a pointer. */ else if (Requires_Transient_Scope (Etype (gnat_entity))) { gnu_return_type = build_pointer_type (gnu_return_type); @@ -3223,8 +3330,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) if (Ekind (gnat_param) == E_In_Parameter && TREE_CODE (gnu_param_type) != UNCONSTRAINED_ARRAY_TYPE && ! (TYPE_SIZE (gnu_param_type) != 0 - && TREE_CODE (TYPE_SIZE (gnu_param_type)) != INTEGER_CST - && contains_placeholder_p (TYPE_SIZE (gnu_param_type)))) + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_param_type)))) gnu_param_type = build_qualified_type (gnu_param_type, (TYPE_QUALS (gnu_param_type) @@ -3283,7 +3389,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) or aggregates by reference. For COBOL and Fortran, pass all integer and FP types that way too. For Convention Ada, use the standard Ada default. */ - else if (must_pass_by_ref (gnu_param_type) || req_by_ref + else if (must_pass_by_ref (gnu_param_type) || req_by_ref || (! req_by_copy && ((Has_Foreign_Convention (gnat_entity) && (Ekind (gnat_param) != E_In_Parameter @@ -3303,7 +3409,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) by_ref_p = 1; } - else if (Ekind (gnat_param) != E_In_Parameter) + else if (Ekind (gnat_param) != E_In_Parameter) copy_in_copy_out_flag = 1; if (req_by_copy && (by_ref_p || by_component_ptr_p)) @@ -3313,12 +3419,30 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) and isn't a pointer or aggregate, we don't make a PARM_DECL for it. Instead, it will be a VAR_DECL created when we process the procedure. For the special parameter of Valued_Procedure, - never pass it in. */ + never pass it in. + + An exception is made to cover the RM-6.4.1 rule requiring "by + copy" out parameters with discriminants or implicit initial + values to be handled like in out parameters. These type are + normally built as aggregates, and hence passed by reference, + except for some packed arrays which end up encoded in special + integer types. + + The exception we need to make is then for packed arrays of + records with discriminants or implicit initial values. We have + no light/easy way to check for the latter case, so we merely + check for packed arrays of records. This may lead to useless + copy-in operations, but in very rare cases only, as these would + be exceptions in a set of already exceptional situations. */ if (Ekind (gnat_param) == E_Out_Parameter && ! by_ref_p && ((Is_Valued_Procedure (gnat_entity) && parmnum == 0) || (! by_descr_p && ! POINTER_TYPE_P (gnu_param_type) - && ! AGGREGATE_TYPE_P (gnu_param_type)))) + && ! AGGREGATE_TYPE_P (gnu_param_type))) + && ! (Is_Array_Type (Etype (gnat_param)) + && Is_Packed (Etype (gnat_param)) + && Is_Composite_Type (Component_Type + (Etype (gnat_param))))) gnu_param = 0; else { @@ -3348,7 +3472,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) pure_flag = 0; } - if (copy_in_copy_out_flag) + if (copy_in_copy_out_flag) { if (! has_copy_in_out) { @@ -3370,8 +3494,8 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) } } - /* Do not compute record for out parameters if subprogram is - stubbed since structures are incomplete for the back-end. */ + /* Do not compute record for out parameters if subprogram is + stubbed since structures are incomplete for the back-end. */ if (gnu_field_list != 0 && Convention (gnat_entity) != Convention_Stubbed) finish_record_type (gnu_return_type, nreverse (gnu_field_list), @@ -3383,6 +3507,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) if (list_length (gnu_return_list) == 1) gnu_return_type = TREE_TYPE (TREE_PURPOSE (gnu_return_list)); +#ifdef _WIN32 if (Convention (gnat_entity) == Convention_Stdcall) { struct attrib *attr @@ -3395,6 +3520,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) attr->error_point = gnat_entity; attr_list = attr; } +#endif /* Both lists ware built in reverse. */ gnu_param_list = nreverse (gnu_param_list); @@ -3416,33 +3542,14 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) | (TYPE_QUAL_CONST * pure_flag) | (TYPE_QUAL_VOLATILE * volatile_flag))); - /* Top-level or external functions need to have an assembler name. - This is passed to create_subprog_decl through the ext_name argument. - For Pragma Interface subprograms with no Pragma Interface_Name, the - simple name already in entity_name is correct, and this is what is - gotten when ext_name is NULL. If Interface_Name is specified, then - the name is extracted from the N_String_Literal node containing the - string specified in the Pragma. If there is no Pragma Interface, - then the Ada fully qualified name is created. */ - - if (Present (Interface_Name (gnat_entity)) - || ! (Is_Imported (gnat_entity) || Is_Exported (gnat_entity))) - { - gnu_ext_name = create_concat_name (gnat_entity, 0); - - /* If there wasn't a specified Interface_Name, use this for the - main name of the entity. This will cause GCC to allow - qualification of a nested subprogram with a unique ID. We - need this in case there is an overloaded subprogram somewhere - up the scope chain. - - ??? This may be a kludge. */ - if (No (Interface_Name (gnat_entity))) - gnu_entity_id = gnu_ext_name; - } - set_lineno (gnat_entity, 0); + /* If there was no specified Interface_Name and the external and + internal names of the subprogram are the same, only use the + internal name to allow disambiguation of nested subprograms. */ + if (No (Interface_Name (gnat_entity)) && gnu_ext_name == gnu_entity_id) + gnu_ext_name = 0; + /* If we are defining the subprogram and it has an Address clause we must get the address expression from the saved GCC tree for the subprogram if it has a Freeze_Node. Otherwise, we elaborate @@ -3473,11 +3580,11 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) DECL_BY_REF_P (gnu_decl) = 1; } - else if (kind == E_Subprogram_Type) - gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, + else if (kind == E_Subprogram_Type) + gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, ! Comes_From_Source (gnat_entity), debug_info_p); - else + else { gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name, gnu_type, gnu_param_list, @@ -3601,7 +3708,8 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) if ((gnu_decl == 0 || this_made_decl) && IN (kind, Type_Kind)) { - if (Is_Tagged_Type (gnat_entity)) + if (Is_Tagged_Type (gnat_entity) + || Is_Class_Wide_Equivalent_Type (gnat_entity)) TYPE_ALIGN_OK (gnu_type) = 1; if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity)) @@ -3667,8 +3775,8 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) Handle both the RM size and the actual size. */ if (global_bindings_p () && TYPE_SIZE (gnu_type) != 0 - && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST - && ! contains_placeholder_p (TYPE_SIZE (gnu_type))) + && ! TREE_CONSTANT (TYPE_SIZE (gnu_type)) + && ! CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) { if (TREE_CODE (gnu_type) == RECORD_TYPE && operand_equal_p (TYPE_ADA_SIZE (gnu_type), @@ -3726,16 +3834,15 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) /* ??? Unfortunately, GCC needs to be able to prove the alignment of this offset and if it's a variable, it can't. - In GCC 3.2, we'll use DECL_OFFSET_ALIGN in some way, but + In GCC 3.4, we'll use DECL_OFFSET_ALIGN in some way, but right now, we have to put in an explicit multiply and divide by that value. */ - if (TREE_CODE (DECL_FIELD_OFFSET (gnu_field)) != INTEGER_CST - && ! contains_placeholder_p (DECL_FIELD_OFFSET (gnu_field))) + if (! CONTAINS_PLACEHOLDER_P (DECL_FIELD_OFFSET (gnu_field))) DECL_FIELD_OFFSET (gnu_field) = build_binary_op (MULT_EXPR, sizetype, elaborate_expression_1 - (gnat_temp, gnat_temp, + (gnat_temp, gnat_temp, build_binary_op (EXACT_DIV_EXPR, sizetype, DECL_FIELD_OFFSET (gnu_field), size_int (DECL_OFFSET_ALIGN (gnu_field) @@ -3748,7 +3855,7 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type) | (TYPE_QUAL_VOLATILE - * Is_Volatile (gnat_entity)))); + * Treat_As_Volatile (gnat_entity)))); if (Is_Atomic (gnat_entity)) check_ok_for_atomic (gnu_type, gnat_entity, 0); @@ -3783,10 +3890,36 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) value of that size. */ tree gnu_size = TYPE_SIZE (gnu_type); - if (contains_placeholder_p (gnu_size)) + if (CONTAINS_PLACEHOLDER_P (gnu_size)) gnu_size = max_size (gnu_size, 1); Set_Esize (gnat_entity, annotate_value (gnu_size)); + + if (type_annotate_only && Is_Tagged_Type (gnat_entity)) + { + /* In this mode the tag and the parent components are not + generated by the front-end, so the sizes must be adjusted + explicitly now. */ + + int size_offset; + int new_size; + + if (Is_Derived_Type (gnat_entity)) + { + size_offset + = UI_To_Int (Esize (Etype (Base_Type (gnat_entity)))); + Set_Alignment (gnat_entity, + Alignment (Etype (Base_Type (gnat_entity)))); + } + else + size_offset = POINTER_SIZE; + + new_size = UI_To_Int (Esize (gnat_entity)) + size_offset; + Set_Esize (gnat_entity, + UI_From_Int (((new_size + (POINTER_SIZE - 1)) + / POINTER_SIZE) * POINTER_SIZE)); + Set_RM_Size (gnat_entity, Esize (gnat_entity)); + } } if (Unknown_RM_Size (gnat_entity) && rm_size (gnu_type) != 0) @@ -4026,10 +4159,10 @@ substitution_list (gnat_subtype, gnat_type, gnu_list, definition) gnat_type = Implementation_Base_Type (gnat_subtype); if (Has_Discriminants (gnat_type)) - for (gnat_discrim = First_Girder_Discriminant (gnat_type), - gnat_value = First_Elmt (Girder_Constraint (gnat_subtype)); + for (gnat_discrim = First_Stored_Discriminant (gnat_type), + gnat_value = First_Elmt (Stored_Constraint (gnat_subtype)); Present (gnat_discrim); - gnat_discrim = Next_Girder_Discriminant (gnat_discrim), + gnat_discrim = Next_Stored_Discriminant (gnat_discrim), gnat_value = Next_Elmt (gnat_value)) /* Ignore access discriminants. */ if (! Is_Access_Type (Etype (Node (gnat_value)))) @@ -4117,6 +4250,8 @@ allocatable_size_p (gnu_size, static_p) tree gnu_size; int static_p; { + HOST_WIDE_INT our_size; + /* If this is not a static allocation, the only case we want to forbid is an overflowing size. That will be converted into a raise a Storage_Error. */ @@ -4125,8 +4260,13 @@ allocatable_size_p (gnu_size, static_p) && TREE_CONSTANT_OVERFLOW (gnu_size)); /* Otherwise, we need to deal with both variable sizes and constant - sizes that won't fit in a host int. */ - return host_integerp (gnu_size, 1); + sizes that won't fit in a host int. We use int instead of HOST_WIDE_INT + since assemblers may not like very large sizes. */ + if (!host_integerp (gnu_size, 1)) + return 0; + + our_size = tree_low_cst (gnu_size, 1); + return (int) our_size == our_size; } /* Return a list of attributes for GNAT_ENTITY, if any. */ @@ -4230,8 +4370,7 @@ maybe_variable (gnu_operand, gnat_node) /* If we will be generating code, make sure we are at the proper line number. */ - if (! global_bindings_p () && ! TREE_CONSTANT (gnu_operand) - && ! contains_placeholder_p (gnu_operand)) + if (! global_bindings_p () && ! CONTAINS_PLACEHOLDER_P (gnu_operand)) set_lineno (gnat_node, 1); if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF) @@ -4284,7 +4423,7 @@ elaborate_expression (gnat_expr, gnat_entity, gnu_name, definition, Since this is not a DECL, don't check it. If this is a constant, don't save it since GNAT_EXPR might be used more than once. Also, don't save if it's a discriminant. */ - if (! TREE_CONSTANT (gnu_expr) && ! contains_placeholder_p (gnu_expr)) + if (! CONTAINS_PLACEHOLDER_P (gnu_expr)) save_gnu_tree (gnat_expr, gnu_expr, 1); return need_value ? gnu_expr : error_mark_node; @@ -4333,14 +4472,14 @@ elaborate_expression_1 (gnat_expr, gnat_entity, gnu_expr, gnu_name, definition, expr_variable = (TREE_CODE_CLASS (TREE_CODE (gnu_expr)) != 'c' && ! (TREE_CODE (gnu_inner_expr) == VAR_DECL && TREE_READONLY (gnu_inner_expr)) - && ! contains_placeholder_p (gnu_expr)); + && ! CONTAINS_PLACEHOLDER_P (gnu_expr)); /* If this is a static expression or contains a discriminant, we don't need the variable for debugging (and can't elaborate anyway if a discriminant). */ if (need_debug && (Is_OK_Static_Expression (gnat_expr) - || contains_placeholder_p (gnu_expr))) + || CONTAINS_PLACEHOLDER_P (gnu_expr))) need_debug = 0; /* Now create the variable if we need it. */ @@ -4392,7 +4531,7 @@ make_aligning_type (type, align, size) pos = size_binop (MULT_EXPR, convert (bitsizetype, - size_binop (BIT_AND_EXPR, + size_binop (BIT_AND_EXPR, size_diffop (size_zero_node, size_addr_place), ssize_int ((align / BITS_PER_UNIT) @@ -4412,29 +4551,36 @@ make_aligning_type (type, align, size) bitsize_int (align)); TYPE_SIZE_UNIT (record_type) = size_binop (PLUS_EXPR, size, size_int (align / BITS_PER_UNIT)); - + TYPE_ALIAS_SET (record_type) = get_alias_set (type); return record_type; } -/* TYPE is a RECORD_TYPE with BLKmode that's being used as the field - type of a packed record. See if we can rewrite it as a record that has - a non-BLKmode type, which we can pack tighter. If so, return the - new type. If not, return the original type. */ +/* TYPE is a RECORD_TYPE, UNION_TYPE, or QUAL_UNION_TYPE, with BLKmode that's + being used as the field type of a packed record. See if we can rewrite it + as a record that has a non-BLKmode type, which we can pack tighter. If so, + return the new type. If not, return the original type. */ static tree make_packable_type (type) tree type; { - tree new_type = make_node (RECORD_TYPE); + tree new_type = make_node (TREE_CODE (type)); tree field_list = NULL_TREE; tree old_field; /* Copy the name and flags from the old type to that of the new and set - the alignment to try for an integral type. */ + the alignment to try for an integral type. For QUAL_UNION_TYPE, + also copy the size. */ TYPE_NAME (new_type) = TYPE_NAME (type); TYPE_LEFT_JUSTIFIED_MODULAR_P (new_type) = TYPE_LEFT_JUSTIFIED_MODULAR_P (type); TYPE_CONTAINS_TEMPLATE_P (new_type) = TYPE_CONTAINS_TEMPLATE_P (type); + TYPE_IS_PADDING_P (new_type) = TYPE_IS_PADDING_P (type); + if (TREE_CODE (type) == QUAL_UNION_TYPE) + { + TYPE_SIZE (new_type) = TYPE_SIZE (type); + TYPE_SIZE_UNIT (new_type) = TYPE_SIZE_UNIT (type); + } TYPE_ALIGN (new_type) = ((HOST_WIDE_INT) 1 @@ -4444,22 +4590,36 @@ make_packable_type (type) for (old_field = TYPE_FIELDS (type); old_field != 0; old_field = TREE_CHAIN (old_field)) { - tree new_field - = create_field_decl (DECL_NAME (old_field), TREE_TYPE (old_field), - new_type, TYPE_PACKED (type), - DECL_SIZE (old_field), - bit_position (old_field), - ! DECL_NONADDRESSABLE_P (old_field)); + tree new_field_type = TREE_TYPE (old_field); + tree new_field; + + if (TYPE_MODE (new_field_type) == BLKmode + && (TREE_CODE (new_field_type) == RECORD_TYPE + || TREE_CODE (new_field_type) == UNION_TYPE + || TREE_CODE (new_field_type) == QUAL_UNION_TYPE) + && host_integerp (TYPE_SIZE (new_field_type), 1)) + new_field_type = make_packable_type (new_field_type); + + new_field = create_field_decl (DECL_NAME (old_field), new_field_type, + new_type, TYPE_PACKED (type), + DECL_SIZE (old_field), + bit_position (old_field), + ! DECL_NONADDRESSABLE_P (old_field)); DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); SET_DECL_ORIGINAL_FIELD (new_field, (DECL_ORIGINAL_FIELD (old_field) != 0 ? DECL_ORIGINAL_FIELD (old_field) : old_field)); + + if (TREE_CODE (new_type) == QUAL_UNION_TYPE) + DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field); + TREE_CHAIN (new_field) = field_list; field_list = new_field; } finish_record_type (new_type, nreverse (field_list), 1, 1); + TYPE_ALIAS_SET (new_type) = get_alias_set (type); return TYPE_MODE (new_type) == BLKmode ? type : new_type; } @@ -4583,7 +4743,7 @@ maybe_pad_type (type, size, align, gnat_entity, name_trailer, TYPE_ALIGN (record) = align; TYPE_IS_PADDING_P (record) = 1; TYPE_VOLATILE (record) - = Present (gnat_entity) && Is_Volatile (gnat_entity); + = Present (gnat_entity) && Treat_As_Volatile (gnat_entity); finish_record_type (record, field, 1, 0); /* Keep the RM_Size of the padded record as that of the old record @@ -4620,8 +4780,7 @@ maybe_pad_type (type, size, align, gnat_entity, name_trailer, type = record; - if (TREE_CODE (orig_size) != INTEGER_CST - && contains_placeholder_p (orig_size)) + if (CONTAINS_PLACEHOLDER_P (orig_size)) orig_size = max_size (orig_size, 1); /* If the size was widened explicitly, maybe give a warning. */ @@ -4772,10 +4931,11 @@ gnat_to_gnu_field (gnat_field, gnu_record_type, packed, definition) tree gnu_field; int needs_strict_alignment = (Is_Aliased (gnat_field) || Strict_Alignment (Etype (gnat_field)) - || Is_Volatile (gnat_field)); + || Treat_As_Volatile (gnat_field)); - /* If this field requires strict alignment pretend it isn't packed. */ - if (needs_strict_alignment) + /* If this field requires strict alignment or contains an item of + variable sized, pretend it isn't packed. */ + if (needs_strict_alignment || is_variable_size (gnu_field_type)) packed = 0; /* For packed records, this is one of the few occasions on which we use @@ -4818,6 +4978,11 @@ gnat_to_gnu_field (gnat_field, gnu_record_type, packed, definition) gnu_size = rm_size (gnu_field_type); } + /* 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 != 0) + gnu_size = round_up (gnu_size, BITS_PER_UNIT); + if (Present (Component_Clause (gnat_field))) { gnu_pos = UI_To_gnu (Component_Bit_Offset (gnat_field), bitsizetype); @@ -4877,7 +5042,7 @@ gnat_to_gnu_field (gnat_field, gnu_record_type, packed, definition) gnu_size = 0; } - if (! integer_zerop (size_binop + if (! integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos, bitsize_int (TYPE_ALIGN (gnu_field_type))))) { @@ -4887,7 +5052,7 @@ gnat_to_gnu_field (gnat_field, gnu_record_type, packed, definition) First_Bit (Component_Clause (gnat_field)), gnat_field, TYPE_ALIGN (gnu_field_type)); - else if (Is_Volatile (gnat_field)) + else if (Treat_As_Volatile (gnat_field)) post_error_ne_num ("position of volatile field& must be multiple of ^ bits", First_Bit (Component_Clause (gnat_field)), gnat_field, @@ -4913,22 +5078,15 @@ gnat_to_gnu_field (gnat_field, gnu_record_type, packed, definition) if (Is_Atomic (gnat_field)) check_ok_for_atomic (gnu_field_type, gnat_field, 0); - if (gnu_pos !=0 && TYPE_MODE (gnu_field_type) == BLKmode + if (gnu_pos != 0 && TYPE_MODE (gnu_field_type) == BLKmode && (! integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos, - bitsize_unit_node)))) + bitsize_unit_node))) + && TYPE_MODE (gnu_field_type) == BLKmode) { - /* Try to see if we can make this a packable type. If we - can, it's OK. */ - if (TREE_CODE (gnu_field_type) == RECORD_TYPE) - gnu_field_type = make_packable_type (gnu_field_type); - - if (TYPE_MODE (gnu_field_type) == BLKmode) - { - post_error_ne ("fields of& must start at storage unit boundary", - First_Bit (Component_Clause (gnat_field)), - Etype (gnat_field)); - gnu_pos = 0; - } + post_error_ne ("fields of& must start at storage unit boundary", + First_Bit (Component_Clause (gnat_field)), + Etype (gnat_field)); + gnu_pos = 0; } } @@ -4941,13 +5099,23 @@ gnat_to_gnu_field (gnat_field, gnu_record_type, packed, definition) gnu_size = TYPE_SIZE (gnu_field_type); } + /* If a size is specified and this is a BLKmode field, it must be an + integral number of bytes. */ + if (gnu_size != 0 && TYPE_MODE (gnu_field_type) == BLKmode + && ! integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_size, + bitsize_unit_node))) + { + post_error_ne ("size of fields of& must be multiple of a storage unit", + gnat_field, Etype (gnat_field)); + gnu_pos = gnu_size = 0; + } + /* 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 pack the field since we can't make a copy to align it. */ if (TREE_CODE (gnu_field_type) == RECORD_TYPE && gnu_size == 0 - && ! TREE_CONSTANT (TYPE_SIZE (gnu_field_type)) - && contains_placeholder_p (TYPE_SIZE (gnu_field_type)) + && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_field_type)) && ! Is_Constrained (Underlying_Type (Etype (gnat_field)))) { gnu_size = max_size (TYPE_SIZE (gnu_field_type), 1); @@ -4979,12 +5147,13 @@ gnat_to_gnu_field (gnat_field, gnu_record_type, packed, definition) && TYPE_CONTAINS_TEMPLATE_P (gnu_field_type)) gigi_abort (118); + /* Now create the decl for the field. */ set_lineno (gnat_field, 0); gnu_field = create_field_decl (gnu_field_id, gnu_field_type, gnu_record_type, packed, gnu_size, gnu_pos, Is_Aliased (gnat_field)); - TREE_THIS_VOLATILE (gnu_field) = Is_Volatile (gnat_field); + TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field); if (Ekind (gnat_field) == E_Discriminant) DECL_DISCRIMINANT_NUMBER (gnu_field) @@ -4993,6 +5162,36 @@ gnat_to_gnu_field (gnat_field, gnu_record_type, packed, definition) return gnu_field; } +/* Return 1 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. */ + +static int +is_variable_size (type) + tree type; +{ + tree field; + + /* We need not be concerned about this at all if we don't have + strict alignment. */ + if (! STRICT_ALIGNMENT) + return 0; + else if (! TREE_CONSTANT (TYPE_SIZE (type))) + return 1; + else if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type) + && ! TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type)))) + return 1; + else if (TREE_CODE (type) != RECORD_TYPE + && TREE_CODE (type) != UNION_TYPE + && TREE_CODE (type) != QUAL_UNION_TYPE) + return 0; + + for (field = TYPE_FIELDS (type); field != 0; field = TREE_CHAIN (field)) + if (is_variable_size (TREE_TYPE (field))) + return 1; + + return 0; +} + /* Return a GCC tree for a record type given a GNAT Component_List and a chain of GCC trees for fields that are in the record and have already been processed. When called from gnat_to_gnu_entity during the processing of a @@ -5041,6 +5240,7 @@ components_to_record (gnu_record_type, component_list, gnu_field_list, packed, tree gnu_our_rep_list = NULL_TREE; tree gnu_field, gnu_last; int layout_with_rep = 0; + int all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type) != 0; /* For each variable within each component declaration create a GCC field and add it to the list, skipping any pragmas in the list. */ @@ -5060,7 +5260,8 @@ components_to_record (gnu_record_type, component_list, gnu_field_list, packed, packed, definition); /* If this is the _Tag field, put it before any discriminants, - instead of after them as is the case for all other fields. */ + instead of after them as is the case for all other fields. + Ignore field of void type if only annotating. */ if (Chars (gnat_field) == Name_uTag) gnu_field_list = chainon (gnu_field_list, gnu_field); else @@ -5137,16 +5338,33 @@ components_to_record (gnu_record_type, component_list, gnu_field_list, packed, so the record actually gets only the alignment required. */ TYPE_ALIGN (gnu_variant_type) = TYPE_ALIGN (gnu_record_type); 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. */ + if (all_rep_and_size) + { + TYPE_SIZE (gnu_variant_type) = TYPE_SIZE (gnu_record_type); + TYPE_SIZE_UNIT (gnu_variant_type) + = TYPE_SIZE_UNIT (gnu_record_type); + } + components_to_record (gnu_variant_type, Component_List (variant), NULL_TREE, packed, definition, - &gnu_our_rep_list, 1, all_rep); + &gnu_our_rep_list, !all_rep_and_size, all_rep); gnu_qual = choices_to_gnu (gnu_discriminant, Discrete_Choices (variant)); Set_Present_Expr (variant, annotate_value (gnu_qual)); gnu_field = create_field_decl (gnu_inner_name, gnu_variant_type, - gnu_union_type, 0, 0, 0, 1); + gnu_union_type, 0, + (all_rep_and_size + ? TYPE_SIZE (gnu_record_type) : 0), + (all_rep_and_size + ? bitsize_zero_node : 0), + 1); + DECL_INTERNAL_P (gnu_field) = 1; DECL_QUALIFIER (gnu_field) = gnu_qual; TREE_CHAIN (gnu_field) = gnu_variant_list; @@ -5162,8 +5380,15 @@ components_to_record (gnu_record_type, component_list, gnu_field_list, packed, /* Only make the QUAL_UNION_TYPE if there are any non-empty variants. */ if (gnu_variant_list != 0) { + if (all_rep_and_size) + { + TYPE_SIZE (gnu_union_type) = TYPE_SIZE (gnu_record_type); + TYPE_SIZE_UNIT (gnu_union_type) + = TYPE_SIZE_UNIT (gnu_record_type); + } + finish_record_type (gnu_union_type, nreverse (gnu_variant_list), - 0, 0); + all_rep_and_size, 0); gnu_union_field = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type, @@ -5297,10 +5522,19 @@ annotate_value (gnu_size) { int len = TREE_CODE_LENGTH (TREE_CODE (gnu_size)); TCode tcode; - Node_Ref_Or_Val ops[3]; + Node_Ref_Or_Val ops[3], ret; int i; int size; + /* If back annotation is suppressed by the front end, return No_Uint */ + if (!Back_Annotate_Rep_Info) + return No_Uint; + + /* See if we've already saved the value for this node. */ + if (IS_EXPR_CODE_CLASS (TREE_CODE_CLASS (TREE_CODE (gnu_size))) + && TREE_COMPLEXITY (gnu_size) != 0) + return (Node_Ref_Or_Val) TREE_COMPLEXITY (gnu_size); + /* 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 the number of recursive calls for us to make. */ @@ -5412,7 +5646,9 @@ annotate_value (gnu_size) return No_Uint; } - return Create_Node (tcode, ops[0], ops[1], ops[2]); + ret = Create_Node (tcode, ops[0], ops[1], ops[2]); + TREE_COMPLEXITY (gnu_size) = ret; + return ret; } /* Given GNAT_ENTITY, a record type, and GNU_TYPE, its corresponding @@ -5439,20 +5675,55 @@ annotate_rep (gnat_entity, gnu_type) gnat_field = Next_Entity (gnat_field)) if ((Ekind (gnat_field) == E_Component || (Ekind (gnat_field) == E_Discriminant - && ! Is_Unchecked_Union (Scope (gnat_field)))) - && 0 != (gnu_entry = purpose_member (gnat_to_gnu_entity (gnat_field, - NULL_TREE, 0), - gnu_list))) + && ! Is_Unchecked_Union (Scope (gnat_field))))) { - Set_Component_Bit_Offset - (gnat_field, - annotate_value (bit_from_pos - (TREE_PURPOSE (TREE_VALUE (gnu_entry)), - TREE_VALUE (TREE_VALUE - (TREE_VALUE (gnu_entry)))))); - - Set_Esize (gnat_field, - annotate_value (DECL_SIZE (TREE_PURPOSE (gnu_entry)))); + tree parent_offset = bitsize_zero_node; + + gnu_entry + = purpose_member (gnat_to_gnu_entity (gnat_field, NULL_TREE, 0), + gnu_list); + + if (gnu_entry) + { + if (type_annotate_only && Is_Tagged_Type (gnat_entity)) + { + /* In this mode the tag and parent components have not been + generated, so we add the appropriate offset to each + component. For a component appearing in the current + extension, the offset is the size of the parent. */ + if (Is_Derived_Type (gnat_entity) + && Original_Record_Component (gnat_field) == gnat_field) + parent_offset + = UI_To_gnu (Esize (Etype (Base_Type (gnat_entity))), + bitsizetype); + else + parent_offset = bitsize_int (POINTER_SIZE); + } + + Set_Component_Bit_Offset + (gnat_field, + annotate_value + (size_binop (PLUS_EXPR, + bit_from_pos (TREE_PURPOSE (TREE_VALUE (gnu_entry)), + TREE_VALUE (TREE_VALUE + (TREE_VALUE (gnu_entry)))), + parent_offset))); + + Set_Esize (gnat_field, + annotate_value (DECL_SIZE (TREE_PURPOSE (gnu_entry)))); + } + else if (type_annotate_only + && Is_Tagged_Type (gnat_entity) + && Is_Derived_Type (gnat_entity)) + { + /* If there is no gnu_entry, this is an inherited component whose + position is the same as in the parent type. */ + Set_Component_Bit_Offset + (gnat_field, + Component_Bit_Offset (Original_Record_Component (gnat_field))); + Set_Esize (gnat_field, + Esize (Original_Record_Component (gnat_field))); + } } } @@ -5527,13 +5798,7 @@ validate_size (uint_size, gnu_type, gnat_object, kind, component_p, zero_ok) = kind == VAR_DECL ? TYPE_SIZE (gnu_type) : rm_size (gnu_type); tree size; - if (type_size != 0 && TREE_CODE (type_size) != INTEGER_CST - && contains_placeholder_p (type_size)) - type_size = max_size (type_size, 1); - - if (TYPE_FAT_POINTER_P (gnu_type)) - type_size = bitsize_int (POINTER_SIZE); - + /* Find the node to use for errors. */ if ((Ekind (gnat_object) == E_Component || Ekind (gnat_object) == E_Discriminant) && Present (Component_Clause (gnat_object))) @@ -5548,30 +5813,25 @@ validate_size (uint_size, gnu_type, gnat_object, kind, component_p, zero_ok) if (Is_Packed_Array_Type (gnat_object)) gnat_error_node = Empty; - /* Get the size as a tree. Return 0 if none was specified, either because - Esize was not Present or if the specified size was zero. Give an error - if a size was specified, but cannot be represented as in sizetype. If - the size is negative, it was a back-annotation of a variable size and - should be treated as not specified. */ + /* Return 0 if no size was specified, either because Esize was not Present or + the specified size was zero. */ if (No (uint_size) || uint_size == No_Uint) return 0; + /* Get the size as a tree. Give an error if a size was specified, but cannot + be represented as in sizetype. */ size = UI_To_gnu (uint_size, bitsizetype); if (TREE_OVERFLOW (size)) { - if (component_p) - post_error_ne ("component size of & is too large", - gnat_error_node, gnat_object); - else - post_error_ne ("size of & is too large", gnat_error_node, gnat_object); - + post_error_ne (component_p ? "component size of & is too large" + : "size of & is too large", + gnat_error_node, gnat_object); return 0; } - /* Ignore a negative size since that corresponds to our back-annotation. Also ignore a zero size unless a size clause exists. */ else if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && ! zero_ok)) - return 0; + return 0; /* The size of objects is always a multiple of a byte. */ if (kind == VAR_DECL @@ -5601,6 +5861,13 @@ validate_size (uint_size, gnu_type, gnat_object, kind, component_p, zero_ok) && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) size = size_binop (PLUS_EXPR, DECL_SIZE (TYPE_FIELDS (gnu_type)), size); + /* Modify the size of the type to be that of the maximum size if it has a + discriminant or the size of a thin pointer if this is a fat pointer. */ + if (type_size != 0 && CONTAINS_PLACEHOLDER_P (type_size)) + type_size = max_size (type_size, 1); + else if (TYPE_FAT_POINTER_P (gnu_type)) + type_size = bitsize_int (POINTER_SIZE); + /* If the size of the object is a constant, the new size must not be smaller. */ if (TREE_CODE (type_size) != INTEGER_CST @@ -5677,8 +5944,7 @@ set_rm_size (uint_size, gnu_type, gnat_entity) return; /* If the old size is self-referential, get the maximum size. */ - if (TREE_CODE (old_size) != INTEGER_CST - && contains_placeholder_p (old_size)) + if (CONTAINS_PLACEHOLDER_P (old_size)) old_size = max_size (old_size, 1); /* If the size of the object is a constant, the new size must not be @@ -5882,7 +6148,7 @@ check_ok_for_atomic (object, gnat_entity, comp_p) /* For the moment, also allow anything that has an alignment equal to its size and which is smaller than a word. */ - if (TREE_CODE (size) == INTEGER_CST + if (size != 0 && TREE_CODE (size) == INTEGER_CST && compare_tree_int (size, align) == 0 && align <= BITS_PER_WORD) return; @@ -5927,10 +6193,8 @@ gnat_substitute_in_type (t, f, r) case ENUMERAL_TYPE: case BOOLEAN_TYPE: case CHAR_TYPE: - if ((TREE_CODE (TYPE_MIN_VALUE (t)) != INTEGER_CST - && contains_placeholder_p (TYPE_MIN_VALUE (t))) - || (TREE_CODE (TYPE_MAX_VALUE (t)) != INTEGER_CST - && contains_placeholder_p (TYPE_MAX_VALUE (t)))) + if (CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (t)) + || CONTAINS_PLACEHOLDER_P (TYPE_MAX_VALUE (t))) { tree low = substitute_in_expr (TYPE_MIN_VALUE (t), f, r); tree high = substitute_in_expr (TYPE_MAX_VALUE (t), f, r); @@ -5940,7 +6204,7 @@ gnat_substitute_in_type (t, f, r) new = build_range_type (TREE_TYPE (t), low, high); if (TYPE_INDEX_TYPE (t)) - SET_TYPE_INDEX_TYPE (new, + SET_TYPE_INDEX_TYPE (new, gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r)); return new; } @@ -5949,11 +6213,9 @@ gnat_substitute_in_type (t, f, r) case REAL_TYPE: if ((TYPE_MIN_VALUE (t) != 0 - && TREE_CODE (TYPE_MIN_VALUE (t)) != REAL_CST - && contains_placeholder_p (TYPE_MIN_VALUE (t))) + && CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (t))) || (TYPE_MAX_VALUE (t) != 0 - && TREE_CODE (TYPE_MAX_VALUE (t)) != REAL_CST - && contains_placeholder_p (TYPE_MAX_VALUE (t)))) + && CONTAINS_PLACEHOLDER_P (TYPE_MAX_VALUE (t)))) { tree low = 0, high = 0; @@ -6181,6 +6443,28 @@ create_concat_name (gnat_entity, suffix) Get_External_Name_With_Suffix (gnat_entity, fp); +#ifdef _WIN32 + /* A variable using the Stdcall convention (meaning we are running + on a Windows box) live in a DLL. Here we adjust its name to use + the jump-table, the _imp__NAME contains the address for the NAME + variable. */ + + { + Entity_Kind kind = Ekind (gnat_entity); + char *prefix = "_imp__"; + int plen = strlen (prefix); + + if ((kind == E_Variable || kind == E_Constant) + && Convention (gnat_entity) == Convention_Stdcall) + { + int k; + for (k = 0; k <= Name_Len; k++) + Name_Buffer [Name_Len - k + plen] = Name_Buffer [Name_Len - k]; + strncpy (Name_Buffer, prefix, plen); + } + } +#endif + return get_identifier (Name_Buffer); } |