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 __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 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 = (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; 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 // Compilier/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; 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; 967 int FTN_STDCALL FTN_GET_INITIAL_DEVICE(void) { 968 #if KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB) 969 return KMP_HOST_DEVICE; 970 #else 971 int (*fptr)(); 972 if ((*(void **)(&fptr) = dlsym(RTLD_NEXT, "omp_get_initial_device"))) { 973 return (*fptr)(); 974 } else { // liboffload & libomptarget don't exist 975 return KMP_HOST_DEVICE; 976 } 977 #endif 978 } 979 980 #if defined(KMP_STUB) 981 // Entries for stubs library 982 // As all *target* functions are C-only parameters always passed by value 983 void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; } 984 985 void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {} 986 987 int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; } 988 989 int FTN_STDCALL FTN_TARGET_MEMCPY(void *dst, void *src, size_t length, 990 size_t dst_offset, size_t src_offset, 991 int dst_device, int src_device) { 992 return -1; 993 } 994 995 int FTN_STDCALL FTN_TARGET_MEMCPY_RECT( 996 void *dst, void *src, size_t element_size, int num_dims, 997 const size_t *volume, const size_t *dst_offsets, const size_t *src_offsets, 998 const size_t *dst_dimensions, const size_t *src_dimensions, int dst_device, 999 int src_device) { 1000 return -1; 1001 } 1002 1003 int FTN_STDCALL FTN_TARGET_ASSOCIATE_PTR(void *host_ptr, void *device_ptr, 1004 size_t size, size_t device_offset, 1005 int device_num) { 1006 return -1; 1007 } 1008 1009 int FTN_STDCALL FTN_TARGET_DISASSOCIATE_PTR(void *host_ptr, int device_num) { 1010 return -1; 1011 } 1012 #endif // defined(KMP_STUB) 1013 1014 #ifdef KMP_STUB 1015 typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t; 1016 #endif /* KMP_STUB */ 1017 1018 #if KMP_USE_DYNAMIC_LOCK 1019 void FTN_STDCALL FTN_INIT_LOCK_WITH_HINT(void **user_lock, 1020 uintptr_t KMP_DEREF hint) { 1021 #ifdef KMP_STUB 1022 *((kmp_stub_lock_t *)user_lock) = UNLOCKED; 1023 #else 1024 int gtid = __kmp_entry_gtid(); 1025 #if OMPT_SUPPORT && OMPT_OPTIONAL 1026 OMPT_STORE_RETURN_ADDRESS(gtid); 1027 #endif 1028 __kmpc_init_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint); 1029 #endif 1030 } 1031 1032 void FTN_STDCALL FTN_INIT_NEST_LOCK_WITH_HINT(void **user_lock, 1033 uintptr_t KMP_DEREF hint) { 1034 #ifdef KMP_STUB 1035 *((kmp_stub_lock_t *)user_lock) = UNLOCKED; 1036 #else 1037 int gtid = __kmp_entry_gtid(); 1038 #if OMPT_SUPPORT && OMPT_OPTIONAL 1039 OMPT_STORE_RETURN_ADDRESS(gtid); 1040 #endif 1041 __kmpc_init_nest_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint); 1042 #endif 1043 } 1044 #endif 1045 1046 /* initialize the lock */ 1047 void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_LOCK)(void **user_lock) { 1048 #ifdef KMP_STUB 1049 *((kmp_stub_lock_t *)user_lock) = UNLOCKED; 1050 #else 1051 int gtid = __kmp_entry_gtid(); 1052 #if OMPT_SUPPORT && OMPT_OPTIONAL 1053 OMPT_STORE_RETURN_ADDRESS(gtid); 1054 #endif 1055 __kmpc_init_lock(NULL, gtid, user_lock); 1056 #endif 1057 } 1058 1059 /* initialize the lock */ 1060 void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_NEST_LOCK)(void **user_lock) { 1061 #ifdef KMP_STUB 1062 *((kmp_stub_lock_t *)user_lock) = UNLOCKED; 1063 #else 1064 int gtid = __kmp_entry_gtid(); 1065 #if OMPT_SUPPORT && OMPT_OPTIONAL 1066 OMPT_STORE_RETURN_ADDRESS(gtid); 1067 #endif 1068 __kmpc_init_nest_lock(NULL, gtid, user_lock); 1069 #endif 1070 } 1071 1072 void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_LOCK)(void **user_lock) { 1073 #ifdef KMP_STUB 1074 *((kmp_stub_lock_t *)user_lock) = UNINIT; 1075 #else 1076 int gtid = __kmp_entry_gtid(); 1077 #if OMPT_SUPPORT && OMPT_OPTIONAL 1078 OMPT_STORE_RETURN_ADDRESS(gtid); 1079 #endif 1080 __kmpc_destroy_lock(NULL, gtid, user_lock); 1081 #endif 1082 } 1083 1084 void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_NEST_LOCK)(void **user_lock) { 1085 #ifdef KMP_STUB 1086 *((kmp_stub_lock_t *)user_lock) = UNINIT; 1087 #else 1088 int gtid = __kmp_entry_gtid(); 1089 #if OMPT_SUPPORT && OMPT_OPTIONAL 1090 OMPT_STORE_RETURN_ADDRESS(gtid); 1091 #endif 1092 __kmpc_destroy_nest_lock(NULL, gtid, user_lock); 1093 #endif 1094 } 1095 1096 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_LOCK)(void **user_lock) { 1097 #ifdef KMP_STUB 1098 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { 1099 // TODO: Issue an error. 1100 } 1101 if (*((kmp_stub_lock_t *)user_lock) != UNLOCKED) { 1102 // TODO: Issue an error. 1103 } 1104 *((kmp_stub_lock_t *)user_lock) = LOCKED; 1105 #else 1106 int gtid = __kmp_entry_gtid(); 1107 #if OMPT_SUPPORT && OMPT_OPTIONAL 1108 OMPT_STORE_RETURN_ADDRESS(gtid); 1109 #endif 1110 __kmpc_set_lock(NULL, gtid, user_lock); 1111 #endif 1112 } 1113 1114 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NEST_LOCK)(void **user_lock) { 1115 #ifdef KMP_STUB 1116 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { 1117 // TODO: Issue an error. 1118 } 1119 (*((int *)user_lock))++; 1120 #else 1121 int gtid = __kmp_entry_gtid(); 1122 #if OMPT_SUPPORT && OMPT_OPTIONAL 1123 OMPT_STORE_RETURN_ADDRESS(gtid); 1124 #endif 1125 __kmpc_set_nest_lock(NULL, gtid, user_lock); 1126 #endif 1127 } 1128 1129 void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_LOCK)(void **user_lock) { 1130 #ifdef KMP_STUB 1131 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { 1132 // TODO: Issue an error. 1133 } 1134 if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) { 1135 // TODO: Issue an error. 1136 } 1137 *((kmp_stub_lock_t *)user_lock) = UNLOCKED; 1138 #else 1139 int gtid = __kmp_entry_gtid(); 1140 #if OMPT_SUPPORT && OMPT_OPTIONAL 1141 OMPT_STORE_RETURN_ADDRESS(gtid); 1142 #endif 1143 __kmpc_unset_lock(NULL, gtid, user_lock); 1144 #endif 1145 } 1146 1147 void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_NEST_LOCK)(void **user_lock) { 1148 #ifdef KMP_STUB 1149 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { 1150 // TODO: Issue an error. 1151 } 1152 if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) { 1153 // TODO: Issue an error. 1154 } 1155 (*((int *)user_lock))--; 1156 #else 1157 int gtid = __kmp_entry_gtid(); 1158 #if OMPT_SUPPORT && OMPT_OPTIONAL 1159 OMPT_STORE_RETURN_ADDRESS(gtid); 1160 #endif 1161 __kmpc_unset_nest_lock(NULL, gtid, user_lock); 1162 #endif 1163 } 1164 1165 int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_LOCK)(void **user_lock) { 1166 #ifdef KMP_STUB 1167 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { 1168 // TODO: Issue an error. 1169 } 1170 if (*((kmp_stub_lock_t *)user_lock) == LOCKED) { 1171 return 0; 1172 } 1173 *((kmp_stub_lock_t *)user_lock) = LOCKED; 1174 return 1; 1175 #else 1176 int gtid = __kmp_entry_gtid(); 1177 #if OMPT_SUPPORT && OMPT_OPTIONAL 1178 OMPT_STORE_RETURN_ADDRESS(gtid); 1179 #endif 1180 return __kmpc_test_lock(NULL, gtid, user_lock); 1181 #endif 1182 } 1183 1184 int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_NEST_LOCK)(void **user_lock) { 1185 #ifdef KMP_STUB 1186 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { 1187 // TODO: Issue an error. 1188 } 1189 return ++(*((int *)user_lock)); 1190 #else 1191 int gtid = __kmp_entry_gtid(); 1192 #if OMPT_SUPPORT && OMPT_OPTIONAL 1193 OMPT_STORE_RETURN_ADDRESS(gtid); 1194 #endif 1195 return __kmpc_test_nest_lock(NULL, gtid, user_lock); 1196 #endif 1197 } 1198 1199 double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTIME)(void) { 1200 #ifdef KMP_STUB 1201 return __kmps_get_wtime(); 1202 #else 1203 double data; 1204 #if !KMP_OS_LINUX 1205 // We don't need library initialization to get the time on Linux* OS. The 1206 // routine can be used to measure library initialization time on Linux* OS now 1207 if (!__kmp_init_serial) { 1208 __kmp_serial_initialize(); 1209 } 1210 #endif 1211 __kmp_elapsed(&data); 1212 return data; 1213 #endif 1214 } 1215 1216 double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTICK)(void) { 1217 #ifdef KMP_STUB 1218 return __kmps_get_wtick(); 1219 #else 1220 double data; 1221 if (!__kmp_init_serial) { 1222 __kmp_serial_initialize(); 1223 } 1224 __kmp_elapsed_tick(&data); 1225 return data; 1226 #endif 1227 } 1228 1229 /* ------------------------------------------------------------------------ */ 1230 1231 void *FTN_STDCALL FTN_MALLOC(size_t KMP_DEREF size) { 1232 // kmpc_malloc initializes the library if needed 1233 return kmpc_malloc(KMP_DEREF size); 1234 } 1235 1236 void *FTN_STDCALL FTN_ALIGNED_MALLOC(size_t KMP_DEREF size, 1237 size_t KMP_DEREF alignment) { 1238 // kmpc_aligned_malloc initializes the library if needed 1239 return kmpc_aligned_malloc(KMP_DEREF size, KMP_DEREF alignment); 1240 } 1241 1242 void *FTN_STDCALL FTN_CALLOC(size_t KMP_DEREF nelem, size_t KMP_DEREF elsize) { 1243 // kmpc_calloc initializes the library if needed 1244 return kmpc_calloc(KMP_DEREF nelem, KMP_DEREF elsize); 1245 } 1246 1247 void *FTN_STDCALL FTN_REALLOC(void *KMP_DEREF ptr, size_t KMP_DEREF size) { 1248 // kmpc_realloc initializes the library if needed 1249 return kmpc_realloc(KMP_DEREF ptr, KMP_DEREF size); 1250 } 1251 1252 void FTN_STDCALL FTN_KFREE(void *KMP_DEREF ptr) { 1253 // does nothing if the library is not initialized 1254 kmpc_free(KMP_DEREF ptr); 1255 } 1256 1257 void FTN_STDCALL FTN_SET_WARNINGS_ON(void) { 1258 #ifndef KMP_STUB 1259 __kmp_generate_warnings = kmp_warnings_explicit; 1260 #endif 1261 } 1262 1263 void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) { 1264 #ifndef KMP_STUB 1265 __kmp_generate_warnings = FALSE; 1266 #endif 1267 } 1268 1269 void FTN_STDCALL FTN_SET_DEFAULTS(char const *str 1270 #ifndef PASS_ARGS_BY_VALUE 1271 , 1272 int len 1273 #endif 1274 ) { 1275 #ifndef KMP_STUB 1276 #ifdef PASS_ARGS_BY_VALUE 1277 int len = (int)KMP_STRLEN(str); 1278 #endif 1279 __kmp_aux_set_defaults(str, len); 1280 #endif 1281 } 1282 1283 /* ------------------------------------------------------------------------ */ 1284 1285 /* returns the status of cancellation */ 1286 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_CANCELLATION)(void) { 1287 #ifdef KMP_STUB 1288 return 0 /* false */; 1289 #else 1290 // initialize the library if needed 1291 if (!__kmp_init_serial) { 1292 __kmp_serial_initialize(); 1293 } 1294 return __kmp_omp_cancellation; 1295 #endif 1296 } 1297 1298 int FTN_STDCALL FTN_GET_CANCELLATION_STATUS(int cancel_kind) { 1299 #ifdef KMP_STUB 1300 return 0 /* false */; 1301 #else 1302 return __kmp_get_cancellation_status(cancel_kind); 1303 #endif 1304 } 1305 1306 /* returns the maximum allowed task priority */ 1307 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_TASK_PRIORITY)(void) { 1308 #ifdef KMP_STUB 1309 return 0; 1310 #else 1311 if (!__kmp_init_serial) { 1312 __kmp_serial_initialize(); 1313 } 1314 return __kmp_max_task_priority; 1315 #endif 1316 } 1317 1318 // This function will be defined in libomptarget. When libomptarget is not 1319 // loaded, we assume we are on the host and return KMP_HOST_DEVICE. 1320 // Compiler/libomptarget will handle this if called inside target. 1321 int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE; 1322 int FTN_STDCALL FTN_GET_DEVICE_NUM(void) { return KMP_HOST_DEVICE; } 1323 1324 // Compiler will ensure that this is only called from host in sequential region 1325 int FTN_STDCALL FTN_PAUSE_RESOURCE(kmp_pause_status_t kind, int device_num) { 1326 #ifdef KMP_STUB 1327 return 1; // just fail 1328 #else 1329 if (device_num == KMP_HOST_DEVICE) 1330 return __kmpc_pause_resource(kind); 1331 else { 1332 #if !KMP_OS_WINDOWS 1333 int (*fptr)(kmp_pause_status_t, int); 1334 if ((*(void **)(&fptr) = dlsym(RTLD_DEFAULT, "tgt_pause_resource"))) 1335 return (*fptr)(kind, device_num); 1336 else 1337 #endif 1338 return 1; // just fail if there is no libomptarget 1339 } 1340 #endif 1341 } 1342 1343 // Compiler will ensure that this is only called from host in sequential region 1344 int FTN_STDCALL FTN_PAUSE_RESOURCE_ALL(kmp_pause_status_t kind) { 1345 #ifdef KMP_STUB 1346 return 1; // just fail 1347 #else 1348 int fails = 0; 1349 #if !KMP_OS_WINDOWS 1350 int (*fptr)(kmp_pause_status_t, int); 1351 if ((*(void **)(&fptr) = dlsym(RTLD_DEFAULT, "tgt_pause_resource"))) 1352 fails = (*fptr)(kind, KMP_DEVICE_ALL); // pause devices 1353 #endif 1354 fails += __kmpc_pause_resource(kind); // pause host 1355 return fails; 1356 #endif 1357 } 1358 1359 // Returns the maximum number of nesting levels supported by implementation 1360 int FTN_STDCALL FTN_GET_SUPPORTED_ACTIVE_LEVELS(void) { 1361 #ifdef KMP_STUB 1362 return 1; 1363 #else 1364 return KMP_MAX_ACTIVE_LEVELS_LIMIT; 1365 #endif 1366 } 1367 1368 void FTN_STDCALL FTN_FULFILL_EVENT(kmp_event_t *event) { 1369 #ifndef KMP_STUB 1370 __kmp_fulfill_event(event); 1371 #endif 1372 } 1373 1374 // GCC compatibility (versioned symbols) 1375 #ifdef KMP_USE_VERSION_SYMBOLS 1376 1377 /* These following sections create versioned symbols for the 1378 omp_* routines. The KMP_VERSION_SYMBOL macro expands the API name and 1379 then maps it to a versioned symbol. 1380 libgomp ``versions'' its symbols (OMP_1.0, OMP_2.0, OMP_3.0, ...) while also 1381 retaining the default version which libomp uses: VERSION (defined in 1382 exports_so.txt). If you want to see the versioned symbols for libgomp.so.1 1383 then just type: 1384 1385 objdump -T /path/to/libgomp.so.1 | grep omp_ 1386 1387 Example: 1388 Step 1) Create __kmp_api_omp_set_num_threads_10_alias which is alias of 1389 __kmp_api_omp_set_num_threads 1390 Step 2) Set __kmp_api_omp_set_num_threads_10_alias to version: 1391 omp_set_num_threads@OMP_1.0 1392 Step 2B) Set __kmp_api_omp_set_num_threads to default version: 1393 omp_set_num_threads@@VERSION 1394 */ 1395 1396 // OMP_1.0 versioned symbols 1397 KMP_VERSION_SYMBOL(FTN_SET_NUM_THREADS, 10, "OMP_1.0"); 1398 KMP_VERSION_SYMBOL(FTN_GET_NUM_THREADS, 10, "OMP_1.0"); 1399 KMP_VERSION_SYMBOL(FTN_GET_MAX_THREADS, 10, "OMP_1.0"); 1400 KMP_VERSION_SYMBOL(FTN_GET_THREAD_NUM, 10, "OMP_1.0"); 1401 KMP_VERSION_SYMBOL(FTN_GET_NUM_PROCS, 10, "OMP_1.0"); 1402 KMP_VERSION_SYMBOL(FTN_IN_PARALLEL, 10, "OMP_1.0"); 1403 KMP_VERSION_SYMBOL(FTN_SET_DYNAMIC, 10, "OMP_1.0"); 1404 KMP_VERSION_SYMBOL(FTN_GET_DYNAMIC, 10, "OMP_1.0"); 1405 KMP_VERSION_SYMBOL(FTN_SET_NESTED, 10, "OMP_1.0"); 1406 KMP_VERSION_SYMBOL(FTN_GET_NESTED, 10, "OMP_1.0"); 1407 KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 10, "OMP_1.0"); 1408 KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 10, "OMP_1.0"); 1409 KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 10, "OMP_1.0"); 1410 KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0"); 1411 KMP_VERSION_SYMBOL(FTN_SET_LOCK, 10, "OMP_1.0"); 1412 KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 10, "OMP_1.0"); 1413 KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 10, "OMP_1.0"); 1414 KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0"); 1415 KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 10, "OMP_1.0"); 1416 KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 10, "OMP_1.0"); 1417 1418 // OMP_2.0 versioned symbols 1419 KMP_VERSION_SYMBOL(FTN_GET_WTICK, 20, "OMP_2.0"); 1420 KMP_VERSION_SYMBOL(FTN_GET_WTIME, 20, "OMP_2.0"); 1421 1422 // OMP_3.0 versioned symbols 1423 KMP_VERSION_SYMBOL(FTN_SET_SCHEDULE, 30, "OMP_3.0"); 1424 KMP_VERSION_SYMBOL(FTN_GET_SCHEDULE, 30, "OMP_3.0"); 1425 KMP_VERSION_SYMBOL(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0"); 1426 KMP_VERSION_SYMBOL(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0"); 1427 KMP_VERSION_SYMBOL(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0"); 1428 KMP_VERSION_SYMBOL(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0"); 1429 KMP_VERSION_SYMBOL(FTN_GET_LEVEL, 30, "OMP_3.0"); 1430 KMP_VERSION_SYMBOL(FTN_GET_TEAM_SIZE, 30, "OMP_3.0"); 1431 KMP_VERSION_SYMBOL(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0"); 1432 1433 // the lock routines have a 1.0 and 3.0 version 1434 KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 30, "OMP_3.0"); 1435 KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 30, "OMP_3.0"); 1436 KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 30, "OMP_3.0"); 1437 KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0"); 1438 KMP_VERSION_SYMBOL(FTN_SET_LOCK, 30, "OMP_3.0"); 1439 KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 30, "OMP_3.0"); 1440 KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 30, "OMP_3.0"); 1441 KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0"); 1442 KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 30, "OMP_3.0"); 1443 KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 30, "OMP_3.0"); 1444 1445 // OMP_3.1 versioned symbol 1446 KMP_VERSION_SYMBOL(FTN_IN_FINAL, 31, "OMP_3.1"); 1447 1448 // OMP_4.0 versioned symbols 1449 KMP_VERSION_SYMBOL(FTN_GET_PROC_BIND, 40, "OMP_4.0"); 1450 KMP_VERSION_SYMBOL(FTN_GET_NUM_TEAMS, 40, "OMP_4.0"); 1451 KMP_VERSION_SYMBOL(FTN_GET_TEAM_NUM, 40, "OMP_4.0"); 1452 KMP_VERSION_SYMBOL(FTN_GET_CANCELLATION, 40, "OMP_4.0"); 1453 KMP_VERSION_SYMBOL(FTN_GET_DEFAULT_DEVICE, 40, "OMP_4.0"); 1454 KMP_VERSION_SYMBOL(FTN_SET_DEFAULT_DEVICE, 40, "OMP_4.0"); 1455 KMP_VERSION_SYMBOL(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0"); 1456 KMP_VERSION_SYMBOL(FTN_GET_NUM_DEVICES, 40, "OMP_4.0"); 1457 1458 // OMP_4.5 versioned symbols 1459 KMP_VERSION_SYMBOL(FTN_GET_MAX_TASK_PRIORITY, 45, "OMP_4.5"); 1460 KMP_VERSION_SYMBOL(FTN_GET_NUM_PLACES, 45, "OMP_4.5"); 1461 KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM_PROCS, 45, "OMP_4.5"); 1462 KMP_VERSION_SYMBOL(FTN_GET_PLACE_PROC_IDS, 45, "OMP_4.5"); 1463 KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM, 45, "OMP_4.5"); 1464 KMP_VERSION_SYMBOL(FTN_GET_PARTITION_NUM_PLACES, 45, "OMP_4.5"); 1465 KMP_VERSION_SYMBOL(FTN_GET_PARTITION_PLACE_NUMS, 45, "OMP_4.5"); 1466 // KMP_VERSION_SYMBOL(FTN_GET_INITIAL_DEVICE, 45, "OMP_4.5"); 1467 1468 // OMP_5.0 versioned symbols 1469 // KMP_VERSION_SYMBOL(FTN_GET_DEVICE_NUM, 50, "OMP_5.0"); 1470 // KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE, 50, "OMP_5.0"); 1471 // KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE_ALL, 50, "OMP_5.0"); 1472 // KMP_VERSION_SYMBOL(FTN_GET_SUPPORTED_ACTIVE_LEVELS, 50, "OMP_5.0"); 1473 // KMP_VERSION_SYMBOL(FTN_FULFILL_EVENT, 50, "OMP_5.0"); 1474 1475 #endif // KMP_USE_VERSION_SYMBOLS 1476 1477 #ifdef __cplusplus 1478 } // extern "C" 1479 #endif // __cplusplus 1480 1481 // end of file // 1482