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, 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);
123 __kmp_aux_set_blocktime(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(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(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(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(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(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, 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 6.0 (TR11) Memory Management support */
432omp_memspace_handle_t FTN_STDCALL
433FTN_GET_DEVICES_MEMSPACE(int KMP_DEREF ndevs, const int *devs,
434 omp_memspace_handle_t KMP_DEREF memspace) {
435#ifdef KMP_STUB
436 return NULL;
437#else
438 return __kmp_get_devices_memspace(KMP_DEREF ndevs, devs, KMP_DEREF memspace,
439 0 /* host */);
440#endif
441}
442
443omp_memspace_handle_t FTN_STDCALL FTN_GET_DEVICE_MEMSPACE(
444 int KMP_DEREF dev, omp_memspace_handle_t KMP_DEREF memspace) {
445#ifdef KMP_STUB
446 return NULL;
447#else
448 int dev_num = KMP_DEREF dev;
449 return __kmp_get_devices_memspace(1, &dev_num, KMP_DEREF memspace, 0);
450#endif
451}
452
453omp_memspace_handle_t FTN_STDCALL
454FTN_GET_DEVICES_AND_HOST_MEMSPACE(int KMP_DEREF ndevs, const int *devs,
455 omp_memspace_handle_t KMP_DEREF memspace) {
456#ifdef KMP_STUB
457 return NULL;
458#else
459 return __kmp_get_devices_memspace(KMP_DEREF ndevs, devs, KMP_DEREF memspace,
460 1);
461#endif
462}
463
464omp_memspace_handle_t FTN_STDCALL FTN_GET_DEVICE_AND_HOST_MEMSPACE(
465 int KMP_DEREF dev, omp_memspace_handle_t KMP_DEREF memspace) {
466#ifdef KMP_STUB
467 return NULL;
468#else
469 int dev_num = KMP_DEREF dev;
470 return __kmp_get_devices_memspace(1, &dev_num, KMP_DEREF memspace, 1);
471#endif
472}
473
474omp_memspace_handle_t FTN_STDCALL
475FTN_GET_DEVICES_ALL_MEMSPACE(omp_memspace_handle_t KMP_DEREF memspace) {
476#ifdef KMP_STUB
477 return NULL;
478#else
479 return __kmp_get_devices_memspace(0, NULL, KMP_DEREF memspace, 1);
480#endif
481}
482
483omp_allocator_handle_t FTN_STDCALL
484FTN_GET_DEVICES_ALLOCATOR(int KMP_DEREF ndevs, const int *devs,
485 omp_allocator_handle_t KMP_DEREF memspace) {
486#ifdef KMP_STUB
487 return NULL;
488#else
489 return __kmp_get_devices_allocator(KMP_DEREF ndevs, devs, KMP_DEREF memspace,
490 0 /* host */);
491#endif
492}
493
494omp_allocator_handle_t FTN_STDCALL FTN_GET_DEVICE_ALLOCATOR(
495 int KMP_DEREF dev, omp_allocator_handle_t KMP_DEREF memspace) {
496#ifdef KMP_STUB
497 return NULL;
498#else
499 int dev_num = KMP_DEREF dev;
500 return __kmp_get_devices_allocator(1, &dev_num, KMP_DEREF memspace, 0);
501#endif
502}
503
504omp_allocator_handle_t FTN_STDCALL
505FTN_GET_DEVICES_AND_HOST_ALLOCATOR(int KMP_DEREF ndevs, const int *devs,
506 omp_allocator_handle_t KMP_DEREF memspace) {
507#ifdef KMP_STUB
508 return NULL;
509#else
510 return __kmp_get_devices_allocator(KMP_DEREF ndevs, devs, KMP_DEREF memspace,
511 1);
512#endif
513}
514
515omp_allocator_handle_t FTN_STDCALL FTN_GET_DEVICE_AND_HOST_ALLOCATOR(
516 int KMP_DEREF dev, omp_allocator_handle_t KMP_DEREF memspace) {
517#ifdef KMP_STUB
518 return NULL;
519#else
520 int dev_num = KMP_DEREF dev;
521 return __kmp_get_devices_allocator(1, &dev_num, KMP_DEREF memspace, 1);
522#endif
523}
524
525omp_allocator_handle_t FTN_STDCALL
526FTN_GET_DEVICES_ALL_ALLOCATOR(omp_allocator_handle_t KMP_DEREF memspace) {
527#ifdef KMP_STUB
528 return NULL;
529#else
530 return __kmp_get_devices_allocator(0, NULL, KMP_DEREF memspace, 1);
531#endif
532}
533
534int FTN_STDCALL
535FTN_GET_MEMSPACE_NUM_RESOURCES(omp_memspace_handle_t KMP_DEREF memspace) {
536#ifdef KMP_STUB
537 return 0;
538#else
539 return __kmp_get_memspace_num_resources(KMP_DEREF memspace);
540#endif
541}
542
543omp_memspace_handle_t FTN_STDCALL
544FTN_GET_SUBMEMSPACE(omp_memspace_handle_t KMP_DEREF memspace,
545 int KMP_DEREF num_resources, int *resources) {
546#ifdef KMP_STUB
547 return NULL;
548#else
549 return __kmp_get_submemspace(KMP_DEREF memspace, KMP_DEREF num_resources,
550 resources);
551#endif
552}
553
554/* OpenMP 5.0 affinity format support */
555#ifndef KMP_STUB
556static void __kmp_fortran_strncpy_truncate(char *buffer, size_t buf_size,
557 char const *csrc, size_t csrc_size) {
558 size_t capped_src_size = csrc_size;
559 if (csrc_size >= buf_size) {
560 capped_src_size = buf_size - 1;
561 }
562 KMP_STRNCPY_S(buffer, buf_size, csrc, capped_src_size);
563 if (csrc_size >= buf_size) {
564 KMP_DEBUG_ASSERT(buffer[buf_size - 1] == '\0');
565 buffer[buf_size - 1] = csrc[buf_size - 1];
566 } else {
567 for (size_t i = csrc_size; i < buf_size; ++i)
568 buffer[i] = ' ';
569 }
570}
571
572// Convert a Fortran string to a C string by adding null byte
573class ConvertedString {
574 char *buf;
575
576public:
577 ConvertedString(char const *fortran_str, size_t size) {
578 buf = (char *)KMP_INTERNAL_MALLOC(size + 1);
579 KMP_STRNCPY_S(buf, size + 1, fortran_str, size);
580 buf[size] = '\0';
581 }
582 ~ConvertedString() { KMP_INTERNAL_FREE(buf); }
583 const char *get() const { return buf; }
584};
585#endif // KMP_STUB
586
587/*
588 * Set the value of the affinity-format-var ICV on the current device to the
589 * format specified in the argument.
590 */
591void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_SET_AFFINITY_FORMAT)(
592 char const *format, size_t size) {
593#ifdef KMP_STUB
594 return;
595#else
596 if (!__kmp_init_serial) {
597 __kmp_serial_initialize();
598 }
599 ConvertedString cformat(format, size);
600 // Since the __kmp_affinity_format variable is a C string, do not
601 // use the fortran strncpy function
602 __kmp_strncpy_truncate(__kmp_affinity_format, KMP_AFFINITY_FORMAT_SIZE,
603 cformat.get(), KMP_STRLEN(cformat.get()));
604#endif
605}
606
607/*
608 * Returns the number of characters required to hold the entire affinity format
609 * specification (not including null byte character) and writes the value of the
610 * affinity-format-var ICV on the current device to buffer. If the return value
611 * is larger than size, the affinity format specification is truncated.
612 */
613size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_GET_AFFINITY_FORMAT)(
614 char *buffer, size_t size) {
615#ifdef KMP_STUB
616 return 0;
617#else
618 size_t format_size;
619 if (!__kmp_init_serial) {
620 __kmp_serial_initialize();
621 }
622 format_size = KMP_STRLEN(__kmp_affinity_format);
623 if (buffer && size) {
624 __kmp_fortran_strncpy_truncate(buffer, size, __kmp_affinity_format,
625 format_size);
626 }
627 return format_size;
628#endif
629}
630
631/*
632 * Prints the thread affinity information of the current thread in the format
633 * specified by the format argument. If the format is NULL or a zero-length
634 * string, the value of the affinity-format-var ICV is used.
635 */
636void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_DISPLAY_AFFINITY)(
637 char const *format, size_t size) {
638#ifdef KMP_STUB
639 return;
640#else
641 int gtid;
642 if (!TCR_4(__kmp_init_middle)) {
643 __kmp_middle_initialize();
644 }
645 __kmp_assign_root_init_mask();
646 gtid = __kmp_get_gtid();
647#if KMP_AFFINITY_SUPPORTED
648 if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 &&
649 __kmp_affinity.flags.reset) {
650 __kmp_reset_root_init_mask(gtid);
651 }
652#endif
653 ConvertedString cformat(format, size);
654 __kmp_aux_display_affinity(gtid, cformat.get());
655#endif
656}
657
658/*
659 * Returns the number of characters required to hold the entire affinity format
660 * specification (not including null byte) and prints the thread affinity
661 * information of the current thread into the character string buffer with the
662 * size of size in the format specified by the format argument. If the format is
663 * NULL or a zero-length string, the value of the affinity-format-var ICV is
664 * used. The buffer must be allocated prior to calling the routine. If the
665 * return value is larger than size, the affinity format specification is
666 * truncated.
667 */
668size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_CAPTURE_AFFINITY)(
669 char *buffer, char const *format, size_t buf_size, size_t for_size) {
670#if defined(KMP_STUB)
671 return 0;
672#else
673 int gtid;
674 size_t num_required;
675 kmp_str_buf_t capture_buf;
676 if (!TCR_4(__kmp_init_middle)) {
677 __kmp_middle_initialize();
678 }
679 __kmp_assign_root_init_mask();
680 gtid = __kmp_get_gtid();
681#if KMP_AFFINITY_SUPPORTED
682 if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 &&
683 __kmp_affinity.flags.reset) {
684 __kmp_reset_root_init_mask(gtid);
685 }
686#endif
687 __kmp_str_buf_init(&capture_buf);
688 ConvertedString cformat(format, for_size);
689 num_required = __kmp_aux_capture_affinity(gtid, cformat.get(), &capture_buf);
690 if (buffer && buf_size) {
691 __kmp_fortran_strncpy_truncate(buffer, buf_size, capture_buf.str,
692 capture_buf.used);
693 }
694 __kmp_str_buf_free(&capture_buf);
695 return num_required;
696#endif
697}
698
699int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_NUM)(void) {
700#ifdef KMP_STUB
701 return 0;
702#else
703 int gtid;
704
705#if KMP_OS_DARWIN || KMP_OS_DRAGONFLY || KMP_OS_FREEBSD || KMP_OS_NETBSD || \
706 KMP_OS_OPENBSD || KMP_OS_HAIKU || KMP_OS_HURD || KMP_OS_SOLARIS || \
707 KMP_OS_AIX
708 gtid = __kmp_entry_gtid();
709#elif KMP_OS_WINDOWS
710 if (!__kmp_init_parallel ||
711 (gtid = (int)((kmp_intptr_t)TlsGetValue(__kmp_gtid_threadprivate_key))) ==
712 0) {
713 // Either library isn't initialized or thread is not registered
714 // 0 is the correct TID in this case
715 return 0;
716 }
717 --gtid; // We keep (gtid+1) in TLS
718#elif KMP_OS_LINUX || KMP_OS_WASI
719#ifdef KMP_TDATA_GTID
720 if (__kmp_gtid_mode >= 3) {
721 if ((gtid = __kmp_gtid) == KMP_GTID_DNE) {
722 return 0;
723 }
724 } else {
725#endif
726 if (!__kmp_init_parallel ||
727 (gtid = (int)((kmp_intptr_t)(
728 pthread_getspecific(__kmp_gtid_threadprivate_key)))) == 0) {
729 return 0;
730 }
731 --gtid;
732#ifdef KMP_TDATA_GTID
733 }
734#endif
735#else
736#error Unknown or unsupported OS
737#endif
738
739 return __kmp_tid_from_gtid(gtid);
740#endif
741}
742
743int FTN_STDCALL FTN_GET_NUM_KNOWN_THREADS(void) {
744#ifdef KMP_STUB
745 return 1;
746#else
747 if (!__kmp_init_serial) {
748 __kmp_serial_initialize();
749 }
750 /* NOTE: this is not syncronized, so it can change at any moment */
751 /* NOTE: this number also includes threads preallocated in hot-teams */
752 return TCR_4(__kmp_nth);
753#endif
754}
755
756int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PROCS)(void) {
757#ifdef KMP_STUB
758 return 1;
759#else
760 if (!TCR_4(__kmp_init_middle)) {
761 __kmp_middle_initialize();
762 }
763#if KMP_AFFINITY_SUPPORTED
764 if (!__kmp_affinity.flags.reset) {
765 // only bind root here if its affinity reset is not requested
766 int gtid = __kmp_entry_gtid();
767 kmp_info_t *thread = __kmp_threads[gtid];
768 if (thread->th.th_team->t.t_level == 0) {
769 __kmp_assign_root_init_mask();
770 }
771 }
772#endif
773 return __kmp_avail_proc;
774#endif
775}
776
777void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NESTED)(int KMP_DEREF flag) {
778#ifdef KMP_STUB
779 __kmps_set_nested(KMP_DEREF flag);
780#else
781 kmp_info_t *thread;
782 /* For the thread-private internal controls implementation */
783 thread = __kmp_entry_thread();
784 KMP_INFORM(APIDeprecated, "omp_set_nested", "omp_set_max_active_levels");
785 __kmp_save_internal_controls(thread);
786 // Somewhat arbitrarily decide where to get a value for max_active_levels
787 int max_active_levels = get__max_active_levels(thread);
788 if (max_active_levels == 1)
789 max_active_levels = KMP_MAX_ACTIVE_LEVELS_LIMIT;
790 set__max_active_levels(thread, (KMP_DEREF flag) ? max_active_levels : 1);
791#endif
792}
793
794int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NESTED)(void) {
795#ifdef KMP_STUB
796 return __kmps_get_nested();
797#else
798 kmp_info_t *thread;
799 thread = __kmp_entry_thread();
800 KMP_INFORM(APIDeprecated, "omp_get_nested", "omp_get_max_active_levels");
801 return get__max_active_levels(thread) > 1;
802#endif
803}
804
805void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DYNAMIC)(int KMP_DEREF flag) {
806#ifdef KMP_STUB
807 __kmps_set_dynamic(KMP_DEREF flag ? TRUE : FALSE);
808#else
809 kmp_info_t *thread;
810 /* For the thread-private implementation of the internal controls */
811 thread = __kmp_entry_thread();
812 // !!! What if foreign thread calls it?
813 __kmp_save_internal_controls(thread);
814 set__dynamic(thread, KMP_DEREF flag ? true : false);
815#endif
816}
817
818int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DYNAMIC)(void) {
819#ifdef KMP_STUB
820 return __kmps_get_dynamic();
821#else
822 kmp_info_t *thread;
823 thread = __kmp_entry_thread();
824 return get__dynamic(thread);
825#endif
826}
827
828int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_PARALLEL)(void) {
829#ifdef KMP_STUB
830 return 0;
831#else
832 kmp_info_t *th = __kmp_entry_thread();
833 if (th->th.th_teams_microtask) {
834 // AC: r_in_parallel does not work inside teams construct where real
835 // parallel is inactive, but all threads have same root, so setting it in
836 // one team affects other teams.
837 // The solution is to use per-team nesting level
838 return (th->th.th_team->t.t_active_level ? 1 : 0);
839 } else
840 return (th->th.th_root->r.r_in_parallel ? FTN_TRUE : FTN_FALSE);
841#endif
842}
843
844void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_SCHEDULE)(kmp_sched_t KMP_DEREF kind,
845 int KMP_DEREF modifier) {
846#ifdef KMP_STUB
847 __kmps_set_schedule(KMP_DEREF kind, KMP_DEREF modifier);
848#else
849 /* TO DO: For the per-task implementation of the internal controls */
850 __kmp_set_schedule(__kmp_entry_gtid(), KMP_DEREF kind, KMP_DEREF modifier);
851#endif
852}
853
854void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_SCHEDULE)(kmp_sched_t *kind,
855 int *modifier) {
856#ifdef KMP_STUB
857 __kmps_get_schedule(kind, modifier);
858#else
859 /* TO DO: For the per-task implementation of the internal controls */
860 __kmp_get_schedule(__kmp_entry_gtid(), kind, modifier);
861#endif
862}
863
864void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_MAX_ACTIVE_LEVELS)(int KMP_DEREF arg) {
865#ifdef KMP_STUB
866// Nothing.
867#else
868 /* TO DO: We want per-task implementation of this internal control */
869 __kmp_set_max_active_levels(__kmp_entry_gtid(), KMP_DEREF arg);
870#endif
871}
872
873int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_ACTIVE_LEVELS)(void) {
874#ifdef KMP_STUB
875 return 0;
876#else
877 /* TO DO: We want per-task implementation of this internal control */
878 if (!TCR_4(__kmp_init_middle)) {
879 __kmp_middle_initialize();
880 }
881 return __kmp_get_max_active_levels(__kmp_entry_gtid());
882#endif
883}
884
885int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_ACTIVE_LEVEL)(void) {
886#ifdef KMP_STUB
887 return 0; // returns 0 if it is called from the sequential part of the program
888#else
889 /* TO DO: For the per-task implementation of the internal controls */
890 return __kmp_entry_thread()->th.th_team->t.t_active_level;
891#endif
892}
893
894int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_LEVEL)(void) {
895#ifdef KMP_STUB
896 return 0; // returns 0 if it is called from the sequential part of the program
897#else
898 /* TO DO: For the per-task implementation of the internal controls */
899 return __kmp_entry_thread()->th.th_team->t.t_level;
900#endif
901}
902
903int FTN_STDCALL
904KMP_EXPAND_NAME(FTN_GET_ANCESTOR_THREAD_NUM)(int KMP_DEREF level) {
905#ifdef KMP_STUB
906 return (KMP_DEREF level) ? (-1) : (0);
907#else
908 return __kmp_get_ancestor_thread_num(__kmp_entry_gtid(), KMP_DEREF level);
909#endif
910}
911
912int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_SIZE)(int KMP_DEREF level) {
913#ifdef KMP_STUB
914 return (KMP_DEREF level) ? (-1) : (1);
915#else
916 return __kmp_get_team_size(__kmp_entry_gtid(), KMP_DEREF level);
917#endif
918}
919
920int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_LIMIT)(void) {
921#ifdef KMP_STUB
922 return 1; // TO DO: clarify whether it returns 1 or 0?
923#else
924 int gtid;
925 kmp_info_t *thread;
926 if (!__kmp_init_serial) {
927 __kmp_serial_initialize();
928 }
929
930 gtid = __kmp_entry_gtid();
931 thread = __kmp_threads[gtid];
932 // If thread_limit for the target task is defined, return that instead of the
933 // regular task thread_limit
934 if (int thread_limit = thread->th.th_current_task->td_icvs.task_thread_limit)
935 return thread_limit;
936 return thread->th.th_current_task->td_icvs.thread_limit;
937#endif
938}
939
940int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_FINAL)(void) {
941#ifdef KMP_STUB
942 return 0; // TO DO: clarify whether it returns 1 or 0?
943#else
944 if (!TCR_4(__kmp_init_parallel)) {
945 return 0;
946 }
947 return __kmp_entry_thread()->th.th_current_task->td_flags.final;
948#endif
949}
950
951kmp_proc_bind_t FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PROC_BIND)(void) {
952#ifdef KMP_STUB
953 return __kmps_get_proc_bind();
954#else
955 return get__proc_bind(__kmp_entry_thread());
956#endif
957}
958
959int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PLACES)(void) {
960#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
961 return 0;
962#else
963 if (!TCR_4(__kmp_init_middle)) {
964 __kmp_middle_initialize();
965 }
966 if (!KMP_AFFINITY_CAPABLE())
967 return 0;
968 if (!__kmp_affinity.flags.reset) {
969 // only bind root here if its affinity reset is not requested
970 int gtid = __kmp_entry_gtid();
971 kmp_info_t *thread = __kmp_threads[gtid];
972 if (thread->th.th_team->t.t_level == 0) {
973 __kmp_assign_root_init_mask();
974 }
975 }
976 return __kmp_affinity.num_masks;
977#endif
978}
979
980int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM_PROCS)(int place_num) {
981#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
982 return 0;
983#else
984 int i;
985 int retval = 0;
986 if (!TCR_4(__kmp_init_middle)) {
987 __kmp_middle_initialize();
988 }
989 if (!KMP_AFFINITY_CAPABLE())
990 return 0;
991 if (!__kmp_affinity.flags.reset) {
992 // only bind root here if its affinity reset is not requested
993 int gtid = __kmp_entry_gtid();
994 kmp_info_t *thread = __kmp_threads[gtid];
995 if (thread->th.th_team->t.t_level == 0) {
996 __kmp_assign_root_init_mask();
997 }
998 }
999 if (place_num < 0 || place_num >= (int)__kmp_affinity.num_masks)
1000 return 0;
1001 kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity.masks, place_num);
1002 KMP_CPU_SET_ITERATE(i, mask) {
1003 if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||
1004 (!KMP_CPU_ISSET(i, mask))) {
1005 continue;
1006 }
1007 ++retval;
1008 }
1009 return retval;
1010#endif
1011}
1012
1013void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_PROC_IDS)(int place_num,
1014 int *ids) {
1015#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
1016// Nothing.
1017#else
1018 int i, j;
1019 if (!TCR_4(__kmp_init_middle)) {
1020 __kmp_middle_initialize();
1021 }
1022 if (!KMP_AFFINITY_CAPABLE())
1023 return;
1024 if (!__kmp_affinity.flags.reset) {
1025 // only bind root here if its affinity reset is not requested
1026 int gtid = __kmp_entry_gtid();
1027 kmp_info_t *thread = __kmp_threads[gtid];
1028 if (thread->th.th_team->t.t_level == 0) {
1029 __kmp_assign_root_init_mask();
1030 }
1031 }
1032 if (place_num < 0 || place_num >= (int)__kmp_affinity.num_masks)
1033 return;
1034 kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity.masks, place_num);
1035 j = 0;
1036 KMP_CPU_SET_ITERATE(i, mask) {
1037 if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||
1038 (!KMP_CPU_ISSET(i, mask))) {
1039 continue;
1040 }
1041 ids[j++] = i;
1042 }
1043#endif
1044}
1045
1046int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM)(void) {
1047#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
1048 return -1;
1049#else
1050 int gtid;
1051 kmp_info_t *thread;
1052 if (!TCR_4(__kmp_init_middle)) {
1053 __kmp_middle_initialize();
1054 }
1055 if (!KMP_AFFINITY_CAPABLE())
1056 return -1;
1057 gtid = __kmp_entry_gtid();
1058 thread = __kmp_thread_from_gtid(gtid);
1059 if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {
1060 __kmp_assign_root_init_mask();
1061 }
1062 if (thread->th.th_current_place < 0)
1063 return -1;
1064 return thread->th.th_current_place;
1065#endif
1066}
1067
1068int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PARTITION_NUM_PLACES)(void) {
1069#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
1070 return 0;
1071#else
1072 int gtid, num_places, first_place, last_place;
1073 kmp_info_t *thread;
1074 if (!TCR_4(__kmp_init_middle)) {
1075 __kmp_middle_initialize();
1076 }
1077 if (!KMP_AFFINITY_CAPABLE())
1078 return 0;
1079 gtid = __kmp_entry_gtid();
1080 thread = __kmp_thread_from_gtid(gtid);
1081 if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {
1082 __kmp_assign_root_init_mask();
1083 }
1084 first_place = thread->th.th_first_place;
1085 last_place = thread->th.th_last_place;
1086 if (first_place < 0 || last_place < 0)
1087 return 0;
1088 if (first_place <= last_place)
1089 num_places = last_place - first_place + 1;
1090 else
1091 num_places = __kmp_affinity.num_masks - first_place + last_place + 1;
1092 return num_places;
1093#endif
1094}
1095
1096void FTN_STDCALL
1097KMP_EXPAND_NAME(FTN_GET_PARTITION_PLACE_NUMS)(int *place_nums) {
1098#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
1099// Nothing.
1100#else
1101 int i, gtid, place_num, first_place, last_place, start, end;
1102 kmp_info_t *thread;
1103 if (!TCR_4(__kmp_init_middle)) {
1104 __kmp_middle_initialize();
1105 }
1106 if (!KMP_AFFINITY_CAPABLE())
1107 return;
1108 gtid = __kmp_entry_gtid();
1109 thread = __kmp_thread_from_gtid(gtid);
1110 if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {
1111 __kmp_assign_root_init_mask();
1112 }
1113 first_place = thread->th.th_first_place;
1114 last_place = thread->th.th_last_place;
1115 if (first_place < 0 || last_place < 0)
1116 return;
1117 if (first_place <= last_place) {
1118 start = first_place;
1119 end = last_place;
1120 } else {
1121 start = last_place;
1122 end = first_place;
1123 }
1124 for (i = 0, place_num = start; place_num <= end; ++place_num, ++i) {
1125 place_nums[i] = place_num;
1126 }
1127#endif
1128}
1129
1130int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_TEAMS)(void) {
1131#ifdef KMP_STUB
1132 return 1;
1133#else
1134 return __kmp_aux_get_num_teams();
1135#endif
1136}
1137
1138int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_NUM)(void) {
1139#ifdef KMP_STUB
1140 return 0;
1141#else
1142 return __kmp_aux_get_team_num();
1143#endif
1144}
1145
1146int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEFAULT_DEVICE)(void) {
1147#if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
1148 return 0;
1149#else
1150 return __kmp_entry_thread()->th.th_current_task->td_icvs.default_device;
1151#endif
1152}
1153
1154void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DEFAULT_DEVICE)(int KMP_DEREF arg) {
1155#if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
1156// Nothing.
1157#else
1158 __kmp_entry_thread()->th.th_current_task->td_icvs.default_device =
1159 KMP_DEREF arg;
1160#endif
1161}
1162
1163// Get number of NON-HOST devices.
1164// libomptarget, if loaded, provides this function in api.cpp.
1165int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void)
1166 KMP_WEAK_ATTRIBUTE_EXTERNAL;
1167int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) {
1168#if KMP_MIC || KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1169 return 0;
1170#else
1171 int (*fptr)();
1172 if ((*(void **)(&fptr) = KMP_DLSYM("__tgt_get_num_devices"))) {
1173 return (*fptr)();
1174 } else if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_devices"))) {
1175 return (*fptr)();
1176 } else if ((*(void **)(&fptr) = KMP_DLSYM("_Offload_number_of_devices"))) {
1177 return (*fptr)();
1178 } else { // liboffload & libomptarget don't exist
1179 return 0;
1180 }
1181#endif // KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB)
1182}
1183
1184// This function always returns true when called on host device.
1185// Compiler/libomptarget should handle when it is called inside target region.
1186int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void)
1187 KMP_WEAK_ATTRIBUTE_EXTERNAL;
1188int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) {
1189 return 1; // This is the host
1190}
1191
1192// libomptarget, if loaded, provides this function
1193int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void)
1194 KMP_WEAK_ATTRIBUTE_EXTERNAL;
1195int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void) {
1196 // same as omp_get_num_devices()
1197 return KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)();
1198}
1199
1200#if defined(KMP_STUB)
1201// Entries for stubs library
1202// As all *target* functions are C-only parameters always passed by value
1203void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; }
1204
1205void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {}
1206
1207int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; }
1208
1209int FTN_STDCALL FTN_TARGET_MEMCPY(void *dst, void *src, size_t length,
1210 size_t dst_offset, size_t src_offset,
1211 int dst_device, int src_device) {
1212 return -1;
1213}
1214
1215int FTN_STDCALL FTN_TARGET_MEMCPY_RECT(
1216 void *dst, void *src, size_t element_size, int num_dims,
1217 const size_t *volume, const size_t *dst_offsets, const size_t *src_offsets,
1218 const size_t *dst_dimensions, const size_t *src_dimensions, int dst_device,
1219 int src_device) {
1220 return -1;
1221}
1222
1223int FTN_STDCALL FTN_TARGET_ASSOCIATE_PTR(void *host_ptr, void *device_ptr,
1224 size_t size, size_t device_offset,
1225 int device_num) {
1226 return -1;
1227}
1228
1229int FTN_STDCALL FTN_TARGET_DISASSOCIATE_PTR(void *host_ptr, int device_num) {
1230 return -1;
1231}
1232#endif // defined(KMP_STUB)
1233
1234#ifdef KMP_STUB
1235typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t;
1236#endif /* KMP_STUB */
1237
1238#if KMP_USE_DYNAMIC_LOCK
1239void FTN_STDCALL FTN_INIT_LOCK_WITH_HINT(void **user_lock,
1240 uintptr_t KMP_DEREF hint) {
1241#ifdef KMP_STUB
1242 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1243#else
1244 int gtid = __kmp_entry_gtid();
1245#if OMPT_SUPPORT && OMPT_OPTIONAL
1246 OMPT_STORE_RETURN_ADDRESS(gtid);
1247#endif
1248 __kmpc_init_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);
1249#endif
1250}
1251
1252void FTN_STDCALL FTN_INIT_NEST_LOCK_WITH_HINT(void **user_lock,
1253 uintptr_t KMP_DEREF hint) {
1254#ifdef KMP_STUB
1255 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1256#else
1257 int gtid = __kmp_entry_gtid();
1258#if OMPT_SUPPORT && OMPT_OPTIONAL
1259 OMPT_STORE_RETURN_ADDRESS(gtid);
1260#endif
1261 __kmpc_init_nest_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);
1262#endif
1263}
1264#endif
1265
1266/* initialize the lock */
1267void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_LOCK)(void **user_lock) {
1268#ifdef KMP_STUB
1269 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1270#else
1271 int gtid = __kmp_entry_gtid();
1272#if OMPT_SUPPORT && OMPT_OPTIONAL
1273 OMPT_STORE_RETURN_ADDRESS(gtid);
1274#endif
1275 __kmpc_init_lock(NULL, gtid, user_lock);
1276#endif
1277}
1278
1279/* initialize the lock */
1280void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_NEST_LOCK)(void **user_lock) {
1281#ifdef KMP_STUB
1282 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1283#else
1284 int gtid = __kmp_entry_gtid();
1285#if OMPT_SUPPORT && OMPT_OPTIONAL
1286 OMPT_STORE_RETURN_ADDRESS(gtid);
1287#endif
1288 __kmpc_init_nest_lock(NULL, gtid, user_lock);
1289#endif
1290}
1291
1292void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_LOCK)(void **user_lock) {
1293#ifdef KMP_STUB
1294 *((kmp_stub_lock_t *)user_lock) = UNINIT;
1295#else
1296 int gtid = __kmp_entry_gtid();
1297#if OMPT_SUPPORT && OMPT_OPTIONAL
1298 OMPT_STORE_RETURN_ADDRESS(gtid);
1299#endif
1300 __kmpc_destroy_lock(NULL, gtid, user_lock);
1301#endif
1302}
1303
1304void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_NEST_LOCK)(void **user_lock) {
1305#ifdef KMP_STUB
1306 *((kmp_stub_lock_t *)user_lock) = UNINIT;
1307#else
1308 int gtid = __kmp_entry_gtid();
1309#if OMPT_SUPPORT && OMPT_OPTIONAL
1310 OMPT_STORE_RETURN_ADDRESS(gtid);
1311#endif
1312 __kmpc_destroy_nest_lock(NULL, gtid, user_lock);
1313#endif
1314}
1315
1316void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_LOCK)(void **user_lock) {
1317#ifdef KMP_STUB
1318 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1319 // TODO: Issue an error.
1320 }
1321 if (*((kmp_stub_lock_t *)user_lock) != UNLOCKED) {
1322 // TODO: Issue an error.
1323 }
1324 *((kmp_stub_lock_t *)user_lock) = LOCKED;
1325#else
1326 int gtid = __kmp_entry_gtid();
1327#if OMPT_SUPPORT && OMPT_OPTIONAL
1328 OMPT_STORE_RETURN_ADDRESS(gtid);
1329#endif
1330 __kmpc_set_lock(NULL, gtid, user_lock);
1331#endif
1332}
1333
1334void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NEST_LOCK)(void **user_lock) {
1335#ifdef KMP_STUB
1336 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1337 // TODO: Issue an error.
1338 }
1339 (*((int *)user_lock))++;
1340#else
1341 int gtid = __kmp_entry_gtid();
1342#if OMPT_SUPPORT && OMPT_OPTIONAL
1343 OMPT_STORE_RETURN_ADDRESS(gtid);
1344#endif
1345 __kmpc_set_nest_lock(NULL, gtid, user_lock);
1346#endif
1347}
1348
1349void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_LOCK)(void **user_lock) {
1350#ifdef KMP_STUB
1351 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1352 // TODO: Issue an error.
1353 }
1354 if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {
1355 // TODO: Issue an error.
1356 }
1357 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1358#else
1359 int gtid = __kmp_entry_gtid();
1360#if OMPT_SUPPORT && OMPT_OPTIONAL
1361 OMPT_STORE_RETURN_ADDRESS(gtid);
1362#endif
1363 __kmpc_unset_lock(NULL, gtid, user_lock);
1364#endif
1365}
1366
1367void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_NEST_LOCK)(void **user_lock) {
1368#ifdef KMP_STUB
1369 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1370 // TODO: Issue an error.
1371 }
1372 if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {
1373 // TODO: Issue an error.
1374 }
1375 (*((int *)user_lock))--;
1376#else
1377 int gtid = __kmp_entry_gtid();
1378#if OMPT_SUPPORT && OMPT_OPTIONAL
1379 OMPT_STORE_RETURN_ADDRESS(gtid);
1380#endif
1381 __kmpc_unset_nest_lock(NULL, gtid, user_lock);
1382#endif
1383}
1384
1385int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_LOCK)(void **user_lock) {
1386#ifdef KMP_STUB
1387 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1388 // TODO: Issue an error.
1389 }
1390 if (*((kmp_stub_lock_t *)user_lock) == LOCKED) {
1391 return 0;
1392 }
1393 *((kmp_stub_lock_t *)user_lock) = LOCKED;
1394 return 1;
1395#else
1396 int gtid = __kmp_entry_gtid();
1397#if OMPT_SUPPORT && OMPT_OPTIONAL
1398 OMPT_STORE_RETURN_ADDRESS(gtid);
1399#endif
1400 return __kmpc_test_lock(NULL, gtid, user_lock);
1401#endif
1402}
1403
1404int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_NEST_LOCK)(void **user_lock) {
1405#ifdef KMP_STUB
1406 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1407 // TODO: Issue an error.
1408 }
1409 return ++(*((int *)user_lock));
1410#else
1411 int gtid = __kmp_entry_gtid();
1412#if OMPT_SUPPORT && OMPT_OPTIONAL
1413 OMPT_STORE_RETURN_ADDRESS(gtid);
1414#endif
1415 return __kmpc_test_nest_lock(NULL, gtid, user_lock);
1416#endif
1417}
1418
1419double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTIME)(void) {
1420#ifdef KMP_STUB
1421 return __kmps_get_wtime();
1422#else
1423 double data;
1424#if !KMP_OS_LINUX
1425 // We don't need library initialization to get the time on Linux* OS. The
1426 // routine can be used to measure library initialization time on Linux* OS now
1427 if (!__kmp_init_serial) {
1428 __kmp_serial_initialize();
1429 }
1430#endif
1431 __kmp_elapsed(&data);
1432 return data;
1433#endif
1434}
1435
1436double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTICK)(void) {
1437#ifdef KMP_STUB
1438 return __kmps_get_wtick();
1439#else
1440 double data;
1441 if (!__kmp_init_serial) {
1442 __kmp_serial_initialize();
1443 }
1444 __kmp_elapsed_tick(&data);
1445 return data;
1446#endif
1447}
1448
1449/* ------------------------------------------------------------------------ */
1450
1451void *FTN_STDCALL FTN_MALLOC(size_t KMP_DEREF size) {
1452 // kmpc_malloc initializes the library if needed
1453 return kmpc_malloc(KMP_DEREF size);
1454}
1455
1456void *FTN_STDCALL FTN_ALIGNED_MALLOC(size_t KMP_DEREF size,
1457 size_t KMP_DEREF alignment) {
1458 // kmpc_aligned_malloc initializes the library if needed
1459 return kmpc_aligned_malloc(KMP_DEREF size, KMP_DEREF alignment);
1460}
1461
1462void *FTN_STDCALL FTN_CALLOC(size_t KMP_DEREF nelem, size_t KMP_DEREF elsize) {
1463 // kmpc_calloc initializes the library if needed
1464 return kmpc_calloc(KMP_DEREF nelem, KMP_DEREF elsize);
1465}
1466
1467void *FTN_STDCALL FTN_REALLOC(void *KMP_DEREF ptr, size_t KMP_DEREF size) {
1468 // kmpc_realloc initializes the library if needed
1469 return kmpc_realloc(KMP_DEREF ptr, KMP_DEREF size);
1470}
1471
1472void FTN_STDCALL FTN_KFREE(void *KMP_DEREF ptr) {
1473 // does nothing if the library is not initialized
1474 kmpc_free(KMP_DEREF ptr);
1475}
1476
1477void FTN_STDCALL FTN_SET_WARNINGS_ON(void) {
1478#ifndef KMP_STUB
1479 __kmp_generate_warnings = kmp_warnings_explicit;
1480#endif
1481}
1482
1483void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) {
1484#ifndef KMP_STUB
1485 __kmp_generate_warnings = FALSE;
1486#endif
1487}
1488
1489void FTN_STDCALL FTN_SET_DEFAULTS(char const *str
1490#ifndef PASS_ARGS_BY_VALUE
1491 ,
1492 int len
1493#endif
1494) {
1495#ifndef KMP_STUB
1496 size_t sz;
1497 char const *defaults = str;
1498
1499#ifdef PASS_ARGS_BY_VALUE
1500 sz = KMP_STRLEN(str);
1501#else
1502 sz = (size_t)len;
1503 ConvertedString cstr(str, sz);
1504 defaults = cstr.get();
1505#endif
1506
1507 __kmp_aux_set_defaults(defaults, sz);
1508#endif
1509}
1510
1511/* ------------------------------------------------------------------------ */
1512
1513/* returns the status of cancellation */
1514int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_CANCELLATION)(void) {
1515#ifdef KMP_STUB
1516 return 0 /* false */;
1517#else
1518 // initialize the library if needed
1519 if (!__kmp_init_serial) {
1520 __kmp_serial_initialize();
1521 }
1522 return __kmp_omp_cancellation;
1523#endif
1524}
1525
1526int FTN_STDCALL FTN_GET_CANCELLATION_STATUS(int cancel_kind) {
1527#ifdef KMP_STUB
1528 return 0 /* false */;
1529#else
1530 return __kmp_get_cancellation_status(cancel_kind);
1531#endif
1532}
1533
1534/* returns the maximum allowed task priority */
1535int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_TASK_PRIORITY)(void) {
1536#ifdef KMP_STUB
1537 return 0;
1538#else
1539 if (!__kmp_init_serial) {
1540 __kmp_serial_initialize();
1541 }
1542 return __kmp_max_task_priority;
1543#endif
1544}
1545
1546// These functions will be defined in libomptarget. When libomptarget is not
1547// loaded, we assume we are on the host.
1548// Compiler/libomptarget will handle this if called inside target.
1549int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE_EXTERNAL;
1550int FTN_STDCALL FTN_GET_DEVICE_NUM(void) {
1551 return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
1552}
1553const char *FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num)
1554 KMP_WEAK_ATTRIBUTE_EXTERNAL;
1555const char *FTN_STDCALL
1556KMP_EXPAND_NAME(FTN_GET_UID_FROM_DEVICE)(int device_num) {
1557#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1558 return nullptr;
1559#else
1560 const char *(*fptr)(int);
1561 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_uid_from_device")))
1562 return (*fptr)(device_num);
1563 // Returns the same string as used by libomptarget
1564 return "HOST";
1565#endif
1566}
1567int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid)
1568 KMP_WEAK_ATTRIBUTE_EXTERNAL;
1569int FTN_STDCALL
1570KMP_EXPAND_NAME(FTN_GET_DEVICE_FROM_UID)(const char *device_uid) {
1571#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1572 return -2; // omp_invalid_device, see definition in omp.h
1573#else
1574 int (*fptr)(const char *);
1575 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_device_from_uid")))
1576 return (*fptr)(device_uid);
1577 return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
1578#endif
1579}
1580
1581// Compiler will ensure that this is only called from host in sequential region
1582int FTN_STDCALL KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE)(kmp_pause_status_t kind,
1583 int device_num) {
1584#ifdef KMP_STUB
1585 return 1; // just fail
1586#else
1587 if (kind == kmp_stop_tool_paused)
1588 return 1; // stop_tool must not be specified
1589 if (device_num == KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)())
1590 return __kmpc_pause_resource(kind);
1591 else {
1592 int (*fptr)(kmp_pause_status_t, int);
1593 if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource")))
1594 return (*fptr)(kind, device_num);
1595 else
1596 return 1; // just fail if there is no libomptarget
1597 }
1598#endif
1599}
1600
1601// Compiler will ensure that this is only called from host in sequential region
1602int FTN_STDCALL
1603 KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE_ALL)(kmp_pause_status_t kind) {
1604#ifdef KMP_STUB
1605 return 1; // just fail
1606#else
1607 int fails = 0;
1608 int (*fptr)(kmp_pause_status_t, int);
1609 if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource")))
1610 fails = (*fptr)(kind, KMP_DEVICE_ALL); // pause devices
1611 fails += __kmpc_pause_resource(kind); // pause host
1612 return fails;
1613#endif
1614}
1615
1616// Returns the maximum number of nesting levels supported by implementation
1617int FTN_STDCALL FTN_GET_SUPPORTED_ACTIVE_LEVELS(void) {
1618#ifdef KMP_STUB
1619 return 1;
1620#else
1621 return KMP_MAX_ACTIVE_LEVELS_LIMIT;
1622#endif
1623}
1624
1625void FTN_STDCALL FTN_FULFILL_EVENT(kmp_event_t *event) {
1626#ifndef KMP_STUB
1627 __kmp_fulfill_event(event);
1628#endif
1629}
1630
1631// nteams-var per-device ICV
1632void FTN_STDCALL FTN_SET_NUM_TEAMS(int KMP_DEREF num_teams) {
1633#ifdef KMP_STUB
1634// Nothing.
1635#else
1636 if (!__kmp_init_serial) {
1637 __kmp_serial_initialize();
1638 }
1639 __kmp_set_num_teams(KMP_DEREF num_teams);
1640#endif
1641}
1642int FTN_STDCALL FTN_GET_MAX_TEAMS(void) {
1643#ifdef KMP_STUB
1644 return 1;
1645#else
1646 if (!__kmp_init_serial) {
1647 __kmp_serial_initialize();
1648 }
1649 return __kmp_get_max_teams();
1650#endif
1651}
1652// teams-thread-limit-var per-device ICV
1653void FTN_STDCALL FTN_SET_TEAMS_THREAD_LIMIT(int KMP_DEREF limit) {
1654#ifdef KMP_STUB
1655// Nothing.
1656#else
1657 if (!__kmp_init_serial) {
1658 __kmp_serial_initialize();
1659 }
1660 __kmp_set_teams_thread_limit(KMP_DEREF limit);
1661#endif
1662}
1663int FTN_STDCALL FTN_GET_TEAMS_THREAD_LIMIT(void) {
1664#ifdef KMP_STUB
1665 return 1;
1666#else
1667 if (!__kmp_init_serial) {
1668 __kmp_serial_initialize();
1669 }
1670 return __kmp_get_teams_thread_limit();
1671#endif
1672}
1673
1675/* OpenMP 5.1 interop */
1676typedef intptr_t omp_intptr_t;
1677
1678/* 0..omp_get_num_interop_properties()-1 are reserved for implementation-defined
1679 * properties */
1680typedef enum omp_interop_property {
1681 omp_ipr_fr_id = -1,
1682 omp_ipr_fr_name = -2,
1683 omp_ipr_vendor = -3,
1684 omp_ipr_vendor_name = -4,
1685 omp_ipr_device_num = -5,
1686 omp_ipr_platform = -6,
1687 omp_ipr_device = -7,
1688 omp_ipr_device_context = -8,
1689 omp_ipr_targetsync = -9,
1690 omp_ipr_first = -9
1691} omp_interop_property_t;
1692
1693#define omp_interop_none 0
1694
1695typedef enum omp_interop_rc {
1696 omp_irc_no_value = 1,
1697 omp_irc_success = 0,
1698 omp_irc_empty = -1,
1699 omp_irc_out_of_range = -2,
1700 omp_irc_type_int = -3,
1701 omp_irc_type_ptr = -4,
1702 omp_irc_type_str = -5,
1703 omp_irc_other = -6
1704} omp_interop_rc_t;
1705
1706typedef enum omp_interop_fr {
1707 omp_ifr_cuda = 1,
1708 omp_ifr_cuda_driver = 2,
1709 omp_ifr_opencl = 3,
1710 omp_ifr_sycl = 4,
1711 omp_ifr_hip = 5,
1712 omp_ifr_level_zero = 6,
1713 omp_ifr_last = 7
1714} omp_interop_fr_t;
1715
1716typedef void *omp_interop_t;
1717
1718// libomptarget, if loaded, provides this function
1719int FTN_STDCALL FTN_GET_NUM_INTEROP_PROPERTIES(const omp_interop_t interop) {
1720#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1721 return 0;
1722#else
1723 int (*fptr)(const omp_interop_t);
1724 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_interop_properties")))
1725 return (*fptr)(interop);
1726 return 0;
1727#endif
1728}
1729
1731// libomptarget, if loaded, provides this function
1732intptr_t FTN_STDCALL FTN_GET_INTEROP_INT(const omp_interop_t interop,
1733 omp_interop_property_t property_id,
1734 int *err) {
1735#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1736 return 0;
1737#else
1738 intptr_t (*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1739 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_int")))
1740 return (*fptr)(interop, property_id, err);
1741 return 0;
1742#endif
1743}
1744
1745// libomptarget, if loaded, provides this function
1746void *FTN_STDCALL FTN_GET_INTEROP_PTR(const omp_interop_t interop,
1747 omp_interop_property_t property_id,
1748 int *err) {
1749#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1750 return nullptr;
1751#else
1752 void *(*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1753 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_ptr")))
1754 return (*fptr)(interop, property_id, err);
1755 return nullptr;
1756#endif
1757}
1758
1759// libomptarget, if loaded, provides this function
1760const char *FTN_STDCALL FTN_GET_INTEROP_STR(const omp_interop_t interop,
1761 omp_interop_property_t property_id,
1762 int *err) {
1763#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1764 return nullptr;
1765#else
1766 const char *(*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1767 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_str")))
1768 return (*fptr)(interop, property_id, err);
1769 return nullptr;
1770#endif
1771}
1772
1773// libomptarget, if loaded, provides this function
1774const char *FTN_STDCALL FTN_GET_INTEROP_NAME(
1775 const omp_interop_t interop, omp_interop_property_t property_id) {
1776#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1777 return nullptr;
1778#else
1779 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1780 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_name")))
1781 return (*fptr)(interop, property_id);
1782 return nullptr;
1783#endif
1784}
1785
1786// libomptarget, if loaded, provides this function
1787const char *FTN_STDCALL FTN_GET_INTEROP_TYPE_DESC(
1788 const omp_interop_t interop, omp_interop_property_t property_id) {
1789#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1790 return nullptr;
1791#else
1792 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1793 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_type_desc")))
1794 return (*fptr)(interop, property_id);
1795 return nullptr;
1796#endif
1797}
1798
1799// libomptarget, if loaded, provides this function
1800const char *FTN_STDCALL FTN_GET_INTEROP_RC_DESC(
1801 const omp_interop_t interop, omp_interop_property_t property_id) {
1802#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1803 return nullptr;
1804#else
1805 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1806 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_rec_desc")))
1807 return (*fptr)(interop, property_id);
1808 return nullptr;
1809#endif
1810}
1811
1812// display environment variables when requested
1813void FTN_STDCALL FTN_DISPLAY_ENV(int verbose) {
1814#ifndef KMP_STUB
1815 __kmp_omp_display_env(verbose);
1816#endif
1817}
1818
1819int FTN_STDCALL FTN_IN_EXPLICIT_TASK(void) {
1820#ifdef KMP_STUB
1821 return 0;
1822#else
1823 int gtid = __kmp_entry_gtid();
1824 return __kmp_thread_from_gtid(gtid)->th.th_current_task->td_flags.tasktype;
1825#endif
1826}
1827
1828// GCC compatibility (versioned symbols)
1829#ifdef KMP_USE_VERSION_SYMBOLS
1830
1831/* These following sections create versioned symbols for the
1832 omp_* routines. The KMP_VERSION_SYMBOL macro expands the API name and
1833 then maps it to a versioned symbol.
1834 libgomp ``versions'' its symbols (OMP_1.0, OMP_2.0, OMP_3.0, ...) while also
1835 retaining the default version which libomp uses: VERSION (defined in
1836 exports_so.txt). If you want to see the versioned symbols for libgomp.so.1
1837 then just type:
1838
1839 objdump -T /path/to/libgomp.so.1 | grep omp_
1840
1841 Example:
1842 Step 1) Create __kmp_api_omp_set_num_threads_10_alias which is alias of
1843 __kmp_api_omp_set_num_threads
1844 Step 2) Set __kmp_api_omp_set_num_threads_10_alias to version:
1845 omp_set_num_threads@OMP_1.0
1846 Step 2B) Set __kmp_api_omp_set_num_threads to default version:
1847 omp_set_num_threads@@VERSION
1848*/
1849
1850// OMP_1.0 versioned symbols
1851KMP_VERSION_SYMBOL(FTN_SET_NUM_THREADS, 10, "OMP_1.0");
1852KMP_VERSION_SYMBOL(FTN_GET_NUM_THREADS, 10, "OMP_1.0");
1853KMP_VERSION_SYMBOL(FTN_GET_MAX_THREADS, 10, "OMP_1.0");
1854KMP_VERSION_SYMBOL(FTN_GET_THREAD_NUM, 10, "OMP_1.0");
1855KMP_VERSION_SYMBOL(FTN_GET_NUM_PROCS, 10, "OMP_1.0");
1856KMP_VERSION_SYMBOL(FTN_IN_PARALLEL, 10, "OMP_1.0");
1857KMP_VERSION_SYMBOL(FTN_SET_DYNAMIC, 10, "OMP_1.0");
1858KMP_VERSION_SYMBOL(FTN_GET_DYNAMIC, 10, "OMP_1.0");
1859KMP_VERSION_SYMBOL(FTN_SET_NESTED, 10, "OMP_1.0");
1860KMP_VERSION_SYMBOL(FTN_GET_NESTED, 10, "OMP_1.0");
1861KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 10, "OMP_1.0");
1862KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 10, "OMP_1.0");
1863KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 10, "OMP_1.0");
1864KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0");
1865KMP_VERSION_SYMBOL(FTN_SET_LOCK, 10, "OMP_1.0");
1866KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 10, "OMP_1.0");
1867KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 10, "OMP_1.0");
1868KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0");
1869KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 10, "OMP_1.0");
1870KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 10, "OMP_1.0");
1871
1872// OMP_2.0 versioned symbols
1873KMP_VERSION_SYMBOL(FTN_GET_WTICK, 20, "OMP_2.0");
1874KMP_VERSION_SYMBOL(FTN_GET_WTIME, 20, "OMP_2.0");
1875
1876// OMP_3.0 versioned symbols
1877KMP_VERSION_SYMBOL(FTN_SET_SCHEDULE, 30, "OMP_3.0");
1878KMP_VERSION_SYMBOL(FTN_GET_SCHEDULE, 30, "OMP_3.0");
1879KMP_VERSION_SYMBOL(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0");
1880KMP_VERSION_SYMBOL(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1881KMP_VERSION_SYMBOL(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1882KMP_VERSION_SYMBOL(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0");
1883KMP_VERSION_SYMBOL(FTN_GET_LEVEL, 30, "OMP_3.0");
1884KMP_VERSION_SYMBOL(FTN_GET_TEAM_SIZE, 30, "OMP_3.0");
1885KMP_VERSION_SYMBOL(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0");
1886
1887// the lock routines have a 1.0 and 3.0 version
1888KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 30, "OMP_3.0");
1889KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 30, "OMP_3.0");
1890KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 30, "OMP_3.0");
1891KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0");
1892KMP_VERSION_SYMBOL(FTN_SET_LOCK, 30, "OMP_3.0");
1893KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 30, "OMP_3.0");
1894KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 30, "OMP_3.0");
1895KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0");
1896KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 30, "OMP_3.0");
1897KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 30, "OMP_3.0");
1898
1899// OMP_3.1 versioned symbol
1900KMP_VERSION_SYMBOL(FTN_IN_FINAL, 31, "OMP_3.1");
1901
1902// OMP_4.0 versioned symbols
1903KMP_VERSION_SYMBOL(FTN_GET_PROC_BIND, 40, "OMP_4.0");
1904KMP_VERSION_SYMBOL(FTN_GET_NUM_TEAMS, 40, "OMP_4.0");
1905KMP_VERSION_SYMBOL(FTN_GET_TEAM_NUM, 40, "OMP_4.0");
1906KMP_VERSION_SYMBOL(FTN_GET_CANCELLATION, 40, "OMP_4.0");
1907KMP_VERSION_SYMBOL(FTN_GET_DEFAULT_DEVICE, 40, "OMP_4.0");
1908KMP_VERSION_SYMBOL(FTN_SET_DEFAULT_DEVICE, 40, "OMP_4.0");
1909KMP_VERSION_SYMBOL(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0");
1910KMP_VERSION_SYMBOL(FTN_GET_NUM_DEVICES, 40, "OMP_4.0");
1911
1912// OMP_4.5 versioned symbols
1913KMP_VERSION_SYMBOL(FTN_GET_MAX_TASK_PRIORITY, 45, "OMP_4.5");
1914KMP_VERSION_SYMBOL(FTN_GET_NUM_PLACES, 45, "OMP_4.5");
1915KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM_PROCS, 45, "OMP_4.5");
1916KMP_VERSION_SYMBOL(FTN_GET_PLACE_PROC_IDS, 45, "OMP_4.5");
1917KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM, 45, "OMP_4.5");
1918KMP_VERSION_SYMBOL(FTN_GET_PARTITION_NUM_PLACES, 45, "OMP_4.5");
1919KMP_VERSION_SYMBOL(FTN_GET_PARTITION_PLACE_NUMS, 45, "OMP_4.5");
1920KMP_VERSION_SYMBOL(FTN_GET_INITIAL_DEVICE, 45, "OMP_4.5");
1921
1922// OMP_5.0 versioned symbols
1923// KMP_VERSION_SYMBOL(FTN_GET_DEVICE_NUM, 50, "OMP_5.0");
1924KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE, 50, "OMP_5.0");
1925KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE_ALL, 50, "OMP_5.0");
1926// The C versions (KMP_FTN_PLAIN) of these symbols are in kmp_csupport.c
1927#if KMP_FTN_ENTRIES == KMP_FTN_APPEND
1928KMP_VERSION_SYMBOL(FTN_CAPTURE_AFFINITY, 50, "OMP_5.0");
1929KMP_VERSION_SYMBOL(FTN_DISPLAY_AFFINITY, 50, "OMP_5.0");
1930KMP_VERSION_SYMBOL(FTN_GET_AFFINITY_FORMAT, 50, "OMP_5.0");
1931KMP_VERSION_SYMBOL(FTN_SET_AFFINITY_FORMAT, 50, "OMP_5.0");
1932#endif
1933// KMP_VERSION_SYMBOL(FTN_GET_SUPPORTED_ACTIVE_LEVELS, 50, "OMP_5.0");
1934// KMP_VERSION_SYMBOL(FTN_FULFILL_EVENT, 50, "OMP_5.0");
1935
1936// OMP_6.0 versioned symbols
1937KMP_VERSION_SYMBOL(FTN_GET_UID_FROM_DEVICE, 60, "OMP_6.0");
1938KMP_VERSION_SYMBOL(FTN_GET_DEVICE_FROM_UID, 60, "OMP_6.0");
1939
1940#endif // KMP_USE_VERSION_SYMBOLS
1941
1942#ifdef __cplusplus
1943} // extern "C"
1944#endif // __cplusplus
1945
1946// end of file //
__kmpc_bound_num_threads
KMP_EXPORT kmp_int32 __kmpc_bound_num_threads(ident_t *)
Definition kmp_csupport.cpp:145
Generated by doxygen 1.15.0