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

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