diff options
Diffstat (limited to 'libgfortran/caf')
| -rw-r--r-- | libgfortran/caf/libcaf.h | 27 | ||||
| -rw-r--r-- | libgfortran/caf/single.c | 71 |
2 files changed, 92 insertions, 6 deletions
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h index 5c39202..2472646 100644 --- a/libgfortran/caf/libcaf.h +++ b/libgfortran/caf/libcaf.h @@ -41,14 +41,20 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #define likely(x) __builtin_expect(!!(x), 1) #define unlikely(x) __builtin_expect(!!(x), 0) #endif +#endif /* Definitions of the Fortran 2008 standard; need to kept in sync with - ISO_FORTRAN_ENV, cf. libgfortran.h. */ -#define STAT_UNLOCKED 0 -#define STAT_LOCKED 1 -#define STAT_LOCKED_OTHER_IMAGE 2 -#define STAT_STOPPED_IMAGE 6000 -#endif + ISO_FORTRAN_ENV, cf. gcc/fortran/libgfortran.h. */ +typedef enum +{ + CAF_STAT_UNLOCKED = 0, + CAF_STAT_LOCKED, + CAF_STAT_LOCKED_OTHER_IMAGE, + CAF_STAT_STOPPED_IMAGE = 6000, + CAF_STAT_FAILED_IMAGE = 6001 +} +caf_stat_codes_t; + /* Describes what type of array we are registerring. Keep in sync with gcc/fortran/trans.h. */ @@ -74,6 +80,7 @@ typedef enum caf_deregister_t { caf_deregister_t; typedef void* caf_token_t; +typedef void * caf_team_t; typedef gfc_array_void gfc_descriptor_t; /* Linked list of static coarrays registered. */ @@ -198,6 +205,7 @@ void _gfortran_caf_stop_str (const char *, int32_t) void _gfortran_caf_error_stop_str (const char *, int32_t) __attribute__ ((noreturn)); void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn)); +void _gfortran_caf_fail_image (void) __attribute__ ((noreturn)); void _gfortran_caf_co_broadcast (gfc_descriptor_t *, int, int *, char *, int); void _gfortran_caf_co_sum (gfc_descriptor_t *, int, int *, char *, int); @@ -243,6 +251,13 @@ void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, int); void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int); void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *); +void _gfortran_caf_failed_images (gfc_descriptor_t *, + caf_team_t * __attribute__ ((unused)), int *); +int _gfortran_caf_image_status (int, caf_team_t * __attribute__ ((unused))); +void _gfortran_caf_stopped_images (gfc_descriptor_t *, + caf_team_t * __attribute__ ((unused)), + int *); + int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *); #endif /* LIBCAF_H */ diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c index 8d3bcbf..bf1a229 100644 --- a/libgfortran/caf/single.c +++ b/libgfortran/caf/single.c @@ -264,6 +264,7 @@ _gfortran_caf_sync_images (int count __attribute__ ((unused)), *stat = 0; } + void _gfortran_caf_stop_numeric(int32_t stop_code) { @@ -271,6 +272,7 @@ _gfortran_caf_stop_numeric(int32_t stop_code) exit (0); } + void _gfortran_caf_stop_str(const char *string, int32_t len) { @@ -282,6 +284,7 @@ _gfortran_caf_stop_str(const char *string, int32_t len) exit (0); } + void _gfortran_caf_error_stop_str (const char *string, int32_t len) { @@ -294,6 +297,74 @@ _gfortran_caf_error_stop_str (const char *string, int32_t len) } +/* Reported that the program terminated because of a fail image issued. + Because this is a single image library, nothing else than aborting the whole + program can be done. */ + +void _gfortran_caf_fail_image (void) +{ + fputs ("IMAGE FAILED!\n", stderr); + exit (0); +} + + +/* Get the status of image IMAGE. Because being the single image library all + other images are reported to be stopped. */ + +int _gfortran_caf_image_status (int image, + caf_team_t * team __attribute__ ((unused))) +{ + if (image == 1) + return 0; + else + return CAF_STAT_STOPPED_IMAGE; +} + + +/* Single image library. There can not be any failed images with only one + image. */ + +void +_gfortran_caf_failed_images (gfc_descriptor_t *array, + caf_team_t * team __attribute__ ((unused)), + int * kind) +{ + int local_kind = kind != NULL ? *kind : 4; + + array->base_addr = NULL; + array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) + | (local_kind << GFC_DTYPE_SIZE_SHIFT)); + /* Setting lower_bound higher then upper_bound is what the compiler does to + indicate an empty array. */ + array->dim[0].lower_bound = 0; + array->dim[0]._ubound = -1; + array->dim[0]._stride = 1; + array->offset = 0; +} + + +/* With only one image available no other images can be stopped. Therefore + return an empty array. */ + +void +_gfortran_caf_stopped_images (gfc_descriptor_t *array, + caf_team_t * team __attribute__ ((unused)), + int * kind) +{ + int local_kind = kind != NULL ? *kind : 4; + + array->base_addr = NULL; + array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) + | (local_kind << GFC_DTYPE_SIZE_SHIFT)); + /* Setting lower_bound higher then upper_bound is what the compiler does to + indicate an empty array. */ + array->dim[0].lower_bound = 0; + array->dim[0]._ubound = -1; + array->dim[0]._stride = 1; + array->offset = 0; +} + + void _gfortran_caf_error_stop (int32_t error) { |