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 // The LLVM Compiler Infrastructure
8 //
9 // This file is dual licensed under the MIT and the University of Illinois Open
10 // Source Licenses. See LICENSE.txt for details.
11 //
12 //===----------------------------------------------------------------------===//
13 
14 #ifndef FTN_STDCALL
15 #error The support file kmp_ftn_entry.h should not be compiled by itself.
16 #endif
17 
18 #ifdef KMP_STUB
19 #include "kmp_stub.h"
20 #endif
21 
22 #include "kmp_i18n.h"
23 
24 #if OMP_50_ENABLED
25 // For affinity format functions
26 #include "kmp_io.h"
27 #include "kmp_str.h"
28 #endif
29 
30 #if OMPT_SUPPORT
31 #include "ompt-specific.h"
32 #endif
33 
34 #ifdef __cplusplus
35 extern "C" {
36 #endif // __cplusplus
37 
38 /* For compatibility with the Gnu/MS Open MP codegen, omp_set_num_threads(),
39  * omp_set_nested(), and omp_set_dynamic() [in lowercase on MS, and w/o
40  * a trailing underscore on Linux* OS] take call by value integer arguments.
41  * + omp_set_max_active_levels()
42  * + omp_set_schedule()
43  *
44  * For backward compatibility with 9.1 and previous Intel compiler, these
45  * entry points take call by reference integer arguments. */
46 #ifdef KMP_GOMP_COMPAT
47 #if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_UPPER)
48 #define PASS_ARGS_BY_VALUE 1
49 #endif
50 #endif
51 #if KMP_OS_WINDOWS
52 #if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_APPEND)
53 #define PASS_ARGS_BY_VALUE 1
54 #endif
55 #endif
56 
57 // This macro helps to reduce code duplication.
58 #ifdef PASS_ARGS_BY_VALUE
59 #define KMP_DEREF
60 #else
61 #define KMP_DEREF *
62 #endif
63 
64 void FTN_STDCALL FTN_SET_STACKSIZE(int KMP_DEREF arg) {
65 #ifdef KMP_STUB
66  __kmps_set_stacksize(KMP_DEREF arg);
67 #else
68  // __kmp_aux_set_stacksize initializes the library if needed
69  __kmp_aux_set_stacksize((size_t)KMP_DEREF arg);
70 #endif
71 }
72 
73 void FTN_STDCALL FTN_SET_STACKSIZE_S(size_t KMP_DEREF arg) {
74 #ifdef KMP_STUB
75  __kmps_set_stacksize(KMP_DEREF arg);
76 #else
77  // __kmp_aux_set_stacksize initializes the library if needed
78  __kmp_aux_set_stacksize(KMP_DEREF arg);
79 #endif
80 }
81 
82 int FTN_STDCALL FTN_GET_STACKSIZE(void) {
83 #ifdef KMP_STUB
84  return __kmps_get_stacksize();
85 #else
86  if (!__kmp_init_serial) {
87  __kmp_serial_initialize();
88  }
89  return (int)__kmp_stksize;
90 #endif
91 }
92 
93 size_t FTN_STDCALL FTN_GET_STACKSIZE_S(void) {
94 #ifdef KMP_STUB
95  return __kmps_get_stacksize();
96 #else
97  if (!__kmp_init_serial) {
98  __kmp_serial_initialize();
99  }
100  return __kmp_stksize;
101 #endif
102 }
103 
104 void FTN_STDCALL FTN_SET_BLOCKTIME(int KMP_DEREF arg) {
105 #ifdef KMP_STUB
106  __kmps_set_blocktime(KMP_DEREF arg);
107 #else
108  int gtid, tid;
109  kmp_info_t *thread;
110 
111  gtid = __kmp_entry_gtid();
112  tid = __kmp_tid_from_gtid(gtid);
113  thread = __kmp_thread_from_gtid(gtid);
114 
115  __kmp_aux_set_blocktime(KMP_DEREF arg, thread, tid);
116 #endif
117 }
118 
119 int FTN_STDCALL FTN_GET_BLOCKTIME(void) {
120 #ifdef KMP_STUB
121  return __kmps_get_blocktime();
122 #else
123  int gtid, tid;
124  kmp_info_t *thread;
125  kmp_team_p *team;
126 
127  gtid = __kmp_entry_gtid();
128  tid = __kmp_tid_from_gtid(gtid);
129  thread = __kmp_thread_from_gtid(gtid);
130  team = __kmp_threads[gtid]->th.th_team;
131 
132  /* These must match the settings used in __kmp_wait_sleep() */
133  if (__kmp_dflt_blocktime == KMP_MAX_BLOCKTIME) {
134  KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n", gtid,
135  team->t.t_id, tid, KMP_MAX_BLOCKTIME));
136  return KMP_MAX_BLOCKTIME;
137  }
138 #ifdef KMP_ADJUST_BLOCKTIME
139  else if (__kmp_zero_bt && !get__bt_set(team, tid)) {
140  KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n", gtid,
141  team->t.t_id, tid, 0));
142  return 0;
143  }
144 #endif /* KMP_ADJUST_BLOCKTIME */
145  else {
146  KF_TRACE(10, ("kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n", gtid,
147  team->t.t_id, tid, get__blocktime(team, tid)));
148  return get__blocktime(team, tid);
149  }
150 #endif
151 }
152 
153 void FTN_STDCALL FTN_SET_LIBRARY_SERIAL(void) {
154 #ifdef KMP_STUB
155  __kmps_set_library(library_serial);
156 #else
157  // __kmp_user_set_library initializes the library if needed
158  __kmp_user_set_library(library_serial);
159 #endif
160 }
161 
162 void FTN_STDCALL FTN_SET_LIBRARY_TURNAROUND(void) {
163 #ifdef KMP_STUB
164  __kmps_set_library(library_turnaround);
165 #else
166  // __kmp_user_set_library initializes the library if needed
167  __kmp_user_set_library(library_turnaround);
168 #endif
169 }
170 
171 void FTN_STDCALL FTN_SET_LIBRARY_THROUGHPUT(void) {
172 #ifdef KMP_STUB
173  __kmps_set_library(library_throughput);
174 #else
175  // __kmp_user_set_library initializes the library if needed
176  __kmp_user_set_library(library_throughput);
177 #endif
178 }
179 
180 void FTN_STDCALL FTN_SET_LIBRARY(int KMP_DEREF arg) {
181 #ifdef KMP_STUB
182  __kmps_set_library(KMP_DEREF arg);
183 #else
184  enum library_type lib;
185  lib = (enum library_type)KMP_DEREF arg;
186  // __kmp_user_set_library initializes the library if needed
187  __kmp_user_set_library(lib);
188 #endif
189 }
190 
191 int FTN_STDCALL FTN_GET_LIBRARY(void) {
192 #ifdef KMP_STUB
193  return __kmps_get_library();
194 #else
195  if (!__kmp_init_serial) {
196  __kmp_serial_initialize();
197  }
198  return ((int)__kmp_library);
199 #endif
200 }
201 
202 void FTN_STDCALL FTN_SET_DISP_NUM_BUFFERS(int KMP_DEREF arg) {
203 #ifdef KMP_STUB
204  ; // empty routine
205 #else
206  // ignore after initialization because some teams have already
207  // allocated dispatch buffers
208  if (__kmp_init_serial == 0 && (KMP_DEREF arg) > 0)
209  __kmp_dispatch_num_buffers = KMP_DEREF arg;
210 #endif
211 }
212 
213 int FTN_STDCALL FTN_SET_AFFINITY(void **mask) {
214 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
215  return -1;
216 #else
217  if (!TCR_4(__kmp_init_middle)) {
218  __kmp_middle_initialize();
219  }
220  return __kmp_aux_set_affinity(mask);
221 #endif
222 }
223 
224 int FTN_STDCALL FTN_GET_AFFINITY(void **mask) {
225 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
226  return -1;
227 #else
228  if (!TCR_4(__kmp_init_middle)) {
229  __kmp_middle_initialize();
230  }
231  return __kmp_aux_get_affinity(mask);
232 #endif
233 }
234 
235 int FTN_STDCALL FTN_GET_AFFINITY_MAX_PROC(void) {
236 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
237  return 0;
238 #else
239  // We really only NEED serial initialization here.
240  if (!TCR_4(__kmp_init_middle)) {
241  __kmp_middle_initialize();
242  }
243  return __kmp_aux_get_affinity_max_proc();
244 #endif
245 }
246 
247 void FTN_STDCALL FTN_CREATE_AFFINITY_MASK(void **mask) {
248 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
249  *mask = NULL;
250 #else
251  // We really only NEED serial initialization here.
252  kmp_affin_mask_t *mask_internals;
253  if (!TCR_4(__kmp_init_middle)) {
254  __kmp_middle_initialize();
255  }
256  mask_internals = __kmp_affinity_dispatch->allocate_mask();
257  KMP_CPU_ZERO(mask_internals);
258  *mask = mask_internals;
259 #endif
260 }
261 
262 void FTN_STDCALL FTN_DESTROY_AFFINITY_MASK(void **mask) {
263 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
264 // Nothing
265 #else
266  // We really only NEED serial initialization here.
267  kmp_affin_mask_t *mask_internals;
268  if (!TCR_4(__kmp_init_middle)) {
269  __kmp_middle_initialize();
270  }
271  if (__kmp_env_consistency_check) {
272  if (*mask == NULL) {
273  KMP_FATAL(AffinityInvalidMask, "kmp_destroy_affinity_mask");
274  }
275  }
276  mask_internals = (kmp_affin_mask_t *)(*mask);
277  __kmp_affinity_dispatch->deallocate_mask(mask_internals);
278  *mask = NULL;
279 #endif
280 }
281 
282 int FTN_STDCALL FTN_SET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
283 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
284  return -1;
285 #else
286  if (!TCR_4(__kmp_init_middle)) {
287  __kmp_middle_initialize();
288  }
289  return __kmp_aux_set_affinity_mask_proc(KMP_DEREF proc, mask);
290 #endif
291 }
292 
293 int FTN_STDCALL FTN_UNSET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
294 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
295  return -1;
296 #else
297  if (!TCR_4(__kmp_init_middle)) {
298  __kmp_middle_initialize();
299  }
300  return __kmp_aux_unset_affinity_mask_proc(KMP_DEREF proc, mask);
301 #endif
302 }
303 
304 int FTN_STDCALL FTN_GET_AFFINITY_MASK_PROC(int KMP_DEREF proc, void **mask) {
305 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
306  return -1;
307 #else
308  if (!TCR_4(__kmp_init_middle)) {
309  __kmp_middle_initialize();
310  }
311  return __kmp_aux_get_affinity_mask_proc(KMP_DEREF proc, mask);
312 #endif
313 }
314 
315 /* ------------------------------------------------------------------------ */
316 
317 /* sets the requested number of threads for the next parallel region */
318 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NUM_THREADS)(int KMP_DEREF arg) {
319 #ifdef KMP_STUB
320 // Nothing.
321 #else
322  __kmp_set_num_threads(KMP_DEREF arg, __kmp_entry_gtid());
323 #endif
324 }
325 
326 /* returns the number of threads in current team */
327 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_THREADS)(void) {
328 #ifdef KMP_STUB
329  return 1;
330 #else
331  // __kmpc_bound_num_threads initializes the library if needed
332  return __kmpc_bound_num_threads(NULL);
333 #endif
334 }
335 
336 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_THREADS)(void) {
337 #ifdef KMP_STUB
338  return 1;
339 #else
340  int gtid;
341  kmp_info_t *thread;
342  if (!TCR_4(__kmp_init_middle)) {
343  __kmp_middle_initialize();
344  }
345  gtid = __kmp_entry_gtid();
346  thread = __kmp_threads[gtid];
347  // return thread -> th.th_team -> t.t_current_task[
348  // thread->th.th_info.ds.ds_tid ] -> icvs.nproc;
349  return thread->th.th_current_task->td_icvs.nproc;
350 #endif
351 }
352 
353 #if OMP_50_ENABLED
354 int FTN_STDCALL FTN_CONTROL_TOOL(int command, int modifier, void *arg) {
355 #if defined(KMP_STUB) || !OMPT_SUPPORT
356  return -2;
357 #else
358  OMPT_STORE_RETURN_ADDRESS(__kmp_entry_gtid());
359  if (!TCR_4(__kmp_init_middle)) {
360  return -2;
361  }
362  kmp_info_t *this_thr = __kmp_threads[__kmp_entry_gtid()];
363  ompt_task_info_t *parent_task_info = OMPT_CUR_TASK_INFO(this_thr);
364  parent_task_info->frame.enter_frame.ptr = OMPT_GET_FRAME_ADDRESS(0);
365  int ret = __kmp_control_tool(command, modifier, arg);
366  parent_task_info->frame.enter_frame.ptr = 0;
367  return ret;
368 #endif
369 }
370 
371 /* OpenMP 5.0 Memory Management support */
372 void FTN_STDCALL FTN_SET_DEFAULT_ALLOCATOR(const omp_allocator_t *allocator) {
373 #ifndef KMP_STUB
374  __kmpc_set_default_allocator(__kmp_entry_gtid(), allocator);
375 #endif
376 }
377 const omp_allocator_t *FTN_STDCALL FTN_GET_DEFAULT_ALLOCATOR(void) {
378 #ifdef KMP_STUB
379  return NULL;
380 #else
381  return __kmpc_get_default_allocator(__kmp_entry_gtid());
382 #endif
383 }
384 void *FTN_STDCALL FTN_ALLOC(size_t size, const omp_allocator_t *allocator) {
385 #ifdef KMP_STUB
386  return malloc(size);
387 #else
388  return __kmpc_alloc(__kmp_entry_gtid(), size, allocator);
389 #endif
390 }
391 void FTN_STDCALL FTN_FREE(void *ptr, const omp_allocator_t *allocator) {
392 #ifdef KMP_STUB
393  free(ptr);
394 #else
395  __kmpc_free(__kmp_entry_gtid(), ptr, allocator);
396 #endif
397 }
398 
399 /* OpenMP 5.0 affinity format support */
400 
401 #ifndef KMP_STUB
402 static void __kmp_fortran_strncpy_truncate(char *buffer, size_t buf_size,
403  char const *csrc, size_t csrc_size) {
404  size_t capped_src_size = csrc_size;
405  if (csrc_size >= buf_size) {
406  capped_src_size = buf_size - 1;
407  }
408  KMP_STRNCPY_S(buffer, buf_size, csrc, capped_src_size);
409  if (csrc_size >= buf_size) {
410  KMP_DEBUG_ASSERT(buffer[buf_size - 1] == '\0');
411  buffer[buf_size - 1] = csrc[buf_size - 1];
412  } else {
413  for (size_t i = csrc_size; i < buf_size; ++i)
414  buffer[i] = ' ';
415  }
416 }
417 
418 // Convert a Fortran string to a C string by adding null byte
419 class ConvertedString {
420  char *buf;
421  kmp_info_t *th;
422 
423 public:
424  ConvertedString(char const *fortran_str, size_t size) {
425  th = __kmp_get_thread();
426  buf = (char *)__kmp_thread_malloc(th, size + 1);
427  KMP_STRNCPY_S(buf, size + 1, fortran_str, size);
428  buf[size] = '\0';
429  }
430  ~ConvertedString() { __kmp_thread_free(th, buf); }
431  const char *get() const { return buf; }
432 };
433 #endif // KMP_STUB
434 
435 /*
436  * Set the value of the affinity-format-var ICV on the current device to the
437  * format specified in the argument.
438 */
439 void FTN_STDCALL FTN_SET_AFFINITY_FORMAT(char const *format, size_t size) {
440 #ifdef KMP_STUB
441  return;
442 #else
443  if (!__kmp_init_serial) {
444  __kmp_serial_initialize();
445  }
446  ConvertedString cformat(format, size);
447  // Since the __kmp_affinity_format variable is a C string, do not
448  // use the fortran strncpy function
449  __kmp_strncpy_truncate(__kmp_affinity_format, KMP_AFFINITY_FORMAT_SIZE,
450  cformat.get(), KMP_STRLEN(cformat.get()));
451 #endif
452 }
453 
454 /*
455  * Returns the number of characters required to hold the entire affinity format
456  * specification (not including null byte character) and writes the value of the
457  * affinity-format-var ICV on the current device to buffer. If the return value
458  * is larger than size, the affinity format specification is truncated.
459 */
460 size_t FTN_STDCALL FTN_GET_AFFINITY_FORMAT(char *buffer, size_t size) {
461 #ifdef KMP_STUB
462  return 0;
463 #else
464  size_t format_size;
465  if (!__kmp_init_serial) {
466  __kmp_serial_initialize();
467  }
468  format_size = KMP_STRLEN(__kmp_affinity_format);
469  if (buffer && size) {
470  __kmp_fortran_strncpy_truncate(buffer, size, __kmp_affinity_format,
471  format_size);
472  }
473  return format_size;
474 #endif
475 }
476 
477 /*
478  * Prints the thread affinity information of the current thread in the format
479  * specified by the format argument. If the format is NULL or a zero-length
480  * string, the value of the affinity-format-var ICV is used.
481 */
482 void FTN_STDCALL FTN_DISPLAY_AFFINITY(char const *format, size_t size) {
483 #ifdef KMP_STUB
484  return;
485 #else
486  int gtid;
487  if (!TCR_4(__kmp_init_middle)) {
488  __kmp_middle_initialize();
489  }
490  gtid = __kmp_get_gtid();
491  ConvertedString cformat(format, size);
492  __kmp_aux_display_affinity(gtid, cformat.get());
493 #endif
494 }
495 
496 /*
497  * Returns the number of characters required to hold the entire affinity format
498  * specification (not including null byte) and prints the thread affinity
499  * information of the current thread into the character string buffer with the
500  * size of size in the format specified by the format argument. If the format is
501  * NULL or a zero-length string, the value of the affinity-format-var ICV is
502  * used. The buffer must be allocated prior to calling the routine. If the
503  * return value is larger than size, the affinity format specification is
504  * truncated.
505 */
506 size_t FTN_STDCALL FTN_CAPTURE_AFFINITY(char *buffer, char const *format,
507  size_t buf_size, size_t for_size) {
508 #if defined(KMP_STUB)
509  return 0;
510 #else
511  int gtid;
512  size_t num_required;
513  kmp_str_buf_t capture_buf;
514  if (!TCR_4(__kmp_init_middle)) {
515  __kmp_middle_initialize();
516  }
517  gtid = __kmp_get_gtid();
518  __kmp_str_buf_init(&capture_buf);
519  ConvertedString cformat(format, for_size);
520  num_required = __kmp_aux_capture_affinity(gtid, cformat.get(), &capture_buf);
521  if (buffer && buf_size) {
522  __kmp_fortran_strncpy_truncate(buffer, buf_size, capture_buf.str,
523  capture_buf.used);
524  }
525  __kmp_str_buf_free(&capture_buf);
526  return num_required;
527 #endif
528 }
529 #endif /* OMP_50_ENABLED */
530 
531 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_NUM)(void) {
532 #ifdef KMP_STUB
533  return 0;
534 #else
535  int gtid;
536 
537 #if KMP_OS_DARWIN || KMP_OS_DRAGONFLY || KMP_OS_FREEBSD || KMP_OS_NETBSD || \
538  KMP_OS_HURD || KMP_OS_KFREEBSD
539  gtid = __kmp_entry_gtid();
540 #elif KMP_OS_WINDOWS
541  if (!__kmp_init_parallel ||
542  (gtid = (int)((kmp_intptr_t)TlsGetValue(__kmp_gtid_threadprivate_key))) ==
543  0) {
544  // Either library isn't initialized or thread is not registered
545  // 0 is the correct TID in this case
546  return 0;
547  }
548  --gtid; // We keep (gtid+1) in TLS
549 #elif KMP_OS_LINUX
550 #ifdef KMP_TDATA_GTID
551  if (__kmp_gtid_mode >= 3) {
552  if ((gtid = __kmp_gtid) == KMP_GTID_DNE) {
553  return 0;
554  }
555  } else {
556 #endif
557  if (!__kmp_init_parallel ||
558  (gtid = (kmp_intptr_t)(
559  pthread_getspecific(__kmp_gtid_threadprivate_key))) == 0) {
560  return 0;
561  }
562  --gtid;
563 #ifdef KMP_TDATA_GTID
564  }
565 #endif
566 #else
567 #error Unknown or unsupported OS
568 #endif
569 
570  return __kmp_tid_from_gtid(gtid);
571 #endif
572 }
573 
574 int FTN_STDCALL FTN_GET_NUM_KNOWN_THREADS(void) {
575 #ifdef KMP_STUB
576  return 1;
577 #else
578  if (!__kmp_init_serial) {
579  __kmp_serial_initialize();
580  }
581  /* NOTE: this is not syncronized, so it can change at any moment */
582  /* NOTE: this number also includes threads preallocated in hot-teams */
583  return TCR_4(__kmp_nth);
584 #endif
585 }
586 
587 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PROCS)(void) {
588 #ifdef KMP_STUB
589  return 1;
590 #else
591  if (!TCR_4(__kmp_init_middle)) {
592  __kmp_middle_initialize();
593  }
594  return __kmp_avail_proc;
595 #endif
596 }
597 
598 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NESTED)(int KMP_DEREF flag) {
599 #ifdef KMP_STUB
600  __kmps_set_nested(KMP_DEREF flag);
601 #else
602  kmp_info_t *thread;
603  /* For the thread-private internal controls implementation */
604  thread = __kmp_entry_thread();
605  __kmp_save_internal_controls(thread);
606  set__nested(thread, ((KMP_DEREF flag) ? TRUE : FALSE));
607 #endif
608 }
609 
610 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NESTED)(void) {
611 #ifdef KMP_STUB
612  return __kmps_get_nested();
613 #else
614  kmp_info_t *thread;
615  thread = __kmp_entry_thread();
616  return get__nested(thread);
617 #endif
618 }
619 
620 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DYNAMIC)(int KMP_DEREF flag) {
621 #ifdef KMP_STUB
622  __kmps_set_dynamic(KMP_DEREF flag ? TRUE : FALSE);
623 #else
624  kmp_info_t *thread;
625  /* For the thread-private implementation of the internal controls */
626  thread = __kmp_entry_thread();
627  // !!! What if foreign thread calls it?
628  __kmp_save_internal_controls(thread);
629  set__dynamic(thread, KMP_DEREF flag ? TRUE : FALSE);
630 #endif
631 }
632 
633 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DYNAMIC)(void) {
634 #ifdef KMP_STUB
635  return __kmps_get_dynamic();
636 #else
637  kmp_info_t *thread;
638  thread = __kmp_entry_thread();
639  return get__dynamic(thread);
640 #endif
641 }
642 
643 int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_PARALLEL)(void) {
644 #ifdef KMP_STUB
645  return 0;
646 #else
647  kmp_info_t *th = __kmp_entry_thread();
648 #if OMP_40_ENABLED
649  if (th->th.th_teams_microtask) {
650  // AC: r_in_parallel does not work inside teams construct where real
651  // parallel is inactive, but all threads have same root, so setting it in
652  // one team affects other teams.
653  // The solution is to use per-team nesting level
654  return (th->th.th_team->t.t_active_level ? 1 : 0);
655  } else
656 #endif /* OMP_40_ENABLED */
657  return (th->th.th_root->r.r_in_parallel ? FTN_TRUE : FTN_FALSE);
658 #endif
659 }
660 
661 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_SCHEDULE)(kmp_sched_t KMP_DEREF kind,
662  int KMP_DEREF modifier) {
663 #ifdef KMP_STUB
664  __kmps_set_schedule(KMP_DEREF kind, KMP_DEREF modifier);
665 #else
666  /* TO DO: For the per-task implementation of the internal controls */
667  __kmp_set_schedule(__kmp_entry_gtid(), KMP_DEREF kind, KMP_DEREF modifier);
668 #endif
669 }
670 
671 void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_SCHEDULE)(kmp_sched_t *kind,
672  int *modifier) {
673 #ifdef KMP_STUB
674  __kmps_get_schedule(kind, modifier);
675 #else
676  /* TO DO: For the per-task implementation of the internal controls */
677  __kmp_get_schedule(__kmp_entry_gtid(), kind, modifier);
678 #endif
679 }
680 
681 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_MAX_ACTIVE_LEVELS)(int KMP_DEREF arg) {
682 #ifdef KMP_STUB
683 // Nothing.
684 #else
685  /* TO DO: We want per-task implementation of this internal control */
686  __kmp_set_max_active_levels(__kmp_entry_gtid(), KMP_DEREF arg);
687 #endif
688 }
689 
690 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_ACTIVE_LEVELS)(void) {
691 #ifdef KMP_STUB
692  return 0;
693 #else
694  /* TO DO: We want per-task implementation of this internal control */
695  return __kmp_get_max_active_levels(__kmp_entry_gtid());
696 #endif
697 }
698 
699 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_ACTIVE_LEVEL)(void) {
700 #ifdef KMP_STUB
701  return 0; // returns 0 if it is called from the sequential part of the program
702 #else
703  /* TO DO: For the per-task implementation of the internal controls */
704  return __kmp_entry_thread()->th.th_team->t.t_active_level;
705 #endif
706 }
707 
708 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_LEVEL)(void) {
709 #ifdef KMP_STUB
710  return 0; // returns 0 if it is called from the sequential part of the program
711 #else
712  /* TO DO: For the per-task implementation of the internal controls */
713  return __kmp_entry_thread()->th.th_team->t.t_level;
714 #endif
715 }
716 
717 int FTN_STDCALL
718  KMP_EXPAND_NAME(FTN_GET_ANCESTOR_THREAD_NUM)(int KMP_DEREF level) {
719 #ifdef KMP_STUB
720  return (KMP_DEREF level) ? (-1) : (0);
721 #else
722  return __kmp_get_ancestor_thread_num(__kmp_entry_gtid(), KMP_DEREF level);
723 #endif
724 }
725 
726 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_SIZE)(int KMP_DEREF level) {
727 #ifdef KMP_STUB
728  return (KMP_DEREF level) ? (-1) : (1);
729 #else
730  return __kmp_get_team_size(__kmp_entry_gtid(), KMP_DEREF level);
731 #endif
732 }
733 
734 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_THREAD_LIMIT)(void) {
735 #ifdef KMP_STUB
736  return 1; // TO DO: clarify whether it returns 1 or 0?
737 #else
738  if (!__kmp_init_serial) {
739  __kmp_serial_initialize();
740  }
741  /* global ICV */
742  return __kmp_cg_max_nth;
743 #endif
744 }
745 
746 int FTN_STDCALL KMP_EXPAND_NAME(FTN_IN_FINAL)(void) {
747 #ifdef KMP_STUB
748  return 0; // TO DO: clarify whether it returns 1 or 0?
749 #else
750  if (!TCR_4(__kmp_init_parallel)) {
751  return 0;
752  }
753  return __kmp_entry_thread()->th.th_current_task->td_flags.final;
754 #endif
755 }
756 
757 #if OMP_40_ENABLED
758 
759 kmp_proc_bind_t FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PROC_BIND)(void) {
760 #ifdef KMP_STUB
761  return __kmps_get_proc_bind();
762 #else
763  return get__proc_bind(__kmp_entry_thread());
764 #endif
765 }
766 
767 #if OMP_45_ENABLED
768 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_PLACES)(void) {
769 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
770  return 0;
771 #else
772  if (!TCR_4(__kmp_init_middle)) {
773  __kmp_middle_initialize();
774  }
775  if (!KMP_AFFINITY_CAPABLE())
776  return 0;
777  return __kmp_affinity_num_masks;
778 #endif
779 }
780 
781 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM_PROCS)(int place_num) {
782 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
783  return 0;
784 #else
785  int i;
786  int retval = 0;
787  if (!TCR_4(__kmp_init_middle)) {
788  __kmp_middle_initialize();
789  }
790  if (!KMP_AFFINITY_CAPABLE())
791  return 0;
792  if (place_num < 0 || place_num >= (int)__kmp_affinity_num_masks)
793  return 0;
794  kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity_masks, place_num);
795  KMP_CPU_SET_ITERATE(i, mask) {
796  if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||
797  (!KMP_CPU_ISSET(i, mask))) {
798  continue;
799  }
800  ++retval;
801  }
802  return retval;
803 #endif
804 }
805 
806 void FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_PROC_IDS)(int place_num,
807  int *ids) {
808 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
809 // Nothing.
810 #else
811  int i, j;
812  if (!TCR_4(__kmp_init_middle)) {
813  __kmp_middle_initialize();
814  }
815  if (!KMP_AFFINITY_CAPABLE())
816  return;
817  if (place_num < 0 || place_num >= (int)__kmp_affinity_num_masks)
818  return;
819  kmp_affin_mask_t *mask = KMP_CPU_INDEX(__kmp_affinity_masks, place_num);
820  j = 0;
821  KMP_CPU_SET_ITERATE(i, mask) {
822  if ((!KMP_CPU_ISSET(i, __kmp_affin_fullMask)) ||
823  (!KMP_CPU_ISSET(i, mask))) {
824  continue;
825  }
826  ids[j++] = i;
827  }
828 #endif
829 }
830 
831 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PLACE_NUM)(void) {
832 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
833  return -1;
834 #else
835  int gtid;
836  kmp_info_t *thread;
837  if (!TCR_4(__kmp_init_middle)) {
838  __kmp_middle_initialize();
839  }
840  if (!KMP_AFFINITY_CAPABLE())
841  return -1;
842  gtid = __kmp_entry_gtid();
843  thread = __kmp_thread_from_gtid(gtid);
844  if (thread->th.th_current_place < 0)
845  return -1;
846  return thread->th.th_current_place;
847 #endif
848 }
849 
850 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PARTITION_NUM_PLACES)(void) {
851 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
852  return 0;
853 #else
854  int gtid, num_places, first_place, last_place;
855  kmp_info_t *thread;
856  if (!TCR_4(__kmp_init_middle)) {
857  __kmp_middle_initialize();
858  }
859  if (!KMP_AFFINITY_CAPABLE())
860  return 0;
861  gtid = __kmp_entry_gtid();
862  thread = __kmp_thread_from_gtid(gtid);
863  first_place = thread->th.th_first_place;
864  last_place = thread->th.th_last_place;
865  if (first_place < 0 || last_place < 0)
866  return 0;
867  if (first_place <= last_place)
868  num_places = last_place - first_place + 1;
869  else
870  num_places = __kmp_affinity_num_masks - first_place + last_place + 1;
871  return num_places;
872 #endif
873 }
874 
875 void
876  FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_PARTITION_PLACE_NUMS)(int *place_nums) {
877 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
878 // Nothing.
879 #else
880  int i, gtid, place_num, first_place, last_place, start, end;
881  kmp_info_t *thread;
882  if (!TCR_4(__kmp_init_middle)) {
883  __kmp_middle_initialize();
884  }
885  if (!KMP_AFFINITY_CAPABLE())
886  return;
887  gtid = __kmp_entry_gtid();
888  thread = __kmp_thread_from_gtid(gtid);
889  first_place = thread->th.th_first_place;
890  last_place = thread->th.th_last_place;
891  if (first_place < 0 || last_place < 0)
892  return;
893  if (first_place <= last_place) {
894  start = first_place;
895  end = last_place;
896  } else {
897  start = last_place;
898  end = first_place;
899  }
900  for (i = 0, place_num = start; place_num <= end; ++place_num, ++i) {
901  place_nums[i] = place_num;
902  }
903 #endif
904 }
905 #endif
906 
907 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_TEAMS)(void) {
908 #ifdef KMP_STUB
909  return 1;
910 #else
911  return __kmp_aux_get_num_teams();
912 #endif
913 }
914 
915 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_TEAM_NUM)(void) {
916 #ifdef KMP_STUB
917  return 0;
918 #else
919  return __kmp_aux_get_team_num();
920 #endif
921 }
922 
923 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_DEFAULT_DEVICE)(void) {
924 #if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
925  return 0;
926 #else
927  return __kmp_entry_thread()->th.th_current_task->td_icvs.default_device;
928 #endif
929 }
930 
931 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_DEFAULT_DEVICE)(int KMP_DEREF arg) {
932 #if KMP_MIC || KMP_OS_DARWIN || defined(KMP_STUB)
933 // Nothing.
934 #else
935  __kmp_entry_thread()->th.th_current_task->td_icvs.default_device =
936  KMP_DEREF arg;
937 #endif
938 }
939 
940 // Get number of NON-HOST devices.
941 // libomptarget, if loaded, provides this function in api.cpp.
942 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) KMP_WEAK_ATTRIBUTE;
943 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_NUM_DEVICES)(void) {
944 #if KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB)
945  return 0;
946 #else
947  int (*fptr)();
948  if ((*(void **)(&fptr) = dlsym(RTLD_DEFAULT, "_Offload_number_of_devices"))) {
949  return (*fptr)();
950  } else if ((*(void **)(&fptr) = dlsym(RTLD_NEXT, "omp_get_num_devices"))) {
951  return (*fptr)();
952  } else { // liboffload & libomptarget don't exist
953  return 0;
954  }
955 #endif // KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB)
956 }
957 
958 // This function always returns true when called on host device.
959 // Compilier/libomptarget should handle when it is called inside target region.
960 int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) KMP_WEAK_ATTRIBUTE;
961 int FTN_STDCALL KMP_EXPAND_NAME(FTN_IS_INITIAL_DEVICE)(void) {
962  return 1; // This is the host
963 }
964 
965 #endif // OMP_40_ENABLED
966 
967 #if OMP_45_ENABLED
968 // OpenMP 4.5 entries
969 
970 // libomptarget, if loaded, provides this function
971 int FTN_STDCALL FTN_GET_INITIAL_DEVICE(void) KMP_WEAK_ATTRIBUTE;
972 int FTN_STDCALL FTN_GET_INITIAL_DEVICE(void) {
973 #if KMP_MIC || KMP_OS_DARWIN || KMP_OS_WINDOWS || defined(KMP_STUB)
974  return KMP_HOST_DEVICE;
975 #else
976  int (*fptr)();
977  if ((*(void **)(&fptr) = dlsym(RTLD_NEXT, "omp_get_initial_device"))) {
978  return (*fptr)();
979  } else { // liboffload & libomptarget don't exist
980  return KMP_HOST_DEVICE;
981  }
982 #endif
983 }
984 
985 #if defined(KMP_STUB)
986 // Entries for stubs library
987 // As all *target* functions are C-only parameters always passed by value
988 void *FTN_STDCALL FTN_TARGET_ALLOC(size_t size, int device_num) { return 0; }
989 
990 void FTN_STDCALL FTN_TARGET_FREE(void *device_ptr, int device_num) {}
991 
992 int FTN_STDCALL FTN_TARGET_IS_PRESENT(void *ptr, int device_num) { return 0; }
993 
994 int FTN_STDCALL FTN_TARGET_MEMCPY(void *dst, void *src, size_t length,
995  size_t dst_offset, size_t src_offset,
996  int dst_device, int src_device) {
997  return -1;
998 }
999 
1000 int FTN_STDCALL FTN_TARGET_MEMCPY_RECT(
1001  void *dst, void *src, size_t element_size, int num_dims,
1002  const size_t *volume, const size_t *dst_offsets, const size_t *src_offsets,
1003  const size_t *dst_dimensions, const size_t *src_dimensions, int dst_device,
1004  int src_device) {
1005  return -1;
1006 }
1007 
1008 int FTN_STDCALL FTN_TARGET_ASSOCIATE_PTR(void *host_ptr, void *device_ptr,
1009  size_t size, size_t device_offset,
1010  int device_num) {
1011  return -1;
1012 }
1013 
1014 int FTN_STDCALL FTN_TARGET_DISASSOCIATE_PTR(void *host_ptr, int device_num) {
1015  return -1;
1016 }
1017 #endif // defined(KMP_STUB)
1018 #endif // OMP_45_ENABLED
1019 
1020 #ifdef KMP_STUB
1021 typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t;
1022 #endif /* KMP_STUB */
1023 
1024 #if KMP_USE_DYNAMIC_LOCK
1025 void FTN_STDCALL FTN_INIT_LOCK_WITH_HINT(void **user_lock,
1026  uintptr_t KMP_DEREF hint) {
1027 #ifdef KMP_STUB
1028  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1029 #else
1030  int gtid = __kmp_entry_gtid();
1031 #if OMPT_SUPPORT && OMPT_OPTIONAL
1032  OMPT_STORE_RETURN_ADDRESS(gtid);
1033 #endif
1034  __kmpc_init_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);
1035 #endif
1036 }
1037 
1038 void FTN_STDCALL FTN_INIT_NEST_LOCK_WITH_HINT(void **user_lock,
1039  uintptr_t KMP_DEREF hint) {
1040 #ifdef KMP_STUB
1041  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1042 #else
1043  int gtid = __kmp_entry_gtid();
1044 #if OMPT_SUPPORT && OMPT_OPTIONAL
1045  OMPT_STORE_RETURN_ADDRESS(gtid);
1046 #endif
1047  __kmpc_init_nest_lock_with_hint(NULL, gtid, user_lock, KMP_DEREF hint);
1048 #endif
1049 }
1050 #endif
1051 
1052 /* initialize the lock */
1053 void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_LOCK)(void **user_lock) {
1054 #ifdef KMP_STUB
1055  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1056 #else
1057  int gtid = __kmp_entry_gtid();
1058 #if OMPT_SUPPORT && OMPT_OPTIONAL
1059  OMPT_STORE_RETURN_ADDRESS(gtid);
1060 #endif
1061  __kmpc_init_lock(NULL, gtid, user_lock);
1062 #endif
1063 }
1064 
1065 /* initialize the lock */
1066 void FTN_STDCALL KMP_EXPAND_NAME(FTN_INIT_NEST_LOCK)(void **user_lock) {
1067 #ifdef KMP_STUB
1068  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1069 #else
1070  int gtid = __kmp_entry_gtid();
1071 #if OMPT_SUPPORT && OMPT_OPTIONAL
1072  OMPT_STORE_RETURN_ADDRESS(gtid);
1073 #endif
1074  __kmpc_init_nest_lock(NULL, gtid, user_lock);
1075 #endif
1076 }
1077 
1078 void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_LOCK)(void **user_lock) {
1079 #ifdef KMP_STUB
1080  *((kmp_stub_lock_t *)user_lock) = UNINIT;
1081 #else
1082  int gtid = __kmp_entry_gtid();
1083 #if OMPT_SUPPORT && OMPT_OPTIONAL
1084  OMPT_STORE_RETURN_ADDRESS(gtid);
1085 #endif
1086  __kmpc_destroy_lock(NULL, gtid, user_lock);
1087 #endif
1088 }
1089 
1090 void FTN_STDCALL KMP_EXPAND_NAME(FTN_DESTROY_NEST_LOCK)(void **user_lock) {
1091 #ifdef KMP_STUB
1092  *((kmp_stub_lock_t *)user_lock) = UNINIT;
1093 #else
1094  int gtid = __kmp_entry_gtid();
1095 #if OMPT_SUPPORT && OMPT_OPTIONAL
1096  OMPT_STORE_RETURN_ADDRESS(gtid);
1097 #endif
1098  __kmpc_destroy_nest_lock(NULL, gtid, user_lock);
1099 #endif
1100 }
1101 
1102 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_LOCK)(void **user_lock) {
1103 #ifdef KMP_STUB
1104  if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1105  // TODO: Issue an error.
1106  }
1107  if (*((kmp_stub_lock_t *)user_lock) != UNLOCKED) {
1108  // TODO: Issue an error.
1109  }
1110  *((kmp_stub_lock_t *)user_lock) = LOCKED;
1111 #else
1112  int gtid = __kmp_entry_gtid();
1113 #if OMPT_SUPPORT && OMPT_OPTIONAL
1114  OMPT_STORE_RETURN_ADDRESS(gtid);
1115 #endif
1116  __kmpc_set_lock(NULL, gtid, user_lock);
1117 #endif
1118 }
1119 
1120 void FTN_STDCALL KMP_EXPAND_NAME(FTN_SET_NEST_LOCK)(void **user_lock) {
1121 #ifdef KMP_STUB
1122  if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1123  // TODO: Issue an error.
1124  }
1125  (*((int *)user_lock))++;
1126 #else
1127  int gtid = __kmp_entry_gtid();
1128 #if OMPT_SUPPORT && OMPT_OPTIONAL
1129  OMPT_STORE_RETURN_ADDRESS(gtid);
1130 #endif
1131  __kmpc_set_nest_lock(NULL, gtid, user_lock);
1132 #endif
1133 }
1134 
1135 void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_LOCK)(void **user_lock) {
1136 #ifdef KMP_STUB
1137  if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1138  // TODO: Issue an error.
1139  }
1140  if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {
1141  // TODO: Issue an error.
1142  }
1143  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
1144 #else
1145  int gtid = __kmp_entry_gtid();
1146 #if OMPT_SUPPORT && OMPT_OPTIONAL
1147  OMPT_STORE_RETURN_ADDRESS(gtid);
1148 #endif
1149  __kmpc_unset_lock(NULL, gtid, user_lock);
1150 #endif
1151 }
1152 
1153 void FTN_STDCALL KMP_EXPAND_NAME(FTN_UNSET_NEST_LOCK)(void **user_lock) {
1154 #ifdef KMP_STUB
1155  if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1156  // TODO: Issue an error.
1157  }
1158  if (*((kmp_stub_lock_t *)user_lock) == UNLOCKED) {
1159  // TODO: Issue an error.
1160  }
1161  (*((int *)user_lock))--;
1162 #else
1163  int gtid = __kmp_entry_gtid();
1164 #if OMPT_SUPPORT && OMPT_OPTIONAL
1165  OMPT_STORE_RETURN_ADDRESS(gtid);
1166 #endif
1167  __kmpc_unset_nest_lock(NULL, gtid, user_lock);
1168 #endif
1169 }
1170 
1171 int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_LOCK)(void **user_lock) {
1172 #ifdef KMP_STUB
1173  if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1174  // TODO: Issue an error.
1175  }
1176  if (*((kmp_stub_lock_t *)user_lock) == LOCKED) {
1177  return 0;
1178  }
1179  *((kmp_stub_lock_t *)user_lock) = LOCKED;
1180  return 1;
1181 #else
1182  int gtid = __kmp_entry_gtid();
1183 #if OMPT_SUPPORT && OMPT_OPTIONAL
1184  OMPT_STORE_RETURN_ADDRESS(gtid);
1185 #endif
1186  return __kmpc_test_lock(NULL, gtid, user_lock);
1187 #endif
1188 }
1189 
1190 int FTN_STDCALL KMP_EXPAND_NAME(FTN_TEST_NEST_LOCK)(void **user_lock) {
1191 #ifdef KMP_STUB
1192  if (*((kmp_stub_lock_t *)user_lock) == UNINIT) {
1193  // TODO: Issue an error.
1194  }
1195  return ++(*((int *)user_lock));
1196 #else
1197  int gtid = __kmp_entry_gtid();
1198 #if OMPT_SUPPORT && OMPT_OPTIONAL
1199  OMPT_STORE_RETURN_ADDRESS(gtid);
1200 #endif
1201  return __kmpc_test_nest_lock(NULL, gtid, user_lock);
1202 #endif
1203 }
1204 
1205 double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTIME)(void) {
1206 #ifdef KMP_STUB
1207  return __kmps_get_wtime();
1208 #else
1209  double data;
1210 #if !KMP_OS_LINUX
1211  // We don't need library initialization to get the time on Linux* OS. The
1212  // routine can be used to measure library initialization time on Linux* OS now
1213  if (!__kmp_init_serial) {
1214  __kmp_serial_initialize();
1215  }
1216 #endif
1217  __kmp_elapsed(&data);
1218  return data;
1219 #endif
1220 }
1221 
1222 double FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_WTICK)(void) {
1223 #ifdef KMP_STUB
1224  return __kmps_get_wtick();
1225 #else
1226  double data;
1227  if (!__kmp_init_serial) {
1228  __kmp_serial_initialize();
1229  }
1230  __kmp_elapsed_tick(&data);
1231  return data;
1232 #endif
1233 }
1234 
1235 /* ------------------------------------------------------------------------ */
1236 
1237 void *FTN_STDCALL FTN_MALLOC(size_t KMP_DEREF size) {
1238  // kmpc_malloc initializes the library if needed
1239  return kmpc_malloc(KMP_DEREF size);
1240 }
1241 
1242 void *FTN_STDCALL FTN_ALIGNED_MALLOC(size_t KMP_DEREF size,
1243  size_t KMP_DEREF alignment) {
1244  // kmpc_aligned_malloc initializes the library if needed
1245  return kmpc_aligned_malloc(KMP_DEREF size, KMP_DEREF alignment);
1246 }
1247 
1248 void *FTN_STDCALL FTN_CALLOC(size_t KMP_DEREF nelem, size_t KMP_DEREF elsize) {
1249  // kmpc_calloc initializes the library if needed
1250  return kmpc_calloc(KMP_DEREF nelem, KMP_DEREF elsize);
1251 }
1252 
1253 void *FTN_STDCALL FTN_REALLOC(void *KMP_DEREF ptr, size_t KMP_DEREF size) {
1254  // kmpc_realloc initializes the library if needed
1255  return kmpc_realloc(KMP_DEREF ptr, KMP_DEREF size);
1256 }
1257 
1258 void FTN_STDCALL FTN_KFREE(void *KMP_DEREF ptr) {
1259  // does nothing if the library is not initialized
1260  kmpc_free(KMP_DEREF ptr);
1261 }
1262 
1263 void FTN_STDCALL FTN_SET_WARNINGS_ON(void) {
1264 #ifndef KMP_STUB
1265  __kmp_generate_warnings = kmp_warnings_explicit;
1266 #endif
1267 }
1268 
1269 void FTN_STDCALL FTN_SET_WARNINGS_OFF(void) {
1270 #ifndef KMP_STUB
1271  __kmp_generate_warnings = FALSE;
1272 #endif
1273 }
1274 
1275 void FTN_STDCALL FTN_SET_DEFAULTS(char const *str
1276 #ifndef PASS_ARGS_BY_VALUE
1277  ,
1278  int len
1279 #endif
1280  ) {
1281 #ifndef KMP_STUB
1282 #ifdef PASS_ARGS_BY_VALUE
1283  int len = (int)KMP_STRLEN(str);
1284 #endif
1285  __kmp_aux_set_defaults(str, len);
1286 #endif
1287 }
1288 
1289 /* ------------------------------------------------------------------------ */
1290 
1291 #if OMP_40_ENABLED
1292 /* returns the status of cancellation */
1293 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_CANCELLATION)(void) {
1294 #ifdef KMP_STUB
1295  return 0 /* false */;
1296 #else
1297  // initialize the library if needed
1298  if (!__kmp_init_serial) {
1299  __kmp_serial_initialize();
1300  }
1301  return __kmp_omp_cancellation;
1302 #endif
1303 }
1304 
1305 int FTN_STDCALL FTN_GET_CANCELLATION_STATUS(int cancel_kind) {
1306 #ifdef KMP_STUB
1307  return 0 /* false */;
1308 #else
1309  return __kmp_get_cancellation_status(cancel_kind);
1310 #endif
1311 }
1312 
1313 #endif // OMP_40_ENABLED
1314 
1315 #if OMP_45_ENABLED
1316 /* returns the maximum allowed task priority */
1317 int FTN_STDCALL KMP_EXPAND_NAME(FTN_GET_MAX_TASK_PRIORITY)(void) {
1318 #ifdef KMP_STUB
1319  return 0;
1320 #else
1321  if (!__kmp_init_serial) {
1322  __kmp_serial_initialize();
1323  }
1324  return __kmp_max_task_priority;
1325 #endif
1326 }
1327 #endif
1328 
1329 #if OMP_50_ENABLED
1330 // This function will be defined in libomptarget. When libomptarget is not
1331 // loaded, we assume we are on the host and return KMP_HOST_DEVICE.
1332 // Compiler/libomptarget will handle this if called inside target.
1333 int FTN_STDCALL FTN_GET_DEVICE_NUM(void) KMP_WEAK_ATTRIBUTE;
1334 int FTN_STDCALL FTN_GET_DEVICE_NUM(void) { return KMP_HOST_DEVICE; }
1335 #endif // OMP_50_ENABLED
1336 
1337 // GCC compatibility (versioned symbols)
1338 #ifdef KMP_USE_VERSION_SYMBOLS
1339 
1340 /* These following sections create versioned symbols for the
1341  omp_* routines. The KMP_VERSION_SYMBOL macro expands the API name and
1342  then maps it to a versioned symbol.
1343  libgomp ``versions'' its symbols (OMP_1.0, OMP_2.0, OMP_3.0, ...) while also
1344  retaining the default version which libomp uses: VERSION (defined in
1345  exports_so.txt). If you want to see the versioned symbols for libgomp.so.1
1346  then just type:
1347 
1348  objdump -T /path/to/libgomp.so.1 | grep omp_
1349 
1350  Example:
1351  Step 1) Create __kmp_api_omp_set_num_threads_10_alias which is alias of
1352  __kmp_api_omp_set_num_threads
1353  Step 2) Set __kmp_api_omp_set_num_threads_10_alias to version:
1354  omp_set_num_threads@OMP_1.0
1355  Step 2B) Set __kmp_api_omp_set_num_threads to default version:
1356  omp_set_num_threads@@VERSION
1357 */
1358 
1359 // OMP_1.0 versioned symbols
1360 KMP_VERSION_SYMBOL(FTN_SET_NUM_THREADS, 10, "OMP_1.0");
1361 KMP_VERSION_SYMBOL(FTN_GET_NUM_THREADS, 10, "OMP_1.0");
1362 KMP_VERSION_SYMBOL(FTN_GET_MAX_THREADS, 10, "OMP_1.0");
1363 KMP_VERSION_SYMBOL(FTN_GET_THREAD_NUM, 10, "OMP_1.0");
1364 KMP_VERSION_SYMBOL(FTN_GET_NUM_PROCS, 10, "OMP_1.0");
1365 KMP_VERSION_SYMBOL(FTN_IN_PARALLEL, 10, "OMP_1.0");
1366 KMP_VERSION_SYMBOL(FTN_SET_DYNAMIC, 10, "OMP_1.0");
1367 KMP_VERSION_SYMBOL(FTN_GET_DYNAMIC, 10, "OMP_1.0");
1368 KMP_VERSION_SYMBOL(FTN_SET_NESTED, 10, "OMP_1.0");
1369 KMP_VERSION_SYMBOL(FTN_GET_NESTED, 10, "OMP_1.0");
1370 KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 10, "OMP_1.0");
1371 KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 10, "OMP_1.0");
1372 KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 10, "OMP_1.0");
1373 KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0");
1374 KMP_VERSION_SYMBOL(FTN_SET_LOCK, 10, "OMP_1.0");
1375 KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 10, "OMP_1.0");
1376 KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 10, "OMP_1.0");
1377 KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0");
1378 KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 10, "OMP_1.0");
1379 KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 10, "OMP_1.0");
1380 
1381 // OMP_2.0 versioned symbols
1382 KMP_VERSION_SYMBOL(FTN_GET_WTICK, 20, "OMP_2.0");
1383 KMP_VERSION_SYMBOL(FTN_GET_WTIME, 20, "OMP_2.0");
1384 
1385 // OMP_3.0 versioned symbols
1386 KMP_VERSION_SYMBOL(FTN_SET_SCHEDULE, 30, "OMP_3.0");
1387 KMP_VERSION_SYMBOL(FTN_GET_SCHEDULE, 30, "OMP_3.0");
1388 KMP_VERSION_SYMBOL(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0");
1389 KMP_VERSION_SYMBOL(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1390 KMP_VERSION_SYMBOL(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1391 KMP_VERSION_SYMBOL(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0");
1392 KMP_VERSION_SYMBOL(FTN_GET_LEVEL, 30, "OMP_3.0");
1393 KMP_VERSION_SYMBOL(FTN_GET_TEAM_SIZE, 30, "OMP_3.0");
1394 KMP_VERSION_SYMBOL(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0");
1395 
1396 // the lock routines have a 1.0 and 3.0 version
1397 KMP_VERSION_SYMBOL(FTN_INIT_LOCK, 30, "OMP_3.0");
1398 KMP_VERSION_SYMBOL(FTN_INIT_NEST_LOCK, 30, "OMP_3.0");
1399 KMP_VERSION_SYMBOL(FTN_DESTROY_LOCK, 30, "OMP_3.0");
1400 KMP_VERSION_SYMBOL(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0");
1401 KMP_VERSION_SYMBOL(FTN_SET_LOCK, 30, "OMP_3.0");
1402 KMP_VERSION_SYMBOL(FTN_SET_NEST_LOCK, 30, "OMP_3.0");
1403 KMP_VERSION_SYMBOL(FTN_UNSET_LOCK, 30, "OMP_3.0");
1404 KMP_VERSION_SYMBOL(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0");
1405 KMP_VERSION_SYMBOL(FTN_TEST_LOCK, 30, "OMP_3.0");
1406 KMP_VERSION_SYMBOL(FTN_TEST_NEST_LOCK, 30, "OMP_3.0");
1407 
1408 // OMP_3.1 versioned symbol
1409 KMP_VERSION_SYMBOL(FTN_IN_FINAL, 31, "OMP_3.1");
1410 
1411 #if OMP_40_ENABLED
1412 // OMP_4.0 versioned symbols
1413 KMP_VERSION_SYMBOL(FTN_GET_PROC_BIND, 40, "OMP_4.0");
1414 KMP_VERSION_SYMBOL(FTN_GET_NUM_TEAMS, 40, "OMP_4.0");
1415 KMP_VERSION_SYMBOL(FTN_GET_TEAM_NUM, 40, "OMP_4.0");
1416 KMP_VERSION_SYMBOL(FTN_GET_CANCELLATION, 40, "OMP_4.0");
1417 KMP_VERSION_SYMBOL(FTN_GET_DEFAULT_DEVICE, 40, "OMP_4.0");
1418 KMP_VERSION_SYMBOL(FTN_SET_DEFAULT_DEVICE, 40, "OMP_4.0");
1419 KMP_VERSION_SYMBOL(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0");
1420 KMP_VERSION_SYMBOL(FTN_GET_NUM_DEVICES, 40, "OMP_4.0");
1421 #endif /* OMP_40_ENABLED */
1422 
1423 #if OMP_45_ENABLED
1424 // OMP_4.5 versioned symbols
1425 KMP_VERSION_SYMBOL(FTN_GET_MAX_TASK_PRIORITY, 45, "OMP_4.5");
1426 KMP_VERSION_SYMBOL(FTN_GET_NUM_PLACES, 45, "OMP_4.5");
1427 KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM_PROCS, 45, "OMP_4.5");
1428 KMP_VERSION_SYMBOL(FTN_GET_PLACE_PROC_IDS, 45, "OMP_4.5");
1429 KMP_VERSION_SYMBOL(FTN_GET_PLACE_NUM, 45, "OMP_4.5");
1430 KMP_VERSION_SYMBOL(FTN_GET_PARTITION_NUM_PLACES, 45, "OMP_4.5");
1431 KMP_VERSION_SYMBOL(FTN_GET_PARTITION_PLACE_NUMS, 45, "OMP_4.5");
1432 // KMP_VERSION_SYMBOL(FTN_GET_INITIAL_DEVICE, 45, "OMP_4.5");
1433 #endif
1434 
1435 #if OMP_50_ENABLED
1436 // OMP_5.0 versioned symbols
1437 // KMP_VERSION_SYMBOL(FTN_GET_DEVICE_NUM, 50, "OMP_5.0");
1438 #endif
1439 
1440 #endif // KMP_USE_VERSION_SYMBOLS
1441 
1442 #ifdef __cplusplus
1443 } // extern "C"
1444 #endif // __cplusplus
1445 
1446 // end of file //
KMP_EXPORT kmp_int32 __kmpc_bound_num_threads(ident_t *)