From 5092eb960c2df8071aa8d61114788265579ebeaa Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 27 Mar 2011 11:01:34 +0200 Subject: [PATCH] re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays]) 2011-03-27 Tobias Burnus PR fortran/18918 * caf/libcaf.h: New - coarray communication library. * caf/mpi.c: New. * caf/single.c: New. From-SVN: r171570 --- libgfortran/ChangeLog | 7 ++ libgfortran/caf/libcaf.h | 53 ++++++++++ libgfortran/caf/mpi.c | 211 +++++++++++++++++++++++++++++++++++++++ libgfortran/caf/single.c | 107 ++++++++++++++++++++ 4 files changed, 378 insertions(+) create mode 100644 libgfortran/caf/libcaf.h create mode 100644 libgfortran/caf/mpi.c create mode 100644 libgfortran/caf/single.c diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index b6dc507f3fd..4557c7cdce9 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2011-03-27 Tobias Burnus + + PR fortran/18918 + * caf/libcaf.h: New - coarray communication library. + * caf/mpi.c: New. + * caf/single.c: New. + 2011-03-23 Jerry DeLisle PR libgfortran/48030 diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h new file mode 100644 index 00000000000..8a66ef3deff --- /dev/null +++ b/libgfortran/caf/libcaf.h @@ -0,0 +1,53 @@ +/* Common declarations for all of GNU Fortran libcaf implementations. + Copyright (C) 2011 + Free Software Foundation, Inc. + Contributed by Tobias Burnus + +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 +. */ + +#ifndef LIBCAF_H +#define LIBCAF_H + +#include +#include + +/* 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 3 + + +void _gfortran_caf_init (int *, char ***, int *, int *); +void _gfortran_caf_finalize (void); + +int _gfortran_caf_sync_all (char *, int); +int _gfortran_caf_sync_images (int count, int images[], char *, int); + +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 00000000000..634e240bf19 --- /dev/null +++ b/libgfortran/caf/mpi.c @@ -0,0 +1,211 @@ +/* MPI implementation of GNU Fortran Coarray Library + Copyright (C) 2011 + Free Software Foundation, Inc. + Contributed by Tobias Burnus + +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 +. */ + +#include "libcaf.h" +#include +#include +#include + +/* 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_this_image; +static int caf_num_images; +static MPI_Win caf_world_window; + + +/* 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) +{ + int flag; + + /* The following is only the case if one does not have a Fortran + main program. */ + MPI_Initialized (&flag); + if (!flag) + MPI_Init (argc, argv); + + MPI_Comm_rank (MPI_COMM_WORLD, &caf_this_image); + *this_image = caf_this_image + 1; + MPI_Comm_size (MPI_COMM_WORLD, &caf_num_images); + *num_images = caf_num_images; + + /* Obtain window for CRITICAL section locking. */ + MPI_Win_create (NULL, 0, 1, MPI_INFO_NULL, MPI_COMM_WORLD, + &caf_world_window); +} + + +/* Finalize coarray program. Note: This is only called before the + program ends; thus the MPI_Initialized status of _gfortran_caf_init + does not play a role. */ + +void +_gfortran_caf_finalize (void) +{ + MPI_Win_free (&caf_world_window); + MPI_Finalize (); +} + + +/* SYNC ALL - the return value matches Fortran's STAT argument. */ + +int +_gfortran_caf_sync_all (char *errmsg, int errmsg_len) +{ + int ierr; + ierr = MPI_Barrier (MPI_COMM_WORLD); + + if (ierr && errmsg_len > 0) + { + const char msg[] = "SYNC ALL failed"; + 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); + } + + /* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */ + return ierr; +} + + +/* 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. The return value matches Fortran's + STAT argument. */ +int +_gfortran_caf_sync_images (int count, int images[], char *errmsg, + int errmsg_len) +{ + int ierr; + + if (count == 0 || (count == 1 && images[0] == caf_this_image)) + return 0; + +#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(*). */ + ierr = MPI_Barrier (MPI_COMM_WORLD); + + if (ierr && errmsg_len > 0) + { + const char msg[] = "SYNC IMAGES failed"; + 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); + } + + /* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */ + return ierr; +} + + +/* CRITICAL BLOCK. */ + +void +_gfortran_caf_critical (void) +{ + MPI_Win_lock (MPI_LOCK_SHARED, 0, 0, caf_world_window); +} + + +void +_gfortran_caf_end_critical (void) +{ + MPI_Win_unlock (0, caf_world_window); +} + + +/* 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 00000000000..7ee37b3a99d --- /dev/null +++ b/libgfortran/caf/single.c @@ -0,0 +1,107 @@ +/* Single-image implementation of GNU Fortran Coarray Library + Copyright (C) 2011 + Free Software Foundation, Inc. + Contributed by Tobias Burnus + +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 +. */ + +#include "libcaf.h" +#include /* For fputs and fprintf. */ +#include /* For exit. */ + +/* 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. */ + +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) +{ +} + +int +_gfortran_caf_sync_all (char *errmsg __attribute__ ((unused)), + int errmsg_len __attribute__ ((unused))) +{ + return 0; +} + +int +_gfortran_caf_sync_images (int count __attribute__ ((unused)), + int images[] __attribute__ ((unused)), + 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 (1); + } +#endif + + return 0; +} + +void +_gfortran_caf_critical (void) +{ +} + +void +_gfortran_caf_end_critical (void) +{ +} + +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); +} -- 2.30.2