| Message ID | CAHqFgjWKwEcojwXeuzmqU3Bg9vQLtJCmu8aNz-VcE1jB10-k6w@mail.gmail.com |
|---|---|
| State | New |
| Headers | show |
* PING * 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: > Dear all, > > please find in attachment the first patch (of n) for the FAILED IMAGES > capability defined in the coarray TS 18508. > The patch adds support for three new intrinsic functions defined in > the TS for simulating a failure (fail image), checking an image status > (image_status) and getting the list of failed images (failed_images). > The patch has been built and regtested on x86_64-pc-linux-gnu. > > Ok for trunk? > > Alessandro
* PING * 2016-06-21 10:59 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: > * PING * > > 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: >> Dear all, >> >> please find in attachment the first patch (of n) for the FAILED IMAGES >> capability defined in the coarray TS 18508. >> The patch adds support for three new intrinsic functions defined in >> the TS for simulating a failure (fail image), checking an image status >> (image_status) and getting the list of failed images (failed_images). >> The patch has been built and regtested on x86_64-pc-linux-gnu. >> >> Ok for trunk? >> >> Alessandro
Third *PING* 2016-07-04 16:46 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: > * PING * > > 2016-06-21 10:59 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: >> * PING * >> >> 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: >>> Dear all, >>> >>> please find in attachment the first patch (of n) for the FAILED IMAGES >>> capability defined in the coarray TS 18508. >>> The patch adds support for three new intrinsic functions defined in >>> the TS for simulating a failure (fail image), checking an image status >>> (image_status) and getting the list of failed images (failed_images). >>> The patch has been built and regtested on x86_64-pc-linux-gnu. >>> >>> Ok for trunk? >>> >>> Alessandro
Hello, this is mostly good in general, but is lacking tests. Especially, tests for successfull matching, and tests for every error you are adding in the patch (except maybe the -fcoarray= one). Also tests that the code executes successfullly with -fcoarray=single, and that it produces the right function calls with -fcoarray=lib. more specific comments below. Mikael Le 15/07/2016 à 19:34, Alessandro Fanfarillo a écrit : > Third *PING* > > 2016-07-04 16:46 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: >> * PING * >> >> 2016-06-21 10:59 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: >>> * PING * >>> >>> 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: >>>> Dear all, >>>> >>>> please find in attachment the first patch (of n) for the FAILED IMAGES >>>> capability defined in the coarray TS 18508. >>>> The patch adds support for three new intrinsic functions defined in >>>> the TS for simulating a failure (fail image), checking an image status >>>> (image_status) and getting the list of failed images (failed_images). >>>> The patch has been built and regtested on x86_64-pc-linux-gnu. >>>> >>>> Ok for trunk? >>>> >>>> Alessandro > > first_complete_patch.diff > > commit b3bca5b09f4cbcf18f2409dae2485a16a7c06498 > Author: Alessandro Fanfarillo <fanfarillo@ing.uniroma2.it> > Date: Mon Jun 6 14:27:37 2016 -0600 > > First patch Failed Images CAF TS-18508 > > diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c > index f3a4a43..9f519ff 100644 > --- a/gcc/fortran/match.c > +++ b/gcc/fortran/match.c > @@ -1594,6 +1594,7 @@ gfc_match_if (gfc_statement *if_type) > match ("event post", gfc_match_event_post, ST_EVENT_POST) > match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT) > match ("exit", gfc_match_exit, ST_EXIT) > + match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE) > match ("flush", gfc_match_flush, ST_FLUSH) > match ("forall", match_simple_forall, ST_FORALL) > match ("go to", gfc_match_goto, ST_GOTO) > @@ -3073,6 +3074,41 @@ gfc_match_event_wait (void) > return event_statement (ST_EVENT_WAIT); > } > > +/* Match a FAIl IMAGE statement */ > + > +static match > +fail_image_statement (gfc_statement st) > +{ > + if (flag_coarray == GFC_FCOARRAY_NONE) > + { > + gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable"); > + return MATCH_ERROR; > + } > + > + if (gfc_match_char ('(') == MATCH_YES) > + goto syntax; > + > + if(st == ST_FAIL_IMAGE) > + new_st.op = EXEC_FAIL_IMAGE; > + else > + gcc_unreachable(); You can use gcc_assert (st == ST_FAIL_IMAGE); foo...; instead of if (st == ST_FAIL_IMAGE) foo...; else gcc_unreachable (); > + > + return MATCH_YES; > + > + syntax: > + gfc_syntax_error (st); > + > + return MATCH_ERROR; > +} > + > +match > +gfc_match_fail_image (void) > +{ > + /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C")) */ > + /* return MATCH_ERROR; */ > + Can this be uncommented? > + return fail_image_statement (ST_FAIL_IMAGE); > +} > > /* Match LOCK/UNLOCK statement. Syntax: > LOCK ( lock-variable [ , lock-stat-list ] ) > diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c > index 1aaf4e2..b2f5596 100644 > --- a/gcc/fortran/trans-intrinsic.c > +++ b/gcc/fortran/trans-intrinsic.c > @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr *expr) > m, lbound)); > } > > +static void > +gfc_conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr) > +{ > + unsigned int num_args; > + tree *args,tmp; > + > + num_args = gfc_intrinsic_argument_list_length (expr); > + args = XALLOCAVEC (tree, num_args); > + > + gfc_conv_intrinsic_function_args (se, expr, args, num_args); > + > + if (flag_coarray == GFC_FCOARRAY_LIB) > + { Can everything be put under the if? Does it work with -fcoarray=single? > + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2, > + args[0], build_int_cst (integer_type_node, -1)); > + se->expr = tmp; > + } > +} > > static void > diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c > index 7d3cf8c..ce0eae7 100644 > --- a/gcc/fortran/trans-stmt.c > +++ b/gcc/fortran/trans-stmt.c > @@ -674,6 +674,31 @@ gfc_trans_stop (gfc_code *code, bool error_stop) > return gfc_finish_block (&se.pre); > } > > +/* Translate the FAIL IMAGE statement. We have to translate this statement > + to a runtime library call. */ > + > +tree > +gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED) > +{ > + tree gfc_int4_type_node = gfc_get_int_type (4); > + gfc_se se; > + tree tmp; > + > + /* Start a new block for this statement. */ > + gfc_init_se (&se, NULL); > + gfc_start_block (&se.pre); > + > + tmp = build_int_cst (gfc_int4_type_node, 0); This tmp doesn't seem to be used. > + tmp = build_call_expr_loc (input_location, > + gfor_fndecl_caf_fail_image, 1, > + build_int_cst (pchar_type_node, 0)); > + > + gfc_add_expr_to_block (&se.pre, tmp); > + > + gfc_add_block_to_block (&se.pre, &se.post); > + > + return gfc_finish_block (&se.pre); > +} > > tree > gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
Hi Mikael, > > + if(st == ST_FAIL_IMAGE) > > + new_st.op = EXEC_FAIL_IMAGE; > > + else > > + gcc_unreachable(); > You can use > gcc_assert (st == ST_FAIL_IMAGE); > foo...; > instead of > if (st == ST_FAIL_IMAGE) > foo...; > else > gcc_unreachable (); Be careful, this is not 100% identical in the general case. For older gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to an abort(), so the behavior can change. But in this case everything is fine, because the patch is most likely not backported. > > + > > + return MATCH_YES; > > + > > + syntax: > > + gfc_syntax_error (st); > > + > > + return MATCH_ERROR; > > +} > > + > > +match > > +gfc_match_fail_image (void) > > +{ > > + /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement > > at %C")) */ > > + /* return MATCH_ERROR; */ > > + > Can this be uncommented? > > > + return fail_image_statement (ST_FAIL_IMAGE); > > +} > > > > /* Match LOCK/UNLOCK statement. Syntax: > > LOCK ( lock-variable [ , lock-stat-list ] ) > > diff --git a/gcc/fortran/trans-intrinsic.c > > b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644 > > --- a/gcc/fortran/trans-intrinsic.c > > +++ b/gcc/fortran/trans-intrinsic.c > > @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr > > *expr) m, lbound)); > > } > > > > +static void > > +gfc_conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr) > > +{ > > + unsigned int num_args; > > + tree *args,tmp; > > + > > + num_args = gfc_intrinsic_argument_list_length (expr); > > + args = XALLOCAVEC (tree, num_args); > > + > > + gfc_conv_intrinsic_function_args (se, expr, args, num_args); > > + > > + if (flag_coarray == GFC_FCOARRAY_LIB) > > + { > Can everything be put under the if? > Does it work with -fcoarray=single? IMO coarray=single should not generate code here, therefore putting everything under the if should to fine. Sorry for the comments ... - Andre
Le 20/07/2016 à 11:39, Andre Vehreschild a écrit : > Hi Mikael, > > >>> + if(st == ST_FAIL_IMAGE) >>> + new_st.op = EXEC_FAIL_IMAGE; >>> + else >>> + gcc_unreachable(); >> You can use >> gcc_assert (st == ST_FAIL_IMAGE); >> foo...; >> instead of >> if (st == ST_FAIL_IMAGE) >> foo...; >> else >> gcc_unreachable (); > > Be careful, this is not 100% identical in the general case. For older > gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to > an abort(), so the behavior can change. But in this case everything is > fine, because the patch is most likely not backported. > Didn't know about this. The difference seems to be very subtle. I don't mind much anyway. The original version can stay if preferred, this was just a suggestion. By the way, if the function is inlined in its single caller, the assert or unreachable statement can be removed, which avoids choosing between them. That's another suggestion. >>> + >>> + return MATCH_YES; >>> + >>> + syntax: >>> + gfc_syntax_error (st); >>> + >>> + return MATCH_ERROR; >>> +} >>> + >>> +match >>> +gfc_match_fail_image (void) >>> +{ >>> + /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement >>> at %C")) */ >>> + /* return MATCH_ERROR; */ >>> + >> Can this be uncommented? >> >>> + return fail_image_statement (ST_FAIL_IMAGE); >>> +} >>> >>> /* Match LOCK/UNLOCK statement. Syntax: >>> LOCK ( lock-variable [ , lock-stat-list ] ) >>> diff --git a/gcc/fortran/trans-intrinsic.c >>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644 >>> --- a/gcc/fortran/trans-intrinsic.c >>> +++ b/gcc/fortran/trans-intrinsic.c >>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr >>> *expr) m, lbound)); >>> } >>> >>> +static void >>> +gfc_conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr) >>> +{ >>> + unsigned int num_args; >>> + tree *args,tmp; >>> + >>> + num_args = gfc_intrinsic_argument_list_length (expr); >>> + args = XALLOCAVEC (tree, num_args); >>> + >>> + gfc_conv_intrinsic_function_args (se, expr, args, num_args); >>> + >>> + if (flag_coarray == GFC_FCOARRAY_LIB) >>> + { >> Can everything be put under the if? >> Does it work with -fcoarray=single? > > IMO coarray=single should not generate code here, therefore putting > everything under the if should to fine. > My point was more avoiding generating code for the arguments if they are not used in the end. Regarding the -fcoarray=single case, the function returns a result, which can be used in an expression, so I don't think it will work without at least hardcoding a fixed value as result in that case. But even that wouldn't be enough, as the function wouldn't work consistently with the fail image statement. > Sorry for the comments ... > Comments are welcome here, as far as I know. ;-) Mikael
Hi, The failed images features of gfortran are exciting, and folks here would like to start testing with their scientific codes. I’d like to build a new gfortran to support them, but I must build from a trusted source, which means from trunk, without custom patches. Can Alessandro’s patch get a review? Many thanks! > On Jun 21, 2016, at 10:59, Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote: > > * PING * > > 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>: >> Dear all, >> >> please find in attachment the first patch (of n) for the FAILED IMAGES >> capability defined in the coarray TS 18508. >> The patch adds support for three new intrinsic functions defined in >> the TS for simulating a failure (fail image), checking an image status >> (image_status) and getting the list of failed images (failed_images). >> The patch has been built and regtested on x86_64-pc-linux-gnu. >> >> Ok for trunk? >> >> Alessandro -- Cheers! Dan Nagle
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index d26e45e..71931cb 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1210,6 +1210,62 @@ gfc_check_event_query (gfc_expr *event, gfc_expr *count, gfc_expr *stat) return true; } +bool +gfc_check_image_status (gfc_expr *image, gfc_expr *team) +{ + if (!type_check (image, 1, BT_INTEGER)) + return false; + + if(team) + { + gfc_error ("TEAM argument of the IMAGE_STATUS intrinsic function at %L " + "not yet supported", + &team->where); + return false; + } + + int i = gfc_validate_kind (BT_INTEGER, image->ts.kind, false); + int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false); + + if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range) + { + gfc_error ("IMAGE argument of the IMAGE_STATUS intrinsic function at %L " + "shall have at least the range of the default integer", + &image->where); + return false; + } + + return true; +} + +bool +gfc_check_failed_images (gfc_expr *team, gfc_expr *kind) +{ + if (team) + { + gfc_error ("TEAM argument of the FAILED_IMAGES intrinsic function at %L " + "not yet supported", + &team->where); + return false; + } + + if (kind) + { + int i = gfc_validate_kind (BT_INTEGER, kind->ts.kind, false); + int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false); + + if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range) + { + gfc_error ("KIND argument of the FAILED_IMAGES intrinsic function at %L " + "shall have at least the range of the default integer", + &kind->where); + return false; + } + } + + return true; +} + bool gfc_check_atomic_fetch_op (gfc_expr *atom, gfc_expr *value, gfc_expr *old, diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index f507434..41ed664 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1628,6 +1628,9 @@ show_code_node (int level, gfc_code *c) break; + case EXEC_FAIL_IMAGE: + fputs ("FAIL IMAGE ", dumpfile); + case EXEC_SYNC_ALL: fputs ("SYNC ALL ", dumpfile); if (c->expr2 != NULL) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0bb71cb..6d87632 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -253,7 +253,7 @@ enum gfc_statement ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, - ST_EVENT_WAIT,ST_NONE + ST_EVENT_WAIT,ST_FAIL_IMAGE,ST_NONE }; /* Types of interfaces that we can have. Assignment interfaces are @@ -411,6 +411,7 @@ enum gfc_isym_id GFC_ISYM_EXP, GFC_ISYM_EXPONENT, GFC_ISYM_EXTENDS_TYPE_OF, + GFC_ISYM_FAILED_IMAGES, GFC_ISYM_FDATE, GFC_ISYM_FE_RUNTIME_ERROR, GFC_ISYM_FGET, @@ -454,6 +455,7 @@ enum gfc_isym_id GFC_ISYM_IEOR, GFC_ISYM_IERRNO, GFC_ISYM_IMAGE_INDEX, + GFC_ISYM_IMAGE_STATUS, GFC_ISYM_INDEX, GFC_ISYM_INT, GFC_ISYM_INT2, @@ -2382,7 +2384,7 @@ enum gfc_exec_op EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT, EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END, EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH, - EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, + EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, EXEC_FAIL_IMAGE, EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE, EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 1d7503d..8dfb568 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1823,6 +1823,10 @@ add_functions (void) a, BT_UNKNOWN, 0, REQUIRED, mo, BT_UNKNOWN, 0, REQUIRED); + add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, + dd, GFC_STD_F2008_TS, gfc_check_failed_images, NULL, + gfc_resolve_failed_images, "team", BT_INTEGER, di, OPTIONAL, "kind", BT_INTEGER, di, OPTIONAL); + add_sym_0 ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate); @@ -2023,7 +2027,11 @@ add_functions (void) add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008, gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index, ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED); - + + add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, + di, GFC_STD_F2008_TS, gfc_check_image_status, NULL, + gfc_resolve_image_status, "image", BT_INTEGER, di, REQUIRED, "team", BT_INTEGER, di, OPTIONAL); + /* The resolution function for INDEX is called gfc_resolve_index_func because the name gfc_resolve_index is already used in resolve.c. */ add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES, @@ -3170,7 +3178,7 @@ add_subroutines (void) "event", BT_INTEGER, di, REQUIRED, INTENT_IN, c, BT_INTEGER, di, OPTIONAL, INTENT_IN, stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT); - + /* More G77 compatibility garbage. */ add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index f228976..bb49b7d 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -71,6 +71,7 @@ bool gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_dtime_etime (gfc_expr *); bool gfc_check_event_query (gfc_expr *, gfc_expr *, gfc_expr *); +bool gfc_check_failed_images (gfc_expr *, gfc_expr *); bool gfc_check_fgetputc (gfc_expr *, gfc_expr *); bool gfc_check_fgetput (gfc_expr *); bool gfc_check_float (gfc_expr *); @@ -92,6 +93,7 @@ bool gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_ichar_iachar (gfc_expr *, gfc_expr *); bool gfc_check_idnint (gfc_expr *); bool gfc_check_ieor (gfc_expr *, gfc_expr *); +bool gfc_check_image_status (gfc_expr *, gfc_expr *); bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_int (gfc_expr *, gfc_expr *); bool gfc_check_intconv (gfc_expr *); @@ -467,6 +469,7 @@ void gfc_resolve_event_query (gfc_code *); void gfc_resolve_exp (gfc_expr *, gfc_expr *); void gfc_resolve_exponent (gfc_expr *, gfc_expr *); void gfc_resolve_extends_type_of (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_failed_images (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_fdate (gfc_expr *); void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_fnum (gfc_expr *, gfc_expr *); @@ -490,6 +493,7 @@ void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_image_index (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_image_status (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ierrno (gfc_expr *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index ecea1c3..ce59c66 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -2577,6 +2577,26 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x) = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); } +void +gfc_resolve_failed_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED, + gfc_expr *kind ATTRIBUTE_UNUSED) +{ + static char failed_images[] = "_gfortran_caf_failed_images"; + f->rank = 1; + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->value.function.name = failed_images; +} + +void +gfc_resolve_image_status (gfc_expr *f, gfc_expr *image, gfc_expr *team ATTRIBUTE_UNUSED) +{ + static char image_status[] = "image_status"; + f->ts.type = BT_INTEGER; + f->ts.kind = gfc_default_integer_kind; + f->ts = image->ts; + f->value.function.name = image_status; +} void gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED, diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index e913250..f00ed83 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -123,7 +123,7 @@ typedef enum GFC_STAT_LOCKED, GFC_STAT_LOCKED_OTHER_IMAGE, GFC_STAT_STOPPED_IMAGE = 6000, /* See LIBERROR_INQUIRE_INTERNAL_UNIT above. */ - GFC_STAT_FAILED_IMAGE + GFC_STAT_FAILED_IMAGE = 6001 } libgfortran_stat_codes; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f3a4a43..9f519ff 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -1594,6 +1594,7 @@ gfc_match_if (gfc_statement *if_type) match ("event post", gfc_match_event_post, ST_EVENT_POST) match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT) match ("exit", gfc_match_exit, ST_EXIT) + match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE) match ("flush", gfc_match_flush, ST_FLUSH) match ("forall", match_simple_forall, ST_FORALL) match ("go to", gfc_match_goto, ST_GOTO) @@ -3073,6 +3074,41 @@ gfc_match_event_wait (void) return event_statement (ST_EVENT_WAIT); } +/* Match a FAIl IMAGE statement */ + +static match +fail_image_statement (gfc_statement st) +{ + if (flag_coarray == GFC_FCOARRAY_NONE) + { + gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable"); + return MATCH_ERROR; + } + + if (gfc_match_char ('(') == MATCH_YES) + goto syntax; + + if(st == ST_FAIL_IMAGE) + new_st.op = EXEC_FAIL_IMAGE; + else + gcc_unreachable(); + + return MATCH_YES; + + syntax: + gfc_syntax_error (st); + + return MATCH_ERROR; +} + +match +gfc_match_fail_image (void) +{ + /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C")) */ + /* return MATCH_ERROR; */ + + return fail_image_statement (ST_FAIL_IMAGE); +} /* Match LOCK/UNLOCK statement. Syntax: LOCK ( lock-variable [ , lock-stat-list ] ) diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 348ca70..4e4b833 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -72,6 +72,7 @@ match gfc_match_else (void); match gfc_match_elseif (void); match gfc_match_event_post (void); match gfc_match_event_wait (void); +match gfc_match_fail_image (void); match gfc_match_critical (void); match gfc_match_block (void); match gfc_match_associate (void); diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 1081b2e..3659d8a 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -483,6 +483,7 @@ decode_statement (void) break; case 'f': + match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE); match ("final", gfc_match_final_decl, ST_FINAL); match ("flush", gfc_match_flush, ST_FLUSH); match ("format", gfc_match_format, ST_FORMAT); @@ -1354,7 +1355,7 @@ next_statement (void) case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \ case ST_OMP_TARGET_UPDATE: case ST_ERROR_STOP: case ST_SYNC_ALL: \ case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ - case ST_EVENT_POST: case ST_EVENT_WAIT: \ + case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \ case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA @@ -1680,6 +1681,9 @@ gfc_ascii_statement (gfc_statement st) case ST_EVENT_WAIT: p = "EVENT WAIT"; break; + case ST_FAIL_IMAGE: + p = "FAIL IMAGE"; + break; case ST_END_ASSOCIATE: p = "END ASSOCIATE"; break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 77f8c10..f56bdf1 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -8749,6 +8749,11 @@ find_reachable_labels (gfc_code *block) } } +static void +resolve_fail_image (gfc_code *code ATTRIBUTE_UNUSED) +{ + return; +} static void resolve_lock_unlock_event (gfc_code *code) @@ -10479,6 +10484,10 @@ start: resolve_lock_unlock_event (code); break; + case EXEC_FAIL_IMAGE: + resolve_fail_image (code); + break; + case EXEC_ENTRY: /* Keep track of which entry we are up to. */ current_entry_id = code->ext.entry->id; diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 7395497..b3a6721 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -120,6 +120,7 @@ gfc_free_statement (gfc_code *p) case EXEC_UNLOCK: case EXEC_EVENT_POST: case EXEC_EVENT_WAIT: + case EXEC_FAIL_IMAGE: break; case EXEC_BLOCK: diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 2f5e434..7c52744 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -151,6 +151,9 @@ tree gfor_fndecl_caf_unlock; tree gfor_fndecl_caf_event_post; tree gfor_fndecl_caf_event_wait; tree gfor_fndecl_caf_event_query; +tree gfor_fndecl_caf_fail_image; +tree gfor_fndecl_caf_failed_images; +tree gfor_fndecl_caf_image_status; tree gfor_fndecl_co_broadcast; tree gfor_fndecl_co_max; tree gfor_fndecl_co_min; @@ -3628,6 +3631,18 @@ gfc_build_builtin_function_decls (void) void_type_node, 5, pvoid_type_node, size_type_node, integer_type_node, pint_type, pint_type); + gfor_fndecl_caf_fail_image = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_fail_image")), "R", + void_type_node, 1, pvoid_type_node); + + gfor_fndecl_caf_failed_images = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_failed_images")), "WRR", + pvoid_type_node, 3, pvoid_type_node, integer_type_node, integer_type_node); + + gfor_fndecl_caf_image_status = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX("caf_image_status")), "RR", + integer_type_node, 2, integer_type_node, integer_type_node); + gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("caf_co_broadcast")), "W.WW", void_type_node, 5, pvoid_type_node, integer_type_node, diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 8f84712..70f9577 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6132,10 +6132,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, components must have the result allocatable components copied. */ arg = expr->value.function.actual; if (result && arg && expr->rank - && expr->value.function.isym - && expr->value.function.isym->transformational - && arg->expr->ts.type == BT_DERIVED - && arg->expr->ts.u.derived->attr.alloc_comp) + && 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) { tree tmp2; /* Copy the allocatable components. We have to use a diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr *expr) m, lbound)); } +static void +gfc_conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr) +{ + unsigned int num_args; + tree *args,tmp; + + num_args = gfc_intrinsic_argument_list_length (expr); + args = XALLOCAVEC (tree, num_args); + + gfc_conv_intrinsic_function_args (se, expr, args, num_args); + + if (flag_coarray == GFC_FCOARRAY_LIB) + { + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2, + args[0], build_int_cst (integer_type_node, -1)); + se->expr = tmp; + } +} static void trans_image_index (gfc_se * se, gfc_expr *expr) @@ -8303,6 +8321,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) trans_image_index (se, expr); break; + case GFC_ISYM_IMAGE_STATUS: + gfc_conv_intrinsic_image_status (se, expr); + break; + case GFC_ISYM_NUM_IMAGES: trans_num_images (se, expr); break; @@ -8653,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 7d3cf8c..ce0eae7 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -674,6 +674,31 @@ gfc_trans_stop (gfc_code *code, bool error_stop) return gfc_finish_block (&se.pre); } +/* Translate the FAIL IMAGE statement. We have to translate this statement + to a runtime library call. */ + +tree +gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED) +{ + tree gfc_int4_type_node = gfc_get_int_type (4); + gfc_se se; + tree tmp; + + /* Start a new block for this statement. */ + gfc_init_se (&se, NULL); + gfc_start_block (&se.pre); + + tmp = build_int_cst (gfc_int4_type_node, 0); + tmp = build_call_expr_loc (input_location, + gfor_fndecl_caf_fail_image, 1, + build_int_cst (pchar_type_node, 0)); + + gfc_add_expr_to_block (&se.pre, tmp); + + gfc_add_block_to_block (&se.pre, &se.post); + + return gfc_finish_block (&se.pre); +} tree gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op) diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index f9c8e74..4b5b4fc 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -56,6 +56,7 @@ tree gfc_trans_select (gfc_code *); tree gfc_trans_sync (gfc_code *, gfc_exec_op); tree gfc_trans_lock_unlock (gfc_code *, gfc_exec_op); tree gfc_trans_event_post_wait (gfc_code *, gfc_exec_op); +tree gfc_trans_fail_image (gfc_code *); tree gfc_trans_forall (gfc_code *); tree gfc_trans_where (gfc_code *); tree gfc_trans_allocate (gfc_code *); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index c6688d3..db0aa49 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1828,6 +1828,10 @@ trans_code (gfc_code * code, tree cond) res = gfc_trans_event_post_wait (code, code->op); break; + case EXEC_FAIL_IMAGE: + res = gfc_trans_fail_image (code); + break; + case EXEC_FORALL: res = gfc_trans_forall (code); break; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 512615a..c6b142f 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -776,6 +776,9 @@ extern GTY(()) tree gfor_fndecl_caf_unlock; extern GTY(()) tree gfor_fndecl_caf_event_post; extern GTY(()) tree gfor_fndecl_caf_event_wait; extern GTY(()) tree gfor_fndecl_caf_event_query; +extern GTY(()) tree gfor_fndecl_caf_fail_image; +extern GTY(()) tree gfor_fndecl_caf_failed_images; +extern GTY(()) tree gfor_fndecl_caf_image_status; extern GTY(()) tree gfor_fndecl_co_broadcast; extern GTY(()) tree gfor_fndecl_co_max; extern GTY(()) tree gfor_fndecl_co_min;
Dear all, please find in attachment the first patch (of n) for the FAILED IMAGES capability defined in the coarray TS 18508. The patch adds support for three new intrinsic functions defined in the TS for simulating a failure (fail image), checking an image status (image_status) and getting the list of failed images (failed_images). The patch has been built and regtested on x86_64-pc-linux-gnu. Ok for trunk? Alessandro commit b3bca5b09f4cbcf18f2409dae2485a16a7c06498 Author: Alessandro Fanfarillo <fanfarillo@ing.uniroma2.it> Date: Mon Jun 6 14:27:37 2016 -0600 First patch Failed Images CAF TS-18508