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