From patchwork Tue May 24 22:05:39 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 97237 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 91845B6F9F for ; Wed, 25 May 2011 08:06:04 +1000 (EST) Received: (qmail 29594 invoked by alias); 24 May 2011 22:06:02 -0000 Received: (qmail 29573 invoked by uid 22791); 24 May 2011 22:05:59 -0000 X-SWARE-Spam-Status: No, hits=-1.7 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, TW_FN, TW_TM X-Spam-Check-By: sourceware.org Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 24 May 2011 22:05:42 +0000 Received: from [192.168.178.22] (port-92-204-35-67.dynamic.qsc.de [92.204.35.67]) by mx01.qsc.de (Postfix) with ESMTP id CB3873CD30; Wed, 25 May 2011 00:05:39 +0200 (CEST) Message-ID: <4DDC2BB3.7020007@net-b.de> Date: Wed, 25 May 2011 00:05:39 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.14) Gecko/20110221 SUSE/3.1.8 Thunderbird/3.1.8 MIME-Version: 1.0 To: gcc patches , gfortran Subject: Re: [Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays References: <4DD92E1A.5010908@net-b.de> In-Reply-To: <4DD92E1A.5010908@net-b.de> Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Instead of a ping, an updated patch. This one additionally supports registering of nonallocatable coarrays also in MODULE and in BLOCK plus a test case. (Changes to gfc_generate_module_vars and gfc_process_block_locals and cgraph call in generate_coarray_init; some functions were moved up in the trans-decl.c file.) OK for the trunk? Tobias On 22 May 2011, Tobias Burnus wrote: > The following applies to -fcoarray=lib; for -fcoarray=single there > should be no change. > > The coarray communication library needs to know about the coarrays > even before the function containing them has been invoked. Thus, the > coarrays (of all translation units) need to be registered at start up. > > This patch handles this by creating a _caf_init function with > constructor attribute, which is nested in the the parent's procedure > if the latter contains local nonallocatable (and thus: static/SAVE) > coarrays variables. > > At the same time, all (nonallocatable) coarrays have been turned into > pointers - to allow the communication library to allocate the memory. > This allows optimizations, e.g., by allocating in memory which is > available for all images on the same node (cf. MPI_Alloc_mem). > > Additionally, a "token" is saved with the coarray, which allows the > coarray library to identify the coarray. In a simple implementation, > it could simply use the base_addr of the coarray or enumerate them > through. > > > Example: The small example program > > ------------- < test.f90 >----------------- > program caf_program > integer :: a[*] = 7 > a = 8 > end program caf_program > ------------- ----------------- > > is turned into the following tree (-fdump-tree-original) > > ------------- < test.f90.003t.original >----------------- > _caf_init.1 () > { > a = (integer(kind=4) * restrict) _gfortran_caf_register (4, 0, > &caf_token.0, 0B, 0B, 0); > *a = 7; > } > > caf_program () > { > static void * caf_token.0; > static integer(kind=4) * restrict a; > void _caf_init.1 (void); > > (integer(kind=4)) *a = 8; > } > > main (integer(kind=4) argc, character(kind=1) * * argv) > { > static integer(kind=4) options.2[8] = {68, 1023, 0, 0, 1, 1, 0, 1}; > > _gfortran_caf_init (&argc, &argv, &_gfortran_caf_this_image, > &_gfortran_caf_num_images); > _gfortran_set_args (argc, argv); > _gfortran_set_options (8, &options.2[0]); > _gfortran_caf_sync_all (0B, 0); > caf_program (); > __sync_synchronize (); > _gfortran_caf_finalize (); > return 0; > } > ------------- ----------------- > > Note: By construction, _gfortran_caf_register is called before > _gfortran_caf_init; thus, the MPI library will be initialized by the > first _gfortran_caf_register call, unless the program does not have > any nonallocatable coarrays. > > No test cases, but the ones in gfortran.dg/coarray/ should already > test this functionality. > > To be done in later patches: > - Coarrays declared in modules (module variables) > - Allocatable coarrays > > Note: As constructors are never optimized away [unless they are > pure/const], static coarrays and also uncalled functions containing > static coarrays will not be optimized away. (Cf. PRs middle-end/49106 > and middle-end/49108.) > > Bootstrapped and regtested on x86-64-linux. > OK for the trunk? > > Tobias 2011-05-24 Tobias Burnus PR fortran/18918 * trans-array.c (gfc_conv_array_ref): Handle pointer coarrays. * trans-decl.c (has_coarray_vars, caf_init_block, gfor_fndecl_caf_register): New file-global variables. (gfc_finish_var_decl): Make sure that coarrays in main are static. (gfc_build_qualified_array): Generate coarray token variable. (gfc_get_symbol_decl): Don't use a static initializer for coarrays. (gfc_build_builtin_function_decls): Set gfor_fndecl_caf_register. (gfc_trans_deferred_vars, gfc_emit_parameter_debug_info): Skip for static coarrays. (generate_local_decl): Check for local coarrays. (create_main_function): SYNC ALL before calling MAIN. (generate_coarray_sym_init): Register static coarray. (generate_coarray_init): Generate CAF registering constructor function. (gfc_generate_function_code): Call it, if needed, do not create cgraph twice. (gfc_generate_module_vars, gfc_process_block_locals): Call generate_coarray_init. * trans-types.c (gfc_get_nodesc_array_type): Generate pointers for -fcoarray=lib. * trans.h (gfor_fndecl_caf_register): New variable. (lang_type): New element caf_token. (GFC_TYPE_ARRAY_CAF_TOKEN): New macro. 2011-05-22 Tobias Burnus PR fortran/18918 * gfortran.dg/coarray/registering_1.f90: New. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 78d65a6..29c7f83 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2623,6 +2623,10 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, if (ar->dimen == 0) { gcc_assert (ar->codimen); + if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr)) + && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE) + se->expr = build_fold_indirect_ref_loc (input_location, se->expr); + /* Use the actual tree type and not the wrapped coarray. */ se->expr = fold_convert (TREE_TYPE (TREE_TYPE (se->expr)), se->expr); return; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index d771484..299f224 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -78,6 +78,12 @@ static gfc_namespace *module_namespace; static gfc_symbol* current_procedure_symbol = NULL; +/* With -fcoarray=lib: For generating the registering call + of static coarrays. */ +static bool has_coarray_vars; +static stmtblock_t caf_init_block; + + /* List of static constructor functions. */ tree gfc_static_ctors; @@ -114,6 +120,7 @@ tree gfor_fndecl_associated; /* Coarray run-time library function decls. */ tree gfor_fndecl_caf_init; tree gfor_fndecl_caf_finalize; +tree gfor_fndecl_caf_register; tree gfor_fndecl_caf_critical; tree gfor_fndecl_caf_end_critical; tree gfor_fndecl_caf_sync_all; @@ -566,7 +573,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) SAVE_EXPLICIT. */ if (!sym->attr.use_assoc && (sym->attr.save != SAVE_NONE || sym->attr.data - || (sym->value && sym->ns->proc_name->attr.is_main_program))) + || (sym->value && sym->ns->proc_name->attr.is_main_program) + || (gfc_option.coarray == GFC_FCOARRAY_LIB + && sym->attr.codimension && !sym->attr.allocatable))) TREE_STATIC (decl) = 1; if (sym->attr.volatile_) @@ -745,6 +754,18 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym) nest = (procns->proc_name->backend_decl != current_function_decl) && !sym->attr.contained; + if (sym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB + && GFC_TYPE_ARRAY_CAF_TOKEN (type) == NULL_TREE) + { + tree token; + + token = gfc_create_var_np (pvoid_type_node, "caf_token"); + GFC_TYPE_ARRAY_CAF_TOKEN (type) = token; + DECL_ARTIFICIAL (token) = 1; + TREE_STATIC (token) = 1; + gfc_add_decl_to_function (token); + } + for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type); dim++) { if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE) @@ -1403,7 +1424,8 @@ gfc_get_symbol_decl (gfc_symbol * sym) && !(sym->attr.use_assoc && !intrinsic_array_parameter) && (sym->attr.save || sym->ns->proc_name->attr.is_main_program || gfc_option.flag_max_stack_var_size == 0 - || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)) + || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE) + && (gfc_option.coarray != GFC_FCOARRAY_LIB || !sym->attr.codimension)) { /* Add static initializer. For procedures, it is only needed if SAVE is specified otherwise they need to be reinitialized @@ -3025,6 +3047,11 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_caf_finalize = gfc_build_library_function_decl ( get_identifier (PREFIX("caf_finalize")), void_type_node, 0); + gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6, + size_type_node, integer_type_node, ppvoid_type_node, pint_type, + build_pointer_type (pchar_type_node), integer_type_node); + gfor_fndecl_caf_critical = gfc_build_library_function_decl ( get_identifier (PREFIX("caf_critical")), void_type_node, 0); @@ -3458,7 +3485,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) gfc_trans_deferred_array (sym, block); } } - else + else if (gfc_option.coarray != GFC_FCOARRAY_LIB) { gfc_save_backend_locus (&loc); gfc_set_backend_locus (&sym->declared_at); @@ -3864,6 +3891,10 @@ gfc_create_module_variable (gfc_symbol * sym) rest_of_decl_compilation (length, 1, 0); } } + + if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable + && sym->attr.referenced && !sym->attr.use_assoc) + has_coarray_vars = true; } /* Emit debug information for USE statements. */ @@ -4066,6 +4097,9 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym) sym->attr.dimension, false)) return; + if (gfc_option.coarray == GFC_FCOARRAY_LIB && sym->attr.codimension) + return; + /* Create the decl for the variable or constant. */ decl = build_decl (input_location, sym->attr.flavor == FL_PARAMETER ? CONST_DECL : VAR_DECL, @@ -4087,6 +4121,120 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym) debug_hooks->global_decl (decl); } + +static void +generate_coarray_sym_init (gfc_symbol *sym) +{ + tree tmp, size, decl, token; + + if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension + || sym->attr.use_assoc || !sym->attr.referenced) + return; + + decl = sym->backend_decl; + TREE_USED(decl) = 1; + gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (decl))); + + /* FIXME: Workaround for PR middle-end/49106, cf. also PR middle-end/49108 + to make sure the variable is not optimized away. */ + DECL_PRESERVE_P (DECL_CONTEXT (decl)) = 1; + + size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (decl))); + + if (GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl))) + { + tmp = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (decl)); + size = fold_build2_loc (input_location, MULT_EXPR, size_type_node, + fold_convert (size_type_node, tmp), + fold_convert (size_type_node, size)); + } + + gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (decl)) != NULL_TREE); + token = gfc_build_addr_expr (ppvoid_type_node, + GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE(decl))); + + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size, + build_int_cst (integer_type_node, 0), /* type. */ + token, null_pointer_node, /* token, stat. */ + null_pointer_node, /* errgmsg, errmsg_len. */ + build_int_cst (integer_type_node, 0)); + + gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp)); + + + /* Handle "static" initializer. */ + if (sym->value) + { + sym->attr.pointer = 1; + tmp = gfc_trans_assignment (gfc_lval_expr_from_sym (sym), sym->value, + true, false); + sym->attr.pointer = 0; + gfc_add_expr_to_block (&caf_init_block, tmp); + } +} + + +/* Generate constructor function to initialize static, nonallocatable + coarrays. */ + +static void +generate_coarray_init (gfc_namespace * ns __attribute((unused))) +{ + tree fndecl, tmp, decl, save_fn_decl; + + save_fn_decl = current_function_decl; + push_function_context (); + + tmp = build_function_type_list (void_type_node, NULL_TREE); + fndecl = build_decl (input_location, FUNCTION_DECL, + create_tmp_var_name ("_caf_init"), tmp); + + DECL_STATIC_CONSTRUCTOR (fndecl) = 1; + SET_DECL_INIT_PRIORITY (fndecl, DEFAULT_INIT_PRIORITY); + + decl = build_decl (input_location, RESULT_DECL, NULL_TREE, void_type_node); + DECL_ARTIFICIAL (decl) = 1; + DECL_IGNORED_P (decl) = 1; + DECL_CONTEXT (decl) = fndecl; + DECL_RESULT (fndecl) = decl; + + pushdecl (fndecl); + current_function_decl = fndecl; + announce_function (fndecl); + + rest_of_decl_compilation (fndecl, 0, 0); + make_decl_rtl (fndecl); + init_function_start (fndecl); + + pushlevel (0); + gfc_init_block (&caf_init_block); + + gfc_traverse_ns (ns, generate_coarray_sym_init); + + DECL_SAVED_TREE (fndecl) = gfc_finish_block (&caf_init_block); + decl = getdecls (); + + poplevel (1, 0, 1); + BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl; + + DECL_SAVED_TREE (fndecl) + = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl), + DECL_INITIAL (fndecl)); + dump_function (TDI_original, fndecl); + + cfun->function_end_locus = input_location; + set_cfun (NULL); + + if (decl_function_context (fndecl)) + (void) cgraph_create_node (fndecl); + else + cgraph_finalize_function (fndecl, true); + + pop_function_context (); + current_function_decl = save_fn_decl; +} + + /* Generate all the required code for module variables. */ void @@ -4101,9 +4249,14 @@ gfc_generate_module_vars (gfc_namespace * ns) /* Generate COMMON blocks. */ gfc_trans_common (ns); + has_coarray_vars = false; + /* Create decls for all the module variables. */ gfc_traverse_ns (ns, gfc_create_module_variable); + if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars) + generate_coarray_init (ns); + cur_module = NULL; gfc_trans_use_stmts (ns); @@ -4200,6 +4353,10 @@ generate_local_decl (gfc_symbol * sym) { if (sym->attr.flavor == FL_VARIABLE) { + if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable + && sym->attr.referenced && !sym->attr.use_assoc) + has_coarray_vars = true; + if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master) generate_dependency_declarations (sym); @@ -4897,8 +5054,12 @@ gfc_generate_function_code (gfc_namespace * ns) nonlocal_dummy_decls = NULL; nonlocal_dummy_decl_pset = NULL; + has_coarray_vars = false; generate_local_vars (ns); + if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars) + generate_coarray_init (ns); + /* Keep the parent fake result declaration in module functions or external procedures. */ if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE) @@ -5062,9 +5223,13 @@ gfc_generate_function_code (gfc_namespace * ns) } current_function_decl = old_context; - if (decl_function_context (fndecl)) + if (decl_function_context (fndecl) && !gfc_option.coarray == GFC_FCOARRAY_LIB + && has_coarray_vars) /* Register this function with cgraph just far enough to get it - added to our parent's nested function list. */ + added to our parent's nested function list. + If there are static coarrays in this function, the nested _caf_init + function has already called cgraph_create_node, which also created + the cgraph node for this function. */ (void) cgraph_create_node (fndecl); else cgraph_finalize_function (fndecl, true); @@ -5190,8 +5355,13 @@ gfc_process_block_locals (gfc_namespace* ns) tree decl; gcc_assert (saved_local_decls == NULL_TREE); + has_coarray_vars = false; + generate_local_vars (ns); + if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars) + generate_coarray_init (ns); + decl = saved_local_decls; while (decl) { diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 1165926..9c4f5f6 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1542,13 +1542,13 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, if (as->rank == 0) { - if (packed != PACKED_STATIC) + if (packed != PACKED_STATIC || gfc_option.coarray == GFC_FCOARRAY_LIB) type = build_pointer_type (type); if (restricted) type = build_qualified_type (type, TYPE_QUAL_RESTRICT); - if (packed != PACKED_STATIC) + if (packed != PACKED_STATIC || gfc_option.coarray == GFC_FCOARRAY_LIB) { GFC_ARRAY_TYPE_P (type) = 1; TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type)); @@ -1596,7 +1596,8 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, DECL_ORIGINAL_TYPE (type_decl) = gtype; } - if (packed != PACKED_STATIC || !known_stride) + if (packed != PACKED_STATIC || !known_stride + || (as->corank && gfc_option.coarray == GFC_FCOARRAY_LIB)) { /* For dummy arrays and automatic (heap allocated) arrays we want a pointer to the array. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 2b06d80..95cd9fb 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -617,6 +617,7 @@ extern GTY(()) tree gfor_fndecl_associated; /* Coarray run-time library function decls. */ extern GTY(()) tree gfor_fndecl_caf_init; extern GTY(()) tree gfor_fndecl_caf_finalize; +extern GTY(()) tree gfor_fndecl_caf_register; extern GTY(()) tree gfor_fndecl_caf_critical; extern GTY(()) tree gfor_fndecl_caf_end_critical; extern GTY(()) tree gfor_fndecl_caf_sync_all; @@ -722,6 +723,7 @@ struct GTY((variable_size)) lang_type { tree span; tree base_decl[2]; tree nonrestricted_type; + tree caf_token; }; struct GTY((variable_size)) lang_decl { @@ -766,6 +768,7 @@ struct GTY((variable_size)) lang_decl { (TYPE_LANG_SPECIFIC(node)->stride[dim]) #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank) #define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank) +#define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token) #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size) #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset) #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind) --- /dev/null 2011-05-24 21:36:28.023892895 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray/registering_1.f90 2011-05-24 23:46:25.000000000 +0200 @@ -0,0 +1,41 @@ +! { dg-do run } +! +! PR fortran/18918 +! +! Check whether registering coarrays works +! +module m + integer :: a(1)[*] = 7 +end module m + +use m +if (any (a /= 7)) call abort() +a = 88 +if (any (a /= 88)) call abort() + + block + integer :: b[*] = 8494 + if (b /= 8494) call abort() + end block + +if (any (a /= 88)) call abort() +call test () +end + +subroutine test() + complex :: z = (1,1) + if (z /= (1,1)) call abort() + call sub1() +contains + subroutine sub1 + real :: r = -1 + if (r /= -1) call abort + r = 10 + if (r /= 10) call abort + end subroutine sub1 + + subroutine uncalled() + integer :: not_refed = 784 + if (not_refed /= 784) call abort() + end subroutine uncalled +end subroutine test