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 32extern "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 61void 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 70void 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 79int 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 90size_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 101void 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 116int 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 150void 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 159void 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 168void 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 177void 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 188int 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 199void 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 210int 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 221int 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 232int 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 244void 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 259void 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 279int 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 290int 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 301int 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 */ 315void 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 */ 324int 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 333int 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 350int 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 */ 368omp_allocator_handle_t FTN_STDCALL 369FTN_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 379void 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} 384void 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} 389omp_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 399static 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 416class ConvertedString { 417 char *buf; 418 kmp_info_t *th; 419 420public: 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*/ 436void 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*/ 457size_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*/ 479void 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*/ 503size_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 527int 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 = (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 570int 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 583int 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 594void 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 611int 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 622void 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 635int 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 645int 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 661void 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 671void 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 681void 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 690int 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 699int 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 708int 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 717int 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 726int 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 734int 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 750int 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 761kmp_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 769int 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 782int 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 807void 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 832int 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 851int 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 876void 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 907int 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 915int 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 923int 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 931void 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. 942int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) KMP_WEAK_ATTRIBUTE; 943int 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. 960int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) KMP_WEAK_ATTRIBUTE; 961int 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 966int FTN_STDCALL FTN_GET_INITIAL_DEVICE(void) KMP_WEAK_ATTRIBUTE; 967int 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 983void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; } 984 985void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {} 986 987int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; } 988 989int 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 995int 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 1003int 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 1009int 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 1015typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t; 1016#endif /* KMP_STUB */ 1017 1018#if KMP_USE_DYNAMIC_LOCK 1019void 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 1032void 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 */ 1047void 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 */ 1060void 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 1072void 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 1084void 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 1096void 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 1114void 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 1129void 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 1147void 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 1165int 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 1184int 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 1199double 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 1216double 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 1231void *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 1236void *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 1242void *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 1247void *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 1252void 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 1257void FTN_STDCALL FTN_SET_WARNINGS_ON(void) { 1258#ifndef KMP_STUB 1259 __kmp_generate_warnings = kmp_warnings_explicit; 1260#endif 1261} 1262 1263void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) { 1264#ifndef KMP_STUB 1265 __kmp_generate_warnings = FALSE; 1266#endif 1267} 1268 1269void 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 */ 1286int 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 1298int 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 */ 1307int 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. 1321int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE; 1322int 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 1325int 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 1344int 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 1360int 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 1368void 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 1397KMP_VERSION_SYMBOL(FTN_SET_NUM_THREADS, 10, "OMP_1.0"); 1398KMP_VERSION_SYMBOL(FTN_GET_NUM_THREADS, 10, "OMP_1.0"); 1399KMP_VERSION_SYMBOL(FTN_GET_MAX_THREADS, 10, "OMP_1.0"); 1400KMP_VERSION_SYMBOL(FTN_GET_THREAD_NUM, 10, "OMP_1.0"); 1401KMP_VERSION_SYMBOL(FTN_GET_NUM_PROCS, 10, "OMP_1.0"); 1402KMP_VERSION_SYMBOL(FTN_IN_PARALLEL, 10, "OMP_1.0"); 1403KMP_VERSION_SYMBOL(FTN_SET_DYNAMIC, 10, "OMP_1.0"); 1404KMP_VERSION_SYMBOL(FTN_GET_DYNAMIC, 10, "OMP_1.0"); 1405KMP_VERSION_SYMBOL(FTN_SET_NESTED, 10, "OMP_1.0"); 1406KMP_VERSION_SYMBOL(FTN_GET_NESTED, 10, "OMP_1.0"); 1407KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 10, "OMP_1.0"); 1408KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 10, "OMP_1.0"); 1409KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 10, "OMP_1.0"); 1410KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0"); 1411KMP_VERSION_SYMBOL(FTN_SET_LOCK, 10, "OMP_1.0"); 1412KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 10, "OMP_1.0"); 1413KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 10, "OMP_1.0"); 1414KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0"); 1415KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 10, "OMP_1.0"); 1416KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 10, "OMP_1.0"); 1417 1418// OMP_2.0 versioned symbols 1419KMP_VERSION_SYMBOL(FTN_GET_WTICK, 20, "OMP_2.0"); 1420KMP_VERSION_SYMBOL(FTN_GET_WTIME, 20, "OMP_2.0"); 1421 1422// OMP_3.0 versioned symbols 1423KMP_VERSION_SYMBOL(FTN_SET_SCHEDULE, 30, "OMP_3.0"); 1424KMP_VERSION_SYMBOL(FTN_GET_SCHEDULE, 30, "OMP_3.0"); 1425KMP_VERSION_SYMBOL(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0"); 1426KMP_VERSION_SYMBOL(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0"); 1427KMP_VERSION_SYMBOL(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0"); 1428KMP_VERSION_SYMBOL(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0"); 1429KMP_VERSION_SYMBOL(FTN_GET_LEVEL, 30, "OMP_3.0"); 1430KMP_VERSION_SYMBOL(FTN_GET_TEAM_SIZE, 30, "OMP_3.0"); 1431KMP_VERSION_SYMBOL(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0"); 1432 1433// the lock routines have a 1.0 and 3.0 version 1434KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 30, "OMP_3.0"); 1435KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 30, "OMP_3.0"); 1436KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 30, "OMP_3.0"); 1437KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0"); 1438KMP_VERSION_SYMBOL(FTN_SET_LOCK, 30, "OMP_3.0"); 1439KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 30, "OMP_3.0"); 1440KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 30, "OMP_3.0"); 1441KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0"); 1442KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 30, "OMP_3.0"); 1443KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 30, "OMP_3.0"); 1444 1445// OMP_3.1 versioned symbol 1446KMP_VERSION_SYMBOL(FTN_IN_FINAL, 31, "OMP_3.1"); 1447 1448// OMP_4.0 versioned symbols 1449KMP_VERSION_SYMBOL(FTN_GET_PROC_BIND, 40, "OMP_4.0"); 1450KMP_VERSION_SYMBOL(FTN_GET_NUM_TEAMS, 40, "OMP_4.0"); 1451KMP_VERSION_SYMBOL(FTN_GET_TEAM_NUM, 40, "OMP_4.0"); 1452KMP_VERSION_SYMBOL(FTN_GET_CANCELLATION, 40, "OMP_4.0"); 1453KMP_VERSION_SYMBOL(FTN_GET_DEFAULT_DEVICE, 40, "OMP_4.0"); 1454KMP_VERSION_SYMBOL(FTN_SET_DEFAULT_DEVICE, 40, "OMP_4.0"); 1455KMP_VERSION_SYMBOL(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0"); 1456KMP_VERSION_SYMBOL(FTN_GET_NUM_DEVICES, 40, "OMP_4.0"); 1457 1458// OMP_4.5 versioned symbols 1459KMP_VERSION_SYMBOL(FTN_GET_MAX_TASK_PRIORITY, 45, "OMP_4.5"); 1460KMP_VERSION_SYMBOL(FTN_GET_NUM_PLACES, 45, "OMP_4.5"); 1461KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM_PROCS, 45, "OMP_4.5"); 1462KMP_VERSION_SYMBOL(FTN_GET_PLACE_PROC_IDS, 45, "OMP_4.5"); 1463KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM, 45, "OMP_4.5"); 1464KMP_VERSION_SYMBOL(FTN_GET_PARTITION_NUM_PLACES, 45, "OMP_4.5"); 1465KMP_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