aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/libgfortran/caf/single.c
diff options
context:
space:
mode:
authorBen Cheng <bccheng@google.com>2014-03-25 22:37:19 -0700
committerBen Cheng <bccheng@google.com>2014-03-25 22:37:19 -0700
commit1bc5aee63eb72b341f506ad058502cd0361f0d10 (patch)
treec607e8252f3405424ff15bc2d00aa38dadbb2518 /gcc-4.9/libgfortran/caf/single.c
parent283a0bf58fcf333c58a2a92c3ebbc41fb9eb1fdb (diff)
downloadtoolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.gz
toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.tar.bz2
toolchain_gcc-1bc5aee63eb72b341f506ad058502cd0361f0d10.zip
Initial checkin of GCC 4.9.0 from trunk (r208799).
Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba
Diffstat (limited to 'gcc-4.9/libgfortran/caf/single.c')
-rw-r--r--gcc-4.9/libgfortran/caf/single.c190
1 files changed, 190 insertions, 0 deletions
diff --git a/gcc-4.9/libgfortran/caf/single.c b/gcc-4.9/libgfortran/caf/single.c
new file mode 100644
index 000000000..551b9aa78
--- /dev/null
+++ b/gcc-4.9/libgfortran/caf/single.c
@@ -0,0 +1,190 @@
+/* Single-image implementation of GNU Fortran Coarray Library
+ Copyright (C) 2011-2014 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);
+}