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