diff options
Diffstat (limited to 'gcc/ada/gcc-interface/utils.c')
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 145 |
1 files changed, 91 insertions, 54 deletions
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. */ |