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