diff options
author | Lorry Tar Creator <lorry-tar-importer@baserock.org> | 2013-04-11 09:13:11 +0000 |
---|---|---|
committer | <> | 2014-04-23 12:05:38 +0000 |
commit | 6af3fdec2262dd94954acc5e426ef71cbd4521d3 (patch) | |
tree | 9be02de9a80f7935892a2d03741adee44723e65d /libgfortran/caf | |
parent | 19be2b4342ac32e9edc78ce6fed8f61b63ae98d1 (diff) | |
download | gcc-tarball-6af3fdec2262dd94954acc5e426ef71cbd4521d3.tar.gz |
Imported from /home/lorry/working-area/delta_gcc-tarball/gcc-4.7.3.tar.bz2.gcc-4.7.3
Diffstat (limited to 'libgfortran/caf')
-rw-r--r-- | libgfortran/caf/libcaf.h | 88 | ||||
-rw-r--r-- | libgfortran/caf/mpi.c | 367 | ||||
-rw-r--r-- | libgfortran/caf/single.c | 191 |
3 files changed, 646 insertions, 0 deletions
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h new file mode 100644 index 0000000000..caffe17c27 --- /dev/null +++ b/libgfortran/caf/libcaf.h @@ -0,0 +1,88 @@ +/* Common declarations for all of GNU Fortran libcaf implementations. + Copyright (C) 2011, 2012 + Free Software Foundation, Inc. + Contributed by Tobias Burnus <burnus@net-b.de> + +This file is part of the GNU Fortran Coarray Runtime Library (libcaf). + +Libcaf is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libcaf is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#ifndef LIBCAF_H +#define LIBCAF_H + +#include <stdint.h> /* For int32_t. */ +#include <stddef.h> /* For ptrdiff_t. */ + +#ifndef __GNUC__ +#define __attribute__(x) +#define likely(x) (x) +#define unlikely(x) (x) +#else +#define likely(x) __builtin_expect(!!(x), 1) +#define unlikely(x) __builtin_expect(!!(x), 0) +#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 + +/* Describes what type of array we are registerring. Keep in sync with + gcc/fortran/trans.h. */ +typedef enum caf_register_t { + CAF_REGTYPE_COARRAY_STATIC, + CAF_REGTYPE_COARRAY_ALLOC, + CAF_REGTYPE_LOCK, + CAF_REGTYPE_LOCK_COMP +} +caf_register_t; + +/* Linked list of static coarrays registered. */ +typedef struct caf_static_t { + void **token; + struct caf_static_t *prev; +} +caf_static_t; + + +void _gfortran_caf_init (int *, char ***, int *, int *); +void _gfortran_caf_finalize (void); + +void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void ***, int *, + char *, int); +void _gfortran_caf_deregister (void ***, int *, char *, int); + + +void _gfortran_caf_sync_all (int *, char *, int); +void _gfortran_caf_sync_images (int, int[], int *, char *, int); + +/* FIXME: The CRITICAL functions should be removed; + the functionality is better represented using Coarray's lock feature. */ +void _gfortran_caf_critical (void) { } +void _gfortran_caf_end_critical (void) { } + + +void _gfortran_caf_error_stop_str (const char *, int32_t) + __attribute__ ((noreturn)); +void _gfortran_caf_error_stop (int32_t) __attribute__ ((noreturn)); + +#endif /* LIBCAF_H */ diff --git a/libgfortran/caf/mpi.c b/libgfortran/caf/mpi.c new file mode 100644 index 0000000000..8c9f07b5b2 --- /dev/null +++ b/libgfortran/caf/mpi.c @@ -0,0 +1,367 @@ +/* MPI implementation of GNU Fortran Coarray Library + Copyright (C) 2011, 2012 + Free Software Foundation, Inc. + Contributed by Tobias Burnus <burnus@net-b.de> + +This file is part of the GNU Fortran Coarray Runtime Library (libcaf). + +Libcaf is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libcaf is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#include "libcaf.h" +#include <stdio.h> +#include <stdlib.h> +#include <string.h> /* For memcpy. */ +#include <stdarg.h> /* For variadic arguments. */ +#include <mpi.h> + + +/* Define GFC_CAF_CHECK to enable run-time checking. */ +/* #define GFC_CAF_CHECK 1 */ + + +static void error_stop (int error) __attribute__ ((noreturn)); + +/* Global variables. */ +static int caf_mpi_initialized; +static int caf_this_image; +static int caf_num_images; +static int caf_is_finalized; + +caf_static_t *caf_static_list = NULL; + + +/* Keep in sync with single.c. */ +static void +caf_runtime_error (const char *message, ...) +{ + va_list ap; + fprintf (stderr, "Fortran runtime error on image %d: ", caf_this_image); + va_start (ap, message); + vfprintf (stderr, message, ap); + va_end (ap); + fprintf (stderr, "\n"); + + /* FIXME: Shutdown the Fortran RTL to flush the buffer. PR 43849. */ + /* FIXME: Do some more effort than just MPI_ABORT. */ + MPI_Abort (MPI_COMM_WORLD, EXIT_FAILURE); + + /* Should be unreachable, but to make sure also call exit. */ + exit (EXIT_FAILURE); +} + + +/* Initialize coarray program. This routine assumes that no other + MPI initialization happened before; otherwise MPI_Initialized + had to be used. As the MPI library might modify the command-line + arguments, the routine should be called before the run-time + libaray is initialized. */ + +void +_gfortran_caf_init (int *argc, char ***argv, int *this_image, int *num_images) +{ + if (caf_num_images == 0) + { + /* caf_mpi_initialized is only true if the main program is + not written in Fortran. */ + MPI_Initialized (&caf_mpi_initialized); + if (!caf_mpi_initialized) + MPI_Init (argc, argv); + + MPI_Comm_size (MPI_COMM_WORLD, &caf_num_images); + MPI_Comm_rank (MPI_COMM_WORLD, &caf_this_image); + caf_this_image++; + } + + if (this_image) + *this_image = caf_this_image; + if (num_images) + *num_images = caf_num_images; +} + + +/* Finalize coarray program. */ + +void +_gfortran_caf_finalize (void) +{ + while (caf_static_list != NULL) + { + caf_static_t *tmp = caf_static_list->prev; + + free (caf_static_list->token[caf_this_image-1]); + free (caf_static_list->token); + free (caf_static_list); + caf_static_list = tmp; + } + + if (!caf_mpi_initialized) + MPI_Finalize (); + + caf_is_finalized = 1; +} + + +void * +_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token, + int *stat, char *errmsg, int errmsg_len) +{ + void *local; + int err; + + if (unlikely (caf_is_finalized)) + goto error; + + /* Start MPI if not already started. */ + if (caf_num_images == 0) + _gfortran_caf_init (NULL, NULL, NULL, NULL); + + /* Token contains only a list of pointers. */ + local = malloc (size); + *token = malloc (sizeof (void*) * caf_num_images); + + if (unlikely (local == NULL || *token == NULL)) + goto error; + + /* token[img-1] is the address of the token in image "img". */ + err = MPI_Allgather (&local, sizeof (void*), MPI_BYTE, *token, + sizeof (void*), MPI_BYTE, MPI_COMM_WORLD); + + if (unlikely (err)) + { + free (local); + free (*token); + goto error; + } + + if (type == CAF_REGTYPE_COARRAY_STATIC) + { + caf_static_t *tmp = malloc (sizeof (caf_static_t)); + tmp->prev = caf_static_list; + tmp->token = *token; + caf_static_list = tmp; + } + + if (stat) + *stat = 0; + + return local; + +error: + { + char *msg; + + if (caf_is_finalized) + msg = "Failed to allocate coarray - there are stopped images"; + else + msg = "Failed to allocate coarray"; + + if (stat) + { + *stat = caf_is_finalized ? STAT_STOPPED_IMAGE : 1; + if (errmsg_len > 0) + { + int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len + : (int) strlen (msg); + memcpy (errmsg, msg, len); + if (errmsg_len > len) + memset (&errmsg[len], ' ', errmsg_len-len); + } + } + else + caf_runtime_error (msg); + } + + return NULL; +} + + +void +_gfortran_caf_deregister (void ***token, int *stat, char *errmsg, int errmsg_len) +{ + if (unlikely (caf_is_finalized)) + { + const char msg[] = "Failed to deallocate coarray - " + "there are stopped images"; + if (stat) + { + *stat = STAT_STOPPED_IMAGE; + + if (errmsg_len > 0) + { + int len = ((int) sizeof (msg) - 1 > errmsg_len) + ? errmsg_len : (int) sizeof (msg) - 1; + memcpy (errmsg, msg, len); + if (errmsg_len > len) + memset (&errmsg[len], ' ', errmsg_len-len); + } + return; + } + caf_runtime_error (msg); + } + + _gfortran_caf_sync_all (NULL, NULL, 0); + + if (stat) + *stat = 0; + + free ((*token)[caf_this_image-1]); + free (*token); +} + + +void +_gfortran_caf_sync_all (int *stat, char *errmsg, int errmsg_len) +{ + int ierr; + + if (unlikely (caf_is_finalized)) + ierr = STAT_STOPPED_IMAGE; + else + ierr = MPI_Barrier (MPI_COMM_WORLD); + + if (stat) + *stat = ierr; + + if (ierr) + { + char *msg; + if (caf_is_finalized) + msg = "SYNC ALL failed - there are stopped images"; + else + msg = "SYNC ALL failed"; + + if (errmsg_len > 0) + { + int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len + : (int) strlen (msg); + memcpy (errmsg, msg, len); + if (errmsg_len > len) + memset (&errmsg[len], ' ', errmsg_len-len); + } + else + caf_runtime_error (msg); + } +} + + +/* SYNC IMAGES. Note: SYNC IMAGES(*) is passed as count == -1 while + SYNC IMAGES([]) has count == 0. Note further that SYNC IMAGES(*) + is not equivalent to SYNC ALL. */ +void +_gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg, + int errmsg_len) +{ + int ierr; + if (count == 0 || (count == 1 && images[0] == caf_this_image)) + { + if (stat) + *stat = 0; + return; + } + +#ifdef GFC_CAF_CHECK + { + int i; + + for (i = 0; i < count; i++) + if (images[i] < 1 || images[i] > caf_num_images) + { + fprintf (stderr, "COARRAY ERROR: Invalid image index %d to SYNC " + "IMAGES", images[i]); + error_stop (1); + } + } +#endif + + /* FIXME: SYNC IMAGES with a nontrivial argument cannot easily be + mapped to MPI communicators. Thus, exist early with an error message. */ + if (count > 0) + { + fprintf (stderr, "COARRAY ERROR: SYNC IMAGES not yet implemented"); + error_stop (1); + } + + /* Handle SYNC IMAGES(*). */ + if (unlikely (caf_is_finalized)) + ierr = STAT_STOPPED_IMAGE; + else + ierr = MPI_Barrier (MPI_COMM_WORLD); + + if (stat) + *stat = ierr; + + if (ierr) + { + char *msg; + if (caf_is_finalized) + msg = "SYNC IMAGES failed - there are stopped images"; + else + msg = "SYNC IMAGES failed"; + + if (errmsg_len > 0) + { + int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len + : (int) strlen (msg); + memcpy (errmsg, msg, len); + if (errmsg_len > len) + memset (&errmsg[len], ' ', errmsg_len-len); + } + else + caf_runtime_error (msg); + } +} + + +/* ERROR STOP the other images. */ + +static void +error_stop (int error) +{ + /* FIXME: Shutdown the Fortran RTL to flush the buffer. PR 43849. */ + /* FIXME: Do some more effort than just MPI_ABORT. */ + MPI_Abort (MPI_COMM_WORLD, error); + + /* Should be unreachable, but to make sure also call exit. */ + exit (error); +} + + +/* ERROR STOP function for string arguments. */ + +void +_gfortran_caf_error_stop_str (const char *string, int32_t len) +{ + fputs ("ERROR STOP ", stderr); + while (len--) + fputc (*(string++), stderr); + fputs ("\n", stderr); + + error_stop (1); +} + + +/* ERROR STOP function for numerical arguments. */ + +void +_gfortran_caf_error_stop (int32_t error) +{ + fprintf (stderr, "ERROR STOP %d\n", error); + error_stop (error); +} diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c new file mode 100644 index 0000000000..4242fada3f --- /dev/null +++ b/libgfortran/caf/single.c @@ -0,0 +1,191 @@ +/* Single-image implementation of GNU Fortran Coarray Library + Copyright (C) 2011, 2012 + Free Software Foundation, Inc. + Contributed by Tobias Burnus <burnus@net-b.de> + +This file is part of the GNU Fortran Coarray Runtime Library (libcaf). + +Libcaf is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libcaf is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#include "libcaf.h" +#include <stdio.h> /* For fputs and fprintf. */ +#include <stdlib.h> /* For exit and malloc. */ +#include <string.h> /* For memcpy and memset. */ +#include <stdarg.h> /* For variadic arguments. */ + +/* Define GFC_CAF_CHECK to enable run-time checking. */ +/* #define GFC_CAF_CHECK 1 */ + +/* Single-image implementation of the CAF library. + Note: For performance reasons -fcoarry=single should be used + rather than this library. */ + +/* Global variables. */ +caf_static_t *caf_static_list = NULL; + + +/* Keep in sync with mpi.c. */ +static void +caf_runtime_error (const char *message, ...) +{ + va_list ap; + fprintf (stderr, "Fortran runtime error: "); + va_start (ap, message); + vfprintf (stderr, message, ap); + va_end (ap); + fprintf (stderr, "\n"); + + /* FIXME: Shutdown the Fortran RTL to flush the buffer. PR 43849. */ + exit (EXIT_FAILURE); +} + +void +_gfortran_caf_init (int *argc __attribute__ ((unused)), + char ***argv __attribute__ ((unused)), + int *this_image, int *num_images) +{ + *this_image = 1; + *num_images = 1; +} + + +void +_gfortran_caf_finalize (void) +{ + while (caf_static_list != NULL) + { + caf_static_t *tmp = caf_static_list->prev; + free (caf_static_list->token[0]); + free (caf_static_list->token); + free (caf_static_list); + caf_static_list = tmp; + } +} + + +void * +_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token, + int *stat, char *errmsg, int errmsg_len) +{ + void *local; + + local = malloc (size); + *token = malloc (sizeof (void*) * 1); + (*token)[0] = local; + + if (unlikely (local == NULL || token == NULL)) + { + const char msg[] = "Failed to allocate coarray"; + if (stat) + { + *stat = 1; + if (errmsg_len > 0) + { + int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len + : (int) sizeof (msg); + memcpy (errmsg, msg, len); + if (errmsg_len > len) + memset (&errmsg[len], ' ', errmsg_len-len); + } + return NULL; + } + else + caf_runtime_error (msg); + } + + if (stat) + *stat = 0; + + if (type == CAF_REGTYPE_COARRAY_STATIC) + { + caf_static_t *tmp = malloc (sizeof (caf_static_t)); + tmp->prev = caf_static_list; + tmp->token = *token; + caf_static_list = tmp; + } + return local; +} + + +void +_gfortran_caf_deregister (void ***token, int *stat, + char *errmsg __attribute__ ((unused)), + int errmsg_len __attribute__ ((unused))) +{ + free ((*token)[0]); + free (*token); + + if (stat) + *stat = 0; +} + + +void +_gfortran_caf_sync_all (int *stat, + char *errmsg __attribute__ ((unused)), + int errmsg_len __attribute__ ((unused))) +{ + if (stat) + *stat = 0; +} + + +void +_gfortran_caf_sync_images (int count __attribute__ ((unused)), + int images[] __attribute__ ((unused)), + int *stat, + char *errmsg __attribute__ ((unused)), + int errmsg_len __attribute__ ((unused))) +{ +#ifdef GFC_CAF_CHECK + int i; + + for (i = 0; i < count; i++) + if (images[i] != 1) + { + fprintf (stderr, "COARRAY ERROR: Invalid image index %d to SYNC " + "IMAGES", images[i]); + exit (EXIT_FAILURE); + } +#endif + + if (stat) + *stat = 0; +} + + +void +_gfortran_caf_error_stop_str (const char *string, int32_t len) +{ + fputs ("ERROR STOP ", stderr); + while (len--) + fputc (*(string++), stderr); + fputs ("\n", stderr); + + exit (1); +} + + +void +_gfortran_caf_error_stop (int32_t error) +{ + fprintf (stderr, "ERROR STOP %d\n", error); + exit (error); +} |