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

source code of openmp/runtime/src/kmp_ftn_entry.h