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