From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 127108 invoked by alias); 18 May 2016 20:11:13 -0000 Mailing-List: contact fortran-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Subscribe: List-Post: List-Help: , Sender: fortran-owner@gcc.gnu.org Received: (qmail 127091 invoked by uid 89); 18 May 2016 20:11:11 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-3.3 required=5.0 tests=AWL,BAYES_00,KAM_STOCKGEN,RCVD_IN_DNSWL_LOW,RP_MATCHES_RCVD,SPF_PASS autolearn=ham version=3.3.2 spammy=Help X-HELO: smtp26.services.sfr.fr Received: from smtp26.services.sfr.fr (HELO smtp26.services.sfr.fr) (93.17.128.10) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Wed, 18 May 2016 20:11:01 +0000 Received: from [192.168.1.10] (LFbn-1-5191-57.w90-105.abo.wanadoo.fr [90.105.161.57]) by msfrf2627.sfr.fr (SMTP Server) with ESMTP id E908A1C00082C; Wed, 18 May 2016 22:10:54 +0200 (CEST) Received: from [192.168.1.10] (LFbn-1-5191-57.w90-105.abo.wanadoo.fr [90.105.161.57]) (using TLSv1.2 with cipher ECDHE-RSA-AES128-GCM-SHA256 (128/128 bits)) (No client certificate requested) (Authenticated sender: mikael.morin@sfr.fr) by msfrf2627.sfr.fr (SMTP Server) with ESMTPSA; Wed, 18 May 2016 22:10:54 +0200 (CEST) Authentication-Results: sfr.fr; auth=pass (PLAIN) smtp.auth=mikael.morin@sfr.fr From: Mikael Morin Subject: Re: [Fortran] Help with intrinsic function returning array To: Alessandro Fanfarillo References: <573A283B.6060306@sfr.fr> <573B751C.8000209@sfr.fr> Cc: gfortran Message-ID: <573CCC33.3040708@sfr.fr> Date: Wed, 18 May 2016 20:11:00 -0000 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.7.0 MIME-Version: 1.0 In-Reply-To: X-sfr-mailing: LEGIT Content-Type: multipart/mixed; boundary=------------020705090002080807050201 X-IsSubscribed: yes X-SW-Source: 2016-05/txt/msg00052.txt.bz2 This is a multi-part message in MIME format. --------------020705090002080807050201 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Content-length: 982 Le 17/05/2016 22:20, Alessandro Fanfarillo a écrit : > 2016-05-17 13:46 GMT-06:00 Mikael Morin : > >> Well, what I was telling was aiming at producing something more like that: >> _gfortran_caf_failed_images(&failed); >> It's probably doable that way, but there might be some problems indeed with >> the scalarizer. Most existing intrinsics functions calling the library can >> have their result shape inferred before the call. > > I think it would be much more easy to use a subroutine rather than a > function. Is there an easy way to > transform the intrinsic function in a subroutine invocation? > Well, all the infrastructure is already there. You just need to tell that the function returns a non-scalar result. I attach an incremental patch, whose result I have only visually inspected. The code generated is not very neat, and does some strange things, but it has the essential parts. The setting of the bounds probably need more investigation. --------------020705090002080807050201 Content-Type: text/x-patch; name="incremental_failed_images.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="incremental_failed_images.diff" Content-length: 6137 diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index d338e5b..5851815 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -2582,6 +2582,7 @@ gfc_resolve_failed_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED, gfc_expr *kind ATTRIBUTE_UNUSED) { static char failed_images[] = "failed_images"; + f->rank = 1; f->ts.type = BT_INTEGER; f->ts.kind = gfc_default_integer_kind; f->value.function.name = failed_images; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 1bea9d6..bbb0abb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8733,7 +8733,7 @@ find_reachable_labels (gfc_code *block) } static void -resolve_fail_image (gfc_code *code) +resolve_fail_image (gfc_code *code ATTRIBUTE_UNUSED) { return; } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index c5ae4c5..2444da2 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6095,6 +6095,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (result && arg && expr->rank && expr->value.function.isym && expr->value.function.isym->transformational + && arg->expr && arg->expr->ts.type == BT_DERIVED && arg->expr->ts.u.derived->attr.alloc_comp) { diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index e37c938..b2f5596 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1648,99 +1648,10 @@ trans_this_image (gfc_se * se, gfc_expr *expr) } static void -gfc_conv_intrinsic_failed_images (gfc_se *se, gfc_expr *expr) -{ - tree tmp,type,res_var,size_var,desc,offset,ubound,stride; - stmtblock_t temp_post; - gfc_se argse, loopse; - gfc_loopinfo loop; - gfc_expr array_expr; - gfc_ss *tmp_ss; - tree parm, parmtype; - gfc_array_info *info; - - /* If mem is NULL, we call gfc_allocate_using_malloc or - gfc_allocate_using_lib. */ - - size_var = gfc_create_var (gfc_array_index_type, "arr"); - /* res_var = gfc_create_var (pvoid_type_node, "res"); */ - type = gfc_typenode_for_spec (&expr->ts); - - if (flag_coarray == GFC_FCOARRAY_LIB) - { - res_var = build_call_expr_loc (input_location, gfor_fndecl_caf_failed_images, 3, - gfc_build_addr_expr (build_pointer_type (type), size_var), - build_int_cst (integer_type_node, -1), - build_int_cst (integer_type_node, -1)); - - /* se->expr = res_var; */ - - loop.ss = gfc_get_array_ss (gfc_ss_terminator, NULL, 1, - GFC_SS_SECTION); - tmp_ss = gfc_walk_expr (expr); - - loop.ss->info->type = GFC_SS_SECTION; - - gfc_init_loopinfo (&loop); - gfc_add_ss_to_loop (&loop, tmp_ss); - loop.dimen = 1; - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, gfc_index_one_node, - gfc_index_one_node); - - loop.to[0] = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, - size_var, tmp); - loop.from[0] = gfc_index_one_node; - - /* parmtype = gfc_get_element_type (integer_type_node); */ - parmtype = type; - parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, 0, - loop.from, loop.to, 0, - GFC_ARRAY_UNKNOWN, false); - parm = gfc_create_var (parmtype, "parm"); - tmp = gfc_conv_descriptor_dtype (parm); - gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype)); - - gfc_conv_descriptor_data_set (&loop.pre, parm, res_var); - - tmp = gfc_conv_array_lbound (parm, 0); - - gfc_conv_descriptor_lbound_set (&loop.pre, parm, gfc_index_zero_node, tmp); - - ubound = gfc_conv_array_ubound (parm, 0); - - gfc_conv_descriptor_ubound_set (&loop.pre, parm, gfc_index_zero_node, size_var); - - stride = gfc_conv_array_stride (parm, 0); - - gfc_conv_descriptor_stride_set (&loop.pre, parm, gfc_index_zero_node, gfc_index_one_node); - - /* tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp), */ - /* gfc_index_zero_node, tmp); */ - /* tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp), */ - /* tmp, gfc_index_one_node); */ - /* offset = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp), */ - /* gfc_index_zero_node, tmp); */ - - offset = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp), - gfc_index_zero_node, tmp); - - gfc_conv_descriptor_offset_set (&loop.pre, parm, offset); - - se->expr = gfc_conv_descriptor_data_get (parm); - - gfc_add_block_to_block (&se->pre, &loop.pre); - gfc_add_block_to_block (&se->post, &loop.post); - } - /* tmp = gfc_finish_block (&alloc_block); */ -} - -static void gfc_conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr) { unsigned int num_args; - tree *args,tmp,rettype,res; + tree *args,tmp; num_args = gfc_intrinsic_argument_list_length (expr); args = XALLOCAVEC (tree, num_args); @@ -8406,10 +8317,6 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) trans_this_image (se, expr); break; - case GFC_ISYM_FAILED_IMAGES: - gfc_conv_intrinsic_failed_images (se, expr); - break; - case GFC_ISYM_IMAGE_INDEX: trans_image_index (se, expr); break; @@ -8768,10 +8675,11 @@ gfc_is_intrinsic_libcall (gfc_expr * expr) /* Ignore absent optional parameters. */ return 1; - case GFC_ISYM_RESHAPE: case GFC_ISYM_CSHIFT: case GFC_ISYM_EOSHIFT: + case GFC_ISYM_FAILED_IMAGES: case GFC_ISYM_PACK: + case GFC_ISYM_RESHAPE: case GFC_ISYM_UNPACK: /* Pass absent optional parameters. */ return 2; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 2544129..c4070e7 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -672,7 +672,7 @@ gfc_trans_stop (gfc_code *code, bool error_stop) to a runtime library call. */ tree -gfc_trans_fail_image (gfc_code *code) +gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED) { tree gfc_int4_type_node = gfc_get_int_type (4); gfc_se se; --------------020705090002080807050201--