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