OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/22244 (dimension information is lost for multi-dimension array) 

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.

From-SVN: r130724
This commit is contained in:
Jakub Jelinek 2007-12-09 18:08:06 +01:00 committed by Jakub Jelinek
parent de80e4f820
commit fad0afd7d7
14 changed files with 414 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ChangeLog
View File

@ -1,3 +1,21 @@
2007-12-09 Jakub Jelinek <jakub@redhat.com>
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.
2007-12-08 Richard Guenther <rguenther@suse.de>
PR tree-optimization/34391

6
gcc/dwarf2.h
View File

@ -274,7 +274,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,
@ -309,7 +310,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,

177
gcc/dwarf2out.c
View File

@ -4263,6 +4263,7 @@ static tree member_declared_type (const_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
@ -4669,8 +4670,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:
@ -4738,8 +4739,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:
@ -11675,6 +11676,163 @@ gen_array_type_die (tree type, dw_die_ref context_die)
add_pubtype (type, array_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 POINTER_PLUS_EXPR:
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 (get_AT (array_die, DW_AT_name))
add_pubtype (type, array_die);
}
#if 0
static void
gen_entry_point_die (tree decl, dw_die_ref context_die)
@ -13051,6 +13209,7 @@ gen_type_die_with_usage (tree type, dw_die_ref context_die,
enum debug_info_usage usage)
{
int need_pop;
struct array_descr_info info;
if (type == NULL_TREE || type == error_mark_node)
return;
@ -13069,6 +13228,16 @@ gen_type_die_with_usage (tree type, dw_die_ref context_die,
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

16
gcc/dwarf2out.h
View File

@ -25,3 +25,19 @@ extern void debug_dwarf (void);
struct die_struct;
extern void debug_dwarf_die (struct die_struct *);
extern void dwarf2out_set_demangle_name_func (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];
};

27
gcc/fortran/ChangeLog
View File

@ -1,3 +1,29 @@
2007-12-09 Jakub Jelinek <jakub@redhat.com>
PR fortran/22244
* 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.
2007-12-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/32129
@ -19,7 +45,6 @@
PR fortran/34345
PR fortran/18026
PR fortran/29471
* gfortran.texi (BOZ literal constants): Improve documentation
and adapt for BOZ changes.
* Make-lang.ini (resolve.o): Add target-memory.h dependency.

2
gcc/fortran/Make-lang.in
View File

@ -312,7 +312,7 @@ fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \
$(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

2
gcc/fortran/f95-lang.c
View File

@ -120,6 +120,7 @@ static alias_set_type gfc_get_alias_set (tree);
#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
#undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
#undef LANG_HOOKS_BUILTIN_FUNCTION
#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
/* Define lang hooks. */
#define LANG_HOOKS_NAME "GNU F95"
@ -143,6 +144,7 @@ static alias_set_type gfc_get_alias_set (tree);
#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
gfc_omp_firstprivatize_type_sizes
#define LANG_HOOKS_BUILTIN_FUNCTION gfc_builtin_function
#define LANG_HOOKS_GET_ARRAY_DESCR_INFO gfc_get_array_descr_info
const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;

6
gcc/fortran/trans-array.c
View File

@ -608,7 +608,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
/* 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;
@ -4783,7 +4784,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
/* 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");
}

3
gcc/fortran/trans-stmt.c
View File

@ -2525,7 +2525,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
/* 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,

154
gcc/fortran/trans-types.c
View File

@ -37,6 +37,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-const.h"
#include "real.h"
#include "flags.h"
#include "dwarf2out.h"
#if (GFC_MAX_DIMENSIONS < 10)
@ -1047,7 +1048,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];
@ -1063,7 +1065,9 @@ gfc_build_array_type (tree type, gfc_array_spec * as)
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. */
@ -1246,7 +1250,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed)
if (expr->expr_type == EXPR_CONSTANT)
{
tmp = gfc_conv_mpz_to_tree (expr->value.integer,
gfc_index_integer_kind);
gfc_index_integer_kind);
}
else
{
@ -1338,7 +1342,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed)
/* 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;
@ -1428,7 +1432,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;
@ -1455,6 +1460,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
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)
@ -1573,9 +1579,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
{
@ -1801,9 +1812,14 @@ gfc_get_derived_type (gfc_symbol * derived)
{
if (c->pointer || c->allocatable)
{
enum gfc_array_kind akind;
if (c->pointer)
akind = GFC_ARRAY_POINTER;
else
akind = GFC_ARRAY_ALLOCATABLE;
/* 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, akind);
}
else
field_type = gfc_get_nodesc_array_type (field_type, c->as,
@ -2121,4 +2137,124 @@ gfc_type_for_mode (enum machine_mode mode, int unsignedp)
return NULL_TREE;
}
/* Return TRUE if TYPE is a type with a hidden descriptor, fill in INFO
in that case. */
bool
gfc_get_array_descr_info (const_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 (POINTER_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 (POINTER_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 (POINTER_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 (POINTER_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"

3
gcc/fortran/trans-types.h
View File

@ -67,7 +67,8 @@ tree gfc_type_for_size (unsigned, int);
tree gfc_type_for_mode (enum machine_mode, int);
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 *, gfc_packed);
/* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE. */

14
gcc/fortran/trans.h
View File

@ -483,6 +483,8 @@ tree poplevel (int, int, int);
tree getdecls (void);
tree gfc_truthvalue_conversion (tree);
tree gfc_builtin_function (tree);
struct array_descr_info;
bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
/* In trans-openmp.c */
bool gfc_omp_privatize_by_reference (const_tree);
@ -569,10 +571,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];
@ -626,7 +637,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) \

2
gcc/langhooks-def.h
View File

@ -180,6 +180,7 @@ extern tree lhd_make_node (enum tree_code);
#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
lhd_omp_firstprivatize_type_sizes
#define LANG_HOOKS_TYPE_HASH_EQ NULL
#define LANG_HOOKS_GET_ARRAY_DESCR_INFO NULL
#define LANG_HOOKS_HASH_TYPES true
#define LANG_HOOKS_FOR_TYPES_INITIALIZER { \
@ -193,6 +194,7 @@ extern tree lhd_make_node (enum tree_code);
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 \
}

6
gcc/langhooks.h
View File

@ -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);
@ -136,6 +138,10 @@ struct lang_hooks_for_types
FUNCTION_TYPEs. */
bool (*type_hash_eq) (const_tree, const_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) (const_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. */