This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: RFA: Revamp fortran array types
Hi,
On Mon, 17 Aug 2009, Toon Moene wrote:
> I am really *not* a fan of the following negative logic:
>
> static tree
> gfc_build_array_type (tree type, gfc_array_spec * as,
> - enum gfc_array_kind akind)
> + enum gfc_array_kind akind, bool nontarget)
>
> as in "this is not a non-target".
>
> Could you flip the sense of this boolean ?
Instead of flipping the sense I've renamed the parameter to "restricted",
hopefully not as confusing (I think the direction I chose is the better
one, only if that argument is true something special happens, namely a
restricted type will be constructed).
I've also removed gcc.dg/tree-ssa/alias-1.c that checked that
flag_argument_noalias was working as expected.
For reference the whole patch I checked in as r150934 is below.
Ciao,
Michael.
--
* tree-ssa-structalias.c (create_variable_info_for): Also mark
first field in a struct.
(intra_create_variable_infos): Don't deal with flag_argument_noalias.
fortran/
* trans-expr.c (gfc_conv_substring): Don't evaluate casted decl early,
change order of length calculation to (end - start) + 1.
(gfc_get_interface_mapping_array): Adjust call to
gfc_get_nodesc_array_type.
* trans-array.c (gfc_trans_create_temp_array,
gfc_build_constant_array_constructor, gfc_conv_expr_descriptor): Ditto.
* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Ditto.
* trans.c (gfc_add_modify): Assignment between base type and nontarget
type are equal enough.
(gfc_call_malloc): Use prvoid_type_node for return value of
__builtin_malloc.
(gfc_allocate_with_status): Ditto.
* trans-types.c (gfc_array_descriptor_base): Double size of this array.
(gfc_init_types): Build prvoid_type_node.
(gfc_build_array_type): New bool parameter "restricted".
(gfc_get_nodesc_array_type): Ditto, build restrict qualified pointers,
if it's true.
(gfc_get_array_descriptor_base): Ditto.
(gfc_get_array_type_bounds): Ditto.
(gfc_sym_type): Use symbol attributes to feed calls to above functions.
(gfc_get_derived_type): Ditto.
* trans.h (struct lang_type): Add nontarget_type member.
* trans-types.h (prvoid_type_node): Declare.
(gfc_get_array_type_bounds, gfc_get_nodesc_array_type): Declare new
parameter.
* trans-decl.c (gfc_finish_var_decl): Give scalars that can't be
aliased a type with a different alias set than the base type.
(gfc_build_dummy_array_decl): Adjust call to gfc_get_nodesc_array_type.
testsuite/
* gfortran.dg/vect/vect-gems.f90: New test.
* gcc.dg/tree-ssa/alias-1.c: Remove, it checks something broken.
Index: tree-ssa-structalias.c
===================================================================
--- tree-ssa-structalias.c (revision 150933)
+++ tree-ssa-structalias.c (working copy)
@@ -4519,6 +4519,13 @@ create_variable_info_for (tree decl, con
vi->size = fo->size;
vi->offset = fo->offset;
vi->may_have_pointers = fo->may_have_pointers;
+ if (vi->is_global_var
+ && (!flag_whole_program || !in_ipa_mode)
+ && vi->may_have_pointers)
+ {
+ if (fo->only_restrict_pointers)
+ make_constraint_from_restrict (vi, "GLOBAL_RESTRICT");
+ }
for (i = VEC_length (fieldoff_s, fieldstack) - 1;
i >= 1 && VEC_iterate (fieldoff_s, fieldstack, i, fo);
i--)
@@ -4611,43 +4618,8 @@ intra_create_variable_infos (void)
if (!could_have_pointers (t))
continue;
- /* If flag_argument_noalias is set, then function pointer
- arguments are guaranteed not to point to each other. In that
- case, create an artificial variable PARM_NOALIAS and the
- constraint ARG = &PARM_NOALIAS. */
- if (POINTER_TYPE_P (TREE_TYPE (t)) && flag_argument_noalias > 0)
- {
- varinfo_t vi;
- var_ann_t ann;
-
- vi = make_constraint_from_heapvar (get_vi_for_tree (t),
- "PARM_NOALIAS");
- ann = get_var_ann (vi->decl);
- if (flag_argument_noalias == 1)
- {
- ann->noalias_state = NO_ALIAS;
- make_copy_constraint (vi, nonlocal_id);
- }
- else if (flag_argument_noalias == 2)
- {
- ann->noalias_state = NO_ALIAS_GLOBAL;
- make_constraint_from (vi, vi->id);
- }
- else if (flag_argument_noalias == 3)
- {
- ann->noalias_state = NO_ALIAS_ANYTHING;
- make_constraint_from (vi, vi->id);
- }
- else
- gcc_unreachable ();
- }
- else
- {
- varinfo_t arg_vi = get_vi_for_tree (t);
-
- for (p = arg_vi; p; p = p->next)
- make_constraint_from (p, nonlocal_id);
- }
+ for (p = get_vi_for_tree (t); p; p = p->next)
+ make_constraint_from (p, nonlocal_id);
if (POINTER_TYPE_P (TREE_TYPE (t))
&& TYPE_RESTRICT (TREE_TYPE (t)))
make_constraint_from_restrict (get_vi_for_tree (t), "PARM_RESTRICT");
Index: fortran/trans-array.c
===================================================================
--- fortran/trans-array.c (revision 150933)
+++ fortran/trans-array.c (working copy)
@@ -725,7 +725,7 @@ gfc_trans_create_temp_array (stmtblock_t
/* Initialize the descriptor. */
type =
gfc_get_array_type_bounds (eltype, info->dimen, loop->from, loop->to, 1,
- GFC_ARRAY_UNKNOWN);
+ GFC_ARRAY_UNKNOWN, true);
desc = gfc_create_var (type, "atmp");
GFC_DECL_PACKED_ARRAY (desc) = 1;
@@ -1715,7 +1715,7 @@ gfc_build_constant_array_constructor (gf
as.upper[i] = gfc_int_expr (tmp - 1);
}
- tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC);
+ tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
init = build_constructor_from_list (tmptype, nreverse (list));
@@ -5250,7 +5250,7 @@ gfc_conv_expr_descriptor (gfc_se * se, g
parmtype = gfc_get_element_type (TREE_TYPE (desc));
parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
loop.from, loop.to, 0,
- GFC_ARRAY_UNKNOWN);
+ GFC_ARRAY_UNKNOWN, false);
parm = gfc_create_var (parmtype, "parm");
}
Index: fortran/trans-expr.c
===================================================================
--- fortran/trans-expr.c (revision 150933)
+++ fortran/trans-expr.c (working copy)
@@ -374,8 +374,10 @@ gfc_conv_substring (gfc_se * se, gfc_ref
gfc_conv_string_parameter (se);
else
{
+ tmp = start.expr;
+ STRIP_NOPS (tmp);
/* Avoid multiple evaluation of substring start. */
- if (!CONSTANT_CLASS_P (start.expr) && !DECL_P (start.expr))
+ if (!CONSTANT_CLASS_P (tmp) && !DECL_P (tmp))
start.expr = gfc_evaluate_now (start.expr, &se->pre);
/* Change the start of the string. */
@@ -397,7 +399,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref
gfc_conv_expr_type (&end, ref->u.ss.end, gfc_charlen_type_node);
gfc_add_block_to_block (&se->pre, &end.pre);
}
- if (!CONSTANT_CLASS_P (end.expr) && !DECL_P (end.expr))
+ tmp = end.expr;
+ STRIP_NOPS (tmp);
+ if (!CONSTANT_CLASS_P (tmp) && !DECL_P (tmp))
end.expr = gfc_evaluate_now (end.expr, &se->pre);
if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
@@ -440,9 +444,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref
}
tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node,
- build_int_cst (gfc_charlen_type_node, 1),
- start.expr);
- tmp = fold_build2 (PLUS_EXPR, gfc_charlen_type_node, end.expr, tmp);
+ end.expr, start.expr);
+ tmp = fold_build2 (PLUS_EXPR, gfc_charlen_type_node,
+ build_int_cst (gfc_charlen_type_node, 1), tmp);
tmp = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tmp,
build_int_cst (gfc_charlen_type_node, 0));
se->string_length = tmp;
@@ -1611,7 +1615,9 @@ gfc_get_interface_mapping_array (stmtblo
tree var;
type = gfc_typenode_for_spec (&sym->ts);
- type = gfc_get_nodesc_array_type (type, sym->as, packed);
+ type = gfc_get_nodesc_array_type (type, sym->as, packed,
+ !sym->attr.target && !sym->attr.pointer
+ && !sym->attr.proc_pointer);
var = gfc_create_var (type, "ifm");
gfc_add_modify (block, var, fold_convert (type, data));
Index: fortran/trans-stmt.c
===================================================================
--- fortran/trans-stmt.c (revision 150933)
+++ fortran/trans-stmt.c (working copy)
@@ -2694,7 +2694,7 @@ gfc_trans_pointer_assign_need_temp (gfc_
parmtype = gfc_get_element_type (TREE_TYPE (desc));
parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen,
loop.from, loop.to, 1,
- GFC_ARRAY_UNKNOWN);
+ GFC_ARRAY_UNKNOWN, true);
/* Allocate temporary for nested forall construct. */
tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype,
Index: fortran/trans.c
===================================================================
--- fortran/trans.c (revision 150933)
+++ fortran/trans.c (working copy)
@@ -159,11 +159,21 @@ gfc_add_modify (stmtblock_t * pblock, tr
tree tmp;
#ifdef ENABLE_CHECKING
+ tree t1, t2;
+ t1 = TREE_TYPE (rhs);
+ t2 = TREE_TYPE (lhs);
+ /* ??? This is actually backwards, we should test the "base" type
+ from which the nontarget_type was copied, but we don't have this
+ backlink. This will do for now, it's for checking anyway. */
+ if (TYPE_LANG_SPECIFIC (t1))
+ t1 = TYPE_LANG_SPECIFIC (t1)->nontarget_type;
+ if (TYPE_LANG_SPECIFIC (t2))
+ t2 = TYPE_LANG_SPECIFIC (t2)->nontarget_type;
/* Make sure that the types of the rhs and the lhs are the same
for scalar assignments. We should probably have something
similar for aggregates, but right now removing that check just
breaks everything. */
- gcc_assert (TREE_TYPE (rhs) == TREE_TYPE (lhs)
+ gcc_assert (t1 == t2
|| AGGREGATE_TYPE_P (TREE_TYPE (lhs)));
#endif
@@ -509,7 +519,7 @@ gfc_call_malloc (stmtblock_t * block, tr
size = fold_convert (size_type_node, size);
/* Create a variable to hold the result. */
- res = gfc_create_var (pvoid_type_node, NULL);
+ res = gfc_create_var (prvoid_type_node, NULL);
/* size < 0 ? */
negative = fold_build2 (LT_EXPR, boolean_type_node, size,
@@ -529,9 +539,9 @@ gfc_call_malloc (stmtblock_t * block, tr
build_int_cst (size_type_node, 1));
gfc_add_modify (&block2, res,
- build_call_expr_loc (input_location,
- built_in_decls[BUILT_IN_MALLOC], 1,
- size));
+ fold_convert (prvoid_type_node,
+ build_call_expr_loc (input_location,
+ built_in_decls[BUILT_IN_MALLOC], 1, size)));
null_result = fold_build2 (EQ_EXPR, boolean_type_node, res,
build_int_cst (pvoid_type_node, 0));
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
@@ -601,7 +611,7 @@ gfc_allocate_with_status (stmtblock_t *
size = fold_convert (size_type_node, size);
/* Create a variable to hold the result. */
- res = gfc_create_var (pvoid_type_node, NULL);
+ res = gfc_create_var (prvoid_type_node, NULL);
/* Set the optional status variable to zero. */
if (status != NULL_TREE && !integer_zerop (status))
@@ -633,7 +643,7 @@ gfc_allocate_with_status (stmtblock_t *
fold_build1 (INDIRECT_REF, status_type, status),
build_int_cst (status_type, LIBERROR_ALLOCATION));
gfc_add_modify (&set_status_block, res,
- build_int_cst (pvoid_type_node, 0));
+ build_int_cst (prvoid_type_node, 0));
tmp = fold_build2 (EQ_EXPR, boolean_type_node, status,
build_int_cst (TREE_TYPE (status), 0));
@@ -644,11 +654,12 @@ gfc_allocate_with_status (stmtblock_t *
/* The allocation itself. */
gfc_start_block (&alloc_block);
gfc_add_modify (&alloc_block, res,
- build_call_expr_loc (input_location,
+ fold_convert (prvoid_type_node,
+ build_call_expr_loc (input_location,
built_in_decls[BUILT_IN_MALLOC], 1,
fold_build2 (MAX_EXPR, size_type_node,
size,
- build_int_cst (size_type_node, 1))));
+ build_int_cst (size_type_node, 1)))));
msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
("Out of memory"));
@@ -671,7 +682,7 @@ gfc_allocate_with_status (stmtblock_t *
tmp = fold_build3 (COND_EXPR, void_type_node,
fold_build2 (EQ_EXPR, boolean_type_node, res,
- build_int_cst (pvoid_type_node, 0)),
+ build_int_cst (prvoid_type_node, 0)),
tmp, build_empty_stmt (input_location));
gfc_add_expr_to_block (&alloc_block, tmp);
@@ -723,7 +734,7 @@ gfc_allocate_array_with_status (stmtbloc
size = fold_convert (size_type_node, size);
/* Create a variable to hold the result. */
- res = gfc_create_var (pvoid_type_node, NULL);
+ res = gfc_create_var (type, NULL);
null_mem = fold_build2 (EQ_EXPR, boolean_type_node, mem,
build_int_cst (type, 0));
Index: fortran/trans-types.c
===================================================================
--- fortran/trans-types.c (revision 150933)
+++ fortran/trans-types.c (working copy)
@@ -59,6 +59,7 @@ tree gfc_array_index_type;
tree gfc_array_range_type;
tree gfc_character1_type_node;
tree pvoid_type_node;
+tree prvoid_type_node;
tree ppvoid_type_node;
tree pchar_type_node;
tree pfunc_type_node;
@@ -67,7 +68,7 @@ tree gfc_charlen_type_node;
static GTY(()) tree gfc_desc_dim_type;
static GTY(()) tree gfc_max_array_element_size;
-static GTY(()) tree gfc_array_descriptor_base[GFC_MAX_DIMENSIONS];
+static GTY(()) tree gfc_array_descriptor_base[2 * GFC_MAX_DIMENSIONS];
/* Arrays for all integral and real kinds. We'll fill this in at runtime
after the target has a chance to process command-line options. */
@@ -866,6 +867,7 @@ gfc_init_types (void)
#undef PUSH_TYPE
pvoid_type_node = build_pointer_type (void_type_node);
+ prvoid_type_node = build_qualified_type (pvoid_type_node, TYPE_QUAL_RESTRICT);
ppvoid_type_node = build_pointer_type (pvoid_type_node);
pchar_type_node = build_pointer_type (gfc_character1_type_node);
pfunc_type_node
@@ -1202,7 +1204,7 @@ gfc_is_nodesc_array (gfc_symbol * sym)
static tree
gfc_build_array_type (tree type, gfc_array_spec * as,
- enum gfc_array_kind akind)
+ enum gfc_array_kind akind, bool restricted)
{
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
@@ -1220,7 +1222,8 @@ gfc_build_array_type (tree type, gfc_arr
if (as->type == AS_ASSUMED_SHAPE)
akind = GFC_ARRAY_ASSUMED_SHAPE;
- return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0, akind);
+ return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0, akind,
+ restricted);
}
/* Returns the struct descriptor_dimension type. */
@@ -1365,7 +1368,8 @@ gfc_get_dtype (tree type)
to the value of PACKED. */
tree
-gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed)
+gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
+ bool restricted)
{
tree range;
tree type;
@@ -1474,6 +1478,10 @@ gfc_get_nodesc_array_type (tree etype, g
/* TODO: use main type if it is unbounded. */
GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
build_pointer_type (build_array_type (etype, range));
+ if (restricted)
+ GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
+ build_qualified_type (GFC_TYPE_ARRAY_DATAPTR_TYPE (type),
+ TYPE_QUAL_RESTRICT);
if (known_stride)
{
@@ -1519,6 +1527,8 @@ gfc_get_nodesc_array_type (tree etype, g
/* For dummy arrays and automatic (heap allocated) arrays we
want a pointer to the array. */
type = build_pointer_type (type);
+ if (restricted)
+ type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
GFC_ARRAY_TYPE_P (type) = 1;
TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
}
@@ -1528,14 +1538,15 @@ gfc_get_nodesc_array_type (tree etype, g
/* Return or create the base type for an array descriptor. */
static tree
-gfc_get_array_descriptor_base (int dimen)
+gfc_get_array_descriptor_base (int dimen, bool restricted)
{
tree fat_type, fieldlist, decl, arraytype;
char name[16 + GFC_RANK_DIGITS + 1];
+ int idx = 2 * (dimen - 1) + restricted;
gcc_assert (dimen >= 1 && dimen <= GFC_MAX_DIMENSIONS);
- if (gfc_array_descriptor_base[dimen - 1])
- return gfc_array_descriptor_base[dimen - 1];
+ if (gfc_array_descriptor_base[idx])
+ return gfc_array_descriptor_base[idx];
/* Build the type node. */
fat_type = make_node (RECORD_TYPE);
@@ -1545,7 +1556,8 @@ gfc_get_array_descriptor_base (int dimen
/* Add the data member as the first element of the descriptor. */
decl = build_decl (input_location,
- FIELD_DECL, get_identifier ("data"), ptr_type_node);
+ FIELD_DECL, get_identifier ("data"),
+ restricted ? prvoid_type_node : ptr_type_node);
DECL_CONTEXT (decl) = fat_type;
fieldlist = decl;
@@ -1585,7 +1597,7 @@ gfc_get_array_descriptor_base (int dimen
gfc_finish_type (fat_type);
TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (fat_type)) = 1;
- gfc_array_descriptor_base[dimen - 1] = fat_type;
+ gfc_array_descriptor_base[idx] = fat_type;
return fat_type;
}
@@ -1594,15 +1606,18 @@ gfc_get_array_descriptor_base (int dimen
tree
gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
tree * ubound, int packed,
- enum gfc_array_kind akind)
+ enum gfc_array_kind akind, bool restricted)
{
char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN];
tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype;
const char *type_name;
int n;
- base_type = gfc_get_array_descriptor_base (dimen);
+ base_type = gfc_get_array_descriptor_base (dimen, restricted);
fat_type = build_distinct_type_copy (base_type);
+ /* Make sure that nontarget and target array type have the same canonical
+ type (and same stub decl for debug info). */
+ base_type = gfc_get_array_descriptor_base (dimen, false);
TYPE_CANONICAL (fat_type) = base_type;
TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type);
@@ -1684,6 +1699,8 @@ gfc_get_array_type_bounds (tree etype, i
rtype = gfc_array_range_type;
arraytype = build_array_type (etype, rtype);
arraytype = build_pointer_type (arraytype);
+ if (restricted)
+ arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
/* This will generate the base declarations we need to emit debug
@@ -1723,6 +1740,7 @@ gfc_sym_type (gfc_symbol * sym)
{
tree type;
int byref;
+ bool restricted;
/* Procedure Pointers inside COMMON blocks. */
if (sym->attr.proc_pointer && sym->attr.in_common)
@@ -1757,6 +1775,8 @@ gfc_sym_type (gfc_symbol * sym)
else
byref = 0;
+ restricted = !sym->attr.target && !sym->attr.pointer
+ && !sym->attr.proc_pointer;
if (sym->attr.dimension)
{
if (gfc_is_nodesc_array (sym))
@@ -1769,7 +1789,8 @@ gfc_sym_type (gfc_symbol * sym)
{
type = gfc_get_nodesc_array_type (type, sym->as,
byref ? PACKED_FULL
- : PACKED_STATIC);
+ : PACKED_STATIC,
+ restricted);
byref = 0;
}
}
@@ -1780,7 +1801,7 @@ gfc_sym_type (gfc_symbol * sym)
akind = GFC_ARRAY_POINTER;
else if (sym->attr.allocatable)
akind = GFC_ARRAY_ALLOCATABLE;
- type = gfc_build_array_type (type, sym->as, akind);
+ type = gfc_build_array_type (type, sym->as, akind, restricted);
}
}
else
@@ -1801,7 +1822,11 @@ gfc_sym_type (gfc_symbol * sym)
if (sym->attr.optional || sym->ns->proc_name->attr.entry_master)
type = build_pointer_type (type);
else
- type = build_reference_type (type);
+ {
+ type = build_reference_type (type);
+ if (restricted)
+ type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
+ }
}
return (type);
@@ -2100,11 +2125,14 @@ gfc_get_derived_type (gfc_symbol * deriv
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, akind);
+ field_type = gfc_build_array_type (field_type, c->as, akind,
+ !c->attr.target
+ && !c->attr.pointer);
}
else
field_type = gfc_get_nodesc_array_type (field_type, c->as,
- PACKED_STATIC);
+ PACKED_STATIC,
+ !c->attr.target);
}
else if (c->attr.pointer)
field_type = build_pointer_type (field_type);
Index: fortran/trans.h
===================================================================
--- fortran/trans.h (revision 150933)
+++ fortran/trans.h (working copy)
@@ -629,6 +629,7 @@ struct GTY(()) lang_type {
tree dataptr_type;
tree span;
tree base_decl[2];
+ tree nontarget_type;
};
struct GTY(()) lang_decl {
Index: fortran/trans-types.h
===================================================================
--- fortran/trans-types.h (revision 150933)
+++ fortran/trans-types.h (working copy)
@@ -29,6 +29,7 @@ extern GTY(()) tree gfc_array_range_type
extern GTY(()) tree gfc_character1_type_node;
extern GTY(()) tree ppvoid_type_node;
extern GTY(()) tree pvoid_type_node;
+extern GTY(()) tree prvoid_type_node;
extern GTY(()) tree pchar_type_node;
/* This is the type used to hold the lengths of character variables.
@@ -72,8 +73,8 @@ tree gfc_build_uint_type (int);
tree gfc_get_element_type (tree);
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);
+ enum gfc_array_kind, bool);
+tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool);
/* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE. */
tree gfc_add_field_to_struct (tree *, tree, tree, tree);
Index: fortran/trans-decl.c
===================================================================
--- fortran/trans-decl.c (revision 150933)
+++ fortran/trans-decl.c (working copy)
@@ -578,6 +578,29 @@ gfc_finish_var_decl (tree decl, gfc_symb
if (sym->attr.threadprivate
&& (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
DECL_TLS_MODEL (decl) = decl_default_tls_model (decl);
+
+ if (!sym->attr.target
+ && !sym->attr.pointer
+ && !sym->attr.proc_pointer
+ /* For now, don't bother with aggregate types. We would need
+ to adjust DECL_CONTEXT of all field decls. */
+ && !AGGREGATE_TYPE_P (TREE_TYPE (decl)))
+ {
+ tree type = TREE_TYPE (decl);
+ if (!TYPE_LANG_SPECIFIC (type))
+ TYPE_LANG_SPECIFIC (type) = (struct lang_type *)
+ ggc_alloc_cleared (sizeof (struct lang_type));
+ if (!TYPE_LANG_SPECIFIC (type)->nontarget_type)
+ {
+ alias_set_type set = new_alias_set ();
+ type = build_distinct_type_copy (type);
+ TYPE_ALIAS_SET (type) = set;
+ TYPE_LANG_SPECIFIC (type)->nontarget_type = type;
+ }
+ else
+ type = TYPE_LANG_SPECIFIC (type)->nontarget_type;
+ TREE_TYPE (decl) = type;
+ }
}
@@ -840,7 +863,8 @@ gfc_build_dummy_array_decl (gfc_symbol *
}
type = gfc_typenode_for_spec (&sym->ts);
- type = gfc_get_nodesc_array_type (type, sym->as, packed);
+ type = gfc_get_nodesc_array_type (type, sym->as, packed,
+ !sym->attr.target);
}
else
{
Index: testsuite/gcc.dg/tree-ssa/alias-1.c
===================================================================
--- testsuite/gcc.dg/tree-ssa/alias-1.c (revision 150933)
+++ testsuite/gcc.dg/tree-ssa/alias-1.c (working copy)
@@ -1,17 +0,0 @@
-/* { dg-options "-O2 -fargument-noalias-global -fdump-tree-optimized" } */
-int f;
-void link_error ();
-
-void g(int *i)
-{
- *i = 0;
- f = 1;
- if (*i != 0)
- link_error ();
-}
-
-
-/* We should have removed the link_error on the tree level as we told GCC
- that *i cannot point to f via the option -fargument-noalias-global. */
-/* { dg-final { scan-tree-dump-times "link_error" 0 "optimized"} } */
-/* { dg-final { cleanup-tree-dump "optimized" } } */
Index: testsuite/gfortran.dg/vect/vect-gems.f90
===================================================================
--- testsuite/gfortran.dg/vect/vect-gems.f90 (revision 0)
+++ testsuite/gfortran.dg/vect/vect-gems.f90 (revision 0)
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-require-effective-target vect_double }
+
+MODULE UPML_mod
+
+IMPLICIT NONE
+
+PUBLIC UPMLupdateE
+
+PRIVATE
+
+real(kind=8), dimension(:,:,:), allocatable :: Dx_ilow
+
+real(kind=8), dimension(:), allocatable :: aye, aze
+real(kind=8), dimension(:), allocatable :: bye, bze
+real(kind=8), dimension(:), allocatable :: fxh, cxh
+
+real(kind=8) :: epsinv
+real(kind=8) :: dxinv, dyinv, dzinv
+
+integer :: xstart, ystart, zstart, xstop, ystop, zstop
+
+CONTAINS
+
+SUBROUTINE UPMLupdateE(nx,ny,nz,Hx,Hy,Hz,Ex,Ey,Ez)
+
+integer, intent(in) :: nx, ny, nz
+real(kind=8), intent(inout), &
+ dimension(xstart:xstop+1,ystart:ystop+1,zstart:zstop+1) :: Ex, Ey, Ez
+real(kind=8), intent(inout), &
+ allocatable :: Hx(:,:,:), Hy(:,:,:), Hz(:,:,:)
+
+integer :: i, j, k
+real(kind=8) :: Dxold, Dyold, Dzold
+
+do k=zstart+1,zstop
+ do j=ystart+1,ystop
+ do i=xstart+1,0
+
+ Dxold = Dx_ilow(i,j,k)
+
+ Dx_ilow(i,j,k) = aye(j) * Dx_ilow(i,j,k) + &
+ bye(j) * ((Hz(i,j,k )-Hz(i,j-1,k))*dyinv + &
+ (Hy(i,j,k-1)-Hy(i,j,k ))*dzinv)
+
+ Ex(i,j,k) = aze(k) * Ex(i,j,k) + &
+ bze(k) * (cxh(i)*Dx_ilow(i,j,k) - fxh(i)*Dxold) * epsinv
+ end do
+ end do
+end do
+
+END SUBROUTINE UPMLupdateE
+
+END MODULE UPML_mod
+
+! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" } }
+! { dg-final { cleanup-tree-dump "vect" } }