diff options
Diffstat (limited to 'gcc/ada/gcc-interface')
| -rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 2 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 96 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/misc.c | 56 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/targtyps.c | 1 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 46 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 145 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils2.c | 8 |
7 files changed, 177 insertions, 177 deletions
diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index 8db581098dc..9a32b608ea5 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -1253,7 +1253,7 @@ ada/misc.o : ada/gcc-interface/misc.c $(CONFIG_H) $(SYSTEM_H) coretypes.h \ $(COMPILER) -c $(ALL_COMPILERFLAGS) -I.. $(ALL_CPPFLAGS) $< -o $@ ada/targtyps.o : ada/gcc-interface/targtyps.c $(CONFIG_H) $(SYSTEM_H) \ - coretypes.h $(TM_H) $(TREE_H) ada/gcc-interface/ada.h \ + coretypes.h $(TM_H) $(TM_P_H) $(TREE_H) ada/gcc-interface/ada.h \ ada/types.h ada/atree.h ada/elists.h ada/namet.h ada/nlists.h \ ada/snames.h ada/stringt.h ada/uintp.h ada/urealp.h ada/fe.h ada/sinfo.h \ ada/einfo.h $(ADA_TREE_H) ada/gcc-interface/gigi.h diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 6952060259d..54d02225e01 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1049,7 +1049,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) : TYPE_FIELDS (gnu_type); VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 1); tree t = build_template (TREE_TYPE (template_field), - TREE_TYPE (TREE_CHAIN (template_field)), + TREE_TYPE (DECL_CHAIN (template_field)), NULL_TREE); CONSTRUCTOR_APPEND_ELT (v, template_field, t); gnu_expr = gnat_build_constructor (gnu_type, v); @@ -1207,7 +1207,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && TYPE_CONTAINS_TEMPLATE_P (gnu_alloc_type)) { gnu_alloc_type - = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_alloc_type))); + = TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_alloc_type))); if (TREE_CODE (gnu_expr) == CONSTRUCTOR && 1 == VEC_length (constructor_elt, @@ -1217,7 +1217,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_expr = build_component_ref (gnu_expr, NULL_TREE, - TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))), + DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (gnu_expr))), false); } @@ -1496,7 +1496,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Note that the bounds are updated at the end of this function to avoid an infinite recursion since they refer to the type. */ } - break; + goto discrete_type; case E_Signed_Integer_Type: case E_Ordinary_Fixed_Point_Type: @@ -1504,7 +1504,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* For integer types, just make a signed type the appropriate number of bits. */ gnu_type = make_signed_type (esize); - break; + goto discrete_type; case E_Modular_Integer_Type: { @@ -1543,7 +1543,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = gnu_subtype; } } - break; + goto discrete_type; case E_Signed_Integer_Subtype: case E_Enumeration_Subtype: @@ -1632,6 +1632,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnat_to_gnu_type (Original_Array_Type (gnat_entity))); + discrete_type: + /* We have to handle clauses that under-align the type specially. */ if ((Present (Alignment_Clause (gnat_entity)) || (Is_Packed_Array_Type (gnat_entity) @@ -1685,9 +1687,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); - /* Don't notify the field as "addressable", since we won't be taking - it's address and it would prevent create_field_decl from making a - bitfield. */ + /* Don't declare the field as addressable since we won't be taking + its address and this would prevent create_field_decl from making + a bitfield. */ gnu_field = create_field_decl (get_identifier ("OBJECT"), gnu_field_type, gnu_type, NULL_TREE, bitsize_zero_node, 1, 0); @@ -1736,9 +1738,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_ALIGN (gnu_type) = align; relate_alias_sets (gnu_type, gnu_field_type, ALIAS_SET_COPY); - /* Don't notify the field as "addressable", since we won't be taking - it's address and it would prevent create_field_decl from making a - bitfield. */ + /* Don't declare the field as addressable since we won't be taking + its address and this would prevent create_field_decl from making + a bitfield. */ gnu_field = create_field_decl (get_identifier ("F"), gnu_field_type, gnu_type, NULL_TREE, bitsize_zero_node, 1, 0); @@ -1894,7 +1896,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) fields once we build them. */ tem = build3 (COMPONENT_REF, gnu_ptr_template, build0 (PLACEHOLDER_EXPR, gnu_fat_type), - TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE); + DECL_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE); gnu_template_reference = build_unary_op (INDIRECT_REF, gnu_template_type, tem); TREE_READONLY (gnu_template_reference) = 1; @@ -2433,7 +2435,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_field = create_field_decl (gnu_index_name, gnu_index, gnu_bound_rec, NULL_TREE, NULL_TREE, 0, 0); - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; } @@ -2903,7 +2905,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (!is_unchecked_union) { - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; } } @@ -2948,8 +2950,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) for (gnu_field = TYPE_FIELDS (gnu_type), gnu_std_field = TYPE_FIELDS (except_type_node); gnu_field; - gnu_field = TREE_CHAIN (gnu_field), - gnu_std_field = TREE_CHAIN (gnu_std_field)) + gnu_field = DECL_CHAIN (gnu_field), + gnu_std_field = DECL_CHAIN (gnu_std_field)) SET_DECL_ORIGINAL_FIELD_TO_FIELD (gnu_field, gnu_std_field); gcc_assert (!gnu_std_field); } @@ -3205,7 +3207,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Put it in one of the new variants directly. */ if (gnu_cont_type != gnu_type) { - TREE_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type); + DECL_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type); TYPE_FIELDS (gnu_cont_type) = gnu_field; } @@ -3229,7 +3231,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) the other fields. */ else { - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; if (!gnu_last) gnu_last = gnu_field; @@ -3246,7 +3248,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_variant_part_from (gnu_variant_part, gnu_variant_list, gnu_type, gnu_pos_list, gnu_subst_list); - TREE_CHAIN (new_variant_part) = gnu_field_list; + DECL_CHAIN (new_variant_part) = gnu_field_list; gnu_field_list = new_variant_part; } @@ -3518,7 +3520,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = create_field_decl (get_identifier ("P_ARRAY"), gnu_ptr_array, gnu_type, NULL_TREE, NULL_TREE, 0, 0); - TREE_CHAIN (fields) + DECL_CHAIN (fields) = create_field_decl (get_identifier ("P_BOUNDS"), gnu_ptr_template, gnu_type, NULL_TREE, NULL_TREE, 0, 0); @@ -4139,7 +4141,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 0, 0); Sloc_to_locus (Sloc (gnat_param), &DECL_SOURCE_LOCATION (gnu_field)); - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; gnu_cico_list = tree_cons (gnu_field, gnu_param, gnu_cico_list); @@ -6138,7 +6140,7 @@ make_packable_type (tree type, bool in_record) /* Now copy the fields, keeping the position and size as we don't want to change the layout by propagating the packedness downwards. */ for (old_field = TYPE_FIELDS (type); old_field; - old_field = TREE_CHAIN (old_field)) + old_field = DECL_CHAIN (old_field)) { tree new_field_type = TREE_TYPE (old_field); tree new_field, new_size; @@ -6153,7 +6155,7 @@ make_packable_type (tree type, bool in_record) /* However, for the last field in a not already packed record type that is of an aggregate type, we need to use the RM size in the packable version of the record type, see finish_record_type. */ - if (!TREE_CHAIN (old_field) + if (!DECL_CHAIN (old_field) && !TYPE_PACKED (type) && (TREE_CODE (new_field_type) == RECORD_TYPE || TREE_CODE (new_field_type) == UNION_TYPE @@ -6176,7 +6178,7 @@ make_packable_type (tree type, bool in_record) if (TREE_CODE (new_type) == QUAL_UNION_TYPE) DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field); - TREE_CHAIN (new_field) = field_list; + DECL_CHAIN (new_field) = field_list; field_list = new_field; } @@ -6829,7 +6831,7 @@ is_variable_size (tree type) && TREE_CODE (type) != QUAL_UNION_TYPE) return false; - for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) if (is_variable_size (TREE_TYPE (field))) return true; @@ -6927,14 +6929,14 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, fields except for the _Tag or _Parent field. */ else if (gnat_name == Name_uController && gnu_last) { - TREE_CHAIN (gnu_field) = TREE_CHAIN (gnu_last); - TREE_CHAIN (gnu_last) = gnu_field; + DECL_CHAIN (gnu_field) = DECL_CHAIN (gnu_last); + DECL_CHAIN (gnu_last) = gnu_field; } /* If this is a regular field, put it after the other fields. */ else { - TREE_CHAIN (gnu_field) = gnu_field_list; + DECL_CHAIN (gnu_field) = gnu_field_list; gnu_field_list = gnu_field; if (!gnu_last) gnu_last = gnu_field; @@ -7033,7 +7035,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, use this field directly to match the layout of C unions. */ if (unchecked_union && TYPE_FIELDS (gnu_variant_type) - && !TREE_CHAIN (TYPE_FIELDS (gnu_variant_type))) + && !DECL_CHAIN (TYPE_FIELDS (gnu_variant_type))) gnu_field = TYPE_FIELDS (gnu_variant_type); else { @@ -7065,7 +7067,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, DECL_QUALIFIER (gnu_field) = gnu_qual; } - TREE_CHAIN (gnu_field) = gnu_variant_list; + DECL_CHAIN (gnu_field) = gnu_variant_list; gnu_variant_list = gnu_field; } @@ -7109,7 +7111,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, union_field_packed, 0); DECL_INTERNAL_P (gnu_union_field) = 1; - TREE_CHAIN (gnu_union_field) = gnu_field_list; + DECL_CHAIN (gnu_union_field) = gnu_field_list; gnu_field_list = gnu_union_field; } } @@ -7124,16 +7126,16 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_last = NULL_TREE; for (gnu_field = gnu_field_list; gnu_field; gnu_field = gnu_next) { - gnu_next = TREE_CHAIN (gnu_field); + gnu_next = DECL_CHAIN (gnu_field); if (DECL_FIELD_OFFSET (gnu_field)) { if (!gnu_last) gnu_field_list = gnu_next; else - TREE_CHAIN (gnu_last) = gnu_next; + DECL_CHAIN (gnu_last) = gnu_next; - TREE_CHAIN (gnu_field) = gnu_our_rep_list; + DECL_CHAIN (gnu_field) = gnu_our_rep_list; gnu_our_rep_list = gnu_field; } else @@ -7157,7 +7159,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, for (gnu_field = gnu_our_rep_list, i = 0; gnu_field; - gnu_field = TREE_CHAIN (gnu_field), i++) + gnu_field = DECL_CHAIN (gnu_field), i++) gnu_arr[i] = gnu_field; qsort (gnu_arr, len, sizeof (tree), compare_field_bitpos); @@ -7167,7 +7169,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list, gnu_our_rep_list = NULL_TREE; for (i = len - 1; i >= 0; i--) { - TREE_CHAIN (gnu_arr[i]) = gnu_our_rep_list; + DECL_CHAIN (gnu_arr[i]) = gnu_our_rep_list; gnu_our_rep_list = gnu_arr[i]; DECL_CONTEXT (gnu_arr[i]) = gnu_rep_type; } @@ -7351,7 +7353,7 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) { if (TREE_CODE (gnu_type) == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) - size = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)))); + size = TYPE_SIZE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))); else if (!size) size = TYPE_SIZE (gnu_type); @@ -7467,7 +7469,7 @@ build_position_list (tree gnu_type, bool do_not_flatten_variant, tree gnu_pos, for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field; - gnu_field = TREE_CHAIN (gnu_field)) + gnu_field = DECL_CHAIN (gnu_field)) { tree gnu_our_bitpos = size_binop (PLUS_EXPR, gnu_bitpos, DECL_FIELD_BIT_OFFSET (gnu_field)); @@ -7553,7 +7555,7 @@ build_variant_list (tree qual_union_type, tree subst_list, tree gnu_list) for (gnu_field = TYPE_FIELDS (qual_union_type); gnu_field; - gnu_field = TREE_CHAIN (gnu_field)) + gnu_field = DECL_CHAIN (gnu_field)) { tree t, qual = DECL_QUALIFIER (gnu_field); @@ -8290,7 +8292,7 @@ get_variant_part (tree record_type) tree field; /* The variant part is the only internal field that is a qualified union. */ - for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field)) if (DECL_INTERNAL_P (field) && TREE_CODE (TREE_TYPE (field)) == QUAL_UNION_TYPE) return field; @@ -8361,7 +8363,7 @@ create_variant_part_from (tree old_variant_part, tree variant_list, tree new_variant_subpart = create_variant_part_from (old_variant_subpart, variant_list, new_variant, pos_list, subst_list); - TREE_CHAIN (new_variant_subpart) = field_list; + DECL_CHAIN (new_variant_subpart) = field_list; field_list = new_variant_subpart; } @@ -8378,7 +8380,7 @@ create_variant_part_from (tree old_variant_part, tree variant_list, pos_list, subst_list); DECL_QUALIFIER (new_field) = TREE_VEC_ELT (TREE_VALUE (t), 1); DECL_INTERNAL_P (new_field) = 1; - TREE_CHAIN (new_field) = union_field_list; + DECL_CHAIN (new_field) = union_field_list; union_field_list = new_field; } @@ -8399,7 +8401,7 @@ create_variant_part_from (tree old_variant_part, tree variant_list, statically selected while outer ones are not; in this case, the list of fields of the inner variant is not flattened and we end up with a qualified union with a single member. Drop the useless container. */ - if (!TREE_CHAIN (union_field_list)) + if (!DECL_CHAIN (union_field_list)) { DECL_CONTEXT (union_field_list) = record_type; DECL_FIELD_OFFSET (union_field_list) @@ -8564,7 +8566,7 @@ substitute_in_type (tree t, tree f, tree r) nt = copy_type (t); TYPE_FIELDS (nt) = NULL_TREE; - for (field = TYPE_FIELDS (t); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (t); field; field = DECL_CHAIN (field)) { tree new_field = copy_node (field), new_n; @@ -8596,7 +8598,7 @@ substitute_in_type (tree t, tree f, tree r) DECL_CONTEXT (new_field) = nt; SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field); - TREE_CHAIN (new_field) = TYPE_FIELDS (nt); + DECL_CHAIN (new_field) = TYPE_FIELDS (nt); TYPE_FIELDS (nt) = new_field; } @@ -8630,7 +8632,7 @@ rm_size (tree gnu_type) && TYPE_CONTAINS_TEMPLATE_P (gnu_type)) return size_binop (PLUS_EXPR, - rm_size (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)))), + rm_size (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))), DECL_SIZE (TYPE_FIELDS (gnu_type))); /* For record types, we store the size explicitly. */ diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 4033173d782..8444e4f714c 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -191,7 +191,6 @@ gnat_handle_option (size_t scode, const char *arg, int value, { const struct cl_option *option = &cl_options[scode]; enum opt_code code = (enum opt_code) scode; - char *q; if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE))) { @@ -201,20 +200,11 @@ gnat_handle_option (size_t scode, const char *arg, int value, switch (code) { - case OPT_I: - q = XNEWVEC (char, sizeof("-I") + strlen (arg)); - strcpy (q, "-I"); - strcat (q, arg); - gnat_argv[gnat_argc] = q; - gnat_argc++; - break; - case OPT_Wall: warn_unused = value; warn_uninitialized = value; break; - /* These are used in the GCC Makefile. */ case OPT_Wmissing_prototypes: case OPT_Wstrict_prototypes: case OPT_Wwrite_strings: @@ -223,15 +213,7 @@ gnat_handle_option (size_t scode, const char *arg, int value, case OPT_Wold_style_definition: case OPT_Wmissing_format_attribute: case OPT_Woverlength_strings: - break; - - /* This is handled by the front-end. */ - case OPT_nostdinc: - break; - - case OPT_nostdlib: - gnat_argv[gnat_argc] = xstrdup ("-nostdlib"); - gnat_argc++; + /* These are used in the GCC Makefile. */ break; case OPT_feliminate_unused_debug_types: @@ -242,9 +224,8 @@ gnat_handle_option (size_t scode, const char *arg, int value, flag_eliminate_unused_debug_types = -value; break; - case OPT_fRTS_: - gnat_argv[gnat_argc] = xstrdup ("-fRTS"); - gnat_argc++; + case OPT_gdwarfplus: + gnat_dwarf_extensions = 1; break; case OPT_gant: @@ -253,22 +234,12 @@ gnat_handle_option (size_t scode, const char *arg, int value, /* ... fall through ... */ case OPT_gnat: - /* Recopy the switches without the 'gnat' prefix. */ - gnat_argv[gnat_argc] = XNEWVEC (char, strlen (arg) + 2); - gnat_argv[gnat_argc][0] = '-'; - strcpy (gnat_argv[gnat_argc] + 1, arg); - gnat_argc++; - break; - case OPT_gnatO: - gnat_argv[gnat_argc] = xstrdup ("-O"); - gnat_argc++; - gnat_argv[gnat_argc] = xstrdup (arg); - gnat_argc++; - break; - - case OPT_gdwarfplus: - gnat_dwarf_extensions = 1; + case OPT_fRTS_: + case OPT_I: + case OPT_nostdinc: + case OPT_nostdlib: + /* These are handled by the front-end. */ break; default: @@ -283,8 +254,7 @@ gnat_handle_option (size_t scode, const char *arg, int value, static unsigned int gnat_init_options (unsigned int argc, const char **argv) { - /* Initialize gnat_argv with save_argv size. */ - gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0])); + gnat_argv = (char **) xmalloc (sizeof (argv[0])); gnat_argv[0] = xstrdup (argv[0]); /* name of the command */ gnat_argc = 1; @@ -423,14 +393,6 @@ gnat_init (void) /* Show that REFERENCE_TYPEs are internal and should be Pmode. */ internal_reference_types (); - /* Add the input filename as the last argument. */ - if (main_input_filename) - { - gnat_argv[gnat_argc] = xstrdup (main_input_filename); - gnat_argc++; - gnat_argv[gnat_argc] = NULL; - } - /* Register our internal error function. */ global_dc->internal_error = &internal_error_function; diff --git a/gcc/ada/gcc-interface/targtyps.c b/gcc/ada/gcc-interface/targtyps.c index 632862e0700..58c155fdb45 100644 --- a/gcc/ada/gcc-interface/targtyps.c +++ b/gcc/ada/gcc-interface/targtyps.c @@ -30,6 +30,7 @@ #include "coretypes.h" #include "tree.h" #include "tm.h" +#include "tm_p.h" #include "ada.h" #include "types.h" diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 46848f230f7..4bf89477d0d 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -5988,33 +5988,31 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, case ADDR_EXPR: op = TREE_OPERAND (expr, 0); - if (TREE_CODE (op) == CONSTRUCTOR) + /* If we are taking the address of a constant CONSTRUCTOR, make sure it + is put into static memory. We know that it's going to be read-only + given the semantics we have and it must be in static memory when the + reference is in an elaboration procedure. */ + if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op)) { - /* If we are taking the address of a constant CONSTRUCTOR, make sure - it is put into static memory. We know it's going to be read-only - given the semantics we have and it must be in static memory when - the reference is in an elaboration procedure. */ - if (TREE_CONSTANT (op)) - { - tree addr = build_fold_addr_expr (tree_output_constant_def (op)); - *expr_p = fold_convert (TREE_TYPE (expr), addr); - } - - /* Otherwise explicitly create the local temporary. That's required - if the type is passed by reference. */ - else - { - tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C"); - TREE_ADDRESSABLE (new_var) = 1; - gimple_add_tmp_var (new_var); + tree addr = build_fold_addr_expr (tree_output_constant_def (op)); + *expr_p = fold_convert (TREE_TYPE (expr), addr); + return GS_ALL_DONE; + } - mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op); - gimplify_and_add (mod, pre_p); + /* Otherwise, if we are taking the address of a non-constant CONSTRUCTOR + or of a call, explicitly create the local temporary. That's required + if the type is passed by reference. */ + if (TREE_CODE (op) == CONSTRUCTOR || TREE_CODE (op) == CALL_EXPR) + { + tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C"); + TREE_ADDRESSABLE (new_var) = 1; + gimple_add_tmp_var (new_var); - TREE_OPERAND (expr, 0) = new_var; - recompute_tree_invariant_for_addr_expr (expr); - } + mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op); + gimplify_and_add (mod, pre_p); + TREE_OPERAND (expr, 0) = new_var; + recompute_tree_invariant_for_addr_expr (expr); return GS_ALL_DONE; } @@ -7364,7 +7362,7 @@ extract_values (tree values, tree record_type) tree field, tem; VEC(constructor_elt,gc) *v = NULL; - for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field)) { tree value = 0; diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index c5d612da91b..541f7bb3f91 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -30,6 +30,7 @@ #include "tree.h" #include "flags.h" #include "toplev.h" +#include "diagnostic-core.h" #include "output.h" #include "ggc.h" #include "debug.h" @@ -460,7 +461,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node) } else { - TREE_CHAIN (decl) = BLOCK_VARS (current_binding_level->block); + DECL_CHAIN (decl) = BLOCK_VARS (current_binding_level->block); BLOCK_VARS (current_binding_level->block) = decl; } } @@ -588,7 +589,7 @@ finish_record_type (tree record_type, tree field_list, int rep_level, if (code == QUAL_UNION_TYPE) field_list = nreverse (field_list); - for (field = field_list; field; field = TREE_CHAIN (field)) + for (field = field_list; field; field = DECL_CHAIN (field)) { tree type = TREE_TYPE (field); tree pos = bit_position (field); @@ -740,7 +741,7 @@ rest_of_record_type_compilation (tree record_type) enum tree_code code = TREE_CODE (record_type); bool var_size = false; - for (field = field_list; field; field = TREE_CHAIN (field)) + for (field = field_list; field; field = DECL_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,7 +795,7 @@ rest_of_record_type_compilation (tree record_type) /* Now scan all the fields, replacing each field with a new field corresponding to the new encoding. */ for (old_field = TYPE_FIELDS (record_type); old_field; - old_field = TREE_CHAIN (old_field)) + old_field = DECL_CHAIN (old_field)) { tree field_type = TREE_TYPE (old_field); tree field_name = DECL_NAME (old_field); @@ -910,7 +911,7 @@ rest_of_record_type_compilation (tree record_type) new_field = create_field_decl (field_name, field_type, new_record_type, DECL_SIZE (old_field), pos, 0, 0); - TREE_CHAIN (new_field) = TYPE_FIELDS (new_record_type); + DECL_CHAIN (new_field) = TYPE_FIELDS (new_record_type); TYPE_FIELDS (new_record_type) = new_field; /* If old_field is a QUAL_UNION_TYPE, take its size as being @@ -1078,7 +1079,7 @@ create_subprog_type (tree return_type, tree param_decl_list, tree cico_list, tree param_type_list = NULL_TREE; tree t, type; - for (t = param_decl_list; t; t = TREE_CHAIN (t)) + for (t = param_decl_list; t; t = DECL_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 @@ -1415,7 +1416,7 @@ aggregate_type_contains_array_p (tree type) case QUAL_UNION_TYPE: { tree field; - for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) if (AGGREGATE_TYPE_P (TREE_TYPE (field)) && aggregate_type_contains_array_p (TREE_TYPE (field))) return true; @@ -1859,7 +1860,7 @@ begin_subprog_body (tree subprog_decl) gnat_pushlevel (); for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl; - param_decl = TREE_CHAIN (param_decl)) + param_decl = DECL_CHAIN (param_decl)) DECL_CONTEXT (param_decl) = subprog_decl; make_decl_rtl (subprog_decl); @@ -2079,17 +2080,17 @@ gnat_types_compatible_p (tree t1, tree 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. */ + /* Array types are also compatible if they are constrained and have the same + domain and compatible component types. */ if (code == ARRAY_TYPE - && TREE_TYPE (t1) == TREE_TYPE (t2) && (TYPE_DOMAIN (t1) == TYPE_DOMAIN (t2) || (TYPE_DOMAIN (t1) && TYPE_DOMAIN (t2) && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (t1)), TYPE_MIN_VALUE (TYPE_DOMAIN (t2))) && tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (t1)), - TYPE_MAX_VALUE (TYPE_DOMAIN (t2)))))) + TYPE_MAX_VALUE (TYPE_DOMAIN (t2))))) + && gnat_types_compatible_p (TREE_TYPE (t1), TREE_TYPE (t2))) return 1; /* Padding record types are also compatible if they pad the same @@ -2245,7 +2246,7 @@ build_template (tree template_type, tree array_type, tree expr) (bound_list ? (bound_list = TREE_CHAIN (bound_list)) : (array_type = TREE_TYPE (array_type))), - field = TREE_CHAIN (TREE_CHAIN (field))) + field = DECL_CHAIN (DECL_CHAIN (field))) { tree bounds, min, max; @@ -2264,7 +2265,7 @@ build_template (tree template_type, tree array_type, tree expr) gcc_unreachable (); min = convert (TREE_TYPE (field), TYPE_MIN_VALUE (bounds)); - max = convert (TREE_TYPE (TREE_CHAIN (field)), TYPE_MAX_VALUE (bounds)); + max = convert (TREE_TYPE (DECL_CHAIN (field)), TYPE_MAX_VALUE (bounds)); /* If either MIN or MAX involve a PLACEHOLDER_EXPR, we must substitute it from OBJECT. */ @@ -2272,7 +2273,7 @@ build_template (tree template_type, tree array_type, tree expr) max = SUBSTITUTE_PLACEHOLDER_IN_EXPR (max, expr); CONSTRUCTOR_APPEND_ELT (template_elts, field, min); - CONSTRUCTOR_APPEND_ELT (template_elts, TREE_CHAIN (field), max); + CONSTRUCTOR_APPEND_ELT (template_elts, DECL_CHAIN (field), max); } return gnat_build_constructor (template_type, template_elts); @@ -2928,9 +2929,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 klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); + tree klass = DECL_CHAIN (DECL_CHAIN (TYPE_FIELDS (desc_type))); /* The POINTER field is the 6th field in the descriptor. */ - tree pointer = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass))); + tree pointer = DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (klass))); /* Retrieve the value of the POINTER field. */ tree gnu_expr64 @@ -2961,7 +2962,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) case 15: /* Class SB */ /* Build {1, LENGTH} template; LENGTH64 is the 5th field. */ v = VEC_alloc (constructor_elt, gc, 2); - t = TREE_CHAIN (TREE_CHAIN (klass)); + t = DECL_CHAIN (DECL_CHAIN (klass)); t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); CONSTRUCTOR_APPEND_ELT (v, min_field, convert (TREE_TYPE (min_field), @@ -2989,7 +2990,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) t = TREE_CHAIN (t); ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); ufield = convert - (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield); + (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (template_type))), ufield); /* Build the template in the form of a constructor. */ v = VEC_alloc (constructor_elt, gc, 2); @@ -3008,7 +3009,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) case 4: /* Class A */ /* The AFLAGS field is the 3rd field after the pointer in the descriptor. */ - t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer))); + t = DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (pointer))); aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); /* The DIMCT field is the next field in the descriptor after aflags. */ @@ -3029,7 +3030,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) u)); /* There is already a template in the descriptor and it is located in block 3. The fields are 64bits so they must be repacked. */ - t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN + t = DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (t))))); lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield); @@ -3037,12 +3038,12 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) t = TREE_CHAIN (t); ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); ufield = convert - (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield); + (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (template_type))), ufield); /* Build the template in the form of a constructor. */ v = VEC_alloc (constructor_elt, gc, 2); CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (template_type), lfield); - CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (template_type)), + CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (template_type)), ufield); template_tree = gnat_build_constructor (template_type, v); template_tree = build3 (COND_EXPR, template_type, u, @@ -3063,7 +3064,7 @@ convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) /* Build the fat pointer in the form of a constructor. */ v = VEC_alloc (constructor_elt, gc, 2); CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (gnu_type), gnu_expr64); - CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (gnu_type)), + CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (gnu_type)), template_addr); return gnat_build_constructor (gnu_type, v); } @@ -3082,9 +3083,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 klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type))); + tree klass = DECL_CHAIN (DECL_CHAIN (TYPE_FIELDS (desc_type))); /* The POINTER field is the 4th field in the descriptor. */ - tree pointer = TREE_CHAIN (klass); + tree pointer = DECL_CHAIN (klass); /* Retrieve the value of the POINTER field. */ tree gnu_expr32 @@ -3146,7 +3147,7 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) case 4: /* Class A */ /* The AFLAGS field is the 7th field in the descriptor. */ - t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer))); + t = DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (pointer))); aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); /* The DIMCT field is the 8th field in the descriptor. */ t = TREE_CHAIN (t); @@ -3166,7 +3167,7 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) u)); /* 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)))); + t = DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (t)))); template_tree = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE); template_tree = build3 (COND_EXPR, TREE_TYPE (t), u, @@ -3187,7 +3188,7 @@ convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog) /* Build the fat pointer in the form of a constructor. */ v = VEC_alloc (constructor_elt, gc, 2); CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (gnu_type), gnu_expr32); - CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (gnu_type)), + CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (gnu_type)), template_addr); return gnat_build_constructor (gnu_type, v); @@ -3210,7 +3211,7 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, tree gnu_expr_alt_type, tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr); tree mbo = TYPE_FIELDS (desc_type); const char *mbostr = IDENTIFIER_POINTER (DECL_NAME (mbo)); - tree mbmo = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (mbo))); + tree mbmo = DECL_CHAIN (DECL_CHAIN (DECL_CHAIN (mbo))); tree is64bit, gnu_expr32, gnu_expr64; /* If the field name is not MBO, it must be 32-bit and no alternate. @@ -3320,7 +3321,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name, TYPE_NAME (type) = name; TYPE_CONTAINS_TEMPLATE_P (type) = 1; - TREE_CHAIN (template_field) = array_field; + DECL_CHAIN (template_field) = array_field; finish_record_type (type, template_field, 0, true); /* Declare it now since it will never be declared otherwise. This is @@ -3342,7 +3343,7 @@ build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, template_type = (TYPE_IS_FAT_POINTER_P (thin_fat_ptr_type) - ? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type)))) + ? TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (thin_fat_ptr_type)))) : TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type)))); return @@ -3361,7 +3362,7 @@ shift_unc_components_for_thin_pointers (tree type) that COMPONENT_REFs on (*thin_ptr) designate the proper location. */ tree bounds_field = TYPE_FIELDS (type); - tree array_field = TREE_CHAIN (TYPE_FIELDS (type)); + tree array_field = DECL_CHAIN (TYPE_FIELDS (type)); DECL_FIELD_OFFSET (bounds_field) = size_binop (MINUS_EXPR, size_zero_node, byte_position (array_field)); @@ -3480,12 +3481,12 @@ update_pointer_to (tree old_type, tree new_type) return; array_field = TYPE_FIELDS (ptr); - bounds_field = TREE_CHAIN (array_field); + bounds_field = DECL_CHAIN (array_field); /* Make pointers to the dummy template point to the real template. */ update_pointer_to (TREE_TYPE (TREE_TYPE (bounds_field)), - TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_ptr))))); + TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (new_ptr))))); /* The references to the template bounds present in the array type use the bounds field of NEW_PTR through a PLACEHOLDER_EXPR. Since we @@ -3500,7 +3501,7 @@ update_pointer_to (tree old_type, tree new_type) update_pointer_to (TREE_TYPE (TREE_TYPE (array_field)), substitute_in_type (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (new_ptr))), - TREE_CHAIN (TYPE_FIELDS (new_ptr)), new_ref)); + DECL_CHAIN (TYPE_FIELDS (new_ptr)), new_ref)); /* Merge PTR in NEW_PTR. */ DECL_FIELD_CONTEXT (array_field) = new_ptr; @@ -3531,7 +3532,7 @@ update_pointer_to (tree old_type, tree new_type) points to. Update all pointers from the old record into the new one, update the type of the array field, and recompute the size. */ update_pointer_to (TYPE_OBJECT_RECORD_TYPE (old_type), new_obj_rec); - TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec))) + TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (new_obj_rec))) = TREE_TYPE (TREE_TYPE (array_field)); /* The size recomputation needs to account for alignment constraints, so @@ -3539,7 +3540,7 @@ update_pointer_to (tree old_type, tree new_type) what they would be in a regular record, so we shift them back to what we want them to be for a thin pointer designated type afterwards. */ DECL_SIZE (TYPE_FIELDS (new_obj_rec)) = NULL_TREE; - DECL_SIZE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec))) = NULL_TREE; + DECL_SIZE (DECL_CHAIN (TYPE_FIELDS (new_obj_rec))) = NULL_TREE; TYPE_SIZE (new_obj_rec) = NULL_TREE; layout_type (new_obj_rec); shift_unc_components_for_thin_pointers (new_obj_rec); @@ -3555,7 +3556,7 @@ update_pointer_to (tree old_type, tree new_type) static tree convert_to_fat_pointer (tree type, tree expr) { - tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)))); + tree template_type = TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (type)))); tree p_array_type = TREE_TYPE (TYPE_FIELDS (type)); tree etype = TREE_TYPE (expr); tree template_tree; @@ -3567,7 +3568,7 @@ convert_to_fat_pointer (tree type, tree expr) { CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), convert (p_array_type, expr)); - CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)), + CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)), convert (build_pointer_type (template_type), expr)); return gnat_build_constructor (type, v); @@ -3587,7 +3588,7 @@ convert_to_fat_pointer (tree type, tree expr) 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)); + DECL_CHAIN (fields), false)); } /* Otherwise, build the constructor for the template. */ @@ -3608,7 +3609,7 @@ convert_to_fat_pointer (tree type, tree expr) will only refer to the provided TEMPLATE_TYPE in this case. */ CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), convert (p_array_type, expr)); - CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)), + CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)), build_unary_op (ADDR_EXPR, NULL_TREE, template_tree)); return gnat_build_constructor (type, v); @@ -3701,9 +3702,10 @@ convert (tree type, tree expr) if (ecode == RECORD_TYPE && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)))) { - if (TREE_CONSTANT (TYPE_SIZE (etype))) + if (TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST) expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty, - false, false, false, true), expr); + false, false, false, true), + expr); return unchecked_convert (type, expr, false); } @@ -3774,7 +3776,7 @@ convert (tree type, tree expr) type and then build the template. */ if (code == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (type)) { - tree obj_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))); + tree obj_type = TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (type))); VEC(constructor_elt,gc) *v = VEC_alloc (constructor_elt, gc, 2); /* If the source already has a template, get a reference to the @@ -3785,7 +3787,7 @@ convert (tree type, tree expr) CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), build_template (TREE_TYPE (TYPE_FIELDS (type)), obj_type, NULL_TREE)); - CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (type)), + CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)), convert (obj_type, expr)); return gnat_build_constructor (type, v); } @@ -3881,8 +3883,8 @@ convert (tree type, tree expr) && !initializer_constant_valid_for_bitfield_p (value)) clear_constant = true; - efield = TREE_CHAIN (efield); - field = TREE_CHAIN (field); + efield = DECL_CHAIN (efield); + field = DECL_CHAIN (field); } /* If we have been able to match and convert all the input fields @@ -4263,14 +4265,14 @@ maybe_unconstrained_array (tree exp) && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new_exp))) return build_component_ref (new_exp, NULL_TREE, - TREE_CHAIN + DECL_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))), + DECL_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))), false); break; @@ -4352,6 +4354,7 @@ 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); + int c; /* If the expression is already of the right type, we are done. */ if (etype == type) @@ -4392,7 +4395,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) /* If we are converting to an integral type whose precision is not equal to its size, first unchecked convert to a record that contains an object of the output type. Then extract the field. */ - else if (INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type) + else if (INTEGRAL_TYPE_P (type) + && TYPE_RM_SIZE (type) && 0 != compare_tree_int (TYPE_RM_SIZE (type), GET_MODE_BITSIZE (TYPE_MODE (type)))) { @@ -4409,9 +4413,10 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) /* Similarly if we are converting from an integral type whose precision is not equal to its size. */ - else if (INTEGRAL_TYPE_P (etype) && TYPE_RM_SIZE (etype) - && 0 != compare_tree_int (TYPE_RM_SIZE (etype), - GET_MODE_BITSIZE (TYPE_MODE (etype)))) + else if (INTEGRAL_TYPE_P (etype) + && TYPE_RM_SIZE (etype) + && 0 != compare_tree_int (TYPE_RM_SIZE (etype), + GET_MODE_BITSIZE (TYPE_MODE (etype)))) { tree rec_type = make_node (RECORD_TYPE); tree field = create_field_decl (get_identifier ("OBJ"), etype, rec_type, @@ -4426,6 +4431,38 @@ unchecked_convert (tree type, tree expr, bool notrunc_p) expr = unchecked_convert (type, expr, notrunc_p); } + /* If we are converting from a scalar type to a type with a different size, + we need to pad to have the same size on both sides. + + ??? We cannot do it unconditionally because unchecked conversions are + used liberally by the front-end to implement polymorphism, e.g. in: + + S191s : constant ada__tags__addr_ptr := ada__tags__addr_ptr!(S190s); + return p___size__4 (p__object!(S191s.all)); + + so we skip all expressions that are references. */ + else if (!REFERENCE_CLASS_P (expr) + && !AGGREGATE_TYPE_P (etype) + && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST + && (c = tree_int_cst_compare (TYPE_SIZE (etype), TYPE_SIZE (type)))) + { + if (c < 0) + { + expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty, + false, false, false, true), + expr); + expr = unchecked_convert (type, expr, notrunc_p); + } + else + { + tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty, + false, false, false, true); + expr = unchecked_convert (rec_type, expr, notrunc_p); + expr = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (rec_type), + false); + } + } + /* 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. */ diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index ab3814ec4e0..bd78686e240 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -1612,7 +1612,7 @@ build_simple_component_ref (tree record_variable, tree component, /* First loop thru normal components. */ for (new_field = TYPE_FIELDS (record_type); new_field; - new_field = TREE_CHAIN (new_field)) + new_field = DECL_CHAIN (new_field)) if (SAME_FIELD_P (field, new_field)) break; @@ -1622,7 +1622,7 @@ build_simple_component_ref (tree record_variable, tree component, _Parent field. */ if (!new_field) for (new_field = TYPE_FIELDS (record_type); new_field; - new_field = TREE_CHAIN (new_field)) + new_field = DECL_CHAIN (new_field)) if (DECL_INTERNAL_P (new_field)) { tree field_ref @@ -1996,7 +1996,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (storage_type), build_template (template_type, type, init)); - CONSTRUCTOR_APPEND_ELT (v, TREE_CHAIN (TYPE_FIELDS (storage_type)), + CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (storage_type)), init); return convert @@ -2088,7 +2088,7 @@ fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual) expr = maybe_unconstrained_array (expr); gnat_mark_addressable (expr); - for (field = TYPE_FIELDS (record_type); field; field = TREE_CHAIN (field)) + for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field)) { tree conexpr = convert (TREE_TYPE (field), SUBSTITUTE_PLACEHOLDER_IN_EXPR |