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
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)
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
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. */
29 #include "libgomp_f.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
)
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
)
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_
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
));
110 gomp_init_lock_30 (omp_lock_arg (lock
));
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
));
119 gomp_init_nest_lock_30 (omp_nest_lock_arg (lock
));
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
;
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
;
143 gomp_set_lock__30 (omp_lock_arg_t lock
)
145 gomp_set_lock_30 (omp_lock_arg (lock
));
149 gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock
)
151 gomp_set_nest_lock_30 (omp_nest_lock_arg (lock
));
155 gomp_unset_lock__30 (omp_lock_arg_t lock
)
157 gomp_unset_lock_30 (omp_lock_arg (lock
));
161 gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock
)
163 gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock
));
167 gomp_test_lock__30 (omp_lock_arg_t lock
)
169 return gomp_test_lock_30 (omp_lock_arg (lock
));
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
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
));
185 gomp_init_lock_25 (omp_lock_25_arg (lock
));
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
));
194 gomp_init_nest_lock_25 (omp_nest_lock_25_arg (lock
));
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
;
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
;
218 gomp_set_lock__25 (omp_lock_25_arg_t lock
)
220 gomp_set_lock_25 (omp_lock_25_arg (lock
));
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
));
230 gomp_unset_lock__25 (omp_lock_25_arg_t lock
)
232 gomp_unset_lock_25 (omp_lock_25_arg (lock
));
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
));
242 gomp_test_lock__25 (omp_lock_25_arg_t lock
)
244 return gomp_test_lock_25 (omp_lock_25_arg (lock
));
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_
)
265 #define TO_INT(x) ((x) > INT_MIN ? (x) < INT_MAX ? (x) : INT_MAX : INT_MIN)
268 omp_set_dynamic_ (const int32_t *set
)
270 omp_set_dynamic (*set
);
274 omp_set_dynamic_8_ (const int64_t *set
)
276 omp_set_dynamic (!!*set
);
280 omp_set_nested_ (const int32_t *set
)
282 omp_set_nested (*set
);
286 omp_set_nested_8_ (const int64_t *set
)
288 omp_set_nested (!!*set
);
292 omp_set_num_threads_ (const int32_t *set
)
294 omp_set_num_threads (*set
);
298 omp_set_num_threads_8_ (const int64_t *set
)
300 omp_set_num_threads (TO_INT (*set
));
304 omp_get_dynamic_ (void)
306 return omp_get_dynamic ();
310 omp_get_nested_ (void)
312 return omp_get_nested ();
316 omp_in_parallel_ (void)
318 return omp_in_parallel ();
322 omp_get_max_threads_ (void)
324 return omp_get_max_threads ();
328 omp_get_num_procs_ (void)
330 return omp_get_num_procs ();
334 omp_get_num_threads_ (void)
336 return omp_get_num_threads ();
340 omp_get_thread_num_ (void)
342 return omp_get_thread_num ();
346 omp_get_wtick_ (void)
348 return omp_get_wtick ();
352 omp_get_wtime_ (void)
354 return omp_get_wtime ();
358 omp_set_schedule_ (const int32_t *kind
, const int32_t *chunk_size
)
360 omp_set_schedule (*kind
, *chunk_size
);
364 omp_set_schedule_8_ (const int32_t *kind
, const int64_t *chunk_size
)
366 omp_set_schedule (*kind
, TO_INT (*chunk_size
));
370 omp_get_schedule_ (int32_t *kind
, int32_t *chunk_size
)
374 omp_get_schedule (&k
, &cs
);
375 /* For now mask off GFS_MONOTONIC, because OpenMP 4.5 code will not
377 *kind
= k
& ~GFS_MONOTONIC
;
382 omp_get_schedule_8_ (int32_t *kind
, int64_t *chunk_size
)
386 omp_get_schedule (&k
, &cs
);
388 *kind
= k
& ~GFS_MONOTONIC
;
393 omp_get_thread_limit_ (void)
395 return omp_get_thread_limit ();
399 omp_set_max_active_levels_ (const int32_t *levels
)
401 omp_set_max_active_levels (*levels
);
405 omp_set_max_active_levels_8_ (const int64_t *levels
)
407 omp_set_max_active_levels (TO_INT (*levels
));
411 omp_get_max_active_levels_ (void)
413 return omp_get_max_active_levels ();
417 omp_get_level_ (void)
419 return omp_get_level ();
423 omp_get_ancestor_thread_num_ (const int32_t *level
)
425 return omp_get_ancestor_thread_num (*level
);
429 omp_get_ancestor_thread_num_8_ (const int64_t *level
)
431 return omp_get_ancestor_thread_num (TO_INT (*level
));
435 omp_get_team_size_ (const int32_t *level
)
437 return omp_get_team_size (*level
);
441 omp_get_team_size_8_ (const int64_t *level
)
443 return omp_get_team_size (TO_INT (*level
));
447 omp_get_active_level_ (void)
449 return omp_get_active_level ();
455 return omp_in_final ();
459 omp_get_cancellation_ (void)
461 return omp_get_cancellation ();
465 omp_get_proc_bind_ (void)
467 return omp_get_proc_bind ();
471 omp_get_num_places_ (void)
473 return omp_get_num_places ();
477 omp_get_place_num_procs_ (const int32_t *place_num
)
479 return omp_get_place_num_procs (*place_num
);
483 omp_get_place_num_procs_8_ (const int64_t *place_num
)
485 return omp_get_place_num_procs (TO_INT (*place_num
));
489 omp_get_place_proc_ids_ (const int32_t *place_num
, int32_t *ids
)
491 omp_get_place_proc_ids (*place_num
, (int *) ids
);
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
);
501 omp_get_place_num_ (void)
503 return omp_get_place_num ();
507 omp_get_partition_num_places_ (void)
509 return omp_get_partition_num_places ();
513 omp_get_partition_place_nums_ (int32_t *place_nums
)
515 omp_get_partition_place_nums ((int *) place_nums
);
519 omp_get_partition_place_nums_8_ (int64_t *place_nums
)
521 if (gomp_places_list
== NULL
)
524 struct gomp_thread
*thr
= gomp_thread ();
526 gomp_init_affinity ();
529 for (i
= 0; i
< thr
->ts
.place_partition_len
; i
++)
530 *place_nums
++ = (int64_t) thr
->ts
.place_partition_off
+ i
;
534 omp_set_default_device_ (const int32_t *device_num
)
536 return omp_set_default_device (*device_num
);
540 omp_set_default_device_8_ (const int64_t *device_num
)
542 return omp_set_default_device (TO_INT (*device_num
));
546 omp_get_default_device_ (void)
548 return omp_get_default_device ();
552 omp_get_num_devices_ (void)
554 return omp_get_num_devices ();
558 omp_get_num_teams_ (void)
560 return omp_get_num_teams ();
564 omp_get_team_num_ (void)
566 return omp_get_team_num ();
570 omp_is_initial_device_ (void)
572 return omp_is_initial_device ();
576 omp_get_initial_device_ (void)
578 return omp_get_initial_device ();
582 omp_get_max_task_priority_ (void)
584 return omp_get_max_task_priority ();
588 omp_set_affinity_format_ (const char *format
, size_t format_len
)
590 gomp_set_affinity_format (format
, format_len
);
594 omp_get_affinity_format_ (char *buffer
, size_t buffer_len
)
596 size_t len
= strlen (gomp_affinity_format_var
);
599 if (len
< buffer_len
)
601 memcpy (buffer
, gomp_affinity_format_var
, len
);
602 memset (buffer
+ len
, ' ', buffer_len
- len
);
605 memcpy (buffer
, gomp_affinity_format_var
, buffer_len
);
611 omp_display_affinity_ (const char *format
, size_t format_len
)
613 char *fmt
= NULL
, fmt_buf
[256];
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 ();
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
)
629 gomp_print_string (buf
, ret
+ 1);
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
);
638 gomp_print_string (b
, ret
+ 1);
641 if (fmt
&& fmt
!= fmt_buf
)
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];
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 ();
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
)
663 if (ret
< buffer_len
)
664 memset (buffer
+ ret
, ' ', buffer_len
- ret
);
669 omp_pause_resource_ (const int32_t *kind
, const int32_t *device_num
)
671 return omp_pause_resource (*kind
, *device_num
);
675 omp_pause_resource_all_ (const int32_t *kind
)
677 return omp_pause_resource_all (*kind
);