|  | /* | 
|  | * kmp_ftn_entry.h -- Fortran entry linkage support for OpenMP. | 
|  | */ | 
|  |  | 
|  | //===----------------------------------------------------------------------===// | 
|  | // | 
|  | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. | 
|  | // See https://llvm.org/LICENSE.txt for license information. | 
|  | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception | 
|  | // | 
|  | //===----------------------------------------------------------------------===// | 
|  |  | 
|  | #ifndef FTN_STDCALL | 
|  | #error The support file kmp_ftn_entry.h should not be compiled by itself. | 
|  | #endif | 
|  |  | 
|  | #ifdef KMP_STUB | 
|  | #include "kmp_stub.h" | 
|  | #endif | 
|  |  | 
|  | #include "kmp_i18n.h" | 
|  |  | 
|  | // For affinity format functions | 
|  | #include "kmp_io.h" | 
|  | #include "kmp_str.h" | 
|  |  | 
|  | #if OMPT_SUPPORT | 
|  | #include "ompt-specific.h" | 
|  | #endif | 
|  |  | 
|  | #ifdef __cplusplus | 
|  | extern "C" { | 
|  | #endif // __cplusplus | 
|  |  | 
|  | /* For compatibility with the Gnu/MS Open MP codegen, omp_set_num_threads(), | 
|  | * omp_set_nested(), and omp_set_dynamic() [in lowercase on MS, and w/o | 
|  | * a trailing underscore on Linux* OS] take call by value integer arguments. | 
|  | * + omp_set_max_active_levels() | 
|  | * + omp_set_schedule() | 
|  | * | 
|  | * For backward compatibility with 9.1 and previous Intel compiler, these | 
|  | * entry points take call by reference integer arguments. */ | 
|  | #ifdef KMP_GOMP_COMPAT | 
|  | #if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_UPPER) | 
|  | #define PASS_ARGS_BY_VALUE 1 | 
|  | #endif | 
|  | #endif | 
|  | #if KMP_OS_WINDOWS | 
|  | #if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_APPEND) | 
|  | #define PASS_ARGS_BY_VALUE 1 | 
|  | #endif | 
|  | #endif | 
|  |  | 
|  | // This macro helps to reduce code duplication. | 
|  | #ifdef PASS_ARGS_BY_VALUE | 
|  | #define KMP_DEREF | 
|  | #else | 
|  | #define KMP_DEREF * | 
|  | #endif | 
|  |  | 
|  | // For API with specific C vs. Fortran interfaces (ompc_* exists in | 
|  | // kmp_csupport.cpp), only create GOMP versioned symbols of the API for the | 
|  | // APPEND Fortran entries in this file. The GOMP versioned symbols of the C API | 
|  | // will take place where the ompc_* functions are defined. | 
|  | #if KMP_FTN_ENTRIES == KMP_FTN_APPEND | 
|  | #define KMP_EXPAND_NAME_IF_APPEND(name) KMP_EXPAND_NAME(name) | 
|  | #else | 
|  | #define KMP_EXPAND_NAME_IF_APPEND(name) name | 
|  | #endif | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_STACKSIZE(int KMP_DEREF arg) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_stacksize(KMP_DEREF arg); | 
|  | #else | 
|  | // __kmp_aux_set_stacksize initializes the library if needed | 
|  | __kmp_aux_set_stacksize((size_t)KMP_DEREF arg); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_STACKSIZE_S(size_t KMP_DEREF arg) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_stacksize(KMP_DEREF arg); | 
|  | #else | 
|  | // __kmp_aux_set_stacksize initializes the library if needed | 
|  | __kmp_aux_set_stacksize(KMP_DEREF arg); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_GET_STACKSIZE(void) { | 
|  | #ifdef KMP_STUB | 
|  | return (int)__kmps_get_stacksize(); | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | return (int)__kmp_stksize; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | size_t FTN_STDCALL FTN_GET_STACKSIZE_S(void) { | 
|  | #ifdef KMP_STUB | 
|  | return __kmps_get_stacksize(); | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | return __kmp_stksize; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_BLOCKTIME(int KMP_DEREF arg) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_blocktime(KMP_DEREF arg); | 
|  | #else | 
|  | int gtid, tid, bt = (KMP_DEREF arg); | 
|  | kmp_info_t *thread; | 
|  |  | 
|  | gtid = __kmp_entry_gtid(); | 
|  | tid = __kmp_tid_from_gtid(gtid); | 
|  | thread = __kmp_thread_from_gtid(gtid); | 
|  |  | 
|  | __kmp_aux_convert_blocktime(&bt); | 
|  | __kmp_aux_set_blocktime(bt, thread, tid); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // Gets blocktime in units used for KMP_BLOCKTIME, ms otherwise | 
|  | int FTN_STDCALL FTN_GET_BLOCKTIME(void) { | 
|  | #ifdef KMP_STUB | 
|  | return __kmps_get_blocktime(); | 
|  | #else | 
|  | int gtid, tid; | 
|  | kmp_team_p *team; | 
|  |  | 
|  | gtid = __kmp_entry_gtid(); | 
|  | tid = __kmp_tid_from_gtid(gtid); | 
|  | team = __kmp_threads[gtid]->th.th_team; | 
|  |  | 
|  | /* These must match the settings used in __kmp_wait_sleep() */ | 
|  | if (__kmp_dflt_blocktime == KMP_MAX_BLOCKTIME) { | 
|  | KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d%cs\n", gtid, | 
|  | team->t.t_id, tid, KMP_MAX_BLOCKTIME, __kmp_blocktime_units)); | 
|  | return KMP_MAX_BLOCKTIME; | 
|  | } | 
|  | #ifdef KMP_ADJUST_BLOCKTIME | 
|  | else if (__kmp_zero_bt && !get__bt_set(team, tid)) { | 
|  | KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d%cs\n", gtid, | 
|  | team->t.t_id, tid, 0, __kmp_blocktime_units)); | 
|  | return 0; | 
|  | } | 
|  | #endif /* KMP_ADJUST_BLOCKTIME */ | 
|  | else { | 
|  | int bt = get__blocktime(team, tid); | 
|  | if (__kmp_blocktime_units == 'm') | 
|  | bt = bt / 1000; | 
|  | KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d%cs\n", gtid, | 
|  | team->t.t_id, tid, bt, __kmp_blocktime_units)); | 
|  | return bt; | 
|  | } | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_LIBRARY_SERIAL(void) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_library(library_serial); | 
|  | #else | 
|  | // __kmp_user_set_library initializes the library if needed | 
|  | __kmp_user_set_library(library_serial); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_LIBRARY_TURNAROUND(void) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_library(library_turnaround); | 
|  | #else | 
|  | // __kmp_user_set_library initializes the library if needed | 
|  | __kmp_user_set_library(library_turnaround); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_LIBRARY_THROUGHPUT(void) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_library(library_throughput); | 
|  | #else | 
|  | // __kmp_user_set_library initializes the library if needed | 
|  | __kmp_user_set_library(library_throughput); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_LIBRARY(int KMP_DEREF arg) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_library(KMP_DEREF arg); | 
|  | #else | 
|  | enum library_type lib; | 
|  | lib = (enum library_type)KMP_DEREF arg; | 
|  | // __kmp_user_set_library initializes the library if needed | 
|  | __kmp_user_set_library(lib); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_GET_LIBRARY(void) { | 
|  | #ifdef KMP_STUB | 
|  | return __kmps_get_library(); | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | return ((int)__kmp_library); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_DISP_NUM_BUFFERS(int KMP_DEREF arg) { | 
|  | #ifdef KMP_STUB | 
|  | ; // empty routine | 
|  | #else | 
|  | // ignore after initialization because some teams have already | 
|  | // allocated dispatch buffers | 
|  | int num_buffers = KMP_DEREF arg; | 
|  | if (__kmp_init_serial == FALSE && num_buffers >= KMP_MIN_DISP_NUM_BUFF && | 
|  | num_buffers <= KMP_MAX_DISP_NUM_BUFF) { | 
|  | __kmp_dispatch_num_buffers = num_buffers; | 
|  | } | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_SET_AFFINITY(void **mask) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return -1; | 
|  | #else | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | return __kmp_aux_set_affinity(mask); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_GET_AFFINITY(void **mask) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return -1; | 
|  | #else | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | int gtid = __kmp_get_gtid(); | 
|  | if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 && | 
|  | __kmp_affinity.flags.reset) { | 
|  | __kmp_reset_root_init_mask(gtid); | 
|  | } | 
|  | return __kmp_aux_get_affinity(mask); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_GET_AFFINITY_MAX_PROC(void) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return 0; | 
|  | #else | 
|  | // We really only NEED serial initialization here. | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | return __kmp_aux_get_affinity_max_proc(); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_CREATE_AFFINITY_MASK(void **mask) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | *mask = NULL; | 
|  | #else | 
|  | // We really only NEED serial initialization here. | 
|  | kmp_affin_mask_t *mask_internals; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | mask_internals = __kmp_affinity_dispatch->allocate_mask(); | 
|  | KMP_CPU_ZERO(mask_internals); | 
|  | *mask = mask_internals; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_DESTROY_AFFINITY_MASK(void **mask) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | // Nothing | 
|  | #else | 
|  | // We really only NEED serial initialization here. | 
|  | kmp_affin_mask_t *mask_internals; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | if (__kmp_env_consistency_check) { | 
|  | if (*mask == NULL) { | 
|  | KMP_FATAL(AffinityInvalidMask, "kmp_destroy_affinity_mask"); | 
|  | } | 
|  | } | 
|  | mask_internals = (kmp_affin_mask_t *)(*mask); | 
|  | __kmp_affinity_dispatch->deallocate_mask(mask_internals); | 
|  | *mask = NULL; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_SET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return -1; | 
|  | #else | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | return __kmp_aux_set_affinity_mask_proc(KMP_DEREF proc, mask); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_UNSET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return -1; | 
|  | #else | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | return __kmp_aux_unset_affinity_mask_proc(KMP_DEREF proc, mask); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_GET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return -1; | 
|  | #else | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | return __kmp_aux_get_affinity_mask_proc(KMP_DEREF proc, mask); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* ------------------------------------------------------------------------ */ | 
|  |  | 
|  | /* sets the requested number of threads for the next parallel region */ | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NUM_THREADS)(int KMP_DEREF arg) { | 
|  | #ifdef KMP_STUB | 
|  | // Nothing. | 
|  | #else | 
|  | __kmp_set_num_threads(KMP_DEREF arg, __kmp_entry_gtid()); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* returns the number of threads in current team */ | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_THREADS)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; | 
|  | #else | 
|  | // __kmpc_bound_num_threads initializes the library if needed | 
|  | return __kmpc_bound_num_threads(NULL); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_THREADS)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; | 
|  | #else | 
|  | int gtid; | 
|  | kmp_info_t *thread; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | gtid = __kmp_entry_gtid(); | 
|  | thread = __kmp_threads[gtid]; | 
|  | #if KMP_AFFINITY_SUPPORTED | 
|  | if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) { | 
|  | __kmp_assign_root_init_mask(); | 
|  | } | 
|  | #endif | 
|  | // return thread -> th.th_team -> t.t_current_task[ | 
|  | // thread->th.th_info.ds.ds_tid ] -> icvs.nproc; | 
|  | return thread->th.th_current_task->td_icvs.nproc; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_CONTROL_TOOL(int command, int modifier, void *arg) { | 
|  | #if defined(KMP_STUB) || !OMPT_SUPPORT | 
|  | return -2; | 
|  | #else | 
|  | OMPT_STORE_RETURN_ADDRESS(__kmp_entry_gtid()); | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | return -2; | 
|  | } | 
|  | kmp_info_t *this_thr = __kmp_threads[__kmp_entry_gtid()]; | 
|  | ompt_task_info_t *parent_task_info = OMPT_CUR_TASK_INFO(this_thr); | 
|  | parent_task_info->frame.enter_frame.ptr = OMPT_GET_FRAME_ADDRESS(0); | 
|  | int ret = __kmp_control_tool(command, modifier, arg); | 
|  | parent_task_info->frame.enter_frame.ptr = 0; | 
|  | return ret; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* OpenMP 5.0 Memory Management support */ | 
|  | omp_allocator_handle_t FTN_STDCALL | 
|  | FTN_INIT_ALLOCATOR(omp_memspace_handle_t KMP_DEREF m, int KMP_DEREF ntraits, | 
|  | omp_alloctrait_t tr[]) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmpc_init_allocator(__kmp_entry_gtid(), KMP_DEREF m, | 
|  | KMP_DEREF ntraits, tr); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_DESTROY_ALLOCATOR(omp_allocator_handle_t al) { | 
|  | #ifndef KMP_STUB | 
|  | __kmpc_destroy_allocator(__kmp_entry_gtid(), al); | 
|  | #endif | 
|  | } | 
|  | void FTN_STDCALL FTN_SET_DEFAULT_ALLOCATOR(omp_allocator_handle_t al) { | 
|  | #ifndef KMP_STUB | 
|  | __kmpc_set_default_allocator(__kmp_entry_gtid(), al); | 
|  | #endif | 
|  | } | 
|  | omp_allocator_handle_t FTN_STDCALL FTN_GET_DEFAULT_ALLOCATOR(void) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmpc_get_default_allocator(__kmp_entry_gtid()); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* OpenMP 6.0 (TR11) Memory Management support */ | 
|  | omp_memspace_handle_t FTN_STDCALL | 
|  | FTN_GET_DEVICES_MEMSPACE(int KMP_DEREF ndevs, const int *devs, | 
|  | omp_memspace_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmp_get_devices_memspace(KMP_DEREF ndevs, devs, KMP_DEREF memspace, | 
|  | 0 /* host */); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_memspace_handle_t FTN_STDCALL FTN_GET_DEVICE_MEMSPACE( | 
|  | int KMP_DEREF dev, omp_memspace_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | int dev_num = KMP_DEREF dev; | 
|  | return __kmp_get_devices_memspace(1, &dev_num, KMP_DEREF memspace, 0); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_memspace_handle_t FTN_STDCALL | 
|  | FTN_GET_DEVICES_AND_HOST_MEMSPACE(int KMP_DEREF ndevs, const int *devs, | 
|  | omp_memspace_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmp_get_devices_memspace(KMP_DEREF ndevs, devs, KMP_DEREF memspace, | 
|  | 1); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_memspace_handle_t FTN_STDCALL FTN_GET_DEVICE_AND_HOST_MEMSPACE( | 
|  | int KMP_DEREF dev, omp_memspace_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | int dev_num = KMP_DEREF dev; | 
|  | return __kmp_get_devices_memspace(1, &dev_num, KMP_DEREF memspace, 1); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_memspace_handle_t FTN_STDCALL | 
|  | FTN_GET_DEVICES_ALL_MEMSPACE(omp_memspace_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmp_get_devices_memspace(0, NULL, KMP_DEREF memspace, 1); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_allocator_handle_t FTN_STDCALL | 
|  | FTN_GET_DEVICES_ALLOCATOR(int KMP_DEREF ndevs, const int *devs, | 
|  | omp_allocator_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmp_get_devices_allocator(KMP_DEREF ndevs, devs, KMP_DEREF memspace, | 
|  | 0 /* host */); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_allocator_handle_t FTN_STDCALL FTN_GET_DEVICE_ALLOCATOR( | 
|  | int KMP_DEREF dev, omp_allocator_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | int dev_num = KMP_DEREF dev; | 
|  | return __kmp_get_devices_allocator(1, &dev_num, KMP_DEREF memspace, 0); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_allocator_handle_t FTN_STDCALL | 
|  | FTN_GET_DEVICES_AND_HOST_ALLOCATOR(int KMP_DEREF ndevs, const int *devs, | 
|  | omp_allocator_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmp_get_devices_allocator(KMP_DEREF ndevs, devs, KMP_DEREF memspace, | 
|  | 1); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_allocator_handle_t FTN_STDCALL FTN_GET_DEVICE_AND_HOST_ALLOCATOR( | 
|  | int KMP_DEREF dev, omp_allocator_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | int dev_num = KMP_DEREF dev; | 
|  | return __kmp_get_devices_allocator(1, &dev_num, KMP_DEREF memspace, 1); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_allocator_handle_t FTN_STDCALL | 
|  | FTN_GET_DEVICES_ALL_ALLOCATOR(omp_allocator_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmp_get_devices_allocator(0, NULL, KMP_DEREF memspace, 1); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL | 
|  | FTN_GET_MEMSPACE_NUM_RESOURCES(omp_memspace_handle_t KMP_DEREF memspace) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; | 
|  | #else | 
|  | return __kmp_get_memspace_num_resources(KMP_DEREF memspace); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | omp_memspace_handle_t FTN_STDCALL | 
|  | FTN_GET_SUBMEMSPACE(omp_memspace_handle_t KMP_DEREF memspace, | 
|  | int KMP_DEREF num_resources, int *resources) { | 
|  | #ifdef KMP_STUB | 
|  | return NULL; | 
|  | #else | 
|  | return __kmp_get_submemspace(KMP_DEREF memspace, KMP_DEREF num_resources, | 
|  | resources); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* OpenMP 5.0 affinity format support */ | 
|  | #ifndef KMP_STUB | 
|  | static void __kmp_fortran_strncpy_truncate(char *buffer, size_t buf_size, | 
|  | char const *csrc, size_t csrc_size) { | 
|  | size_t capped_src_size = csrc_size; | 
|  | if (csrc_size >= buf_size) { | 
|  | capped_src_size = buf_size - 1; | 
|  | } | 
|  | KMP_STRNCPY_S(buffer, buf_size, csrc, capped_src_size); | 
|  | if (csrc_size >= buf_size) { | 
|  | KMP_DEBUG_ASSERT(buffer[buf_size - 1] == '\0'); | 
|  | buffer[buf_size - 1] = csrc[buf_size - 1]; | 
|  | } else { | 
|  | for (size_t i = csrc_size; i < buf_size; ++i) | 
|  | buffer[i] = ' '; | 
|  | } | 
|  | } | 
|  |  | 
|  | // Convert a Fortran string to a C string by adding null byte | 
|  | class ConvertedString { | 
|  | char *buf; | 
|  | kmp_info_t *th; | 
|  |  | 
|  | public: | 
|  | ConvertedString(char const *fortran_str, size_t size) { | 
|  | th = __kmp_get_thread(); | 
|  | buf = (char *)__kmp_thread_malloc(th, size + 1); | 
|  | KMP_STRNCPY_S(buf, size + 1, fortran_str, size); | 
|  | buf[size] = '\0'; | 
|  | } | 
|  | ~ConvertedString() { __kmp_thread_free(th, buf); } | 
|  | const char *get() const { return buf; } | 
|  | }; | 
|  | #endif // KMP_STUB | 
|  |  | 
|  | /* | 
|  | * Set the value of the affinity-format-var ICV on the current device to the | 
|  | * format specified in the argument. | 
|  | */ | 
|  | void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_SET_AFFINITY_FORMAT)( | 
|  | char const *format, size_t size) { | 
|  | #ifdef KMP_STUB | 
|  | return; | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | ConvertedString cformat(format, size); | 
|  | // Since the __kmp_affinity_format variable is a C string, do not | 
|  | // use the fortran strncpy function | 
|  | __kmp_strncpy_truncate(__kmp_affinity_format, KMP_AFFINITY_FORMAT_SIZE, | 
|  | cformat.get(), KMP_STRLEN(cformat.get())); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* | 
|  | * Returns the number of characters required to hold the entire affinity format | 
|  | * specification (not including null byte character) and writes the value of the | 
|  | * affinity-format-var ICV on the current device to buffer. If the return value | 
|  | * is larger than size, the affinity format specification is truncated. | 
|  | */ | 
|  | size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_GET_AFFINITY_FORMAT)( | 
|  | char *buffer, size_t size) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; | 
|  | #else | 
|  | size_t format_size; | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | format_size = KMP_STRLEN(__kmp_affinity_format); | 
|  | if (buffer && size) { | 
|  | __kmp_fortran_strncpy_truncate(buffer, size, __kmp_affinity_format, | 
|  | format_size); | 
|  | } | 
|  | return format_size; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* | 
|  | * Prints the thread affinity information of the current thread in the format | 
|  | * specified by the format argument. If the format is NULL or a zero-length | 
|  | * string, the value of the affinity-format-var ICV is used. | 
|  | */ | 
|  | void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_DISPLAY_AFFINITY)( | 
|  | char const *format, size_t size) { | 
|  | #ifdef KMP_STUB | 
|  | return; | 
|  | #else | 
|  | int gtid; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | gtid = __kmp_get_gtid(); | 
|  | #if KMP_AFFINITY_SUPPORTED | 
|  | if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 && | 
|  | __kmp_affinity.flags.reset) { | 
|  | __kmp_reset_root_init_mask(gtid); | 
|  | } | 
|  | #endif | 
|  | ConvertedString cformat(format, size); | 
|  | __kmp_aux_display_affinity(gtid, cformat.get()); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* | 
|  | * Returns the number of characters required to hold the entire affinity format | 
|  | * specification (not including null byte) and prints the thread affinity | 
|  | * information of the current thread into the character string buffer with the | 
|  | * size of size in the format specified by the format argument. If the format is | 
|  | * NULL or a zero-length string, the value of the affinity-format-var ICV is | 
|  | * used. The buffer must be allocated prior to calling the routine. If the | 
|  | * return value is larger than size, the affinity format specification is | 
|  | * truncated. | 
|  | */ | 
|  | size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_CAPTURE_AFFINITY)( | 
|  | char *buffer, char const *format, size_t buf_size, size_t for_size) { | 
|  | #if defined(KMP_STUB) | 
|  | return 0; | 
|  | #else | 
|  | int gtid; | 
|  | size_t num_required; | 
|  | kmp_str_buf_t capture_buf; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | __kmp_assign_root_init_mask(); | 
|  | gtid = __kmp_get_gtid(); | 
|  | #if KMP_AFFINITY_SUPPORTED | 
|  | if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 && | 
|  | __kmp_affinity.flags.reset) { | 
|  | __kmp_reset_root_init_mask(gtid); | 
|  | } | 
|  | #endif | 
|  | __kmp_str_buf_init(&capture_buf); | 
|  | ConvertedString cformat(format, for_size); | 
|  | num_required = __kmp_aux_capture_affinity(gtid, cformat.get(), &capture_buf); | 
|  | if (buffer && buf_size) { | 
|  | __kmp_fortran_strncpy_truncate(buffer, buf_size, capture_buf.str, | 
|  | capture_buf.used); | 
|  | } | 
|  | __kmp_str_buf_free(&capture_buf); | 
|  | return num_required; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_NUM)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; | 
|  | #else | 
|  | int gtid; | 
|  |  | 
|  | #if KMP_OS_DARWIN || KMP_OS_DRAGONFLY || KMP_OS_FREEBSD || KMP_OS_NETBSD ||    \ | 
|  | KMP_OS_OPENBSD || KMP_OS_HAIKU || KMP_OS_HURD || KMP_OS_SOLARIS ||         \ | 
|  | KMP_OS_AIX | 
|  | gtid = __kmp_entry_gtid(); | 
|  | #elif KMP_OS_WINDOWS | 
|  | if (!__kmp_init_parallel || | 
|  | (gtid = (int)((kmp_intptr_t)TlsGetValue(__kmp_gtid_threadprivate_key))) == | 
|  | 0) { | 
|  | // Either library isn't initialized or thread is not registered | 
|  | // 0 is the correct TID in this case | 
|  | return 0; | 
|  | } | 
|  | --gtid; // We keep (gtid+1) in TLS | 
|  | #elif KMP_OS_LINUX || KMP_OS_WASI | 
|  | #ifdef KMP_TDATA_GTID | 
|  | if (__kmp_gtid_mode >= 3) { | 
|  | if ((gtid = __kmp_gtid) == KMP_GTID_DNE) { | 
|  | return 0; | 
|  | } | 
|  | } else { | 
|  | #endif | 
|  | if (!__kmp_init_parallel || | 
|  | (gtid = (int)((kmp_intptr_t)( | 
|  | pthread_getspecific(__kmp_gtid_threadprivate_key)))) == 0) { | 
|  | return 0; | 
|  | } | 
|  | --gtid; | 
|  | #ifdef KMP_TDATA_GTID | 
|  | } | 
|  | #endif | 
|  | #else | 
|  | #error Unknown or unsupported OS | 
|  | #endif | 
|  |  | 
|  | return __kmp_tid_from_gtid(gtid); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_GET_NUM_KNOWN_THREADS(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | /* NOTE: this is not syncronized, so it can change at any moment */ | 
|  | /* NOTE: this number also includes threads preallocated in hot-teams */ | 
|  | return TCR_4(__kmp_nth); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PROCS)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; | 
|  | #else | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | #if KMP_AFFINITY_SUPPORTED | 
|  | if (!__kmp_affinity.flags.reset) { | 
|  | // only bind root here if its affinity reset is not requested | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | kmp_info_t *thread = __kmp_threads[gtid]; | 
|  | if (thread->th.th_team->t.t_level == 0) { | 
|  | __kmp_assign_root_init_mask(); | 
|  | } | 
|  | } | 
|  | #endif | 
|  | return __kmp_avail_proc; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NESTED)(int KMP_DEREF flag) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_nested(KMP_DEREF flag); | 
|  | #else | 
|  | kmp_info_t *thread; | 
|  | /* For the thread-private internal controls implementation */ | 
|  | thread = __kmp_entry_thread(); | 
|  | KMP_INFORM(APIDeprecated, "omp_set_nested", "omp_set_max_active_levels"); | 
|  | __kmp_save_internal_controls(thread); | 
|  | // Somewhat arbitrarily decide where to get a value for max_active_levels | 
|  | int max_active_levels = get__max_active_levels(thread); | 
|  | if (max_active_levels == 1) | 
|  | max_active_levels = KMP_MAX_ACTIVE_LEVELS_LIMIT; | 
|  | set__max_active_levels(thread, (KMP_DEREF flag) ? max_active_levels : 1); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NESTED)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return __kmps_get_nested(); | 
|  | #else | 
|  | kmp_info_t *thread; | 
|  | thread = __kmp_entry_thread(); | 
|  | KMP_INFORM(APIDeprecated, "omp_get_nested", "omp_get_max_active_levels"); | 
|  | return get__max_active_levels(thread) > 1; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DYNAMIC)(int KMP_DEREF flag) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_dynamic(KMP_DEREF flag ? TRUE : FALSE); | 
|  | #else | 
|  | kmp_info_t *thread; | 
|  | /* For the thread-private implementation of the internal controls */ | 
|  | thread = __kmp_entry_thread(); | 
|  | // !!! What if foreign thread calls it? | 
|  | __kmp_save_internal_controls(thread); | 
|  | set__dynamic(thread, KMP_DEREF flag ? true : false); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DYNAMIC)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return __kmps_get_dynamic(); | 
|  | #else | 
|  | kmp_info_t *thread; | 
|  | thread = __kmp_entry_thread(); | 
|  | return get__dynamic(thread); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_PARALLEL)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; | 
|  | #else | 
|  | kmp_info_t *th = __kmp_entry_thread(); | 
|  | if (th->th.th_teams_microtask) { | 
|  | // AC: r_in_parallel does not work inside teams construct where real | 
|  | // parallel is inactive, but all threads have same root, so setting it in | 
|  | // one team affects other teams. | 
|  | // The solution is to use per-team nesting level | 
|  | return (th->th.th_team->t.t_active_level ? 1 : 0); | 
|  | } else | 
|  | return (th->th.th_root->r.r_in_parallel ? FTN_TRUE : FTN_FALSE); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_SCHEDULE)(kmp_sched_t KMP_DEREF kind, | 
|  | int KMP_DEREF modifier) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_set_schedule(KMP_DEREF kind, KMP_DEREF modifier); | 
|  | #else | 
|  | /* TO DO: For the per-task implementation of the internal controls */ | 
|  | __kmp_set_schedule(__kmp_entry_gtid(), KMP_DEREF kind, KMP_DEREF modifier); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_SCHEDULE)(kmp_sched_t *kind, | 
|  | int *modifier) { | 
|  | #ifdef KMP_STUB | 
|  | __kmps_get_schedule(kind, modifier); | 
|  | #else | 
|  | /* TO DO: For the per-task implementation of the internal controls */ | 
|  | __kmp_get_schedule(__kmp_entry_gtid(), kind, modifier); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_MAX_ACTIVE_LEVELS)(int KMP_DEREF arg) { | 
|  | #ifdef KMP_STUB | 
|  | // Nothing. | 
|  | #else | 
|  | /* TO DO: We want per-task implementation of this internal control */ | 
|  | __kmp_set_max_active_levels(__kmp_entry_gtid(), KMP_DEREF arg); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_ACTIVE_LEVELS)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; | 
|  | #else | 
|  | /* TO DO: We want per-task implementation of this internal control */ | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | return __kmp_get_max_active_levels(__kmp_entry_gtid()); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_ACTIVE_LEVEL)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; // returns 0 if it is called from the sequential part of the program | 
|  | #else | 
|  | /* TO DO: For the per-task implementation of the internal controls */ | 
|  | return __kmp_entry_thread()->th.th_team->t.t_active_level; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_LEVEL)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; // returns 0 if it is called from the sequential part of the program | 
|  | #else | 
|  | /* TO DO: For the per-task implementation of the internal controls */ | 
|  | return __kmp_entry_thread()->th.th_team->t.t_level; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL | 
|  | KMP_EXPAND_NAME(FTN_GET_ANCESTOR_THREAD_NUM)(int KMP_DEREF level) { | 
|  | #ifdef KMP_STUB | 
|  | return (KMP_DEREF level) ? (-1) : (0); | 
|  | #else | 
|  | return __kmp_get_ancestor_thread_num(__kmp_entry_gtid(), KMP_DEREF level); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_SIZE)(int KMP_DEREF level) { | 
|  | #ifdef KMP_STUB | 
|  | return (KMP_DEREF level) ? (-1) : (1); | 
|  | #else | 
|  | return __kmp_get_team_size(__kmp_entry_gtid(), KMP_DEREF level); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_LIMIT)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; // TO DO: clarify whether it returns 1 or 0? | 
|  | #else | 
|  | int gtid; | 
|  | kmp_info_t *thread; | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  |  | 
|  | gtid = __kmp_entry_gtid(); | 
|  | thread = __kmp_threads[gtid]; | 
|  | // If thread_limit for the target task is defined, return that instead of the | 
|  | // regular task thread_limit | 
|  | if (int thread_limit = thread->th.th_current_task->td_icvs.task_thread_limit) | 
|  | return thread_limit; | 
|  | return thread->th.th_current_task->td_icvs.thread_limit; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_FINAL)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; // TO DO: clarify whether it returns 1 or 0? | 
|  | #else | 
|  | if (!TCR_4(__kmp_init_parallel)) { | 
|  | return 0; | 
|  | } | 
|  | return __kmp_entry_thread()->th.th_current_task->td_flags.final; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | kmp_proc_bind_t FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PROC_BIND)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return __kmps_get_proc_bind(); | 
|  | #else | 
|  | return get__proc_bind(__kmp_entry_thread()); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PLACES)(void) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return 0; | 
|  | #else | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | if (!KMP_AFFINITY_CAPABLE()) | 
|  | return 0; | 
|  | if (!__kmp_affinity.flags.reset) { | 
|  | // only bind root here if its affinity reset is not requested | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | kmp_info_t *thread = __kmp_threads[gtid]; | 
|  | if (thread->th.th_team->t.t_level == 0) { | 
|  | __kmp_assign_root_init_mask(); | 
|  | } | 
|  | } | 
|  | return __kmp_affinity.num_masks; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM_PROCS)(int place_num) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return 0; | 
|  | #else | 
|  | int i; | 
|  | int retval = 0; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | if (!KMP_AFFINITY_CAPABLE()) | 
|  | return 0; | 
|  | if (!__kmp_affinity.flags.reset) { | 
|  | // only bind root here if its affinity reset is not requested | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | kmp_info_t *thread = __kmp_threads[gtid]; | 
|  | if (thread->th.th_team->t.t_level == 0) { | 
|  | __kmp_assign_root_init_mask(); | 
|  | } | 
|  | } | 
|  | if (place_num < 0 || place_num >= (int)__kmp_affinity.num_masks) | 
|  | return 0; | 
|  | kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity.masks, place_num); | 
|  | KMP_CPU_SET_ITERATE(i, mask) { | 
|  | if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) || | 
|  | (!KMP_CPU_ISSET(i, mask))) { | 
|  | continue; | 
|  | } | 
|  | ++retval; | 
|  | } | 
|  | return retval; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_PROC_IDS)(int place_num, | 
|  | int *ids) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | // Nothing. | 
|  | #else | 
|  | int i, j; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | if (!KMP_AFFINITY_CAPABLE()) | 
|  | return; | 
|  | if (!__kmp_affinity.flags.reset) { | 
|  | // only bind root here if its affinity reset is not requested | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | kmp_info_t *thread = __kmp_threads[gtid]; | 
|  | if (thread->th.th_team->t.t_level == 0) { | 
|  | __kmp_assign_root_init_mask(); | 
|  | } | 
|  | } | 
|  | if (place_num < 0 || place_num >= (int)__kmp_affinity.num_masks) | 
|  | return; | 
|  | kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity.masks, place_num); | 
|  | j = 0; | 
|  | KMP_CPU_SET_ITERATE(i, mask) { | 
|  | if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) || | 
|  | (!KMP_CPU_ISSET(i, mask))) { | 
|  | continue; | 
|  | } | 
|  | ids[j++] = i; | 
|  | } | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM)(void) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return -1; | 
|  | #else | 
|  | int gtid; | 
|  | kmp_info_t *thread; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | if (!KMP_AFFINITY_CAPABLE()) | 
|  | return -1; | 
|  | gtid = __kmp_entry_gtid(); | 
|  | thread = __kmp_thread_from_gtid(gtid); | 
|  | if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) { | 
|  | __kmp_assign_root_init_mask(); | 
|  | } | 
|  | if (thread->th.th_current_place < 0) | 
|  | return -1; | 
|  | return thread->th.th_current_place; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PARTITION_NUM_PLACES)(void) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | return 0; | 
|  | #else | 
|  | int gtid, num_places, first_place, last_place; | 
|  | kmp_info_t *thread; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | if (!KMP_AFFINITY_CAPABLE()) | 
|  | return 0; | 
|  | gtid = __kmp_entry_gtid(); | 
|  | thread = __kmp_thread_from_gtid(gtid); | 
|  | if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) { | 
|  | __kmp_assign_root_init_mask(); | 
|  | } | 
|  | first_place = thread->th.th_first_place; | 
|  | last_place = thread->th.th_last_place; | 
|  | if (first_place < 0 || last_place < 0) | 
|  | return 0; | 
|  | if (first_place <= last_place) | 
|  | num_places = last_place - first_place + 1; | 
|  | else | 
|  | num_places = __kmp_affinity.num_masks - first_place + last_place + 1; | 
|  | return num_places; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL | 
|  | KMP_EXPAND_NAME(FTN_GET_PARTITION_PLACE_NUMS)(int *place_nums) { | 
|  | #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED | 
|  | // Nothing. | 
|  | #else | 
|  | int i, gtid, place_num, first_place, last_place, start, end; | 
|  | kmp_info_t *thread; | 
|  | if (!TCR_4(__kmp_init_middle)) { | 
|  | __kmp_middle_initialize(); | 
|  | } | 
|  | if (!KMP_AFFINITY_CAPABLE()) | 
|  | return; | 
|  | gtid = __kmp_entry_gtid(); | 
|  | thread = __kmp_thread_from_gtid(gtid); | 
|  | if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) { | 
|  | __kmp_assign_root_init_mask(); | 
|  | } | 
|  | first_place = thread->th.th_first_place; | 
|  | last_place = thread->th.th_last_place; | 
|  | if (first_place < 0 || last_place < 0) | 
|  | return; | 
|  | if (first_place <= last_place) { | 
|  | start = first_place; | 
|  | end = last_place; | 
|  | } else { | 
|  | start = last_place; | 
|  | end = first_place; | 
|  | } | 
|  | for (i = 0, place_num = start; place_num <= end; ++place_num, ++i) { | 
|  | place_nums[i] = place_num; | 
|  | } | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_TEAMS)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; | 
|  | #else | 
|  | return __kmp_aux_get_num_teams(); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_NUM)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; | 
|  | #else | 
|  | return __kmp_aux_get_team_num(); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEFAULT_DEVICE)(void) { | 
|  | #if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB) | 
|  | return 0; | 
|  | #else | 
|  | return __kmp_entry_thread()->th.th_current_task->td_icvs.default_device; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DEFAULT_DEVICE)(int KMP_DEREF arg) { | 
|  | #if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB) | 
|  | // Nothing. | 
|  | #else | 
|  | __kmp_entry_thread()->th.th_current_task->td_icvs.default_device = | 
|  | KMP_DEREF arg; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // Get number of NON-HOST devices. | 
|  | // libomptarget, if loaded, provides this function in api.cpp. | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) | 
|  | KMP_WEAK_ATTRIBUTE_EXTERNAL; | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) { | 
|  | #if KMP_MIC || KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB) | 
|  | return 0; | 
|  | #else | 
|  | int (*fptr)(); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM("__tgt_get_num_devices"))) { | 
|  | return (*fptr)(); | 
|  | } else if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_devices"))) { | 
|  | return (*fptr)(); | 
|  | } else if ((*(void **)(&fptr) = KMP_DLSYM("_Offload_number_of_devices"))) { | 
|  | return (*fptr)(); | 
|  | } else { // liboffload & libomptarget don't exist | 
|  | return 0; | 
|  | } | 
|  | #endif // KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB) | 
|  | } | 
|  |  | 
|  | // This function always returns true when called on host device. | 
|  | // Compiler/libomptarget should handle when it is called inside target region. | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) | 
|  | KMP_WEAK_ATTRIBUTE_EXTERNAL; | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) { | 
|  | return 1; // This is the host | 
|  | } | 
|  |  | 
|  | // libomptarget, if loaded, provides this function | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void) | 
|  | KMP_WEAK_ATTRIBUTE_EXTERNAL; | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void) { | 
|  | // same as omp_get_num_devices() | 
|  | return KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(); | 
|  | } | 
|  |  | 
|  | #if defined(KMP_STUB) | 
|  | // Entries for stubs library | 
|  | // As all *target* functions are C-only parameters always passed by value | 
|  | void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; } | 
|  |  | 
|  | void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {} | 
|  |  | 
|  | int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; } | 
|  |  | 
|  | int FTN_STDCALL FTN_TARGET_MEMCPY(void *dst, void *src, size_t length, | 
|  | size_t dst_offset, size_t src_offset, | 
|  | int dst_device, int src_device) { | 
|  | return -1; | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_TARGET_MEMCPY_RECT( | 
|  | void *dst, void *src, size_t element_size, int num_dims, | 
|  | const size_t *volume, const size_t *dst_offsets, const size_t *src_offsets, | 
|  | const size_t *dst_dimensions, const size_t *src_dimensions, int dst_device, | 
|  | int src_device) { | 
|  | return -1; | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_TARGET_ASSOCIATE_PTR(void *host_ptr, void *device_ptr, | 
|  | size_t size, size_t device_offset, | 
|  | int device_num) { | 
|  | return -1; | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_TARGET_DISASSOCIATE_PTR(void *host_ptr, int device_num) { | 
|  | return -1; | 
|  | } | 
|  | #endif // defined(KMP_STUB) | 
|  |  | 
|  | #ifdef KMP_STUB | 
|  | typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t; | 
|  | #endif /* KMP_STUB */ | 
|  |  | 
|  | #if KMP_USE_DYNAMIC_LOCK | 
|  | void FTN_STDCALL FTN_INIT_LOCK_WITH_HINT(void **user_lock, | 
|  | uintptr_t KMP_DEREF hint) { | 
|  | #ifdef KMP_STUB | 
|  | *((kmp_stub_lock_t *)user_lock) = UNLOCKED; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_init_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_INIT_NEST_LOCK_WITH_HINT(void **user_lock, | 
|  | uintptr_t KMP_DEREF hint) { | 
|  | #ifdef KMP_STUB | 
|  | *((kmp_stub_lock_t *)user_lock) = UNLOCKED; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_init_nest_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint); | 
|  | #endif | 
|  | } | 
|  | #endif | 
|  |  | 
|  | /* initialize the lock */ | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | *((kmp_stub_lock_t *)user_lock) = UNLOCKED; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_init_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* initialize the lock */ | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_NEST_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | *((kmp_stub_lock_t *)user_lock) = UNLOCKED; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_init_nest_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | *((kmp_stub_lock_t *)user_lock) = UNINIT; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_destroy_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_NEST_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | *((kmp_stub_lock_t *)user_lock) = UNINIT; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_destroy_nest_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | if (*((kmp_stub_lock_t *)user_lock) != UNLOCKED) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | *((kmp_stub_lock_t *)user_lock) = LOCKED; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_set_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NEST_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | (*((int *)user_lock))++; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_set_nest_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | *((kmp_stub_lock_t *)user_lock) = UNLOCKED; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_unset_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_NEST_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | (*((int *)user_lock))--; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | __kmpc_unset_nest_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | if (*((kmp_stub_lock_t *)user_lock) == LOCKED) { | 
|  | return 0; | 
|  | } | 
|  | *((kmp_stub_lock_t *)user_lock) = LOCKED; | 
|  | return 1; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | return __kmpc_test_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_NEST_LOCK)(void **user_lock) { | 
|  | #ifdef KMP_STUB | 
|  | if (*((kmp_stub_lock_t *)user_lock) == UNINIT) { | 
|  | // TODO: Issue an error. | 
|  | } | 
|  | return ++(*((int *)user_lock)); | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | #if OMPT_SUPPORT && OMPT_OPTIONAL | 
|  | OMPT_STORE_RETURN_ADDRESS(gtid); | 
|  | #endif | 
|  | return __kmpc_test_nest_lock(NULL, gtid, user_lock); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTIME)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return __kmps_get_wtime(); | 
|  | #else | 
|  | double data; | 
|  | #if !KMP_OS_LINUX | 
|  | // We don't need library initialization to get the time on Linux* OS. The | 
|  | // routine can be used to measure library initialization time on Linux* OS now | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | #endif | 
|  | __kmp_elapsed(&data); | 
|  | return data; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTICK)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return __kmps_get_wtick(); | 
|  | #else | 
|  | double data; | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | __kmp_elapsed_tick(&data); | 
|  | return data; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* ------------------------------------------------------------------------ */ | 
|  |  | 
|  | void *FTN_STDCALL FTN_MALLOC(size_t KMP_DEREF size) { | 
|  | // kmpc_malloc initializes the library if needed | 
|  | return kmpc_malloc(KMP_DEREF size); | 
|  | } | 
|  |  | 
|  | void *FTN_STDCALL FTN_ALIGNED_MALLOC(size_t KMP_DEREF size, | 
|  | size_t KMP_DEREF alignment) { | 
|  | // kmpc_aligned_malloc initializes the library if needed | 
|  | return kmpc_aligned_malloc(KMP_DEREF size, KMP_DEREF alignment); | 
|  | } | 
|  |  | 
|  | void *FTN_STDCALL FTN_CALLOC(size_t KMP_DEREF nelem, size_t KMP_DEREF elsize) { | 
|  | // kmpc_calloc initializes the library if needed | 
|  | return kmpc_calloc(KMP_DEREF nelem, KMP_DEREF elsize); | 
|  | } | 
|  |  | 
|  | void *FTN_STDCALL FTN_REALLOC(void *KMP_DEREF ptr, size_t KMP_DEREF size) { | 
|  | // kmpc_realloc initializes the library if needed | 
|  | return kmpc_realloc(KMP_DEREF ptr, KMP_DEREF size); | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_KFREE(void *KMP_DEREF ptr) { | 
|  | // does nothing if the library is not initialized | 
|  | kmpc_free(KMP_DEREF ptr); | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_WARNINGS_ON(void) { | 
|  | #ifndef KMP_STUB | 
|  | __kmp_generate_warnings = kmp_warnings_explicit; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) { | 
|  | #ifndef KMP_STUB | 
|  | __kmp_generate_warnings = FALSE; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_SET_DEFAULTS(char const *str | 
|  | #ifndef PASS_ARGS_BY_VALUE | 
|  | , | 
|  | int len | 
|  | #endif | 
|  | ) { | 
|  | #ifndef KMP_STUB | 
|  | #ifdef PASS_ARGS_BY_VALUE | 
|  | int len = (int)KMP_STRLEN(str); | 
|  | #endif | 
|  | __kmp_aux_set_defaults(str, len); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* ------------------------------------------------------------------------ */ | 
|  |  | 
|  | /* returns the status of cancellation */ | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_CANCELLATION)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0 /* false */; | 
|  | #else | 
|  | // initialize the library if needed | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | return __kmp_omp_cancellation; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_GET_CANCELLATION_STATUS(int cancel_kind) { | 
|  | #ifdef KMP_STUB | 
|  | return 0 /* false */; | 
|  | #else | 
|  | return __kmp_get_cancellation_status(cancel_kind); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /* returns the maximum allowed task priority */ | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_TASK_PRIORITY)(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | return __kmp_max_task_priority; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // This function will be defined in libomptarget. When libomptarget is not | 
|  | // loaded, we assume we are on the host and return KMP_HOST_DEVICE. | 
|  | // Compiler/libomptarget will handle this if called inside target. | 
|  | int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE_EXTERNAL; | 
|  | int FTN_STDCALL FTN_GET_DEVICE_NUM(void) { | 
|  | return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(); | 
|  | } | 
|  |  | 
|  | // Compiler will ensure that this is only called from host in sequential region | 
|  | int FTN_STDCALL KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE)(kmp_pause_status_t kind, | 
|  | int device_num) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; // just fail | 
|  | #else | 
|  | if (kind == kmp_stop_tool_paused) | 
|  | return 1; // stop_tool must not be specified | 
|  | if (device_num == KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)()) | 
|  | return __kmpc_pause_resource(kind); | 
|  | else { | 
|  | int (*fptr)(kmp_pause_status_t, int); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource"))) | 
|  | return (*fptr)(kind, device_num); | 
|  | else | 
|  | return 1; // just fail if there is no libomptarget | 
|  | } | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // Compiler will ensure that this is only called from host in sequential region | 
|  | int FTN_STDCALL | 
|  | KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE_ALL)(kmp_pause_status_t kind) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; // just fail | 
|  | #else | 
|  | int fails = 0; | 
|  | int (*fptr)(kmp_pause_status_t, int); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource"))) | 
|  | fails = (*fptr)(kind, KMP_DEVICE_ALL); // pause devices | 
|  | fails += __kmpc_pause_resource(kind); // pause host | 
|  | return fails; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // Returns the maximum number of nesting levels supported by implementation | 
|  | int FTN_STDCALL FTN_GET_SUPPORTED_ACTIVE_LEVELS(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; | 
|  | #else | 
|  | return KMP_MAX_ACTIVE_LEVELS_LIMIT; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | void FTN_STDCALL FTN_FULFILL_EVENT(kmp_event_t *event) { | 
|  | #ifndef KMP_STUB | 
|  | __kmp_fulfill_event(event); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // nteams-var per-device ICV | 
|  | void FTN_STDCALL FTN_SET_NUM_TEAMS(int KMP_DEREF num_teams) { | 
|  | #ifdef KMP_STUB | 
|  | // Nothing. | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | __kmp_set_num_teams(KMP_DEREF num_teams); | 
|  | #endif | 
|  | } | 
|  | int FTN_STDCALL FTN_GET_MAX_TEAMS(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | return __kmp_get_max_teams(); | 
|  | #endif | 
|  | } | 
|  | // teams-thread-limit-var per-device ICV | 
|  | void FTN_STDCALL FTN_SET_TEAMS_THREAD_LIMIT(int KMP_DEREF limit) { | 
|  | #ifdef KMP_STUB | 
|  | // Nothing. | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | __kmp_set_teams_thread_limit(KMP_DEREF limit); | 
|  | #endif | 
|  | } | 
|  | int FTN_STDCALL FTN_GET_TEAMS_THREAD_LIMIT(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 1; | 
|  | #else | 
|  | if (!__kmp_init_serial) { | 
|  | __kmp_serial_initialize(); | 
|  | } | 
|  | return __kmp_get_teams_thread_limit(); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /// TODO: Include the `omp.h` of the current build | 
|  | /* OpenMP 5.1 interop */ | 
|  | typedef intptr_t omp_intptr_t; | 
|  |  | 
|  | /* 0..omp_get_num_interop_properties()-1 are reserved for implementation-defined | 
|  | * properties */ | 
|  | typedef enum omp_interop_property { | 
|  | omp_ipr_fr_id = -1, | 
|  | omp_ipr_fr_name = -2, | 
|  | omp_ipr_vendor = -3, | 
|  | omp_ipr_vendor_name = -4, | 
|  | omp_ipr_device_num = -5, | 
|  | omp_ipr_platform = -6, | 
|  | omp_ipr_device = -7, | 
|  | omp_ipr_device_context = -8, | 
|  | omp_ipr_targetsync = -9, | 
|  | omp_ipr_first = -9 | 
|  | } omp_interop_property_t; | 
|  |  | 
|  | #define omp_interop_none 0 | 
|  |  | 
|  | typedef enum omp_interop_rc { | 
|  | omp_irc_no_value = 1, | 
|  | omp_irc_success = 0, | 
|  | omp_irc_empty = -1, | 
|  | omp_irc_out_of_range = -2, | 
|  | omp_irc_type_int = -3, | 
|  | omp_irc_type_ptr = -4, | 
|  | omp_irc_type_str = -5, | 
|  | omp_irc_other = -6 | 
|  | } omp_interop_rc_t; | 
|  |  | 
|  | typedef enum omp_interop_fr { | 
|  | omp_ifr_cuda = 1, | 
|  | omp_ifr_cuda_driver = 2, | 
|  | omp_ifr_opencl = 3, | 
|  | omp_ifr_sycl = 4, | 
|  | omp_ifr_hip = 5, | 
|  | omp_ifr_level_zero = 6, | 
|  | omp_ifr_last = 7 | 
|  | } omp_interop_fr_t; | 
|  |  | 
|  | typedef void *omp_interop_t; | 
|  |  | 
|  | // libomptarget, if loaded, provides this function | 
|  | int FTN_STDCALL FTN_GET_NUM_INTEROP_PROPERTIES(const omp_interop_t interop) { | 
|  | #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB) | 
|  | return 0; | 
|  | #else | 
|  | int (*fptr)(const omp_interop_t); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_interop_properties"))) | 
|  | return (*fptr)(interop); | 
|  | return 0; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | /// TODO Convert FTN_GET_INTEROP_XXX functions into a macro like interop.cpp | 
|  | // libomptarget, if loaded, provides this function | 
|  | intptr_t FTN_STDCALL FTN_GET_INTEROP_INT(const omp_interop_t interop, | 
|  | omp_interop_property_t property_id, | 
|  | int *err) { | 
|  | #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB) | 
|  | return 0; | 
|  | #else | 
|  | intptr_t (*fptr)(const omp_interop_t, omp_interop_property_t, int *); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_int"))) | 
|  | return (*fptr)(interop, property_id, err); | 
|  | return 0; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // libomptarget, if loaded, provides this function | 
|  | void *FTN_STDCALL FTN_GET_INTEROP_PTR(const omp_interop_t interop, | 
|  | omp_interop_property_t property_id, | 
|  | int *err) { | 
|  | #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB) | 
|  | return nullptr; | 
|  | #else | 
|  | void *(*fptr)(const omp_interop_t, omp_interop_property_t, int *); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_ptr"))) | 
|  | return (*fptr)(interop, property_id, err); | 
|  | return nullptr; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // libomptarget, if loaded, provides this function | 
|  | const char *FTN_STDCALL FTN_GET_INTEROP_STR(const omp_interop_t interop, | 
|  | omp_interop_property_t property_id, | 
|  | int *err) { | 
|  | #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB) | 
|  | return nullptr; | 
|  | #else | 
|  | const char *(*fptr)(const omp_interop_t, omp_interop_property_t, int *); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_str"))) | 
|  | return (*fptr)(interop, property_id, err); | 
|  | return nullptr; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // libomptarget, if loaded, provides this function | 
|  | const char *FTN_STDCALL FTN_GET_INTEROP_NAME( | 
|  | const omp_interop_t interop, omp_interop_property_t property_id) { | 
|  | #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB) | 
|  | return nullptr; | 
|  | #else | 
|  | const char *(*fptr)(const omp_interop_t, omp_interop_property_t); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_name"))) | 
|  | return (*fptr)(interop, property_id); | 
|  | return nullptr; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // libomptarget, if loaded, provides this function | 
|  | const char *FTN_STDCALL FTN_GET_INTEROP_TYPE_DESC( | 
|  | const omp_interop_t interop, omp_interop_property_t property_id) { | 
|  | #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB) | 
|  | return nullptr; | 
|  | #else | 
|  | const char *(*fptr)(const omp_interop_t, omp_interop_property_t); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_type_desc"))) | 
|  | return (*fptr)(interop, property_id); | 
|  | return nullptr; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // libomptarget, if loaded, provides this function | 
|  | const char *FTN_STDCALL FTN_GET_INTEROP_RC_DESC( | 
|  | const omp_interop_t interop, omp_interop_property_t property_id) { | 
|  | #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB) | 
|  | return nullptr; | 
|  | #else | 
|  | const char *(*fptr)(const omp_interop_t, omp_interop_property_t); | 
|  | if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_rec_desc"))) | 
|  | return (*fptr)(interop, property_id); | 
|  | return nullptr; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // display environment variables when requested | 
|  | void FTN_STDCALL FTN_DISPLAY_ENV(int verbose) { | 
|  | #ifndef KMP_STUB | 
|  | __kmp_omp_display_env(verbose); | 
|  | #endif | 
|  | } | 
|  |  | 
|  | int FTN_STDCALL FTN_IN_EXPLICIT_TASK(void) { | 
|  | #ifdef KMP_STUB | 
|  | return 0; | 
|  | #else | 
|  | int gtid = __kmp_entry_gtid(); | 
|  | return __kmp_thread_from_gtid(gtid)->th.th_current_task->td_flags.tasktype; | 
|  | #endif | 
|  | } | 
|  |  | 
|  | // GCC compatibility (versioned symbols) | 
|  | #ifdef KMP_USE_VERSION_SYMBOLS | 
|  |  | 
|  | /* These following sections create versioned symbols for the | 
|  | omp_* routines. The KMP_VERSION_SYMBOL macro expands the API name and | 
|  | then maps it to a versioned symbol. | 
|  | libgomp ``versions'' its symbols (OMP_1.0, OMP_2.0, OMP_3.0, ...) while also | 
|  | retaining the default version which libomp uses: VERSION (defined in | 
|  | exports_so.txt). If you want to see the versioned symbols for libgomp.so.1 | 
|  | then just type: | 
|  |  | 
|  | objdump -T /path/to/libgomp.so.1 | grep omp_ | 
|  |  | 
|  | Example: | 
|  | Step 1) Create __kmp_api_omp_set_num_threads_10_alias which is alias of | 
|  | __kmp_api_omp_set_num_threads | 
|  | Step 2) Set __kmp_api_omp_set_num_threads_10_alias to version: | 
|  | omp_set_num_threads@OMP_1.0 | 
|  | Step 2B) Set __kmp_api_omp_set_num_threads to default version: | 
|  | omp_set_num_threads@@VERSION | 
|  | */ | 
|  |  | 
|  | // OMP_1.0 versioned symbols | 
|  | KMP_VERSION_SYMBOL(FTN_SET_NUM_THREADS, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_NUM_THREADS, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_MAX_THREADS, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_THREAD_NUM, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_NUM_PROCS, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_IN_PARALLEL, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_DYNAMIC, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_DYNAMIC, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_NESTED, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_NESTED, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 10, "OMP_1.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 10, "OMP_1.0"); | 
|  |  | 
|  | // OMP_2.0 versioned symbols | 
|  | KMP_VERSION_SYMBOL(FTN_GET_WTICK, 20, "OMP_2.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_WTIME, 20, "OMP_2.0"); | 
|  |  | 
|  | // OMP_3.0 versioned symbols | 
|  | KMP_VERSION_SYMBOL(FTN_SET_SCHEDULE, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_SCHEDULE, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_LEVEL, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_TEAM_SIZE, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0"); | 
|  |  | 
|  | // the lock routines have a 1.0 and 3.0 version | 
|  | KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 30, "OMP_3.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 30, "OMP_3.0"); | 
|  |  | 
|  | // OMP_3.1 versioned symbol | 
|  | KMP_VERSION_SYMBOL(FTN_IN_FINAL, 31, "OMP_3.1"); | 
|  |  | 
|  | // OMP_4.0 versioned symbols | 
|  | KMP_VERSION_SYMBOL(FTN_GET_PROC_BIND, 40, "OMP_4.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_NUM_TEAMS, 40, "OMP_4.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_TEAM_NUM, 40, "OMP_4.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_CANCELLATION, 40, "OMP_4.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_DEFAULT_DEVICE, 40, "OMP_4.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_DEFAULT_DEVICE, 40, "OMP_4.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_NUM_DEVICES, 40, "OMP_4.0"); | 
|  |  | 
|  | // OMP_4.5 versioned symbols | 
|  | KMP_VERSION_SYMBOL(FTN_GET_MAX_TASK_PRIORITY, 45, "OMP_4.5"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_NUM_PLACES, 45, "OMP_4.5"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM_PROCS, 45, "OMP_4.5"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_PLACE_PROC_IDS, 45, "OMP_4.5"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM, 45, "OMP_4.5"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_PARTITION_NUM_PLACES, 45, "OMP_4.5"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_PARTITION_PLACE_NUMS, 45, "OMP_4.5"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_INITIAL_DEVICE, 45, "OMP_4.5"); | 
|  |  | 
|  | // OMP_5.0 versioned symbols | 
|  | // KMP_VERSION_SYMBOL(FTN_GET_DEVICE_NUM, 50, "OMP_5.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE, 50, "OMP_5.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE_ALL, 50, "OMP_5.0"); | 
|  | // The C versions (KMP_FTN_PLAIN) of these symbols are in kmp_csupport.c | 
|  | #if KMP_FTN_ENTRIES == KMP_FTN_APPEND | 
|  | KMP_VERSION_SYMBOL(FTN_CAPTURE_AFFINITY, 50, "OMP_5.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_DISPLAY_AFFINITY, 50, "OMP_5.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_GET_AFFINITY_FORMAT, 50, "OMP_5.0"); | 
|  | KMP_VERSION_SYMBOL(FTN_SET_AFFINITY_FORMAT, 50, "OMP_5.0"); | 
|  | #endif | 
|  | // KMP_VERSION_SYMBOL(FTN_GET_SUPPORTED_ACTIVE_LEVELS, 50, "OMP_5.0"); | 
|  | // KMP_VERSION_SYMBOL(FTN_FULFILL_EVENT, 50, "OMP_5.0"); | 
|  |  | 
|  | #endif // KMP_USE_VERSION_SYMBOLS | 
|  |  | 
|  | #ifdef __cplusplus | 
|  | } // extern "C" | 
|  | #endif // __cplusplus | 
|  |  | 
|  | // end of file // |