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