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 int FTN_STDCALL
219 FTN_SET_AFFINITY( void **mask )
220 {
221  #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
222  return -1;
223  #else
224  if ( ! TCR_4(__kmp_init_middle) ) {
225  __kmp_middle_initialize();
226  }
227  return __kmp_aux_set_affinity( mask );
228  #endif
229 }
230 
231 int FTN_STDCALL
232 FTN_GET_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_get_affinity( mask );
241  #endif
242 }
243 
244 int FTN_STDCALL
245 FTN_GET_AFFINITY_MAX_PROC( void )
246 {
247  #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
248  return 0;
249  #else
250  //
251  // We really only NEED serial initialization here.
252  //
253  if ( ! TCR_4(__kmp_init_middle) ) {
254  __kmp_middle_initialize();
255  }
256  if ( ! ( KMP_AFFINITY_CAPABLE() ) ) {
257  return 0;
258  }
259 
260  #if KMP_GROUP_AFFINITY && !KMP_USE_HWLOC
261  if ( __kmp_num_proc_groups > 1 ) {
262  return (int)KMP_CPU_SETSIZE;
263  }
264  #endif /* KMP_GROUP_AFFINITY */
265  return __kmp_xproc;
266  #endif
267 }
268 
269 void FTN_STDCALL
270 FTN_CREATE_AFFINITY_MASK( void **mask )
271 {
272  #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
273  *mask = NULL;
274  #else
275  //
276  // We really only NEED serial initialization here.
277  //
278  if ( ! TCR_4(__kmp_init_middle) ) {
279  __kmp_middle_initialize();
280  }
281  # if KMP_USE_HWLOC
282  *mask = (hwloc_cpuset_t)hwloc_bitmap_alloc();
283  # else
284  *mask = kmpc_malloc( __kmp_affin_mask_size );
285  # endif
286  KMP_CPU_ZERO( (kmp_affin_mask_t *)(*mask) );
287  #endif
288 }
289 
290 void FTN_STDCALL
291 FTN_DESTROY_AFFINITY_MASK( void **mask )
292 {
293  #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
294  // Nothing
295  #else
296  //
297  // We really only NEED serial initialization here.
298  //
299  if ( ! TCR_4(__kmp_init_middle) ) {
300  __kmp_middle_initialize();
301  }
302  if ( __kmp_env_consistency_check ) {
303  if ( *mask == NULL ) {
304  KMP_FATAL( AffinityInvalidMask, "kmp_destroy_affinity_mask" );
305  }
306  }
307  # if KMP_USE_HWLOC
308  hwloc_bitmap_free((hwloc_cpuset_t)(*mask));
309  # else
310  kmpc_free( *mask );
311  # endif
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 int FTN_STDCALL
680 xexpand(FTN_GET_NUM_TEAMS)( void )
681 {
682  #ifdef KMP_STUB
683  return 1;
684  #else
685  kmp_info_t *thr = __kmp_entry_thread();
686  if ( thr->th.th_teams_microtask ) {
687  kmp_team_t *team = thr->th.th_team;
688  int tlevel = thr->th.th_teams_level;
689  int ii = team->t.t_level; // the level of the teams construct
690  int dd = team -> t.t_serialized;
691  int level = tlevel + 1;
692  KMP_DEBUG_ASSERT( ii >= tlevel );
693  while( ii > level )
694  {
695  for( dd = team -> t.t_serialized; ( dd > 0 ) && ( ii > level ); dd--, ii-- )
696  {
697  }
698  if( team -> t.t_serialized && ( !dd ) ) {
699  team = team->t.t_parent;
700  continue;
701  }
702  if( ii > level ) {
703  team = team->t.t_parent;
704  ii--;
705  }
706  }
707  if ( dd > 1 ) {
708  return 1; // teams region is serialized ( 1 team of 1 thread ).
709  } else {
710  return team->t.t_parent->t.t_nproc;
711  }
712  } else {
713  return 1;
714  }
715  #endif
716 }
717 
718 int FTN_STDCALL
719 xexpand(FTN_GET_TEAM_NUM)( void )
720 {
721  #ifdef KMP_STUB
722  return 0;
723  #else
724  kmp_info_t *thr = __kmp_entry_thread();
725  if ( thr->th.th_teams_microtask ) {
726  kmp_team_t *team = thr->th.th_team;
727  int tlevel = thr->th.th_teams_level; // the level of the teams construct
728  int ii = team->t.t_level;
729  int dd = team -> t.t_serialized;
730  int level = tlevel + 1;
731  KMP_DEBUG_ASSERT( ii >= tlevel );
732  while( ii > level )
733  {
734  for( dd = team -> t.t_serialized; ( dd > 0 ) && ( ii > level ); dd--, ii-- )
735  {
736  }
737  if( team -> t.t_serialized && ( !dd ) ) {
738  team = team->t.t_parent;
739  continue;
740  }
741  if( ii > level ) {
742  team = team->t.t_parent;
743  ii--;
744  }
745  }
746  if ( dd > 1 ) {
747  return 0; // teams region is serialized ( 1 team of 1 thread ).
748  } else {
749  return team->t.t_master_tid;
750  }
751  } else {
752  return 0;
753  }
754  #endif
755 }
756 
757 #if KMP_MIC || KMP_OS_DARWIN
758 
759 static int __kmp_default_device = 0;
760 
761 int FTN_STDCALL
762 FTN_GET_DEFAULT_DEVICE( void )
763 {
764  return __kmp_default_device;
765 }
766 
767 void FTN_STDCALL
768 FTN_SET_DEFAULT_DEVICE( int KMP_DEREF arg )
769 {
770  __kmp_default_device = KMP_DEREF arg;
771 }
772 
773 int FTN_STDCALL
774 FTN_GET_NUM_DEVICES( void )
775 {
776  return 0;
777 }
778 
779 #endif // KMP_MIC || KMP_OS_DARWIN
780 
781 #if ! KMP_OS_LINUX
782 
783 int FTN_STDCALL
784 xexpand(FTN_IS_INITIAL_DEVICE)( void )
785 {
786  return 1;
787 }
788 
789 #else
790 
791 // This internal function is used when the entry from the offload library
792 // is not found.
793 int _Offload_get_device_number( void ) __attribute__((weak));
794 
795 int FTN_STDCALL
796 xexpand(FTN_IS_INITIAL_DEVICE)( void )
797 {
798  if( _Offload_get_device_number ) {
799  return _Offload_get_device_number() == -1;
800  } else {
801  return 1;
802  }
803 }
804 
805 #endif // ! KMP_OS_LINUX
806 
807 #endif // OMP_40_ENABLED
808 
809 #ifdef KMP_STUB
810 typedef enum { UNINIT = -1, UNLOCKED, LOCKED } kmp_stub_lock_t;
811 #endif /* KMP_STUB */
812 
813 #if KMP_USE_DYNAMIC_LOCK
814 void FTN_STDCALL
815 FTN_INIT_LOCK_WITH_HINT( void **user_lock, uintptr_t KMP_DEREF hint )
816 {
817  #ifdef KMP_STUB
818  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
819  #else
820  __kmpc_init_lock_with_hint( NULL, __kmp_entry_gtid(), user_lock, KMP_DEREF hint );
821  #endif
822 }
823 
824 void FTN_STDCALL
825 FTN_INIT_NEST_LOCK_WITH_HINT( void **user_lock, uintptr_t KMP_DEREF hint )
826 {
827  #ifdef KMP_STUB
828  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
829  #else
830  __kmpc_init_nest_lock_with_hint( NULL, __kmp_entry_gtid(), user_lock, KMP_DEREF hint );
831  #endif
832 }
833 #endif
834 
835 /* initialize the lock */
836 void FTN_STDCALL
837 xexpand(FTN_INIT_LOCK)( void **user_lock )
838 {
839  #ifdef KMP_STUB
840  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
841  #else
842  __kmpc_init_lock( NULL, __kmp_entry_gtid(), user_lock );
843  #endif
844 }
845 
846 /* initialize the lock */
847 void FTN_STDCALL
848 xexpand(FTN_INIT_NEST_LOCK)( void **user_lock )
849 {
850  #ifdef KMP_STUB
851  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
852  #else
853  __kmpc_init_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
854  #endif
855 }
856 
857 void FTN_STDCALL
858 xexpand(FTN_DESTROY_LOCK)( void **user_lock )
859 {
860  #ifdef KMP_STUB
861  *((kmp_stub_lock_t *)user_lock) = UNINIT;
862  #else
863  __kmpc_destroy_lock( NULL, __kmp_entry_gtid(), user_lock );
864  #endif
865 }
866 
867 void FTN_STDCALL
868 xexpand(FTN_DESTROY_NEST_LOCK)( void **user_lock )
869 {
870  #ifdef KMP_STUB
871  *((kmp_stub_lock_t *)user_lock) = UNINIT;
872  #else
873  __kmpc_destroy_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
874  #endif
875 }
876 
877 void FTN_STDCALL
878 xexpand(FTN_SET_LOCK)( void **user_lock )
879 {
880  #ifdef KMP_STUB
881  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
882  // TODO: Issue an error.
883  }; // if
884  if ( *((kmp_stub_lock_t *)user_lock) != UNLOCKED ) {
885  // TODO: Issue an error.
886  }; // if
887  *((kmp_stub_lock_t *)user_lock) = LOCKED;
888  #else
889  __kmpc_set_lock( NULL, __kmp_entry_gtid(), user_lock );
890  #endif
891 }
892 
893 void FTN_STDCALL
894 xexpand(FTN_SET_NEST_LOCK)( void **user_lock )
895 {
896  #ifdef KMP_STUB
897  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
898  // TODO: Issue an error.
899  }; // if
900  (*((int *)user_lock))++;
901  #else
902  __kmpc_set_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
903  #endif
904 }
905 
906 void FTN_STDCALL
907 xexpand(FTN_UNSET_LOCK)( void **user_lock )
908 {
909  #ifdef KMP_STUB
910  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
911  // TODO: Issue an error.
912  }; // if
913  if ( *((kmp_stub_lock_t *)user_lock) == UNLOCKED ) {
914  // TODO: Issue an error.
915  }; // if
916  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
917  #else
918  __kmpc_unset_lock( NULL, __kmp_entry_gtid(), user_lock );
919  #endif
920 }
921 
922 void FTN_STDCALL
923 xexpand(FTN_UNSET_NEST_LOCK)( void **user_lock )
924 {
925  #ifdef KMP_STUB
926  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
927  // TODO: Issue an error.
928  }; // if
929  if ( *((kmp_stub_lock_t *)user_lock) == UNLOCKED ) {
930  // TODO: Issue an error.
931  }; // if
932  (*((int *)user_lock))--;
933  #else
934  __kmpc_unset_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
935  #endif
936 }
937 
938 int FTN_STDCALL
939 xexpand(FTN_TEST_LOCK)( void **user_lock )
940 {
941  #ifdef KMP_STUB
942  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
943  // TODO: Issue an error.
944  }; // if
945  if ( *((kmp_stub_lock_t *)user_lock) == LOCKED ) {
946  return 0;
947  }; // if
948  *((kmp_stub_lock_t *)user_lock) = LOCKED;
949  return 1;
950  #else
951  return __kmpc_test_lock( NULL, __kmp_entry_gtid(), user_lock );
952  #endif
953 }
954 
955 int FTN_STDCALL
956 xexpand(FTN_TEST_NEST_LOCK)( void **user_lock )
957 {
958  #ifdef KMP_STUB
959  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
960  // TODO: Issue an error.
961  }; // if
962  return ++(*((int *)user_lock));
963  #else
964  return __kmpc_test_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
965  #endif
966 }
967 
968 double FTN_STDCALL
969 xexpand(FTN_GET_WTIME)( void )
970 {
971  #ifdef KMP_STUB
972  return __kmps_get_wtime();
973  #else
974  double data;
975  #if ! KMP_OS_LINUX
976  // We don't need library initialization to get the time on Linux* OS.
977  // The routine can be used to measure library initialization time on Linux* OS now.
978  if ( ! __kmp_init_serial ) {
979  __kmp_serial_initialize();
980  };
981  #endif
982  __kmp_elapsed( & data );
983  return data;
984  #endif
985 }
986 
987 double FTN_STDCALL
988 xexpand(FTN_GET_WTICK)( void )
989 {
990  #ifdef KMP_STUB
991  return __kmps_get_wtick();
992  #else
993  double data;
994  if ( ! __kmp_init_serial ) {
995  __kmp_serial_initialize();
996  };
997  __kmp_elapsed_tick( & data );
998  return data;
999  #endif
1000 }
1001 
1002 /* ------------------------------------------------------------------------ */
1003 
1004 void * FTN_STDCALL
1005 FTN_MALLOC( size_t KMP_DEREF size )
1006 {
1007  // kmpc_malloc initializes the library if needed
1008  return kmpc_malloc( KMP_DEREF size );
1009 }
1010 
1011 void * FTN_STDCALL
1012 FTN_CALLOC( size_t KMP_DEREF nelem, size_t KMP_DEREF elsize )
1013 {
1014  // kmpc_calloc initializes the library if needed
1015  return kmpc_calloc( KMP_DEREF nelem, KMP_DEREF elsize );
1016 }
1017 
1018 void * FTN_STDCALL
1019 FTN_REALLOC( void * KMP_DEREF ptr, size_t KMP_DEREF size )
1020 {
1021  // kmpc_realloc initializes the library if needed
1022  return kmpc_realloc( KMP_DEREF ptr, KMP_DEREF size );
1023 }
1024 
1025 void FTN_STDCALL
1026 FTN_FREE( void * KMP_DEREF ptr )
1027 {
1028  // does nothing if the library is not initialized
1029  kmpc_free( KMP_DEREF ptr );
1030 }
1031 
1032 void FTN_STDCALL
1033 FTN_SET_WARNINGS_ON( void )
1034 {
1035  #ifndef KMP_STUB
1036  __kmp_generate_warnings = kmp_warnings_explicit;
1037  #endif
1038 }
1039 
1040 void FTN_STDCALL
1041 FTN_SET_WARNINGS_OFF( void )
1042 {
1043  #ifndef KMP_STUB
1044  __kmp_generate_warnings = FALSE;
1045  #endif
1046 }
1047 
1048 void FTN_STDCALL
1049 FTN_SET_DEFAULTS( char const * str
1050  #ifndef PASS_ARGS_BY_VALUE
1051  , int len
1052  #endif
1053 )
1054 {
1055  #ifndef KMP_STUB
1056  #ifdef PASS_ARGS_BY_VALUE
1057  int len = (int)KMP_STRLEN( str );
1058  #endif
1059  __kmp_aux_set_defaults( str, len );
1060  #endif
1061 }
1062 
1063 /* ------------------------------------------------------------------------ */
1064 
1065 
1066 #if OMP_40_ENABLED
1067 /* returns the status of cancellation */
1068 int FTN_STDCALL
1069 xexpand(FTN_GET_CANCELLATION)(void) {
1070 #ifdef KMP_STUB
1071  return 0 /* false */;
1072 #else
1073  // initialize the library if needed
1074  if ( ! __kmp_init_serial ) {
1075  __kmp_serial_initialize();
1076  }
1077  return __kmp_omp_cancellation;
1078 #endif
1079 }
1080 
1081 int FTN_STDCALL
1082 FTN_GET_CANCELLATION_STATUS(int cancel_kind) {
1083 #ifdef KMP_STUB
1084  return 0 /* false */;
1085 #else
1086  return __kmp_get_cancellation_status(cancel_kind);
1087 #endif
1088 }
1089 
1090 #endif // OMP_40_ENABLED
1091 
1092 // GCC compatibility (versioned symbols)
1093 #ifdef KMP_USE_VERSION_SYMBOLS
1094 
1095 /*
1096  These following sections create function aliases (dummy symbols) for the omp_* routines.
1097  These aliases will then be versioned according to how libgomp ``versions'' its
1098  symbols (OMP_1.0, OMP_2.0, OMP_3.0, ...) while also retaining the
1099  default version which libomp uses: VERSION (defined in exports_so.txt)
1100  If you want to see the versioned symbols for libgomp.so.1 then just type:
1101 
1102  objdump -T /path/to/libgomp.so.1 | grep omp_
1103 
1104  Example:
1105  Step 1) Create __kmp_api_omp_set_num_threads_10_alias
1106  which is alias of __kmp_api_omp_set_num_threads
1107  Step 2) Set __kmp_api_omp_set_num_threads_10_alias to version: omp_set_num_threads@OMP_1.0
1108  Step 2B) Set __kmp_api_omp_set_num_threads to default version : omp_set_num_threads@@VERSION
1109 */
1110 
1111 // OMP_1.0 aliases
1112 xaliasify(FTN_SET_NUM_THREADS, 10);
1113 xaliasify(FTN_GET_NUM_THREADS, 10);
1114 xaliasify(FTN_GET_MAX_THREADS, 10);
1115 xaliasify(FTN_GET_THREAD_NUM, 10);
1116 xaliasify(FTN_GET_NUM_PROCS, 10);
1117 xaliasify(FTN_IN_PARALLEL, 10);
1118 xaliasify(FTN_SET_DYNAMIC, 10);
1119 xaliasify(FTN_GET_DYNAMIC, 10);
1120 xaliasify(FTN_SET_NESTED, 10);
1121 xaliasify(FTN_GET_NESTED, 10);
1122 xaliasify(FTN_INIT_LOCK, 10);
1123 xaliasify(FTN_INIT_NEST_LOCK, 10);
1124 xaliasify(FTN_DESTROY_LOCK, 10);
1125 xaliasify(FTN_DESTROY_NEST_LOCK, 10);
1126 xaliasify(FTN_SET_LOCK, 10);
1127 xaliasify(FTN_SET_NEST_LOCK, 10);
1128 xaliasify(FTN_UNSET_LOCK, 10);
1129 xaliasify(FTN_UNSET_NEST_LOCK, 10);
1130 xaliasify(FTN_TEST_LOCK, 10);
1131 xaliasify(FTN_TEST_NEST_LOCK, 10);
1132 
1133 // OMP_2.0 aliases
1134 xaliasify(FTN_GET_WTICK, 20);
1135 xaliasify(FTN_GET_WTIME, 20);
1136 
1137 // OMP_3.0 aliases
1138 xaliasify(FTN_SET_SCHEDULE, 30);
1139 xaliasify(FTN_GET_SCHEDULE, 30);
1140 xaliasify(FTN_GET_THREAD_LIMIT, 30);
1141 xaliasify(FTN_SET_MAX_ACTIVE_LEVELS, 30);
1142 xaliasify(FTN_GET_MAX_ACTIVE_LEVELS, 30);
1143 xaliasify(FTN_GET_LEVEL, 30);
1144 xaliasify(FTN_GET_ANCESTOR_THREAD_NUM, 30);
1145 xaliasify(FTN_GET_TEAM_SIZE, 30);
1146 xaliasify(FTN_GET_ACTIVE_LEVEL, 30);
1147 xaliasify(FTN_INIT_LOCK, 30);
1148 xaliasify(FTN_INIT_NEST_LOCK, 30);
1149 xaliasify(FTN_DESTROY_LOCK, 30);
1150 xaliasify(FTN_DESTROY_NEST_LOCK, 30);
1151 xaliasify(FTN_SET_LOCK, 30);
1152 xaliasify(FTN_SET_NEST_LOCK, 30);
1153 xaliasify(FTN_UNSET_LOCK, 30);
1154 xaliasify(FTN_UNSET_NEST_LOCK, 30);
1155 xaliasify(FTN_TEST_LOCK, 30);
1156 xaliasify(FTN_TEST_NEST_LOCK, 30);
1157 
1158 // OMP_3.1 aliases
1159 xaliasify(FTN_IN_FINAL, 31);
1160 
1161 #if OMP_40_ENABLED
1162 // OMP_4.0 aliases
1163 xaliasify(FTN_GET_PROC_BIND, 40);
1164 xaliasify(FTN_GET_NUM_TEAMS, 40);
1165 xaliasify(FTN_GET_TEAM_NUM, 40);
1166 xaliasify(FTN_GET_CANCELLATION, 40);
1167 xaliasify(FTN_IS_INITIAL_DEVICE, 40);
1168 #endif /* OMP_40_ENABLED */
1169 
1170 #if OMP_41_ENABLED
1171 // OMP_4.1 aliases
1172 #endif
1173 
1174 #if OMP_50_ENABLED
1175 // OMP_5.0 aliases
1176 #endif
1177 
1178 // OMP_1.0 versioned symbols
1179 xversionify(FTN_SET_NUM_THREADS, 10, "OMP_1.0");
1180 xversionify(FTN_GET_NUM_THREADS, 10, "OMP_1.0");
1181 xversionify(FTN_GET_MAX_THREADS, 10, "OMP_1.0");
1182 xversionify(FTN_GET_THREAD_NUM, 10, "OMP_1.0");
1183 xversionify(FTN_GET_NUM_PROCS, 10, "OMP_1.0");
1184 xversionify(FTN_IN_PARALLEL, 10, "OMP_1.0");
1185 xversionify(FTN_SET_DYNAMIC, 10, "OMP_1.0");
1186 xversionify(FTN_GET_DYNAMIC, 10, "OMP_1.0");
1187 xversionify(FTN_SET_NESTED, 10, "OMP_1.0");
1188 xversionify(FTN_GET_NESTED, 10, "OMP_1.0");
1189 xversionify(FTN_INIT_LOCK, 10, "OMP_1.0");
1190 xversionify(FTN_INIT_NEST_LOCK, 10, "OMP_1.0");
1191 xversionify(FTN_DESTROY_LOCK, 10, "OMP_1.0");
1192 xversionify(FTN_DESTROY_NEST_LOCK, 10, "OMP_1.0");
1193 xversionify(FTN_SET_LOCK, 10, "OMP_1.0");
1194 xversionify(FTN_SET_NEST_LOCK, 10, "OMP_1.0");
1195 xversionify(FTN_UNSET_LOCK, 10, "OMP_1.0");
1196 xversionify(FTN_UNSET_NEST_LOCK, 10, "OMP_1.0");
1197 xversionify(FTN_TEST_LOCK, 10, "OMP_1.0");
1198 xversionify(FTN_TEST_NEST_LOCK, 10, "OMP_1.0");
1199 
1200 // OMP_2.0 versioned symbols
1201 xversionify(FTN_GET_WTICK, 20, "OMP_2.0");
1202 xversionify(FTN_GET_WTIME, 20, "OMP_2.0");
1203 
1204 // OMP_3.0 versioned symbols
1205 xversionify(FTN_SET_SCHEDULE, 30, "OMP_3.0");
1206 xversionify(FTN_GET_SCHEDULE, 30, "OMP_3.0");
1207 xversionify(FTN_GET_THREAD_LIMIT, 30, "OMP_3.0");
1208 xversionify(FTN_SET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1209 xversionify(FTN_GET_MAX_ACTIVE_LEVELS, 30, "OMP_3.0");
1210 xversionify(FTN_GET_ANCESTOR_THREAD_NUM, 30, "OMP_3.0");
1211 xversionify(FTN_GET_LEVEL, 30, "OMP_3.0");
1212 xversionify(FTN_GET_TEAM_SIZE, 30, "OMP_3.0");
1213 xversionify(FTN_GET_ACTIVE_LEVEL, 30, "OMP_3.0");
1214 
1215 // the lock routines have a 1.0 and 3.0 version
1216 xversionify(FTN_INIT_LOCK, 30, "OMP_3.0");
1217 xversionify(FTN_INIT_NEST_LOCK, 30, "OMP_3.0");
1218 xversionify(FTN_DESTROY_LOCK, 30, "OMP_3.0");
1219 xversionify(FTN_DESTROY_NEST_LOCK, 30, "OMP_3.0");
1220 xversionify(FTN_SET_LOCK, 30, "OMP_3.0");
1221 xversionify(FTN_SET_NEST_LOCK, 30, "OMP_3.0");
1222 xversionify(FTN_UNSET_LOCK, 30, "OMP_3.0");
1223 xversionify(FTN_UNSET_NEST_LOCK, 30, "OMP_3.0");
1224 xversionify(FTN_TEST_LOCK, 30, "OMP_3.0");
1225 xversionify(FTN_TEST_NEST_LOCK, 30, "OMP_3.0");
1226 
1227 // OMP_3.1 versioned symbol
1228 xversionify(FTN_IN_FINAL, 31, "OMP_3.1");
1229 
1230 #if OMP_40_ENABLED
1231 // OMP_4.0 versioned symbols
1232 xversionify(FTN_GET_PROC_BIND, 40, "OMP_4.0");
1233 xversionify(FTN_GET_NUM_TEAMS, 40, "OMP_4.0");
1234 xversionify(FTN_GET_TEAM_NUM, 40, "OMP_4.0");
1235 xversionify(FTN_GET_CANCELLATION, 40, "OMP_4.0");
1236 xversionify(FTN_IS_INITIAL_DEVICE, 40, "OMP_4.0");
1237 #endif /* OMP_40_ENABLED */
1238 
1239 #if OMP_41_ENABLED
1240 // OMP_4.1 versioned symbols
1241 #endif
1242 
1243 #if OMP_50_ENABLED
1244 // OMP_5.0 versioned symbols
1245 #endif
1246 
1247 #endif // KMP_USE_VERSION_SYMBOLS
1248 
1249 #ifdef __cplusplus
1250  } //extern "C"
1251 #endif // __cplusplus
1252 
1253 // end of file //
KMP_EXPORT kmp_int32 __kmpc_bound_num_threads(ident_t *)
Definition: kmp_csupport.c:147