LLVM OpenMP* Runtime Library
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 
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 
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 //
KMP_EXPORT kmp_int32 __kmpc_bound_num_threads(ident_t *)