X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fgcc-interface%2Futils.c;h=335941a2e0cd139a3187db0abf0765f812f6b9e2;hb=5c96587ce00d1c93c6497101b30bb26e0704317b;hp=ad3909fa859efa1823617158ee0e3c1c9b520fb8;hpb=211df5132f9d9a43019cbaeae9a213f1d79a664a;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index ad3909fa859..335941a2e0c 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2009, Free Software Foundation, Inc. * + * Copyright (C) 1992-2010, 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- * @@ -23,10 +23,6 @@ * * ****************************************************************************/ -/* We have attribute handlers using C specific format specifiers in warning - messages. Make sure they are properly recognized. */ -#define GCC_DIAG_STYLE __gcc_cdiag__ - #include "config.h" #include "system.h" #include "coretypes.h" @@ -63,10 +59,6 @@ #include "ada-tree.h" #include "gigi.h" -#ifndef MAX_FIXED_MODE_SIZE -#define MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (DImode) -#endif - #ifndef MAX_BITS_PER_WORD #define MAX_BITS_PER_WORD BITS_PER_WORD #endif @@ -74,6 +66,16 @@ /* If nonzero, pretend we are allocating at global level. */ int force_global; +/* The default alignment of "double" floating-point types, i.e. floating + point types whose size is equal to 64 bits, or 0 if this alignment is + not specifically capped. */ +int double_float_alignment; + +/* The default alignment of "double" or larger scalar types, i.e. scalar + types whose size is greater or equal to 64 bits, or 0 if this alignment + is not specifically capped. */ +int double_scalar_alignment; + /* Tree nodes for the various types and decls we create. */ tree gnat_std_decls[(int) ADT_LAST]; @@ -90,6 +92,8 @@ static tree handle_sentinel_attribute (tree *, tree, tree, int, bool *); static tree handle_noreturn_attribute (tree *, tree, tree, int, bool *); static tree handle_malloc_attribute (tree *, tree, tree, int, bool *); static tree handle_type_generic_attribute (tree *, tree, tree, int, bool *); +static tree handle_vector_size_attribute (tree *, tree, tree, int, bool *); +static tree handle_vector_type_attribute (tree *, tree, tree, int, bool *); /* Fake handler for attributes we don't properly support, typically because they'd require dragging a lot of the common-c front-end circuitry. */ @@ -108,7 +112,11 @@ const struct attribute_spec gnat_internal_attribute_table[] = { "sentinel", 0, 1, false, true, true, handle_sentinel_attribute }, { "noreturn", 0, 0, true, false, false, handle_noreturn_attribute }, { "malloc", 0, 0, true, false, false, handle_malloc_attribute }, - { "type generic", 0, 0, false, true, true, handle_type_generic_attribute }, + { "type generic", 0, 0, false, true, true, handle_type_generic_attribute }, + + { "vector_size", 1, 1, false, true, false, handle_vector_size_attribute }, + { "vector_type", 0, 0, false, true, false, handle_vector_type_attribute }, + { "may_alias", 0, 0, false, true, false, NULL }, /* ??? format and format_arg are heavy and not supported, which actually prevents support for stdio builtins, which we however declare as part @@ -190,7 +198,6 @@ static GTY((deletable)) tree free_block_chain; static tree merge_sizes (tree, tree, tree, bool, bool); static tree compute_related_constant (tree, tree); static tree split_plus (tree, tree *); -static void gnat_gimplify_function (tree); static tree float_type_for_precision (int, enum machine_mode); static tree convert_to_fat_pointer (tree, tree); static tree convert_to_thin_pointer (tree, tree); @@ -287,8 +294,8 @@ make_dummy_type (Entity_Id gnat_type) TYPE_DUMMY_P (gnu_type) = 1; TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type); - if (AGGREGATE_TYPE_P (gnu_type)) - TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_type); + if (Is_By_Reference_Type (gnat_type)) + TREE_ADDRESSABLE (gnu_type) = 1; SET_DUMMY_NODE (gnat_underlying, gnu_type); @@ -306,7 +313,7 @@ global_bindings_p (void) /* Enter a new binding level. */ void -gnat_pushlevel () +gnat_pushlevel (void) { struct gnat_binding_level *newlevel = NULL; @@ -366,7 +373,7 @@ set_block_jmpbuf_decl (tree decl) /* Get the jmpbuf_decl, if any, for the current binding level. */ tree -get_block_jmpbuf_decl () +get_block_jmpbuf_decl (void) { return current_binding_level->jmpbuf_decl; } @@ -374,7 +381,7 @@ get_block_jmpbuf_decl () /* Exit a binding level. Set any BLOCK into the current code group. */ void -gnat_poplevel () +gnat_poplevel (void) { struct gnat_binding_level *level = current_binding_level; tree block = level->block; @@ -426,9 +433,12 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) { DECL_CONTEXT (decl) = current_function_decl; - /* Functions imported in another function are not really nested. */ - if (TREE_CODE (decl) == FUNCTION_DECL && TREE_PUBLIC (decl)) - DECL_NO_STATIC_CHAIN (decl) = 1; + /* Functions imported in another function are not really nested. + For really nested functions mark them initially as needing + a static chain for uses of that flag before unnesting; + lower_nested_functions will then recompute it. */ + if (TREE_CODE (decl) == FUNCTION_DECL && !TREE_PUBLIC (decl)) + DECL_STATIC_CHAIN (decl) = 1; } TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node)); @@ -476,14 +486,18 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) if (!(TYPE_NAME (t) && TREE_CODE (TYPE_NAME (t)) == TYPE_DECL)) ; - else if (TYPE_FAT_POINTER_P (t)) + else if (TYPE_IS_FAT_POINTER_P (t)) { tree tt = build_variant_type_copy (t); TYPE_NAME (tt) = decl; TREE_USED (tt) = TREE_USED (t); TREE_TYPE (decl) = tt; - DECL_ORIGINAL_TYPE (decl) = t; + if (DECL_ORIGINAL_TYPE (TYPE_NAME (t))) + DECL_ORIGINAL_TYPE (decl) = DECL_ORIGINAL_TYPE (TYPE_NAME (t)); + else + DECL_ORIGINAL_TYPE (decl) = t; t = NULL_TREE; + DECL_ARTIFICIAL (decl) = 0; } else if (DECL_ARTIFICIAL (TYPE_NAME (t)) && !DECL_ARTIFICIAL (decl)) ; @@ -520,12 +534,14 @@ gnat_init_decl_processing (void) set_sizetype (size_type_node); /* In Ada, we use an unsigned 8-bit type for the default boolean type. */ - boolean_type_node = make_node (BOOLEAN_TYPE); - TYPE_PRECISION (boolean_type_node) = 1; - fixup_unsigned_type (boolean_type_node); - TYPE_RM_SIZE (boolean_type_node) = bitsize_int (1); + boolean_type_node = make_unsigned_type (8); + TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE); + SET_TYPE_RM_MAX_VALUE (boolean_type_node, + build_int_cst (boolean_type_node, 1)); + SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1)); build_common_tree_nodes_2 (0); + boolean_true_node = TYPE_MAX_VALUE (boolean_type_node); ptr_void_type_node = build_pointer_type (void_type_node); } @@ -535,7 +551,8 @@ gnat_init_decl_processing (void) void record_builtin_type (const char *name, tree type) { - tree type_decl = build_decl (TYPE_DECL, get_identifier (name), type); + tree type_decl = build_decl (input_location, + TYPE_DECL, get_identifier (name), type); gnat_pushdecl (type_decl, Empty); @@ -543,19 +560,18 @@ record_builtin_type (const char *name, tree type) debug_hooks->type_decl (type_decl, false); } -/* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST, +/* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST, finish constructing the record or union type. If REP_LEVEL is zero, this record has no representation clause and so will be entirely laid out here. If REP_LEVEL is one, this record has a representation clause and has been laid out already; only set the sizes and alignment. If REP_LEVEL is two, this record is derived from a parent record and thus inherits its layout; - only make a pass on the fields to finalize them. If DO_NOT_FINALIZE is - true, the record type is expected to be modified afterwards so it will - not be sent to the back-end for finalization. */ + only make a pass on the fields to finalize them. DEBUG_INFO_P is true if + we need to write debug information about this type. */ void -finish_record_type (tree record_type, tree fieldlist, int rep_level, - bool do_not_finalize) +finish_record_type (tree record_type, tree field_list, int rep_level, + bool debug_info_p) { enum tree_code code = TREE_CODE (record_type); tree name = TYPE_NAME (record_type); @@ -566,7 +582,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, bool had_align = TYPE_ALIGN (record_type) != 0; tree field; - TYPE_FIELDS (record_type) = fieldlist; + TYPE_FIELDS (record_type) = field_list; /* Always attach the TYPE_STUB_DECL for a record type. It is required to generate debug info and have a parallel type. */ @@ -579,10 +595,10 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, if (rep_level > 0) { TYPE_ALIGN (record_type) = MAX (BITS_PER_UNIT, TYPE_ALIGN (record_type)); - SET_TYPE_MODE (record_type, BLKmode); if (!had_size_unit) TYPE_SIZE_UNIT (record_type) = size_zero_node; + if (!had_size) TYPE_SIZE (record_type) = bitsize_zero_node; @@ -610,9 +626,9 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, handled yet, and adjust DECL_NONADDRESSABLE_P accordingly. */ if (code == QUAL_UNION_TYPE) - fieldlist = nreverse (fieldlist); + field_list = nreverse (field_list); - for (field = fieldlist; field; field = TREE_CHAIN (field)) + for (field = field_list; field; field = TREE_CHAIN (field)) { tree type = TREE_TYPE (field); tree pos = bit_position (field); @@ -622,7 +638,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, if ((TREE_CODE (type) == RECORD_TYPE || TREE_CODE (type) == UNION_TYPE || TREE_CODE (type) == QUAL_UNION_TYPE) - && !TYPE_IS_FAT_POINTER_P (type) + && !TYPE_FAT_POINTER_P (type) && !TYPE_CONTAINS_TEMPLATE_P (type) && TYPE_ADA_SIZE (type)) this_ada_size = TYPE_ADA_SIZE (type); @@ -716,23 +732,17 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, } if (code == QUAL_UNION_TYPE) - nreverse (fieldlist); - - /* If the type is discriminated, it can be used to access all its - constrained subtypes, so force structural equality checks. */ - if (CONTAINS_PLACEHOLDER_P (size)) - SET_TYPE_STRUCTURAL_EQUALITY (record_type); + nreverse (field_list); if (rep_level < 2) { /* If this is a padding record, we never want to make the size smaller than what was specified in it, if any. */ - if (TREE_CODE (record_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type)) + if (TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type)) size = TYPE_SIZE (record_type); /* Now set any of the values we've just computed that apply. */ - if (!TYPE_IS_FAT_POINTER_P (record_type) + if (!TYPE_FAT_POINTER_P (record_type) && !TYPE_CONTAINS_TEMPLATE_P (record_type)) SET_TYPE_ADA_SIZE (record_type, ada_size); @@ -753,24 +763,24 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, } } - if (!do_not_finalize) + if (debug_info_p) rest_of_record_type_compilation (record_type); } -/* Wrap up compilation of RECORD_TYPE, i.e. most notably output all - the debug information associated with it. It need not be invoked - directly in most cases since finish_record_type takes care of doing - so, unless explicitly requested not to through DO_NOT_FINALIZE. */ +/* Wrap up compilation of RECORD_TYPE, i.e. output all the debug information + associated with it. It need not be invoked directly in most cases since + finish_record_type takes care of doing so, but this can be necessary if + a parallel type is to be attached to the record type. */ void rest_of_record_type_compilation (tree record_type) { - tree fieldlist = TYPE_FIELDS (record_type); + tree field_list = TYPE_FIELDS (record_type); tree field; enum tree_code code = TREE_CODE (record_type); bool var_size = false; - for (field = fieldlist; field; field = TREE_CHAIN (field)) + for (field = field_list; field; field = TREE_CHAIN (field)) { /* We need to make an XVE/XVU record if any field has variable size, whether or not the record does. For example, if we have a union, @@ -794,9 +804,7 @@ rest_of_record_type_compilation (tree record_type) that tells the debugger how the record is laid out. See exp_dbug.ads. But don't do this for records that are padding since they confuse GDB. */ - if (var_size - && !(TREE_CODE (record_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (record_type))) + if (var_size && !TYPE_IS_PADDING_P (record_type)) { tree new_record_type = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE @@ -1001,33 +1009,33 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special, bool has_rep) { tree type = TREE_TYPE (last_size); - tree new; + tree new_size; if (!special || TREE_CODE (size) != COND_EXPR) { - new = size_binop (PLUS_EXPR, first_bit, size); + new_size = size_binop (PLUS_EXPR, first_bit, size); if (has_rep) - new = size_binop (MAX_EXPR, last_size, new); + new_size = size_binop (MAX_EXPR, last_size, new_size); } else - new = fold_build3 (COND_EXPR, type, TREE_OPERAND (size, 0), - integer_zerop (TREE_OPERAND (size, 1)) - ? last_size : merge_sizes (last_size, first_bit, - TREE_OPERAND (size, 1), - 1, has_rep), - integer_zerop (TREE_OPERAND (size, 2)) - ? last_size : merge_sizes (last_size, first_bit, - TREE_OPERAND (size, 2), - 1, has_rep)); + new_size = fold_build3 (COND_EXPR, type, TREE_OPERAND (size, 0), + integer_zerop (TREE_OPERAND (size, 1)) + ? last_size : merge_sizes (last_size, first_bit, + TREE_OPERAND (size, 1), + 1, has_rep), + integer_zerop (TREE_OPERAND (size, 2)) + ? last_size : merge_sizes (last_size, first_bit, + TREE_OPERAND (size, 2), + 1, has_rep)); /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially when fed through substitute_in_expr) into thinking that a constant size is not constant. */ - while (TREE_CODE (new) == NON_LVALUE_EXPR) - new = TREE_OPERAND (new, 0); + while (TREE_CODE (new_size) == NON_LVALUE_EXPR) + new_size = TREE_OPERAND (new_size, 0); - return new; + return new_size; } /* Utility function of above to see if OP0 and OP1, both of SIZETYPE, are @@ -1087,58 +1095,54 @@ split_plus (tree in, tree *pvar) return bitsize_zero_node; } -/* Return a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the - subprogram. If it is void_type_node, then we are dealing with a procedure, - otherwise we are dealing with a function. PARAM_DECL_LIST is a list of - PARM_DECL nodes that are the subprogram arguments. CICO_LIST is the - copy-in/copy-out list to be stored into TYPE_CICO_LIST. - RETURNS_UNCONSTRAINED is true if the function returns an unconstrained - object. RETURNS_BY_REF is true if the function returns by reference. - RETURNS_BY_TARGET_PTR is true if the function is to be passed (as its - first parameter) the address of the place to copy its result. */ +/* Return a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the + subprogram. If it is VOID_TYPE, then we are dealing with a procedure, + otherwise we are dealing with a function. PARAM_DECL_LIST is a list of + PARM_DECL nodes that are the subprogram parameters. CICO_LIST is the + copy-in/copy-out list to be stored into the TYPE_CICO_LIST field. + RETURN_UNCONSTRAINED_P is true if the function returns an unconstrained + object. RETURN_BY_DIRECT_REF_P is true if the function returns by direct + reference. RETURN_BY_INVISI_REF_P is true if the function returns by + invisible reference. */ tree create_subprog_type (tree return_type, tree param_decl_list, tree cico_list, - bool returns_unconstrained, bool returns_by_ref, - bool returns_by_target_ptr) + bool return_unconstrained_p, bool return_by_direct_ref_p, + bool return_by_invisi_ref_p) { /* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of - the subprogram formal parameters. This list is generated by traversing the - input list of PARM_DECL nodes. */ - tree param_type_list = NULL; - tree param_decl; - tree type; + the subprogram formal parameters. This list is generated by traversing + the input list of PARM_DECL nodes. */ + tree param_type_list = NULL_TREE; + tree t, type; - for (param_decl = param_decl_list; param_decl; - param_decl = TREE_CHAIN (param_decl)) - param_type_list = tree_cons (NULL_TREE, TREE_TYPE (param_decl), - param_type_list); + for (t = param_decl_list; t; t = TREE_CHAIN (t)) + param_type_list = tree_cons (NULL_TREE, TREE_TYPE (t), param_type_list); /* The list of the function parameter types has to be terminated by the void type to signal to the back-end that we are not dealing with a variable - parameter subprogram, but that the subprogram has a fixed number of - parameters. */ + parameter subprogram, but that it has a fixed number of parameters. */ param_type_list = tree_cons (NULL_TREE, void_type_node, param_type_list); - /* The list of argument types has been created in reverse - so nreverse it. */ + /* The list of argument types has been created in reverse so reverse it. */ param_type_list = nreverse (param_type_list); type = build_function_type (return_type, param_type_list); - /* TYPE may have been shared since GCC hashes types. If it has a CICO_LIST - or the new type should, make a copy of TYPE. Likewise for - RETURNS_UNCONSTRAINED and RETURNS_BY_REF. */ - if (TYPE_CI_CO_LIST (type) || cico_list - || TYPE_RETURNS_UNCONSTRAINED_P (type) != returns_unconstrained - || TYPE_RETURNS_BY_REF_P (type) != returns_by_ref - || TYPE_RETURNS_BY_TARGET_PTR_P (type) != returns_by_target_ptr) - type = copy_type (type); + /* TYPE may have been shared since GCC hashes types. If it has a different + CICO_LIST, make a copy. Likewise for the various flags. */ + if (TYPE_CI_CO_LIST (type) != cico_list + || TYPE_RETURN_UNCONSTRAINED_P (type) != return_unconstrained_p + || TYPE_RETURN_BY_DIRECT_REF_P (type) != return_by_direct_ref_p + || TREE_ADDRESSABLE (type) != return_by_invisi_ref_p) + { + type = copy_type (type); + TYPE_CI_CO_LIST (type) = cico_list; + TYPE_RETURN_UNCONSTRAINED_P (type) = return_unconstrained_p; + TYPE_RETURN_BY_DIRECT_REF_P (type) = return_by_direct_ref_p; + TREE_ADDRESSABLE (type) = return_by_invisi_ref_p; + } - TYPE_CI_CO_LIST (type) = cico_list; - TYPE_RETURNS_UNCONSTRAINED_P (type) = returns_unconstrained; - TYPE_RETURNS_BY_REF_P (type) = returns_by_ref; - TYPE_RETURNS_BY_TARGET_PTR_P (type) = returns_by_target_ptr; return type; } @@ -1147,18 +1151,35 @@ create_subprog_type (tree return_type, tree param_decl_list, tree cico_list, tree copy_type (tree type) { - tree new = copy_node (type); + tree new_type = copy_node (type); + + /* Unshare the language-specific data. */ + if (TYPE_LANG_SPECIFIC (type)) + { + TYPE_LANG_SPECIFIC (new_type) = NULL; + SET_TYPE_LANG_SPECIFIC (new_type, GET_TYPE_LANG_SPECIFIC (type)); + } + + /* And the contents of the language-specific slot if needed. */ + if ((INTEGRAL_TYPE_P (type) || TREE_CODE (type) == REAL_TYPE) + && TYPE_RM_VALUES (type)) + { + TYPE_RM_VALUES (new_type) = NULL_TREE; + SET_TYPE_RM_SIZE (new_type, TYPE_RM_SIZE (type)); + SET_TYPE_RM_MIN_VALUE (new_type, TYPE_RM_MIN_VALUE (type)); + SET_TYPE_RM_MAX_VALUE (new_type, TYPE_RM_MAX_VALUE (type)); + } /* copy_node clears this field instead of copying it, because it is aliased with TREE_CHAIN. */ - TYPE_STUB_DECL (new) = TYPE_STUB_DECL (type); + TYPE_STUB_DECL (new_type) = TYPE_STUB_DECL (type); - TYPE_POINTER_TO (new) = 0; - TYPE_REFERENCE_TO (new) = 0; - TYPE_MAIN_VARIANT (new) = new; - TYPE_NEXT_VARIANT (new) = 0; + TYPE_POINTER_TO (new_type) = 0; + TYPE_REFERENCE_TO (new_type) = 0; + TYPE_MAIN_VARIANT (new_type) = new_type; + TYPE_NEXT_VARIANT (new_type) = 0; - return new; + return new_type; } /* Return a subtype of sizetype with range MIN to MAX and whose @@ -1185,6 +1206,42 @@ create_index_type (tree min, tree max, tree index, Node_Id gnat_node) return type; } + +/* Return a subtype of TYPE with range MIN to MAX. If TYPE is NULL, + sizetype is used. */ + +tree +create_range_type (tree type, tree min, tree max) +{ + tree range_type; + + if (type == NULL_TREE) + type = sizetype; + + /* First build a type with the base range. */ + range_type + = build_range_type (type, TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type)); + + min = convert (type, min); + max = convert (type, max); + + /* If this type has the TYPE_RM_{MIN,MAX}_VALUE we want, return it. */ + if (TYPE_RM_MIN_VALUE (range_type) + && TYPE_RM_MAX_VALUE (range_type) + && operand_equal_p (TYPE_RM_MIN_VALUE (range_type), min, 0) + && operand_equal_p (TYPE_RM_MAX_VALUE (range_type), max, 0)) + return range_type; + + /* Otherwise, if TYPE_RM_{MIN,MAX}_VALUE is set, make a copy. */ + if (TYPE_RM_MIN_VALUE (range_type) || TYPE_RM_MAX_VALUE (range_type)) + range_type = copy_type (range_type); + + /* Then set the actual range. */ + SET_TYPE_RM_MIN_VALUE (range_type, min); + SET_TYPE_RM_MAX_VALUE (range_type, max); + + return range_type; +} /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of a type. TYPE_NAME gives the name of the type and TYPE is a ..._TYPE node giving @@ -1196,7 +1253,8 @@ create_type_stub_decl (tree type_name, tree type) /* Using a named TYPE_DECL ensures that a type name marker is emitted in STABS while setting DECL_ARTIFICIAL ensures that no DW_TAG_typedef is emitted in DWARF. */ - tree type_decl = build_decl (TYPE_DECL, type_name, type); + tree type_decl = build_decl (input_location, + TYPE_DECL, type_name, type); DECL_ARTIFICIAL (type_decl) = 1; return type_decl; } @@ -1226,7 +1284,8 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list, DECL_NAME (type_decl) = type_name; } else - type_decl = build_decl (TYPE_DECL, type_name, type); + type_decl = build_decl (input_location, + TYPE_DECL, type_name, type); DECL_ARTIFICIAL (type_decl) = artificial_p; gnat_pushdecl (type_decl, gnat_node); @@ -1247,7 +1306,7 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list, if (code == UNCONSTRAINED_ARRAY_TYPE || !debug_info_p) DECL_IGNORED_P (type_decl) = 1; else if (code != ENUMERAL_TYPE - && (code != RECORD_TYPE || TYPE_IS_FAT_POINTER_P (type)) + && (code != RECORD_TYPE || TYPE_FAT_POINTER_P (type)) && !((code == POINTER_TYPE || code == REFERENCE_TYPE) && TYPE_IS_DUMMY_P (TREE_TYPE (type))) && !(code == RECORD_TYPE @@ -1304,7 +1363,8 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, /* The actual DECL node. CONST_DECL was initially intended for enumerals and may be used for scalars in general but not for aggregates. */ tree var_decl - = build_decl ((constant_p && const_decl_allowed_p + = build_decl (input_location, + (constant_p && const_decl_allowed_p && !AGGREGATE_TYPE_P (type)) ? CONST_DECL : VAR_DECL, var_name, type); @@ -1321,24 +1381,26 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, /* At the global level, an initializer requiring code to be generated produces elaboration statements. Check that such statements are allowed, that is, not violating a No_Elaboration_Code restriction. */ - if (global_bindings_p () && var_init != 0 && ! init_const) + if (global_bindings_p () && var_init != 0 && !init_const) Check_Elaboration_Code_Allowed (gnat_node); + DECL_INITIAL (var_decl) = var_init; + TREE_READONLY (var_decl) = const_flag; + DECL_EXTERNAL (var_decl) = extern_flag; + TREE_PUBLIC (var_decl) = public_flag || extern_flag; + TREE_CONSTANT (var_decl) = constant_p; + TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl) + = TYPE_VOLATILE (type); + /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't try to fiddle with DECL_COMMON. However, on platforms that don't support global BSS sections, uninitialized global variables would go in DATA instead, thus increasing the size of the executable. */ if (!flag_no_common && TREE_CODE (var_decl) == VAR_DECL + && TREE_PUBLIC (var_decl) && !have_global_bss_p ()) DECL_COMMON (var_decl) = 1; - DECL_INITIAL (var_decl) = var_init; - TREE_READONLY (var_decl) = const_flag; - DECL_EXTERNAL (var_decl) = extern_flag; - TREE_PUBLIC (var_decl) = public_flag || extern_flag; - TREE_CONSTANT (var_decl) = constant_p; - TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl) - = TYPE_VOLATILE (type); /* If it's public and not external, always allocate storage for it. At the global binding level we need to allocate static storage for the @@ -1356,10 +1418,12 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init, != null_pointer_node) DECL_IGNORED_P (var_decl) = 1; - if (asm_name && VAR_OR_FUNCTION_DECL_P (var_decl)) - SET_DECL_ASSEMBLER_NAME (var_decl, asm_name); - - process_attributes (var_decl, attr_list); + if (TREE_CODE (var_decl) == VAR_DECL) + { + if (asm_name) + SET_DECL_ASSEMBLER_NAME (var_decl, asm_name); + process_attributes (var_decl, attr_list); + } /* Add this decl to the current binding level. */ gnat_pushdecl (var_decl, gnat_node); @@ -1405,19 +1469,20 @@ aggregate_type_contains_array_p (tree type) } } -/* Return a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its - type, and RECORD_TYPE is the type of the parent. PACKED is nonzero if - this field is in a record type with a "pragma pack". If SIZE is nonzero - it is the specified size for this field. If POS is nonzero, it is the bit - position. If ADDRESSABLE is nonzero, it means we are allowed to take - the address of this field for aliasing purposes. If it is negative, we - should not make a bitfield, which is used by make_aligning_type. */ +/* Return a FIELD_DECL node. FIELD_NAME is the field's name, FIELD_TYPE is + its type and RECORD_TYPE is the type of the enclosing record. PACKED is + 1 if the enclosing record is packed, -1 if it has Component_Alignment of + Storage_Unit. If SIZE is nonzero, it is the specified size of the field. + If POS is nonzero, it is the bit position. If ADDRESSABLE is nonzero, it + means we are allowed to take the address of the field; if it is negative, + we should not make a bitfield, which is used by make_aligning_type. */ tree create_field_decl (tree field_name, tree field_type, tree record_type, int packed, tree size, tree pos, int addressable) { - tree field_decl = build_decl (FIELD_DECL, field_name, field_type); + tree field_decl = build_decl (input_location, + FIELD_DECL, field_name, field_type); DECL_CONTEXT (field_decl) = record_type; TREE_READONLY (field_decl) = TYPE_READONLY (field_type); @@ -1444,12 +1509,8 @@ create_field_decl (tree field_name, tree field_type, tree record_type, else if (packed == 1) { size = rm_size (field_type); - - /* For a constant size larger than MAX_FIXED_MODE_SIZE, round up to - byte. */ - if (TREE_CODE (size) == INTEGER_CST - && compare_tree_int (size, MAX_FIXED_MODE_SIZE) > 0) - size = round_up (size, BITS_PER_UNIT); + if (TYPE_MODE (field_type) == BLKmode) + size = round_up (size, BITS_PER_UNIT); } /* If we may, according to ADDRESSABLE, make a bitfield if a size is @@ -1558,7 +1619,8 @@ create_field_decl (tree field_name, tree field_type, tree record_type, tree create_param_decl (tree param_name, tree param_type, bool readonly) { - tree param_decl = build_decl (PARM_DECL, param_name, param_type); + tree param_decl = build_decl (input_location, + PARM_DECL, param_name, param_type); /* Honor TARGET_PROMOTE_PROTOTYPES like the C compiler, as not doing so can lead to various ABI violations. */ @@ -1571,16 +1633,12 @@ create_param_decl (tree param_name, tree param_type, bool readonly) if (TREE_CODE (param_type) == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (param_type)) { - tree subtype = make_node (INTEGER_TYPE); + tree subtype + = make_unsigned_type (TYPE_PRECISION (integer_type_node)); TREE_TYPE (subtype) = integer_type_node; TYPE_BIASED_REPRESENTATION_P (subtype) = 1; - - TYPE_UNSIGNED (subtype) = 1; - TYPE_PRECISION (subtype) = TYPE_PRECISION (integer_type_node); - TYPE_MIN_VALUE (subtype) = TYPE_MIN_VALUE (param_type); - TYPE_MAX_VALUE (subtype) = TYPE_MAX_VALUE (param_type); - layout_type (subtype); - + SET_TYPE_RM_MIN_VALUE (subtype, TYPE_MIN_VALUE (param_type)); + SET_TYPE_RM_MAX_VALUE (subtype, TYPE_MAX_VALUE (param_type)); param_type = subtype; } else @@ -1742,7 +1800,8 @@ potential_alignment_gap (tree prev_field, tree curr_field, tree offset) tree create_label_decl (tree label_name) { - tree label_decl = build_decl (LABEL_DECL, label_name, void_type_node); + tree label_decl = build_decl (input_location, + LABEL_DECL, label_name, void_type_node); DECL_CONTEXT (label_decl) = current_function_decl; DECL_MODE (label_decl) = VOIDmode; @@ -1765,8 +1824,10 @@ create_subprog_decl (tree subprog_name, tree asm_name, bool public_flag, bool extern_flag, struct attrib *attr_list, Node_Id gnat_node) { - tree return_type = TREE_TYPE (subprog_type); - tree subprog_decl = build_decl (FUNCTION_DECL, subprog_name, subprog_type); + tree subprog_decl = build_decl (input_location, FUNCTION_DECL, subprog_name, + subprog_type); + tree result_decl = build_decl (input_location, RESULT_DECL, NULL_TREE, + TREE_TYPE (subprog_type)); /* If this is a non-inline function nested inside an inlined external function, we cannot honor both requests without cloning the nested @@ -1787,22 +1848,11 @@ create_subprog_decl (tree subprog_name, tree asm_name, TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type); DECL_DECLARED_INLINE_P (subprog_decl) = inline_flag; DECL_ARGUMENTS (subprog_decl) = param_decl_list; - DECL_RESULT (subprog_decl) = build_decl (RESULT_DECL, 0, return_type); - DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1; - DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1; - - /* TREE_ADDRESSABLE is set on the result type to request the use of the - target by-reference return mechanism. This is not supported all the - way down to RTL expansion with GCC 4, which ICEs on temporary creation - attempts with such a type and expects DECL_BY_REFERENCE to be set on - the RESULT_DECL instead - see gnat_genericize for more details. */ - if (TREE_ADDRESSABLE (TREE_TYPE (DECL_RESULT (subprog_decl)))) - { - tree result_decl = DECL_RESULT (subprog_decl); - TREE_ADDRESSABLE (TREE_TYPE (result_decl)) = 0; - DECL_BY_REFERENCE (result_decl) = 1; - } + DECL_ARTIFICIAL (result_decl) = 1; + DECL_IGNORED_P (result_decl) = 1; + DECL_BY_REFERENCE (result_decl) = TREE_ADDRESSABLE (subprog_type); + DECL_RESULT (subprog_decl) = result_decl; if (asm_name) { @@ -1813,9 +1863,9 @@ create_subprog_decl (tree subprog_name, tree asm_name, to be declared as the "main" function literally by default. Ada program entry points are typically declared with a different name within the binder generated file, exported as 'main' to satisfy the - system expectations. Redirect main_identifier_node in this case. */ + system expectations. Force main_identifier_node in this case. */ if (asm_name == main_identifier_node) - main_identifier_node = DECL_NAME (subprog_decl); + DECL_NAME (subprog_decl) = main_identifier_node; } process_attributes (subprog_decl, attr_list); @@ -1856,169 +1906,10 @@ begin_subprog_body (tree subprog_decl) get_pending_sizes (); } - -/* Helper for the genericization callback. Return a dereference of VAL - if it is of a reference type. */ - -static tree -convert_from_reference (tree val) -{ - tree value_type, ref; - - if (TREE_CODE (TREE_TYPE (val)) != REFERENCE_TYPE) - return val; - - value_type = TREE_TYPE (TREE_TYPE (val)); - ref = build1 (INDIRECT_REF, value_type, val); - - /* See if what we reference is CONST or VOLATILE, which requires - looking into array types to get to the component type. */ - - while (TREE_CODE (value_type) == ARRAY_TYPE) - value_type = TREE_TYPE (value_type); - - TREE_READONLY (ref) - = (TYPE_QUALS (value_type) & TYPE_QUAL_CONST); - TREE_THIS_VOLATILE (ref) - = (TYPE_QUALS (value_type) & TYPE_QUAL_VOLATILE); - - TREE_SIDE_EFFECTS (ref) - = (TREE_THIS_VOLATILE (ref) || TREE_SIDE_EFFECTS (val)); - - return ref; -} - -/* Helper for the genericization callback. Returns true if T denotes - a RESULT_DECL with DECL_BY_REFERENCE set. */ - -static inline bool -is_byref_result (tree t) -{ - return (TREE_CODE (t) == RESULT_DECL && DECL_BY_REFERENCE (t)); -} - - -/* Tree walking callback for gnat_genericize. Currently ... - - o Adjust references to the function's DECL_RESULT if it is marked - DECL_BY_REFERENCE and so has had its type turned into a reference - type at the end of the function compilation. */ - -static tree -gnat_genericize_r (tree *stmt_p, int *walk_subtrees, void *data) -{ - /* This implementation is modeled after what the C++ front-end is - doing, basis of the downstream passes behavior. */ - - tree stmt = *stmt_p; - struct pointer_set_t *p_set = (struct pointer_set_t*) data; - - /* If we have a direct mention of the result decl, dereference. */ - if (is_byref_result (stmt)) - { - *stmt_p = convert_from_reference (stmt); - *walk_subtrees = 0; - return NULL; - } - - /* Otherwise, no need to walk the same tree twice. */ - if (pointer_set_contains (p_set, stmt)) - { - *walk_subtrees = 0; - return NULL_TREE; - } - - /* If we are taking the address of what now is a reference, just get the - reference value. */ - if (TREE_CODE (stmt) == ADDR_EXPR - && is_byref_result (TREE_OPERAND (stmt, 0))) - { - *stmt_p = convert (TREE_TYPE (stmt), TREE_OPERAND (stmt, 0)); - *walk_subtrees = 0; - } - - /* Don't dereference an by-reference RESULT_DECL inside a RETURN_EXPR. */ - else if (TREE_CODE (stmt) == RETURN_EXPR - && TREE_OPERAND (stmt, 0) - && is_byref_result (TREE_OPERAND (stmt, 0))) - *walk_subtrees = 0; - - /* Don't look inside trees that cannot embed references of interest. */ - else if (IS_TYPE_OR_DECL_P (stmt)) - *walk_subtrees = 0; - - pointer_set_insert (p_set, *stmt_p); - - return NULL; -} - -/* Perform lowering of Ada trees to GENERIC. In particular: - - o Turn a DECL_BY_REFERENCE RESULT_DECL into a real by-reference decl - and adjust all the references to this decl accordingly. */ - -static void -gnat_genericize (tree fndecl) -{ - /* Prior to GCC 4, an explicit By_Reference result mechanism for a function - was handled by simply setting TREE_ADDRESSABLE on the result type. - Everything required to actually pass by invisible ref using the target - mechanism (e.g. extra parameter) was handled at RTL expansion time. - - This doesn't work with GCC 4 any more for several reasons. First, the - gimplification process might need the creation of temporaries of this - type, and the gimplifier ICEs on such attempts. Second, the middle-end - now relies on a different attribute for such cases (DECL_BY_REFERENCE on - RESULT/PARM_DECLs), and expects the user invisible by-reference-ness to - be explicitly accounted for by the front-end in the function body. - - We achieve the complete transformation in two steps: - - 1/ create_subprog_decl performs early attribute tweaks: it clears - TREE_ADDRESSABLE from the result type and sets DECL_BY_REFERENCE on - the result decl. The former ensures that the bit isn't set in the GCC - tree saved for the function, so prevents ICEs on temporary creation. - The latter we use here to trigger the rest of the processing. - - 2/ This function performs the type transformation on the result decl - and adjusts all the references to this decl from the function body - accordingly. - - Clearing TREE_ADDRESSABLE from the type differs from the C++ front-end - strategy, which escapes the gimplifier temporary creation issues by - creating it's own temporaries using TARGET_EXPR nodes. Our way relies - on simple specific support code in aggregate_value_p to look at the - target function result decl explicitly. */ - - struct pointer_set_t *p_set; - tree decl_result = DECL_RESULT (fndecl); - - if (!DECL_BY_REFERENCE (decl_result)) - return; - - /* Make the DECL_RESULT explicitly by-reference and adjust all the - occurrences in the function body using the common tree-walking facility. - We want to see every occurrence of the result decl to adjust the - referencing tree, so need to use our own pointer set to control which - trees should be visited again or not. */ - - p_set = pointer_set_create (); - - TREE_TYPE (decl_result) = build_reference_type (TREE_TYPE (decl_result)); - TREE_ADDRESSABLE (decl_result) = 0; - relayout_decl (decl_result); - - walk_tree (&DECL_SAVED_TREE (fndecl), gnat_genericize_r, p_set, NULL); - - pointer_set_destroy (p_set); -} - -/* Finish the definition of the current subprogram BODY and compile it all the - way to assembler language output. ELAB_P tells if this is called for an - elaboration routine, to be entirely discarded if empty. */ +/* Finish the definition of the current subprogram BODY and finalize it. */ void -end_subprog_body (tree body, bool elab_p) +end_subprog_body (tree body) { tree fndecl = current_function_decl; @@ -2048,47 +1939,18 @@ end_subprog_body (tree body, bool elab_p) if (type_annotate_only) return; - /* Perform the required pre-gimplification transformations on the tree. */ - gnat_genericize (fndecl); + /* Dump functions before gimplification. */ + dump_function (TDI_original, fndecl); - /* We do different things for nested and non-nested functions. - ??? This should be in cgraph. */ + /* ??? This special handling of nested functions is probably obsolete. */ if (!DECL_CONTEXT (fndecl)) - { - gnat_gimplify_function (fndecl); - - /* If this is an empty elaboration proc, just discard the node. - Otherwise, compile further. */ - if (elab_p && empty_body_p (gimple_body (fndecl))) - cgraph_remove_node (cgraph_node (fndecl)); - else - cgraph_finalize_function (fndecl, false); - } + cgraph_finalize_function (fndecl, false); else /* Register this function with cgraph just far enough to get it added to our parent's nested function list. */ (void) cgraph_node (fndecl); } -/* Convert FNDECL's code to GIMPLE and handle any nested functions. */ - -static void -gnat_gimplify_function (tree fndecl) -{ - struct cgraph_node *cgn; - - dump_function (TDI_original, fndecl); - gimplify_function_tree (fndecl); - dump_function (TDI_generic, fndecl); - - /* Convert all nested functions to GIMPLE now. We do things in this order - so that items like VLA sizes are expanded properly in the context of the - correct function. */ - cgn = cgraph_node (fndecl); - for (cgn = cgn->nested; cgn; cgn = cgn->next_nested) - gnat_gimplify_function (cgn->decl); -} - tree gnat_builtin_function (tree decl) { @@ -2160,16 +2022,28 @@ gnat_type_for_mode (enum machine_mode mode, int unsignedp) { if (mode == BLKmode) return NULL_TREE; - else if (mode == VOIDmode) + + if (mode == VOIDmode) return void_type_node; - else if (COMPLEX_MODE_P (mode)) + + if (COMPLEX_MODE_P (mode)) return NULL_TREE; - else if (SCALAR_FLOAT_MODE_P (mode)) + + if (SCALAR_FLOAT_MODE_P (mode)) return float_type_for_precision (GET_MODE_PRECISION (mode), mode); - else if (SCALAR_INT_MODE_P (mode)) + + if (SCALAR_INT_MODE_P (mode)) return gnat_type_for_size (GET_MODE_BITSIZE (mode), unsignedp); - else - return NULL_TREE; + + if (VECTOR_MODE_P (mode)) + { + enum machine_mode inner_mode = GET_MODE_INNER (mode); + tree inner_type = gnat_type_for_mode (inner_mode, unsignedp); + if (inner_type) + return build_vector_type_for_mode (inner_type, mode); + } + + return NULL_TREE; } /* Return the unsigned version of a TYPE_NODE, a scalar type. */ @@ -2234,6 +2108,14 @@ gnat_types_compatible_p (tree t1, tree t2) if ((code = TREE_CODE (t1)) != TREE_CODE (t2)) return 0; + /* Vector types are also compatible if they have the same number of subparts + and the same form of (scalar) element type. */ + if (code == VECTOR_TYPE + && TYPE_VECTOR_SUBPARTS (t1) == TYPE_VECTOR_SUBPARTS (t2) + && TREE_CODE (TREE_TYPE (t1)) == TREE_CODE (TREE_TYPE (t2)) + && TYPE_PRECISION (TREE_TYPE (t1)) == TYPE_PRECISION (TREE_TYPE (t2))) + return 1; + /* Array types are also compatible if they are constrained and have the same component type and the same domain. */ if (code == ARRAY_TYPE @@ -2250,7 +2132,7 @@ gnat_types_compatible_p (tree t1, tree t2) /* Padding record types are also compatible if they pad the same type and have the same constant size. */ if (code == RECORD_TYPE - && TYPE_IS_PADDING_P (t1) && TYPE_IS_PADDING_P (t2) + && TYPE_PADDING_P (t1) && TYPE_PADDING_P (t2) && TREE_TYPE (TYPE_FIELDS (t1)) == TREE_TYPE (TYPE_FIELDS (t2)) && tree_int_cst_equal (TYPE_SIZE (t1), TYPE_SIZE (t2))) return 1; @@ -2277,10 +2159,15 @@ max_size (tree exp, bool max_p) case tcc_vl_exp: if (code == CALL_EXPR) { - tree *argarray; - int i, n = call_expr_nargs (exp); - gcc_assert (n > 0); + tree t, *argarray; + int n, i; + + t = maybe_inline_call_in_expr (exp); + if (t) + return max_size (t, max_p); + n = call_expr_nargs (exp); + gcc_assert (n > 0); argarray = (tree *) alloca (n * sizeof (tree)); for (i = 0; i < n; i++) argarray[i] = max_size (CALL_EXPR_ARG (exp, i), max_p); @@ -2395,7 +2282,7 @@ build_template (tree template_type, tree array_type, tree expr) tree field; while (TREE_CODE (array_type) == RECORD_TYPE - && (TYPE_IS_PADDING_P (array_type) + && (TYPE_PADDING_P (array_type) || TYPE_JUSTIFIED_MODULAR_P (array_type))) array_type = TREE_TYPE (TYPE_FIELDS (array_type)); @@ -2459,7 +2346,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) tree record_type = make_node (RECORD_TYPE); tree pointer32_type; tree field_list = 0; - int class; + int klass; int dtype = 0; tree inner_type; int ndim; @@ -2571,22 +2458,22 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) { case By_Descriptor_A: case By_Short_Descriptor_A: - class = 4; + klass = 4; break; case By_Descriptor_NCA: case By_Short_Descriptor_NCA: - class = 10; + klass = 10; break; case By_Descriptor_SB: case By_Short_Descriptor_SB: - class = 15; + klass = 15; break; case By_Descriptor: case By_Short_Descriptor: case By_Descriptor_S: case By_Short_Descriptor_S: default: - class = 1; + klass = 1; break; } @@ -2608,7 +2495,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) field_list = chainon (field_list, make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), - record_type, size_int (class))); + record_type, size_int (klass))); /* Of course this will crash at run-time if the address space is not within the low 32 bits, but there is nothing else we can do. */ @@ -2757,7 +2644,7 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) } TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC"); - finish_record_type (record_type, field_list, 0, true); + finish_record_type (record_type, field_list, 0, false); return record_type; } @@ -2774,7 +2661,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) tree record64_type = make_node (RECORD_TYPE); tree pointer64_type; tree field_list64 = 0; - int class; + int klass; int dtype = 0; tree inner_type; int ndim; @@ -2885,18 +2772,18 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) switch (mech) { case By_Descriptor_A: - class = 4; + klass = 4; break; case By_Descriptor_NCA: - class = 10; + klass = 10; break; case By_Descriptor_SB: - class = 15; + klass = 15; break; case By_Descriptor: case By_Descriptor_S: default: - class = 1; + klass = 1; break; } @@ -2915,7 +2802,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) field_list64 = chainon (field_list64, make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), - record64_type, size_int (class))); + record64_type, size_int (klass))); field_list64 = chainon (field_list64, make_descriptor_field ("MBMO", @@ -3071,7 +2958,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) } TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64"); - finish_record_type (record64_type, field_list64, 0, true); + finish_record_type (record64_type, field_list64, 0, false); return record64_type; } @@ -3098,9 +2985,9 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr)); tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr); /* The CLASS field is the 3rd field in the descriptor. */ - tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); + tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); /* The POINTER field is the 6th field in the descriptor. */ - tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (class))); + tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass))); /* Retrieve the value of the POINTER field. */ tree gnu_expr64 @@ -3109,43 +2996,43 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) if (POINTER_TYPE_P (gnu_type)) return convert (gnu_type, gnu_expr64); - else if (TYPE_FAT_POINTER_P (gnu_type)) + else if (TYPE_IS_FAT_POINTER_P (gnu_type)) { tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type)); tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))); tree template_type = TREE_TYPE (p_bounds_type); tree min_field = TYPE_FIELDS (template_type); tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type)); - tree template, template_addr, aflags, dimct, t, u; + tree template_tree, template_addr, aflags, dimct, t, u; /* See the head comment of build_vms_descriptor. */ - int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class)); + int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass)); tree lfield, ufield; /* Convert POINTER to the type of the P_ARRAY field. */ gnu_expr64 = convert (p_array_type, gnu_expr64); - switch (iclass) + switch (iklass) { case 1: /* Class S */ case 15: /* Class SB */ /* Build {1, LENGTH} template; LENGTH64 is the 5th field. */ - t = TREE_CHAIN (TREE_CHAIN (class)); + t = TREE_CHAIN (TREE_CHAIN (klass)); t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); t = tree_cons (min_field, convert (TREE_TYPE (min_field), integer_one_node), tree_cons (max_field, convert (TREE_TYPE (max_field), t), NULL_TREE)); - template = gnat_build_constructor (template_type, t); - template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template); + template_tree = gnat_build_constructor (template_type, t); + template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree); /* For class S, we are done. */ - if (iclass == 1) + if (iklass == 1) break; /* Test that we really have a SB descriptor, like DEC Ada. */ - t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL); - u = convert (TREE_TYPE (class), DECL_INITIAL (class)); + t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL); + u = convert (TREE_TYPE (klass), DECL_INITIAL (klass)); u = build_binary_op (EQ_EXPR, integer_type_node, t, u); /* If so, there is already a template in the descriptor and it is located right after the POINTER field. The fields are @@ -3163,12 +3050,12 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) t = tree_cons (TYPE_FIELDS (template_type), lfield, tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)), ufield, NULL_TREE)); - template = gnat_build_constructor (template_type, t); + template_tree = gnat_build_constructor (template_type, t); /* Otherwise use the {1, LENGTH} template we build above. */ template_addr = build3 (COND_EXPR, p_bounds_type, u, build_unary_op (ADDR_EXPR, p_bounds_type, - template), + template_tree), template_addr); break; @@ -3210,12 +3097,13 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) t = tree_cons (TYPE_FIELDS (template_type), lfield, tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)), ufield, NULL_TREE)); - template = gnat_build_constructor (template_type, t); - template = build3 (COND_EXPR, p_bounds_type, u, + template_tree = gnat_build_constructor (template_type, t); + template_tree = build3 (COND_EXPR, template_type, u, build_call_raise (CE_Length_Check_Failed, Empty, N_Raise_Constraint_Error), - template); - template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template); + template_tree); + template_addr + = build_unary_op (ADDR_EXPR, p_bounds_type, template_tree); break; case 10: /* Class NCA */ @@ -3246,9 +3134,9 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr)); tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr); /* The CLASS field is the 3rd field in the descriptor. */ - tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); + tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); /* The POINTER field is the 4th field in the descriptor. */ - tree pointer = TREE_CHAIN (class); + tree pointer = TREE_CHAIN (klass); /* Retrieve the value of the POINTER field. */ tree gnu_expr32 @@ -3257,21 +3145,21 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) if (POINTER_TYPE_P (gnu_type)) return convert (gnu_type, gnu_expr32); - else if (TYPE_FAT_POINTER_P (gnu_type)) + else if (TYPE_IS_FAT_POINTER_P (gnu_type)) { tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type)); tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))); tree template_type = TREE_TYPE (p_bounds_type); tree min_field = TYPE_FIELDS (template_type); tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type)); - tree template, template_addr, aflags, dimct, t, u; + tree template_tree, template_addr, aflags, dimct, t, u; /* See the head comment of build_vms_descriptor. */ - int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class)); + int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass)); /* Convert POINTER to the type of the P_ARRAY field. */ gnu_expr32 = convert (p_array_type, gnu_expr32); - switch (iclass) + switch (iklass) { case 1: /* Class S */ case 15: /* Class SB */ @@ -3283,25 +3171,26 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) tree_cons (max_field, convert (TREE_TYPE (max_field), t), NULL_TREE)); - template = gnat_build_constructor (template_type, t); - template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template); + template_tree = gnat_build_constructor (template_type, t); + template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template_tree); /* For class S, we are done. */ - if (iclass == 1) + if (iklass == 1) break; /* Test that we really have a SB descriptor, like DEC Ada. */ - t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL); - u = convert (TREE_TYPE (class), DECL_INITIAL (class)); + t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL); + u = convert (TREE_TYPE (klass), DECL_INITIAL (klass)); u = build_binary_op (EQ_EXPR, integer_type_node, t, u); /* If so, there is already a template in the descriptor and it is located right after the POINTER field. */ t = TREE_CHAIN (pointer); - template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + template_tree + = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); /* Otherwise use the {1, LENGTH} template we build above. */ template_addr = build3 (COND_EXPR, p_bounds_type, u, build_unary_op (ADDR_EXPR, p_bounds_type, - template), + template_tree), template_addr); break; @@ -3328,12 +3217,14 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) /* There is already a template in the descriptor and it is located at the start of block 3 (12th field). */ t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t)))); - template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); - template = build3 (COND_EXPR, p_bounds_type, u, + template_tree + = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); + template_tree = build3 (COND_EXPR, TREE_TYPE (t), u, build_call_raise (CE_Length_Check_Failed, Empty, N_Raise_Constraint_Error), - template); - template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template); + template_tree); + template_addr + = build_unary_op (ADDR_EXPR, p_bounds_type, template_tree); break; case 10: /* Class NCA */ @@ -3455,7 +3346,7 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog) gnat_poplevel (); allocate_struct_function (gnu_stub_decl, false); - end_subprog_body (gnu_body, false); + end_subprog_body (gnu_body); } /* Build a type to be used to represent an aliased object whose nominal @@ -3479,7 +3370,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name) finish_record_type (type, chainon (chainon (NULL_TREE, template_field), array_field), - 0, false); + 0, true); return type; } @@ -3492,10 +3383,10 @@ build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, { tree template_type; - gcc_assert (TYPE_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type)); + gcc_assert (TYPE_IS_FAT_OR_THIN_POINTER_P (thin_fat_ptr_type)); template_type - = (TYPE_FAT_POINTER_P (thin_fat_ptr_type) + = (TYPE_IS_FAT_POINTER_P (thin_fat_ptr_type) ? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type)))) : TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type)))); return build_unc_object_type (template_type, object_type, name); @@ -3591,7 +3482,7 @@ update_pointer_to (tree old_type, tree new_type) /* Now deal with the unconstrained array case. In this case the "pointer" is actually a RECORD_TYPE where both fields are pointers to dummy nodes. Turn them into pointers to the correct types using update_pointer_to. */ - else if (!TYPE_FAT_POINTER_P (ptr)) + else if (!TYPE_IS_FAT_POINTER_P (ptr)) gcc_unreachable (); else @@ -3628,6 +3519,18 @@ update_pointer_to (tree old_type, tree new_type) TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type) = TREE_TYPE (new_type) = ptr; + /* And show the original pointer NEW_PTR to the debugger. This is the + counterpart of the equivalent processing in gnat_pushdecl when the + unconstrained array type is frozen after access types to it. Note + that update_pointer_to can be invoked multiple times on the same + couple of types because of the type variants. */ + if (TYPE_NAME (ptr) + && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL + && !DECL_ORIGINAL_TYPE (TYPE_NAME (ptr))) + { + DECL_ORIGINAL_TYPE (TYPE_NAME (ptr)) = new_ptr; + DECL_ARTIFICIAL (TYPE_NAME (ptr)) = 0; + } for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var)) SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type); @@ -3664,7 +3567,7 @@ convert_to_fat_pointer (tree type, tree expr) tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)))); tree p_array_type = TREE_TYPE (TYPE_FIELDS (type)); tree etype = TREE_TYPE (expr); - tree template; + tree template_tree; /* If EXPR is null, make a fat pointer that contains null pointers to the template and array. */ @@ -3680,17 +3583,17 @@ convert_to_fat_pointer (tree type, tree expr) NULL_TREE))); /* If EXPR is a thin pointer, make template and data from the record.. */ - else if (TYPE_THIN_POINTER_P (etype)) + else if (TYPE_IS_THIN_POINTER_P (etype)) { tree fields = TYPE_FIELDS (TREE_TYPE (etype)); - expr = save_expr (expr); + expr = gnat_protect_expr (expr); if (TREE_CODE (expr) == ADDR_EXPR) expr = TREE_OPERAND (expr, 0); else expr = build1 (INDIRECT_REF, TREE_TYPE (etype), expr); - template = build_component_ref (expr, NULL_TREE, fields, false); + template_tree = build_component_ref (expr, NULL_TREE, fields, false); expr = build_unary_op (ADDR_EXPR, NULL_TREE, build_component_ref (expr, NULL_TREE, TREE_CHAIN (fields), false)); @@ -3698,7 +3601,7 @@ convert_to_fat_pointer (tree type, tree expr) /* Otherwise, build the constructor for the template. */ else - template = build_template (template_type, TREE_TYPE (etype), expr); + template_tree = build_template (template_type, TREE_TYPE (etype), expr); /* The final result is a constructor for the fat pointer. @@ -3718,7 +3621,8 @@ convert_to_fat_pointer (tree type, tree expr) tree_cons (TYPE_FIELDS (type), convert (p_array_type, expr), tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), - build_unary_op (ADDR_EXPR, NULL_TREE, template), + build_unary_op (ADDR_EXPR, NULL_TREE, + template_tree), NULL_TREE))); } @@ -3729,7 +3633,7 @@ convert_to_fat_pointer (tree type, tree expr) static tree convert_to_thin_pointer (tree type, tree expr) { - if (!TYPE_FAT_POINTER_P (TREE_TYPE (expr))) + if (!TYPE_IS_FAT_POINTER_P (TREE_TYPE (expr))) expr = convert_to_fat_pointer (TREE_TYPE (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type))), expr); @@ -3752,19 +3656,19 @@ convert_to_thin_pointer (tree type, tree expr) tree convert (tree type, tree expr) { - enum tree_code code = TREE_CODE (type); tree etype = TREE_TYPE (expr); enum tree_code ecode = TREE_CODE (etype); + enum tree_code code = TREE_CODE (type); - /* If EXPR is already the right type, we are done. */ - if (type == etype) + /* If the expression is already of the right type, we are done. */ + if (etype == type) return expr; /* If both input and output have padding and are of variable size, do this as an unchecked conversion. Likewise if one is a mere variant of the other, so we avoid a pointless unpad/repad sequence. */ else if (code == RECORD_TYPE && ecode == RECORD_TYPE - && TYPE_IS_PADDING_P (type) && TYPE_IS_PADDING_P (etype) + && TYPE_PADDING_P (type) && TYPE_PADDING_P (etype) && (!TREE_CONSTANT (TYPE_SIZE (type)) || !TREE_CONSTANT (TYPE_SIZE (etype)) || gnat_types_compatible_p (type, etype) @@ -3772,13 +3676,13 @@ convert (tree type, tree expr) == TYPE_NAME (TREE_TYPE (TYPE_FIELDS (etype))))) ; - /* If the output type has padding, convert to the inner type and - make a constructor to build the record. */ - else if (code == RECORD_TYPE && TYPE_IS_PADDING_P (type)) + /* If the output type has padding, convert to the inner type and make a + constructor to build the record, unless a variable size is involved. */ + else if (code == RECORD_TYPE && TYPE_PADDING_P (type)) { /* If we previously converted from another type and our type is of variable size, remove the conversion to avoid the need for - variable-size temporaries. Likewise for a conversion between + variable-sized temporaries. Likewise for a conversion between original and packable version. */ if (TREE_CODE (expr) == VIEW_CONVERT_EXPR && (!TREE_CONSTANT (TYPE_SIZE (type)) @@ -3789,10 +3693,9 @@ convert (tree type, tree expr) /* If we are just removing the padding from expr, convert the original object if we have variable size in order to avoid the need for some - variable-size temporaries. Likewise if the padding is a mere variant + variable-sized temporaries. Likewise if the padding is a variant of the other, so we avoid a pointless unpad/repad sequence. */ if (TREE_CODE (expr) == COMPONENT_REF - && TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == RECORD_TYPE && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0))) && (!TREE_CONSTANT (TYPE_SIZE (type)) || gnat_types_compatible_p (type, @@ -3802,28 +3705,45 @@ convert (tree type, tree expr) == TYPE_NAME (TREE_TYPE (TYPE_FIELDS (type)))))) return convert (type, TREE_OPERAND (expr, 0)); - /* If the result type is a padded type with a self-referentially-sized - field and the expression type is a record, do this as an - unchecked conversion. */ - else if (TREE_CODE (etype) == RECORD_TYPE - && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)))) - return unchecked_convert (type, expr, false); + /* If the inner type is of self-referential size and the expression type + is a record, do this as an unchecked conversion. But first pad the + expression if possible to have the same size on both sides. */ + if (ecode == RECORD_TYPE + && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)))) + { + if (TREE_CONSTANT (TYPE_SIZE (etype))) + expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty, + false, false, false, true), expr); + return unchecked_convert (type, expr, false); + } - else - return - gnat_build_constructor (type, - tree_cons (TYPE_FIELDS (type), - convert (TREE_TYPE - (TYPE_FIELDS (type)), - expr), - NULL_TREE)); + /* If we are converting between array types with variable size, do the + final conversion as an unchecked conversion, again to avoid the need + for some variable-sized temporaries. If valid, this conversion is + very likely purely technical and without real effects. */ + if (ecode == ARRAY_TYPE + && TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE + && !TREE_CONSTANT (TYPE_SIZE (etype)) + && !TREE_CONSTANT (TYPE_SIZE (type))) + return unchecked_convert (type, + convert (TREE_TYPE (TYPE_FIELDS (type)), + expr), + false); + + return + gnat_build_constructor (type, + tree_cons (TYPE_FIELDS (type), + convert (TREE_TYPE + (TYPE_FIELDS (type)), + expr), + NULL_TREE)); } /* If the input type has padding, remove it and convert to the output type. The conditions ordering is arranged to ensure that the output type is not a padding type here, as it is not clear whether the conversion would always be correct if this was to happen. */ - else if (ecode == RECORD_TYPE && TYPE_IS_PADDING_P (etype)) + else if (ecode == RECORD_TYPE && TYPE_PADDING_P (etype)) { tree unpadded; @@ -3912,6 +3832,16 @@ convert (tree type, tree expr) } break; + case VECTOR_CST: + /* If we are converting a VECTOR_CST to a mere variant type, just make + a new one in the proper type. */ + if (code == ecode && gnat_types_compatible_p (type, etype)) + { + expr = copy_node (expr); + TREE_TYPE (expr) = type; + return expr; + } + case CONSTRUCTOR: /* If we are converting a CONSTRUCTOR to a mere variant type, just make a new one in the proper type. */ @@ -3922,11 +3852,14 @@ convert (tree type, tree expr) return expr; } - /* Likewise for a conversion between original and packable version, but - we have to work harder in order to preserve type consistency. */ + /* Likewise for a conversion between original and packable version, or + conversion between types of the same size and with the same list of + fields, but we have to work harder to preserve type consistency. */ if (code == ecode && code == RECORD_TYPE - && TYPE_NAME (type) == TYPE_NAME (etype)) + && (TYPE_NAME (type) == TYPE_NAME (etype) + || tree_int_cst_equal (TYPE_SIZE (type), TYPE_SIZE (etype)))) + { VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr); unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e); @@ -3935,26 +3868,96 @@ convert (tree type, tree expr) unsigned HOST_WIDE_INT idx; tree index, value; + /* Whether we need to clear TREE_CONSTANT et al. on the output + constructor when we convert in place. */ + bool clear_constant = false; + FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value) { - constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL); - /* We expect only simple constructors. Otherwise, punt. */ - if (!(index == efield || index == DECL_ORIGINAL_FIELD (efield))) + constructor_elt *elt; + /* We expect only simple constructors. */ + if (!SAME_FIELD_P (index, efield)) break; + /* The field must be the same. */ + if (!SAME_FIELD_P (efield, field)) + break; + elt = VEC_quick_push (constructor_elt, v, NULL); elt->index = field; elt->value = convert (TREE_TYPE (field), value); + + /* If packing has made this field a bitfield and the input + value couldn't be emitted statically any more, we need to + clear TREE_CONSTANT on our output. */ + if (!clear_constant + && TREE_CONSTANT (expr) + && !CONSTRUCTOR_BITFIELD_P (efield) + && CONSTRUCTOR_BITFIELD_P (field) + && !initializer_constant_valid_for_bitfield_p (value)) + clear_constant = true; + efield = TREE_CHAIN (efield); field = TREE_CHAIN (field); } + /* If we have been able to match and convert all the input fields + to their output type, convert in place now. We'll fallback to a + view conversion downstream otherwise. */ if (idx == len) { expr = copy_node (expr); TREE_TYPE (expr) = type; CONSTRUCTOR_ELTS (expr) = v; + if (clear_constant) + TREE_CONSTANT (expr) = TREE_STATIC (expr) = 0; return expr; } } + + /* Likewise for a conversion between array type and vector type with a + compatible representative array. */ + else if (code == VECTOR_TYPE + && ecode == ARRAY_TYPE + && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type), + etype)) + { + VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr); + unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e); + VEC(constructor_elt,gc) *v; + unsigned HOST_WIDE_INT ix; + tree value; + + /* Build a VECTOR_CST from a *constant* array constructor. */ + if (TREE_CONSTANT (expr)) + { + bool constant_p = true; + + /* Iterate through elements and check if all constructor + elements are *_CSTs. */ + FOR_EACH_CONSTRUCTOR_VALUE (e, ix, value) + if (!CONSTANT_CLASS_P (value)) + { + constant_p = false; + break; + } + + if (constant_p) + return build_vector_from_ctor (type, + CONSTRUCTOR_ELTS (expr)); + } + + /* Otherwise, build a regular vector constructor. */ + v = VEC_alloc (constructor_elt, gc, len); + FOR_EACH_CONSTRUCTOR_VALUE (e, ix, value) + { + constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL); + elt->index = NULL_TREE; + elt->value = value; + } + expr = copy_node (expr); + TREE_TYPE (expr) = type; + CONSTRUCTOR_ELTS (expr) = v; + return expr; + } break; case UNCONSTRAINED_ARRAY_REF: @@ -3983,10 +3986,11 @@ convert (tree type, tree expr) if (type == TREE_TYPE (op0)) return op0; - /* Otherwise, if we're converting between two aggregate types, we - might be allowed to substitute the VIEW_CONVERT_EXPR target type - in place or to just convert the inner expression. */ - if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype)) + /* Otherwise, if we're converting between two aggregate or vector + types, we might be allowed to substitute the VIEW_CONVERT_EXPR + target type in place or to just convert the inner expression. */ + if ((AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype)) + || (VECTOR_TYPE_P (type) && VECTOR_TYPE_P (etype))) { /* If we are converting between mere variants, we can just substitute the VIEW_CONVERT_EXPR in place. */ @@ -3996,46 +4000,46 @@ convert (tree type, tree expr) /* Otherwise, we may just bypass the input view conversion unless one of the types is a fat pointer, which is handled by specialized code below which relies on exact type matching. */ - else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)) + else if (!TYPE_IS_FAT_POINTER_P (type) + && !TYPE_IS_FAT_POINTER_P (etype)) return convert (type, op0); } } break; - case INDIRECT_REF: - /* If both types are record types, just convert the pointer and - make a new INDIRECT_REF. - - ??? Disable this for now since it causes problems with the - code in build_binary_op for MODIFY_EXPR which wants to - strip off conversions. But that code really is a mess and - we need to do this a much better way some time. */ - if (0 - && (TREE_CODE (type) == RECORD_TYPE - || TREE_CODE (type) == UNION_TYPE) - && (TREE_CODE (etype) == RECORD_TYPE - || TREE_CODE (etype) == UNION_TYPE) - && !TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)) - return build_unary_op (INDIRECT_REF, NULL_TREE, - convert (build_pointer_type (type), - TREE_OPERAND (expr, 0))); - break; - default: break; } /* Check for converting to a pointer to an unconstrained array. */ - if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)) + if (TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype)) return convert_to_fat_pointer (type, expr); - /* If we are converting between two aggregate types that are mere - variants, just make a VIEW_CONVERT_EXPR. */ - else if (code == ecode - && AGGREGATE_TYPE_P (type) - && gnat_types_compatible_p (type, etype)) + /* If we are converting between two aggregate or vector types that are mere + variants, just make a VIEW_CONVERT_EXPR. Likewise when we are converting + to a vector type from its representative array type. */ + else if ((code == ecode + && (AGGREGATE_TYPE_P (type) || VECTOR_TYPE_P (type)) + && gnat_types_compatible_p (type, etype)) + || (code == VECTOR_TYPE + && ecode == ARRAY_TYPE + && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type), + etype))) return build1 (VIEW_CONVERT_EXPR, type, expr); + /* If we are converting between tagged types, try to upcast properly. */ + else if (ecode == RECORD_TYPE && code == RECORD_TYPE + && TYPE_ALIGN_OK (etype) && TYPE_ALIGN_OK (type)) + { + tree child_etype = etype; + do { + tree field = TYPE_FIELDS (child_etype); + if (DECL_NAME (field) == parent_name_id && TREE_TYPE (field) == type) + return build_component_ref (expr, NULL_TREE, field, false); + child_etype = TREE_TYPE (field); + } while (TREE_CODE (child_etype) == RECORD_TYPE); + } + /* In all other cases of related types, make a NOP_EXPR. */ else if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype) || (code == INTEGER_CST && ecode == INTEGER_CST @@ -4093,7 +4097,7 @@ convert (tree type, tree expr) /* If converting between two pointers to records denoting both a template and type, adjust if needed to account for any differing offsets, since one might be negative. */ - if (TYPE_THIN_POINTER_P (etype) && TYPE_THIN_POINTER_P (type)) + if (TYPE_IS_THIN_POINTER_P (etype) && TYPE_IS_THIN_POINTER_P (type)) { tree bit_diff = size_diffop (bit_position (TYPE_FIELDS (TREE_TYPE (etype))), @@ -4111,13 +4115,13 @@ convert (tree type, tree expr) } /* If converting to a thin pointer, handle specially. */ - if (TYPE_THIN_POINTER_P (type) + if (TYPE_IS_THIN_POINTER_P (type) && TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type))) return convert_to_thin_pointer (type, expr); /* If converting fat pointer to normal pointer, get the pointer to the array and then convert it. */ - else if (TYPE_FAT_POINTER_P (etype)) + else if (TYPE_IS_FAT_POINTER_P (etype)) expr = build_component_ref (expr, get_identifier ("P_ARRAY"), NULL_TREE, false); @@ -4149,6 +4153,15 @@ convert (tree type, tree expr) return unchecked_convert (type, expr, false); case UNCONSTRAINED_ARRAY_TYPE: + /* If the input is a VECTOR_TYPE, convert to the representative + array type first. */ + if (ecode == VECTOR_TYPE) + { + expr = convert (TYPE_REPRESENTATIVE_ARRAY (etype), expr); + etype = TREE_TYPE (expr); + ecode = TREE_CODE (etype); + } + /* If EXPR is a constrained array, take its address, convert it to a fat pointer, and then dereference it. Likewise if EXPR is a record containing both a template and a constrained array. @@ -4205,8 +4218,7 @@ remove_conversions (tree exp, bool true_address) break; case COMPONENT_REF: - if (TREE_CODE (TREE_TYPE (TREE_OPERAND (exp, 0))) == RECORD_TYPE - && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (exp, 0)))) + if (TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (exp, 0)))) return remove_conversions (TREE_OPERAND (exp, 0), true_address); break; @@ -4229,20 +4241,20 @@ tree maybe_unconstrained_array (tree exp) { enum tree_code code = TREE_CODE (exp); - tree new; + tree new_exp; switch (TREE_CODE (TREE_TYPE (exp))) { case UNCONSTRAINED_ARRAY_TYPE: if (code == UNCONSTRAINED_ARRAY_REF) { - new + new_exp = build_unary_op (INDIRECT_REF, NULL_TREE, build_component_ref (TREE_OPERAND (exp, 0), get_identifier ("P_ARRAY"), NULL_TREE, false)); - TREE_READONLY (new) = TREE_STATIC (new) = TREE_READONLY (exp); - return new; + TREE_READONLY (new_exp) = TREE_READONLY (exp); + return new_exp; } else if (code == NULL_EXPR) @@ -4254,20 +4266,22 @@ maybe_unconstrained_array (tree exp) case RECORD_TYPE: /* If this is a padded type, convert to the unpadded type and see if it contains a template. */ - if (TYPE_IS_PADDING_P (TREE_TYPE (exp))) + if (TYPE_PADDING_P (TREE_TYPE (exp))) { - new = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp); - if (TREE_CODE (TREE_TYPE (new)) == RECORD_TYPE - && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new))) + new_exp = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp); + if (TREE_CODE (TREE_TYPE (new_exp)) == RECORD_TYPE + && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new_exp))) return - build_component_ref (new, NULL_TREE, - TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new))), - 0); + build_component_ref (new_exp, NULL_TREE, + TREE_CHAIN + (TYPE_FIELDS (TREE_TYPE (new_exp))), + false); } else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp))) return build_component_ref (exp, NULL_TREE, - TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))), 0); + TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))), + false); break; default: @@ -4276,10 +4290,23 @@ maybe_unconstrained_array (tree exp) return exp; } + +/* If EXP's type is a VECTOR_TYPE, return EXP converted to the associated + TYPE_REPRESENTATIVE_ARRAY. */ + +tree +maybe_vector_array (tree exp) +{ + tree etype = TREE_TYPE (exp); + + if (VECTOR_TYPE_P (etype)) + exp = convert (TYPE_REPRESENTATIVE_ARRAY (etype), exp); + + return exp; +} /* Return true if EXPR is an expression that can be folded as an operand - of a VIEW_CONVERT_EXPR. See the head comment of unchecked_convert for - the rationale. */ + of a VIEW_CONVERT_EXPR. See ada-tree.h for a complete rationale. */ static bool can_fold_for_view_convert_p (tree expr) @@ -4327,50 +4354,32 @@ can_fold_for_view_convert_p (tree expr) we expect the 8 bits at Vbits'Address to always contain Value, while their original location depends on the endianness, at Value'Address - on a little-endian architecture but not on a big-endian one. - - ??? There is a problematic discrepancy between what is called precision - here (and more generally throughout gigi) for integral types and what is - called precision in the middle-end. In the former case it's the RM size - as given by TYPE_RM_SIZE (or rm_size) whereas it's TYPE_PRECISION in the - latter case, the hitch being that they are not equal when they matter, - that is when the number of value bits is not equal to the type's size: - TYPE_RM_SIZE does give the number of value bits but TYPE_PRECISION is set - to the size. The sole exception are BOOLEAN_TYPEs for which both are 1. - - The consequence is that gigi must duplicate code bridging the gap between - the type's size and its precision that exists for TYPE_PRECISION in the - middle-end, because the latter knows nothing about TYPE_RM_SIZE, and be - wary of transformations applied in the middle-end based on TYPE_PRECISION - because this value doesn't reflect the actual precision for Ada. */ + on a little-endian architecture but not on a big-endian one. */ tree unchecked_convert (tree type, tree expr, bool notrunc_p) { tree etype = TREE_TYPE (expr); + enum tree_code ecode = TREE_CODE (etype); + enum tree_code code = TREE_CODE (type); - /* If the expression is already the right type, we are done. */ + /* If the expression is already of the right type, we are done. */ if (etype == type) return expr; /* If both types types are integral just do a normal conversion. Likewise for a conversion to an unconstrained array. */ if ((((INTEGRAL_TYPE_P (type) - && !(TREE_CODE (type) == INTEGER_TYPE - && TYPE_VAX_FLOATING_POINT_P (type))) - || (POINTER_TYPE_P (type) && ! TYPE_THIN_POINTER_P (type)) - || (TREE_CODE (type) == RECORD_TYPE - && TYPE_JUSTIFIED_MODULAR_P (type))) + && !(code == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (type))) + || (POINTER_TYPE_P (type) && ! TYPE_IS_THIN_POINTER_P (type)) + || (code == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (type))) && ((INTEGRAL_TYPE_P (etype) - && !(TREE_CODE (etype) == INTEGER_TYPE - && TYPE_VAX_FLOATING_POINT_P (etype))) - || (POINTER_TYPE_P (etype) && !TYPE_THIN_POINTER_P (etype)) - || (TREE_CODE (etype) == RECORD_TYPE - && TYPE_JUSTIFIED_MODULAR_P (etype)))) - || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) + && !(ecode == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (etype))) + || (POINTER_TYPE_P (etype) && !TYPE_IS_THIN_POINTER_P (etype)) + || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype)))) + || code == UNCONSTRAINED_ARRAY_TYPE) { - if (TREE_CODE (etype) == INTEGER_TYPE - && TYPE_BIASED_REPRESENTATION_P (etype)) + if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype)) { tree ntype = copy_type (etype); TYPE_BIASED_REPRESENTATION_P (ntype) = 0; @@ -4378,8 +4387,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) expr = build1 (NOP_EXPR, ntype, expr); } - if (TREE_CODE (type) == INTEGER_TYPE - && TYPE_BIASED_REPRESENTATION_P (type)) + if (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)) { tree rtype = copy_type (type); TYPE_BIASED_REPRESENTATION_P (rtype) = 0; @@ -4387,43 +4395,6 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) expr = convert (rtype, expr); expr = build1 (NOP_EXPR, type, expr); } - - /* We have another special case: if we are unchecked converting either - a subtype or a type with limited range into a base type, we need to - ensure that VRP doesn't propagate range information because this - conversion may be done precisely to validate that the object is - within the range it is supposed to have. */ - else if (TREE_CODE (expr) != INTEGER_CST - && TREE_CODE (type) == INTEGER_TYPE && !TREE_TYPE (type) - && ((TREE_CODE (etype) == INTEGER_TYPE && TREE_TYPE (etype)) - || TREE_CODE (etype) == ENUMERAL_TYPE - || TREE_CODE (etype) == BOOLEAN_TYPE)) - { - /* The optimization barrier is a VIEW_CONVERT_EXPR node; moreover, - in order not to be deemed an useless type conversion, it must - be from subtype to base type. - - Therefore we first do the bulk of the conversion to a subtype of - the final type. And this conversion must itself not be deemed - useless if the source type is not a subtype because, otherwise, - the final VIEW_CONVERT_EXPR will be deemed so as well. That's - why we toggle the unsigned flag in this conversion, which is - harmless since the final conversion is only a reinterpretation - of the bit pattern. - - ??? This may raise addressability and/or aliasing issues because - VIEW_CONVERT_EXPR gets gimplified as an lvalue, thus causing the - address of its operand to be taken if it is deemed addressable - and not already in GIMPLE form. */ - tree rtype - = gnat_type_for_mode (TYPE_MODE (type), !TYPE_UNSIGNED (etype)); - rtype = copy_type (rtype); - TYPE_MAIN_VARIANT (rtype) = rtype; - TREE_TYPE (rtype) = type; - expr = convert (rtype, expr); - expr = build1 (VIEW_CONVERT_EXPR, type, expr); - } - else expr = convert (type, expr); } @@ -4443,7 +4414,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) layout_type (rec_type); expr = unchecked_convert (rec_type, expr, notrunc_p); - expr = build_component_ref (expr, NULL_TREE, field, 0); + expr = build_component_ref (expr, NULL_TREE, field, false); } /* Similarly if we are converting from an integral type whose precision @@ -4464,19 +4435,28 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) expr = unchecked_convert (type, expr, notrunc_p); } - /* We have a special case when we are converting between two - unconstrained array types. In that case, take the address, - convert the fat pointer types, and dereference. */ - else if (TREE_CODE (etype) == UNCONSTRAINED_ARRAY_TYPE - && TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) + /* We have a special case when we are converting between two unconstrained + array types. In that case, take the address, convert the fat pointer + types, and dereference. */ + else if (ecode == code && code == UNCONSTRAINED_ARRAY_TYPE) expr = build_unary_op (INDIRECT_REF, NULL_TREE, build1 (VIEW_CONVERT_EXPR, TREE_TYPE (type), build_unary_op (ADDR_EXPR, NULL_TREE, expr))); + + /* Another special case is when we are converting to a vector type from its + representative array type; this a regular conversion. */ + else if (code == VECTOR_TYPE + && ecode == ARRAY_TYPE + && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type), + etype)) + expr = convert (type, expr); + else { expr = maybe_unconstrained_array (expr); etype = TREE_TYPE (expr); + ecode = TREE_CODE (etype); if (can_fold_for_view_convert_p (expr)) expr = fold_build1 (VIEW_CONVERT_EXPR, type, expr); else @@ -4489,8 +4469,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) is a biased type or if both the input and output are unsigned. */ if (!notrunc_p && INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type) - && !(TREE_CODE (type) == INTEGER_TYPE - && TYPE_BIASED_REPRESENTATION_P (type)) + && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)) && 0 != compare_tree_int (TYPE_RM_SIZE (type), GET_MODE_BITSIZE (TYPE_MODE (type))) && !(INTEGRAL_TYPE_P (etype) @@ -4501,8 +4480,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) 0)) && !(TYPE_UNSIGNED (type) && TYPE_UNSIGNED (etype))) { - tree base_type = gnat_type_for_mode (TYPE_MODE (type), - TYPE_UNSIGNED (type)); + tree base_type + = gnat_type_for_mode (TYPE_MODE (type), TYPE_UNSIGNED (type)); tree shift_expr = convert (base_type, size_binop (MINUS_EXPR, @@ -4564,6 +4543,62 @@ tree_code_for_record_type (Entity_Id gnat_type) return UNION_TYPE; } +/* Return true if GNAT_TYPE is a "double" floating-point type, i.e. whose + size is equal to 64 bits, or an array of such a type. Set ALIGN_CLAUSE + according to the presence of an alignment clause on the type or, if it + is an array, on the component type. */ + +bool +is_double_float_or_array (Entity_Id gnat_type, bool *align_clause) +{ + gnat_type = Underlying_Type (gnat_type); + + *align_clause = Present (Alignment_Clause (gnat_type)); + + if (Is_Array_Type (gnat_type)) + { + gnat_type = Underlying_Type (Component_Type (gnat_type)); + if (Present (Alignment_Clause (gnat_type))) + *align_clause = true; + } + + if (!Is_Floating_Point_Type (gnat_type)) + return false; + + if (UI_To_Int (Esize (gnat_type)) != 64) + return false; + + return true; +} + +/* Return true if GNAT_TYPE is a "double" or larger scalar type, i.e. whose + size is greater or equal to 64 bits, or an array of such a type. Set + ALIGN_CLAUSE according to the presence of an alignment clause on the + type or, if it is an array, on the component type. */ + +bool +is_double_scalar_or_array (Entity_Id gnat_type, bool *align_clause) +{ + gnat_type = Underlying_Type (gnat_type); + + *align_clause = Present (Alignment_Clause (gnat_type)); + + if (Is_Array_Type (gnat_type)) + { + gnat_type = Underlying_Type (Component_Type (gnat_type)); + if (Present (Alignment_Clause (gnat_type))) + *align_clause = true; + } + + if (!Is_Scalar_Type (gnat_type)) + return false; + + if (UI_To_Int (Esize (gnat_type)) < 64) + return false; + + return true; +} + /* Return true if GNU_TYPE is suitable as the type of a non-aliased component of an aggregate type. */ @@ -4603,7 +4638,7 @@ gnat_write_global_declarations (void) { /* Proceed to optimize and emit assembly. FIXME: shouldn't be the front end's responsibility to call this. */ - cgraph_optimize (); + cgraph_finalize_compilation_unit (); /* Emit debug info for all global declarations. */ emit_debug_global_declarations (VEC_address (tree, global_decls), @@ -4697,7 +4732,7 @@ build_void_list_node (void) static tree builtin_type_for_size (int size, bool unsignedp) { - tree type = lang_hooks.types.type_for_size (size, unsignedp); + tree type = gnat_type_for_size (size, unsignedp); return type ? type : error_mark_node; } @@ -4786,7 +4821,7 @@ def_fn_type (builtin_type def, builtin_type ret, bool var, int n, ...) va_start (list, n); for (i = 0; i < n; ++i) { - builtin_type a = va_arg (list, builtin_type); + builtin_type a = (builtin_type) va_arg (list, int); t = builtin_types[a]; if (t == error_mark_node) goto egress; @@ -4967,7 +5002,8 @@ handle_pure_attribute (tree *node, tree name, tree ARG_UNUSED (args), /* ??? TODO: Support types. */ else { - warning (OPT_Wattributes, "%qE attribute ignored", name); + warning (OPT_Wattributes, "%qs attribute ignored", + IDENTIFIER_POINTER (name)); *no_add_attrs = true; } @@ -5082,7 +5118,8 @@ handle_sentinel_attribute (tree *node, tree name, tree args, if (!params) { warning (OPT_Wattributes, - "%qE attribute requires prototypes with named arguments", name); + "%qs attribute requires prototypes with named arguments", + IDENTIFIER_POINTER (name)); *no_add_attrs = true; } else @@ -5093,7 +5130,8 @@ handle_sentinel_attribute (tree *node, tree name, tree args, if (VOID_TYPE_P (TREE_VALUE (params))) { warning (OPT_Wattributes, - "%qE attribute only applies to variadic functions", name); + "%qs attribute only applies to variadic functions", + IDENTIFIER_POINTER (name)); *no_add_attrs = true; } } @@ -5140,7 +5178,8 @@ handle_noreturn_attribute (tree *node, tree name, tree ARG_UNUSED (args), TYPE_READONLY (TREE_TYPE (type)), 1)); else { - warning (OPT_Wattributes, "%qE attribute ignored", name); + warning (OPT_Wattributes, "%qs attribute ignored", + IDENTIFIER_POINTER (name)); *no_add_attrs = true; } @@ -5159,7 +5198,8 @@ handle_malloc_attribute (tree *node, tree name, tree ARG_UNUSED (args), DECL_IS_MALLOC (*node) = 1; else { - warning (OPT_Wattributes, "%qE attribute ignored", name); + warning (OPT_Wattributes, "%qs attribute ignored", + IDENTIFIER_POINTER (name)); *no_add_attrs = true; } @@ -5200,6 +5240,189 @@ handle_type_generic_attribute (tree *node, tree ARG_UNUSED (name), return NULL_TREE; } +/* Handle a "vector_size" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_vector_size_attribute (tree *node, tree name, tree args, + int ARG_UNUSED (flags), + bool *no_add_attrs) +{ + unsigned HOST_WIDE_INT vecsize, nunits; + enum machine_mode orig_mode; + tree type = *node, new_type, size; + + *no_add_attrs = true; + + size = TREE_VALUE (args); + + if (!host_integerp (size, 1)) + { + warning (OPT_Wattributes, "%qs attribute ignored", + IDENTIFIER_POINTER (name)); + return NULL_TREE; + } + + /* Get the vector size (in bytes). */ + vecsize = tree_low_cst (size, 1); + + /* We need to provide for vector pointers, vector arrays, and + functions returning vectors. For example: + + __attribute__((vector_size(16))) short *foo; + + In this case, the mode is SI, but the type being modified is + HI, so we need to look further. */ + + while (POINTER_TYPE_P (type) + || TREE_CODE (type) == FUNCTION_TYPE + || TREE_CODE (type) == METHOD_TYPE + || TREE_CODE (type) == ARRAY_TYPE + || TREE_CODE (type) == OFFSET_TYPE) + type = TREE_TYPE (type); + + /* Get the mode of the type being modified. */ + orig_mode = TYPE_MODE (type); + + if ((!INTEGRAL_TYPE_P (type) + && !SCALAR_FLOAT_TYPE_P (type) + && !FIXED_POINT_TYPE_P (type)) + || (!SCALAR_FLOAT_MODE_P (orig_mode) + && GET_MODE_CLASS (orig_mode) != MODE_INT + && !ALL_SCALAR_FIXED_POINT_MODE_P (orig_mode)) + || !host_integerp (TYPE_SIZE_UNIT (type), 1) + || TREE_CODE (type) == BOOLEAN_TYPE) + { + error ("invalid vector type for attribute %qs", + IDENTIFIER_POINTER (name)); + return NULL_TREE; + } + + if (vecsize % tree_low_cst (TYPE_SIZE_UNIT (type), 1)) + { + error ("vector size not an integral multiple of component size"); + return NULL; + } + + if (vecsize == 0) + { + error ("zero vector size"); + return NULL; + } + + /* Calculate how many units fit in the vector. */ + nunits = vecsize / tree_low_cst (TYPE_SIZE_UNIT (type), 1); + if (nunits & (nunits - 1)) + { + error ("number of components of the vector not a power of two"); + return NULL_TREE; + } + + new_type = build_vector_type (type, nunits); + + /* Build back pointers if needed. */ + *node = lang_hooks.types.reconstruct_complex_type (*node, new_type); + + return NULL_TREE; +} + +/* Handle a "vector_type" attribute; arguments as in + struct attribute_spec.handler. */ + +static tree +handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args), + int ARG_UNUSED (flags), + bool *no_add_attrs) +{ + /* Vector representative type and size. */ + tree rep_type = *node; + tree rep_size = TYPE_SIZE_UNIT (rep_type); + tree rep_name; + + /* Vector size in bytes and number of units. */ + unsigned HOST_WIDE_INT vec_bytes, vec_units; + + /* Vector element type and mode. */ + tree elem_type; + enum machine_mode elem_mode; + + *no_add_attrs = true; + + /* Get the representative array type, possibly nested within a + padding record e.g. for alignment purposes. */ + + if (TYPE_IS_PADDING_P (rep_type)) + rep_type = TREE_TYPE (TYPE_FIELDS (rep_type)); + + if (TREE_CODE (rep_type) != ARRAY_TYPE) + { + error ("attribute %qs applies to array types only", + IDENTIFIER_POINTER (name)); + return NULL_TREE; + } + + /* Silently punt on variable sizes. We can't make vector types for them, + need to ignore them on front-end generated subtypes of unconstrained + bases, and this attribute is for binding implementors, not end-users, so + we should never get there from legitimate explicit uses. */ + + if (!host_integerp (rep_size, 1)) + return NULL_TREE; + + /* Get the element type/mode and check this is something we know + how to make vectors of. */ + + elem_type = TREE_TYPE (rep_type); + elem_mode = TYPE_MODE (elem_type); + + if ((!INTEGRAL_TYPE_P (elem_type) + && !SCALAR_FLOAT_TYPE_P (elem_type) + && !FIXED_POINT_TYPE_P (elem_type)) + || (!SCALAR_FLOAT_MODE_P (elem_mode) + && GET_MODE_CLASS (elem_mode) != MODE_INT + && !ALL_SCALAR_FIXED_POINT_MODE_P (elem_mode)) + || !host_integerp (TYPE_SIZE_UNIT (elem_type), 1)) + { + error ("invalid element type for attribute %qs", + IDENTIFIER_POINTER (name)); + return NULL_TREE; + } + + /* Sanity check the vector size and element type consistency. */ + + vec_bytes = tree_low_cst (rep_size, 1); + + if (vec_bytes % tree_low_cst (TYPE_SIZE_UNIT (elem_type), 1)) + { + error ("vector size not an integral multiple of component size"); + return NULL; + } + + if (vec_bytes == 0) + { + error ("zero vector size"); + return NULL; + } + + vec_units = vec_bytes / tree_low_cst (TYPE_SIZE_UNIT (elem_type), 1); + if (vec_units & (vec_units - 1)) + { + error ("number of components of the vector not a power of two"); + return NULL_TREE; + } + + /* Build the vector type and replace. */ + + *node = build_vector_type (elem_type, vec_units); + rep_name = TYPE_NAME (rep_type); + if (TREE_CODE (rep_name) == TYPE_DECL) + rep_name = DECL_NAME (rep_name); + TYPE_NAME (*node) = rep_name; + TYPE_REPRESENTATIVE_ARRAY (*node) = rep_type; + + return NULL_TREE; +} + /* ----------------------------------------------------------------------- * * BUILTIN FUNCTIONS * * ----------------------------------------------------------------------- */