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