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