1 /* Copyright (C) 2005-2024 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_get_dynamic
)
51 #pragma GCC diagnostic push
52 #pragma GCC diagnostic ignored "-Wdeprecated-declarations"
53 ialias_redirect (omp_set_nested
)
54 ialias_redirect (omp_get_nested
)
55 #pragma GCC diagnostic pop
56 ialias_redirect (omp_set_num_threads
)
57 ialias_redirect (omp_in_parallel
)
58 ialias_redirect (omp_get_max_threads
)
59 ialias_redirect (omp_get_num_procs
)
60 ialias_redirect (omp_get_num_threads
)
61 ialias_redirect (omp_get_thread_num
)
62 ialias_redirect (omp_get_wtick
)
63 ialias_redirect (omp_get_wtime
)
64 ialias_redirect (omp_set_schedule
)
65 ialias_redirect (omp_get_schedule
)
66 ialias_redirect (omp_get_thread_limit
)
67 ialias_redirect (omp_set_max_active_levels
)
68 ialias_redirect (omp_get_max_active_levels
)
69 ialias_redirect (omp_get_supported_active_levels
)
70 ialias_redirect (omp_set_num_teams
)
71 ialias_redirect (omp_get_max_teams
)
72 ialias_redirect (omp_set_teams_thread_limit
)
73 ialias_redirect (omp_get_teams_thread_limit
)
74 ialias_redirect (omp_get_level
)
75 ialias_redirect (omp_get_ancestor_thread_num
)
76 ialias_redirect (omp_get_team_size
)
77 ialias_redirect (omp_get_active_level
)
78 ialias_redirect (omp_in_final
)
79 ialias_redirect (omp_in_explicit_task
)
80 ialias_redirect (omp_get_cancellation
)
81 ialias_redirect (omp_get_proc_bind
)
82 ialias_redirect (omp_get_num_places
)
83 ialias_redirect (omp_get_place_num_procs
)
84 ialias_redirect (omp_get_place_proc_ids
)
85 ialias_redirect (omp_get_place_num
)
86 ialias_redirect (omp_get_partition_num_places
)
87 ialias_redirect (omp_get_partition_place_nums
)
88 ialias_redirect (omp_set_default_device
)
89 ialias_redirect (omp_get_default_device
)
90 ialias_redirect (omp_get_num_devices
)
91 ialias_redirect (omp_get_device_num
)
92 ialias_redirect (omp_get_num_teams
)
93 ialias_redirect (omp_get_team_num
)
94 ialias_redirect (omp_is_initial_device
)
95 ialias_redirect (omp_get_initial_device
)
96 ialias_redirect (omp_get_max_task_priority
)
97 ialias_redirect (omp_pause_resource
)
98 ialias_redirect (omp_pause_resource_all
)
99 ialias_redirect (omp_init_allocator
)
100 ialias_redirect (omp_destroy_allocator
)
101 ialias_redirect (omp_set_default_allocator
)
102 ialias_redirect (omp_get_default_allocator
)
103 ialias_redirect (omp_display_env
)
104 ialias_redirect (omp_fulfill_event
)
107 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
108 # define gomp_init_lock__30 omp_init_lock_
109 # define gomp_destroy_lock__30 omp_destroy_lock_
110 # define gomp_set_lock__30 omp_set_lock_
111 # define gomp_unset_lock__30 omp_unset_lock_
112 # define gomp_test_lock__30 omp_test_lock_
113 # define gomp_init_nest_lock__30 omp_init_nest_lock_
114 # define gomp_destroy_nest_lock__30 omp_destroy_nest_lock_
115 # define gomp_set_nest_lock__30 omp_set_nest_lock_
116 # define gomp_unset_nest_lock__30 omp_unset_nest_lock_
117 # define gomp_test_nest_lock__30 omp_test_nest_lock_
121 gomp_init_lock__30 (omp_lock_arg_t lock
)
123 #ifndef OMP_LOCK_DIRECT
124 omp_lock_arg (lock
) = malloc (sizeof (omp_lock_t
));
126 gomp_init_lock_30 (omp_lock_arg (lock
));
130 gomp_init_nest_lock__30 (omp_nest_lock_arg_t lock
)
132 #ifndef OMP_NEST_LOCK_DIRECT
133 omp_nest_lock_arg (lock
) = malloc (sizeof (omp_nest_lock_t
));
135 gomp_init_nest_lock_30 (omp_nest_lock_arg (lock
));
139 gomp_destroy_lock__30 (omp_lock_arg_t lock
)
141 gomp_destroy_lock_30 (omp_lock_arg (lock
));
142 #ifndef OMP_LOCK_DIRECT
143 free (omp_lock_arg (lock
));
144 omp_lock_arg (lock
) = NULL
;
149 gomp_destroy_nest_lock__30 (omp_nest_lock_arg_t lock
)
151 gomp_destroy_nest_lock_30 (omp_nest_lock_arg (lock
));
152 #ifndef OMP_NEST_LOCK_DIRECT
153 free (omp_nest_lock_arg (lock
));
154 omp_nest_lock_arg (lock
) = NULL
;
159 gomp_set_lock__30 (omp_lock_arg_t lock
)
161 gomp_set_lock_30 (omp_lock_arg (lock
));
165 gomp_set_nest_lock__30 (omp_nest_lock_arg_t lock
)
167 gomp_set_nest_lock_30 (omp_nest_lock_arg (lock
));
171 gomp_unset_lock__30 (omp_lock_arg_t lock
)
173 gomp_unset_lock_30 (omp_lock_arg (lock
));
177 gomp_unset_nest_lock__30 (omp_nest_lock_arg_t lock
)
179 gomp_unset_nest_lock_30 (omp_nest_lock_arg (lock
));
183 gomp_test_lock__30 (omp_lock_arg_t lock
)
185 return gomp_test_lock_30 (omp_lock_arg (lock
));
189 gomp_test_nest_lock__30 (omp_nest_lock_arg_t lock
)
191 return gomp_test_nest_lock_30 (omp_nest_lock_arg (lock
));
194 #ifdef LIBGOMP_GNU_SYMBOL_VERSIONING
196 gomp_init_lock__25 (omp_lock_25_arg_t lock
)
198 #ifndef OMP_LOCK_25_DIRECT
199 omp_lock_25_arg (lock
) = malloc (sizeof (omp_lock_25_t
));
201 gomp_init_lock_25 (omp_lock_25_arg (lock
));
205 gomp_init_nest_lock__25 (omp_nest_lock_25_arg_t lock
)
207 #ifndef OMP_NEST_LOCK_25_DIRECT
208 omp_nest_lock_25_arg (lock
) = malloc (sizeof (omp_nest_lock_25_t
));
210 gomp_init_nest_lock_25 (omp_nest_lock_25_arg (lock
));
214 gomp_destroy_lock__25 (omp_lock_25_arg_t lock
)
216 gomp_destroy_lock_25 (omp_lock_25_arg (lock
));
217 #ifndef OMP_LOCK_25_DIRECT
218 free (omp_lock_25_arg (lock
));
219 omp_lock_25_arg (lock
) = NULL
;
224 gomp_destroy_nest_lock__25 (omp_nest_lock_25_arg_t lock
)
226 gomp_destroy_nest_lock_25 (omp_nest_lock_25_arg (lock
));
227 #ifndef OMP_NEST_LOCK_25_DIRECT
228 free (omp_nest_lock_25_arg (lock
));
229 omp_nest_lock_25_arg (lock
) = NULL
;
234 gomp_set_lock__25 (omp_lock_25_arg_t lock
)
236 gomp_set_lock_25 (omp_lock_25_arg (lock
));
240 gomp_set_nest_lock__25 (omp_nest_lock_25_arg_t lock
)
242 gomp_set_nest_lock_25 (omp_nest_lock_25_arg (lock
));
246 gomp_unset_lock__25 (omp_lock_25_arg_t lock
)
248 gomp_unset_lock_25 (omp_lock_25_arg (lock
));
252 gomp_unset_nest_lock__25 (omp_nest_lock_25_arg_t lock
)
254 gomp_unset_nest_lock_25 (omp_nest_lock_25_arg (lock
));
258 gomp_test_lock__25 (omp_lock_25_arg_t lock
)
260 return gomp_test_lock_25 (omp_lock_25_arg (lock
));
264 gomp_test_nest_lock__25 (omp_nest_lock_25_arg_t lock
)
266 return gomp_test_nest_lock_25 (omp_nest_lock_25_arg (lock
));
269 omp_lock_symver (omp_init_lock_
)
270 omp_lock_symver (omp_destroy_lock_
)
271 omp_lock_symver (omp_set_lock_
)
272 omp_lock_symver (omp_unset_lock_
)
273 omp_lock_symver (omp_test_lock_
)
274 omp_lock_symver (omp_init_nest_lock_
)
275 omp_lock_symver (omp_destroy_nest_lock_
)
276 omp_lock_symver (omp_set_nest_lock_
)
277 omp_lock_symver (omp_unset_nest_lock_
)
278 omp_lock_symver (omp_test_nest_lock_
)
281 #define TO_INT(x) ((x) > INT_MIN ? (x) < INT_MAX ? (x) : INT_MAX : INT_MIN)
284 omp_set_dynamic_ (const int32_t *set
)
286 omp_set_dynamic (*set
);
290 omp_set_dynamic_8_ (const int64_t *set
)
292 omp_set_dynamic (!!*set
);
295 #pragma GCC diagnostic push
296 #pragma GCC diagnostic ignored "-Wdeprecated-declarations"
298 omp_set_nested_ (const int32_t *set
)
300 omp_set_nested (*set
);
304 omp_set_nested_8_ (const int64_t *set
)
306 omp_set_nested (!!*set
);
308 #pragma GCC diagnostic pop
311 omp_set_num_threads_ (const int32_t *set
)
313 omp_set_num_threads (*set
);
317 omp_set_num_threads_8_ (const int64_t *set
)
319 omp_set_num_threads (TO_INT (*set
));
323 omp_get_dynamic_ (void)
325 return omp_get_dynamic ();
328 #pragma GCC diagnostic push
329 #pragma GCC diagnostic ignored "-Wdeprecated-declarations"
331 omp_get_nested_ (void)
333 return omp_get_nested ();
335 #pragma GCC diagnostic pop
338 omp_in_parallel_ (void)
340 return omp_in_parallel ();
344 omp_get_max_threads_ (void)
346 return omp_get_max_threads ();
350 omp_get_num_procs_ (void)
352 return omp_get_num_procs ();
356 omp_get_num_threads_ (void)
358 return omp_get_num_threads ();
362 omp_get_thread_num_ (void)
364 return omp_get_thread_num ();
368 omp_get_wtick_ (void)
370 return omp_get_wtick ();
374 omp_get_wtime_ (void)
376 return omp_get_wtime ();
380 omp_set_schedule_ (const int32_t *kind
, const int32_t *chunk_size
)
382 omp_set_schedule (*kind
, *chunk_size
);
386 omp_set_schedule_8_ (const int32_t *kind
, const int64_t *chunk_size
)
388 omp_set_schedule (*kind
, TO_INT (*chunk_size
));
392 omp_get_schedule_ (int32_t *kind
, int32_t *chunk_size
)
396 omp_get_schedule (&k
, &cs
);
397 /* For now mask off GFS_MONOTONIC, because OpenMP 4.5 code will not
399 *kind
= k
& ~GFS_MONOTONIC
;
404 omp_get_schedule_8_ (int32_t *kind
, int64_t *chunk_size
)
408 omp_get_schedule (&k
, &cs
);
410 *kind
= k
& ~GFS_MONOTONIC
;
415 omp_get_thread_limit_ (void)
417 return omp_get_thread_limit ();
421 omp_set_max_active_levels_ (const int32_t *levels
)
423 omp_set_max_active_levels (*levels
);
427 omp_set_max_active_levels_8_ (const int64_t *levels
)
429 omp_set_max_active_levels (TO_INT (*levels
));
433 omp_get_max_active_levels_ (void)
435 return omp_get_max_active_levels ();
439 omp_get_supported_active_levels_ (void)
441 return omp_get_supported_active_levels ();
445 omp_get_level_ (void)
447 return omp_get_level ();
451 omp_get_ancestor_thread_num_ (const int32_t *level
)
453 return omp_get_ancestor_thread_num (*level
);
457 omp_get_ancestor_thread_num_8_ (const int64_t *level
)
459 return omp_get_ancestor_thread_num (TO_INT (*level
));
463 omp_get_team_size_ (const int32_t *level
)
465 return omp_get_team_size (*level
);
469 omp_get_team_size_8_ (const int64_t *level
)
471 return omp_get_team_size (TO_INT (*level
));
475 omp_get_active_level_ (void)
477 return omp_get_active_level ();
483 return omp_in_final ();
487 omp_in_explicit_task_ (void)
489 return omp_in_explicit_task ();
493 omp_set_num_teams_ (const int32_t *num_teams
)
495 omp_set_num_teams (*num_teams
);
499 omp_set_num_teams_8_ (const int64_t *num_teams
)
501 omp_set_num_teams (TO_INT (*num_teams
));
505 omp_get_max_teams_ (void)
507 return omp_get_max_teams ();
511 omp_set_teams_thread_limit_ (const int32_t *thread_limit
)
513 omp_set_teams_thread_limit (*thread_limit
);
517 omp_set_teams_thread_limit_8_ (const int64_t *thread_limit
)
519 omp_set_teams_thread_limit (TO_INT (*thread_limit
));
523 omp_get_teams_thread_limit_ (void)
525 return omp_get_teams_thread_limit ();
529 omp_get_cancellation_ (void)
531 return omp_get_cancellation ();
535 omp_get_proc_bind_ (void)
537 return omp_get_proc_bind ();
541 omp_get_num_places_ (void)
543 return omp_get_num_places ();
547 omp_get_place_num_procs_ (const int32_t *place_num
)
549 return omp_get_place_num_procs (*place_num
);
553 omp_get_place_num_procs_8_ (const int64_t *place_num
)
555 return omp_get_place_num_procs (TO_INT (*place_num
));
559 omp_get_place_proc_ids_ (const int32_t *place_num
, int32_t *ids
)
561 omp_get_place_proc_ids (*place_num
, (int *) ids
);
565 omp_get_place_proc_ids_8_ (const int64_t *place_num
, int64_t *ids
)
567 gomp_get_place_proc_ids_8 (TO_INT (*place_num
), ids
);
571 omp_get_place_num_ (void)
573 return omp_get_place_num ();
577 omp_get_partition_num_places_ (void)
579 return omp_get_partition_num_places ();
583 omp_get_partition_place_nums_ (int32_t *place_nums
)
585 omp_get_partition_place_nums ((int *) place_nums
);
589 omp_get_partition_place_nums_8_ (int64_t *place_nums
)
591 if (gomp_places_list
== NULL
)
594 struct gomp_thread
*thr
= gomp_thread ();
596 gomp_init_affinity ();
599 for (i
= 0; i
< thr
->ts
.place_partition_len
; i
++)
600 *place_nums
++ = (int64_t) thr
->ts
.place_partition_off
+ i
;
604 omp_set_default_device_ (const int32_t *device_num
)
606 return omp_set_default_device (*device_num
);
610 omp_set_default_device_8_ (const int64_t *device_num
)
612 return omp_set_default_device (TO_INT (*device_num
));
616 omp_get_default_device_ (void)
618 return omp_get_default_device ();
622 omp_get_num_devices_ (void)
624 return omp_get_num_devices ();
628 omp_get_num_teams_ (void)
630 return omp_get_num_teams ();
634 omp_get_team_num_ (void)
636 return omp_get_team_num ();
640 omp_is_initial_device_ (void)
642 return omp_is_initial_device ();
646 omp_get_initial_device_ (void)
648 return omp_get_initial_device ();
652 omp_get_device_num_ (void)
654 return omp_get_device_num ();
658 omp_get_max_task_priority_ (void)
660 return omp_get_max_task_priority ();
664 omp_fulfill_event_ (intptr_t event
)
666 omp_fulfill_event ((omp_event_handle_t
) event
);
670 omp_set_affinity_format_ (const char *format
, size_t format_len
)
672 gomp_set_affinity_format (format
, format_len
);
676 omp_get_affinity_format_ (char *buffer
, size_t buffer_len
)
678 size_t len
= strlen (gomp_affinity_format_var
);
681 if (len
< buffer_len
)
683 memcpy (buffer
, gomp_affinity_format_var
, len
);
684 memset (buffer
+ len
, ' ', buffer_len
- len
);
687 memcpy (buffer
, gomp_affinity_format_var
, buffer_len
);
693 omp_display_affinity_ (const char *format
, size_t format_len
)
695 char *fmt
= NULL
, fmt_buf
[256];
699 fmt
= format_len
< 256 ? fmt_buf
: gomp_malloc (format_len
+ 1);
700 memcpy (fmt
, format
, format_len
);
701 fmt
[format_len
] = '\0';
703 struct gomp_thread
*thr
= gomp_thread ();
705 = gomp_display_affinity (buf
, sizeof buf
,
706 format_len
? fmt
: gomp_affinity_format_var
,
707 gomp_thread_self (), &thr
->ts
, thr
->place
);
708 if (ret
< sizeof buf
)
711 gomp_print_string (buf
, ret
+ 1);
715 char *b
= gomp_malloc (ret
+ 1);
716 gomp_display_affinity (buf
, sizeof buf
,
717 format_len
? fmt
: gomp_affinity_format_var
,
718 gomp_thread_self (), &thr
->ts
, thr
->place
);
720 gomp_print_string (b
, ret
+ 1);
723 if (fmt
&& fmt
!= fmt_buf
)
728 omp_capture_affinity_ (char *buffer
, const char *format
,
729 size_t buffer_len
, size_t format_len
)
731 char *fmt
= NULL
, fmt_buf
[256];
734 fmt
= format_len
< 256 ? fmt_buf
: gomp_malloc (format_len
+ 1);
735 memcpy (fmt
, format
, format_len
);
736 fmt
[format_len
] = '\0';
738 struct gomp_thread
*thr
= gomp_thread ();
740 = gomp_display_affinity (buffer
, buffer_len
,
741 format_len
? fmt
: gomp_affinity_format_var
,
742 gomp_thread_self (), &thr
->ts
, thr
->place
);
743 if (fmt
&& fmt
!= fmt_buf
)
745 if (ret
< buffer_len
)
746 memset (buffer
+ ret
, ' ', buffer_len
- ret
);
751 omp_pause_resource_ (const int32_t *kind
, const int32_t *device_num
)
753 return omp_pause_resource (*kind
, *device_num
);
757 omp_pause_resource_all_ (const int32_t *kind
)
759 return omp_pause_resource_all (*kind
);
763 omp_init_allocator_ (const intptr_t *memspace
, const int32_t *ntraits
,
764 const omp_alloctrait_t
*traits
)
766 return (intptr_t) omp_init_allocator ((omp_memspace_handle_t
) *memspace
,
767 (int) *ntraits
, traits
);
771 omp_init_allocator_8_ (const intptr_t *memspace
, const int64_t *ntraits
,
772 const omp_alloctrait_t
*traits
)
774 return (intptr_t) omp_init_allocator ((omp_memspace_handle_t
) *memspace
,
775 (int) *ntraits
, traits
);
779 omp_destroy_allocator_ (const intptr_t *allocator
)
781 omp_destroy_allocator ((omp_allocator_handle_t
) *allocator
);
785 omp_set_default_allocator_ (const intptr_t *allocator
)
787 omp_set_default_allocator ((omp_allocator_handle_t
) *allocator
);
791 omp_get_default_allocator_ ()
793 return (intptr_t) omp_get_default_allocator ();
796 #ifndef LIBGOMP_OFFLOADED_ONLY
799 omp_display_env_ (const int32_t *verbose
)
801 omp_display_env (*verbose
);
805 omp_display_env_8_ (const int64_t *verbose
)
807 omp_display_env (!!*verbose
);
810 #endif /* LIBGOMP_OFFLOADED_ONLY */