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