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