]>
Commit | Line | Data |
---|---|---|
5092eb96 TB |
1 | /* Single-image implementation of GNU Fortran Coarray Library |
2 | Copyright (C) 2011 | |
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. */ | |
cc9ae24c | 29 | #include <stdlib.h> /* For exit and malloc. */ |
5092eb96 TB |
30 | |
31 | /* Define GFC_CAF_CHECK to enable run-time checking. */ | |
32 | /* #define GFC_CAF_CHECK 1 */ | |
33 | ||
5092eb96 TB |
34 | /* Single-image implementation of the CAF library. |
35 | Note: For performance reasons -fcoarry=single should be used | |
36 | rather than this library. */ | |
37 | ||
0a1138af DC |
38 | /* Global variables. */ |
39 | caf_static_t *caf_static_list = NULL; | |
40 | ||
cc9ae24c | 41 | |
5092eb96 TB |
42 | void |
43 | _gfortran_caf_init (int *argc __attribute__ ((unused)), | |
44 | char ***argv __attribute__ ((unused)), | |
45 | int *this_image, int *num_images) | |
46 | { | |
47 | *this_image = 1; | |
48 | *num_images = 1; | |
49 | } | |
50 | ||
cc9ae24c | 51 | |
5092eb96 TB |
52 | void |
53 | _gfortran_caf_finalize (void) | |
54 | { | |
0a1138af DC |
55 | while (caf_static_list != NULL) |
56 | { | |
57 | free(caf_static_list->token[0]); | |
58 | caf_static_list = caf_static_list->prev; | |
59 | } | |
5092eb96 TB |
60 | } |
61 | ||
cc9ae24c TB |
62 | |
63 | void * | |
0a1138af | 64 | _gfortran_caf_register (ptrdiff_t size, caf_register_t type, |
cc9ae24c TB |
65 | void **token) |
66 | { | |
0a1138af DC |
67 | void *local; |
68 | ||
69 | local = malloc (size); | |
70 | token = malloc (sizeof (void*) * 1); | |
71 | token[0] = local; | |
72 | ||
73 | if (type == CAF_REGTYPE_COARRAY_STATIC) | |
74 | { | |
75 | caf_static_t *tmp = malloc (sizeof (caf_static_t)); | |
76 | tmp->prev = caf_static_list; | |
77 | tmp->token = token; | |
78 | caf_static_list = tmp; | |
79 | } | |
80 | return local; | |
cc9ae24c TB |
81 | } |
82 | ||
83 | ||
84 | int | |
85 | _gfortran_caf_deregister (void **token __attribute__ ((unused))) | |
86 | { | |
87 | return 0; | |
88 | } | |
89 | ||
90 | ||
f5c01f5b DC |
91 | void |
92 | _gfortran_caf_sync_all (int *stat, | |
93 | char *errmsg __attribute__ ((unused)), | |
5092eb96 TB |
94 | int errmsg_len __attribute__ ((unused))) |
95 | { | |
f5c01f5b DC |
96 | if (stat) |
97 | *stat = 0; | |
5092eb96 TB |
98 | } |
99 | ||
0a1138af | 100 | |
f5c01f5b | 101 | void |
5092eb96 TB |
102 | _gfortran_caf_sync_images (int count __attribute__ ((unused)), |
103 | int images[] __attribute__ ((unused)), | |
f5c01f5b | 104 | int *stat, |
5092eb96 TB |
105 | char *errmsg __attribute__ ((unused)), |
106 | int errmsg_len __attribute__ ((unused))) | |
107 | { | |
108 | #ifdef GFC_CAF_CHECK | |
109 | int i; | |
110 | ||
111 | for (i = 0; i < count; i++) | |
112 | if (images[i] != 1) | |
113 | { | |
114 | fprintf (stderr, "COARRAY ERROR: Invalid image index %d to SYNC " | |
115 | "IMAGES", images[i]); | |
116 | exit (1); | |
117 | } | |
118 | #endif | |
119 | ||
f5c01f5b DC |
120 | if (stat) |
121 | *stat = 0; | |
5092eb96 TB |
122 | } |
123 | ||
5092eb96 TB |
124 | |
125 | void | |
126 | _gfortran_caf_error_stop_str (const char *string, int32_t len) | |
127 | { | |
128 | fputs ("ERROR STOP ", stderr); | |
129 | while (len--) | |
130 | fputc (*(string++), stderr); | |
131 | fputs ("\n", stderr); | |
132 | ||
133 | exit (1); | |
134 | } | |
135 | ||
cc9ae24c | 136 | |
5092eb96 TB |
137 | void |
138 | _gfortran_caf_error_stop (int32_t error) | |
139 | { | |
140 | fprintf (stderr, "ERROR STOP %d\n", error); | |
141 | exit (error); | |
142 | } |