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