From 10174ddf5d0e0e2293e54ebc14f9c49a9983de98 Mon Sep 17 00:00:00 2001 From: Michael Matz Date: Wed, 19 Aug 2009 10:17:33 +0000 Subject: [PATCH] tree-ssa-structalias.c (create_variable_info_for): Also mark first field in a struct. * 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. From-SVN: r150934 --- gcc/ChangeLog | 6 ++ gcc/fortran/ChangeLog | 31 ++++++++++ gcc/fortran/trans-array.c | 6 +- gcc/fortran/trans-decl.c | 26 ++++++++- gcc/fortran/trans-expr.c | 18 ++++-- gcc/fortran/trans-stmt.c | 2 +- gcc/fortran/trans-types.c | 60 ++++++++++++++------ gcc/fortran/trans-types.h | 5 +- gcc/fortran/trans.c | 33 +++++++---- gcc/fortran/trans.h | 1 + gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gcc.dg/tree-ssa/alias-1.c | 17 ------ gcc/testsuite/gfortran.dg/vect/vect-gems.f90 | 57 +++++++++++++++++++ gcc/tree-ssa-structalias.c | 46 +++------------ 14 files changed, 219 insertions(+), 94 deletions(-) delete mode 100644 gcc/testsuite/gcc.dg/tree-ssa/alias-1.c create mode 100644 gcc/testsuite/gfortran.dg/vect/vect-gems.f90 diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 206656d6c0c..9df0297b0c6 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,9 @@ +2009-08-18 Michael Matz + + * 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. + 2009-08-18 Uros Bizjak * config/alpha/alpha.c (alpha_output_mi_thunk_osf): Allocate insn diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d7873260933..4eb6ea24428 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,34 @@ +2009-08-18 Michael Matz + + * 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. + 2009-08-18 Janus Weil Paul Thomas diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 529a6b10495..31c59c6ee84 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -725,7 +725,7 @@ 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_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 (gfc_expr * expr, tree type) 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, gfc_expr * expr, gfc_ss * ss) 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"); } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 7fb571f5e57..6a4c3e45cc9 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -578,6 +578,29 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) 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 * sym, tree dummy) } 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 { diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 144c20441e9..7672f0b092d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -374,8 +374,10 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, 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 * ref, int kind, 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 * ref, int kind, } 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 (stmtblock_t * block, gfc_symbol * sym, 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)); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 935943727ab..66aecb19520 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -2694,7 +2694,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, 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, diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 90e82d488d7..4a293998800 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -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_array_spec * as, 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, gfc_array_spec * as, gfc_packed packed) /* 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, gfc_array_spec * as, gfc_packed packed) /* 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, gfc_array_spec * as, gfc_packed packed) /* 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, int dimen, tree * lbound, 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 * derived) 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); diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 283d57772a0..87feea3dfaf 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -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); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 35a786aef29..f4a215aeeaf 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -159,11 +159,21 @@ gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs) 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, tree type, tree size) 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, tree type, tree size) 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 * block, tree size, tree status) 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 * block, tree size, tree status) 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 * block, tree size, tree status) /* 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 * block, tree size, tree status) 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 (stmtblock_t * block, tree mem, tree size, 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)); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 4469023499d..643f28b37f4 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -629,6 +629,7 @@ struct GTY(()) lang_type { tree dataptr_type; tree span; tree base_decl[2]; + tree nontarget_type; }; struct GTY(()) lang_decl { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ea60d928e8b..e766efcc3e4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-08-18 Michael Matz + + * gfortran.dg/vect/vect-gems.f90: New test. + * gcc.dg/tree-ssa/alias-1.c: Remove, it checks something broken. + 2009-08-18 DJ Delorie * lib/wrapper.exp: Move load of target-libpath.exp from here... diff --git a/gcc/testsuite/gcc.dg/tree-ssa/alias-1.c b/gcc/testsuite/gcc.dg/tree-ssa/alias-1.c deleted file mode 100644 index 6e88eb1ce23..00000000000 --- a/gcc/testsuite/gcc.dg/tree-ssa/alias-1.c +++ /dev/null @@ -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" } } */ diff --git a/gcc/testsuite/gfortran.dg/vect/vect-gems.f90 b/gcc/testsuite/gfortran.dg/vect/vect-gems.f90 new file mode 100644 index 00000000000..019b4155844 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/vect/vect-gems.f90 @@ -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" } } diff --git a/gcc/tree-ssa-structalias.c b/gcc/tree-ssa-structalias.c index 50ef0b660f9..72e10835bb5 100644 --- a/gcc/tree-ssa-structalias.c +++ b/gcc/tree-ssa-structalias.c @@ -4519,6 +4519,13 @@ create_variable_info_for (tree decl, const char *name) 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"); -- 2.30.2