X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=gcc%2Fada%2Fgcc-interface%2Futils.c;h=335941a2e0cd139a3187db0abf0765f812f6b9e2;hp=b1e2e588347ddcac2f1cf092ad31eeb829702ec4;hb=5c96587ce00d1c93c6497101b30bb26e0704317b;hpb=90aa6d7defcc5c368fcf6e64910cbed12cc2cbdb diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index b1e2e588347..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- * @@ -59,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 @@ -298,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); @@ -564,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); @@ -587,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. */ @@ -600,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; @@ -631,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); @@ -737,7 +732,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level, } if (code == QUAL_UNION_TYPE) - nreverse (fieldlist); + nreverse (field_list); if (rep_level < 2) { @@ -768,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, @@ -1100,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; } @@ -1162,6 +1153,23 @@ copy_type (tree 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) = TYPE_STUB_DECL (type); @@ -1373,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 @@ -1408,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); @@ -1457,13 +1469,13 @@ 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, @@ -1497,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 @@ -1816,9 +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 (input_location, - 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 @@ -1839,23 +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 (input_location, - 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) { @@ -1909,163 +1906,6 @@ 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 finalize it. */ void @@ -2099,9 +1939,6 @@ end_subprog_body (tree body) 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); @@ -2185,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. */ @@ -2795,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; } @@ -3109,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; } @@ -3521,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; } @@ -3738,7 +3587,7 @@ convert_to_fat_pointer (tree type, tree expr) { 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 @@ -3807,12 +3656,12 @@ 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 @@ -3859,7 +3708,7 @@ convert (tree type, tree expr) /* 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 (TREE_CODE (etype) == RECORD_TYPE + if (ecode == RECORD_TYPE && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)))) { if (TREE_CONSTANT (TYPE_SIZE (etype))) @@ -3872,7 +3721,7 @@ convert (tree type, tree expr) 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 (TREE_CODE (etype) == ARRAY_TYPE + if (ecode == ARRAY_TYPE && TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE && !TREE_CONSTANT (TYPE_SIZE (etype)) && !TREE_CONSTANT (TYPE_SIZE (type))) @@ -4003,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); @@ -4022,17 +3874,22 @@ convert (tree type, tree expr) 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) + if (!clear_constant + && TREE_CONSTANT (expr) && !CONSTRUCTOR_BITFIELD_P (efield) && CONSTRUCTOR_BITFIELD_P (field) && !initializer_constant_valid_for_bitfield_p (value)) @@ -4051,7 +3908,7 @@ convert (tree type, tree expr) TREE_TYPE (expr) = type; CONSTRUCTOR_ELTS (expr) = v; if (clear_constant) - TREE_CONSTANT (expr) = TREE_STATIC (expr) = false; + TREE_CONSTANT (expr) = TREE_STATIC (expr) = 0; return expr; } } @@ -4150,25 +4007,6 @@ convert (tree type, tree expr) } 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_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype)) - return build_unary_op (INDIRECT_REF, NULL_TREE, - convert (build_pointer_type (type), - TREE_OPERAND (expr, 0))); - break; - default: break; } @@ -4189,6 +4027,19 @@ convert (tree type, tree expr) 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 @@ -4402,8 +4253,7 @@ maybe_unconstrained_array (tree exp) build_component_ref (TREE_OPERAND (exp, 0), get_identifier ("P_ARRAY"), NULL_TREE, false)); - TREE_READONLY (new_exp) = TREE_STATIC (new_exp) - = TREE_READONLY (exp); + TREE_READONLY (new_exp) = TREE_READONLY (exp); return new_exp; } @@ -4425,12 +4275,13 @@ maybe_unconstrained_array (tree exp) build_component_ref (new_exp, NULL_TREE, TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new_exp))), - 0); + 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: @@ -4509,29 +4360,26 @@ 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))) + && !(code == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (type))) || (POINTER_TYPE_P (type) && ! TYPE_IS_THIN_POINTER_P (type)) - || (TREE_CODE (type) == RECORD_TYPE - && TYPE_JUSTIFIED_MODULAR_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))) + && !(ecode == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (etype))) || (POINTER_TYPE_P (etype) && !TYPE_IS_THIN_POINTER_P (etype)) - || (TREE_CODE (etype) == RECORD_TYPE - && TYPE_JUSTIFIED_MODULAR_P (etype)))) - || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) + || (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; @@ -4539,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; @@ -4567,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 @@ -4591,8 +4438,7 @@ unchecked_convert (tree type, tree expr, bool 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) + 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, @@ -4600,8 +4446,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) /* Another special case is when we are converting to a vector type from its representative array type; this a regular conversion. */ - else if (TREE_CODE (type) == VECTOR_TYPE - && TREE_CODE (etype) == ARRAY_TYPE + else if (code == VECTOR_TYPE + && ecode == ARRAY_TYPE && gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type), etype)) expr = convert (type, expr); @@ -4610,6 +4456,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) { 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 @@ -4622,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) @@ -4634,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, @@ -4886,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; }