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