re PR fortran/45859 ([Coarray, F2008, IR] Rejects valid actuals to coarray dummies)
[official-gcc.git] / libgomp / oacc-init.c
blob9a9a0b0333f71a634bbcb770b0a213a258fc9ba0
1 /* OpenACC Runtime initialization routines
3 Copyright (C) 2013-2015 Free Software Foundation, Inc.
5 Contributed by Mentor Embedded.
7 This file is part of the GNU Offloading and Multi Processing Library
8 (libgomp).
10 Libgomp is free software; you can redistribute it and/or modify it
11 under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 3, or (at your option)
13 any later version.
15 Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
16 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
17 FOR A PARTICULAR PURPOSE. See the GNU General Public License for
18 more details.
20 Under Section 7 of GPL version 3, you are granted additional
21 permissions described in the GCC Runtime Library Exception, version
22 3.1, as published by the Free Software Foundation.
24 You should have received a copy of the GNU General Public License and
25 a copy of the GCC Runtime Library Exception along with this program;
26 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
27 <http://www.gnu.org/licenses/>. */
29 #include "libgomp.h"
30 #include "oacc-int.h"
31 #include "openacc.h"
32 #include <assert.h>
33 #include <stdlib.h>
34 #include <strings.h>
35 #include <stdbool.h>
36 #include <string.h>
38 /* This lock is used to protect access to cached_base_dev, dispatchers and
39 the (abstract) initialisation state of attached offloading devices. */
41 static gomp_mutex_t acc_device_lock;
43 /* A cached version of the dispatcher for the global "current" accelerator type,
44 e.g. used as the default when creating new host threads. This is the
45 device-type equivalent of goacc_device_num (which specifies which device to
46 use out of potentially several of the same type). If there are several
47 devices of a given type, this points at the first one. */
49 static struct gomp_device_descr *cached_base_dev = NULL;
51 #if defined HAVE_TLS || defined USE_EMUTLS
52 __thread struct goacc_thread *goacc_tls_data;
53 #else
54 pthread_key_t goacc_tls_key;
55 #endif
56 static pthread_key_t goacc_cleanup_key;
58 static struct goacc_thread *goacc_threads;
59 static gomp_mutex_t goacc_thread_lock;
61 /* An array of dispatchers for device types, indexed by the type. This array
62 only references "base" devices, and other instances of the same type are
63 found by simply indexing from each such device (which are stored linearly,
64 grouped by device in target.c:devices). */
65 static struct gomp_device_descr *dispatchers[_ACC_device_hwm] = { 0 };
67 attribute_hidden void
68 goacc_register (struct gomp_device_descr *disp)
70 /* Only register the 0th device here. */
71 if (disp->target_id != 0)
72 return;
74 gomp_mutex_lock (&acc_device_lock);
76 assert (acc_device_type (disp->type) != acc_device_none
77 && acc_device_type (disp->type) != acc_device_default
78 && acc_device_type (disp->type) != acc_device_not_host);
79 assert (!dispatchers[disp->type]);
80 dispatchers[disp->type] = disp;
82 gomp_mutex_unlock (&acc_device_lock);
85 /* OpenACC names some things a little differently. */
87 static const char *
88 get_openacc_name (const char *name)
90 if (strcmp (name, "nvptx") == 0)
91 return "nvidia";
92 else
93 return name;
96 static const char *
97 name_of_acc_device_t (enum acc_device_t type)
99 switch (type)
101 case acc_device_none: return "none";
102 case acc_device_default: return "default";
103 case acc_device_host: return "host";
104 case acc_device_not_host: return "not_host";
105 case acc_device_nvidia: return "nvidia";
106 default: gomp_fatal ("unknown device type %u", (unsigned) type);
110 /* ACC_DEVICE_LOCK must be held before calling this function. If FAIL_IS_ERROR
111 is true, this function raises an error if there are no devices of type D,
112 otherwise it returns NULL in that case. */
114 static struct gomp_device_descr *
115 resolve_device (acc_device_t d, bool fail_is_error)
117 acc_device_t d_arg = d;
119 switch (d)
121 case acc_device_default:
123 if (goacc_device_type)
125 /* Lookup the named device. */
126 while (++d != _ACC_device_hwm)
127 if (dispatchers[d]
128 && !strcasecmp (goacc_device_type,
129 get_openacc_name (dispatchers[d]->name))
130 && dispatchers[d]->get_num_devices_func () > 0)
131 goto found;
133 if (fail_is_error)
135 gomp_mutex_unlock (&acc_device_lock);
136 gomp_fatal ("device type %s not supported", goacc_device_type);
138 else
139 return NULL;
142 /* No default device specified, so start scanning for any non-host
143 device that is available. */
144 d = acc_device_not_host;
146 /* FALLTHROUGH */
148 case acc_device_not_host:
149 /* Find the first available device after acc_device_not_host. */
150 while (++d != _ACC_device_hwm)
151 if (dispatchers[d] && dispatchers[d]->get_num_devices_func () > 0)
152 goto found;
153 if (d_arg == acc_device_default)
155 d = acc_device_host;
156 goto found;
158 if (fail_is_error)
160 gomp_mutex_unlock (&acc_device_lock);
161 gomp_fatal ("no device found");
163 else
164 return NULL;
165 break;
167 case acc_device_host:
168 break;
170 default:
171 if (d > _ACC_device_hwm)
173 if (fail_is_error)
174 goto unsupported_device;
175 else
176 return NULL;
178 break;
180 found:
182 assert (d != acc_device_none
183 && d != acc_device_default
184 && d != acc_device_not_host);
186 if (dispatchers[d] == NULL && fail_is_error)
188 unsupported_device:
189 gomp_mutex_unlock (&acc_device_lock);
190 gomp_fatal ("device type %s not supported", name_of_acc_device_t (d));
193 return dispatchers[d];
196 /* Emit a suitable error if no device of a particular type is available, or
197 the given device number is out-of-range. */
198 static void
199 acc_dev_num_out_of_range (acc_device_t d, int ord, int ndevs)
201 if (ndevs == 0)
202 gomp_fatal ("no devices of type %s available", name_of_acc_device_t (d));
203 else
204 gomp_fatal ("device %u out of range", ord);
207 /* This is called when plugins have been initialized, and serves to call
208 (indirectly) the target's device_init hook. Calling multiple times without
209 an intervening acc_shutdown_1 call is an error. ACC_DEVICE_LOCK must be
210 held before calling this function. */
212 static struct gomp_device_descr *
213 acc_init_1 (acc_device_t d)
215 struct gomp_device_descr *base_dev, *acc_dev;
216 int ndevs;
218 base_dev = resolve_device (d, true);
220 ndevs = base_dev->get_num_devices_func ();
222 if (ndevs <= 0 || goacc_device_num >= ndevs)
223 acc_dev_num_out_of_range (d, goacc_device_num, ndevs);
225 acc_dev = &base_dev[goacc_device_num];
227 gomp_mutex_lock (&acc_dev->lock);
228 if (acc_dev->is_initialized)
230 gomp_mutex_unlock (&acc_dev->lock);
231 gomp_fatal ("device already active");
234 gomp_init_device (acc_dev);
235 gomp_mutex_unlock (&acc_dev->lock);
237 return base_dev;
240 /* ACC_DEVICE_LOCK must be held before calling this function. */
242 static void
243 acc_shutdown_1 (acc_device_t d)
245 struct gomp_device_descr *base_dev;
246 struct goacc_thread *walk;
247 int ndevs, i;
248 bool devices_active = false;
250 /* Get the base device for this device type. */
251 base_dev = resolve_device (d, true);
253 ndevs = base_dev->get_num_devices_func ();
255 /* Unload all the devices of this type that have been opened. */
256 for (i = 0; i < ndevs; i++)
258 struct gomp_device_descr *acc_dev = &base_dev[i];
260 gomp_mutex_lock (&acc_dev->lock);
261 gomp_unload_device (acc_dev);
262 gomp_mutex_unlock (&acc_dev->lock);
265 gomp_mutex_lock (&goacc_thread_lock);
267 /* Free target-specific TLS data and close all devices. */
268 for (walk = goacc_threads; walk != NULL; walk = walk->next)
270 if (walk->target_tls)
271 base_dev->openacc.destroy_thread_data_func (walk->target_tls);
273 walk->target_tls = NULL;
275 /* This would mean the user is shutting down OpenACC in the middle of an
276 "acc data" pragma. Likely not intentional. */
277 if (walk->mapped_data)
279 gomp_mutex_unlock (&goacc_thread_lock);
280 gomp_fatal ("shutdown in 'acc data' region");
283 /* Similarly, if this happens then user code has done something weird. */
284 if (walk->saved_bound_dev)
286 gomp_mutex_unlock (&goacc_thread_lock);
287 gomp_fatal ("shutdown during host fallback");
290 if (walk->dev)
292 gomp_mutex_lock (&walk->dev->lock);
293 gomp_free_memmap (&walk->dev->mem_map);
294 gomp_mutex_unlock (&walk->dev->lock);
296 walk->dev = NULL;
297 walk->base_dev = NULL;
301 gomp_mutex_unlock (&goacc_thread_lock);
304 /* Close all the devices of this type that have been opened. */
305 for (i = 0; i < ndevs; i++)
307 struct gomp_device_descr *acc_dev = &base_dev[i];
308 gomp_mutex_lock (&acc_dev->lock);
309 if (acc_dev->is_initialized)
311 devices_active = true;
312 gomp_fini_device (acc_dev);
314 gomp_mutex_unlock (&acc_dev->lock);
317 if (!devices_active)
318 gomp_fatal ("no device initialized");
321 static struct goacc_thread *
322 goacc_new_thread (void)
324 struct goacc_thread *thr = gomp_malloc (sizeof (struct gomp_thread));
326 #if defined HAVE_TLS || defined USE_EMUTLS
327 goacc_tls_data = thr;
328 #else
329 pthread_setspecific (goacc_tls_key, thr);
330 #endif
332 pthread_setspecific (goacc_cleanup_key, thr);
334 gomp_mutex_lock (&goacc_thread_lock);
335 thr->next = goacc_threads;
336 goacc_threads = thr;
337 gomp_mutex_unlock (&goacc_thread_lock);
339 return thr;
342 static void
343 goacc_destroy_thread (void *data)
345 struct goacc_thread *thr = data, *walk, *prev;
347 gomp_mutex_lock (&goacc_thread_lock);
349 if (thr)
351 struct gomp_device_descr *acc_dev = thr->dev;
353 if (acc_dev && thr->target_tls)
355 acc_dev->openacc.destroy_thread_data_func (thr->target_tls);
356 thr->target_tls = NULL;
359 assert (!thr->mapped_data);
361 /* Remove from thread list. */
362 for (prev = NULL, walk = goacc_threads; walk;
363 prev = walk, walk = walk->next)
364 if (walk == thr)
366 if (prev == NULL)
367 goacc_threads = walk->next;
368 else
369 prev->next = walk->next;
371 free (thr);
373 break;
376 assert (walk);
379 gomp_mutex_unlock (&goacc_thread_lock);
382 /* Use the ORD'th device instance for the current host thread (or -1 for the
383 current global default). The device (and the runtime) must be initialised
384 before calling this function. */
386 void
387 goacc_attach_host_thread_to_device (int ord)
389 struct goacc_thread *thr = goacc_thread ();
390 struct gomp_device_descr *acc_dev = NULL, *base_dev = NULL;
391 int num_devices;
393 if (thr && thr->dev && (thr->dev->target_id == ord || ord < 0))
394 return;
396 if (ord < 0)
397 ord = goacc_device_num;
399 /* Decide which type of device to use. If the current thread has a device
400 type already (e.g. set by acc_set_device_type), use that, else use the
401 global default. */
402 if (thr && thr->base_dev)
403 base_dev = thr->base_dev;
404 else
406 assert (cached_base_dev);
407 base_dev = cached_base_dev;
410 num_devices = base_dev->get_num_devices_func ();
411 if (num_devices <= 0 || ord >= num_devices)
412 acc_dev_num_out_of_range (acc_device_type (base_dev->type), ord,
413 num_devices);
415 if (!thr)
416 thr = goacc_new_thread ();
418 thr->base_dev = base_dev;
419 thr->dev = acc_dev = &base_dev[ord];
420 thr->saved_bound_dev = NULL;
421 thr->mapped_data = NULL;
423 thr->target_tls
424 = acc_dev->openacc.create_thread_data_func (ord);
426 acc_dev->openacc.async_set_async_func (acc_async_sync);
429 /* OpenACC 2.0a (3.2.12, 3.2.13) doesn't specify whether the serialization of
430 init/shutdown is per-process or per-thread. We choose per-process. */
432 void
433 acc_init (acc_device_t d)
435 if (!cached_base_dev)
436 gomp_init_targets_once ();
438 gomp_mutex_lock (&acc_device_lock);
440 cached_base_dev = acc_init_1 (d);
442 gomp_mutex_unlock (&acc_device_lock);
444 goacc_attach_host_thread_to_device (-1);
447 ialias (acc_init)
449 void
450 acc_shutdown (acc_device_t d)
452 gomp_init_targets_once ();
454 gomp_mutex_lock (&acc_device_lock);
456 acc_shutdown_1 (d);
458 gomp_mutex_unlock (&acc_device_lock);
461 ialias (acc_shutdown)
464 acc_get_num_devices (acc_device_t d)
466 int n = 0;
467 struct gomp_device_descr *acc_dev;
469 if (d == acc_device_none)
470 return 0;
472 gomp_init_targets_once ();
474 gomp_mutex_lock (&acc_device_lock);
475 acc_dev = resolve_device (d, false);
476 gomp_mutex_unlock (&acc_device_lock);
478 if (!acc_dev)
479 return 0;
481 n = acc_dev->get_num_devices_func ();
482 if (n < 0)
483 n = 0;
485 return n;
488 ialias (acc_get_num_devices)
490 /* Set the device type for the current thread only (using the current global
491 default device number), initialising that device if necessary. Also set the
492 default device type for new threads to D. */
494 void
495 acc_set_device_type (acc_device_t d)
497 struct gomp_device_descr *base_dev, *acc_dev;
498 struct goacc_thread *thr = goacc_thread ();
500 gomp_mutex_lock (&acc_device_lock);
502 if (!cached_base_dev)
503 gomp_init_targets_once ();
505 cached_base_dev = base_dev = resolve_device (d, true);
506 acc_dev = &base_dev[goacc_device_num];
508 gomp_mutex_lock (&acc_dev->lock);
509 if (!acc_dev->is_initialized)
510 gomp_init_device (acc_dev);
511 gomp_mutex_unlock (&acc_dev->lock);
513 gomp_mutex_unlock (&acc_device_lock);
515 /* We're changing device type: invalidate the current thread's dev and
516 base_dev pointers. */
517 if (thr && thr->base_dev != base_dev)
519 thr->base_dev = thr->dev = NULL;
520 if (thr->mapped_data)
521 gomp_fatal ("acc_set_device_type in 'acc data' region");
524 goacc_attach_host_thread_to_device (-1);
527 ialias (acc_set_device_type)
529 acc_device_t
530 acc_get_device_type (void)
532 acc_device_t res = acc_device_none;
533 struct gomp_device_descr *dev;
534 struct goacc_thread *thr = goacc_thread ();
536 if (thr && thr->base_dev)
537 res = acc_device_type (thr->base_dev->type);
538 else
540 gomp_init_targets_once ();
542 gomp_mutex_lock (&acc_device_lock);
543 dev = resolve_device (acc_device_default, true);
544 gomp_mutex_unlock (&acc_device_lock);
545 res = acc_device_type (dev->type);
548 assert (res != acc_device_default
549 && res != acc_device_not_host);
551 return res;
554 ialias (acc_get_device_type)
557 acc_get_device_num (acc_device_t d)
559 const struct gomp_device_descr *dev;
560 struct goacc_thread *thr = goacc_thread ();
562 if (d >= _ACC_device_hwm)
563 gomp_fatal ("unknown device type %u", (unsigned) d);
565 if (!cached_base_dev)
566 gomp_init_targets_once ();
568 gomp_mutex_lock (&acc_device_lock);
569 dev = resolve_device (d, true);
570 gomp_mutex_unlock (&acc_device_lock);
572 if (thr && thr->base_dev == dev && thr->dev)
573 return thr->dev->target_id;
575 return goacc_device_num;
578 ialias (acc_get_device_num)
580 void
581 acc_set_device_num (int ord, acc_device_t d)
583 struct gomp_device_descr *base_dev, *acc_dev;
584 int num_devices;
586 if (!cached_base_dev)
587 gomp_init_targets_once ();
589 if (ord < 0)
590 ord = goacc_device_num;
592 if ((int) d == 0)
593 /* Set whatever device is being used by the current host thread to use
594 device instance ORD. It's unclear if this is supposed to affect other
595 host threads too (OpenACC 2.0 (3.2.4) acc_set_device_num). */
596 goacc_attach_host_thread_to_device (ord);
597 else
599 gomp_mutex_lock (&acc_device_lock);
601 cached_base_dev = base_dev = resolve_device (d, true);
603 num_devices = base_dev->get_num_devices_func ();
605 if (num_devices <= 0 || ord >= num_devices)
606 acc_dev_num_out_of_range (d, ord, num_devices);
608 acc_dev = &base_dev[ord];
610 gomp_mutex_lock (&acc_dev->lock);
611 if (!acc_dev->is_initialized)
612 gomp_init_device (acc_dev);
613 gomp_mutex_unlock (&acc_dev->lock);
615 gomp_mutex_unlock (&acc_device_lock);
617 goacc_attach_host_thread_to_device (ord);
620 goacc_device_num = ord;
623 ialias (acc_set_device_num)
625 /* For -O and higher, the compiler always attempts to expand acc_on_device, but
626 if the user disables the builtin, or calls it via a pointer, we'll need this
627 version.
629 Compile this with optimization, so that the compiler expands
630 this, rather than generating infinitely recursive code. */
632 int __attribute__ ((__optimize__ ("O2")))
633 acc_on_device (acc_device_t dev)
635 return __builtin_acc_on_device (dev);
638 ialias (acc_on_device)
640 attribute_hidden void
641 goacc_runtime_initialize (void)
643 gomp_mutex_init (&acc_device_lock);
645 #if !(defined HAVE_TLS || defined USE_EMUTLS)
646 pthread_key_create (&goacc_tls_key, NULL);
647 #endif
649 pthread_key_create (&goacc_cleanup_key, goacc_destroy_thread);
651 cached_base_dev = NULL;
653 goacc_threads = NULL;
654 gomp_mutex_init (&goacc_thread_lock);
656 /* Initialize and register the 'host' device type. */
657 goacc_host_init ();
660 /* Compiler helper functions */
662 attribute_hidden void
663 goacc_save_and_set_bind (acc_device_t d)
665 struct goacc_thread *thr = goacc_thread ();
667 assert (!thr->saved_bound_dev);
669 thr->saved_bound_dev = thr->dev;
670 thr->dev = dispatchers[d];
673 attribute_hidden void
674 goacc_restore_bind (void)
676 struct goacc_thread *thr = goacc_thread ();
678 thr->dev = thr->saved_bound_dev;
679 thr->saved_bound_dev = NULL;
682 /* This is called from any OpenACC support function that may need to implicitly
683 initialize the libgomp runtime, either globally or from a new host thread.
684 On exit "goacc_thread" will return a valid & populated thread block. */
686 attribute_hidden void
687 goacc_lazy_initialize (void)
689 struct goacc_thread *thr = goacc_thread ();
691 if (thr && thr->dev)
692 return;
694 if (!cached_base_dev)
695 acc_init (acc_device_default);
696 else
697 goacc_attach_host_thread_to_device (-1);