1916 lines · c
1/*2 * kmp_ftn_entry.h -- Fortran entry linkage support for OpenMP.3 */4 5//===----------------------------------------------------------------------===//6//7// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.8// See https://llvm.org/LICENSE.txt for license information.9// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception10//11//===----------------------------------------------------------------------===//12 13#ifndef FTN_STDCALL14#error The support file kmp_ftn_entry.h should not be compiled by itself.15#endif16 17#ifdef KMP_STUB18#include "kmp_stub.h"19#endif20 21#include "kmp_i18n.h"22 23// For affinity format functions24#include "kmp_io.h"25#include "kmp_str.h"26 27#if OMPT_SUPPORT28#include "ompt-specific.h"29#endif30 31#ifdef __cplusplus32extern "C" {33#endif // __cplusplus34 35/* For compatibility with the Gnu/MS Open MP codegen, omp_set_num_threads(),36 * omp_set_nested(), and omp_set_dynamic() [in lowercase on MS, and w/o37 * a trailing underscore on Linux* OS] take call by value integer arguments.38 * + omp_set_max_active_levels()39 * + omp_set_schedule()40 *41 * For backward compatibility with 9.1 and previous Intel compiler, these42 * entry points take call by reference integer arguments. */43#ifdef KMP_GOMP_COMPAT44#if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_UPPER)45#define PASS_ARGS_BY_VALUE 146#endif47#endif48#if KMP_OS_WINDOWS49#if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_APPEND)50#define PASS_ARGS_BY_VALUE 151#endif52#endif53 54// This macro helps to reduce code duplication.55#ifdef PASS_ARGS_BY_VALUE56#define KMP_DEREF57#else58#define KMP_DEREF *59#endif60 61// For API with specific C vs. Fortran interfaces (ompc_* exists in62// kmp_csupport.cpp), only create GOMP versioned symbols of the API for the63// APPEND Fortran entries in this file. The GOMP versioned symbols of the C API64// will take place where the ompc_* functions are defined.65#if KMP_FTN_ENTRIES == KMP_FTN_APPEND66#define KMP_EXPAND_NAME_IF_APPEND(name) KMP_EXPAND_NAME(name)67#else68#define KMP_EXPAND_NAME_IF_APPEND(name) name69#endif70 71void FTN_STDCALL FTN_SET_STACKSIZE(int KMP_DEREF arg) {72#ifdef KMP_STUB73 __kmps_set_stacksize(KMP_DEREF arg);74#else75 // __kmp_aux_set_stacksize initializes the library if needed76 __kmp_aux_set_stacksize((size_t)KMP_DEREF arg);77#endif78}79 80void FTN_STDCALL FTN_SET_STACKSIZE_S(size_t KMP_DEREF arg) {81#ifdef KMP_STUB82 __kmps_set_stacksize(KMP_DEREF arg);83#else84 // __kmp_aux_set_stacksize initializes the library if needed85 __kmp_aux_set_stacksize(KMP_DEREF arg);86#endif87}88 89int FTN_STDCALL FTN_GET_STACKSIZE(void) {90#ifdef KMP_STUB91 return (int)__kmps_get_stacksize();92#else93 if (!__kmp_init_serial) {94 __kmp_serial_initialize();95 }96 return (int)__kmp_stksize;97#endif98}99 100size_t FTN_STDCALL FTN_GET_STACKSIZE_S(void) {101#ifdef KMP_STUB102 return __kmps_get_stacksize();103#else104 if (!__kmp_init_serial) {105 __kmp_serial_initialize();106 }107 return __kmp_stksize;108#endif109}110 111void FTN_STDCALL FTN_SET_BLOCKTIME(int KMP_DEREF arg) {112#ifdef KMP_STUB113 __kmps_set_blocktime(KMP_DEREF arg);114#else115 int gtid, tid, bt = (KMP_DEREF arg);116 kmp_info_t *thread;117 118 gtid = __kmp_entry_gtid();119 tid = __kmp_tid_from_gtid(gtid);120 thread = __kmp_thread_from_gtid(gtid);121 122 __kmp_aux_convert_blocktime(&bt);123 __kmp_aux_set_blocktime(bt, thread, tid);124#endif125}126 127// Gets blocktime in units used for KMP_BLOCKTIME, ms otherwise128int FTN_STDCALL FTN_GET_BLOCKTIME(void) {129#ifdef KMP_STUB130 return __kmps_get_blocktime();131#else132 int gtid, tid;133 kmp_team_p *team;134 135 gtid = __kmp_entry_gtid();136 tid = __kmp_tid_from_gtid(gtid);137 team = __kmp_threads[gtid]->th.th_team;138 139 /* These must match the settings used in __kmp_wait_sleep() */140 if (__kmp_dflt_blocktime == KMP_MAX_BLOCKTIME) {141 KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d%cs\n", gtid,142 team->t.t_id, tid, KMP_MAX_BLOCKTIME, __kmp_blocktime_units));143 return KMP_MAX_BLOCKTIME;144 }145#ifdef KMP_ADJUST_BLOCKTIME146 else if (__kmp_zero_bt && !get__bt_set(team, tid)) {147 KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d%cs\n", gtid,148 team->t.t_id, tid, 0, __kmp_blocktime_units));149 return 0;150 }151#endif /* KMP_ADJUST_BLOCKTIME */152 else {153 int bt = get__blocktime(team, tid);154 if (__kmp_blocktime_units == 'm')155 bt = bt / 1000;156 KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d%cs\n", gtid,157 team->t.t_id, tid, bt, __kmp_blocktime_units));158 return bt;159 }160#endif161}162 163void FTN_STDCALL FTN_SET_LIBRARY_SERIAL(void) {164#ifdef KMP_STUB165 __kmps_set_library(library_serial);166#else167 // __kmp_user_set_library initializes the library if needed168 __kmp_user_set_library(library_serial);169#endif170}171 172void FTN_STDCALL FTN_SET_LIBRARY_TURNAROUND(void) {173#ifdef KMP_STUB174 __kmps_set_library(library_turnaround);175#else176 // __kmp_user_set_library initializes the library if needed177 __kmp_user_set_library(library_turnaround);178#endif179}180 181void FTN_STDCALL FTN_SET_LIBRARY_THROUGHPUT(void) {182#ifdef KMP_STUB183 __kmps_set_library(library_throughput);184#else185 // __kmp_user_set_library initializes the library if needed186 __kmp_user_set_library(library_throughput);187#endif188}189 190void FTN_STDCALL FTN_SET_LIBRARY(int KMP_DEREF arg) {191#ifdef KMP_STUB192 __kmps_set_library(KMP_DEREF arg);193#else194 enum library_type lib;195 lib = (enum library_type)KMP_DEREF arg;196 // __kmp_user_set_library initializes the library if needed197 __kmp_user_set_library(lib);198#endif199}200 201int FTN_STDCALL FTN_GET_LIBRARY(void) {202#ifdef KMP_STUB203 return __kmps_get_library();204#else205 if (!__kmp_init_serial) {206 __kmp_serial_initialize();207 }208 return ((int)__kmp_library);209#endif210}211 212void FTN_STDCALL FTN_SET_DISP_NUM_BUFFERS(int KMP_DEREF arg) {213#ifdef KMP_STUB214 ; // empty routine215#else216 // ignore after initialization because some teams have already217 // allocated dispatch buffers218 int num_buffers = KMP_DEREF arg;219 if (__kmp_init_serial == FALSE && num_buffers >= KMP_MIN_DISP_NUM_BUFF &&220 num_buffers <= KMP_MAX_DISP_NUM_BUFF) {221 __kmp_dispatch_num_buffers = num_buffers;222 }223#endif224}225 226int FTN_STDCALL FTN_SET_AFFINITY(void **mask) {227#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED228 return -1;229#else230 if (!TCR_4(__kmp_init_middle)) {231 __kmp_middle_initialize();232 }233 __kmp_assign_root_init_mask();234 return __kmp_aux_set_affinity(mask);235#endif236}237 238int FTN_STDCALL FTN_GET_AFFINITY(void **mask) {239#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED240 return -1;241#else242 if (!TCR_4(__kmp_init_middle)) {243 __kmp_middle_initialize();244 }245 __kmp_assign_root_init_mask();246 int gtid = __kmp_get_gtid();247 if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 &&248 __kmp_affinity.flags.reset) {249 __kmp_reset_root_init_mask(gtid);250 }251 return __kmp_aux_get_affinity(mask);252#endif253}254 255int FTN_STDCALL FTN_GET_AFFINITY_MAX_PROC(void) {256#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED257 return 0;258#else259 // We really only NEED serial initialization here.260 if (!TCR_4(__kmp_init_middle)) {261 __kmp_middle_initialize();262 }263 __kmp_assign_root_init_mask();264 return __kmp_aux_get_affinity_max_proc();265#endif266}267 268void FTN_STDCALL FTN_CREATE_AFFINITY_MASK(void **mask) {269#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED270 *mask = NULL;271#else272 // We really only NEED serial initialization here.273 kmp_affin_mask_t *mask_internals;274 if (!TCR_4(__kmp_init_middle)) {275 __kmp_middle_initialize();276 }277 __kmp_assign_root_init_mask();278 mask_internals = __kmp_affinity_dispatch->allocate_mask();279 KMP_CPU_ZERO(mask_internals);280 *mask = mask_internals;281#endif282}283 284void FTN_STDCALL FTN_DESTROY_AFFINITY_MASK(void **mask) {285#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED286// Nothing287#else288 // We really only NEED serial initialization here.289 kmp_affin_mask_t *mask_internals;290 if (!TCR_4(__kmp_init_middle)) {291 __kmp_middle_initialize();292 }293 __kmp_assign_root_init_mask();294 if (__kmp_env_consistency_check) {295 if (*mask == NULL) {296 KMP_FATAL(AffinityInvalidMask, "kmp_destroy_affinity_mask");297 }298 }299 mask_internals = (kmp_affin_mask_t *)(*mask);300 __kmp_affinity_dispatch->deallocate_mask(mask_internals);301 *mask = NULL;302#endif303}304 305int FTN_STDCALL FTN_SET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {306#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED307 return -1;308#else309 if (!TCR_4(__kmp_init_middle)) {310 __kmp_middle_initialize();311 }312 __kmp_assign_root_init_mask();313 return __kmp_aux_set_affinity_mask_proc(KMP_DEREF proc, mask);314#endif315}316 317int FTN_STDCALL FTN_UNSET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {318#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED319 return -1;320#else321 if (!TCR_4(__kmp_init_middle)) {322 __kmp_middle_initialize();323 }324 __kmp_assign_root_init_mask();325 return __kmp_aux_unset_affinity_mask_proc(KMP_DEREF proc, mask);326#endif327}328 329int FTN_STDCALL FTN_GET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {330#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED331 return -1;332#else333 if (!TCR_4(__kmp_init_middle)) {334 __kmp_middle_initialize();335 }336 __kmp_assign_root_init_mask();337 return __kmp_aux_get_affinity_mask_proc(KMP_DEREF proc, mask);338#endif339}340 341/* ------------------------------------------------------------------------ */342 343/* sets the requested number of threads for the next parallel region */344void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NUM_THREADS)(int KMP_DEREF arg) {345#ifdef KMP_STUB346// Nothing.347#else348 __kmp_set_num_threads(KMP_DEREF arg, __kmp_entry_gtid());349#endif350}351 352/* returns the number of threads in current team */353int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_THREADS)(void) {354#ifdef KMP_STUB355 return 1;356#else357 // __kmpc_bound_num_threads initializes the library if needed358 return __kmpc_bound_num_threads(NULL);359#endif360}361 362int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_THREADS)(void) {363#ifdef KMP_STUB364 return 1;365#else366 int gtid;367 kmp_info_t *thread;368 if (!TCR_4(__kmp_init_middle)) {369 __kmp_middle_initialize();370 }371 gtid = __kmp_entry_gtid();372 thread = __kmp_threads[gtid];373#if KMP_AFFINITY_SUPPORTED374 if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {375 __kmp_assign_root_init_mask();376 }377#endif378 // return thread -> th.th_team -> t.t_current_task[379 // thread->th.th_info.ds.ds_tid ] -> icvs.nproc;380 return thread->th.th_current_task->td_icvs.nproc;381#endif382}383 384int FTN_STDCALL FTN_CONTROL_TOOL(int command, int modifier, void *arg) {385#if defined(KMP_STUB) || !OMPT_SUPPORT386 return -2;387#else388 OMPT_STORE_RETURN_ADDRESS(__kmp_entry_gtid());389 if (!TCR_4(__kmp_init_middle)) {390 return -2;391 }392 kmp_info_t *this_thr = __kmp_threads[__kmp_entry_gtid()];393 ompt_task_info_t *parent_task_info = OMPT_CUR_TASK_INFO(this_thr);394 parent_task_info->frame.enter_frame.ptr = OMPT_GET_FRAME_ADDRESS(0);395 int ret = __kmp_control_tool(command, modifier, arg);396 parent_task_info->frame.enter_frame.ptr = 0;397 return ret;398#endif399}400 401/* OpenMP 5.0 Memory Management support */402omp_allocator_handle_t FTN_STDCALL403FTN_INIT_ALLOCATOR(omp_memspace_handle_t KMP_DEREF m, int KMP_DEREF ntraits,404 omp_alloctrait_t tr[]) {405#ifdef KMP_STUB406 return NULL;407#else408 return __kmpc_init_allocator(__kmp_entry_gtid(), KMP_DEREF m,409 KMP_DEREF ntraits, tr);410#endif411}412 413void FTN_STDCALL FTN_DESTROY_ALLOCATOR(omp_allocator_handle_t al) {414#ifndef KMP_STUB415 __kmpc_destroy_allocator(__kmp_entry_gtid(), al);416#endif417}418void FTN_STDCALL FTN_SET_DEFAULT_ALLOCATOR(omp_allocator_handle_t al) {419#ifndef KMP_STUB420 __kmpc_set_default_allocator(__kmp_entry_gtid(), al);421#endif422}423omp_allocator_handle_t FTN_STDCALL FTN_GET_DEFAULT_ALLOCATOR(void) {424#ifdef KMP_STUB425 return NULL;426#else427 return __kmpc_get_default_allocator(__kmp_entry_gtid());428#endif429}430 431/* OpenMP 6.0 (TR11) Memory Management support */432omp_memspace_handle_t FTN_STDCALL433FTN_GET_DEVICES_MEMSPACE(int KMP_DEREF ndevs, const int *devs,434 omp_memspace_handle_t KMP_DEREF memspace) {435#ifdef KMP_STUB436 return NULL;437#else438 return __kmp_get_devices_memspace(KMP_DEREF ndevs, devs, KMP_DEREF memspace,439 0 /* host */);440#endif441}442 443omp_memspace_handle_t FTN_STDCALL FTN_GET_DEVICE_MEMSPACE(444 int KMP_DEREF dev, omp_memspace_handle_t KMP_DEREF memspace) {445#ifdef KMP_STUB446 return NULL;447#else448 int dev_num = KMP_DEREF dev;449 return __kmp_get_devices_memspace(1, &dev_num, KMP_DEREF memspace, 0);450#endif451}452 453omp_memspace_handle_t FTN_STDCALL454FTN_GET_DEVICES_AND_HOST_MEMSPACE(int KMP_DEREF ndevs, const int *devs,455 omp_memspace_handle_t KMP_DEREF memspace) {456#ifdef KMP_STUB457 return NULL;458#else459 return __kmp_get_devices_memspace(KMP_DEREF ndevs, devs, KMP_DEREF memspace,460 1);461#endif462}463 464omp_memspace_handle_t FTN_STDCALL FTN_GET_DEVICE_AND_HOST_MEMSPACE(465 int KMP_DEREF dev, omp_memspace_handle_t KMP_DEREF memspace) {466#ifdef KMP_STUB467 return NULL;468#else469 int dev_num = KMP_DEREF dev;470 return __kmp_get_devices_memspace(1, &dev_num, KMP_DEREF memspace, 1);471#endif472}473 474omp_memspace_handle_t FTN_STDCALL475FTN_GET_DEVICES_ALL_MEMSPACE(omp_memspace_handle_t KMP_DEREF memspace) {476#ifdef KMP_STUB477 return NULL;478#else479 return __kmp_get_devices_memspace(0, NULL, KMP_DEREF memspace, 1);480#endif481}482 483omp_allocator_handle_t FTN_STDCALL484FTN_GET_DEVICES_ALLOCATOR(int KMP_DEREF ndevs, const int *devs,485 omp_allocator_handle_t KMP_DEREF memspace) {486#ifdef KMP_STUB487 return NULL;488#else489 return __kmp_get_devices_allocator(KMP_DEREF ndevs, devs, KMP_DEREF memspace,490 0 /* host */);491#endif492}493 494omp_allocator_handle_t FTN_STDCALL FTN_GET_DEVICE_ALLOCATOR(495 int KMP_DEREF dev, omp_allocator_handle_t KMP_DEREF memspace) {496#ifdef KMP_STUB497 return NULL;498#else499 int dev_num = KMP_DEREF dev;500 return __kmp_get_devices_allocator(1, &dev_num, KMP_DEREF memspace, 0);501#endif502}503 504omp_allocator_handle_t FTN_STDCALL505FTN_GET_DEVICES_AND_HOST_ALLOCATOR(int KMP_DEREF ndevs, const int *devs,506 omp_allocator_handle_t KMP_DEREF memspace) {507#ifdef KMP_STUB508 return NULL;509#else510 return __kmp_get_devices_allocator(KMP_DEREF ndevs, devs, KMP_DEREF memspace,511 1);512#endif513}514 515omp_allocator_handle_t FTN_STDCALL FTN_GET_DEVICE_AND_HOST_ALLOCATOR(516 int KMP_DEREF dev, omp_allocator_handle_t KMP_DEREF memspace) {517#ifdef KMP_STUB518 return NULL;519#else520 int dev_num = KMP_DEREF dev;521 return __kmp_get_devices_allocator(1, &dev_num, KMP_DEREF memspace, 1);522#endif523}524 525omp_allocator_handle_t FTN_STDCALL526FTN_GET_DEVICES_ALL_ALLOCATOR(omp_allocator_handle_t KMP_DEREF memspace) {527#ifdef KMP_STUB528 return NULL;529#else530 return __kmp_get_devices_allocator(0, NULL, KMP_DEREF memspace, 1);531#endif532}533 534int FTN_STDCALL535FTN_GET_MEMSPACE_NUM_RESOURCES(omp_memspace_handle_t KMP_DEREF memspace) {536#ifdef KMP_STUB537 return 0;538#else539 return __kmp_get_memspace_num_resources(KMP_DEREF memspace);540#endif541}542 543omp_memspace_handle_t FTN_STDCALL544FTN_GET_SUBMEMSPACE(omp_memspace_handle_t KMP_DEREF memspace,545 int KMP_DEREF num_resources, int *resources) {546#ifdef KMP_STUB547 return NULL;548#else549 return __kmp_get_submemspace(KMP_DEREF memspace, KMP_DEREF num_resources,550 resources);551#endif552}553 554/* OpenMP 5.0 affinity format support */555#ifndef KMP_STUB556static void __kmp_fortran_strncpy_truncate(char *buffer, size_t buf_size,557 char const *csrc, size_t csrc_size) {558 size_t capped_src_size = csrc_size;559 if (csrc_size >= buf_size) {560 capped_src_size = buf_size - 1;561 }562 KMP_STRNCPY_S(buffer, buf_size, csrc, capped_src_size);563 if (csrc_size >= buf_size) {564 KMP_DEBUG_ASSERT(buffer[buf_size - 1] == '\0');565 buffer[buf_size - 1] = csrc[buf_size - 1];566 } else {567 for (size_t i = csrc_size; i < buf_size; ++i)568 buffer[i] = ' ';569 }570}571 572// Convert a Fortran string to a C string by adding null byte573class ConvertedString {574 char *buf;575 576public:577 ConvertedString(char const *fortran_str, size_t size) {578 buf = (char *)KMP_INTERNAL_MALLOC(size + 1);579 KMP_STRNCPY_S(buf, size + 1, fortran_str, size);580 buf[size] = '\0';581 }582 ~ConvertedString() { KMP_INTERNAL_FREE(buf); }583 const char *get() const { return buf; }584};585#endif // KMP_STUB586 587/*588 * Set the value of the affinity-format-var ICV on the current device to the589 * format specified in the argument.590 */591void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_SET_AFFINITY_FORMAT)(592 char const *format, size_t size) {593#ifdef KMP_STUB594 return;595#else596 if (!__kmp_init_serial) {597 __kmp_serial_initialize();598 }599 ConvertedString cformat(format, size);600 // Since the __kmp_affinity_format variable is a C string, do not601 // use the fortran strncpy function602 __kmp_strncpy_truncate(__kmp_affinity_format, KMP_AFFINITY_FORMAT_SIZE,603 cformat.get(), KMP_STRLEN(cformat.get()));604#endif605}606 607/*608 * Returns the number of characters required to hold the entire affinity format609 * specification (not including null byte character) and writes the value of the610 * affinity-format-var ICV on the current device to buffer. If the return value611 * is larger than size, the affinity format specification is truncated.612 */613size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_GET_AFFINITY_FORMAT)(614 char *buffer, size_t size) {615#ifdef KMP_STUB616 return 0;617#else618 size_t format_size;619 if (!__kmp_init_serial) {620 __kmp_serial_initialize();621 }622 format_size = KMP_STRLEN(__kmp_affinity_format);623 if (buffer && size) {624 __kmp_fortran_strncpy_truncate(buffer, size, __kmp_affinity_format,625 format_size);626 }627 return format_size;628#endif629}630 631/*632 * Prints the thread affinity information of the current thread in the format633 * specified by the format argument. If the format is NULL or a zero-length634 * string, the value of the affinity-format-var ICV is used.635 */636void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_DISPLAY_AFFINITY)(637 char const *format, size_t size) {638#ifdef KMP_STUB639 return;640#else641 int gtid;642 if (!TCR_4(__kmp_init_middle)) {643 __kmp_middle_initialize();644 }645 __kmp_assign_root_init_mask();646 gtid = __kmp_get_gtid();647#if KMP_AFFINITY_SUPPORTED648 if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 &&649 __kmp_affinity.flags.reset) {650 __kmp_reset_root_init_mask(gtid);651 }652#endif653 ConvertedString cformat(format, size);654 __kmp_aux_display_affinity(gtid, cformat.get());655#endif656}657 658/*659 * Returns the number of characters required to hold the entire affinity format660 * specification (not including null byte) and prints the thread affinity661 * information of the current thread into the character string buffer with the662 * size of size in the format specified by the format argument. If the format is663 * NULL or a zero-length string, the value of the affinity-format-var ICV is664 * used. The buffer must be allocated prior to calling the routine. If the665 * return value is larger than size, the affinity format specification is666 * truncated.667 */668size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_CAPTURE_AFFINITY)(669 char *buffer, char const *format, size_t buf_size, size_t for_size) {670#if defined(KMP_STUB)671 return 0;672#else673 int gtid;674 size_t num_required;675 kmp_str_buf_t capture_buf;676 if (!TCR_4(__kmp_init_middle)) {677 __kmp_middle_initialize();678 }679 __kmp_assign_root_init_mask();680 gtid = __kmp_get_gtid();681#if KMP_AFFINITY_SUPPORTED682 if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 &&683 __kmp_affinity.flags.reset) {684 __kmp_reset_root_init_mask(gtid);685 }686#endif687 __kmp_str_buf_init(&capture_buf);688 ConvertedString cformat(format, for_size);689 num_required = __kmp_aux_capture_affinity(gtid, cformat.get(), &capture_buf);690 if (buffer && buf_size) {691 __kmp_fortran_strncpy_truncate(buffer, buf_size, capture_buf.str,692 capture_buf.used);693 }694 __kmp_str_buf_free(&capture_buf);695 return num_required;696#endif697}698 699int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_NUM)(void) {700#ifdef KMP_STUB701 return 0;702#else703 int gtid;704 705#if KMP_OS_DARWIN || KMP_OS_DRAGONFLY || KMP_OS_FREEBSD || KMP_OS_NETBSD || \706 KMP_OS_OPENBSD || KMP_OS_HAIKU || KMP_OS_HURD || KMP_OS_SOLARIS || \707 KMP_OS_AIX708 gtid = __kmp_entry_gtid();709#elif KMP_OS_WINDOWS710 if (!__kmp_init_parallel ||711 (gtid = (int)((kmp_intptr_t)TlsGetValue(__kmp_gtid_threadprivate_key))) ==712 0) {713 // Either library isn't initialized or thread is not registered714 // 0 is the correct TID in this case715 return 0;716 }717 --gtid; // We keep (gtid+1) in TLS718#elif KMP_OS_LINUX || KMP_OS_WASI719#ifdef KMP_TDATA_GTID720 if (__kmp_gtid_mode >= 3) {721 if ((gtid = __kmp_gtid) == KMP_GTID_DNE) {722 return 0;723 }724 } else {725#endif726 if (!__kmp_init_parallel ||727 (gtid = (int)((kmp_intptr_t)(728 pthread_getspecific(__kmp_gtid_threadprivate_key)))) == 0) {729 return 0;730 }731 --gtid;732#ifdef KMP_TDATA_GTID733 }734#endif735#else736#error Unknown or unsupported OS737#endif738 739 return __kmp_tid_from_gtid(gtid);740#endif741}742 743int FTN_STDCALL FTN_GET_NUM_KNOWN_THREADS(void) {744#ifdef KMP_STUB745 return 1;746#else747 if (!__kmp_init_serial) {748 __kmp_serial_initialize();749 }750 /* NOTE: this is not syncronized, so it can change at any moment */751 /* NOTE: this number also includes threads preallocated in hot-teams */752 return TCR_4(__kmp_nth);753#endif754}755 756int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PROCS)(void) {757#ifdef KMP_STUB758 return 1;759#else760 if (!TCR_4(__kmp_init_middle)) {761 __kmp_middle_initialize();762 }763#if KMP_AFFINITY_SUPPORTED764 if (!__kmp_affinity.flags.reset) {765 // only bind root here if its affinity reset is not requested766 int gtid = __kmp_entry_gtid();767 kmp_info_t *thread = __kmp_threads[gtid];768 if (thread->th.th_team->t.t_level == 0) {769 __kmp_assign_root_init_mask();770 }771 }772#endif773 return __kmp_avail_proc;774#endif775}776 777void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NESTED)(int KMP_DEREF flag) {778#ifdef KMP_STUB779 __kmps_set_nested(KMP_DEREF flag);780#else781 kmp_info_t *thread;782 /* For the thread-private internal controls implementation */783 thread = __kmp_entry_thread();784 KMP_INFORM(APIDeprecated, "omp_set_nested", "omp_set_max_active_levels");785 __kmp_save_internal_controls(thread);786 // Somewhat arbitrarily decide where to get a value for max_active_levels787 int max_active_levels = get__max_active_levels(thread);788 if (max_active_levels == 1)789 max_active_levels = KMP_MAX_ACTIVE_LEVELS_LIMIT;790 set__max_active_levels(thread, (KMP_DEREF flag) ? max_active_levels : 1);791#endif792}793 794int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NESTED)(void) {795#ifdef KMP_STUB796 return __kmps_get_nested();797#else798 kmp_info_t *thread;799 thread = __kmp_entry_thread();800 KMP_INFORM(APIDeprecated, "omp_get_nested", "omp_get_max_active_levels");801 return get__max_active_levels(thread) > 1;802#endif803}804 805void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DYNAMIC)(int KMP_DEREF flag) {806#ifdef KMP_STUB807 __kmps_set_dynamic(KMP_DEREF flag ? TRUE : FALSE);808#else809 kmp_info_t *thread;810 /* For the thread-private implementation of the internal controls */811 thread = __kmp_entry_thread();812 // !!! What if foreign thread calls it?813 __kmp_save_internal_controls(thread);814 set__dynamic(thread, KMP_DEREF flag ? true : false);815#endif816}817 818int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DYNAMIC)(void) {819#ifdef KMP_STUB820 return __kmps_get_dynamic();821#else822 kmp_info_t *thread;823 thread = __kmp_entry_thread();824 return get__dynamic(thread);825#endif826}827 828int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_PARALLEL)(void) {829#ifdef KMP_STUB830 return 0;831#else832 kmp_info_t *th = __kmp_entry_thread();833 if (th->th.th_teams_microtask) {834 // AC: r_in_parallel does not work inside teams construct where real835 // parallel is inactive, but all threads have same root, so setting it in836 // one team affects other teams.837 // The solution is to use per-team nesting level838 return (th->th.th_team->t.t_active_level ? 1 : 0);839 } else840 return (th->th.th_root->r.r_in_parallel ? FTN_TRUE : FTN_FALSE);841#endif842}843 844void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_SCHEDULE)(kmp_sched_t KMP_DEREF kind,845 int KMP_DEREF modifier) {846#ifdef KMP_STUB847 __kmps_set_schedule(KMP_DEREF kind, KMP_DEREF modifier);848#else849 /* TO DO: For the per-task implementation of the internal controls */850 __kmp_set_schedule(__kmp_entry_gtid(), KMP_DEREF kind, KMP_DEREF modifier);851#endif852}853 854void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_SCHEDULE)(kmp_sched_t *kind,855 int *modifier) {856#ifdef KMP_STUB857 __kmps_get_schedule(kind, modifier);858#else859 /* TO DO: For the per-task implementation of the internal controls */860 __kmp_get_schedule(__kmp_entry_gtid(), kind, modifier);861#endif862}863 864void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_MAX_ACTIVE_LEVELS)(int KMP_DEREF arg) {865#ifdef KMP_STUB866// Nothing.867#else868 /* TO DO: We want per-task implementation of this internal control */869 __kmp_set_max_active_levels(__kmp_entry_gtid(), KMP_DEREF arg);870#endif871}872 873int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_ACTIVE_LEVELS)(void) {874#ifdef KMP_STUB875 return 0;876#else877 /* TO DO: We want per-task implementation of this internal control */878 if (!TCR_4(__kmp_init_middle)) {879 __kmp_middle_initialize();880 }881 return __kmp_get_max_active_levels(__kmp_entry_gtid());882#endif883}884 885int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_ACTIVE_LEVEL)(void) {886#ifdef KMP_STUB887 return 0; // returns 0 if it is called from the sequential part of the program888#else889 /* TO DO: For the per-task implementation of the internal controls */890 return __kmp_entry_thread()->th.th_team->t.t_active_level;891#endif892}893 894int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_LEVEL)(void) {895#ifdef KMP_STUB896 return 0; // returns 0 if it is called from the sequential part of the program897#else898 /* TO DO: For the per-task implementation of the internal controls */899 return __kmp_entry_thread()->th.th_team->t.t_level;900#endif901}902 903int FTN_STDCALL904KMP_EXPAND_NAME(FTN_GET_ANCESTOR_THREAD_NUM)(int KMP_DEREF level) {905#ifdef KMP_STUB906 return (KMP_DEREF level) ? (-1) : (0);907#else908 return __kmp_get_ancestor_thread_num(__kmp_entry_gtid(), KMP_DEREF level);909#endif910}911 912int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_SIZE)(int KMP_DEREF level) {913#ifdef KMP_STUB914 return (KMP_DEREF level) ? (-1) : (1);915#else916 return __kmp_get_team_size(__kmp_entry_gtid(), KMP_DEREF level);917#endif918}919 920int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_LIMIT)(void) {921#ifdef KMP_STUB922 return 1; // TO DO: clarify whether it returns 1 or 0?923#else924 int gtid;925 kmp_info_t *thread;926 if (!__kmp_init_serial) {927 __kmp_serial_initialize();928 }929 930 gtid = __kmp_entry_gtid();931 thread = __kmp_threads[gtid];932 // If thread_limit for the target task is defined, return that instead of the933 // regular task thread_limit934 if (int thread_limit = thread->th.th_current_task->td_icvs.task_thread_limit)935 return thread_limit;936 return thread->th.th_current_task->td_icvs.thread_limit;937#endif938}939 940int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_FINAL)(void) {941#ifdef KMP_STUB942 return 0; // TO DO: clarify whether it returns 1 or 0?943#else944 if (!TCR_4(__kmp_init_parallel)) {945 return 0;946 }947 return __kmp_entry_thread()->th.th_current_task->td_flags.final;948#endif949}950 951kmp_proc_bind_t FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PROC_BIND)(void) {952#ifdef KMP_STUB953 return __kmps_get_proc_bind();954#else955 return get__proc_bind(__kmp_entry_thread());956#endif957}958 959int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PLACES)(void) {960#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED961 return 0;962#else963 if (!TCR_4(__kmp_init_middle)) {964 __kmp_middle_initialize();965 }966 if (!KMP_AFFINITY_CAPABLE())967 return 0;968 if (!__kmp_affinity.flags.reset) {969 // only bind root here if its affinity reset is not requested970 int gtid = __kmp_entry_gtid();971 kmp_info_t *thread = __kmp_threads[gtid];972 if (thread->th.th_team->t.t_level == 0) {973 __kmp_assign_root_init_mask();974 }975 }976 return __kmp_affinity.num_masks;977#endif978}979 980int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM_PROCS)(int place_num) {981#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED982 return 0;983#else984 int i;985 int retval = 0;986 if (!TCR_4(__kmp_init_middle)) {987 __kmp_middle_initialize();988 }989 if (!KMP_AFFINITY_CAPABLE())990 return 0;991 if (!__kmp_affinity.flags.reset) {992 // only bind root here if its affinity reset is not requested993 int gtid = __kmp_entry_gtid();994 kmp_info_t *thread = __kmp_threads[gtid];995 if (thread->th.th_team->t.t_level == 0) {996 __kmp_assign_root_init_mask();997 }998 }999 if (place_num < 0 || place_num >= (int)__kmp_affinity.num_masks)1000 return 0;1001 kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity.masks, place_num);1002 KMP_CPU_SET_ITERATE(i, mask) {1003 if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||1004 (!KMP_CPU_ISSET(i, mask))) {1005 continue;1006 }1007 ++retval;1008 }1009 return retval;1010#endif1011}1012 1013void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_PROC_IDS)(int place_num,1014 int *ids) {1015#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED1016// Nothing.1017#else1018 int i, j;1019 if (!TCR_4(__kmp_init_middle)) {1020 __kmp_middle_initialize();1021 }1022 if (!KMP_AFFINITY_CAPABLE())1023 return;1024 if (!__kmp_affinity.flags.reset) {1025 // only bind root here if its affinity reset is not requested1026 int gtid = __kmp_entry_gtid();1027 kmp_info_t *thread = __kmp_threads[gtid];1028 if (thread->th.th_team->t.t_level == 0) {1029 __kmp_assign_root_init_mask();1030 }1031 }1032 if (place_num < 0 || place_num >= (int)__kmp_affinity.num_masks)1033 return;1034 kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity.masks, place_num);1035 j = 0;1036 KMP_CPU_SET_ITERATE(i, mask) {1037 if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||1038 (!KMP_CPU_ISSET(i, mask))) {1039 continue;1040 }1041 ids[j++] = i;1042 }1043#endif1044}1045 1046int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM)(void) {1047#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED1048 return -1;1049#else1050 int gtid;1051 kmp_info_t *thread;1052 if (!TCR_4(__kmp_init_middle)) {1053 __kmp_middle_initialize();1054 }1055 if (!KMP_AFFINITY_CAPABLE())1056 return -1;1057 gtid = __kmp_entry_gtid();1058 thread = __kmp_thread_from_gtid(gtid);1059 if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {1060 __kmp_assign_root_init_mask();1061 }1062 if (thread->th.th_current_place < 0)1063 return -1;1064 return thread->th.th_current_place;1065#endif1066}1067 1068int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PARTITION_NUM_PLACES)(void) {1069#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED1070 return 0;1071#else1072 int gtid, num_places, first_place, last_place;1073 kmp_info_t *thread;1074 if (!TCR_4(__kmp_init_middle)) {1075 __kmp_middle_initialize();1076 }1077 if (!KMP_AFFINITY_CAPABLE())1078 return 0;1079 gtid = __kmp_entry_gtid();1080 thread = __kmp_thread_from_gtid(gtid);1081 if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {1082 __kmp_assign_root_init_mask();1083 }1084 first_place = thread->th.th_first_place;1085 last_place = thread->th.th_last_place;1086 if (first_place < 0 || last_place < 0)1087 return 0;1088 if (first_place <= last_place)1089 num_places = last_place - first_place + 1;1090 else1091 num_places = __kmp_affinity.num_masks - first_place + last_place + 1;1092 return num_places;1093#endif1094}1095 1096void FTN_STDCALL1097KMP_EXPAND_NAME(FTN_GET_PARTITION_PLACE_NUMS)(int *place_nums) {1098#if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED1099// Nothing.1100#else1101 int i, gtid, place_num, first_place, last_place, start, end;1102 kmp_info_t *thread;1103 if (!TCR_4(__kmp_init_middle)) {1104 __kmp_middle_initialize();1105 }1106 if (!KMP_AFFINITY_CAPABLE())1107 return;1108 gtid = __kmp_entry_gtid();1109 thread = __kmp_thread_from_gtid(gtid);1110 if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {1111 __kmp_assign_root_init_mask();1112 }1113 first_place = thread->th.th_first_place;1114 last_place = thread->th.th_last_place;1115 if (first_place < 0 || last_place < 0)1116 return;1117 if (first_place <= last_place) {1118 start = first_place;1119 end = last_place;1120 } else {1121 start = last_place;1122 end = first_place;1123 }1124 for (i = 0, place_num = start; place_num <= end; ++place_num, ++i) {1125 place_nums[i] = place_num;1126 }1127#endif1128}1129 1130int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_TEAMS)(void) {1131#ifdef KMP_STUB1132 return 1;1133#else1134 return __kmp_aux_get_num_teams();1135#endif1136}1137 1138int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_NUM)(void) {1139#ifdef KMP_STUB1140 return 0;1141#else1142 return __kmp_aux_get_team_num();1143#endif1144}1145 1146int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEFAULT_DEVICE)(void) {1147#if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)1148 return 0;1149#else1150 return __kmp_entry_thread()->th.th_current_task->td_icvs.default_device;1151#endif1152}1153 1154void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DEFAULT_DEVICE)(int KMP_DEREF arg) {1155#if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)1156// Nothing.1157#else1158 __kmp_entry_thread()->th.th_current_task->td_icvs.default_device =1159 KMP_DEREF arg;1160#endif1161}1162 1163// Get number of NON-HOST devices.1164// libomptarget, if loaded, provides this function in api.cpp.1165int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void)1166 KMP_WEAK_ATTRIBUTE_EXTERNAL;1167int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) {1168#if KMP_MIC || KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)1169 return 0;1170#else1171 int (*fptr)();1172 if ((*(void **)(&fptr) = KMP_DLSYM("__tgt_get_num_devices"))) {1173 return (*fptr)();1174 } else if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_devices"))) {1175 return (*fptr)();1176 } else if ((*(void **)(&fptr) = KMP_DLSYM("_Offload_number_of_devices"))) {1177 return (*fptr)();1178 } else { // liboffload & libomptarget don't exist1179 return 0;1180 }1181#endif // KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB)1182}1183 1184// This function always returns true when called on host device.1185// Compiler/libomptarget should handle when it is called inside target region.1186int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void)1187 KMP_WEAK_ATTRIBUTE_EXTERNAL;1188int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) {1189 return 1; // This is the host1190}1191 1192// libomptarget, if loaded, provides this function1193int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void)1194 KMP_WEAK_ATTRIBUTE_EXTERNAL;1195int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void) {1196 // same as omp_get_num_devices()1197 return KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)();1198}1199 1200#if defined(KMP_STUB)1201// Entries for stubs library1202// As all *target* functions are C-only parameters always passed by value1203void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; }1204 1205void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {}1206 1207int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; }1208 1209int FTN_STDCALL FTN_TARGET_MEMCPY(void *dst, void *src, size_t length,1210 size_t dst_offset, size_t src_offset,1211 int dst_device, int src_device) {1212 return -1;1213}1214 1215int FTN_STDCALL FTN_TARGET_MEMCPY_RECT(1216 void *dst, void *src, size_t element_size, int num_dims,1217 const size_t *volume, const size_t *dst_offsets, const size_t *src_offsets,1218 const size_t *dst_dimensions, const size_t *src_dimensions, int dst_device,1219 int src_device) {1220 return -1;1221}1222 1223int FTN_STDCALL FTN_TARGET_ASSOCIATE_PTR(void *host_ptr, void *device_ptr,1224 size_t size, size_t device_offset,1225 int device_num) {1226 return -1;1227}1228 1229int FTN_STDCALL FTN_TARGET_DISASSOCIATE_PTR(void *host_ptr, int device_num) {1230 return -1;1231}1232#endif // defined(KMP_STUB)1233 1234#ifdef KMP_STUB1235typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t;1236#endif /* KMP_STUB */1237 1238#if KMP_USE_DYNAMIC_LOCK1239void FTN_STDCALL FTN_INIT_LOCK_WITH_HINT(void **user_lock,1240 uintptr_t KMP_DEREF hint) {1241#ifdef KMP_STUB1242 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;1243#else1244 int gtid = __kmp_entry_gtid();1245#if OMPT_SUPPORT && OMPT_OPTIONAL1246 OMPT_STORE_RETURN_ADDRESS(gtid);1247#endif1248 __kmpc_init_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);1249#endif1250}1251 1252void FTN_STDCALL FTN_INIT_NEST_LOCK_WITH_HINT(void **user_lock,1253 uintptr_t KMP_DEREF hint) {1254#ifdef KMP_STUB1255 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;1256#else1257 int gtid = __kmp_entry_gtid();1258#if OMPT_SUPPORT && OMPT_OPTIONAL1259 OMPT_STORE_RETURN_ADDRESS(gtid);1260#endif1261 __kmpc_init_nest_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);1262#endif1263}1264#endif1265 1266/* initialize the lock */1267void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_LOCK)(void **user_lock) {1268#ifdef KMP_STUB1269 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;1270#else1271 int gtid = __kmp_entry_gtid();1272#if OMPT_SUPPORT && OMPT_OPTIONAL1273 OMPT_STORE_RETURN_ADDRESS(gtid);1274#endif1275 __kmpc_init_lock(NULL, gtid, user_lock);1276#endif1277}1278 1279/* initialize the lock */1280void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_NEST_LOCK)(void **user_lock) {1281#ifdef KMP_STUB1282 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;1283#else1284 int gtid = __kmp_entry_gtid();1285#if OMPT_SUPPORT && OMPT_OPTIONAL1286 OMPT_STORE_RETURN_ADDRESS(gtid);1287#endif1288 __kmpc_init_nest_lock(NULL, gtid, user_lock);1289#endif1290}1291 1292void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_LOCK)(void **user_lock) {1293#ifdef KMP_STUB1294 *((kmp_stub_lock_t *)user_lock) = UNINIT;1295#else1296 int gtid = __kmp_entry_gtid();1297#if OMPT_SUPPORT && OMPT_OPTIONAL1298 OMPT_STORE_RETURN_ADDRESS(gtid);1299#endif1300 __kmpc_destroy_lock(NULL, gtid, user_lock);1301#endif1302}1303 1304void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_NEST_LOCK)(void **user_lock) {1305#ifdef KMP_STUB1306 *((kmp_stub_lock_t *)user_lock) = UNINIT;1307#else1308 int gtid = __kmp_entry_gtid();1309#if OMPT_SUPPORT && OMPT_OPTIONAL1310 OMPT_STORE_RETURN_ADDRESS(gtid);1311#endif1312 __kmpc_destroy_nest_lock(NULL, gtid, user_lock);1313#endif1314}1315 1316void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_LOCK)(void **user_lock) {1317#ifdef KMP_STUB1318 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {1319 // TODO: Issue an error.1320 }1321 if (*((kmp_stub_lock_t *)user_lock) != UNLOCKED) {1322 // TODO: Issue an error.1323 }1324 *((kmp_stub_lock_t *)user_lock) = LOCKED;1325#else1326 int gtid = __kmp_entry_gtid();1327#if OMPT_SUPPORT && OMPT_OPTIONAL1328 OMPT_STORE_RETURN_ADDRESS(gtid);1329#endif1330 __kmpc_set_lock(NULL, gtid, user_lock);1331#endif1332}1333 1334void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NEST_LOCK)(void **user_lock) {1335#ifdef KMP_STUB1336 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {1337 // TODO: Issue an error.1338 }1339 (*((int *)user_lock))++;1340#else1341 int gtid = __kmp_entry_gtid();1342#if OMPT_SUPPORT && OMPT_OPTIONAL1343 OMPT_STORE_RETURN_ADDRESS(gtid);1344#endif1345 __kmpc_set_nest_lock(NULL, gtid, user_lock);1346#endif1347}1348 1349void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_LOCK)(void **user_lock) {1350#ifdef KMP_STUB1351 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {1352 // TODO: Issue an error.1353 }1354 if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {1355 // TODO: Issue an error.1356 }1357 *((kmp_stub_lock_t *)user_lock) = UNLOCKED;1358#else1359 int gtid = __kmp_entry_gtid();1360#if OMPT_SUPPORT && OMPT_OPTIONAL1361 OMPT_STORE_RETURN_ADDRESS(gtid);1362#endif1363 __kmpc_unset_lock(NULL, gtid, user_lock);1364#endif1365}1366 1367void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_NEST_LOCK)(void **user_lock) {1368#ifdef KMP_STUB1369 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {1370 // TODO: Issue an error.1371 }1372 if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {1373 // TODO: Issue an error.1374 }1375 (*((int *)user_lock))--;1376#else1377 int gtid = __kmp_entry_gtid();1378#if OMPT_SUPPORT && OMPT_OPTIONAL1379 OMPT_STORE_RETURN_ADDRESS(gtid);1380#endif1381 __kmpc_unset_nest_lock(NULL, gtid, user_lock);1382#endif1383}1384 1385int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_LOCK)(void **user_lock) {1386#ifdef KMP_STUB1387 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {1388 // TODO: Issue an error.1389 }1390 if (*((kmp_stub_lock_t *)user_lock) == LOCKED) {1391 return 0;1392 }1393 *((kmp_stub_lock_t *)user_lock) = LOCKED;1394 return 1;1395#else1396 int gtid = __kmp_entry_gtid();1397#if OMPT_SUPPORT && OMPT_OPTIONAL1398 OMPT_STORE_RETURN_ADDRESS(gtid);1399#endif1400 return __kmpc_test_lock(NULL, gtid, user_lock);1401#endif1402}1403 1404int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_NEST_LOCK)(void **user_lock) {1405#ifdef KMP_STUB1406 if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {1407 // TODO: Issue an error.1408 }1409 return ++(*((int *)user_lock));1410#else1411 int gtid = __kmp_entry_gtid();1412#if OMPT_SUPPORT && OMPT_OPTIONAL1413 OMPT_STORE_RETURN_ADDRESS(gtid);1414#endif1415 return __kmpc_test_nest_lock(NULL, gtid, user_lock);1416#endif1417}1418 1419double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTIME)(void) {1420#ifdef KMP_STUB1421 return __kmps_get_wtime();1422#else1423 double data;1424#if !KMP_OS_LINUX1425 // We don't need library initialization to get the time on Linux* OS. The1426 // routine can be used to measure library initialization time on Linux* OS now1427 if (!__kmp_init_serial) {1428 __kmp_serial_initialize();1429 }1430#endif1431 __kmp_elapsed(&data);1432 return data;1433#endif1434}1435 1436double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTICK)(void) {1437#ifdef KMP_STUB1438 return __kmps_get_wtick();1439#else1440 double data;1441 if (!__kmp_init_serial) {1442 __kmp_serial_initialize();1443 }1444 __kmp_elapsed_tick(&data);1445 return data;1446#endif1447}1448 1449/* ------------------------------------------------------------------------ */1450 1451void *FTN_STDCALL FTN_MALLOC(size_t KMP_DEREF size) {1452 // kmpc_malloc initializes the library if needed1453 return kmpc_malloc(KMP_DEREF size);1454}1455 1456void *FTN_STDCALL FTN_ALIGNED_MALLOC(size_t KMP_DEREF size,1457 size_t KMP_DEREF alignment) {1458 // kmpc_aligned_malloc initializes the library if needed1459 return kmpc_aligned_malloc(KMP_DEREF size, KMP_DEREF alignment);1460}1461 1462void *FTN_STDCALL FTN_CALLOC(size_t KMP_DEREF nelem, size_t KMP_DEREF elsize) {1463 // kmpc_calloc initializes the library if needed1464 return kmpc_calloc(KMP_DEREF nelem, KMP_DEREF elsize);1465}1466 1467void *FTN_STDCALL FTN_REALLOC(void *KMP_DEREF ptr, size_t KMP_DEREF size) {1468 // kmpc_realloc initializes the library if needed1469 return kmpc_realloc(KMP_DEREF ptr, KMP_DEREF size);1470}1471 1472void FTN_STDCALL FTN_KFREE(void *KMP_DEREF ptr) {1473 // does nothing if the library is not initialized1474 kmpc_free(KMP_DEREF ptr);1475}1476 1477void FTN_STDCALL FTN_SET_WARNINGS_ON(void) {1478#ifndef KMP_STUB1479 __kmp_generate_warnings = kmp_warnings_explicit;1480#endif1481}1482 1483void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) {1484#ifndef KMP_STUB1485 __kmp_generate_warnings = FALSE;1486#endif1487}1488 1489void FTN_STDCALL FTN_SET_DEFAULTS(char const *str1490#ifndef PASS_ARGS_BY_VALUE1491 ,1492 int len1493#endif1494) {1495#ifndef KMP_STUB1496 size_t sz;1497 char const *defaults = str;1498 1499#ifdef PASS_ARGS_BY_VALUE1500 sz = KMP_STRLEN(str);1501#else1502 sz = (size_t)len;1503 ConvertedString cstr(str, sz);1504 defaults = cstr.get();1505#endif1506 1507 __kmp_aux_set_defaults(defaults, sz);1508#endif1509}1510 1511/* ------------------------------------------------------------------------ */1512 1513/* returns the status of cancellation */1514int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_CANCELLATION)(void) {1515#ifdef KMP_STUB1516 return 0 /* false */;1517#else1518 // initialize the library if needed1519 if (!__kmp_init_serial) {1520 __kmp_serial_initialize();1521 }1522 return __kmp_omp_cancellation;1523#endif1524}1525 1526int FTN_STDCALL FTN_GET_CANCELLATION_STATUS(int cancel_kind) {1527#ifdef KMP_STUB1528 return 0 /* false */;1529#else1530 return __kmp_get_cancellation_status(cancel_kind);1531#endif1532}1533 1534/* returns the maximum allowed task priority */1535int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_TASK_PRIORITY)(void) {1536#ifdef KMP_STUB1537 return 0;1538#else1539 if (!__kmp_init_serial) {1540 __kmp_serial_initialize();1541 }1542 return __kmp_max_task_priority;1543#endif1544}1545 1546// This function will be defined in libomptarget. When libomptarget is not1547// loaded, we assume we are on the host and return KMP_HOST_DEVICE.1548// Compiler/libomptarget will handle this if called inside target.1549int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE_EXTERNAL;1550int FTN_STDCALL FTN_GET_DEVICE_NUM(void) {1551 return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();1552}1553 1554// Compiler will ensure that this is only called from host in sequential region1555int FTN_STDCALL KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE)(kmp_pause_status_t kind,1556 int device_num) {1557#ifdef KMP_STUB1558 return 1; // just fail1559#else1560 if (kind == kmp_stop_tool_paused)1561 return 1; // stop_tool must not be specified1562 if (device_num == KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)())1563 return __kmpc_pause_resource(kind);1564 else {1565 int (*fptr)(kmp_pause_status_t, int);1566 if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource")))1567 return (*fptr)(kind, device_num);1568 else1569 return 1; // just fail if there is no libomptarget1570 }1571#endif1572}1573 1574// Compiler will ensure that this is only called from host in sequential region1575int FTN_STDCALL1576 KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE_ALL)(kmp_pause_status_t kind) {1577#ifdef KMP_STUB1578 return 1; // just fail1579#else1580 int fails = 0;1581 int (*fptr)(kmp_pause_status_t, int);1582 if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource")))1583 fails = (*fptr)(kind, KMP_DEVICE_ALL); // pause devices1584 fails += __kmpc_pause_resource(kind); // pause host1585 return fails;1586#endif1587}1588 1589// Returns the maximum number of nesting levels supported by implementation1590int FTN_STDCALL FTN_GET_SUPPORTED_ACTIVE_LEVELS(void) {1591#ifdef KMP_STUB1592 return 1;1593#else1594 return KMP_MAX_ACTIVE_LEVELS_LIMIT;1595#endif1596}1597 1598void FTN_STDCALL FTN_FULFILL_EVENT(kmp_event_t *event) {1599#ifndef KMP_STUB1600 __kmp_fulfill_event(event);1601#endif1602}1603 1604// nteams-var per-device ICV1605void FTN_STDCALL FTN_SET_NUM_TEAMS(int KMP_DEREF num_teams) {1606#ifdef KMP_STUB1607// Nothing.1608#else1609 if (!__kmp_init_serial) {1610 __kmp_serial_initialize();1611 }1612 __kmp_set_num_teams(KMP_DEREF num_teams);1613#endif1614}1615int FTN_STDCALL FTN_GET_MAX_TEAMS(void) {1616#ifdef KMP_STUB1617 return 1;1618#else1619 if (!__kmp_init_serial) {1620 __kmp_serial_initialize();1621 }1622 return __kmp_get_max_teams();1623#endif1624}1625// teams-thread-limit-var per-device ICV1626void FTN_STDCALL FTN_SET_TEAMS_THREAD_LIMIT(int KMP_DEREF limit) {1627#ifdef KMP_STUB1628// Nothing.1629#else1630 if (!__kmp_init_serial) {1631 __kmp_serial_initialize();1632 }1633 __kmp_set_teams_thread_limit(KMP_DEREF limit);1634#endif1635}1636int FTN_STDCALL FTN_GET_TEAMS_THREAD_LIMIT(void) {1637#ifdef KMP_STUB1638 return 1;1639#else1640 if (!__kmp_init_serial) {1641 __kmp_serial_initialize();1642 }1643 return __kmp_get_teams_thread_limit();1644#endif1645}1646 1647/// TODO: Include the `omp.h` of the current build1648/* OpenMP 5.1 interop */1649typedef intptr_t omp_intptr_t;1650 1651/* 0..omp_get_num_interop_properties()-1 are reserved for implementation-defined1652 * properties */1653typedef enum omp_interop_property {1654 omp_ipr_fr_id = -1,1655 omp_ipr_fr_name = -2,1656 omp_ipr_vendor = -3,1657 omp_ipr_vendor_name = -4,1658 omp_ipr_device_num = -5,1659 omp_ipr_platform = -6,1660 omp_ipr_device = -7,1661 omp_ipr_device_context = -8,1662 omp_ipr_targetsync = -9,1663 omp_ipr_first = -91664} omp_interop_property_t;1665 1666#define omp_interop_none 01667 1668typedef enum omp_interop_rc {1669 omp_irc_no_value = 1,1670 omp_irc_success = 0,1671 omp_irc_empty = -1,1672 omp_irc_out_of_range = -2,1673 omp_irc_type_int = -3,1674 omp_irc_type_ptr = -4,1675 omp_irc_type_str = -5,1676 omp_irc_other = -61677} omp_interop_rc_t;1678 1679typedef enum omp_interop_fr {1680 omp_ifr_cuda = 1,1681 omp_ifr_cuda_driver = 2,1682 omp_ifr_opencl = 3,1683 omp_ifr_sycl = 4,1684 omp_ifr_hip = 5,1685 omp_ifr_level_zero = 6,1686 omp_ifr_last = 71687} omp_interop_fr_t;1688 1689typedef void *omp_interop_t;1690 1691// libomptarget, if loaded, provides this function1692int FTN_STDCALL FTN_GET_NUM_INTEROP_PROPERTIES(const omp_interop_t interop) {1693#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)1694 return 0;1695#else1696 int (*fptr)(const omp_interop_t);1697 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_interop_properties")))1698 return (*fptr)(interop);1699 return 0;1700#endif1701}1702 1703/// TODO Convert FTN_GET_INTEROP_XXX functions into a macro like interop.cpp1704// libomptarget, if loaded, provides this function1705intptr_t FTN_STDCALL FTN_GET_INTEROP_INT(const omp_interop_t interop,1706 omp_interop_property_t property_id,1707 int *err) {1708#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)1709 return 0;1710#else1711 intptr_t (*fptr)(const omp_interop_t, omp_interop_property_t, int *);1712 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_int")))1713 return (*fptr)(interop, property_id, err);1714 return 0;1715#endif1716}1717 1718// libomptarget, if loaded, provides this function1719void *FTN_STDCALL FTN_GET_INTEROP_PTR(const omp_interop_t interop,1720 omp_interop_property_t property_id,1721 int *err) {1722#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)1723 return nullptr;1724#else1725 void *(*fptr)(const omp_interop_t, omp_interop_property_t, int *);1726 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_ptr")))1727 return (*fptr)(interop, property_id, err);1728 return nullptr;1729#endif1730}1731 1732// libomptarget, if loaded, provides this function1733const char *FTN_STDCALL FTN_GET_INTEROP_STR(const omp_interop_t interop,1734 omp_interop_property_t property_id,1735 int *err) {1736#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)1737 return nullptr;1738#else1739 const char *(*fptr)(const omp_interop_t, omp_interop_property_t, int *);1740 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_str")))1741 return (*fptr)(interop, property_id, err);1742 return nullptr;1743#endif1744}1745 1746// libomptarget, if loaded, provides this function1747const char *FTN_STDCALL FTN_GET_INTEROP_NAME(1748 const omp_interop_t interop, omp_interop_property_t property_id) {1749#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)1750 return nullptr;1751#else1752 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);1753 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_name")))1754 return (*fptr)(interop, property_id);1755 return nullptr;1756#endif1757}1758 1759// libomptarget, if loaded, provides this function1760const char *FTN_STDCALL FTN_GET_INTEROP_TYPE_DESC(1761 const omp_interop_t interop, omp_interop_property_t property_id) {1762#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)1763 return nullptr;1764#else1765 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);1766 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_type_desc")))1767 return (*fptr)(interop, property_id);1768 return nullptr;1769#endif1770}1771 1772// libomptarget, if loaded, provides this function1773const char *FTN_STDCALL FTN_GET_INTEROP_RC_DESC(1774 const omp_interop_t interop, omp_interop_property_t property_id) {1775#if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)1776 return nullptr;1777#else1778 const char *(*fptr)(const omp_interop_t, omp_interop_property_t);1779 if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_rec_desc")))1780 return (*fptr)(interop, property_id);1781 return nullptr;1782#endif1783}1784 1785// display environment variables when requested1786void FTN_STDCALL FTN_DISPLAY_ENV(int verbose) {1787#ifndef KMP_STUB1788 __kmp_omp_display_env(verbose);1789#endif1790}1791 1792int FTN_STDCALL FTN_IN_EXPLICIT_TASK(void) {1793#ifdef KMP_STUB1794 return 0;1795#else1796 int gtid = __kmp_entry_gtid();1797 return __kmp_thread_from_gtid(gtid)->th.th_current_task->td_flags.tasktype;1798#endif1799}1800 1801// GCC compatibility (versioned symbols)1802#ifdef KMP_USE_VERSION_SYMBOLS1803 1804/* These following sections create versioned symbols for the1805 omp_* routines. The KMP_VERSION_SYMBOL macro expands the API name and1806 then maps it to a versioned symbol.1807 libgomp ``versions'' its symbols (OMP_1.0, OMP_2.0, OMP_3.0, ...) while also1808 retaining the default version which libomp uses: VERSION (defined in1809 exports_so.txt). If you want to see the versioned symbols for libgomp.so.11810 then just type:1811 1812 objdump -T /path/to/libgomp.so.1 | grep omp_1813 1814 Example:1815 Step 1) Create __kmp_api_omp_set_num_threads_10_alias which is alias of1816 __kmp_api_omp_set_num_threads1817 Step 2) Set __kmp_api_omp_set_num_threads_10_alias to version:1818 omp_set_num_threads@OMP_1.01819 Step 2B) Set __kmp_api_omp_set_num_threads to default version:1820 omp_set_num_threads@@VERSION1821*/1822 1823// OMP_1.0 versioned symbols1824KMP_VERSION_SYMBOL(FTN_SET_NUM_THREADS, 10, "OMP_1.0");1825KMP_VERSION_SYMBOL(FTN_GET_NUM_THREADS, 10, "OMP_1.0");1826KMP_VERSION_SYMBOL(FTN_GET_MAX_THREADS, 10, "OMP_1.0");1827KMP_VERSION_SYMBOL(FTN_GET_THREAD_NUM, 10, "OMP_1.0");1828KMP_VERSION_SYMBOL(FTN_GET_NUM_PROCS, 10, "OMP_1.0");1829KMP_VERSION_SYMBOL(FTN_IN_PARALLEL, 10, "OMP_1.0");1830KMP_VERSION_SYMBOL(FTN_SET_DYNAMIC, 10, "OMP_1.0");1831KMP_VERSION_SYMBOL(FTN_GET_DYNAMIC, 10, "OMP_1.0");1832KMP_VERSION_SYMBOL(FTN_SET_NESTED, 10, "OMP_1.0");1833KMP_VERSION_SYMBOL(FTN_GET_NESTED, 10, "OMP_1.0");1834KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 10, "OMP_1.0");1835KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 10, "OMP_1.0");1836KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 10, "OMP_1.0");1837KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0");1838KMP_VERSION_SYMBOL(FTN_SET_LOCK, 10, "OMP_1.0");1839KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 10, "OMP_1.0");1840KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 10, "OMP_1.0");1841KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0");1842KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 10, "OMP_1.0");1843KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 10, "OMP_1.0");1844 1845// OMP_2.0 versioned symbols1846KMP_VERSION_SYMBOL(FTN_GET_WTICK, 20, "OMP_2.0");1847KMP_VERSION_SYMBOL(FTN_GET_WTIME, 20, "OMP_2.0");1848 1849// OMP_3.0 versioned symbols1850KMP_VERSION_SYMBOL(FTN_SET_SCHEDULE, 30, "OMP_3.0");1851KMP_VERSION_SYMBOL(FTN_GET_SCHEDULE, 30, "OMP_3.0");1852KMP_VERSION_SYMBOL(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0");1853KMP_VERSION_SYMBOL(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");1854KMP_VERSION_SYMBOL(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");1855KMP_VERSION_SYMBOL(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0");1856KMP_VERSION_SYMBOL(FTN_GET_LEVEL, 30, "OMP_3.0");1857KMP_VERSION_SYMBOL(FTN_GET_TEAM_SIZE, 30, "OMP_3.0");1858KMP_VERSION_SYMBOL(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0");1859 1860// the lock routines have a 1.0 and 3.0 version1861KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 30, "OMP_3.0");1862KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 30, "OMP_3.0");1863KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 30, "OMP_3.0");1864KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0");1865KMP_VERSION_SYMBOL(FTN_SET_LOCK, 30, "OMP_3.0");1866KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 30, "OMP_3.0");1867KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 30, "OMP_3.0");1868KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0");1869KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 30, "OMP_3.0");1870KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 30, "OMP_3.0");1871 1872// OMP_3.1 versioned symbol1873KMP_VERSION_SYMBOL(FTN_IN_FINAL, 31, "OMP_3.1");1874 1875// OMP_4.0 versioned symbols1876KMP_VERSION_SYMBOL(FTN_GET_PROC_BIND, 40, "OMP_4.0");1877KMP_VERSION_SYMBOL(FTN_GET_NUM_TEAMS, 40, "OMP_4.0");1878KMP_VERSION_SYMBOL(FTN_GET_TEAM_NUM, 40, "OMP_4.0");1879KMP_VERSION_SYMBOL(FTN_GET_CANCELLATION, 40, "OMP_4.0");1880KMP_VERSION_SYMBOL(FTN_GET_DEFAULT_DEVICE, 40, "OMP_4.0");1881KMP_VERSION_SYMBOL(FTN_SET_DEFAULT_DEVICE, 40, "OMP_4.0");1882KMP_VERSION_SYMBOL(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0");1883KMP_VERSION_SYMBOL(FTN_GET_NUM_DEVICES, 40, "OMP_4.0");1884 1885// OMP_4.5 versioned symbols1886KMP_VERSION_SYMBOL(FTN_GET_MAX_TASK_PRIORITY, 45, "OMP_4.5");1887KMP_VERSION_SYMBOL(FTN_GET_NUM_PLACES, 45, "OMP_4.5");1888KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM_PROCS, 45, "OMP_4.5");1889KMP_VERSION_SYMBOL(FTN_GET_PLACE_PROC_IDS, 45, "OMP_4.5");1890KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM, 45, "OMP_4.5");1891KMP_VERSION_SYMBOL(FTN_GET_PARTITION_NUM_PLACES, 45, "OMP_4.5");1892KMP_VERSION_SYMBOL(FTN_GET_PARTITION_PLACE_NUMS, 45, "OMP_4.5");1893KMP_VERSION_SYMBOL(FTN_GET_INITIAL_DEVICE, 45, "OMP_4.5");1894 1895// OMP_5.0 versioned symbols1896// KMP_VERSION_SYMBOL(FTN_GET_DEVICE_NUM, 50, "OMP_5.0");1897KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE, 50, "OMP_5.0");1898KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE_ALL, 50, "OMP_5.0");1899// The C versions (KMP_FTN_PLAIN) of these symbols are in kmp_csupport.c1900#if KMP_FTN_ENTRIES == KMP_FTN_APPEND1901KMP_VERSION_SYMBOL(FTN_CAPTURE_AFFINITY, 50, "OMP_5.0");1902KMP_VERSION_SYMBOL(FTN_DISPLAY_AFFINITY, 50, "OMP_5.0");1903KMP_VERSION_SYMBOL(FTN_GET_AFFINITY_FORMAT, 50, "OMP_5.0");1904KMP_VERSION_SYMBOL(FTN_SET_AFFINITY_FORMAT, 50, "OMP_5.0");1905#endif1906// KMP_VERSION_SYMBOL(FTN_GET_SUPPORTED_ACTIVE_LEVELS, 50, "OMP_5.0");1907// KMP_VERSION_SYMBOL(FTN_FULFILL_EVENT, 50, "OMP_5.0");1908 1909#endif // KMP_USE_VERSION_SYMBOLS1910 1911#ifdef __cplusplus1912} // extern "C"1913#endif // __cplusplus1914 1915// end of file //1916