Loading...
Searching...
No Matches
kmp_ftn_entry.h
/*
* 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 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_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 (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
}
/* 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
}
// 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 //
__kmpc_bound_num_threads
KMP_EXPORT kmp_int32 __kmpc_bound_num_threads(ident_t *)
Definition kmp_csupport.cpp:144