LLVM OpenMP* Runtime Library
Loading...
Searching...
No Matches
kmp_ftn_entry.h
1/*
2 * kmp_ftn_entry.h -- Fortran entry linkage support for OpenMP.
3 */
4
5//===----------------------------------------------------------------------===//
6//
7// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
8// See https://llvm.org/LICENSE.txt for license information.
9// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
10//
11//===----------------------------------------------------------------------===//
12
13#ifndef FTN_STDCALL
14#error The support file kmp_ftn_entry.h should not be compiled by itself.
15#endif
16
17#ifdef KMP_STUB
18#include "kmp_stub.h"
19#endif
20
21#include "kmp_i18n.h"
22
23// For affinity format functions
24#include "kmp_io.h"
25#include "kmp_str.h"
26
27#if OMPT_SUPPORT
28#include "ompt-specific.h"
29#endif
30
31#ifdef __cplusplus
32extern "C" {
33#endif // __cplusplus
34
35/* For compatibility with the Gnu/MS Open MP codegen, omp_set_num_threads(),
36 * omp_set_nested(), and omp_set_dynamic() [in lowercase on MS, and w/o
37 * a trailing underscore on Linux* OS] take call by value integer arguments.
38 * + omp_set_max_active_levels()
39 * + omp_set_schedule()
40 *
41 * For backward compatibility with 9.1 and previous Intel compiler, these
42 * entry points take call by reference integer arguments. */
43#ifdef KMP_GOMP_COMPAT
44#if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_UPPER)
45#define PASS_ARGS_BY_VALUE 1
46#endif
47#endif
48#if KMP_OS_WINDOWS
49#if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_APPEND)
50#define PASS_ARGS_BY_VALUE 1
51#endif
52#endif
53
54// This macro helps to reduce code duplication.
55#ifdef PASS_ARGS_BY_VALUE
56#define KMP_DEREF
57#else
58#define KMP_DEREF *
59#endif
60
61// For API with specific C vs. Fortran interfaces (ompc_* exists in
62// kmp_csupport.cpp), only create GOMP versioned symbols of the API for the
63// APPEND Fortran entries in this file. The GOMP versioned symbols of the C API
64// will take place where the ompc_* functions are defined.
65#if KMP_FTN_ENTRIES == KMP_FTN_APPEND
66#define KMP_EXPAND_NAME_IF_APPEND(name) KMP_EXPAND_NAME(name)
67#else
68#define KMP_EXPAND_NAME_IF_APPEND(name) name
69#endif
70
71void FTN_STDCALL FTN_SET_STACKSIZE(int KMP_DEREF arg) {
72#ifdef KMP_STUB
73 __kmps_set_stacksize(KMP_DEREF arg);
74#else
75 // __kmp_aux_set_stacksize initializes the library if needed
76 __kmp_aux_set_stacksize((size_t)KMP_DEREF arg);
77#endif
78}
79
80void FTN_STDCALL FTN_SET_STACKSIZE_S(size_t KMP_DEREF arg) {
81#ifdef KMP_STUB
82 __kmps_set_stacksize(KMP_DEREF arg);
83#else
84 // __kmp_aux_set_stacksize initializes the library if needed
85 __kmp_aux_set_stacksize(KMP_DEREF arg);
86#endif
87}
88
89int FTN_STDCALL FTN_GET_STACKSIZE(void) {
90#ifdef KMP_STUB
91 return (int)__kmps_get_stacksize();
92#else
93 if (!__kmp_init_serial) {
94 __kmp_serial_initialize();
95 }
96 return (int)__kmp_stksize;
97#endif
98}
99
100size_t FTN_STDCALL FTN_GET_STACKSIZE_S(void) {
101#ifdef KMP_STUB
102 return __kmps_get_stacksize();
103#else
104 if (!__kmp_init_serial) {
105 __kmp_serial_initialize();
106 }
107 return __kmp_stksize;
108#endif
109}
110
111void FTN_STDCALL FTN_SET_BLOCKTIME(int KMP_DEREF arg) {
112#ifdef KMP_STUB
113 __kmps_set_blocktime(KMP_DEREF arg);
114#else
115 int gtid, tid;
116 kmp_info_t *thread;
117
118 gtid = __kmp_entry_gtid();
119 tid = __kmp_tid_from_gtid(gtid);
120 thread = __kmp_thread_from_gtid(gtid);
121
122 __kmp_aux_set_blocktime(KMP_DEREF arg, thread, tid);
123#endif
124}
125
126int FTN_STDCALL FTN_GET_BLOCKTIME(void) {
127#ifdef KMP_STUB
128 return __kmps_get_blocktime();
129#else
130 int gtid, tid;
131 kmp_team_p *team;
132
133 gtid = __kmp_entry_gtid();
134 tid = __kmp_tid_from_gtid(gtid);
135 team = __kmp_threads[gtid]->th.th_team;
136
137 /* These must match the settings used in __kmp_wait_sleep() */
138 if (__kmp_dflt_blocktime == KMP_MAX_BLOCKTIME) {
139 KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n", gtid,
140 team->t.t_id, tid, KMP_MAX_BLOCKTIME));
141 return KMP_MAX_BLOCKTIME;
142 }
143#ifdef KMP_ADJUST_BLOCKTIME
144 else if (__kmp_zero_bt && !get__bt_set(team, tid)) {
145 KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n", gtid,
146 team->t.t_id, tid, 0));
147 return 0;
148 }
149#endif /* KMP_ADJUST_BLOCKTIME */
150 else {
151 KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n", gtid,
152 team->t.t_id, tid, get__blocktime(team, tid)));
153 return get__blocktime(team, tid);
154 }
155#endif
156}
157
158void FTN_STDCALL FTN_SET_LIBRARY_SERIAL(void) {
159#ifdef KMP_STUB
160 __kmps_set_library(library_serial);
161#else
162 // __kmp_user_set_library initializes the library if needed
163 __kmp_user_set_library(library_serial);
164#endif
165}
166
167void FTN_STDCALL FTN_SET_LIBRARY_TURNAROUND(void) {
168#ifdef KMP_STUB
169 __kmps_set_library(library_turnaround);
170#else
171 // __kmp_user_set_library initializes the library if needed
172 __kmp_user_set_library(library_turnaround);
173#endif
174}
175
176void FTN_STDCALL FTN_SET_LIBRARY_THROUGHPUT(void) {
177#ifdef KMP_STUB
178 __kmps_set_library(library_throughput);
179#else
180 // __kmp_user_set_library initializes the library if needed
181 __kmp_user_set_library(library_throughput);
182#endif
183}
184
185void FTN_STDCALL FTN_SET_LIBRARY(int KMP_DEREF arg) {
186#ifdef KMP_STUB
187 __kmps_set_library(KMP_DEREF arg);
188#else
189 enum library_type lib;
190 lib = (enum library_type)KMP_DEREF arg;
191 // __kmp_user_set_library initializes the library if needed
192 __kmp_user_set_library(lib);
193#endif
194}
195
196int FTN_STDCALL FTN_GET_LIBRARY(void) {
197#ifdef KMP_STUB
198 return __kmps_get_library();
199#else
200 if (!__kmp_init_serial) {
201 __kmp_serial_initialize();
202 }
203 return ((int)__kmp_library);
204#endif
205}
206
207void FTN_STDCALL FTN_SET_DISP_NUM_BUFFERS(int KMP_DEREF arg) {
208#ifdef KMP_STUB
209 ; // empty routine
210#else
211 // ignore after initialization because some teams have already
212 // allocated dispatch buffers
213 int num_buffers = KMP_DEREF arg;
214 if (__kmp_init_serial == FALSE && num_buffers >= KMP_MIN_DISP_NUM_BUFF &&
215 num_buffers <= KMP_MAX_DISP_NUM_BUFF) {
216 __kmp_dispatch_num_buffers = num_buffers;
217 }
218#endif
219}
220
221int FTN_STDCALL FTN_SET_AFFINITY(void **mask) {
222#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
223 return -1;
224#else
225 if (!TCR_4(__kmp_init_middle)) {
226 __kmp_middle_initialize();
227 }
228 __kmp_assign_root_init_mask();
229 return __kmp_aux_set_affinity(mask);
230#endif
231}
232
233int FTN_STDCALL FTN_GET_AFFINITY(void **mask) {
234#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
235 return -1;
236#else
237 if (!TCR_4(__kmp_init_middle)) {
238 __kmp_middle_initialize();
239 }
240 __kmp_assign_root_init_mask();
241 return __kmp_aux_get_affinity(mask);
242#endif
243}
244
245int FTN_STDCALL FTN_GET_AFFINITY_MAX_PROC(void) {
246#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
247 return 0;
248#else
249 // We really only NEED serial initialization here.
250 if (!TCR_4(__kmp_init_middle)) {
251 __kmp_middle_initialize();
252 }
253 __kmp_assign_root_init_mask();
254 return __kmp_aux_get_affinity_max_proc();
255#endif
256}
257
258void FTN_STDCALL FTN_CREATE_AFFINITY_MASK(void **mask) {
259#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
260 *mask = NULL;
261#else
262 // We really only NEED serial initialization here.
263 kmp_affin_mask_t *mask_internals;
264 if (!TCR_4(__kmp_init_middle)) {
265 __kmp_middle_initialize();
266 }
267 __kmp_assign_root_init_mask();
268 mask_internals = __kmp_affinity_dispatch->allocate_mask();
269 KMP_CPU_ZERO(mask_internals);
270 *mask = mask_internals;
271#endif
272}
273
274void FTN_STDCALL FTN_DESTROY_AFFINITY_MASK(void **mask) {
275#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
276// Nothing
277#else
278 // We really only NEED serial initialization here.
279 kmp_affin_mask_t *mask_internals;
280 if (!TCR_4(__kmp_init_middle)) {
281 __kmp_middle_initialize();
282 }
283 __kmp_assign_root_init_mask();
284 if (__kmp_env_consistency_check) {
285 if (*mask == NULL) {
286 KMP_FATAL(AffinityInvalidMask, "kmp_destroy_affinity_mask");
287 }
288 }
289 mask_internals = (kmp_affin_mask_t *)(*mask);
290 __kmp_affinity_dispatch->deallocate_mask(mask_internals);
291 *mask = NULL;
292#endif
293}
294
295int FTN_STDCALL FTN_SET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
296#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
297 return -1;
298#else
299 if (!TCR_4(__kmp_init_middle)) {
300 __kmp_middle_initialize();
301 }
302 __kmp_assign_root_init_mask();
303 return __kmp_aux_set_affinity_mask_proc(KMP_DEREF proc, mask);
304#endif
305}
306
307int FTN_STDCALL FTN_UNSET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
308#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
309 return -1;
310#else
311 if (!TCR_4(__kmp_init_middle)) {
312 __kmp_middle_initialize();
313 }
314 __kmp_assign_root_init_mask();
315 return __kmp_aux_unset_affinity_mask_proc(KMP_DEREF proc, mask);
316#endif
317}
318
319int FTN_STDCALL FTN_GET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
320#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
321 return -1;
322#else
323 if (!TCR_4(__kmp_init_middle)) {
324 __kmp_middle_initialize();
325 }
326 __kmp_assign_root_init_mask();
327 return __kmp_aux_get_affinity_mask_proc(KMP_DEREF proc, mask);
328#endif
329}
330
331/* ------------------------------------------------------------------------ */
332
333/* sets the requested number of threads for the next parallel region */
334void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NUM_THREADS)(int KMP_DEREF arg) {
335#ifdef KMP_STUB
336// Nothing.
337#else
338 __kmp_set_num_threads(KMP_DEREF arg, __kmp_entry_gtid());
339#endif
340}
341
342/* returns the number of threads in current team */
343int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_THREADS)(void) {
344#ifdef KMP_STUB
345 return 1;
346#else
347 // __kmpc_bound_num_threads initializes the library if needed
348 return __kmpc_bound_num_threads(NULL);
349#endif
350}
351
352int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_THREADS)(void) {
353#ifdef KMP_STUB
354 return 1;
355#else
356 int gtid;
357 kmp_info_t *thread;
358 if (!TCR_4(__kmp_init_middle)) {
359 __kmp_middle_initialize();
360 }
361 __kmp_assign_root_init_mask();
362 gtid = __kmp_entry_gtid();
363 thread = __kmp_threads[gtid];
364 // return thread -> th.th_team -> t.t_current_task[
365 // thread->th.th_info.ds.ds_tid ] -> icvs.nproc;
366 return thread->th.th_current_task->td_icvs.nproc;
367#endif
368}
369
370int FTN_STDCALL FTN_CONTROL_TOOL(int command, int modifier, void *arg) {
371#if defined(KMP_STUB) || !OMPT_SUPPORT
372 return -2;
373#else
374 OMPT_STORE_RETURN_ADDRESS(__kmp_entry_gtid());
375 if (!TCR_4(__kmp_init_middle)) {
376 return -2;
377 }
378 kmp_info_t *this_thr = __kmp_threads[__kmp_entry_gtid()];
379 ompt_task_info_t *parent_task_info = OMPT_CUR_TASK_INFO(this_thr);
380 parent_task_info->frame.enter_frame.ptr = OMPT_GET_FRAME_ADDRESS(0);
381 int ret = __kmp_control_tool(command, modifier, arg);
382 parent_task_info->frame.enter_frame.ptr = 0;
383 return ret;
384#endif
385}
386
387/* OpenMP 5.0 Memory Management support */
388omp_allocator_handle_t FTN_STDCALL
389FTN_INIT_ALLOCATOR(omp_memspace_handle_t KMP_DEREF m, int KMP_DEREF ntraits,
390 omp_alloctrait_t tr[]) {
391#ifdef KMP_STUB
392 return NULL;
393#else
394 return __kmpc_init_allocator(__kmp_entry_gtid(), KMP_DEREF m,
395 KMP_DEREF ntraits, tr);
396#endif
397}
398
399void FTN_STDCALL FTN_DESTROY_ALLOCATOR(omp_allocator_handle_t al) {
400#ifndef KMP_STUB
401 __kmpc_destroy_allocator(__kmp_entry_gtid(), al);
402#endif
403}
404void FTN_STDCALL FTN_SET_DEFAULT_ALLOCATOR(omp_allocator_handle_t al) {
405#ifndef KMP_STUB
406 __kmpc_set_default_allocator(__kmp_entry_gtid(), al);
407#endif
408}
409omp_allocator_handle_t FTN_STDCALL FTN_GET_DEFAULT_ALLOCATOR(void) {
410#ifdef KMP_STUB
411 return NULL;
412#else
413 return __kmpc_get_default_allocator(__kmp_entry_gtid());
414#endif
415}
416
417/* OpenMP 5.0 affinity format support */
418#ifndef KMP_STUB
419static void __kmp_fortran_strncpy_truncate(char *buffer, size_t buf_size,
420 char const *csrc, size_t csrc_size) {
421 size_t capped_src_size = csrc_size;
422 if (csrc_size >= buf_size) {
423 capped_src_size = buf_size - 1;
424 }
425 KMP_STRNCPY_S(buffer, buf_size, csrc, capped_src_size);
426 if (csrc_size >= buf_size) {
427 KMP_DEBUG_ASSERT(buffer[buf_size - 1] == '\0');
428 buffer[buf_size - 1] = csrc[buf_size - 1];
429 } else {
430 for (size_t i = csrc_size; i < buf_size; ++i)
431 buffer[i] = ' ';
432 }
433}
434
435// Convert a Fortran string to a C string by adding null byte
436class ConvertedString {
437 char *buf;
438 kmp_info_t *th;
439
440public:
441 ConvertedString(char const *fortran_str, size_t size) {
442 th = __kmp_get_thread();
443 buf = (char *)__kmp_thread_malloc(th, size + 1);
444 KMP_STRNCPY_S(buf, size + 1, fortran_str, size);
445 buf[size] = '\0';
446 }
447 ~ConvertedString() { __kmp_thread_free(th, buf); }
448 const char *get() const { return buf; }
449};
450#endif // KMP_STUB
451
452/*
453 * Set the value of the affinity-format-var ICV on the current device to the
454 * format specified in the argument.
455 */
456void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_SET_AFFINITY_FORMAT)(
457 char const *format, size_t size) {
458#ifdef KMP_STUB
459 return;
460#else
461 if (!__kmp_init_serial) {
462 __kmp_serial_initialize();
463 }
464 ConvertedString cformat(format, size);
465 // Since the __kmp_affinity_format variable is a C string, do not
466 // use the fortran strncpy function
467 __kmp_strncpy_truncate(__kmp_affinity_format, KMP_AFFINITY_FORMAT_SIZE,
468 cformat.get(), KMP_STRLEN(cformat.get()));
469#endif
470}
471
472/*
473 * Returns the number of characters required to hold the entire affinity format
474 * specification (not including null byte character) and writes the value of the
475 * affinity-format-var ICV on the current device to buffer. If the return value
476 * is larger than size, the affinity format specification is truncated.
477 */
478size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_GET_AFFINITY_FORMAT)(
479 char *buffer, size_t size) {
480#ifdef KMP_STUB
481 return 0;
482#else
483 size_t format_size;
484 if (!__kmp_init_serial) {
485 __kmp_serial_initialize();
486 }
487 format_size = KMP_STRLEN(__kmp_affinity_format);
488 if (buffer && size) {
489 __kmp_fortran_strncpy_truncate(buffer, size, __kmp_affinity_format,
490 format_size);
491 }
492 return format_size;
493#endif
494}
495
496/*
497 * Prints the thread affinity information of the current thread in the format
498 * specified by the format argument. If the format is NULL or a zero-length
499 * string, the value of the affinity-format-var ICV is used.
500 */
501void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_DISPLAY_AFFINITY)(
502 char const *format, size_t size) {
503#ifdef KMP_STUB
504 return;
505#else
506 int gtid;
507 if (!TCR_4(__kmp_init_middle)) {
508 __kmp_middle_initialize();
509 }
510 __kmp_assign_root_init_mask();
511 gtid = __kmp_get_gtid();
512 ConvertedString cformat(format, size);
513 __kmp_aux_display_affinity(gtid, cformat.get());
514#endif
515}
516
517/*
518 * Returns the number of characters required to hold the entire affinity format
519 * specification (not including null byte) and prints the thread affinity
520 * information of the current thread into the character string buffer with the
521 * size of size in the format specified by the format argument. If the format is
522 * NULL or a zero-length string, the value of the affinity-format-var ICV is
523 * used. The buffer must be allocated prior to calling the routine. If the
524 * return value is larger than size, the affinity format specification is
525 * truncated.
526 */
527size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_CAPTURE_AFFINITY)(
528 char *buffer, char const *format, size_t buf_size, size_t for_size) {
529#if defined(KMP_STUB)
530 return 0;
531#else
532 int gtid;
533 size_t num_required;
534 kmp_str_buf_t capture_buf;
535 if (!TCR_4(__kmp_init_middle)) {
536 __kmp_middle_initialize();
537 }
538 __kmp_assign_root_init_mask();
539 gtid = __kmp_get_gtid();
540 __kmp_str_buf_init(&capture_buf);
541 ConvertedString cformat(format, for_size);
542 num_required = __kmp_aux_capture_affinity(gtid, cformat.get(), &capture_buf);
543 if (buffer && buf_size) {
544 __kmp_fortran_strncpy_truncate(buffer, buf_size, capture_buf.str,
545 capture_buf.used);
546 }
547 __kmp_str_buf_free(&capture_buf);
548 return num_required;
549#endif
550}
551
552int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_NUM)(void) {
553#ifdef KMP_STUB
554 return 0;
555#else
556 int gtid;
557
558#if KMP_OS_DARWIN || KMP_OS_DRAGONFLY || KMP_OS_FREEBSD || KMP_OS_NETBSD || \
559 KMP_OS_HURD || KMP_OS_OPENBSD
560 gtid = __kmp_entry_gtid();
561#elif KMP_OS_WINDOWS
562 if (!__kmp_init_parallel ||
563 (gtid = (int)((kmp_intptr_t)TlsGetValue(__kmp_gtid_threadprivate_key))) ==
564 0) {
565 // Either library isn't initialized or thread is not registered
566 // 0 is the correct TID in this case
567 return 0;
568 }
569 --gtid; // We keep (gtid+1) in TLS
570#elif KMP_OS_LINUX
571#ifdef KMP_TDATA_GTID
572 if (__kmp_gtid_mode >= 3) {
573 if ((gtid = __kmp_gtid) == KMP_GTID_DNE) {
574 return 0;
575 }
576 } else {
577#endif
578 if (!__kmp_init_parallel ||
579 (gtid = (int)((kmp_intptr_t)(
580 pthread_getspecific(__kmp_gtid_threadprivate_key)))) == 0) {
581 return 0;
582 }
583 --gtid;
584#ifdef KMP_TDATA_GTID
585 }
586#endif
587#else
588#error Unknown or unsupported OS
589#endif
590
591 return __kmp_tid_from_gtid(gtid);
592#endif
593}
594
595int FTN_STDCALL FTN_GET_NUM_KNOWN_THREADS(void) {
596#ifdef KMP_STUB
597 return 1;
598#else
599 if (!__kmp_init_serial) {
600 __kmp_serial_initialize();
601 }
602 /* NOTE: this is not syncronized, so it can change at any moment */
603 /* NOTE: this number also includes threads preallocated in hot-teams */
604 return TCR_4(__kmp_nth);
605#endif
606}
607
608int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PROCS)(void) {
609#ifdef KMP_STUB
610 return 1;
611#else
612 if (!TCR_4(__kmp_init_middle)) {
613 __kmp_middle_initialize();
614 }
615 __kmp_assign_root_init_mask();
616 return __kmp_avail_proc;
617#endif
618}
619
620void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NESTED)(int KMP_DEREF flag) {
621#ifdef KMP_STUB
622 __kmps_set_nested(KMP_DEREF flag);
623#else
624 kmp_info_t *thread;
625 /* For the thread-private internal controls implementation */
626 thread = __kmp_entry_thread();
627 KMP_INFORM(APIDeprecated, "omp_set_nested", "omp_set_max_active_levels");
628 __kmp_save_internal_controls(thread);
629 // Somewhat arbitrarily decide where to get a value for max_active_levels
630 int max_active_levels = get__max_active_levels(thread);
631 if (max_active_levels == 1)
632 max_active_levels = KMP_MAX_ACTIVE_LEVELS_LIMIT;
633 set__max_active_levels(thread, (KMP_DEREF flag) ? max_active_levels : 1);
634#endif
635}
636
637int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NESTED)(void) {
638#ifdef KMP_STUB
639 return __kmps_get_nested();
640#else
641 kmp_info_t *thread;
642 thread = __kmp_entry_thread();
643 KMP_INFORM(APIDeprecated, "omp_get_nested", "omp_get_max_active_levels");
644 return get__max_active_levels(thread) > 1;
645#endif
646}
647
648void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DYNAMIC)(int KMP_DEREF flag) {
649#ifdef KMP_STUB
650 __kmps_set_dynamic(KMP_DEREF flag ? TRUE : FALSE);
651#else
652 kmp_info_t *thread;
653 /* For the thread-private implementation of the internal controls */
654 thread = __kmp_entry_thread();
655 // !!! What if foreign thread calls it?
656 __kmp_save_internal_controls(thread);
657 set__dynamic(thread, KMP_DEREF flag ? true : false);
658#endif
659}
660
661int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DYNAMIC)(void) {
662#ifdef KMP_STUB
663 return __kmps_get_dynamic();
664#else
665 kmp_info_t *thread;
666 thread = __kmp_entry_thread();
667 return get__dynamic(thread);
668#endif
669}
670
671int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_PARALLEL)(void) {
672#ifdef KMP_STUB
673 return 0;
674#else
675 kmp_info_t *th = __kmp_entry_thread();
676 if (th->th.th_teams_microtask) {
677 // AC: r_in_parallel does not work inside teams construct where real
678 // parallel is inactive, but all threads have same root, so setting it in
679 // one team affects other teams.
680 // The solution is to use per-team nesting level
681 return (th->th.th_team->t.t_active_level ? 1 : 0);
682 } else
683 return (th->th.th_root->r.r_in_parallel ? FTN_TRUE : FTN_FALSE);
684#endif
685}
686
687void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_SCHEDULE)(kmp_sched_t KMP_DEREF kind,
688 int KMP_DEREF modifier) {
689#ifdef KMP_STUB
690 __kmps_set_schedule(KMP_DEREF kind, KMP_DEREF modifier);
691#else
692 /* TO DO: For the per-task implementation of the internal controls */
693 __kmp_set_schedule(__kmp_entry_gtid(), KMP_DEREF kind, KMP_DEREF modifier);
694#endif
695}
696
697void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_SCHEDULE)(kmp_sched_t *kind,
698 int *modifier) {
699#ifdef KMP_STUB
700 __kmps_get_schedule(kind, modifier);
701#else
702 /* TO DO: For the per-task implementation of the internal controls */
703 __kmp_get_schedule(__kmp_entry_gtid(), kind, modifier);
704#endif
705}
706
707void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_MAX_ACTIVE_LEVELS)(int KMP_DEREF arg) {
708#ifdef KMP_STUB
709// Nothing.
710#else
711 /* TO DO: We want per-task implementation of this internal control */
712 __kmp_set_max_active_levels(__kmp_entry_gtid(), KMP_DEREF arg);
713#endif
714}
715
716int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_ACTIVE_LEVELS)(void) {
717#ifdef KMP_STUB
718 return 0;
719#else
720 /* TO DO: We want per-task implementation of this internal control */
721 if (!TCR_4(__kmp_init_middle)) {
722 __kmp_middle_initialize();
723 }
724 return __kmp_get_max_active_levels(__kmp_entry_gtid());
725#endif
726}
727
728int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_ACTIVE_LEVEL)(void) {
729#ifdef KMP_STUB
730 return 0; // returns 0 if it is called from the sequential part of the program
731#else
732 /* TO DO: For the per-task implementation of the internal controls */
733 return __kmp_entry_thread()->th.th_team->t.t_active_level;
734#endif
735}
736
737int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_LEVEL)(void) {
738#ifdef KMP_STUB
739 return 0; // returns 0 if it is called from the sequential part of the program
740#else
741 /* TO DO: For the per-task implementation of the internal controls */
742 return __kmp_entry_thread()->th.th_team->t.t_level;
743#endif
744}
745
746int FTN_STDCALL
747KMP_EXPAND_NAME(FTN_GET_ANCESTOR_THREAD_NUM)(int KMP_DEREF level) {
748#ifdef KMP_STUB
749 return (KMP_DEREF level) ? (-1) : (0);
750#else
751 return __kmp_get_ancestor_thread_num(__kmp_entry_gtid(), KMP_DEREF level);
752#endif
753}
754
755int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_SIZE)(int KMP_DEREF level) {
756#ifdef KMP_STUB
757 return (KMP_DEREF level) ? (-1) : (1);
758#else
759 return __kmp_get_team_size(__kmp_entry_gtid(), KMP_DEREF level);
760#endif
761}
762
763int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_LIMIT)(void) {
764#ifdef KMP_STUB
765 return 1; // TO DO: clarify whether it returns 1 or 0?
766#else
767 int gtid;
768 kmp_info_t *thread;
769 if (!__kmp_init_serial) {
770 __kmp_serial_initialize();
771 }
772
773 gtid = __kmp_entry_gtid();
774 thread = __kmp_threads[gtid];
775 return thread->th.th_current_task->td_icvs.thread_limit;
776#endif
777}
778
779int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_FINAL)(void) {
780#ifdef KMP_STUB
781 return 0; // TO DO: clarify whether it returns 1 or 0?
782#else
783 if (!TCR_4(__kmp_init_parallel)) {
784 return 0;
785 }
786 return __kmp_entry_thread()->th.th_current_task->td_flags.final;
787#endif
788}
789
790kmp_proc_bind_t FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PROC_BIND)(void) {
791#ifdef KMP_STUB
792 return __kmps_get_proc_bind();
793#else
794 return get__proc_bind(__kmp_entry_thread());
795#endif
796}
797
798int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PLACES)(void) {
799#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
800 return 0;
801#else
802 if (!TCR_4(__kmp_init_middle)) {
803 __kmp_middle_initialize();
804 }
805 __kmp_assign_root_init_mask();
806 if (!KMP_AFFINITY_CAPABLE())
807 return 0;
808 return __kmp_affinity_num_masks;
809#endif
810}
811
812int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM_PROCS)(int place_num) {
813#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
814 return 0;
815#else
816 int i;
817 int retval = 0;
818 if (!TCR_4(__kmp_init_middle)) {
819 __kmp_middle_initialize();
820 }
821 __kmp_assign_root_init_mask();
822 if (!KMP_AFFINITY_CAPABLE())
823 return 0;
824 if (place_num < 0 || place_num >= (int)__kmp_affinity_num_masks)
825 return 0;
826 kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity_masks, place_num);
827 KMP_CPU_SET_ITERATE(i, mask) {
828 if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||
829 (!KMP_CPU_ISSET(i, mask))) {
830 continue;
831 }
832 ++retval;
833 }
834 return retval;
835#endif
836}
837
838void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_PROC_IDS)(int place_num,
839 int *ids) {
840#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
841// Nothing.
842#else
843 int i, j;
844 if (!TCR_4(__kmp_init_middle)) {
845 __kmp_middle_initialize();
846 }
847 __kmp_assign_root_init_mask();
848 if (!KMP_AFFINITY_CAPABLE())
849 return;
850 if (place_num < 0 || place_num >= (int)__kmp_affinity_num_masks)
851 return;
852 kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity_masks, place_num);
853 j = 0;
854 KMP_CPU_SET_ITERATE(i, mask) {
855 if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||
856 (!KMP_CPU_ISSET(i, mask))) {
857 continue;
858 }
859 ids[j++] = i;
860 }
861#endif
862}
863
864int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM)(void) {
865#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
866 return -1;
867#else
868 int gtid;
869 kmp_info_t *thread;
870 if (!TCR_4(__kmp_init_middle)) {
871 __kmp_middle_initialize();
872 }
873 __kmp_assign_root_init_mask();
874 if (!KMP_AFFINITY_CAPABLE())
875 return -1;
876 gtid = __kmp_entry_gtid();
877 thread = __kmp_thread_from_gtid(gtid);
878 if (thread->th.th_current_place < 0)
879 return -1;
880 return thread->th.th_current_place;
881#endif
882}
883
884int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PARTITION_NUM_PLACES)(void) {
885#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
886 return 0;
887#else
888 int gtid, num_places, first_place, last_place;
889 kmp_info_t *thread;
890 if (!TCR_4(__kmp_init_middle)) {
891 __kmp_middle_initialize();
892 }
893 __kmp_assign_root_init_mask();
894 if (!KMP_AFFINITY_CAPABLE())
895 return 0;
896 gtid = __kmp_entry_gtid();
897 thread = __kmp_thread_from_gtid(gtid);
898 first_place = thread->th.th_first_place;
899 last_place = thread->th.th_last_place;
900 if (first_place < 0 || last_place < 0)
901 return 0;
902 if (first_place <= last_place)
903 num_places = last_place - first_place + 1;
904 else
905 num_places = __kmp_affinity_num_masks - first_place + last_place + 1;
906 return num_places;
907#endif
908}
909
910void FTN_STDCALL
911KMP_EXPAND_NAME(FTN_GET_PARTITION_PLACE_NUMS)(int *place_nums) {
912#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
913// Nothing.
914#else
915 int i, gtid, place_num, first_place, last_place, start, end;
916 kmp_info_t *thread;
917 if (!TCR_4(__kmp_init_middle)) {
918 __kmp_middle_initialize();
919 }
920 __kmp_assign_root_init_mask();
921 if (!KMP_AFFINITY_CAPABLE())
922 return;
923 gtid = __kmp_entry_gtid();
924 thread = __kmp_thread_from_gtid(gtid);
925 first_place = thread->th.th_first_place;
926 last_place = thread->th.th_last_place;
927 if (first_place < 0 || last_place < 0)
928 return;
929 if (first_place <= last_place) {
930 start = first_place;
931 end = last_place;
932 } else {
933 start = last_place;
934 end = first_place;
935 }
936 for (i = 0, place_num = start; place_num <= end; ++place_num, ++i) {
937 place_nums[i] = place_num;
938 }
939#endif
940}
941
942int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_TEAMS)(void) {
943#ifdef KMP_STUB
944 return 1;
945#else
946 return __kmp_aux_get_num_teams();
947#endif
948}
949
950int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_NUM)(void) {
951#ifdef KMP_STUB
952 return 0;
953#else
954 return __kmp_aux_get_team_num();
955#endif
956}
957
958int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEFAULT_DEVICE)(void) {
959#if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
960 return 0;
961#else
962 return __kmp_entry_thread()->th.th_current_task->td_icvs.default_device;
963#endif
964}
965
966void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DEFAULT_DEVICE)(int KMP_DEREF arg) {
967#if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
968// Nothing.
969#else
970 __kmp_entry_thread()->th.th_current_task->td_icvs.default_device =
971 KMP_DEREF arg;
972#endif
973}
974
975// Get number of NON-HOST devices.
976// libomptarget, if loaded, provides this function in api.cpp.
977int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void)
978 KMP_WEAK_ATTRIBUTE_EXTERNAL;
979int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) {
980#if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
981 return 0;
982#else
983 int (*fptr)();
984 if ((*(void **)(&fptr) = KMP_DLSYM("__tgt_get_num_devices"))) {
985 return (*fptr)();
986 } else if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_devices"))) {
987 return (*fptr)();
988 } else if ((*(void **)(&fptr) = KMP_DLSYM("_Offload_number_of_devices"))) {
989 return (*fptr)();
990 } else { // liboffload & libomptarget don't exist
991 return 0;
992 }
993#endif // KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB)
994}
995
996// This function always returns true when called on host device.
997// Compiler/libomptarget should handle when it is called inside target region.
998int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void)
999 KMP_WEAK_ATTRIBUTE_EXTERNAL;
1000int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) {
1001 return 1; // This is the host
1002}
1003
1004// libomptarget, if loaded, provides this function
1005int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void)
1006 KMP_WEAK_ATTRIBUTE_EXTERNAL;
1007int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void) {
1008 // same as omp_get_num_devices()
1009 return KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)();
1010}
1011
1012#if defined(KMP_STUB)
1013// Entries for stubs library
1014// As all *target* functions are C-only parameters always passed by value
1015void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; }
1016
1017void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {}
1018
1019int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; }
1020
1021int FTN_STDCALL FTN_TARGET_MEMCPY(void *dst, void *src, size_t length,
1022 size_t dst_offset, size_t src_offset,
1023 int dst_device, int src_device) {
1024 return -1;
1025}
1026
1027int FTN_STDCALL FTN_TARGET_MEMCPY_RECT(
1028 void *dst, void *src, size_t element_size, int num_dims,
1029 const size_t *volume, const size_t *dst_offsets, const size_t *src_offsets,
1030 const size_t *dst_dimensions, const size_t *src_dimensions, int dst_device,
1031 int src_device) {
1032 return -1;
1033}
1034
1035int FTN_STDCALL FTN_TARGET_ASSOCIATE_PTR(void *host_ptr, void *device_ptr,
1036 size_t size, size_t device_offset,
1037 int device_num) {
1038 return -1;
1039}
1040
1041int FTN_STDCALL FTN_TARGET_DISASSOCIATE_PTR(void *host_ptr, int device_num) {
1042 return -1;
1043}
1044#endif // defined(KMP_STUB)
1045
1046#ifdef KMP_STUB
1047typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t;
1048#endif /* KMP_STUB */
1049
1050#if KMP_USE_DYNAMIC_LOCK
1051void FTN_STDCALL FTN_INIT_LOCK_WITH_HINT(void **user_lock,
1052 uintptr_t KMP_DEREF hint) {
1053#ifdef KMP_STUB
1054 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1055#else
1056 int gtid = __kmp_entry_gtid();
1057#if OMPT_SUPPORT && OMPT_OPTIONAL
1058 OMPT_STORE_RETURN_ADDRESS(gtid);
1059#endif
1060 __kmpc_init_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);
1061#endif
1062}
1063
1064void FTN_STDCALL FTN_INIT_NEST_LOCK_WITH_HINT(void **user_lock,
1065 uintptr_t KMP_DEREF hint) {
1066#ifdef KMP_STUB
1067 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1068#else
1069 int gtid = __kmp_entry_gtid();
1070#if OMPT_SUPPORT && OMPT_OPTIONAL
1071 OMPT_STORE_RETURN_ADDRESS(gtid);
1072#endif
1073 __kmpc_init_nest_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);
1074#endif
1075}
1076#endif
1077
1078/* initialize the lock */
1079void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_LOCK)(void **user_lock) {
1080#ifdef KMP_STUB
1081 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1082#else
1083 int gtid = __kmp_entry_gtid();
1084#if OMPT_SUPPORT && OMPT_OPTIONAL
1085 OMPT_STORE_RETURN_ADDRESS(gtid);
1086#endif
1087 __kmpc_init_lock(NULL, gtid, user_lock);
1088#endif
1089}
1090
1091/* initialize the lock */
1092void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_NEST_LOCK)(void **user_lock) {
1093#ifdef KMP_STUB
1094 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1095#else
1096 int gtid = __kmp_entry_gtid();
1097#if OMPT_SUPPORT && OMPT_OPTIONAL
1098 OMPT_STORE_RETURN_ADDRESS(gtid);
1099#endif
1100 __kmpc_init_nest_lock(NULL, gtid, user_lock);
1101#endif
1102}
1103
1104void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_LOCK)(void **user_lock) {
1105#ifdef KMP_STUB
1106 *((kmp_stub_lock_t *)user_lock) = UNINIT;
1107#else
1108 int gtid = __kmp_entry_gtid();
1109#if OMPT_SUPPORT && OMPT_OPTIONAL
1110 OMPT_STORE_RETURN_ADDRESS(gtid);
1111#endif
1112 __kmpc_destroy_lock(NULL, gtid, user_lock);
1113#endif
1114}
1115
1116void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_NEST_LOCK)(void **user_lock) {
1117#ifdef KMP_STUB
1118 *((kmp_stub_lock_t *)user_lock) = UNINIT;
1119#else
1120 int gtid = __kmp_entry_gtid();
1121#if OMPT_SUPPORT && OMPT_OPTIONAL
1122 OMPT_STORE_RETURN_ADDRESS(gtid);
1123#endif
1124 __kmpc_destroy_nest_lock(NULL, gtid, user_lock);
1125#endif
1126}
1127
1128void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_LOCK)(void **user_lock) {
1129#ifdef KMP_STUB
1130 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1131 // TODO: Issue an error.
1132 }
1133 if (*((kmp_stub_lock_t *)user_lock) != UNLOCKED) {
1134 // TODO: Issue an error.
1135 }
1136 *((kmp_stub_lock_t *)user_lock) = LOCKED;
1137#else
1138 int gtid = __kmp_entry_gtid();
1139#if OMPT_SUPPORT && OMPT_OPTIONAL
1140 OMPT_STORE_RETURN_ADDRESS(gtid);
1141#endif
1142 __kmpc_set_lock(NULL, gtid, user_lock);
1143#endif
1144}
1145
1146void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NEST_LOCK)(void **user_lock) {
1147#ifdef KMP_STUB
1148 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1149 // TODO: Issue an error.
1150 }
1151 (*((int *)user_lock))++;
1152#else
1153 int gtid = __kmp_entry_gtid();
1154#if OMPT_SUPPORT && OMPT_OPTIONAL
1155 OMPT_STORE_RETURN_ADDRESS(gtid);
1156#endif
1157 __kmpc_set_nest_lock(NULL, gtid, user_lock);
1158#endif
1159}
1160
1161void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_LOCK)(void **user_lock) {
1162#ifdef KMP_STUB
1163 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1164 // TODO: Issue an error.
1165 }
1166 if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {
1167 // TODO: Issue an error.
1168 }
1169 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1170#else
1171 int gtid = __kmp_entry_gtid();
1172#if OMPT_SUPPORT && OMPT_OPTIONAL
1173 OMPT_STORE_RETURN_ADDRESS(gtid);
1174#endif
1175 __kmpc_unset_lock(NULL, gtid, user_lock);
1176#endif
1177}
1178
1179void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_NEST_LOCK)(void **user_lock) {
1180#ifdef KMP_STUB
1181 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1182 // TODO: Issue an error.
1183 }
1184 if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {
1185 // TODO: Issue an error.
1186 }
1187 (*((int *)user_lock))--;
1188#else
1189 int gtid = __kmp_entry_gtid();
1190#if OMPT_SUPPORT && OMPT_OPTIONAL
1191 OMPT_STORE_RETURN_ADDRESS(gtid);
1192#endif
1193 __kmpc_unset_nest_lock(NULL, gtid, user_lock);
1194#endif
1195}
1196
1197int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_LOCK)(void **user_lock) {
1198#ifdef KMP_STUB
1199 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1200 // TODO: Issue an error.
1201 }
1202 if (*((kmp_stub_lock_t *)user_lock) == LOCKED) {
1203 return 0;
1204 }
1205 *((kmp_stub_lock_t *)user_lock) = LOCKED;
1206 return 1;
1207#else
1208 int gtid = __kmp_entry_gtid();
1209#if OMPT_SUPPORT && OMPT_OPTIONAL
1210 OMPT_STORE_RETURN_ADDRESS(gtid);
1211#endif
1212 return __kmpc_test_lock(NULL, gtid, user_lock);
1213#endif
1214}
1215
1216int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_NEST_LOCK)(void **user_lock) {
1217#ifdef KMP_STUB
1218 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1219 // TODO: Issue an error.
1220 }
1221 return ++(*((int *)user_lock));
1222#else
1223 int gtid = __kmp_entry_gtid();
1224#if OMPT_SUPPORT && OMPT_OPTIONAL
1225 OMPT_STORE_RETURN_ADDRESS(gtid);
1226#endif
1227 return __kmpc_test_nest_lock(NULL, gtid, user_lock);
1228#endif
1229}
1230
1231double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTIME)(void) {
1232#ifdef KMP_STUB
1233 return __kmps_get_wtime();
1234#else
1235 double data;
1236#if !KMP_OS_LINUX
1237 // We don't need library initialization to get the time on Linux* OS. The
1238 // routine can be used to measure library initialization time on Linux* OS now
1239 if (!__kmp_init_serial) {
1240 __kmp_serial_initialize();
1241 }
1242#endif
1243 __kmp_elapsed(&data);
1244 return data;
1245#endif
1246}
1247
1248double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTICK)(void) {
1249#ifdef KMP_STUB
1250 return __kmps_get_wtick();
1251#else
1252 double data;
1253 if (!__kmp_init_serial) {
1254 __kmp_serial_initialize();
1255 }
1256 __kmp_elapsed_tick(&data);
1257 return data;
1258#endif
1259}
1260
1261/* ------------------------------------------------------------------------ */
1262
1263void *FTN_STDCALL FTN_MALLOC(size_t KMP_DEREF size) {
1264 // kmpc_malloc initializes the library if needed
1265 return kmpc_malloc(KMP_DEREF size);
1266}
1267
1268void *FTN_STDCALL FTN_ALIGNED_MALLOC(size_t KMP_DEREF size,
1269 size_t KMP_DEREF alignment) {
1270 // kmpc_aligned_malloc initializes the library if needed
1271 return kmpc_aligned_malloc(KMP_DEREF size, KMP_DEREF alignment);
1272}
1273
1274void *FTN_STDCALL FTN_CALLOC(size_t KMP_DEREF nelem, size_t KMP_DEREF elsize) {
1275 // kmpc_calloc initializes the library if needed
1276 return kmpc_calloc(KMP_DEREF nelem, KMP_DEREF elsize);
1277}
1278
1279void *FTN_STDCALL FTN_REALLOC(void *KMP_DEREF ptr, size_t KMP_DEREF size) {
1280 // kmpc_realloc initializes the library if needed
1281 return kmpc_realloc(KMP_DEREF ptr, KMP_DEREF size);
1282}
1283
1284void FTN_STDCALL FTN_KFREE(void *KMP_DEREF ptr) {
1285 // does nothing if the library is not initialized
1286 kmpc_free(KMP_DEREF ptr);
1287}
1288
1289void FTN_STDCALL FTN_SET_WARNINGS_ON(void) {
1290#ifndef KMP_STUB
1291 __kmp_generate_warnings = kmp_warnings_explicit;
1292#endif
1293}
1294
1295void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) {
1296#ifndef KMP_STUB
1297 __kmp_generate_warnings = FALSE;
1298#endif
1299}
1300
1301void FTN_STDCALL FTN_SET_DEFAULTS(char const *str
1302#ifndef PASS_ARGS_BY_VALUE
1303 ,
1304 int len
1305#endif
1306) {
1307#ifndef KMP_STUB
1308#ifdef PASS_ARGS_BY_VALUE
1309 int len = (int)KMP_STRLEN(str);
1310#endif
1311 __kmp_aux_set_defaults(str, len);
1312#endif
1313}
1314
1315/* ------------------------------------------------------------------------ */
1316
1317/* returns the status of cancellation */
1318int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_CANCELLATION)(void) {
1319#ifdef KMP_STUB
1320 return 0 /* false */;
1321#else
1322 // initialize the library if needed
1323 if (!__kmp_init_serial) {
1324 __kmp_serial_initialize();
1325 }
1326 return __kmp_omp_cancellation;
1327#endif
1328}
1329
1330int FTN_STDCALL FTN_GET_CANCELLATION_STATUS(int cancel_kind) {
1331#ifdef KMP_STUB
1332 return 0 /* false */;
1333#else
1334 return __kmp_get_cancellation_status(cancel_kind);
1335#endif
1336}
1337
1338/* returns the maximum allowed task priority */
1339int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_TASK_PRIORITY)(void) {
1340#ifdef KMP_STUB
1341 return 0;
1342#else
1343 if (!__kmp_init_serial) {
1344 __kmp_serial_initialize();
1345 }
1346 return __kmp_max_task_priority;
1347#endif
1348}
1349
1350// This function will be defined in libomptarget. When libomptarget is not
1351// loaded, we assume we are on the host and return KMP_HOST_DEVICE.
1352// Compiler/libomptarget will handle this if called inside target.
1353int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE_EXTERNAL;
1354int FTN_STDCALL FTN_GET_DEVICE_NUM(void) {
1355 return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
1356}
1357
1358// Compiler will ensure that this is only called from host in sequential region
1359int FTN_STDCALL KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE)(kmp_pause_status_t kind,
1360 int device_num) {
1361#ifdef KMP_STUB
1362 return 1; // just fail
1363#else
1364 if (device_num == KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)())
1365 return __kmpc_pause_resource(kind);
1366 else {
1367 int (*fptr)(kmp_pause_status_t, int);
1368 if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource")))
1369 return (*fptr)(kind, device_num);
1370 else
1371 return 1; // just fail if there is no libomptarget
1372 }
1373#endif
1374}
1375
1376// Compiler will ensure that this is only called from host in sequential region
1377int FTN_STDCALL
1378 KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE_ALL)(kmp_pause_status_t kind) {
1379#ifdef KMP_STUB
1380 return 1; // just fail
1381#else
1382 int fails = 0;
1383 int (*fptr)(kmp_pause_status_t, int);
1384 if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource")))
1385 fails = (*fptr)(kind, KMP_DEVICE_ALL); // pause devices
1386 fails += __kmpc_pause_resource(kind); // pause host
1387 return fails;
1388#endif
1389}
1390
1391// Returns the maximum number of nesting levels supported by implementation
1392int FTN_STDCALL FTN_GET_SUPPORTED_ACTIVE_LEVELS(void) {
1393#ifdef KMP_STUB
1394 return 1;
1395#else
1396 return KMP_MAX_ACTIVE_LEVELS_LIMIT;
1397#endif
1398}
1399
1400void FTN_STDCALL FTN_FULFILL_EVENT(kmp_event_t *event) {
1401#ifndef KMP_STUB
1402 __kmp_fulfill_event(event);
1403#endif
1404}
1405
1406// nteams-var per-device ICV
1407void FTN_STDCALL FTN_SET_NUM_TEAMS(int KMP_DEREF num_teams) {
1408#ifdef KMP_STUB
1409// Nothing.
1410#else
1411 if (!__kmp_init_serial) {
1412 __kmp_serial_initialize();
1413 }
1414 __kmp_set_num_teams(KMP_DEREF num_teams);
1415#endif
1416}
1417int FTN_STDCALL FTN_GET_MAX_TEAMS(void) {
1418#ifdef KMP_STUB
1419 return 1;
1420#else
1421 if (!__kmp_init_serial) {
1422 __kmp_serial_initialize();
1423 }
1424 return __kmp_get_max_teams();
1425#endif
1426}
1427// teams-thread-limit-var per-device ICV
1428void FTN_STDCALL FTN_SET_TEAMS_THREAD_LIMIT(int KMP_DEREF limit) {
1429#ifdef KMP_STUB
1430// Nothing.
1431#else
1432 if (!__kmp_init_serial) {
1433 __kmp_serial_initialize();
1434 }
1435 __kmp_set_teams_thread_limit(KMP_DEREF limit);
1436#endif
1437}
1438int FTN_STDCALL FTN_GET_TEAMS_THREAD_LIMIT(void) {
1439#ifdef KMP_STUB
1440 return 1;
1441#else
1442 if (!__kmp_init_serial) {
1443 __kmp_serial_initialize();
1444 }
1445 return __kmp_get_teams_thread_limit();
1446#endif
1447}
1448
1450/* OpenMP 5.1 interop */
1451typedef intptr_t omp_intptr_t;
1452
1453/* 0..omp_get_num_interop_properties()-1 are reserved for implementation-defined
1454 * properties */
1455typedef enum omp_interop_property {
1456 omp_ipr_fr_id = -1,
1457 omp_ipr_fr_name = -2,
1458 omp_ipr_vendor = -3,
1459 omp_ipr_vendor_name = -4,
1460 omp_ipr_device_num = -5,
1461 omp_ipr_platform = -6,
1462 omp_ipr_device = -7,
1463 omp_ipr_device_context = -8,
1464 omp_ipr_targetsync = -9,
1465 omp_ipr_first = -9
1466} omp_interop_property_t;
1467
1468#define omp_interop_none 0
1469
1470typedef enum omp_interop_rc {
1471 omp_irc_no_value = 1,
1472 omp_irc_success = 0,
1473 omp_irc_empty = -1,
1474 omp_irc_out_of_range = -2,
1475 omp_irc_type_int = -3,
1476 omp_irc_type_ptr = -4,
1477 omp_irc_type_str = -5,
1478 omp_irc_other = -6
1479} omp_interop_rc_t;
1480
1481typedef enum omp_interop_fr {
1482 omp_ifr_cuda = 1,
1483 omp_ifr_cuda_driver = 2,
1484 omp_ifr_opencl = 3,
1485 omp_ifr_sycl = 4,
1486 omp_ifr_hip = 5,
1487 omp_ifr_level_zero = 6,
1488 omp_ifr_last = 7
1489} omp_interop_fr_t;
1490
1491typedef void *omp_interop_t;
1492
1493// libomptarget, if loaded, provides this function
1494int FTN_STDCALL FTN_GET_NUM_INTEROP_PROPERTIES(const omp_interop_t interop) {
1495#if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
1496 return 0;
1497#else
1498 int (*fptr)(const omp_interop_t);
1499 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_interop_properties")))
1500 return (*fptr)(interop);
1501 return 0;
1502#endif // KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB)
1503}
1504
1506// libomptarget, if loaded, provides this function
1507intptr_t FTN_STDCALL FTN_GET_INTEROP_INT(const omp_interop_t interop,
1508 omp_interop_property_t property_id,
1509 int *err) {
1510 intptr_t (*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1511 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_int")))
1512 return (*fptr)(interop, property_id, err);
1513 return 0;
1514}
1515
1516// libomptarget, if loaded, provides this function
1517void *FTN_STDCALL FTN_GET_INTEROP_PTR(const omp_interop_t interop,
1518 omp_interop_property_t property_id,
1519 int *err) {
1520 void *(*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1521 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_ptr")))
1522 return (*fptr)(interop, property_id, err);
1523 return nullptr;
1524}
1525
1526// libomptarget, if loaded, provides this function
1527const char *FTN_STDCALL FTN_GET_INTEROP_STR(const omp_interop_t interop,
1528 omp_interop_property_t property_id,
1529 int *err) {
1530 const char *(*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1531 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_str")))
1532 return (*fptr)(interop, property_id, err);
1533 return nullptr;
1534}
1535
1536// libomptarget, if loaded, provides this function
1537const char *FTN_STDCALL FTN_GET_INTEROP_NAME(
1538 const omp_interop_t interop, omp_interop_property_t property_id) {
1539 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1540 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_name")))
1541 return (*fptr)(interop, property_id);
1542 return nullptr;
1543}
1544
1545// libomptarget, if loaded, provides this function
1546const char *FTN_STDCALL FTN_GET_INTEROP_TYPE_DESC(
1547 const omp_interop_t interop, omp_interop_property_t property_id) {
1548 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1549 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_type_desc")))
1550 return (*fptr)(interop, property_id);
1551 return nullptr;
1552}
1553
1554// libomptarget, if loaded, provides this function
1555const char *FTN_STDCALL FTN_GET_INTEROP_RC_DESC(
1556 const omp_interop_t interop, omp_interop_property_t property_id) {
1557 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1558 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_rec_desc")))
1559 return (*fptr)(interop, property_id);
1560 return nullptr;
1561}
1562
1563// display environment variables when requested
1564void FTN_STDCALL FTN_DISPLAY_ENV(int verbose) {
1565#ifndef KMP_STUB
1566 __kmp_omp_display_env(verbose);
1567#endif
1568}
1569
1570// GCC compatibility (versioned symbols)
1571#ifdef KMP_USE_VERSION_SYMBOLS
1572
1573/* These following sections create versioned symbols for the
1574 omp_* routines. The KMP_VERSION_SYMBOL macro expands the API name and
1575 then maps it to a versioned symbol.
1576 libgomp ``versions'' its symbols (OMP_1.0, OMP_2.0, OMP_3.0, ...) while also
1577 retaining the default version which libomp uses: VERSION (defined in
1578 exports_so.txt). If you want to see the versioned symbols for libgomp.so.1
1579 then just type:
1580
1581 objdump -T /path/to/libgomp.so.1 | grep omp_
1582
1583 Example:
1584 Step 1) Create __kmp_api_omp_set_num_threads_10_alias which is alias of
1585 __kmp_api_omp_set_num_threads
1586 Step 2) Set __kmp_api_omp_set_num_threads_10_alias to version:
1587 omp_set_num_threads@OMP_1.0
1588 Step 2B) Set __kmp_api_omp_set_num_threads to default version:
1589 omp_set_num_threads@@VERSION
1590*/
1591
1592// OMP_1.0 versioned symbols
1593KMP_VERSION_SYMBOL(FTN_SET_NUM_THREADS, 10, "OMP_1.0");
1594KMP_VERSION_SYMBOL(FTN_GET_NUM_THREADS, 10, "OMP_1.0");
1595KMP_VERSION_SYMBOL(FTN_GET_MAX_THREADS, 10, "OMP_1.0");
1596KMP_VERSION_SYMBOL(FTN_GET_THREAD_NUM, 10, "OMP_1.0");
1597KMP_VERSION_SYMBOL(FTN_GET_NUM_PROCS, 10, "OMP_1.0");
1598KMP_VERSION_SYMBOL(FTN_IN_PARALLEL, 10, "OMP_1.0");
1599KMP_VERSION_SYMBOL(FTN_SET_DYNAMIC, 10, "OMP_1.0");
1600KMP_VERSION_SYMBOL(FTN_GET_DYNAMIC, 10, "OMP_1.0");
1601KMP_VERSION_SYMBOL(FTN_SET_NESTED, 10, "OMP_1.0");
1602KMP_VERSION_SYMBOL(FTN_GET_NESTED, 10, "OMP_1.0");
1603KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 10, "OMP_1.0");
1604KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 10, "OMP_1.0");
1605KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 10, "OMP_1.0");
1606KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0");
1607KMP_VERSION_SYMBOL(FTN_SET_LOCK, 10, "OMP_1.0");
1608KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 10, "OMP_1.0");
1609KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 10, "OMP_1.0");
1610KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0");
1611KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 10, "OMP_1.0");
1612KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 10, "OMP_1.0");
1613
1614// OMP_2.0 versioned symbols
1615KMP_VERSION_SYMBOL(FTN_GET_WTICK, 20, "OMP_2.0");
1616KMP_VERSION_SYMBOL(FTN_GET_WTIME, 20, "OMP_2.0");
1617
1618// OMP_3.0 versioned symbols
1619KMP_VERSION_SYMBOL(FTN_SET_SCHEDULE, 30, "OMP_3.0");
1620KMP_VERSION_SYMBOL(FTN_GET_SCHEDULE, 30, "OMP_3.0");
1621KMP_VERSION_SYMBOL(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0");
1622KMP_VERSION_SYMBOL(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1623KMP_VERSION_SYMBOL(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1624KMP_VERSION_SYMBOL(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0");
1625KMP_VERSION_SYMBOL(FTN_GET_LEVEL, 30, "OMP_3.0");
1626KMP_VERSION_SYMBOL(FTN_GET_TEAM_SIZE, 30, "OMP_3.0");
1627KMP_VERSION_SYMBOL(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0");
1628
1629// the lock routines have a 1.0 and 3.0 version
1630KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 30, "OMP_3.0");
1631KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 30, "OMP_3.0");
1632KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 30, "OMP_3.0");
1633KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0");
1634KMP_VERSION_SYMBOL(FTN_SET_LOCK, 30, "OMP_3.0");
1635KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 30, "OMP_3.0");
1636KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 30, "OMP_3.0");
1637KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0");
1638KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 30, "OMP_3.0");
1639KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 30, "OMP_3.0");
1640
1641// OMP_3.1 versioned symbol
1642KMP_VERSION_SYMBOL(FTN_IN_FINAL, 31, "OMP_3.1");
1643
1644// OMP_4.0 versioned symbols
1645KMP_VERSION_SYMBOL(FTN_GET_PROC_BIND, 40, "OMP_4.0");
1646KMP_VERSION_SYMBOL(FTN_GET_NUM_TEAMS, 40, "OMP_4.0");
1647KMP_VERSION_SYMBOL(FTN_GET_TEAM_NUM, 40, "OMP_4.0");
1648KMP_VERSION_SYMBOL(FTN_GET_CANCELLATION, 40, "OMP_4.0");
1649KMP_VERSION_SYMBOL(FTN_GET_DEFAULT_DEVICE, 40, "OMP_4.0");
1650KMP_VERSION_SYMBOL(FTN_SET_DEFAULT_DEVICE, 40, "OMP_4.0");
1651KMP_VERSION_SYMBOL(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0");
1652KMP_VERSION_SYMBOL(FTN_GET_NUM_DEVICES, 40, "OMP_4.0");
1653
1654// OMP_4.5 versioned symbols
1655KMP_VERSION_SYMBOL(FTN_GET_MAX_TASK_PRIORITY, 45, "OMP_4.5");
1656KMP_VERSION_SYMBOL(FTN_GET_NUM_PLACES, 45, "OMP_4.5");
1657KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM_PROCS, 45, "OMP_4.5");
1658KMP_VERSION_SYMBOL(FTN_GET_PLACE_PROC_IDS, 45, "OMP_4.5");
1659KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM, 45, "OMP_4.5");
1660KMP_VERSION_SYMBOL(FTN_GET_PARTITION_NUM_PLACES, 45, "OMP_4.5");
1661KMP_VERSION_SYMBOL(FTN_GET_PARTITION_PLACE_NUMS, 45, "OMP_4.5");
1662KMP_VERSION_SYMBOL(FTN_GET_INITIAL_DEVICE, 45, "OMP_4.5");
1663
1664// OMP_5.0 versioned symbols
1665// KMP_VERSION_SYMBOL(FTN_GET_DEVICE_NUM, 50, "OMP_5.0");
1666KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE, 50, "OMP_5.0");
1667KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE_ALL, 50, "OMP_5.0");
1668// The C versions (KMP_FTN_PLAIN) of these symbols are in kmp_csupport.c
1669#if KMP_FTN_ENTRIES == KMP_FTN_APPEND
1670KMP_VERSION_SYMBOL(FTN_CAPTURE_AFFINITY, 50, "OMP_5.0");
1671KMP_VERSION_SYMBOL(FTN_DISPLAY_AFFINITY, 50, "OMP_5.0");
1672KMP_VERSION_SYMBOL(FTN_GET_AFFINITY_FORMAT, 50, "OMP_5.0");
1673KMP_VERSION_SYMBOL(FTN_SET_AFFINITY_FORMAT, 50, "OMP_5.0");
1674#endif
1675// KMP_VERSION_SYMBOL(FTN_GET_SUPPORTED_ACTIVE_LEVELS, 50, "OMP_5.0");
1676// KMP_VERSION_SYMBOL(FTN_FULFILL_EVENT, 50, "OMP_5.0");
1677
1678#endif // KMP_USE_VERSION_SYMBOLS
1679
1680#ifdef __cplusplus
1681} // extern "C"
1682#endif // __cplusplus
1683
1684// end of file //
KMP_EXPORT kmp_int32 __kmpc_bound_num_threads(ident_t *)