openmp/runtime/src/kmp_ftn_entry.h

   1 /*
   2  * kmp_ftn_entry.h -- Fortran entry linkage support for OpenMP.
   3  */
   4
   5 //===----------------------------------------------------------------------===//
   6 //
   7 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   8 // See https://llvm.org/LICENSE.txt for license information.
   9 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
  10 //
  11 //===----------------------------------------------------------------------===//
  12
  13 #ifndef FTN_STDCALL
  14 #error The support file kmp_ftn_entry.h should not be compiled by itself.
  15 #endif
  16
  17 #ifdef KMP_STUB
  18 #include "kmp_stub.h"
  19 #endif
  20
  21 #include "kmp_i18n.h"
  22
  23 // For affinity format functions
  24 #include "kmp_io.h"
  25 #include "kmp_str.h"
  26
  27 #if OMPT_SUPPORT
  28 #include "ompt-specific.h"
  29 #endif
  30
  31 #ifdef __cplusplus
  32 extern "C" {
  33 #endif // __cplusplus
  34
  35 /* For compatibility with the Gnu/MS Open MP codegen, omp_set_num_threads(),
  36  * omp_set_nested(), and omp_set_dynamic() [in lowercase on MS, and w/o
  37  * a trailing underscore on Linux* OS] take call by value integer arguments.
  38  * + omp_set_max_active_levels()
  39  * + omp_set_schedule()
  40  *
  41  * For backward compatibility with 9.1 and previous Intel compiler, these
  42  * entry points take call by reference integer arguments. */
  43 #ifdef KMP_GOMP_COMPAT
  44 #if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_UPPER)
  45 #define PASS_ARGS_BY_VALUE 1
  46 #endif
  47 #endif
  48 #if KMP_OS_WINDOWS
  49 #if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_APPEND)
  50 #define PASS_ARGS_BY_VALUE 1
  51 #endif
  52 #endif
  53
  54 // This macro helps to reduce code duplication.
  55 #ifdef PASS_ARGS_BY_VALUE
  56 #define KMP_DEREF
  57 #else
  58 #define KMP_DEREF *
  59 #endif
  60
  61 // For API with specific C vs. Fortran interfaces (ompc_* exists in
  62 // kmp_csupport.cpp), only create GOMP versioned symbols of the API for the
  63 // APPEND Fortran entries in this file. The GOMP versioned symbols of the C API
  64 // will take place where the ompc_* functions are defined.
  65 #if KMP_FTN_ENTRIES == KMP_FTN_APPEND
  66 #define KMP_EXPAND_NAME_IF_APPEND(name) KMP_EXPAND_NAME(name)
  67 #else
  68 #define KMP_EXPAND_NAME_IF_APPEND(name) name
  69 #endif
  70
  71 void FTN_STDCALL FTN_SET_STACKSIZE(int KMP_DEREF arg) {
  72 #ifdef KMP_STUB
  73   __kmps_set_stacksize(KMP_DEREF arg);
  74 #else
  75   // __kmp_aux_set_stacksize initializes the library if needed
  76   __kmp_aux_set_stacksize((size_t)KMP_DEREF arg);
  77 #endif
  78 }
  79
  80 void FTN_STDCALL FTN_SET_STACKSIZE_S(size_t KMP_DEREF arg) {
  81 #ifdef KMP_STUB
  82   __kmps_set_stacksize(KMP_DEREF arg);
  83 #else
  84   // __kmp_aux_set_stacksize initializes the library if needed
  85   __kmp_aux_set_stacksize(KMP_DEREF arg);
  86 #endif
  87 }
  88
  89 int FTN_STDCALL FTN_GET_STACKSIZE(void) {
  90 #ifdef KMP_STUB
  91   return (int)__kmps_get_stacksize();
  92 #else
  93   if (!__kmp_init_serial) {
  94     __kmp_serial_initialize();
  95   }
  96   return (int)__kmp_stksize;
  97 #endif
  98 }
  99
 100 size_t FTN_STDCALL FTN_GET_STACKSIZE_S(void) {
 101 #ifdef KMP_STUB
 102   return __kmps_get_stacksize();
 103 #else
 104   if (!__kmp_init_serial) {
 105     __kmp_serial_initialize();
 106   }
 107   return __kmp_stksize;
 108 #endif
 109 }
 110
 111 void FTN_STDCALL FTN_SET_BLOCKTIME(int KMP_DEREF arg) {
 112 #ifdef KMP_STUB
 113   __kmps_set_blocktime(KMP_DEREF arg);
 114 #else
 115   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 #endif
 125 }
 126
 127 // Gets blocktime in units used for KMP_BLOCKTIME, ms otherwise
 128 int FTN_STDCALL FTN_GET_BLOCKTIME(void) {
 129 #ifdef KMP_STUB
 130   return __kmps_get_blocktime();
 131 #else
 132   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_BLOCKTIME
 146   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 #endif
 161 }
 162
 163 void FTN_STDCALL FTN_SET_LIBRARY_SERIAL(void) {
 164 #ifdef KMP_STUB
 165   __kmps_set_library(library_serial);
 166 #else
 167   // __kmp_user_set_library initializes the library if needed
 168   __kmp_user_set_library(library_serial);
 169 #endif
 170 }
 171
 172 void FTN_STDCALL FTN_SET_LIBRARY_TURNAROUND(void) {
 173 #ifdef KMP_STUB
 174   __kmps_set_library(library_turnaround);
 175 #else
 176   // __kmp_user_set_library initializes the library if needed
 177   __kmp_user_set_library(library_turnaround);
 178 #endif
 179 }
 180
 181 void FTN_STDCALL FTN_SET_LIBRARY_THROUGHPUT(void) {
 182 #ifdef KMP_STUB
 183   __kmps_set_library(library_throughput);
 184 #else
 185   // __kmp_user_set_library initializes the library if needed
 186   __kmp_user_set_library(library_throughput);
 187 #endif
 188 }
 189
 190 void FTN_STDCALL FTN_SET_LIBRARY(int KMP_DEREF arg) {
 191 #ifdef KMP_STUB
 192   __kmps_set_library(KMP_DEREF arg);
 193 #else
 194   enum library_type lib;
 195   lib = (enum library_type)KMP_DEREF arg;
 196   // __kmp_user_set_library initializes the library if needed
 197   __kmp_user_set_library(lib);
 198 #endif
 199 }
 200
 201 int FTN_STDCALL FTN_GET_LIBRARY(void) {
 202 #ifdef KMP_STUB
 203   return __kmps_get_library();
 204 #else
 205   if (!__kmp_init_serial) {
 206     __kmp_serial_initialize();
 207   }
 208   return ((int)__kmp_library);
 209 #endif
 210 }
 211
 212 void FTN_STDCALL FTN_SET_DISP_NUM_BUFFERS(int KMP_DEREF arg) {
 213 #ifdef KMP_STUB
 214   ; // empty routine
 215 #else
 216   // ignore after initialization because some teams have already
 217   // allocated dispatch buffers
 218   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 #endif
 224 }
 225
 226 int FTN_STDCALL FTN_SET_AFFINITY(void **mask) {
 227 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 228   return -1;
 229 #else
 230   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 #endif
 236 }
 237
 238 int FTN_STDCALL FTN_GET_AFFINITY(void **mask) {
 239 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 240   return -1;
 241 #else
 242   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 #endif
 253 }
 254
 255 int FTN_STDCALL FTN_GET_AFFINITY_MAX_PROC(void) {
 256 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 257   return 0;
 258 #else
 259   // 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 #endif
 266 }
 267
 268 void FTN_STDCALL FTN_CREATE_AFFINITY_MASK(void **mask) {
 269 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 270   *mask = NULL;
 271 #else
 272   // 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 #endif
 282 }
 283
 284 void FTN_STDCALL FTN_DESTROY_AFFINITY_MASK(void **mask) {
 285 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 286 // Nothing
 287 #else
 288   // 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 #endif
 303 }
 304
 305 int FTN_STDCALL FTN_SET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
 306 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 307   return -1;
 308 #else
 309   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 #endif
 315 }
 316
 317 int FTN_STDCALL FTN_UNSET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
 318 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 319   return -1;
 320 #else
 321   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 #endif
 327 }
 328
 329 int FTN_STDCALL FTN_GET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
 330 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 331   return -1;
 332 #else
 333   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 #endif
 339 }
 340
 341 /* ------------------------------------------------------------------------ */
 342
 343 /* sets the requested number of threads for the next parallel region */
 344 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NUM_THREADS)(int KMP_DEREF arg) {
 345 #ifdef KMP_STUB
 346 // Nothing.
 347 #else
 348   __kmp_set_num_threads(KMP_DEREF arg, __kmp_entry_gtid());
 349 #endif
 350 }
 351
 352 /* returns the number of threads in current team */
 353 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_THREADS)(void) {
 354 #ifdef KMP_STUB
 355   return 1;
 356 #else
 357   // __kmpc_bound_num_threads initializes the library if needed
 358   return __kmpc_bound_num_threads(NULL);
 359 #endif
 360 }
 361
 362 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_THREADS)(void) {
 363 #ifdef KMP_STUB
 364   return 1;
 365 #else
 366   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_SUPPORTED
 374   if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {
 375     __kmp_assign_root_init_mask();
 376   }
 377 #endif
 378   // 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 #endif
 382 }
 383
 384 int FTN_STDCALL FTN_CONTROL_TOOL(int command, int modifier, void *arg) {
 385 #if defined(KMP_STUB) || !OMPT_SUPPORT
 386   return -2;
 387 #else
 388   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 #endif
 399 }
 400
 401 /* OpenMP 5.0 Memory Management support */
 402 omp_allocator_handle_t FTN_STDCALL
 403 FTN_INIT_ALLOCATOR(omp_memspace_handle_t KMP_DEREF m, int KMP_DEREF ntraits,
 404                    omp_alloctrait_t tr[]) {
 405 #ifdef KMP_STUB
 406   return NULL;
 407 #else
 408   return __kmpc_init_allocator(__kmp_entry_gtid(), KMP_DEREF m,
 409                                KMP_DEREF ntraits, tr);
 410 #endif
 411 }
 412
 413 void FTN_STDCALL FTN_DESTROY_ALLOCATOR(omp_allocator_handle_t al) {
 414 #ifndef KMP_STUB
 415   __kmpc_destroy_allocator(__kmp_entry_gtid(), al);
 416 #endif
 417 }
 418 void FTN_STDCALL FTN_SET_DEFAULT_ALLOCATOR(omp_allocator_handle_t al) {
 419 #ifndef KMP_STUB
 420   __kmpc_set_default_allocator(__kmp_entry_gtid(), al);
 421 #endif
 422 }
 423 omp_allocator_handle_t FTN_STDCALL FTN_GET_DEFAULT_ALLOCATOR(void) {
 424 #ifdef KMP_STUB
 425   return NULL;
 426 #else
 427   return __kmpc_get_default_allocator(__kmp_entry_gtid());
 428 #endif
 429 }
 430
 431 /* OpenMP 5.0 affinity format support */
 432 #ifndef KMP_STUB
 433 static void __kmp_fortran_strncpy_truncate(char *buffer, size_t buf_size,
 434                                            char const *csrc, size_t csrc_size) {
 435   size_t capped_src_size = csrc_size;
 436   if (csrc_size >= buf_size) {
 437     capped_src_size = buf_size - 1;
 438   }
 439   KMP_STRNCPY_S(buffer, buf_size, csrc, capped_src_size);
 440   if (csrc_size >= buf_size) {
 441     KMP_DEBUG_ASSERT(buffer[buf_size - 1] == '\0');
 442     buffer[buf_size - 1] = csrc[buf_size - 1];
 443   } else {
 444     for (size_t i = csrc_size; i < buf_size; ++i)
 445       buffer[i] = ' ';
 446   }
 447 }
 448
 449 // Convert a Fortran string to a C string by adding null byte
 450 class ConvertedString {
 451   char *buf;
 452   kmp_info_t *th;
 453
 454 public:
 455   ConvertedString(char const *fortran_str, size_t size) {
 456     th = __kmp_get_thread();
 457     buf = (char *)__kmp_thread_malloc(th, size + 1);
 458     KMP_STRNCPY_S(buf, size + 1, fortran_str, size);
 459     buf[size] = '\0';
 460   }
 461   ~ConvertedString() { __kmp_thread_free(th, buf); }
 462   const char *get() const { return buf; }
 463 };
 464 #endif // KMP_STUB
 465
 466 /*
 467  * Set the value of the affinity-format-var ICV on the current device to the
 468  * format specified in the argument.
 469  */
 470 void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_SET_AFFINITY_FORMAT)(
 471     char const *format, size_t size) {
 472 #ifdef KMP_STUB
 473   return;
 474 #else
 475   if (!__kmp_init_serial) {
 476     __kmp_serial_initialize();
 477   }
 478   ConvertedString cformat(format, size);
 479   // Since the __kmp_affinity_format variable is a C string, do not
 480   // use the fortran strncpy function
 481   __kmp_strncpy_truncate(__kmp_affinity_format, KMP_AFFINITY_FORMAT_SIZE,
 482                          cformat.get(), KMP_STRLEN(cformat.get()));
 483 #endif
 484 }
 485
 486 /*
 487  * Returns the number of characters required to hold the entire affinity format
 488  * specification (not including null byte character) and writes the value of the
 489  * affinity-format-var ICV on the current device to buffer. If the return value
 490  * is larger than size, the affinity format specification is truncated.
 491  */
 492 size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_GET_AFFINITY_FORMAT)(
 493     char *buffer, size_t size) {
 494 #ifdef KMP_STUB
 495   return 0;
 496 #else
 497   size_t format_size;
 498   if (!__kmp_init_serial) {
 499     __kmp_serial_initialize();
 500   }
 501   format_size = KMP_STRLEN(__kmp_affinity_format);
 502   if (buffer && size) {
 503     __kmp_fortran_strncpy_truncate(buffer, size, __kmp_affinity_format,
 504                                    format_size);
 505   }
 506   return format_size;
 507 #endif
 508 }
 509
 510 /*
 511  * Prints the thread affinity information of the current thread in the format
 512  * specified by the format argument. If the format is NULL or a zero-length
 513  * string, the value of the affinity-format-var ICV is used.
 514  */
 515 void FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_DISPLAY_AFFINITY)(
 516     char const *format, size_t size) {
 517 #ifdef KMP_STUB
 518   return;
 519 #else
 520   int gtid;
 521   if (!TCR_4(__kmp_init_middle)) {
 522     __kmp_middle_initialize();
 523   }
 524   __kmp_assign_root_init_mask();
 525   gtid = __kmp_get_gtid();
 526 #if KMP_AFFINITY_SUPPORTED
 527   if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 &&
 528       __kmp_affinity.flags.reset) {
 529     __kmp_reset_root_init_mask(gtid);
 530   }
 531 #endif
 532   ConvertedString cformat(format, size);
 533   __kmp_aux_display_affinity(gtid, cformat.get());
 534 #endif
 535 }
 536
 537 /*
 538  * Returns the number of characters required to hold the entire affinity format
 539  * specification (not including null byte) and prints the thread affinity
 540  * information of the current thread into the character string buffer with the
 541  * size of size in the format specified by the format argument. If the format is
 542  * NULL or a zero-length string, the value of the affinity-format-var ICV is
 543  * used. The buffer must be allocated prior to calling the routine. If the
 544  * return value is larger than size, the affinity format specification is
 545  * truncated.
 546  */
 547 size_t FTN_STDCALL KMP_EXPAND_NAME_IF_APPEND(FTN_CAPTURE_AFFINITY)(
 548     char *buffer, char const *format, size_t buf_size, size_t for_size) {
 549 #if defined(KMP_STUB)
 550   return 0;
 551 #else
 552   int gtid;
 553   size_t num_required;
 554   kmp_str_buf_t capture_buf;
 555   if (!TCR_4(__kmp_init_middle)) {
 556     __kmp_middle_initialize();
 557   }
 558   __kmp_assign_root_init_mask();
 559   gtid = __kmp_get_gtid();
 560 #if KMP_AFFINITY_SUPPORTED
 561   if (__kmp_threads[gtid]->th.th_team->t.t_level == 0 &&
 562       __kmp_affinity.flags.reset) {
 563     __kmp_reset_root_init_mask(gtid);
 564   }
 565 #endif
 566   __kmp_str_buf_init(&capture_buf);
 567   ConvertedString cformat(format, for_size);
 568   num_required = __kmp_aux_capture_affinity(gtid, cformat.get(), &capture_buf);
 569   if (buffer && buf_size) {
 570     __kmp_fortran_strncpy_truncate(buffer, buf_size, capture_buf.str,
 571                                    capture_buf.used);
 572   }
 573   __kmp_str_buf_free(&capture_buf);
 574   return num_required;
 575 #endif
 576 }
 577
 578 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_NUM)(void) {
 579 #ifdef KMP_STUB
 580   return 0;
 581 #else
 582   int gtid;
 583
 584 #if KMP_OS_DARWIN || KMP_OS_DRAGONFLY || KMP_OS_FREEBSD || KMP_OS_NETBSD ||    \
 585     KMP_OS_OPENBSD || KMP_OS_HURD || KMP_OS_SOLARIS || KMP_OS_AIX
 586   gtid = __kmp_entry_gtid();
 587 #elif KMP_OS_WINDOWS
 588   if (!__kmp_init_parallel ||
 589       (gtid = (int)((kmp_intptr_t)TlsGetValue(__kmp_gtid_threadprivate_key))) ==
 590           0) {
 591     // Either library isn't initialized or thread is not registered
 592     // 0 is the correct TID in this case
 593     return 0;
 594   }
 595   --gtid; // We keep (gtid+1) in TLS
 596 #elif KMP_OS_LINUX || KMP_OS_WASI
 597 #ifdef KMP_TDATA_GTID
 598   if (__kmp_gtid_mode >= 3) {
 599     if ((gtid = __kmp_gtid) == KMP_GTID_DNE) {
 600       return 0;
 601     }
 602   } else {
 603 #endif
 604     if (!__kmp_init_parallel ||
 605         (gtid = (int)((kmp_intptr_t)(
 606              pthread_getspecific(__kmp_gtid_threadprivate_key)))) == 0) {
 607       return 0;
 608     }
 609     --gtid;
 610 #ifdef KMP_TDATA_GTID
 611   }
 612 #endif
 613 #else
 614 #error Unknown or unsupported OS
 615 #endif
 616
 617   return __kmp_tid_from_gtid(gtid);
 618 #endif
 619 }
 620
 621 int FTN_STDCALL FTN_GET_NUM_KNOWN_THREADS(void) {
 622 #ifdef KMP_STUB
 623   return 1;
 624 #else
 625   if (!__kmp_init_serial) {
 626     __kmp_serial_initialize();
 627   }
 628   /* NOTE: this is not syncronized, so it can change at any moment */
 629   /* NOTE: this number also includes threads preallocated in hot-teams */
 630   return TCR_4(__kmp_nth);
 631 #endif
 632 }
 633
 634 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PROCS)(void) {
 635 #ifdef KMP_STUB
 636   return 1;
 637 #else
 638   if (!TCR_4(__kmp_init_middle)) {
 639     __kmp_middle_initialize();
 640   }
 641 #if KMP_AFFINITY_SUPPORTED
 642   if (!__kmp_affinity.flags.reset) {
 643     // only bind root here if its affinity reset is not requested
 644     int gtid = __kmp_entry_gtid();
 645     kmp_info_t *thread = __kmp_threads[gtid];
 646     if (thread->th.th_team->t.t_level == 0) {
 647       __kmp_assign_root_init_mask();
 648     }
 649   }
 650 #endif
 651   return __kmp_avail_proc;
 652 #endif
 653 }
 654
 655 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NESTED)(int KMP_DEREF flag) {
 656 #ifdef KMP_STUB
 657   __kmps_set_nested(KMP_DEREF flag);
 658 #else
 659   kmp_info_t *thread;
 660   /* For the thread-private internal controls implementation */
 661   thread = __kmp_entry_thread();
 662   KMP_INFORM(APIDeprecated, "omp_set_nested", "omp_set_max_active_levels");
 663   __kmp_save_internal_controls(thread);
 664   // Somewhat arbitrarily decide where to get a value for max_active_levels
 665   int max_active_levels = get__max_active_levels(thread);
 666   if (max_active_levels == 1)
 667     max_active_levels = KMP_MAX_ACTIVE_LEVELS_LIMIT;
 668   set__max_active_levels(thread, (KMP_DEREF flag) ? max_active_levels : 1);
 669 #endif
 670 }
 671
 672 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NESTED)(void) {
 673 #ifdef KMP_STUB
 674   return __kmps_get_nested();
 675 #else
 676   kmp_info_t *thread;
 677   thread = __kmp_entry_thread();
 678   KMP_INFORM(APIDeprecated, "omp_get_nested", "omp_get_max_active_levels");
 679   return get__max_active_levels(thread) > 1;
 680 #endif
 681 }
 682
 683 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DYNAMIC)(int KMP_DEREF flag) {
 684 #ifdef KMP_STUB
 685   __kmps_set_dynamic(KMP_DEREF flag ? TRUE : FALSE);
 686 #else
 687   kmp_info_t *thread;
 688   /* For the thread-private implementation of the internal controls */
 689   thread = __kmp_entry_thread();
 690   // !!! What if foreign thread calls it?
 691   __kmp_save_internal_controls(thread);
 692   set__dynamic(thread, KMP_DEREF flag ? true : false);
 693 #endif
 694 }
 695
 696 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DYNAMIC)(void) {
 697 #ifdef KMP_STUB
 698   return __kmps_get_dynamic();
 699 #else
 700   kmp_info_t *thread;
 701   thread = __kmp_entry_thread();
 702   return get__dynamic(thread);
 703 #endif
 704 }
 705
 706 int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_PARALLEL)(void) {
 707 #ifdef KMP_STUB
 708   return 0;
 709 #else
 710   kmp_info_t *th = __kmp_entry_thread();
 711   if (th->th.th_teams_microtask) {
 712     // AC: r_in_parallel does not work inside teams construct where real
 713     // parallel is inactive, but all threads have same root, so setting it in
 714     // one team affects other teams.
 715     // The solution is to use per-team nesting level
 716     return (th->th.th_team->t.t_active_level ? 1 : 0);
 717   } else
 718     return (th->th.th_root->r.r_in_parallel ? FTN_TRUE : FTN_FALSE);
 719 #endif
 720 }
 721
 722 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_SCHEDULE)(kmp_sched_t KMP_DEREF kind,
 723                                                    int KMP_DEREF modifier) {
 724 #ifdef KMP_STUB
 725   __kmps_set_schedule(KMP_DEREF kind, KMP_DEREF modifier);
 726 #else
 727   /* TO DO: For the per-task implementation of the internal controls */
 728   __kmp_set_schedule(__kmp_entry_gtid(), KMP_DEREF kind, KMP_DEREF modifier);
 729 #endif
 730 }
 731
 732 void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_SCHEDULE)(kmp_sched_t *kind,
 733                                                    int *modifier) {
 734 #ifdef KMP_STUB
 735   __kmps_get_schedule(kind, modifier);
 736 #else
 737   /* TO DO: For the per-task implementation of the internal controls */
 738   __kmp_get_schedule(__kmp_entry_gtid(), kind, modifier);
 739 #endif
 740 }
 741
 742 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_MAX_ACTIVE_LEVELS)(int KMP_DEREF arg) {
 743 #ifdef KMP_STUB
 744 // Nothing.
 745 #else
 746   /* TO DO: We want per-task implementation of this internal control */
 747   __kmp_set_max_active_levels(__kmp_entry_gtid(), KMP_DEREF arg);
 748 #endif
 749 }
 750
 751 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_ACTIVE_LEVELS)(void) {
 752 #ifdef KMP_STUB
 753   return 0;
 754 #else
 755   /* TO DO: We want per-task implementation of this internal control */
 756   if (!TCR_4(__kmp_init_middle)) {
 757     __kmp_middle_initialize();
 758   }
 759   return __kmp_get_max_active_levels(__kmp_entry_gtid());
 760 #endif
 761 }
 762
 763 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_ACTIVE_LEVEL)(void) {
 764 #ifdef KMP_STUB
 765   return 0; // returns 0 if it is called from the sequential part of the program
 766 #else
 767   /* TO DO: For the per-task implementation of the internal controls */
 768   return __kmp_entry_thread()->th.th_team->t.t_active_level;
 769 #endif
 770 }
 771
 772 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_LEVEL)(void) {
 773 #ifdef KMP_STUB
 774   return 0; // returns 0 if it is called from the sequential part of the program
 775 #else
 776   /* TO DO: For the per-task implementation of the internal controls */
 777   return __kmp_entry_thread()->th.th_team->t.t_level;
 778 #endif
 779 }
 780
 781 int FTN_STDCALL
 782 KMP_EXPAND_NAME(FTN_GET_ANCESTOR_THREAD_NUM)(int KMP_DEREF level) {
 783 #ifdef KMP_STUB
 784   return (KMP_DEREF level) ? (-1) : (0);
 785 #else
 786   return __kmp_get_ancestor_thread_num(__kmp_entry_gtid(), KMP_DEREF level);
 787 #endif
 788 }
 789
 790 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_SIZE)(int KMP_DEREF level) {
 791 #ifdef KMP_STUB
 792   return (KMP_DEREF level) ? (-1) : (1);
 793 #else
 794   return __kmp_get_team_size(__kmp_entry_gtid(), KMP_DEREF level);
 795 #endif
 796 }
 797
 798 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_LIMIT)(void) {
 799 #ifdef KMP_STUB
 800   return 1; // TO DO: clarify whether it returns 1 or 0?
 801 #else
 802   int gtid;
 803   kmp_info_t *thread;
 804   if (!__kmp_init_serial) {
 805     __kmp_serial_initialize();
 806   }
 807
 808   gtid = __kmp_entry_gtid();
 809   thread = __kmp_threads[gtid];
 810   // If thread_limit for the target task is defined, return that instead of the
 811   // regular task thread_limit
 812   if (int thread_limit = thread->th.th_current_task->td_icvs.task_thread_limit)
 813     return thread_limit;
 814   return thread->th.th_current_task->td_icvs.thread_limit;
 815 #endif
 816 }
 817
 818 int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_FINAL)(void) {
 819 #ifdef KMP_STUB
 820   return 0; // TO DO: clarify whether it returns 1 or 0?
 821 #else
 822   if (!TCR_4(__kmp_init_parallel)) {
 823     return 0;
 824   }
 825   return __kmp_entry_thread()->th.th_current_task->td_flags.final;
 826 #endif
 827 }
 828
 829 kmp_proc_bind_t FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PROC_BIND)(void) {
 830 #ifdef KMP_STUB
 831   return __kmps_get_proc_bind();
 832 #else
 833   return get__proc_bind(__kmp_entry_thread());
 834 #endif
 835 }
 836
 837 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PLACES)(void) {
 838 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 839   return 0;
 840 #else
 841   if (!TCR_4(__kmp_init_middle)) {
 842     __kmp_middle_initialize();
 843   }
 844   if (!KMP_AFFINITY_CAPABLE())
 845     return 0;
 846   if (!__kmp_affinity.flags.reset) {
 847     // only bind root here if its affinity reset is not requested
 848     int gtid = __kmp_entry_gtid();
 849     kmp_info_t *thread = __kmp_threads[gtid];
 850     if (thread->th.th_team->t.t_level == 0) {
 851       __kmp_assign_root_init_mask();
 852     }
 853   }
 854   return __kmp_affinity.num_masks;
 855 #endif
 856 }
 857
 858 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM_PROCS)(int place_num) {
 859 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 860   return 0;
 861 #else
 862   int i;
 863   int retval = 0;
 864   if (!TCR_4(__kmp_init_middle)) {
 865     __kmp_middle_initialize();
 866   }
 867   if (!KMP_AFFINITY_CAPABLE())
 868     return 0;
 869   if (!__kmp_affinity.flags.reset) {
 870     // only bind root here if its affinity reset is not requested
 871     int gtid = __kmp_entry_gtid();
 872     kmp_info_t *thread = __kmp_threads[gtid];
 873     if (thread->th.th_team->t.t_level == 0) {
 874       __kmp_assign_root_init_mask();
 875     }
 876   }
 877   if (place_num < 0 || place_num >= (int)__kmp_affinity.num_masks)
 878     return 0;
 879   kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity.masks, place_num);
 880   KMP_CPU_SET_ITERATE(i, mask) {
 881     if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||
 882         (!KMP_CPU_ISSET(i, mask))) {
 883       continue;
 884     }
 885     ++retval;
 886   }
 887   return retval;
 888 #endif
 889 }
 890
 891 void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_PROC_IDS)(int place_num,
 892                                                          int *ids) {
 893 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 894 // Nothing.
 895 #else
 896   int i, j;
 897   if (!TCR_4(__kmp_init_middle)) {
 898     __kmp_middle_initialize();
 899   }
 900   if (!KMP_AFFINITY_CAPABLE())
 901     return;
 902   if (!__kmp_affinity.flags.reset) {
 903     // only bind root here if its affinity reset is not requested
 904     int gtid = __kmp_entry_gtid();
 905     kmp_info_t *thread = __kmp_threads[gtid];
 906     if (thread->th.th_team->t.t_level == 0) {
 907       __kmp_assign_root_init_mask();
 908     }
 909   }
 910   if (place_num < 0 || place_num >= (int)__kmp_affinity.num_masks)
 911     return;
 912   kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity.masks, place_num);
 913   j = 0;
 914   KMP_CPU_SET_ITERATE(i, mask) {
 915     if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||
 916         (!KMP_CPU_ISSET(i, mask))) {
 917       continue;
 918     }
 919     ids[j++] = i;
 920   }
 921 #endif
 922 }
 923
 924 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM)(void) {
 925 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 926   return -1;
 927 #else
 928   int gtid;
 929   kmp_info_t *thread;
 930   if (!TCR_4(__kmp_init_middle)) {
 931     __kmp_middle_initialize();
 932   }
 933   if (!KMP_AFFINITY_CAPABLE())
 934     return -1;
 935   gtid = __kmp_entry_gtid();
 936   thread = __kmp_thread_from_gtid(gtid);
 937   if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {
 938     __kmp_assign_root_init_mask();
 939   }
 940   if (thread->th.th_current_place < 0)
 941     return -1;
 942   return thread->th.th_current_place;
 943 #endif
 944 }
 945
 946 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PARTITION_NUM_PLACES)(void) {
 947 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 948   return 0;
 949 #else
 950   int gtid, num_places, first_place, last_place;
 951   kmp_info_t *thread;
 952   if (!TCR_4(__kmp_init_middle)) {
 953     __kmp_middle_initialize();
 954   }
 955   if (!KMP_AFFINITY_CAPABLE())
 956     return 0;
 957   gtid = __kmp_entry_gtid();
 958   thread = __kmp_thread_from_gtid(gtid);
 959   if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {
 960     __kmp_assign_root_init_mask();
 961   }
 962   first_place = thread->th.th_first_place;
 963   last_place = thread->th.th_last_place;
 964   if (first_place < 0 || last_place < 0)
 965     return 0;
 966   if (first_place <= last_place)
 967     num_places = last_place - first_place + 1;
 968   else
 969     num_places = __kmp_affinity.num_masks - first_place + last_place + 1;
 970   return num_places;
 971 #endif
 972 }
 973
 974 void FTN_STDCALL
 975 KMP_EXPAND_NAME(FTN_GET_PARTITION_PLACE_NUMS)(int *place_nums) {
 976 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
 977 // Nothing.
 978 #else
 979   int i, gtid, place_num, first_place, last_place, start, end;
 980   kmp_info_t *thread;
 981   if (!TCR_4(__kmp_init_middle)) {
 982     __kmp_middle_initialize();
 983   }
 984   if (!KMP_AFFINITY_CAPABLE())
 985     return;
 986   gtid = __kmp_entry_gtid();
 987   thread = __kmp_thread_from_gtid(gtid);
 988   if (thread->th.th_team->t.t_level == 0 && !__kmp_affinity.flags.reset) {
 989     __kmp_assign_root_init_mask();
 990   }
 991   first_place = thread->th.th_first_place;
 992   last_place = thread->th.th_last_place;
 993   if (first_place < 0 || last_place < 0)
 994     return;
 995   if (first_place <= last_place) {
 996     start = first_place;
 997     end = last_place;
 998   } else {
 999     start = last_place;
1000     end = first_place;
1001   }
1002   for (i = 0, place_num = start; place_num <= end; ++place_num, ++i) {
1003     place_nums[i] = place_num;
1004   }
1005 #endif
1006 }
1007
1008 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_TEAMS)(void) {
1009 #ifdef KMP_STUB
1010   return 1;
1011 #else
1012   return __kmp_aux_get_num_teams();
1013 #endif
1014 }
1015
1016 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_NUM)(void) {
1017 #ifdef KMP_STUB
1018   return 0;
1019 #else
1020   return __kmp_aux_get_team_num();
1021 #endif
1022 }
1023
1024 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEFAULT_DEVICE)(void) {
1025 #if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
1026   return 0;
1027 #else
1028   return __kmp_entry_thread()->th.th_current_task->td_icvs.default_device;
1029 #endif
1030 }
1031
1032 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DEFAULT_DEVICE)(int KMP_DEREF arg) {
1033 #if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
1034 // Nothing.
1035 #else
1036   __kmp_entry_thread()->th.th_current_task->td_icvs.default_device =
1037       KMP_DEREF arg;
1038 #endif
1039 }
1040
1041 // Get number of NON-HOST devices.
1042 // libomptarget, if loaded, provides this function in api.cpp.
1043 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void)
1044     KMP_WEAK_ATTRIBUTE_EXTERNAL;
1045 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) {
1046 #if KMP_MIC || KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1047   return 0;
1048 #else
1049   int (*fptr)();
1050   if ((*(void **)(&fptr) = KMP_DLSYM("__tgt_get_num_devices"))) {
1051     return (*fptr)();
1052   } else if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_devices"))) {
1053     return (*fptr)();
1054   } else if ((*(void **)(&fptr) = KMP_DLSYM("_Offload_number_of_devices"))) {
1055     return (*fptr)();
1056   } else { // liboffload & libomptarget don't exist
1057     return 0;
1058   }
1059 #endif // KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB)
1060 }
1061
1062 // This function always returns true when called on host device.
1063 // Compiler/libomptarget should handle when it is called inside target region.
1064 int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void)
1065     KMP_WEAK_ATTRIBUTE_EXTERNAL;
1066 int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) {
1067   return 1; // This is the host
1068 }
1069
1070 // libomptarget, if loaded, provides this function
1071 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void)
1072     KMP_WEAK_ATTRIBUTE_EXTERNAL;
1073 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)(void) {
1074   // same as omp_get_num_devices()
1075   return KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)();
1076 }
1077
1078 #if defined(KMP_STUB)
1079 // Entries for stubs library
1080 // As all *target* functions are C-only parameters always passed by value
1081 void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; }
1082
1083 void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {}
1084
1085 int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; }
1086
1087 int FTN_STDCALL FTN_TARGET_MEMCPY(void *dst, void *src, size_t length,
1088                                   size_t dst_offset, size_t src_offset,
1089                                   int dst_device, int src_device) {
1090   return -1;
1091 }
1092
1093 int FTN_STDCALL FTN_TARGET_MEMCPY_RECT(
1094     void *dst, void *src, size_t element_size, int num_dims,
1095     const size_t *volume, const size_t *dst_offsets, const size_t *src_offsets,
1096     const size_t *dst_dimensions, const size_t *src_dimensions, int dst_device,
1097     int src_device) {
1098   return -1;
1099 }
1100
1101 int FTN_STDCALL FTN_TARGET_ASSOCIATE_PTR(void *host_ptr, void *device_ptr,
1102                                          size_t size, size_t device_offset,
1103                                          int device_num) {
1104   return -1;
1105 }
1106
1107 int FTN_STDCALL FTN_TARGET_DISASSOCIATE_PTR(void *host_ptr, int device_num) {
1108   return -1;
1109 }
1110 #endif // defined(KMP_STUB)
1111
1112 #ifdef KMP_STUB
1113 typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t;
1114 #endif /* KMP_STUB */
1115
1116 #if KMP_USE_DYNAMIC_LOCK
1117 void FTN_STDCALL FTN_INIT_LOCK_WITH_HINT(void **user_lock,
1118                                          uintptr_t KMP_DEREF hint) {
1119 #ifdef KMP_STUB
1120   *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1121 #else
1122   int gtid = __kmp_entry_gtid();
1123 #if OMPT_SUPPORT && OMPT_OPTIONAL
1124   OMPT_STORE_RETURN_ADDRESS(gtid);
1125 #endif
1126   __kmpc_init_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);
1127 #endif
1128 }
1129
1130 void FTN_STDCALL FTN_INIT_NEST_LOCK_WITH_HINT(void **user_lock,
1131                                               uintptr_t KMP_DEREF hint) {
1132 #ifdef KMP_STUB
1133   *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1134 #else
1135   int gtid = __kmp_entry_gtid();
1136 #if OMPT_SUPPORT && OMPT_OPTIONAL
1137   OMPT_STORE_RETURN_ADDRESS(gtid);
1138 #endif
1139   __kmpc_init_nest_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);
1140 #endif
1141 }
1142 #endif
1143
1144 /* initialize the lock */
1145 void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_LOCK)(void **user_lock) {
1146 #ifdef KMP_STUB
1147   *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1148 #else
1149   int gtid = __kmp_entry_gtid();
1150 #if OMPT_SUPPORT && OMPT_OPTIONAL
1151   OMPT_STORE_RETURN_ADDRESS(gtid);
1152 #endif
1153   __kmpc_init_lock(NULL, gtid, user_lock);
1154 #endif
1155 }
1156
1157 /* initialize the lock */
1158 void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_NEST_LOCK)(void **user_lock) {
1159 #ifdef KMP_STUB
1160   *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1161 #else
1162   int gtid = __kmp_entry_gtid();
1163 #if OMPT_SUPPORT && OMPT_OPTIONAL
1164   OMPT_STORE_RETURN_ADDRESS(gtid);
1165 #endif
1166   __kmpc_init_nest_lock(NULL, gtid, user_lock);
1167 #endif
1168 }
1169
1170 void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_LOCK)(void **user_lock) {
1171 #ifdef KMP_STUB
1172   *((kmp_stub_lock_t *)user_lock) = UNINIT;
1173 #else
1174   int gtid = __kmp_entry_gtid();
1175 #if OMPT_SUPPORT && OMPT_OPTIONAL
1176   OMPT_STORE_RETURN_ADDRESS(gtid);
1177 #endif
1178   __kmpc_destroy_lock(NULL, gtid, user_lock);
1179 #endif
1180 }
1181
1182 void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_NEST_LOCK)(void **user_lock) {
1183 #ifdef KMP_STUB
1184   *((kmp_stub_lock_t *)user_lock) = UNINIT;
1185 #else
1186   int gtid = __kmp_entry_gtid();
1187 #if OMPT_SUPPORT && OMPT_OPTIONAL
1188   OMPT_STORE_RETURN_ADDRESS(gtid);
1189 #endif
1190   __kmpc_destroy_nest_lock(NULL, gtid, user_lock);
1191 #endif
1192 }
1193
1194 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_LOCK)(void **user_lock) {
1195 #ifdef KMP_STUB
1196   if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1197     // TODO: Issue an error.
1198   }
1199   if (*((kmp_stub_lock_t *)user_lock) != UNLOCKED) {
1200     // TODO: Issue an error.
1201   }
1202   *((kmp_stub_lock_t *)user_lock) = LOCKED;
1203 #else
1204   int gtid = __kmp_entry_gtid();
1205 #if OMPT_SUPPORT && OMPT_OPTIONAL
1206   OMPT_STORE_RETURN_ADDRESS(gtid);
1207 #endif
1208   __kmpc_set_lock(NULL, gtid, user_lock);
1209 #endif
1210 }
1211
1212 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NEST_LOCK)(void **user_lock) {
1213 #ifdef KMP_STUB
1214   if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1215     // TODO: Issue an error.
1216   }
1217   (*((int *)user_lock))++;
1218 #else
1219   int gtid = __kmp_entry_gtid();
1220 #if OMPT_SUPPORT && OMPT_OPTIONAL
1221   OMPT_STORE_RETURN_ADDRESS(gtid);
1222 #endif
1223   __kmpc_set_nest_lock(NULL, gtid, user_lock);
1224 #endif
1225 }
1226
1227 void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_LOCK)(void **user_lock) {
1228 #ifdef KMP_STUB
1229   if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1230     // TODO: Issue an error.
1231   }
1232   if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {
1233     // TODO: Issue an error.
1234   }
1235   *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1236 #else
1237   int gtid = __kmp_entry_gtid();
1238 #if OMPT_SUPPORT && OMPT_OPTIONAL
1239   OMPT_STORE_RETURN_ADDRESS(gtid);
1240 #endif
1241   __kmpc_unset_lock(NULL, gtid, user_lock);
1242 #endif
1243 }
1244
1245 void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_NEST_LOCK)(void **user_lock) {
1246 #ifdef KMP_STUB
1247   if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1248     // TODO: Issue an error.
1249   }
1250   if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {
1251     // TODO: Issue an error.
1252   }
1253   (*((int *)user_lock))--;
1254 #else
1255   int gtid = __kmp_entry_gtid();
1256 #if OMPT_SUPPORT && OMPT_OPTIONAL
1257   OMPT_STORE_RETURN_ADDRESS(gtid);
1258 #endif
1259   __kmpc_unset_nest_lock(NULL, gtid, user_lock);
1260 #endif
1261 }
1262
1263 int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_LOCK)(void **user_lock) {
1264 #ifdef KMP_STUB
1265   if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1266     // TODO: Issue an error.
1267   }
1268   if (*((kmp_stub_lock_t *)user_lock) == LOCKED) {
1269     return 0;
1270   }
1271   *((kmp_stub_lock_t *)user_lock) = LOCKED;
1272   return 1;
1273 #else
1274   int gtid = __kmp_entry_gtid();
1275 #if OMPT_SUPPORT && OMPT_OPTIONAL
1276   OMPT_STORE_RETURN_ADDRESS(gtid);
1277 #endif
1278   return __kmpc_test_lock(NULL, gtid, user_lock);
1279 #endif
1280 }
1281
1282 int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_NEST_LOCK)(void **user_lock) {
1283 #ifdef KMP_STUB
1284   if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1285     // TODO: Issue an error.
1286   }
1287   return ++(*((int *)user_lock));
1288 #else
1289   int gtid = __kmp_entry_gtid();
1290 #if OMPT_SUPPORT && OMPT_OPTIONAL
1291   OMPT_STORE_RETURN_ADDRESS(gtid);
1292 #endif
1293   return __kmpc_test_nest_lock(NULL, gtid, user_lock);
1294 #endif
1295 }
1296
1297 double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTIME)(void) {
1298 #ifdef KMP_STUB
1299   return __kmps_get_wtime();
1300 #else
1301   double data;
1302 #if !KMP_OS_LINUX
1303   // We don't need library initialization to get the time on Linux* OS. The
1304   // routine can be used to measure library initialization time on Linux* OS now
1305   if (!__kmp_init_serial) {
1306     __kmp_serial_initialize();
1307   }
1308 #endif
1309   __kmp_elapsed(&data);
1310   return data;
1311 #endif
1312 }
1313
1314 double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTICK)(void) {
1315 #ifdef KMP_STUB
1316   return __kmps_get_wtick();
1317 #else
1318   double data;
1319   if (!__kmp_init_serial) {
1320     __kmp_serial_initialize();
1321   }
1322   __kmp_elapsed_tick(&data);
1323   return data;
1324 #endif
1325 }
1326
1327 /* ------------------------------------------------------------------------ */
1328
1329 void *FTN_STDCALL FTN_MALLOC(size_t KMP_DEREF size) {
1330   // kmpc_malloc initializes the library if needed
1331   return kmpc_malloc(KMP_DEREF size);
1332 }
1333
1334 void *FTN_STDCALL FTN_ALIGNED_MALLOC(size_t KMP_DEREF size,
1335                                      size_t KMP_DEREF alignment) {
1336   // kmpc_aligned_malloc initializes the library if needed
1337   return kmpc_aligned_malloc(KMP_DEREF size, KMP_DEREF alignment);
1338 }
1339
1340 void *FTN_STDCALL FTN_CALLOC(size_t KMP_DEREF nelem, size_t KMP_DEREF elsize) {
1341   // kmpc_calloc initializes the library if needed
1342   return kmpc_calloc(KMP_DEREF nelem, KMP_DEREF elsize);
1343 }
1344
1345 void *FTN_STDCALL FTN_REALLOC(void *KMP_DEREF ptr, size_t KMP_DEREF size) {
1346   // kmpc_realloc initializes the library if needed
1347   return kmpc_realloc(KMP_DEREF ptr, KMP_DEREF size);
1348 }
1349
1350 void FTN_STDCALL FTN_KFREE(void *KMP_DEREF ptr) {
1351   // does nothing if the library is not initialized
1352   kmpc_free(KMP_DEREF ptr);
1353 }
1354
1355 void FTN_STDCALL FTN_SET_WARNINGS_ON(void) {
1356 #ifndef KMP_STUB
1357   __kmp_generate_warnings = kmp_warnings_explicit;
1358 #endif
1359 }
1360
1361 void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) {
1362 #ifndef KMP_STUB
1363   __kmp_generate_warnings = FALSE;
1364 #endif
1365 }
1366
1367 void FTN_STDCALL FTN_SET_DEFAULTS(char const *str
1368 #ifndef PASS_ARGS_BY_VALUE
1369                                   ,
1370                                   int len
1371 #endif
1372 ) {
1373 #ifndef KMP_STUB
1374 #ifdef PASS_ARGS_BY_VALUE
1375   int len = (int)KMP_STRLEN(str);
1376 #endif
1377   __kmp_aux_set_defaults(str, len);
1378 #endif
1379 }
1380
1381 /* ------------------------------------------------------------------------ */
1382
1383 /* returns the status of cancellation */
1384 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_CANCELLATION)(void) {
1385 #ifdef KMP_STUB
1386   return 0 /* false */;
1387 #else
1388   // initialize the library if needed
1389   if (!__kmp_init_serial) {
1390     __kmp_serial_initialize();
1391   }
1392   return __kmp_omp_cancellation;
1393 #endif
1394 }
1395
1396 int FTN_STDCALL FTN_GET_CANCELLATION_STATUS(int cancel_kind) {
1397 #ifdef KMP_STUB
1398   return 0 /* false */;
1399 #else
1400   return __kmp_get_cancellation_status(cancel_kind);
1401 #endif
1402 }
1403
1404 /* returns the maximum allowed task priority */
1405 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_TASK_PRIORITY)(void) {
1406 #ifdef KMP_STUB
1407   return 0;
1408 #else
1409   if (!__kmp_init_serial) {
1410     __kmp_serial_initialize();
1411   }
1412   return __kmp_max_task_priority;
1413 #endif
1414 }
1415
1416 // This function will be defined in libomptarget. When libomptarget is not
1417 // loaded, we assume we are on the host and return KMP_HOST_DEVICE.
1418 // Compiler/libomptarget will handle this if called inside target.
1419 int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE_EXTERNAL;
1420 int FTN_STDCALL FTN_GET_DEVICE_NUM(void) {
1421   return KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)();
1422 }
1423
1424 // Compiler will ensure that this is only called from host in sequential region
1425 int FTN_STDCALL KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE)(kmp_pause_status_t kind,
1426                                                     int device_num) {
1427 #ifdef KMP_STUB
1428   return 1; // just fail
1429 #else
1430   if (kind == kmp_stop_tool_paused)
1431     return 1; // stop_tool must not be specified
1432   if (device_num == KMP_EXPAND_NAME(FTN_GET_INITIAL_DEVICE)())
1433     return __kmpc_pause_resource(kind);
1434   else {
1435     int (*fptr)(kmp_pause_status_t, int);
1436     if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource")))
1437       return (*fptr)(kind, device_num);
1438     else
1439       return 1; // just fail if there is no libomptarget
1440   }
1441 #endif
1442 }
1443
1444 // Compiler will ensure that this is only called from host in sequential region
1445 int FTN_STDCALL
1446     KMP_EXPAND_NAME(FTN_PAUSE_RESOURCE_ALL)(kmp_pause_status_t kind) {
1447 #ifdef KMP_STUB
1448   return 1; // just fail
1449 #else
1450   int fails = 0;
1451   int (*fptr)(kmp_pause_status_t, int);
1452   if ((*(void **)(&fptr) = KMP_DLSYM("tgt_pause_resource")))
1453     fails = (*fptr)(kind, KMP_DEVICE_ALL); // pause devices
1454   fails += __kmpc_pause_resource(kind); // pause host
1455   return fails;
1456 #endif
1457 }
1458
1459 // Returns the maximum number of nesting levels supported by implementation
1460 int FTN_STDCALL FTN_GET_SUPPORTED_ACTIVE_LEVELS(void) {
1461 #ifdef KMP_STUB
1462   return 1;
1463 #else
1464   return KMP_MAX_ACTIVE_LEVELS_LIMIT;
1465 #endif
1466 }
1467
1468 void FTN_STDCALL FTN_FULFILL_EVENT(kmp_event_t *event) {
1469 #ifndef KMP_STUB
1470   __kmp_fulfill_event(event);
1471 #endif
1472 }
1473
1474 // nteams-var per-device ICV
1475 void FTN_STDCALL FTN_SET_NUM_TEAMS(int KMP_DEREF num_teams) {
1476 #ifdef KMP_STUB
1477 // Nothing.
1478 #else
1479   if (!__kmp_init_serial) {
1480     __kmp_serial_initialize();
1481   }
1482   __kmp_set_num_teams(KMP_DEREF num_teams);
1483 #endif
1484 }
1485 int FTN_STDCALL FTN_GET_MAX_TEAMS(void) {
1486 #ifdef KMP_STUB
1487   return 1;
1488 #else
1489   if (!__kmp_init_serial) {
1490     __kmp_serial_initialize();
1491   }
1492   return __kmp_get_max_teams();
1493 #endif
1494 }
1495 // teams-thread-limit-var per-device ICV
1496 void FTN_STDCALL FTN_SET_TEAMS_THREAD_LIMIT(int KMP_DEREF limit) {
1497 #ifdef KMP_STUB
1498 // Nothing.
1499 #else
1500   if (!__kmp_init_serial) {
1501     __kmp_serial_initialize();
1502   }
1503   __kmp_set_teams_thread_limit(KMP_DEREF limit);
1504 #endif
1505 }
1506 int FTN_STDCALL FTN_GET_TEAMS_THREAD_LIMIT(void) {
1507 #ifdef KMP_STUB
1508   return 1;
1509 #else
1510   if (!__kmp_init_serial) {
1511     __kmp_serial_initialize();
1512   }
1513   return __kmp_get_teams_thread_limit();
1514 #endif
1515 }
1516
1517 /// TODO: Include the `omp.h` of the current build
1518 /* OpenMP 5.1 interop */
1519 typedef intptr_t omp_intptr_t;
1520
1521 /* 0..omp_get_num_interop_properties()-1 are reserved for implementation-defined
1522  * properties */
1523 typedef enum omp_interop_property {
1524   omp_ipr_fr_id = -1,
1525   omp_ipr_fr_name = -2,
1526   omp_ipr_vendor = -3,
1527   omp_ipr_vendor_name = -4,
1528   omp_ipr_device_num = -5,
1529   omp_ipr_platform = -6,
1530   omp_ipr_device = -7,
1531   omp_ipr_device_context = -8,
1532   omp_ipr_targetsync = -9,
1533   omp_ipr_first = -9
1534 } omp_interop_property_t;
1535
1536 #define omp_interop_none 0
1537
1538 typedef enum omp_interop_rc {
1539   omp_irc_no_value = 1,
1540   omp_irc_success = 0,
1541   omp_irc_empty = -1,
1542   omp_irc_out_of_range = -2,
1543   omp_irc_type_int = -3,
1544   omp_irc_type_ptr = -4,
1545   omp_irc_type_str = -5,
1546   omp_irc_other = -6
1547 } omp_interop_rc_t;
1548
1549 typedef enum omp_interop_fr {
1550   omp_ifr_cuda = 1,
1551   omp_ifr_cuda_driver = 2,
1552   omp_ifr_opencl = 3,
1553   omp_ifr_sycl = 4,
1554   omp_ifr_hip = 5,
1555   omp_ifr_level_zero = 6,
1556   omp_ifr_last = 7
1557 } omp_interop_fr_t;
1558
1559 typedef void *omp_interop_t;
1560
1561 // libomptarget, if loaded, provides this function
1562 int FTN_STDCALL FTN_GET_NUM_INTEROP_PROPERTIES(const omp_interop_t interop) {
1563 #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1564   return 0;
1565 #else
1566   int (*fptr)(const omp_interop_t);
1567   if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_num_interop_properties")))
1568     return (*fptr)(interop);
1569   return 0;
1570 #endif
1571 }
1572
1573 /// TODO Convert FTN_GET_INTEROP_XXX functions into a macro like interop.cpp
1574 // libomptarget, if loaded, provides this function
1575 intptr_t FTN_STDCALL FTN_GET_INTEROP_INT(const omp_interop_t interop,
1576                                          omp_interop_property_t property_id,
1577                                          int *err) {
1578 #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1579   return 0;
1580 #else
1581   intptr_t (*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1582   if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_int")))
1583     return (*fptr)(interop, property_id, err);
1584   return 0;
1585 #endif
1586 }
1587
1588 // libomptarget, if loaded, provides this function
1589 void *FTN_STDCALL FTN_GET_INTEROP_PTR(const omp_interop_t interop,
1590                                       omp_interop_property_t property_id,
1591                                       int *err) {
1592 #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1593   return nullptr;
1594 #else
1595   void *(*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1596   if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_ptr")))
1597     return (*fptr)(interop, property_id, err);
1598   return nullptr;
1599 #endif
1600 }
1601
1602 // libomptarget, if loaded, provides this function
1603 const char *FTN_STDCALL FTN_GET_INTEROP_STR(const omp_interop_t interop,
1604                                             omp_interop_property_t property_id,
1605                                             int *err) {
1606 #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1607   return nullptr;
1608 #else
1609   const char *(*fptr)(const omp_interop_t, omp_interop_property_t, int *);
1610   if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_str")))
1611     return (*fptr)(interop, property_id, err);
1612   return nullptr;
1613 #endif
1614 }
1615
1616 // libomptarget, if loaded, provides this function
1617 const char *FTN_STDCALL FTN_GET_INTEROP_NAME(
1618     const omp_interop_t interop, omp_interop_property_t property_id) {
1619 #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1620   return nullptr;
1621 #else
1622   const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1623   if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_name")))
1624     return (*fptr)(interop, property_id);
1625   return nullptr;
1626 #endif
1627 }
1628
1629 // libomptarget, if loaded, provides this function
1630 const char *FTN_STDCALL FTN_GET_INTEROP_TYPE_DESC(
1631     const omp_interop_t interop, omp_interop_property_t property_id) {
1632 #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1633   return nullptr;
1634 #else
1635   const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1636   if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_type_desc")))
1637     return (*fptr)(interop, property_id);
1638   return nullptr;
1639 #endif
1640 }
1641
1642 // libomptarget, if loaded, provides this function
1643 const char *FTN_STDCALL FTN_GET_INTEROP_RC_DESC(
1644     const omp_interop_t interop, omp_interop_property_t property_id) {
1645 #if KMP_OS_DARWIN || KMP_OS_WASI || defined(KMP_STUB)
1646   return nullptr;
1647 #else
1648   const char *(*fptr)(const omp_interop_t, omp_interop_property_t);
1649   if ((*(void **)(&fptr) = KMP_DLSYM_NEXT("omp_get_interop_rec_desc")))
1650     return (*fptr)(interop, property_id);
1651   return nullptr;
1652 #endif
1653 }
1654
1655 // display environment variables when requested
1656 void FTN_STDCALL FTN_DISPLAY_ENV(int verbose) {
1657 #ifndef KMP_STUB
1658   __kmp_omp_display_env(verbose);
1659 #endif
1660 }
1661
1662 int FTN_STDCALL FTN_IN_EXPLICIT_TASK(void) {
1663 #ifdef KMP_STUB
1664   return 0;
1665 #else
1666   int gtid = __kmp_entry_gtid();
1667   return __kmp_thread_from_gtid(gtid)->th.th_current_task->td_flags.tasktype;
1668 #endif
1669 }
1670
1671 // GCC compatibility (versioned symbols)
1672 #ifdef KMP_USE_VERSION_SYMBOLS
1673
1674 /* These following sections create versioned symbols for the
1675    omp_* routines. The KMP_VERSION_SYMBOL macro expands the API name and
1676    then maps it to a versioned symbol.
1677    libgomp ``versions'' its symbols (OMP_1.0, OMP_2.0, OMP_3.0, ...) while also
1678    retaining the default version which libomp uses: VERSION (defined in
1679    exports_so.txt). If you want to see the versioned symbols for libgomp.so.1
1680    then just type:
1681
1682    objdump -T /path/to/libgomp.so.1 | grep omp_
1683
1684    Example:
1685    Step 1) Create __kmp_api_omp_set_num_threads_10_alias which is alias of
1686      __kmp_api_omp_set_num_threads
1687    Step 2) Set __kmp_api_omp_set_num_threads_10_alias to version:
1688      omp_set_num_threads@OMP_1.0
1689    Step 2B) Set __kmp_api_omp_set_num_threads to default version:
1690      omp_set_num_threads@@VERSION
1691 */
1692
1693 // OMP_1.0 versioned symbols
1694 KMP_VERSION_SYMBOL(FTN_SET_NUM_THREADS, 10, "OMP_1.0");
1695 KMP_VERSION_SYMBOL(FTN_GET_NUM_THREADS, 10, "OMP_1.0");
1696 KMP_VERSION_SYMBOL(FTN_GET_MAX_THREADS, 10, "OMP_1.0");
1697 KMP_VERSION_SYMBOL(FTN_GET_THREAD_NUM, 10, "OMP_1.0");
1698 KMP_VERSION_SYMBOL(FTN_GET_NUM_PROCS, 10, "OMP_1.0");
1699 KMP_VERSION_SYMBOL(FTN_IN_PARALLEL, 10, "OMP_1.0");
1700 KMP_VERSION_SYMBOL(FTN_SET_DYNAMIC, 10, "OMP_1.0");
1701 KMP_VERSION_SYMBOL(FTN_GET_DYNAMIC, 10, "OMP_1.0");
1702 KMP_VERSION_SYMBOL(FTN_SET_NESTED, 10, "OMP_1.0");
1703 KMP_VERSION_SYMBOL(FTN_GET_NESTED, 10, "OMP_1.0");
1704 KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 10, "OMP_1.0");
1705 KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 10, "OMP_1.0");
1706 KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 10, "OMP_1.0");
1707 KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0");
1708 KMP_VERSION_SYMBOL(FTN_SET_LOCK, 10, "OMP_1.0");
1709 KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 10, "OMP_1.0");
1710 KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 10, "OMP_1.0");
1711 KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0");
1712 KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 10, "OMP_1.0");
1713 KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 10, "OMP_1.0");
1714
1715 // OMP_2.0 versioned symbols
1716 KMP_VERSION_SYMBOL(FTN_GET_WTICK, 20, "OMP_2.0");
1717 KMP_VERSION_SYMBOL(FTN_GET_WTIME, 20, "OMP_2.0");
1718
1719 // OMP_3.0 versioned symbols
1720 KMP_VERSION_SYMBOL(FTN_SET_SCHEDULE, 30, "OMP_3.0");
1721 KMP_VERSION_SYMBOL(FTN_GET_SCHEDULE, 30, "OMP_3.0");
1722 KMP_VERSION_SYMBOL(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0");
1723 KMP_VERSION_SYMBOL(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1724 KMP_VERSION_SYMBOL(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1725 KMP_VERSION_SYMBOL(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0");
1726 KMP_VERSION_SYMBOL(FTN_GET_LEVEL, 30, "OMP_3.0");
1727 KMP_VERSION_SYMBOL(FTN_GET_TEAM_SIZE, 30, "OMP_3.0");
1728 KMP_VERSION_SYMBOL(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0");
1729
1730 // the lock routines have a 1.0 and 3.0 version
1731 KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 30, "OMP_3.0");
1732 KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 30, "OMP_3.0");
1733 KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 30, "OMP_3.0");
1734 KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0");
1735 KMP_VERSION_SYMBOL(FTN_SET_LOCK, 30, "OMP_3.0");
1736 KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 30, "OMP_3.0");
1737 KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 30, "OMP_3.0");
1738 KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0");
1739 KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 30, "OMP_3.0");
1740 KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 30, "OMP_3.0");
1741
1742 // OMP_3.1 versioned symbol
1743 KMP_VERSION_SYMBOL(FTN_IN_FINAL, 31, "OMP_3.1");
1744
1745 // OMP_4.0 versioned symbols
1746 KMP_VERSION_SYMBOL(FTN_GET_PROC_BIND, 40, "OMP_4.0");
1747 KMP_VERSION_SYMBOL(FTN_GET_NUM_TEAMS, 40, "OMP_4.0");
1748 KMP_VERSION_SYMBOL(FTN_GET_TEAM_NUM, 40, "OMP_4.0");
1749 KMP_VERSION_SYMBOL(FTN_GET_CANCELLATION, 40, "OMP_4.0");
1750 KMP_VERSION_SYMBOL(FTN_GET_DEFAULT_DEVICE, 40, "OMP_4.0");
1751 KMP_VERSION_SYMBOL(FTN_SET_DEFAULT_DEVICE, 40, "OMP_4.0");
1752 KMP_VERSION_SYMBOL(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0");
1753 KMP_VERSION_SYMBOL(FTN_GET_NUM_DEVICES, 40, "OMP_4.0");
1754
1755 // OMP_4.5 versioned symbols
1756 KMP_VERSION_SYMBOL(FTN_GET_MAX_TASK_PRIORITY, 45, "OMP_4.5");
1757 KMP_VERSION_SYMBOL(FTN_GET_NUM_PLACES, 45, "OMP_4.5");
1758 KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM_PROCS, 45, "OMP_4.5");
1759 KMP_VERSION_SYMBOL(FTN_GET_PLACE_PROC_IDS, 45, "OMP_4.5");
1760 KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM, 45, "OMP_4.5");
1761 KMP_VERSION_SYMBOL(FTN_GET_PARTITION_NUM_PLACES, 45, "OMP_4.5");
1762 KMP_VERSION_SYMBOL(FTN_GET_PARTITION_PLACE_NUMS, 45, "OMP_4.5");
1763 KMP_VERSION_SYMBOL(FTN_GET_INITIAL_DEVICE, 45, "OMP_4.5");
1764
1765 // OMP_5.0 versioned symbols
1766 // KMP_VERSION_SYMBOL(FTN_GET_DEVICE_NUM, 50, "OMP_5.0");
1767 KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE, 50, "OMP_5.0");
1768 KMP_VERSION_SYMBOL(FTN_PAUSE_RESOURCE_ALL, 50, "OMP_5.0");
1769 // The C versions (KMP_FTN_PLAIN) of these symbols are in kmp_csupport.c
1770 #if KMP_FTN_ENTRIES == KMP_FTN_APPEND
1771 KMP_VERSION_SYMBOL(FTN_CAPTURE_AFFINITY, 50, "OMP_5.0");
1772 KMP_VERSION_SYMBOL(FTN_DISPLAY_AFFINITY, 50, "OMP_5.0");
1773 KMP_VERSION_SYMBOL(FTN_GET_AFFINITY_FORMAT, 50, "OMP_5.0");
1774 KMP_VERSION_SYMBOL(FTN_SET_AFFINITY_FORMAT, 50, "OMP_5.0");
1775 #endif
1776 // KMP_VERSION_SYMBOL(FTN_GET_SUPPORTED_ACTIVE_LEVELS, 50, "OMP_5.0");
1777 // KMP_VERSION_SYMBOL(FTN_FULFILL_EVENT, 50, "OMP_5.0");
1778
1779 #endif // KMP_USE_VERSION_SYMBOLS
1780
1781 #ifdef __cplusplus
1782 } // extern "C"
1783 #endif // __cplusplus
1784
1785 // end of file //