From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 119288 invoked by alias); 13 Jun 2016 18:31:32 -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 119265 invoked by uid 89); 13 Jun 2016 18:31:30 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-3.8 required=5.0 tests=AWL,BAYES_00,RCVD_IN_DNSWL_LOW,RP_MATCHES_RCVD,SPF_PASS autolearn=ham version=3.3.2 spammy=ses, Space, H*F:D*sfr.fr, Images 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; Mon, 13 Jun 2016 18:31:28 +0000 Received: from [192.168.1.10] (LFbn-1-5191-57.w90-105.abo.wanadoo.fr [90.105.161.57]) by msfrf2619.sfr.fr (SMTP Server) with ESMTP id 937C81C000C05; Mon, 13 Jun 2016 20:31:22 +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 msfrf2619.sfr.fr (SMTP Server) with ESMTPSA; Mon, 13 Jun 2016 20:31:21 +0200 (CEST) Authentication-Results: sfr.fr; auth=pass (PLAIN) smtp.auth=mikael.morin@sfr.fr Subject: Re: [Fortran] Help with STAT= attribute in coarray reference To: Alessandro Fanfarillo , gfortran References: From: Mikael Morin Message-ID: <575EFBE5.50101@sfr.fr> Date: Mon, 13 Jun 2016 18:31: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: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit X-IsSubscribed: yes X-SW-Source: 2016-06/txt/msg00035.txt.bz2 Le 13/06/2016 19:16, Alessandro Fanfarillo a écrit : > Dear all, > > in attachment there is a working patch for adding the STAT= attribute > to coarray get and put needed by Failed Images (TS 18508). > > E.g.: > > integer,dimension(10) :: a[*] > integer :: stat > > a(:) = a(:)[num_images(),stat=stat] > > > In order to pass the variable assigned during the coarray reference I > had to modify the gfc_array_ref structure by adding a gfc_expr* field. > By doing so, I'm able to store the stat variable in the descriptor and > pass it to the OpenCoarrays routines at the right moment. > > Is there a better way of doing it? > Array ref and coarray ref should have been separated when we introduced coarrays, as they are really different things. Appart from that, I think your way is the natural way of doing it. Comments below about the patch. It's mostly good. > diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c > index 1430e80..232bae7 100644 > --- a/gcc/fortran/array.c > +++ b/gcc/fortran/array.c > @@ -156,6 +156,7 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init, > { > match m; > bool matched_bracket = false; > + gfc_expr *tmp; > > memset (ar, '\0', sizeof (*ar)); > > @@ -226,6 +227,11 @@ coarray: > if (m == MATCH_ERROR) > return MATCH_ERROR; > > + if(gfc_match(",stat=%e",&tmp) == MATCH_YES) Add spaces between the tokens to match for optional whitespace. (tests welcome for this) An error is missing for multiple stat= (tests welcome as well) > + ar->stat = tmp; > + else > + ar->stat = NULL; > + > if (gfc_match_char (']') == MATCH_YES) > { > ar->codimen++; > @@ -237,6 +243,11 @@ coarray: > } > if (ar->codimen > corank) > { > + if(ar->stat) > + { > + ar->codimen--; > + return MATCH_YES; > + } I don't understand this change. If there are some extra codimension refs and a stat argument, you should still emit a "Too many codimensions" error. (Tests welcome for this) > gfc_error ("Too many codimensions at %C, expected %d not %d", > corank, ar->codimen); > return MATCH_ERROR; > diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c > index d1258cd..34a3557 100644 > --- a/gcc/fortran/expr.c > +++ b/gcc/fortran/expr.c > @@ -4428,6 +4428,16 @@ gfc_ref_this_image (gfc_ref *ref) > return true; > } > > +gfc_expr * > +gfc_find_stat_co(gfc_expr *e) > +{ > + gfc_ref *ref; > + > + for (ref = e->ref; ref; ref = ref->next) > + if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0) > + return ref->u.ar.stat; > + return NULL; > +} > > bool > gfc_is_coindexed (gfc_expr *e) > diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h > index 6d87632..2f22c32 100644 > --- a/gcc/fortran/gfortran.h > +++ b/gcc/fortran/gfortran.h > @@ -1816,6 +1816,7 @@ typedef struct gfc_array_ref > int dimen; /* # of components in the reference */ > int codimen; > bool in_allocate; /* For coarray checks. */ > + gfc_expr *stat; > locus where; > gfc_array_spec *as; > > @@ -3067,7 +3068,7 @@ bool gfc_is_coarray (gfc_expr *); > int gfc_get_corank (gfc_expr *); > bool gfc_has_ultimate_allocatable (gfc_expr *); > bool gfc_has_ultimate_pointer (gfc_expr *); > - > +gfc_expr* gfc_find_stat_co (gfc_expr *); > gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*, > locus, unsigned, ...); > bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*); > diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c > index f56bdf1..54be70e 100644 > --- a/gcc/fortran/resolve.c > +++ b/gcc/fortran/resolve.c > @@ -4169,7 +4169,7 @@ compare_spec_to_ref (gfc_array_ref *ar) > } > > /* ar->codimen == 0 is a local array. */ > - if (as->corank != ar->codimen && ar->codimen != 0) > + if (as->corank != ar->codimen && ar->codimen != 0 && !ar->stat) I think stat is irrelevant here. > { > gfc_error ("Coindex rank mismatch in array reference at %L (%d/%d)", > &ar->where, ar->codimen, as->corank); > diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c > index 04339a6..1ee548a 100644 > --- a/gcc/fortran/trans-decl.c > +++ b/gcc/fortran/trans-decl.c > @@ -3529,16 +3529,16 @@ gfc_build_builtin_function_decls (void) > ppvoid_type_node, pint_type, pchar_type_node, integer_type_node); > > gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec ( > - get_identifier (PREFIX("caf_get")), ".R.RRRW", void_type_node, 9, > + get_identifier (PREFIX("caf_get")), ".R.RRRW", void_type_node, 10, The spec string ".R.RRRW" should be updated as well. > pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node, > pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node, > - boolean_type_node); > + integer_type_node, boolean_type_node); > > gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec ( > - get_identifier (PREFIX("caf_send")), ".R.RRRR", void_type_node, 9, > + get_identifier (PREFIX("caf_send")), ".R.RRRR", void_type_node, 10, Same here > pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node, > pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node, > - boolean_type_node); > + pint_type, boolean_type_node); > > gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec ( > get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRR", void_type_node, > diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c > index e5cc907..7d8123b 100644 > --- a/gcc/fortran/trans-intrinsic.c > +++ b/gcc/fortran/trans-intrinsic.c > @@ -1100,10 +1100,10 @@ static void > gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, > tree may_require_tmp) > { > - gfc_expr *array_expr; > + gfc_expr *array_expr, *tmp_stat; > gfc_se argse; > tree caf_decl, token, offset, image_index, tmp; > - tree res_var, dst_var, type, kind, vec; > + tree res_var, dst_var, type, kind, vec, stat; > > gcc_assert (flag_coarray == GFC_FCOARRAY_LIB); > > @@ -1122,6 +1122,16 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, > dst_var = lhs; > > vec = null_pointer_node; > + tmp_stat = gfc_find_stat_co(expr); > + > + if(tmp_stat) Space after if > + { Call gfc_init_se. > + gfc_conv_expr_val (se, tmp_stat); It's better to have one dedicated se per expression, like you did for send. > + stat = se->expr; > + stat = gfc_build_addr_expr (NULL, stat); You can use gfc_conv_expr_reference directly. > + } > + else > + stat = null_pointer_node; > > gfc_init_se (&argse, NULL); > if (array_expr->rank == 0) > @@ -1219,9 +1229,9 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, > ASM_VOLATILE_P (tmp) = 1; > gfc_add_expr_to_block (&se->pre, tmp); > > - tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9, > + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10, > token, offset, image_index, argse.expr, vec, > - dst_var, kind, lhs_kind, may_require_tmp); > + dst_var, kind, lhs_kind, stat, may_require_tmp); > gfc_add_expr_to_block (&se->pre, tmp); > > if (se->ss) > @@ -1237,11 +1247,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind, > > static tree > conv_caf_send (gfc_code *code) { > - gfc_expr *lhs_expr, *rhs_expr; > + gfc_expr *lhs_expr, *rhs_expr, *tmp_stat; > gfc_se lhs_se, rhs_se; > stmtblock_t block; > tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind; > - tree may_require_tmp; > + tree may_require_tmp, stat; > tree lhs_type = NULL_TREE; > tree vec = null_pointer_node, rhs_vec = null_pointer_node; > > @@ -1253,6 +1263,8 @@ conv_caf_send (gfc_code *code) { > ? boolean_false_node : boolean_true_node; > gfc_init_block (&block); > > + stat = null_pointer_node; > + > /* LHS. */ > gfc_init_se (&lhs_se, NULL); > if (lhs_expr->rank == 0) > @@ -1375,10 +1387,24 @@ conv_caf_send (gfc_code *code) { > > rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind); > > + tmp_stat = gfc_find_stat_co(lhs_expr); > + > + if(tmp_stat) space after if > + { > + gfc_se stat_se; > + gfc_init_se (&stat_se, NULL); > + gfc_conv_expr_val (&stat_se, tmp_stat); > + stat = stat_se.expr; > + stat = gfc_build_addr_expr (NULL, stat); gfc_conv_expr_reference For complex cases (say, pointer-returning functions), you'll need to add stat_se's pre block to se's pre block. (Tests welcome for this) > + } > + else > + stat = null_pointer_node; > + > if (!gfc_is_coindexed (rhs_expr)) > - tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9, token, > - offset, image_index, lhs_se.expr, vec, > - rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp); > + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10, token, > + offset, image_index, lhs_se.expr, vec, > + rhs_se.expr, lhs_kind, rhs_kind, stat, > + may_require_tmp); > else > { > tree rhs_token, rhs_offset, rhs_image_index; More tests welcome ;-)