OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [libgfortran/] [caf/] [single.c] - Blame information for rev 867

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 733 jeremybenn
/* Single-image implementation of GNU Fortran Coarray Library
2
   Copyright (C) 2011, 2012
3
   Free Software Foundation, Inc.
4
   Contributed by Tobias Burnus <burnus@net-b.de>
5
 
6
This file is part of the GNU Fortran Coarray Runtime Library (libcaf).
7
 
8
Libcaf is free software; you can redistribute it and/or modify
9
it under the terms of the GNU General Public License as published by
10
the Free Software Foundation; either version 3, or (at your option)
11
any later version.
12
 
13
Libcaf is distributed in the hope that it will be useful,
14
but WITHOUT ANY WARRANTY; without even the implied warranty of
15
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16
GNU General Public License for more details.
17
 
18
Under Section 7 of GPL version 3, you are granted additional
19
permissions described in the GCC Runtime Library Exception, version
20
3.1, as published by the Free Software Foundation.
21
 
22
You should have received a copy of the GNU General Public License and
23
a copy of the GCC Runtime Library Exception along with this program;
24
see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
25
<http://www.gnu.org/licenses/>.  */
26
 
27
#include "libcaf.h"
28
#include <stdio.h>  /* For fputs and fprintf.  */
29
#include <stdlib.h> /* For exit and malloc.  */
30
#include <string.h> /* For memcpy and memset.  */
31
#include <stdarg.h> /* For variadic arguments.  */
32
 
33
/* Define GFC_CAF_CHECK to enable run-time checking.  */
34
/* #define GFC_CAF_CHECK  1  */
35
 
36
/* Single-image implementation of the CAF library.
37
   Note: For performance reasons -fcoarry=single should be used
38
   rather than this library.  */
39
 
40
/* Global variables.  */
41
caf_static_t *caf_static_list = NULL;
42
 
43
 
44
/* Keep in sync with mpi.c.  */
45
static void
46
caf_runtime_error (const char *message, ...)
47
{
48
  va_list ap;
49
  fprintf (stderr, "Fortran runtime error: ");
50
  va_start (ap, message);
51
  vfprintf (stderr, message, ap);
52
  va_end (ap);
53
  fprintf (stderr, "\n");
54
 
55
  /* FIXME: Shutdown the Fortran RTL to flush the buffer.  PR 43849.  */
56
  exit (EXIT_FAILURE);
57
}
58
 
59
void
60
_gfortran_caf_init (int *argc __attribute__ ((unused)),
61
                    char ***argv __attribute__ ((unused)),
62
                    int *this_image, int *num_images)
63
{
64
  *this_image = 1;
65
  *num_images = 1;
66
}
67
 
68
 
69
void
70
_gfortran_caf_finalize (void)
71
{
72
  while (caf_static_list != NULL)
73
    {
74
      caf_static_t *tmp = caf_static_list->prev;
75
      free (caf_static_list->token[0]);
76
      free (caf_static_list->token);
77
      free (caf_static_list);
78
      caf_static_list = tmp;
79
    }
80
}
81
 
82
 
83
void *
84
_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
85
                        int *stat, char *errmsg, int errmsg_len)
86
{
87
  void *local;
88
 
89
  local = malloc (size);
90
  *token = malloc (sizeof (void*) * 1);
91
  (*token)[0] = local;
92
 
93
  if (unlikely (local == NULL || token == NULL))
94
    {
95
      const char msg[] = "Failed to allocate coarray";
96
      if (stat)
97
        {
98
          *stat = 1;
99
          if (errmsg_len > 0)
100
            {
101
              int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
102
                                                          : (int) sizeof (msg);
103
              memcpy (errmsg, msg, len);
104
              if (errmsg_len > len)
105
                memset (&errmsg[len], ' ', errmsg_len-len);
106
            }
107
          return NULL;
108
        }
109
      else
110
          caf_runtime_error (msg);
111
    }
112
 
113
  if (stat)
114
    *stat = 0;
115
 
116
  if (type == CAF_REGTYPE_COARRAY_STATIC)
117
    {
118
      caf_static_t *tmp = malloc (sizeof (caf_static_t));
119
      tmp->prev  = caf_static_list;
120
      tmp->token = *token;
121
      caf_static_list = tmp;
122
    }
123
  return local;
124
}
125
 
126
 
127
void
128
_gfortran_caf_deregister (void ***token, int *stat,
129
                          char *errmsg __attribute__ ((unused)),
130
                          int errmsg_len __attribute__ ((unused)))
131
{
132
  free ((*token)[0]);
133
  free (*token);
134
 
135
  if (stat)
136
    *stat = 0;
137
}
138
 
139
 
140
void
141
_gfortran_caf_sync_all (int *stat,
142
                        char *errmsg __attribute__ ((unused)),
143
                        int errmsg_len __attribute__ ((unused)))
144
{
145
  if (stat)
146
    *stat = 0;
147
}
148
 
149
 
150
void
151
_gfortran_caf_sync_images (int count __attribute__ ((unused)),
152
                           int images[] __attribute__ ((unused)),
153
                           int *stat,
154
                           char *errmsg __attribute__ ((unused)),
155
                           int errmsg_len __attribute__ ((unused)))
156
{
157
#ifdef GFC_CAF_CHECK
158
  int i;
159
 
160
  for (i = 0; i < count; i++)
161
    if (images[i] != 1)
162
      {
163
        fprintf (stderr, "COARRAY ERROR: Invalid image index %d to SYNC "
164
                 "IMAGES", images[i]);
165
        exit (EXIT_FAILURE);
166
      }
167
#endif
168
 
169
  if (stat)
170
    *stat = 0;
171
}
172
 
173
 
174
void
175
_gfortran_caf_error_stop_str (const char *string, int32_t len)
176
{
177
  fputs ("ERROR STOP ", stderr);
178
  while (len--)
179
    fputc (*(string++), stderr);
180
  fputs ("\n", stderr);
181
 
182
  exit (1);
183
}
184
 
185
 
186
void
187
_gfortran_caf_error_stop (int32_t error)
188
{
189
  fprintf (stderr, "ERROR STOP %d\n", error);
190
  exit (error);
191
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.