libstdc++: AIX xfail for_overwrite.cc testcase
[official-gcc.git] / libgomp / fortran.c
blob029dec17459412d04753f0eb10e307baede2c94b
1 /* Copyright (C) 2005-2020 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_supported_active_levels)
67 ialias_redirect (omp_get_level)
68 ialias_redirect (omp_get_ancestor_thread_num)
69 ialias_redirect (omp_get_team_size)
70 ialias_redirect (omp_get_active_level)
71 ialias_redirect (omp_in_final)
72 ialias_redirect (omp_get_cancellation)
73 ialias_redirect (omp_get_proc_bind)
74 ialias_redirect (omp_get_num_places)
75 ialias_redirect (omp_get_place_num_procs)
76 ialias_redirect (omp_get_place_proc_ids)
77 ialias_redirect (omp_get_place_num)
78 ialias_redirect (omp_get_partition_num_places)
79 ialias_redirect (omp_get_partition_place_nums)
80 ialias_redirect (omp_set_default_device)
81 ialias_redirect (omp_get_default_device)
82 ialias_redirect (omp_get_num_devices)
83 ialias_redirect (omp_get_num_teams)
84 ialias_redirect (omp_get_team_num)
85 ialias_redirect (omp_is_initial_device)
86 ialias_redirect (omp_get_initial_device)
87 ialias_redirect (omp_get_max_task_priority)
88 ialias_redirect (omp_pause_resource)
89 ialias_redirect (omp_pause_resource_all)
90 ialias_redirect (omp_init_allocator)
91 ialias_redirect (omp_destroy_allocator)
92 ialias_redirect (omp_set_default_allocator)
93 ialias_redirect (omp_get_default_allocator)
94 #endif
96 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
97 # define gomp_init_lock__30 omp_init_lock_
98 # define gomp_destroy_lock__30 omp_destroy_lock_
99 # define gomp_set_lock__30 omp_set_lock_
100 # define gomp_unset_lock__30 omp_unset_lock_
101 # define gomp_test_lock__30 omp_test_lock_
102 # define gomp_init_nest_lock__30 omp_init_nest_lock_
103 # define gomp_destroy_nest_lock__30 omp_destroy_nest_lock_
104 # define gomp_set_nest_lock__30 omp_set_nest_lock_
105 # define gomp_unset_nest_lock__30 omp_unset_nest_lock_
106 # define gomp_test_nest_lock__30 omp_test_nest_lock_
107 #endif
109 void
110 gomp_init_lock__30 (omp_lock_arg_t lock)
112 #ifndef OMP_LOCK_DIRECT
113 omp_lock_arg (lock) = malloc (sizeof (omp_lock_t));
114 #endif
115 gomp_init_lock_30 (omp_lock_arg (lock));
118 void
119 gomp_init_nest_lock__30 (omp_nest_lock_arg_t lock)
121 #ifndef OMP_NEST_LOCK_DIRECT
122 omp_nest_lock_arg (lock) = malloc (sizeof (omp_nest_lock_t));
123 #endif
124 gomp_init_nest_lock_30 (omp_nest_lock_arg (lock));
127 void
128 gomp_destroy_lock__30 (omp_lock_arg_t lock)
130 gomp_destroy_lock_30 (omp_lock_arg (lock));
131 #ifndef OMP_LOCK_DIRECT
132 free (omp_lock_arg (lock));
133 omp_lock_arg (lock) = NULL;
134 #endif
137 void
138 gomp_destroy_nest_lock__30 (omp_nest_lock_arg_t lock)
140 gomp_destroy_nest_lock_30 (omp_nest_lock_arg (lock));
141 #ifndef OMP_NEST_LOCK_DIRECT
142 free (omp_nest_lock_arg (lock));
143 omp_nest_lock_arg (lock) = NULL;
144 #endif
147 void
148 gomp_set_lock__30 (omp_lock_arg_t lock)
150 gomp_set_lock_30 (omp_lock_arg (lock));
153 void
154 gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock)
156 gomp_set_nest_lock_30 (omp_nest_lock_arg (lock));
159 void
160 gomp_unset_lock__30 (omp_lock_arg_t lock)
162 gomp_unset_lock_30 (omp_lock_arg (lock));
165 void
166 gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock)
168 gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock));
171 int32_t
172 gomp_test_lock__30 (omp_lock_arg_t lock)
174 return gomp_test_lock_30 (omp_lock_arg (lock));
177 int32_t
178 gomp_test_nest_lock__30 (omp_nest_lock_arg_t lock)
180 return gomp_test_nest_lock_30 (omp_nest_lock_arg (lock));
183 #ifdef LIBGOMP_GNU_SYMBOL_VERSIONING
184 void
185 gomp_init_lock__25 (omp_lock_25_arg_t lock)
187 #ifndef OMP_LOCK_25_DIRECT
188 omp_lock_25_arg (lock) = malloc (sizeof (omp_lock_25_t));
189 #endif
190 gomp_init_lock_25 (omp_lock_25_arg (lock));
193 void
194 gomp_init_nest_lock__25 (omp_nest_lock_25_arg_t lock)
196 #ifndef OMP_NEST_LOCK_25_DIRECT
197 omp_nest_lock_25_arg (lock) = malloc (sizeof (omp_nest_lock_25_t));
198 #endif
199 gomp_init_nest_lock_25 (omp_nest_lock_25_arg (lock));
202 void
203 gomp_destroy_lock__25 (omp_lock_25_arg_t lock)
205 gomp_destroy_lock_25 (omp_lock_25_arg (lock));
206 #ifndef OMP_LOCK_25_DIRECT
207 free (omp_lock_25_arg (lock));
208 omp_lock_25_arg (lock) = NULL;
209 #endif
212 void
213 gomp_destroy_nest_lock__25 (omp_nest_lock_25_arg_t lock)
215 gomp_destroy_nest_lock_25 (omp_nest_lock_25_arg (lock));
216 #ifndef OMP_NEST_LOCK_25_DIRECT
217 free (omp_nest_lock_25_arg (lock));
218 omp_nest_lock_25_arg (lock) = NULL;
219 #endif
222 void
223 gomp_set_lock__25 (omp_lock_25_arg_t lock)
225 gomp_set_lock_25 (omp_lock_25_arg (lock));
228 void
229 gomp_set_nest_lock__25 (omp_nest_lock_25_arg_t lock)
231 gomp_set_nest_lock_25 (omp_nest_lock_25_arg (lock));
234 void
235 gomp_unset_lock__25 (omp_lock_25_arg_t lock)
237 gomp_unset_lock_25 (omp_lock_25_arg (lock));
240 void
241 gomp_unset_nest_lock__25 (omp_nest_lock_25_arg_t lock)
243 gomp_unset_nest_lock_25 (omp_nest_lock_25_arg (lock));
246 int32_t
247 gomp_test_lock__25 (omp_lock_25_arg_t lock)
249 return gomp_test_lock_25 (omp_lock_25_arg (lock));
252 int32_t
253 gomp_test_nest_lock__25 (omp_nest_lock_25_arg_t lock)
255 return gomp_test_nest_lock_25 (omp_nest_lock_25_arg (lock));
258 omp_lock_symver (omp_init_lock_)
259 omp_lock_symver (omp_destroy_lock_)
260 omp_lock_symver (omp_set_lock_)
261 omp_lock_symver (omp_unset_lock_)
262 omp_lock_symver (omp_test_lock_)
263 omp_lock_symver (omp_init_nest_lock_)
264 omp_lock_symver (omp_destroy_nest_lock_)
265 omp_lock_symver (omp_set_nest_lock_)
266 omp_lock_symver (omp_unset_nest_lock_)
267 omp_lock_symver (omp_test_nest_lock_)
268 #endif
270 #define TO_INT(x) ((x) > INT_MIN ? (x) < INT_MAX ? (x) : INT_MAX : INT_MIN)
272 void
273 omp_set_dynamic_ (const int32_t *set)
275 omp_set_dynamic (*set);
278 void
279 omp_set_dynamic_8_ (const int64_t *set)
281 omp_set_dynamic (!!*set);
284 void
285 omp_set_nested_ (const int32_t *set)
287 omp_set_nested (*set);
290 void
291 omp_set_nested_8_ (const int64_t *set)
293 omp_set_nested (!!*set);
296 void
297 omp_set_num_threads_ (const int32_t *set)
299 omp_set_num_threads (*set);
302 void
303 omp_set_num_threads_8_ (const int64_t *set)
305 omp_set_num_threads (TO_INT (*set));
308 int32_t
309 omp_get_dynamic_ (void)
311 return omp_get_dynamic ();
314 int32_t
315 omp_get_nested_ (void)
317 return omp_get_nested ();
320 int32_t
321 omp_in_parallel_ (void)
323 return omp_in_parallel ();
326 int32_t
327 omp_get_max_threads_ (void)
329 return omp_get_max_threads ();
332 int32_t
333 omp_get_num_procs_ (void)
335 return omp_get_num_procs ();
338 int32_t
339 omp_get_num_threads_ (void)
341 return omp_get_num_threads ();
344 int32_t
345 omp_get_thread_num_ (void)
347 return omp_get_thread_num ();
350 double
351 omp_get_wtick_ (void)
353 return omp_get_wtick ();
356 double
357 omp_get_wtime_ (void)
359 return omp_get_wtime ();
362 void
363 omp_set_schedule_ (const int32_t *kind, const int32_t *chunk_size)
365 omp_set_schedule (*kind, *chunk_size);
368 void
369 omp_set_schedule_8_ (const int32_t *kind, const int64_t *chunk_size)
371 omp_set_schedule (*kind, TO_INT (*chunk_size));
374 void
375 omp_get_schedule_ (int32_t *kind, int32_t *chunk_size)
377 omp_sched_t k;
378 int cs;
379 omp_get_schedule (&k, &cs);
380 /* For now mask off GFS_MONOTONIC, because OpenMP 4.5 code will not
381 expect to see it. */
382 *kind = k & ~GFS_MONOTONIC;
383 *chunk_size = cs;
386 void
387 omp_get_schedule_8_ (int32_t *kind, int64_t *chunk_size)
389 omp_sched_t k;
390 int cs;
391 omp_get_schedule (&k, &cs);
392 /* See above. */
393 *kind = k & ~GFS_MONOTONIC;
394 *chunk_size = cs;
397 int32_t
398 omp_get_thread_limit_ (void)
400 return omp_get_thread_limit ();
403 void
404 omp_set_max_active_levels_ (const int32_t *levels)
406 omp_set_max_active_levels (*levels);
409 void
410 omp_set_max_active_levels_8_ (const int64_t *levels)
412 omp_set_max_active_levels (TO_INT (*levels));
415 int32_t
416 omp_get_max_active_levels_ (void)
418 return omp_get_max_active_levels ();
421 int32_t
422 omp_get_supported_active_levels_ (void)
424 return omp_get_supported_active_levels ();
427 int32_t
428 omp_get_level_ (void)
430 return omp_get_level ();
433 int32_t
434 omp_get_ancestor_thread_num_ (const int32_t *level)
436 return omp_get_ancestor_thread_num (*level);
439 int32_t
440 omp_get_ancestor_thread_num_8_ (const int64_t *level)
442 return omp_get_ancestor_thread_num (TO_INT (*level));
445 int32_t
446 omp_get_team_size_ (const int32_t *level)
448 return omp_get_team_size (*level);
451 int32_t
452 omp_get_team_size_8_ (const int64_t *level)
454 return omp_get_team_size (TO_INT (*level));
457 int32_t
458 omp_get_active_level_ (void)
460 return omp_get_active_level ();
463 int32_t
464 omp_in_final_ (void)
466 return omp_in_final ();
469 int32_t
470 omp_get_cancellation_ (void)
472 return omp_get_cancellation ();
475 int32_t
476 omp_get_proc_bind_ (void)
478 return omp_get_proc_bind ();
481 int32_t
482 omp_get_num_places_ (void)
484 return omp_get_num_places ();
487 int32_t
488 omp_get_place_num_procs_ (const int32_t *place_num)
490 return omp_get_place_num_procs (*place_num);
493 int32_t
494 omp_get_place_num_procs_8_ (const int64_t *place_num)
496 return omp_get_place_num_procs (TO_INT (*place_num));
499 void
500 omp_get_place_proc_ids_ (const int32_t *place_num, int32_t *ids)
502 omp_get_place_proc_ids (*place_num, (int *) ids);
505 void
506 omp_get_place_proc_ids_8_ (const int64_t *place_num, int64_t *ids)
508 gomp_get_place_proc_ids_8 (TO_INT (*place_num), ids);
511 int32_t
512 omp_get_place_num_ (void)
514 return omp_get_place_num ();
517 int32_t
518 omp_get_partition_num_places_ (void)
520 return omp_get_partition_num_places ();
523 void
524 omp_get_partition_place_nums_ (int32_t *place_nums)
526 omp_get_partition_place_nums ((int *) place_nums);
529 void
530 omp_get_partition_place_nums_8_ (int64_t *place_nums)
532 if (gomp_places_list == NULL)
533 return;
535 struct gomp_thread *thr = gomp_thread ();
536 if (thr->place == 0)
537 gomp_init_affinity ();
539 unsigned int i;
540 for (i = 0; i < thr->ts.place_partition_len; i++)
541 *place_nums++ = (int64_t) thr->ts.place_partition_off + i;
544 void
545 omp_set_default_device_ (const int32_t *device_num)
547 return omp_set_default_device (*device_num);
550 void
551 omp_set_default_device_8_ (const int64_t *device_num)
553 return omp_set_default_device (TO_INT (*device_num));
556 int32_t
557 omp_get_default_device_ (void)
559 return omp_get_default_device ();
562 int32_t
563 omp_get_num_devices_ (void)
565 return omp_get_num_devices ();
568 int32_t
569 omp_get_num_teams_ (void)
571 return omp_get_num_teams ();
574 int32_t
575 omp_get_team_num_ (void)
577 return omp_get_team_num ();
580 int32_t
581 omp_is_initial_device_ (void)
583 return omp_is_initial_device ();
586 int32_t
587 omp_get_initial_device_ (void)
589 return omp_get_initial_device ();
592 int32_t
593 omp_get_max_task_priority_ (void)
595 return omp_get_max_task_priority ();
598 void
599 omp_set_affinity_format_ (const char *format, size_t format_len)
601 gomp_set_affinity_format (format, format_len);
604 int32_t
605 omp_get_affinity_format_ (char *buffer, size_t buffer_len)
607 size_t len = strlen (gomp_affinity_format_var);
608 if (buffer_len)
610 if (len < buffer_len)
612 memcpy (buffer, gomp_affinity_format_var, len);
613 memset (buffer + len, ' ', buffer_len - len);
615 else
616 memcpy (buffer, gomp_affinity_format_var, buffer_len);
618 return len;
621 void
622 omp_display_affinity_ (const char *format, size_t format_len)
624 char *fmt = NULL, fmt_buf[256];
625 char buf[512];
626 if (format_len)
628 fmt = format_len < 256 ? fmt_buf : gomp_malloc (format_len + 1);
629 memcpy (fmt, format, format_len);
630 fmt[format_len] = '\0';
632 struct gomp_thread *thr = gomp_thread ();
633 size_t ret
634 = gomp_display_affinity (buf, sizeof buf,
635 format_len ? fmt : gomp_affinity_format_var,
636 gomp_thread_self (), &thr->ts, thr->place);
637 if (ret < sizeof buf)
639 buf[ret] = '\n';
640 gomp_print_string (buf, ret + 1);
642 else
644 char *b = gomp_malloc (ret + 1);
645 gomp_display_affinity (buf, sizeof buf,
646 format_len ? fmt : gomp_affinity_format_var,
647 gomp_thread_self (), &thr->ts, thr->place);
648 b[ret] = '\n';
649 gomp_print_string (b, ret + 1);
650 free (b);
652 if (fmt && fmt != fmt_buf)
653 free (fmt);
656 int32_t
657 omp_capture_affinity_ (char *buffer, const char *format,
658 size_t buffer_len, size_t format_len)
660 char *fmt = NULL, fmt_buf[256];
661 if (format_len)
663 fmt = format_len < 256 ? fmt_buf : gomp_malloc (format_len + 1);
664 memcpy (fmt, format, format_len);
665 fmt[format_len] = '\0';
667 struct gomp_thread *thr = gomp_thread ();
668 size_t ret
669 = gomp_display_affinity (buffer, buffer_len,
670 format_len ? fmt : gomp_affinity_format_var,
671 gomp_thread_self (), &thr->ts, thr->place);
672 if (fmt && fmt != fmt_buf)
673 free (fmt);
674 if (ret < buffer_len)
675 memset (buffer + ret, ' ', buffer_len - ret);
676 return ret;
679 int32_t
680 omp_pause_resource_ (const int32_t *kind, const int32_t *device_num)
682 return omp_pause_resource (*kind, *device_num);
685 int32_t
686 omp_pause_resource_all_ (const int32_t *kind)
688 return omp_pause_resource_all (*kind);
691 intptr_t
692 omp_init_allocator_ (const intptr_t *memspace, const int32_t *ntraits,
693 const omp_alloctrait_t *traits)
695 return (intptr_t) omp_init_allocator ((omp_memspace_handle_t) *memspace,
696 (int) *ntraits, traits);
699 intptr_t
700 omp_init_allocator_8_ (const intptr_t *memspace, const int64_t *ntraits,
701 const omp_alloctrait_t *traits)
703 return (intptr_t) omp_init_allocator ((omp_memspace_handle_t) *memspace,
704 (int) *ntraits, traits);
707 void
708 omp_destroy_allocator_ (const intptr_t *allocator)
710 omp_destroy_allocator ((omp_allocator_handle_t) *allocator);
713 void
714 omp_set_default_allocator_ (const intptr_t *allocator)
716 omp_set_default_allocator ((omp_allocator_handle_t) *allocator);
719 intptr_t
720 omp_get_default_allocator_ ()
722 return (intptr_t) omp_get_default_allocator ();