[RS6000] rs6000_indirect_call_template
[official-gcc.git] / libgomp / fortran.c
blob0157baec648dbdb18ec2ac662d624c15ef909766
1 /* Copyright (C) 2005-2018 Free Software Foundation, Inc.
2 Contributed by Jakub Jelinek <jakub@redhat.com>.
4 This file is part of the GNU Offloading and Multi Processing Library
5 (libgomp).
7 Libgomp is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
10 any later version.
12 Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14 FOR A PARTICULAR PURPOSE. See the GNU General Public License for
15 more details.
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
26 /* This file contains Fortran wrapper routines. */
28 #include "libgomp.h"
29 #include "libgomp_f.h"
30 #include <stdlib.h>
31 #include <stdio.h>
32 #include <string.h>
33 #include <limits.h>
35 #ifdef HAVE_ATTRIBUTE_ALIAS
36 /* Use internal aliases if possible. */
37 # ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
38 ialias_redirect (omp_init_lock)
39 ialias_redirect (omp_init_nest_lock)
40 ialias_redirect (omp_destroy_lock)
41 ialias_redirect (omp_destroy_nest_lock)
42 ialias_redirect (omp_set_lock)
43 ialias_redirect (omp_set_nest_lock)
44 ialias_redirect (omp_unset_lock)
45 ialias_redirect (omp_unset_nest_lock)
46 ialias_redirect (omp_test_lock)
47 ialias_redirect (omp_test_nest_lock)
48 # endif
49 ialias_redirect (omp_set_dynamic)
50 ialias_redirect (omp_set_nested)
51 ialias_redirect (omp_set_num_threads)
52 ialias_redirect (omp_get_dynamic)
53 ialias_redirect (omp_get_nested)
54 ialias_redirect (omp_in_parallel)
55 ialias_redirect (omp_get_max_threads)
56 ialias_redirect (omp_get_num_procs)
57 ialias_redirect (omp_get_num_threads)
58 ialias_redirect (omp_get_thread_num)
59 ialias_redirect (omp_get_wtick)
60 ialias_redirect (omp_get_wtime)
61 ialias_redirect (omp_set_schedule)
62 ialias_redirect (omp_get_schedule)
63 ialias_redirect (omp_get_thread_limit)
64 ialias_redirect (omp_set_max_active_levels)
65 ialias_redirect (omp_get_max_active_levels)
66 ialias_redirect (omp_get_level)
67 ialias_redirect (omp_get_ancestor_thread_num)
68 ialias_redirect (omp_get_team_size)
69 ialias_redirect (omp_get_active_level)
70 ialias_redirect (omp_in_final)
71 ialias_redirect (omp_get_cancellation)
72 ialias_redirect (omp_get_proc_bind)
73 ialias_redirect (omp_get_num_places)
74 ialias_redirect (omp_get_place_num_procs)
75 ialias_redirect (omp_get_place_proc_ids)
76 ialias_redirect (omp_get_place_num)
77 ialias_redirect (omp_get_partition_num_places)
78 ialias_redirect (omp_get_partition_place_nums)
79 ialias_redirect (omp_set_default_device)
80 ialias_redirect (omp_get_default_device)
81 ialias_redirect (omp_get_num_devices)
82 ialias_redirect (omp_get_num_teams)
83 ialias_redirect (omp_get_team_num)
84 ialias_redirect (omp_is_initial_device)
85 ialias_redirect (omp_get_initial_device)
86 ialias_redirect (omp_get_max_task_priority)
87 ialias_redirect (omp_pause_resource)
88 ialias_redirect (omp_pause_resource_all)
89 #endif
91 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
92 # define gomp_init_lock__30 omp_init_lock_
93 # define gomp_destroy_lock__30 omp_destroy_lock_
94 # define gomp_set_lock__30 omp_set_lock_
95 # define gomp_unset_lock__30 omp_unset_lock_
96 # define gomp_test_lock__30 omp_test_lock_
97 # define gomp_init_nest_lock__30 omp_init_nest_lock_
98 # define gomp_destroy_nest_lock__30 omp_destroy_nest_lock_
99 # define gomp_set_nest_lock__30 omp_set_nest_lock_
100 # define gomp_unset_nest_lock__30 omp_unset_nest_lock_
101 # define gomp_test_nest_lock__30 omp_test_nest_lock_
102 #endif
104 void
105 gomp_init_lock__30 (omp_lock_arg_t lock)
107 #ifndef OMP_LOCK_DIRECT
108 omp_lock_arg (lock) = malloc (sizeof (omp_lock_t));
109 #endif
110 gomp_init_lock_30 (omp_lock_arg (lock));
113 void
114 gomp_init_nest_lock__30 (omp_nest_lock_arg_t lock)
116 #ifndef OMP_NEST_LOCK_DIRECT
117 omp_nest_lock_arg (lock) = malloc (sizeof (omp_nest_lock_t));
118 #endif
119 gomp_init_nest_lock_30 (omp_nest_lock_arg (lock));
122 void
123 gomp_destroy_lock__30 (omp_lock_arg_t lock)
125 gomp_destroy_lock_30 (omp_lock_arg (lock));
126 #ifndef OMP_LOCK_DIRECT
127 free (omp_lock_arg (lock));
128 omp_lock_arg (lock) = NULL;
129 #endif
132 void
133 gomp_destroy_nest_lock__30 (omp_nest_lock_arg_t lock)
135 gomp_destroy_nest_lock_30 (omp_nest_lock_arg (lock));
136 #ifndef OMP_NEST_LOCK_DIRECT
137 free (omp_nest_lock_arg (lock));
138 omp_nest_lock_arg (lock) = NULL;
139 #endif
142 void
143 gomp_set_lock__30 (omp_lock_arg_t lock)
145 gomp_set_lock_30 (omp_lock_arg (lock));
148 void
149 gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock)
151 gomp_set_nest_lock_30 (omp_nest_lock_arg (lock));
154 void
155 gomp_unset_lock__30 (omp_lock_arg_t lock)
157 gomp_unset_lock_30 (omp_lock_arg (lock));
160 void
161 gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock)
163 gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock));
166 int32_t
167 gomp_test_lock__30 (omp_lock_arg_t lock)
169 return gomp_test_lock_30 (omp_lock_arg (lock));
172 int32_t
173 gomp_test_nest_lock__30 (omp_nest_lock_arg_t lock)
175 return gomp_test_nest_lock_30 (omp_nest_lock_arg (lock));
178 #ifdef LIBGOMP_GNU_SYMBOL_VERSIONING
179 void
180 gomp_init_lock__25 (omp_lock_25_arg_t lock)
182 #ifndef OMP_LOCK_25_DIRECT
183 omp_lock_25_arg (lock) = malloc (sizeof (omp_lock_25_t));
184 #endif
185 gomp_init_lock_25 (omp_lock_25_arg (lock));
188 void
189 gomp_init_nest_lock__25 (omp_nest_lock_25_arg_t lock)
191 #ifndef OMP_NEST_LOCK_25_DIRECT
192 omp_nest_lock_25_arg (lock) = malloc (sizeof (omp_nest_lock_25_t));
193 #endif
194 gomp_init_nest_lock_25 (omp_nest_lock_25_arg (lock));
197 void
198 gomp_destroy_lock__25 (omp_lock_25_arg_t lock)
200 gomp_destroy_lock_25 (omp_lock_25_arg (lock));
201 #ifndef OMP_LOCK_25_DIRECT
202 free (omp_lock_25_arg (lock));
203 omp_lock_25_arg (lock) = NULL;
204 #endif
207 void
208 gomp_destroy_nest_lock__25 (omp_nest_lock_25_arg_t lock)
210 gomp_destroy_nest_lock_25 (omp_nest_lock_25_arg (lock));
211 #ifndef OMP_NEST_LOCK_25_DIRECT
212 free (omp_nest_lock_25_arg (lock));
213 omp_nest_lock_25_arg (lock) = NULL;
214 #endif
217 void
218 gomp_set_lock__25 (omp_lock_25_arg_t lock)
220 gomp_set_lock_25 (omp_lock_25_arg (lock));
223 void
224 gomp_set_nest_lock__25 (omp_nest_lock_25_arg_t lock)
226 gomp_set_nest_lock_25 (omp_nest_lock_25_arg (lock));
229 void
230 gomp_unset_lock__25 (omp_lock_25_arg_t lock)
232 gomp_unset_lock_25 (omp_lock_25_arg (lock));
235 void
236 gomp_unset_nest_lock__25 (omp_nest_lock_25_arg_t lock)
238 gomp_unset_nest_lock_25 (omp_nest_lock_25_arg (lock));
241 int32_t
242 gomp_test_lock__25 (omp_lock_25_arg_t lock)
244 return gomp_test_lock_25 (omp_lock_25_arg (lock));
247 int32_t
248 gomp_test_nest_lock__25 (omp_nest_lock_25_arg_t lock)
250 return gomp_test_nest_lock_25 (omp_nest_lock_25_arg (lock));
253 omp_lock_symver (omp_init_lock_)
254 omp_lock_symver (omp_destroy_lock_)
255 omp_lock_symver (omp_set_lock_)
256 omp_lock_symver (omp_unset_lock_)
257 omp_lock_symver (omp_test_lock_)
258 omp_lock_symver (omp_init_nest_lock_)
259 omp_lock_symver (omp_destroy_nest_lock_)
260 omp_lock_symver (omp_set_nest_lock_)
261 omp_lock_symver (omp_unset_nest_lock_)
262 omp_lock_symver (omp_test_nest_lock_)
263 #endif
265 #define TO_INT(x) ((x) > INT_MIN ? (x) < INT_MAX ? (x) : INT_MAX : INT_MIN)
267 void
268 omp_set_dynamic_ (const int32_t *set)
270 omp_set_dynamic (*set);
273 void
274 omp_set_dynamic_8_ (const int64_t *set)
276 omp_set_dynamic (!!*set);
279 void
280 omp_set_nested_ (const int32_t *set)
282 omp_set_nested (*set);
285 void
286 omp_set_nested_8_ (const int64_t *set)
288 omp_set_nested (!!*set);
291 void
292 omp_set_num_threads_ (const int32_t *set)
294 omp_set_num_threads (*set);
297 void
298 omp_set_num_threads_8_ (const int64_t *set)
300 omp_set_num_threads (TO_INT (*set));
303 int32_t
304 omp_get_dynamic_ (void)
306 return omp_get_dynamic ();
309 int32_t
310 omp_get_nested_ (void)
312 return omp_get_nested ();
315 int32_t
316 omp_in_parallel_ (void)
318 return omp_in_parallel ();
321 int32_t
322 omp_get_max_threads_ (void)
324 return omp_get_max_threads ();
327 int32_t
328 omp_get_num_procs_ (void)
330 return omp_get_num_procs ();
333 int32_t
334 omp_get_num_threads_ (void)
336 return omp_get_num_threads ();
339 int32_t
340 omp_get_thread_num_ (void)
342 return omp_get_thread_num ();
345 double
346 omp_get_wtick_ (void)
348 return omp_get_wtick ();
351 double
352 omp_get_wtime_ (void)
354 return omp_get_wtime ();
357 void
358 omp_set_schedule_ (const int32_t *kind, const int32_t *chunk_size)
360 omp_set_schedule (*kind, *chunk_size);
363 void
364 omp_set_schedule_8_ (const int32_t *kind, const int64_t *chunk_size)
366 omp_set_schedule (*kind, TO_INT (*chunk_size));
369 void
370 omp_get_schedule_ (int32_t *kind, int32_t *chunk_size)
372 omp_sched_t k;
373 int cs;
374 omp_get_schedule (&k, &cs);
375 /* For now mask off GFS_MONOTONIC, because OpenMP 4.5 code will not
376 expect to see it. */
377 *kind = k & ~GFS_MONOTONIC;
378 *chunk_size = cs;
381 void
382 omp_get_schedule_8_ (int32_t *kind, int64_t *chunk_size)
384 omp_sched_t k;
385 int cs;
386 omp_get_schedule (&k, &cs);
387 /* See above. */
388 *kind = k & ~GFS_MONOTONIC;
389 *chunk_size = cs;
392 int32_t
393 omp_get_thread_limit_ (void)
395 return omp_get_thread_limit ();
398 void
399 omp_set_max_active_levels_ (const int32_t *levels)
401 omp_set_max_active_levels (*levels);
404 void
405 omp_set_max_active_levels_8_ (const int64_t *levels)
407 omp_set_max_active_levels (TO_INT (*levels));
410 int32_t
411 omp_get_max_active_levels_ (void)
413 return omp_get_max_active_levels ();
416 int32_t
417 omp_get_level_ (void)
419 return omp_get_level ();
422 int32_t
423 omp_get_ancestor_thread_num_ (const int32_t *level)
425 return omp_get_ancestor_thread_num (*level);
428 int32_t
429 omp_get_ancestor_thread_num_8_ (const int64_t *level)
431 return omp_get_ancestor_thread_num (TO_INT (*level));
434 int32_t
435 omp_get_team_size_ (const int32_t *level)
437 return omp_get_team_size (*level);
440 int32_t
441 omp_get_team_size_8_ (const int64_t *level)
443 return omp_get_team_size (TO_INT (*level));
446 int32_t
447 omp_get_active_level_ (void)
449 return omp_get_active_level ();
452 int32_t
453 omp_in_final_ (void)
455 return omp_in_final ();
458 int32_t
459 omp_get_cancellation_ (void)
461 return omp_get_cancellation ();
464 int32_t
465 omp_get_proc_bind_ (void)
467 return omp_get_proc_bind ();
470 int32_t
471 omp_get_num_places_ (void)
473 return omp_get_num_places ();
476 int32_t
477 omp_get_place_num_procs_ (const int32_t *place_num)
479 return omp_get_place_num_procs (*place_num);
482 int32_t
483 omp_get_place_num_procs_8_ (const int64_t *place_num)
485 return omp_get_place_num_procs (TO_INT (*place_num));
488 void
489 omp_get_place_proc_ids_ (const int32_t *place_num, int32_t *ids)
491 omp_get_place_proc_ids (*place_num, (int *) ids);
494 void
495 omp_get_place_proc_ids_8_ (const int64_t *place_num, int64_t *ids)
497 gomp_get_place_proc_ids_8 (TO_INT (*place_num), ids);
500 int32_t
501 omp_get_place_num_ (void)
503 return omp_get_place_num ();
506 int32_t
507 omp_get_partition_num_places_ (void)
509 return omp_get_partition_num_places ();
512 void
513 omp_get_partition_place_nums_ (int32_t *place_nums)
515 omp_get_partition_place_nums ((int *) place_nums);
518 void
519 omp_get_partition_place_nums_8_ (int64_t *place_nums)
521 if (gomp_places_list == NULL)
522 return;
524 struct gomp_thread *thr = gomp_thread ();
525 if (thr->place == 0)
526 gomp_init_affinity ();
528 unsigned int i;
529 for (i = 0; i < thr->ts.place_partition_len; i++)
530 *place_nums++ = (int64_t) thr->ts.place_partition_off + i;
533 void
534 omp_set_default_device_ (const int32_t *device_num)
536 return omp_set_default_device (*device_num);
539 void
540 omp_set_default_device_8_ (const int64_t *device_num)
542 return omp_set_default_device (TO_INT (*device_num));
545 int32_t
546 omp_get_default_device_ (void)
548 return omp_get_default_device ();
551 int32_t
552 omp_get_num_devices_ (void)
554 return omp_get_num_devices ();
557 int32_t
558 omp_get_num_teams_ (void)
560 return omp_get_num_teams ();
563 int32_t
564 omp_get_team_num_ (void)
566 return omp_get_team_num ();
569 int32_t
570 omp_is_initial_device_ (void)
572 return omp_is_initial_device ();
575 int32_t
576 omp_get_initial_device_ (void)
578 return omp_get_initial_device ();
581 int32_t
582 omp_get_max_task_priority_ (void)
584 return omp_get_max_task_priority ();
587 void
588 omp_set_affinity_format_ (const char *format, size_t format_len)
590 gomp_set_affinity_format (format, format_len);
593 int32_t
594 omp_get_affinity_format_ (char *buffer, size_t buffer_len)
596 size_t len = strlen (gomp_affinity_format_var);
597 if (buffer_len)
599 if (len < buffer_len)
601 memcpy (buffer, gomp_affinity_format_var, len);
602 memset (buffer + len, ' ', buffer_len - len);
604 else
605 memcpy (buffer, gomp_affinity_format_var, buffer_len);
607 return len;
610 void
611 omp_display_affinity_ (const char *format, size_t format_len)
613 char *fmt = NULL, fmt_buf[256];
614 char buf[512];
615 if (format_len)
617 fmt = format_len < 256 ? fmt_buf : gomp_malloc (format_len + 1);
618 memcpy (fmt, format, format_len);
619 fmt[format_len] = '\0';
621 struct gomp_thread *thr = gomp_thread ();
622 size_t ret
623 = gomp_display_affinity (buf, sizeof buf,
624 format_len ? fmt : gomp_affinity_format_var,
625 gomp_thread_self (), &thr->ts, thr->place);
626 if (ret < sizeof buf)
628 buf[ret] = '\n';
629 fwrite (buf, 1, ret + 1, stderr);
631 else
633 char *b = gomp_malloc (ret + 1);
634 gomp_display_affinity (buf, sizeof buf,
635 format_len ? fmt : gomp_affinity_format_var,
636 gomp_thread_self (), &thr->ts, thr->place);
637 b[ret] = '\n';
638 fwrite (b, 1, ret + 1, stderr);
639 free (b);
641 if (fmt && fmt != fmt_buf)
642 free (fmt);
645 int32_t
646 omp_capture_affinity_ (char *buffer, const char *format,
647 size_t buffer_len, size_t format_len)
649 char *fmt = NULL, fmt_buf[256];
650 if (format_len)
652 fmt = format_len < 256 ? fmt_buf : gomp_malloc (format_len + 1);
653 memcpy (fmt, format, format_len);
654 fmt[format_len] = '\0';
656 struct gomp_thread *thr = gomp_thread ();
657 size_t ret
658 = gomp_display_affinity (buffer, buffer_len,
659 format_len ? fmt : gomp_affinity_format_var,
660 gomp_thread_self (), &thr->ts, thr->place);
661 if (fmt && fmt != fmt_buf)
662 free (fmt);
663 if (ret < buffer_len)
664 memset (buffer + ret, ' ', buffer_len - ret);
665 return ret;
668 int32_t
669 omp_pause_resource_ (const int32_t *kind, const int32_t *device_num)
671 return omp_pause_resource (*kind, *device_num);
674 int32_t
675 omp_pause_resource_all_ (const int32_t *kind)
677 return omp_pause_resource_all (*kind);