URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [caf/] [single.c] - Rev 734
Go to most recent revision | Compare with Previous | Blame | View Log
/* 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); }
Go to most recent revision | Compare with Previous | Blame | View Log