2007-11-16 Jakub Jelinek PR fortran/22244 * langhooks-def.h (LANG_HOOKS_GET_ARRAY_DESCR_INFO): Define. (LANG_HOOKS_FOR_TYPES_INITIALIZER): Add it. * langhooks.h (struct array_descr_info): Forward declaration. (struct lang_hooks_for_types): Add get_array_descr_info field. * dwarf2.h (DW_AT_bit_stride, DW_AT_byte_stride): New. (DW_AT_stride_size, DW_AT_stride): Keep around for Dwarf2 compatibility. * dwarf2out.h (struct array_descr_info): New type. * dwarf2out.c (dwarf_attr_name): Rename DW_AT_stride to DW_AT_byte_stride and DW_AT_stride_size to DW_AT_bit_size. (descr_info_loc, add_descr_info_field, gen_descr_array_type_die): New functions. (gen_type_die_with_usage): Call lang_hooks.types.get_array_descr_info and gen_descr_array_type_die. * trans.h (struct array_descr_info): Forward declaration. (gfc_get_array_descr_info): New prototype. (enum gfc_array_kind): New type. (struct lang_type): Add akind field. (GFC_TYPE_ARRAY_AKIND): Define. * trans-types.c: Include dwarf2out.h. (gfc_build_array_type): Add akind argument. Adjust gfc_get_array_type_bounds call. (gfc_get_nodesc_array_type): Include proper debug info even for assumed-size arrays. (gfc_get_array_type_bounds): Add akind argument, set GFC_TYPE_ARRAY_AKIND to it. (gfc_sym_type, gfc_get_derived_type): Adjust gfc_build_array_type callers. (gfc_get_array_descr_info): New function. * trans-array.c (gfc_trans_create_temp_array, gfc_conv_expr_descriptor): Adjust gfc_get_array_type_bounds callers. * trans-stmt.c (gfc_trans_pointer_assign_need_temp): Likewise. * trans-types.h (gfc_get_array_type_bounds): Adjust prototype. * Make-lang.in (fortran/trans-types.o): Depend on dwarf2out.h. * f95-lang.c (LANG_HOOKS_GET_ARRAY_DESCR_INFO): Define. --- gcc/fortran/trans.h.jj 2007-07-23 12:24:16.000000000 +0200 +++ gcc/fortran/trans.h 2007-11-24 15:04:51.000000000 +0100 @@ -453,6 +453,8 @@ tree getdecls (void); tree gfc_truthvalue_conversion (tree); tree builtin_function (const char *, tree, int, enum built_in_class, const char *, tree); +struct array_descr_info; +bool gfc_get_array_descr_info (tree, struct array_descr_info *); /* In trans-openmp.c */ bool gfc_omp_privatize_by_reference (tree); @@ -541,10 +543,19 @@ extern GTY(()) tree gfor_fndecl_sr_kind; /* G95-specific declaration information. */ +enum gfc_array_kind +{ + GFC_ARRAY_UNKNOWN, + GFC_ARRAY_ASSUMED_SHAPE, + GFC_ARRAY_ALLOCATABLE, + GFC_ARRAY_POINTER +}; + /* Array types only. */ struct lang_type GTY(()) { int rank; + enum gfc_array_kind akind; tree lbound[GFC_MAX_DIMENSIONS]; tree ubound[GFC_MAX_DIMENSIONS]; tree stride[GFC_MAX_DIMENSIONS]; @@ -595,7 +606,8 @@ struct lang_decl GTY(()) #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank) #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size) #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset) -/* Code should use gfc_get_dtype instead of accesig this directly. It may +#define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind) +/* Code should use gfc_get_dtype instead of accesing this directly. It may not be known when the type is created. */ #define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype) #define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \ --- gcc/fortran/trans-stmt.c.jj 2007-03-12 08:28:15.000000000 +0100 +++ gcc/fortran/trans-stmt.c 2007-11-24 14:58:20.000000000 +0100 @@ -2313,7 +2313,8 @@ gfc_trans_pointer_assign_need_temp (gfc_ /* Make a new descriptor. */ parmtype = gfc_get_element_type (TREE_TYPE (desc)); parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, - loop.from, loop.to, 1); + loop.from, loop.to, 1, + GFC_ARRAY_UNKNOWN); /* Allocate temporary for nested forall construct. */ tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype, --- gcc/fortran/f95-lang.c.jj 2007-02-20 22:38:20.000000000 +0100 +++ gcc/fortran/f95-lang.c 2007-11-24 15:03:19.000000000 +0100 @@ -124,6 +124,7 @@ static HOST_WIDE_INT gfc_get_alias_set ( #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE #undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES +#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO /* Define lang hooks. */ #define LANG_HOOKS_NAME "GNU F95" @@ -150,6 +151,7 @@ static HOST_WIDE_INT gfc_get_alias_set ( #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \ gfc_omp_firstprivatize_type_sizes +#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; --- gcc/fortran/Make-lang.in.jj 2007-09-25 11:32:17.000000000 +0200 +++ gcc/fortran/Make-lang.in 2007-11-24 15:02:36.000000000 +0100 @@ -292,7 +292,7 @@ fortran/trans-decl.o: $(GFORTRAN_TRANS_D cgraph.h $(TARGET_H) function.h $(FLAGS_H) $(RTL_H) tree-gimple.h \ tree-dump.h fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \ - real.h toplev.h $(TARGET_H) $(FLAGS_H) + real.h toplev.h $(TARGET_H) $(FLAGS_H) dwarf2out.h fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h --- gcc/fortran/trans-types.c.jj 2007-09-25 11:32:17.000000000 +0200 +++ gcc/fortran/trans-types.c 2007-11-24 15:06:59.000000000 +0100 @@ -36,6 +36,7 @@ Software Foundation, 51 Franklin Street, #include "trans-const.h" #include "real.h" #include "flags.h" +#include "dwarf2out.h" #if (GFC_MAX_DIMENSIONS < 10) @@ -821,7 +822,8 @@ gfc_is_nodesc_array (gfc_symbol * sym) /* Create an array descriptor type. */ static tree -gfc_build_array_type (tree type, gfc_array_spec * as) +gfc_build_array_type (tree type, gfc_array_spec * as, + enum gfc_array_kind akind) { tree lbound[GFC_MAX_DIMENSIONS]; tree ubound[GFC_MAX_DIMENSIONS]; @@ -837,7 +839,9 @@ gfc_build_array_type (tree type, gfc_arr ubound[n] = gfc_conv_array_bound (as->upper[n]); } - return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0); + if (as->type == AS_ASSUMED_SHAPE) + akind = GFC_ARRAY_ASSUMED_SHAPE; + return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0, akind); } /* Returns the struct descriptor_dimension type. */ @@ -1015,7 +1019,7 @@ gfc_get_nodesc_array_type (tree etype, g if (expr->expr_type == EXPR_CONSTANT) { tmp = gfc_conv_mpz_to_tree (expr->value.integer, - gfc_index_integer_kind); + gfc_index_integer_kind); } else { @@ -1107,7 +1111,7 @@ gfc_get_nodesc_array_type (tree etype, g /* In debug info represent packed arrays as multi-dimensional if they have rank > 1 and with proper bounds, instead of flat arrays. */ - if (known_stride && write_symbols != NO_DEBUG) + if (known_offset && write_symbols != NO_DEBUG) { tree gtype = etype, rtype, type_decl; @@ -1193,7 +1197,8 @@ gfc_get_array_descriptor_base (int dimen tree gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, - tree * ubound, int packed) + tree * ubound, int packed, + enum gfc_array_kind akind) { char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN]; tree fat_type, base_type, arraytype, lower, upper, stride, tmp; @@ -1220,6 +1225,7 @@ gfc_get_array_type_bounds (tree etype, i GFC_TYPE_ARRAY_RANK (fat_type) = dimen; GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE; + GFC_TYPE_ARRAY_AKIND (fat_type) = akind; /* Build an array descriptor record type. */ if (packed != 0) @@ -1337,7 +1343,14 @@ gfc_sym_type (gfc_symbol * sym) } } else - type = gfc_build_array_type (type, sym->as); + { + enum gfc_array_kind akind = GFC_ARRAY_UNKNOWN; + if (sym->attr.pointer) + akind = GFC_ARRAY_POINTER; + else if (sym->attr.allocatable) + akind = GFC_ARRAY_ALLOCATABLE; + type = gfc_build_array_type (type, sym->as, akind); + } } else { @@ -1550,7 +1563,8 @@ gfc_get_derived_type (gfc_symbol * deriv { /* Pointers to arrays aren't actually pointer types. The descriptors are separate, but the data is common. */ - field_type = gfc_build_array_type (field_type, c->as); + field_type = gfc_build_array_type (field_type, c->as, + GFC_ARRAY_POINTER); } else field_type = gfc_get_nodesc_array_type (field_type, c->as, 3); @@ -1893,4 +1907,124 @@ gfc_signed_type (tree type) return gfc_signed_or_unsigned_type (0, type); } +/* Return TRUE if TYPE is a type with a hidden descriptor, fill in INFO + in that case. */ + +bool +gfc_get_array_descr_info (tree type, struct array_descr_info *info) +{ + int rank, dim; + bool indirect = false; + tree etype, ptype, field, t, base_decl; + tree data_off, offset_off, dim_off, dim_size, elem_size; + tree lower_suboff, upper_suboff, stride_suboff; + + if (! GFC_DESCRIPTOR_TYPE_P (type)) + { + if (! POINTER_TYPE_P (type)) + return false; + type = TREE_TYPE (type); + if (! GFC_DESCRIPTOR_TYPE_P (type)) + return false; + indirect = true; + } + + rank = GFC_TYPE_ARRAY_RANK (type); + if (rank >= (int) (sizeof (info->dimen) / sizeof (info->dimen[0]))) + return false; + + etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type); + gcc_assert (POINTER_TYPE_P (etype)); + etype = TREE_TYPE (etype); + gcc_assert (TREE_CODE (etype) == ARRAY_TYPE); + etype = TREE_TYPE (etype); + /* Can't handle variable sized elements yet. */ + if (int_size_in_bytes (etype) <= 0) + return false; + /* Nor non-constant lower bounds in assumed shape arrays. */ + if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE) + { + for (dim = 0; dim < rank; dim++) + if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE + || TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) != INTEGER_CST) + return false; + } + + memset (info, '\0', sizeof (*info)); + info->ndimensions = rank; + info->element_type = etype; + ptype = build_pointer_type (gfc_array_index_type); + if (indirect) + { + info->base_decl = build_decl (VAR_DECL, NULL_TREE, + build_pointer_type (ptype)); + base_decl = build1 (INDIRECT_REF, ptype, info->base_decl); + } + else + info->base_decl = base_decl = build_decl (VAR_DECL, NULL_TREE, ptype); + + elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype)); + field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type)); + data_off = byte_position (field); + field = TREE_CHAIN (field); + offset_off = byte_position (field); + field = TREE_CHAIN (field); + field = TREE_CHAIN (field); + dim_off = byte_position (field); + dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (field))); + field = TYPE_FIELDS (TREE_TYPE (TREE_TYPE (field))); + stride_suboff = byte_position (field); + field = TREE_CHAIN (field); + lower_suboff = byte_position (field); + field = TREE_CHAIN (field); + upper_suboff = byte_position (field); + + t = base_decl; + if (!integer_zerop (data_off)) + t = build2 (PLUS_EXPR, ptype, t, data_off); + t = build1 (NOP_EXPR, build_pointer_type (ptr_type_node), t); + info->data_location = build1 (INDIRECT_REF, ptr_type_node, t); + if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) + info->allocated = build2 (NE_EXPR, boolean_type_node, + info->data_location, null_pointer_node); + else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER) + info->associated = build2 (NE_EXPR, boolean_type_node, + info->data_location, null_pointer_node); + + for (dim = 0; dim < rank; dim++) + { + t = build2 (PLUS_EXPR, ptype, base_decl, + size_binop (PLUS_EXPR, dim_off, lower_suboff)); + t = build1 (INDIRECT_REF, gfc_array_index_type, t); + info->dimen[dim].lower_bound = t; + t = build2 (PLUS_EXPR, ptype, base_decl, + size_binop (PLUS_EXPR, dim_off, upper_suboff)); + t = build1 (INDIRECT_REF, gfc_array_index_type, t); + info->dimen[dim].upper_bound = t; + if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE) + { + /* Assumed shape arrays have known lower bounds. */ + info->dimen[dim].upper_bound + = build2 (MINUS_EXPR, gfc_array_index_type, + info->dimen[dim].upper_bound, + info->dimen[dim].lower_bound); + info->dimen[dim].lower_bound + = fold_convert (gfc_array_index_type, + GFC_TYPE_ARRAY_LBOUND (type, dim)); + info->dimen[dim].upper_bound + = build2 (PLUS_EXPR, gfc_array_index_type, + info->dimen[dim].lower_bound, + info->dimen[dim].upper_bound); + } + t = build2 (PLUS_EXPR, ptype, base_decl, + size_binop (PLUS_EXPR, dim_off, stride_suboff)); + t = build1 (INDIRECT_REF, gfc_array_index_type, t); + t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size); + info->dimen[dim].stride = t; + dim_off = size_binop (PLUS_EXPR, dim_off, dim_size); + } + + return true; +} + #include "gt-fortran-trans-types.h" --- gcc/fortran/trans-array.c.jj 2007-04-03 13:10:00.000000000 +0200 +++ gcc/fortran/trans-array.c 2007-11-24 14:58:20.000000000 +0100 @@ -612,7 +612,8 @@ gfc_trans_allocate_temp_array (stmtblock /* Initialize the descriptor. */ type = - gfc_get_array_type_bounds (eltype, info->dimen, loop->from, loop->to, 1); + gfc_get_array_type_bounds (eltype, info->dimen, loop->from, loop->to, 1, + GFC_ARRAY_UNKNOWN); desc = gfc_create_var (type, "atmp"); GFC_DECL_PACKED_ARRAY (desc) = 1; @@ -4345,7 +4346,8 @@ gfc_conv_expr_descriptor (gfc_se * se, g /* Otherwise make a new one. */ parmtype = gfc_get_element_type (TREE_TYPE (desc)); parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, - loop.from, loop.to, 0); + loop.from, loop.to, 0, + GFC_ARRAY_UNKNOWN); parm = gfc_create_var (parmtype, "parm"); } --- gcc/fortran/trans-types.h.jj 2007-02-20 22:38:20.000000000 +0100 +++ gcc/fortran/trans-types.h 2007-11-24 15:03:58.000000000 +0100 @@ -79,7 +79,8 @@ tree gfc_signed_type (tree); tree gfc_signed_or_unsigned_type (int, tree); tree gfc_get_element_type (tree); -tree gfc_get_array_type_bounds (tree, int, tree *, tree *, int); +tree gfc_get_array_type_bounds (tree, int, tree *, tree *, int, + enum gfc_array_kind); tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, int); /* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE. */ --- gcc/dwarf2.h.jj 2007-02-20 22:39:12.000000000 +0100 +++ gcc/dwarf2.h 2007-11-24 14:58:20.000000000 +0100 @@ -275,7 +275,8 @@ enum dwarf_attribute DW_AT_prototyped = 0x27, DW_AT_return_addr = 0x2a, DW_AT_start_scope = 0x2c, - DW_AT_stride_size = 0x2e, + DW_AT_bit_stride = 0x2e, + DW_AT_stride_size = DW_AT_bit_stride, DW_AT_upper_bound = 0x2f, DW_AT_abstract_origin = 0x31, DW_AT_accessibility = 0x32, @@ -310,7 +311,8 @@ enum dwarf_attribute DW_AT_allocated = 0x4e, DW_AT_associated = 0x4f, DW_AT_data_location = 0x50, - DW_AT_stride = 0x51, + DW_AT_byte_stride = 0x51, + DW_AT_stride = DW_AT_byte_stride, DW_AT_entry_pc = 0x52, DW_AT_use_UTF8 = 0x53, DW_AT_extension = 0x54, --- gcc/langhooks.h.jj 2007-11-23 17:41:15.000000000 +0100 +++ gcc/langhooks.h 2007-11-24 15:01:32.000000000 +0100 @@ -28,6 +28,8 @@ struct diagnostic_info; struct gimplify_omp_ctx; +struct array_descr_info; + /* A print hook for print_tree (). */ typedef void (*lang_print_tree_hook) (FILE *, tree, int indent); @@ -153,6 +155,10 @@ struct lang_hooks_for_types Called only after doing all language independent checks. */ bool (*type_hash_eq) (tree, tree); + /* Return TRUE if TYPE uses a hidden descriptor and fills in information + for the debugger about the array bounds, strides, etc. */ + bool (*get_array_descr_info) (tree, struct array_descr_info *); + /* Nonzero if types that are identical are to be hashed so that only one copy is kept. If a language requires unique types for each user-specified type, such as Ada, this should be set to TRUE. */ --- gcc/langhooks-def.h.jj 2007-11-23 17:41:15.000000000 +0100 +++ gcc/langhooks-def.h 2007-11-24 15:00:47.000000000 +0100 @@ -223,6 +223,7 @@ extern tree lhd_make_node (enum tree_cod #define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \ lhd_omp_firstprivatize_type_sizes #define LANG_HOOKS_TYPE_HASH_EQ lhd_type_hash_eq +#define LANG_HOOKS_GET_ARRAY_DESCR_INFO NULL #define LANG_HOOKS_HASH_TYPES true #define LANG_HOOKS_FOR_TYPES_INITIALIZER { \ @@ -238,6 +239,7 @@ extern tree lhd_make_node (enum tree_cod LANG_HOOKS_TYPE_MAX_SIZE, \ LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES, \ LANG_HOOKS_TYPE_HASH_EQ, \ + LANG_HOOKS_GET_ARRAY_DESCR_INFO, \ LANG_HOOKS_HASH_TYPES \ } --- gcc/dwarf2out.c.jj 2007-11-23 18:10:20.000000000 +0100 +++ gcc/dwarf2out.c 2007-11-24 14:58:20.000000000 +0100 @@ -4146,6 +4146,7 @@ static tree member_declared_type (tree); static const char *decl_start_label (tree); #endif static void gen_array_type_die (tree, dw_die_ref); +static void gen_descr_array_type_die (tree, struct array_descr_info *, dw_die_ref); #if 0 static void gen_entry_point_die (tree, dw_die_ref); #endif @@ -4552,8 +4553,8 @@ dwarf_attr_name (unsigned int attr) return "DW_AT_return_addr"; case DW_AT_start_scope: return "DW_AT_start_scope"; - case DW_AT_stride_size: - return "DW_AT_stride_size"; + case DW_AT_bit_stride: + return "DW_AT_bit_stride"; case DW_AT_upper_bound: return "DW_AT_upper_bound"; case DW_AT_abstract_origin: @@ -4621,8 +4622,8 @@ dwarf_attr_name (unsigned int attr) return "DW_AT_associated"; case DW_AT_data_location: return "DW_AT_data_location"; - case DW_AT_stride: - return "DW_AT_stride"; + case DW_AT_byte_stride: + return "DW_AT_byte_stride"; case DW_AT_entry_pc: return "DW_AT_entry_pc"; case DW_AT_use_UTF8: @@ -11169,6 +11170,159 @@ gen_array_type_die (tree type, dw_die_re add_type_attribute (array_die, element_type, 0, 0, context_die); } +static dw_loc_descr_ref +descr_info_loc (tree val, tree base_decl) +{ + HOST_WIDE_INT size; + dw_loc_descr_ref loc, loc2; + enum dwarf_location_atom op; + + if (val == base_decl) + return new_loc_descr (DW_OP_push_object_address, 0, 0); + + switch (TREE_CODE (val)) + { + case NOP_EXPR: + case CONVERT_EXPR: + return descr_info_loc (TREE_OPERAND (val, 0), base_decl); + case INTEGER_CST: + if (host_integerp (val, 0)) + return int_loc_descriptor (tree_low_cst (val, 0)); + break; + case INDIRECT_REF: + size = int_size_in_bytes (TREE_TYPE (val)); + if (size < 0) + break; + loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl); + if (!loc) + break; + if (size == DWARF2_ADDR_SIZE) + add_loc_descr (&loc, new_loc_descr (DW_OP_deref, 0, 0)); + else + add_loc_descr (&loc, new_loc_descr (DW_OP_deref_size, size, 0)); + return loc; + case PLUS_EXPR: + if (host_integerp (TREE_OPERAND (val, 1), 1) + && (unsigned HOST_WIDE_INT) tree_low_cst (TREE_OPERAND (val, 1), 1) + < 16384) + { + loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl); + if (!loc) + break; + add_loc_descr (&loc, + new_loc_descr (DW_OP_plus_uconst, + tree_low_cst (TREE_OPERAND (val, 1), + 1), 0)); + } + else + { + op = DW_OP_plus; + do_binop: + loc = descr_info_loc (TREE_OPERAND (val, 0), base_decl); + if (!loc) + break; + loc2 = descr_info_loc (TREE_OPERAND (val, 1), base_decl); + if (!loc2) + break; + add_loc_descr (&loc, loc2); + add_loc_descr (&loc2, new_loc_descr (op, 0, 0)); + } + return loc; + case MINUS_EXPR: + op = DW_OP_minus; + goto do_binop; + case MULT_EXPR: + op = DW_OP_mul; + goto do_binop; + case EQ_EXPR: + op = DW_OP_eq; + goto do_binop; + case NE_EXPR: + op = DW_OP_ne; + goto do_binop; + default: + break; + } + return NULL; +} + +static void +add_descr_info_field (dw_die_ref die, enum dwarf_attribute attr, + tree val, tree base_decl) +{ + dw_loc_descr_ref loc; + + if (host_integerp (val, 0)) + { + add_AT_unsigned (die, attr, tree_low_cst (val, 0)); + return; + } + + loc = descr_info_loc (val, base_decl); + if (!loc) + return; + + add_AT_loc (die, attr, loc); +} + +/* This routine generates DIE for array with hidden descriptor, details + are filled into *info by a langhook. */ + +static void +gen_descr_array_type_die (tree type, struct array_descr_info *info, + dw_die_ref context_die) +{ + dw_die_ref scope_die = scope_die_for (type, context_die); + dw_die_ref array_die; + int dim; + + array_die = new_die (DW_TAG_array_type, scope_die, type); + add_name_attribute (array_die, type_tag (type)); + equate_type_number_to_die (type, array_die); + + if (info->data_location) + add_descr_info_field (array_die, DW_AT_data_location, info->data_location, + info->base_decl); + if (info->associated) + add_descr_info_field (array_die, DW_AT_associated, info->associated, + info->base_decl); + if (info->allocated) + add_descr_info_field (array_die, DW_AT_allocated, info->allocated, + info->base_decl); + + for (dim = 0; dim < info->ndimensions; dim++) + { + dw_die_ref subrange_die + = new_die (DW_TAG_subrange_type, array_die, NULL); + + if (info->dimen[dim].lower_bound) + { + /* If it is the default value, omit it. */ + if ((is_c_family () || is_java ()) + && integer_zerop (info->dimen[dim].lower_bound)) + ; + else if (is_fortran () + && integer_onep (info->dimen[dim].lower_bound)) + ; + else + add_descr_info_field (subrange_die, DW_AT_lower_bound, + info->dimen[dim].lower_bound, + info->base_decl); + } + if (info->dimen[dim].upper_bound) + add_descr_info_field (subrange_die, DW_AT_upper_bound, + info->dimen[dim].upper_bound, + info->base_decl); + if (info->dimen[dim].stride) + add_descr_info_field (subrange_die, DW_AT_byte_stride, + info->dimen[dim].stride, + info->base_decl); + } + + gen_type_die (info->element_type, context_die); + add_type_attribute (array_die, info->element_type, 0, 0, context_die); +} + #if 0 static void gen_entry_point_die (tree decl, dw_die_ref context_die) @@ -12478,6 +12632,7 @@ static void gen_type_die (tree type, dw_die_ref context_die) { int need_pop; + struct array_descr_info info; if (type == NULL_TREE || type == error_mark_node) return; @@ -12496,6 +12651,16 @@ gen_type_die (tree type, dw_die_ref cont return; } + /* If this is an array type with hidden descriptor, handle it first. */ + if (!TREE_ASM_WRITTEN (type) + && lang_hooks.types.get_array_descr_info + && lang_hooks.types.get_array_descr_info (type, &info)) + { + gen_descr_array_type_die (type, &info, context_die); + TREE_ASM_WRITTEN (type) = 1; + return; + } + /* We are going to output a DIE to represent the unqualified version of this type (i.e. without any const or volatile qualifiers) so get the main variant (i.e. the unqualified version) of this type --- gcc/dwarf2out.h.jj 2007-02-20 22:39:12.000000000 +0100 +++ gcc/dwarf2out.h 2007-11-24 15:00:14.000000000 +0100 @@ -27,3 +27,19 @@ struct die_struct; extern void debug_dwarf_die (struct die_struct *); extern void dwarf2out_set_demangle_name_func (const char *(*) (const char *)); extern void dwarf2out_add_library_unit_info (const char *, const char *); + +struct array_descr_info +{ + int ndimensions; + tree element_type; + tree base_decl; + tree data_location; + tree allocated; + tree associated; + struct array_descr_dimen + { + tree lower_bound; + tree upper_bound; + tree stride; + } dimen[10]; +};