1 /* 2 * kmp_ftn_entry.h -- Fortran entry linkage support for OpenMP. 3 */ 4 5 //===----------------------------------------------------------------------===// 6 // 7 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 8 // See https://llvm.org/LICENSE.txt for license information. 9 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 10 // 11 //===----------------------------------------------------------------------===// 12 13 #ifndef FTN_STDCALL 14 #error The support file kmp_ftn_entry.h should not be compiled by itself. 15 #endif 16 17 #ifdef KMP_STUB 18 #include "kmp_stub.h" 19 #endif 20 21 #include "kmp_i18n.h" 22 23 // For affinity format functions 24 #include "kmp_io.h" 25 #include "kmp_str.h" 26 27 #if OMPT_SUPPORT 28 #include "ompt-specific.h" 29 #endif 30 31 #ifdef __cplusplus 32 extern "C" { 33 #endif // __cplusplus 34 35 /* For compatibility with the Gnu/MS Open MP codegen, omp_set_num_threads(), 36 * omp_set_nested(), and omp_set_dynamic() [in lowercase on MS, and w/o 37 * a trailing underscore on Linux* OS] take call by value integer arguments. 38 * + omp_set_max_active_levels() 39 * + omp_set_schedule() 40 * 41 * For backward compatibility with 9.1 and previous Intel compiler, these 42 * entry points take call by reference integer arguments. */ 43 #ifdef KMP_GOMP_COMPAT 44 #if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_UPPER) 45 #define PASS_ARGS_BY_VALUE 1 46 #endif 47 #endif 48 #if KMP_OS_WINDOWS 49 #if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_APPEND) 50 #define PASS_ARGS_BY_VALUE 1 51 #endif 52 #endif 53 54 // This macro helps to reduce code duplication. 55 #ifdef PASS_ARGS_BY_VALUE 56 #define KMP_DEREF 57 #else 58 #define KMP_DEREF * 59 #endif 60 61 // For API with specific C vs. Fortran interfaces (ompc_* exists in 62 // kmp_csupport.cpp), only create GOMP versioned symbols of the API for the 63 // APPEND Fortran entries in this file. The GOMP versioned symbols of the C API 64 // will take place where the ompc_* functions are defined. 65 #if KMP_FTN_ENTRIES == KMP_FTN_APPEND 66 #define KMP_EXPAND_NAME_IF_APPEND(name) KMP_EXPAND_NAME(name) 67 #else 68 #define KMP_EXPAND_NAME_IF_APPEND(name) name 69 #endif 70 71 void FTN_STDCALL FTN_SET_STACKSIZE(int KMP_DEREF arg) { 72 #ifdef KMP_STUB 73 __kmps_set_stacksize(KMP_DEREF arg); 74 #else 75 // __kmp_aux_set_stacksize initializes the library if needed 76 __kmp_aux_set_stacksize((size_t)KMP_DEREF arg); 77 #endif 78 } 79 80 void FTN_STDCALL FTN_SET_STACKSIZE_S(size_t KMP_DEREF arg) { 81 #ifdef KMP_STUB 82 __kmps_set_stacksize(KMP_DEREF arg); 83 #else 84 // __kmp_aux_set_stacksize initializes the library if needed 85 __kmp_aux_set_stacksize(KMP_DEREF arg); 86 #endif 87 } 88 89 int FTN_STDCALL FTN_GET_STACKSIZE(void) { 90 #ifdef KMP_STUB 91 return (int)__kmps_get_stacksize(); 92 #else 93 if (!__kmp_init_serial) { 94 __kmp_serial_initialize(); 95 } 96 return (int)__kmp_stksize; 97 #endif 98 } 99 100 size_t FTN_STDCALL FTN_GET_STACKSIZE_S(void) { 101 #ifdef KMP_STUB 102 return __kmps_get_stacksize(); 103 #else 104 if (!__kmp_init_serial) { 105 __kmp_serial_initialize(); 106 } 107 return __kmp_stksize; 108 #endif 109 } 110 111 void FTN_STDCALL FTN_SET_BLOCKTIME(int KMP_DEREF arg) { 112 #ifdef KMP_STUB 113 __kmps_set_blocktime(KMP_DEREF arg); 114 #else 115 int gtid, tid; 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 */ 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 */ 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 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 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 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 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 } 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 } 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 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: 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 } 455 ~ConvertedString() { __kmp_thread_free(th, buf); } 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 */ 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 */ 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 */ 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 */ 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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; 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; 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; 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 1069 void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; } 1070 1071 void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {} 1072 1073 int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; } 1074 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 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 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 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 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 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 */ 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 */ 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 1343 void FTN_STDCALL FTN_SET_WARNINGS_ON(void) { 1344 #ifndef KMP_STUB 1345 __kmp_generate_warnings = kmp_warnings_explicit; 1346 #endif 1347 } 1348 1349 void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) { 1350 #ifndef KMP_STUB 1351 __kmp_generate_warnings = FALSE; 1352 #endif 1353 } 1354 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 */ 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 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 */ 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; 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 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 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 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 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 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 } 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 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 } 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 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 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 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 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 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 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 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 1618 void FTN_STDCALL FTN_DISPLAY_ENV(int verbose) { 1619 #ifndef KMP_STUB 1620 __kmp_omp_display_env(verbose); 1621 #endif 1622 } 1623 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