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