From patchwork Sun May 22 15:39:06 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 96756 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 41D22B6FB7 for ; Mon, 23 May 2011 01:39:33 +1000 (EST) Received: (qmail 11446 invoked by alias); 22 May 2011 15:39:30 -0000 Received: (qmail 11091 invoked by uid 22791); 22 May 2011 15:39:26 -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 mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 22 May 2011 15:39:11 +0000 Received: from [192.168.178.22] (port-92-204-35-67.dynamic.qsc.de [92.204.35.67]) by mx02.qsc.de (Postfix) with ESMTP id 20AC71E122; Sun, 22 May 2011 17:39:08 +0200 (CEST) Message-ID: <4DD92E1A.5010908@net-b.de> Date: Sun, 22 May 2011 17:39:06 +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: [Patch, Fortran] -fcoarray=lib - add registering calls for nonallocatable coarrays 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 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-22 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. * 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. 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..5121a39 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); @@ -4066,6 +4093,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, @@ -4200,6 +4230,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) + has_coarray_vars = true; + if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master) generate_dependency_declarations (sym); @@ -4826,6 +4860,116 @@ gfc_generate_return (void) } +static void +generate_coarray_sym_init (gfc_symbol *sym) +{ + tree tmp, size, decl, token; + + if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension) + return; + + if (!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); + (void) cgraph_create_node (fndecl); + pop_function_context (); + current_function_decl = save_fn_decl; +} + + /* Generate code for a function. */ void @@ -4897,8 +5041,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 +5210,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); 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)