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