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