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