Intel® OpenMP* Runtime Library
 All Classes Functions Variables Typedefs Enumerations Enumerator Groups Pages
kmp_ftn_entry.h
1 /*
2  * kmp_ftn_entry.h -- Fortran entry linkage support for OpenMP.
3  * $Revision: 42507 $
4  * $Date: 2013-07-11 07:55:25 -0500 (Thu, 11 Jul 2013) $
5  */
6 
7 /* <copyright>
8  Copyright (c) 1997-2013 Intel Corporation. All Rights Reserved.
9 
10  Redistribution and use in source and binary forms, with or without
11  modification, are permitted provided that the following conditions
12  are met:
13 
14  * Redistributions of source code must retain the above copyright
15  notice, this list of conditions and the following disclaimer.
16  * Redistributions in binary form must reproduce the above copyright
17  notice, this list of conditions and the following disclaimer in the
18  documentation and/or other materials provided with the distribution.
19  * Neither the name of Intel Corporation nor the names of its
20  contributors may be used to endorse or promote products derived
21  from this software without specific prior written permission.
22 
23  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
24  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
25  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
26  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
27  HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
28  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
29  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
30  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
31  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
32  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
33  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34 
35 </copyright> */
36 
37 #ifndef FTN_STDCALL
38 # error The support file kmp_ftn_entry.h should not be compiled by itself.
39 #endif
40 
41 #ifdef KMP_STUB
42  #include "kmp_stub.h"
43 #endif
44 
45 #include "kmp_i18n.h"
46 
47 #ifdef __cplusplus
48  extern "C" {
49 #endif // __cplusplus
50 
51 /*
52  * For compatiblity with the Gnu/MS Open MP codegen, omp_set_num_threads(),
53  * omp_set_nested(), and omp_set_dynamic() [in lowercase on MS, and w/o
54  * a trailing underscore on Linux* OS] take call by value integer arguments.
55  * + omp_set_max_active_levels()
56  * + omp_set_schedule()
57  *
58  * For backward compatiblity with 9.1 and previous Intel compiler, these
59  * entry points take call by reference integer arguments.
60  */
61 #ifdef KMP_GOMP_COMPAT
62 # if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_UPPER)
63 # define PASS_ARGS_BY_VALUE 1
64 # endif
65 #endif
66 #if KMP_OS_WINDOWS
67 # if (KMP_FTN_ENTRIES == KMP_FTN_PLAIN) || (KMP_FTN_ENTRIES == KMP_FTN_APPEND)
68 # define PASS_ARGS_BY_VALUE 1
69 # endif
70 #endif
71 
72 // This macro helps to reduce code duplication.
73 #ifdef PASS_ARGS_BY_VALUE
74  #define KMP_DEREF
75 #else
76  #define KMP_DEREF *
77 #endif
78 
79 void FTN_STDCALL
80 FTN_SET_STACKSIZE( int KMP_DEREF arg )
81 {
82  #ifdef KMP_STUB
83  __kmps_set_stacksize( KMP_DEREF arg );
84  #else
85  // __kmp_aux_set_stacksize initializes the library if needed
86  __kmp_aux_set_stacksize( (size_t) KMP_DEREF arg );
87  #endif
88 }
89 
90 void FTN_STDCALL
91 FTN_SET_STACKSIZE_S( size_t KMP_DEREF arg )
92 {
93  #ifdef KMP_STUB
94  __kmps_set_stacksize( KMP_DEREF arg );
95  #else
96  // __kmp_aux_set_stacksize initializes the library if needed
97  __kmp_aux_set_stacksize( KMP_DEREF arg );
98  #endif
99 }
100 
101 int FTN_STDCALL
102 FTN_GET_STACKSIZE( void )
103 {
104  #ifdef KMP_STUB
105  return __kmps_get_stacksize();
106  #else
107  if ( ! __kmp_init_serial ) {
108  __kmp_serial_initialize();
109  };
110  return (int)__kmp_stksize;
111  #endif
112 }
113 
114 size_t FTN_STDCALL
115 FTN_GET_STACKSIZE_S( void )
116 {
117  #ifdef KMP_STUB
118  return __kmps_get_stacksize();
119  #else
120  if ( ! __kmp_init_serial ) {
121  __kmp_serial_initialize();
122  };
123  return __kmp_stksize;
124  #endif
125 }
126 
127 void FTN_STDCALL
128 FTN_SET_BLOCKTIME( int KMP_DEREF arg )
129 {
130  #ifdef KMP_STUB
131  __kmps_set_blocktime( KMP_DEREF arg );
132  #else
133  int gtid, tid;
134  kmp_info_t *thread;
135 
136  gtid = __kmp_entry_gtid();
137  tid = __kmp_tid_from_gtid(gtid);
138  thread = __kmp_thread_from_gtid(gtid);
139 
140  __kmp_aux_set_blocktime( KMP_DEREF arg, thread, tid );
141  #endif
142 }
143 
144 int FTN_STDCALL
145 FTN_GET_BLOCKTIME( void )
146 {
147  #ifdef KMP_STUB
148  return __kmps_get_blocktime();
149  #else
150  int gtid, tid;
151  kmp_info_t *thread;
152  kmp_team_p *team;
153 
154  gtid = __kmp_entry_gtid();
155  tid = __kmp_tid_from_gtid(gtid);
156  thread = __kmp_thread_from_gtid(gtid);
157  team = __kmp_threads[ gtid ] -> th.th_team;
158 
159  /* These must match the settings used in __kmp_wait_sleep() */
160  if ( __kmp_dflt_blocktime == KMP_MAX_BLOCKTIME ) {
161  KF_TRACE(10, ( "kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n",
162  gtid, team->t.t_id, tid, KMP_MAX_BLOCKTIME) );
163  return KMP_MAX_BLOCKTIME;
164  }
165 #ifdef KMP_ADJUST_BLOCKTIME
166  else if ( __kmp_zero_bt && !get__bt_set( team, tid ) ) {
167  KF_TRACE(10, ( "kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n",
168  gtid, team->t.t_id, tid, 0) );
169  return 0;
170  }
171 #endif /* KMP_ADJUST_BLOCKTIME */
172  else {
173  KF_TRACE(10, ( "kmp_get_blocktime: T#%d(%d:%d), blocktime=%d\n",
174  gtid, team->t.t_id, tid, get__blocktime( team, tid ) ) );
175  return get__blocktime( team, tid );
176  };
177  #endif
178 }
179 
180 void FTN_STDCALL
181 FTN_SET_LIBRARY_SERIAL( void )
182 {
183  #ifdef KMP_STUB
184  __kmps_set_library( library_serial );
185  #else
186  // __kmp_user_set_library initializes the library if needed
187  __kmp_user_set_library( library_serial );
188  #endif
189 }
190 
191 void FTN_STDCALL
192 FTN_SET_LIBRARY_TURNAROUND( void )
193 {
194  #ifdef KMP_STUB
195  __kmps_set_library( library_turnaround );
196  #else
197  // __kmp_user_set_library initializes the library if needed
198  __kmp_user_set_library( library_turnaround );
199  #endif
200 }
201 
202 void FTN_STDCALL
203 FTN_SET_LIBRARY_THROUGHPUT( void )
204 {
205  #ifdef KMP_STUB
206  __kmps_set_library( library_throughput );
207  #else
208  // __kmp_user_set_library initializes the library if needed
209  __kmp_user_set_library( library_throughput );
210  #endif
211 }
212 
213 void FTN_STDCALL
214 FTN_SET_LIBRARY( int KMP_DEREF arg )
215 {
216  #ifdef KMP_STUB
217  __kmps_set_library( KMP_DEREF arg );
218  #else
219  enum library_type lib;
220  lib = (enum library_type) KMP_DEREF arg;
221  // __kmp_user_set_library initializes the library if needed
222  __kmp_user_set_library( lib );
223  #endif
224 }
225 
226 int FTN_STDCALL
227 FTN_GET_LIBRARY (void)
228 {
229  #ifdef KMP_STUB
230  return __kmps_get_library();
231  #else
232  if ( ! __kmp_init_serial ) {
233  __kmp_serial_initialize();
234  }
235  return ((int) __kmp_library);
236  #endif
237 }
238 
239 #if OMP_30_ENABLED
240 
241 int FTN_STDCALL
242 FTN_SET_AFFINITY( void **mask )
243 {
244  #if defined(KMP_STUB) || !(KMP_OS_WINDOWS || KMP_OS_LINUX)
245  return -1;
246  #else
247  if ( ! TCR_4(__kmp_init_middle) ) {
248  __kmp_middle_initialize();
249  }
250  return __kmp_aux_set_affinity( mask );
251  #endif
252 }
253 
254 int FTN_STDCALL
255 FTN_GET_AFFINITY( void **mask )
256 {
257  #if defined(KMP_STUB) || !(KMP_OS_WINDOWS || KMP_OS_LINUX)
258  return -1;
259  #else
260  if ( ! TCR_4(__kmp_init_middle) ) {
261  __kmp_middle_initialize();
262  }
263  return __kmp_aux_get_affinity( mask );
264  #endif
265 }
266 
267 int FTN_STDCALL
268 FTN_GET_AFFINITY_MAX_PROC( void )
269 {
270  #if defined(KMP_STUB) || !(KMP_OS_WINDOWS || KMP_OS_LINUX)
271  return 0;
272  #else
273  //
274  // We really only NEED serial initialization here.
275  //
276  if ( ! TCR_4(__kmp_init_middle) ) {
277  __kmp_middle_initialize();
278  }
279  if ( ! ( KMP_AFFINITY_CAPABLE() ) ) {
280  return 0;
281  }
282 
283  #if KMP_OS_WINDOWS && KMP_ARCH_X86_64
284  if ( __kmp_num_proc_groups <= 1 ) {
285  return KMP_CPU_SETSIZE;
286  }
287  #endif /* KMP_OS_WINDOWS && KMP_ARCH_X86_64 */
288  return __kmp_xproc;
289  #endif
290 }
291 
292 void FTN_STDCALL
293 FTN_CREATE_AFFINITY_MASK( void **mask )
294 {
295  #if defined(KMP_STUB) || !(KMP_OS_WINDOWS || KMP_OS_LINUX)
296  *mask = NULL;
297  #else
298  //
299  // We really only NEED serial initialization here.
300  //
301  if ( ! TCR_4(__kmp_init_middle) ) {
302  __kmp_middle_initialize();
303  }
304  *mask = kmpc_malloc( __kmp_affin_mask_size );
305  KMP_CPU_ZERO( (kmp_affin_mask_t *)(*mask) );
306  #endif
307 }
308 
309 void FTN_STDCALL
310 FTN_DESTROY_AFFINITY_MASK( void **mask )
311 {
312  #if defined(KMP_STUB) || !(KMP_OS_WINDOWS || KMP_OS_LINUX)
313  // Nothing
314  #else
315  //
316  // We really only NEED serial initialization here.
317  //
318  if ( ! TCR_4(__kmp_init_middle) ) {
319  __kmp_middle_initialize();
320  }
321  if ( __kmp_env_consistency_check ) {
322  if ( *mask == NULL ) {
323  KMP_FATAL( AffinityInvalidMask, "kmp_destroy_affinity_mask" );
324  }
325  }
326  kmpc_free( *mask );
327  *mask = NULL;
328  #endif
329 }
330 
331 int FTN_STDCALL
332 FTN_SET_AFFINITY_MASK_PROC( int KMP_DEREF proc, void **mask )
333 {
334  #if defined(KMP_STUB) || !(KMP_OS_WINDOWS || KMP_OS_LINUX)
335  return -1;
336  #else
337  if ( ! TCR_4(__kmp_init_middle) ) {
338  __kmp_middle_initialize();
339  }
340  return __kmp_aux_set_affinity_mask_proc( KMP_DEREF proc, mask );
341  #endif
342 }
343 
344 int FTN_STDCALL
345 FTN_UNSET_AFFINITY_MASK_PROC( int KMP_DEREF proc, void **mask )
346 {
347  #if defined(KMP_STUB) || !(KMP_OS_WINDOWS || KMP_OS_LINUX)
348  return -1;
349  #else
350  if ( ! TCR_4(__kmp_init_middle) ) {
351  __kmp_middle_initialize();
352  }
353  return __kmp_aux_unset_affinity_mask_proc( KMP_DEREF proc, mask );
354  #endif
355 }
356 
357 int FTN_STDCALL
358 FTN_GET_AFFINITY_MASK_PROC( int KMP_DEREF proc, void **mask )
359 {
360  #if defined(KMP_STUB) || !(KMP_OS_WINDOWS || KMP_OS_LINUX)
361  return -1;
362  #else
363  if ( ! TCR_4(__kmp_init_middle) ) {
364  __kmp_middle_initialize();
365  }
366  return __kmp_aux_get_affinity_mask_proc( KMP_DEREF proc, mask );
367  #endif
368 }
369 
370 #endif /* OMP_30_ENABLED */
371 
372 
373 /* ------------------------------------------------------------------------ */
374 
375 /* sets the requested number of threads for the next parallel region */
376 
377 void FTN_STDCALL
378 FTN_SET_NUM_THREADS( int KMP_DEREF arg )
379 {
380  #ifdef KMP_STUB
381  // Nothing.
382  #else
383  __kmp_set_num_threads( KMP_DEREF arg, __kmp_entry_gtid() );
384  #endif
385 }
386 
387 
388 /* returns the number of threads in current team */
389 int FTN_STDCALL
390 FTN_GET_NUM_THREADS( void )
391 {
392  #ifdef KMP_STUB
393  return 1;
394  #else
395  // __kmpc_bound_num_threads initializes the library if needed
396  return __kmpc_bound_num_threads(NULL);
397  #endif
398 }
399 
400 int FTN_STDCALL
401 FTN_GET_MAX_THREADS( void )
402 {
403  #ifdef KMP_STUB
404  return 1;
405  #else
406  int gtid;
407  kmp_info_t *thread;
408  if ( ! TCR_4(__kmp_init_middle) ) {
409  __kmp_middle_initialize();
410  }
411  gtid = __kmp_entry_gtid();
412  thread = __kmp_threads[ gtid ];
413  #if OMP_30_ENABLED
414  //return thread -> th.th_team -> t.t_current_task[ thread->th.th_info.ds.ds_tid ] -> icvs.nproc;
415  return thread -> th.th_current_task -> td_icvs.nproc;
416  #else
417  return thread -> th.th_team -> t.t_set_nproc[ thread->th.th_info.ds.ds_tid ];
418  #endif
419  #endif
420 }
421 
422 int FTN_STDCALL
423 FTN_GET_THREAD_NUM( void )
424 {
425  #ifdef KMP_STUB
426  return 0;
427  #else
428  int gtid;
429 
430  #if KMP_OS_DARWIN
431  gtid = __kmp_entry_gtid();
432  #elif KMP_OS_WINDOWS
433  if (!__kmp_init_parallel ||
434  (gtid = ((kmp_intptr_t)TlsGetValue( __kmp_gtid_threadprivate_key ))) == 0) {
435  // Either library isn't initialized or thread is not registered
436  // 0 is the correct TID in this case
437  return 0;
438  }
439  --gtid; // We keep (gtid+1) in TLS
440  #elif KMP_OS_LINUX
441  #ifdef KMP_TDATA_GTID
442  if ( __kmp_gtid_mode >= 3 ) {
443  if ((gtid = __kmp_gtid) == KMP_GTID_DNE) {
444  return 0;
445  }
446  } else {
447  #endif
448  if (!__kmp_init_parallel ||
449  (gtid = (kmp_intptr_t)(pthread_getspecific( __kmp_gtid_threadprivate_key ))) == 0) {
450  return 0;
451  }
452  --gtid;
453  #ifdef KMP_TDATA_GTID
454  }
455  #endif
456  #else
457  #error Unknown or unsupported OS
458  #endif
459 
460  return __kmp_tid_from_gtid( gtid );
461  #endif
462 }
463 
464 int FTN_STDCALL
465 FTN_GET_NUM_KNOWN_THREADS( void )
466 {
467  #ifdef KMP_STUB
468  return 1;
469  #else
470  if ( ! __kmp_init_serial ) {
471  __kmp_serial_initialize();
472  }
473  /* NOTE: this is not syncronized, so it can change at any moment */
474  /* NOTE: this number also includes threads preallocated in hot-teams */
475  return TCR_4(__kmp_nth);
476  #endif
477 }
478 
479 int FTN_STDCALL
480 FTN_GET_NUM_PROCS( void )
481 {
482  #ifdef KMP_STUB
483  return 1;
484  #else
485  int gtid;
486  if ( ! TCR_4(__kmp_init_middle) ) {
487  __kmp_middle_initialize();
488  }
489  return __kmp_avail_proc;
490  #endif
491 }
492 
493 void FTN_STDCALL
494 FTN_SET_NESTED( int KMP_DEREF flag )
495 {
496  #ifdef KMP_STUB
497  __kmps_set_nested( KMP_DEREF flag );
498  #else
499  kmp_info_t *thread;
500  /* For the thread-private internal controls implementation */
501  thread = __kmp_entry_thread();
502  __kmp_save_internal_controls( thread );
503  set__nested( thread, ( (KMP_DEREF flag) ? TRUE : FALSE ) );
504  #endif
505 }
506 
507 
508 int FTN_STDCALL
509 FTN_GET_NESTED( void )
510 {
511  #ifdef KMP_STUB
512  return __kmps_get_nested();
513  #else
514  kmp_info_t *thread;
515  thread = __kmp_entry_thread();
516  return get__nested( thread );
517  #endif
518 }
519 
520 void FTN_STDCALL
521 FTN_SET_DYNAMIC( int KMP_DEREF flag )
522 {
523  #ifdef KMP_STUB
524  __kmps_set_dynamic( KMP_DEREF flag ? TRUE : FALSE );
525  #else
526  kmp_info_t *thread;
527  /* For the thread-private implementation of the internal controls */
528  thread = __kmp_entry_thread();
529  // !!! What if foreign thread calls it?
530  __kmp_save_internal_controls( thread );
531  set__dynamic( thread, KMP_DEREF flag ? TRUE : FALSE );
532  #endif
533 }
534 
535 
536 int FTN_STDCALL
537 FTN_GET_DYNAMIC( void )
538 {
539  #ifdef KMP_STUB
540  return __kmps_get_dynamic();
541  #else
542  kmp_info_t *thread;
543  thread = __kmp_entry_thread();
544  return get__dynamic( thread );
545  #endif
546 }
547 
548 int FTN_STDCALL
549 FTN_IN_PARALLEL( void )
550 {
551  #ifdef KMP_STUB
552  return 0;
553  #else
554  kmp_info_t *th = __kmp_entry_thread();
555 #if OMP_40_ENABLED
556  if ( th->th.th_team_microtask ) {
557  // AC: r_in_parallel does not work inside teams construct
558  // where real parallel is inactive, but all threads have same root,
559  // so setting it in one team affects other teams.
560  // The solution is to use per-team nesting level
561  return ( th->th.th_team->t.t_active_level ? 1 : 0 );
562  }
563  else
564 #endif /* OMP_40_ENABLED */
565  return ( th->th.th_root->r.r_in_parallel ? FTN_TRUE : FTN_FALSE );
566  #endif
567 }
568 
569 #if OMP_30_ENABLED
570 
571 void FTN_STDCALL
572 FTN_SET_SCHEDULE( kmp_sched_t KMP_DEREF kind, int KMP_DEREF modifier )
573 {
574  #ifdef KMP_STUB
575  __kmps_set_schedule( KMP_DEREF kind, KMP_DEREF modifier );
576  #else
577  /* TO DO */
578  /* For the per-task implementation of the internal controls */
579  __kmp_set_schedule( __kmp_entry_gtid(), KMP_DEREF kind, KMP_DEREF modifier );
580  #endif
581 }
582 
583 void FTN_STDCALL
584 FTN_GET_SCHEDULE( kmp_sched_t * kind, int * modifier )
585 {
586  #ifdef KMP_STUB
587  __kmps_get_schedule( kind, modifier );
588  #else
589  /* TO DO */
590  /* For the per-task implementation of the internal controls */
591  __kmp_get_schedule( __kmp_entry_gtid(), kind, modifier );
592  #endif
593 }
594 
595 void FTN_STDCALL
596 FTN_SET_MAX_ACTIVE_LEVELS( int KMP_DEREF arg )
597 {
598  #ifdef KMP_STUB
599  // Nothing.
600  #else
601  /* TO DO */
602  /* We want per-task implementation of this internal control */
603  __kmp_set_max_active_levels( __kmp_entry_gtid(), KMP_DEREF arg );
604  #endif
605 }
606 
607 int FTN_STDCALL
608 FTN_GET_MAX_ACTIVE_LEVELS( void )
609 {
610  #ifdef KMP_STUB
611  return 0;
612  #else
613  /* TO DO */
614  /* We want per-task implementation of this internal control */
615  return __kmp_get_max_active_levels( __kmp_entry_gtid() );
616  #endif
617 }
618 
619 int FTN_STDCALL
620 FTN_GET_ACTIVE_LEVEL( void )
621 {
622  #ifdef KMP_STUB
623  return 0; // returns 0 if it is called from the sequential part of the program
624  #else
625  /* TO DO */
626  /* For the per-task implementation of the internal controls */
627  return __kmp_entry_thread() -> th.th_team -> t.t_active_level;
628  #endif
629 }
630 
631 int FTN_STDCALL
632 FTN_GET_LEVEL( void )
633 {
634  #ifdef KMP_STUB
635  return 0; // returns 0 if it is called from the sequential part of the program
636  #else
637  /* TO DO */
638  /* For the per-task implementation of the internal controls */
639  return __kmp_entry_thread() -> th.th_team -> t.t_level;
640  #endif
641 }
642 
643 int FTN_STDCALL
644 FTN_GET_ANCESTOR_THREAD_NUM( int KMP_DEREF level )
645 {
646  #ifdef KMP_STUB
647  return ( KMP_DEREF level ) ? ( -1 ) : ( 0 );
648  #else
649  return __kmp_get_ancestor_thread_num( __kmp_entry_gtid(), KMP_DEREF level );
650  #endif
651 }
652 
653 int FTN_STDCALL
654 FTN_GET_TEAM_SIZE( int KMP_DEREF level )
655 {
656  #ifdef KMP_STUB
657  return ( KMP_DEREF level ) ? ( -1 ) : ( 1 );
658  #else
659  return __kmp_get_team_size( __kmp_entry_gtid(), KMP_DEREF level );
660  #endif
661 }
662 
663 int FTN_STDCALL
664 FTN_GET_THREAD_LIMIT( void )
665 {
666  #ifdef KMP_STUB
667  return 1; // TO DO: clarify whether it returns 1 or 0?
668  #else
669  if ( ! __kmp_init_serial ) {
670  __kmp_serial_initialize();
671  };
672  /* global ICV */
673  return __kmp_max_nth;
674  #endif
675 }
676 
677 int FTN_STDCALL
678 FTN_IN_FINAL( void )
679 {
680  #ifdef KMP_STUB
681  return 0; // TO DO: clarify whether it returns 1 or 0?
682  #else
683  if ( ! TCR_4(__kmp_init_parallel) ) {
684  return 0;
685  }
686  return __kmp_entry_thread() -> th.th_current_task -> td_flags.final;
687  #endif
688 }
689 
690 #endif // OMP_30_ENABLED
691 
692 #if OMP_40_ENABLED
693 
694 
695 kmp_proc_bind_t FTN_STDCALL
696 FTN_GET_PROC_BIND( void )
697 {
698  #ifdef KMP_STUB
699  return __kmps_get_proc_bind();
700  #else
701  return get__proc_bind( __kmp_entry_thread() );
702  #endif
703 }
704 
705 int FTN_STDCALL
706 FTN_GET_NUM_TEAMS( void )
707 {
708  #ifdef KMP_STUB
709  return 1;
710  #else
711  kmp_info_t *thr = __kmp_entry_thread();
712  if ( thr->th.th_team_microtask ) {
713  kmp_team_t *team = thr->th.th_team;
714  int tlevel = thr->th.th_teams_level;
715  int ii = team->t.t_level; // the level of the teams construct
716  int dd = team -> t.t_serialized;
717  int level = tlevel + 1;
718  KMP_DEBUG_ASSERT( ii >= tlevel );
719  while( ii > level )
720  {
721  for( dd = team -> t.t_serialized; ( dd > 0 ) && ( ii > level ); dd--, ii-- )
722  {
723  }
724  if( team -> t.t_serialized && ( !dd ) ) {
725  team = team->t.t_parent;
726  continue;
727  }
728  if( ii > level ) {
729  team = team->t.t_parent;
730  ii--;
731  }
732  }
733  if ( dd > 1 ) {
734  return 1; // teams region is serialized ( 1 team of 1 thread ).
735  } else {
736  return team->t.t_parent->t.t_nproc;
737  }
738  } else {
739  return 1;
740  }
741  #endif
742 }
743 
744 int FTN_STDCALL
745 FTN_GET_TEAM_NUM( void )
746 {
747  #ifdef KMP_STUB
748  return 0;
749  #else
750  kmp_info_t *thr = __kmp_entry_thread();
751  if ( thr->th.th_team_microtask ) {
752  kmp_team_t *team = thr->th.th_team;
753  int tlevel = thr->th.th_teams_level; // the level of the teams construct
754  int ii = team->t.t_level;
755  int dd = team -> t.t_serialized;
756  int level = tlevel + 1;
757  KMP_DEBUG_ASSERT( ii >= tlevel );
758  while( ii > level )
759  {
760  for( dd = team -> t.t_serialized; ( dd > 0 ) && ( ii > level ); dd--, ii-- )
761  {
762  }
763  if( team -> t.t_serialized && ( !dd ) ) {
764  team = team->t.t_parent;
765  continue;
766  }
767  if( ii > level ) {
768  team = team->t.t_parent;
769  ii--;
770  }
771  }
772  if ( dd > 1 ) {
773  return 0; // teams region is serialized ( 1 team of 1 thread ).
774  } else {
775  return team->t.t_master_tid;
776  }
777  } else {
778  return 0;
779  }
780  #endif
781 }
782 
783 #if KMP_MIC || KMP_OS_DARWIN
784 
785 static int __kmp_default_device = 0;
786 
787 int FTN_STDCALL
788 FTN_GET_DEFAULT_DEVICE( void )
789 {
790  return __kmp_default_device;
791 }
792 
793 void FTN_STDCALL
794 FTN_SET_DEFAULT_DEVICE( int KMP_DEREF arg )
795 {
796  __kmp_default_device = KMP_DEREF arg;
797 }
798 
799 int FTN_STDCALL
800 FTN_GET_NUM_DEVICES( void )
801 {
802  return 0;
803 }
804 
805 #endif // KMP_MIC || KMP_OS_DARWIN
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 /* initialize the lock */
814 void FTN_STDCALL
815 FTN_INIT_LOCK( void **user_lock )
816 {
817  #ifdef KMP_STUB
818  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
819  #else
820  __kmpc_init_lock( NULL, __kmp_entry_gtid(), user_lock );
821  #endif
822 }
823 
824 /* initialize the lock */
825 void FTN_STDCALL
826 FTN_INIT_NEST_LOCK( void **user_lock )
827 {
828  #ifdef KMP_STUB
829  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
830  #else
831  __kmpc_init_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
832  #endif
833 }
834 
835 void FTN_STDCALL
836 FTN_DESTROY_LOCK( void **user_lock )
837 {
838  #ifdef KMP_STUB
839  *((kmp_stub_lock_t *)user_lock) = UNINIT;
840  #else
841  __kmpc_destroy_lock( NULL, __kmp_entry_gtid(), user_lock );
842  #endif
843 }
844 
845 void FTN_STDCALL
846 FTN_DESTROY_NEST_LOCK( void **user_lock )
847 {
848  #ifdef KMP_STUB
849  *((kmp_stub_lock_t *)user_lock) = UNINIT;
850  #else
851  __kmpc_destroy_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
852  #endif
853 }
854 
855 void FTN_STDCALL
856 FTN_SET_LOCK( void **user_lock )
857 {
858  #ifdef KMP_STUB
859  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
860  // TODO: Issue an error.
861  }; // if
862  if ( *((kmp_stub_lock_t *)user_lock) != UNLOCKED ) {
863  // TODO: Issue an error.
864  }; // if
865  *((kmp_stub_lock_t *)user_lock) = LOCKED;
866  #else
867  __kmpc_set_lock( NULL, __kmp_entry_gtid(), user_lock );
868  #endif
869 }
870 
871 void FTN_STDCALL
872 FTN_SET_NEST_LOCK( void **user_lock )
873 {
874  #ifdef KMP_STUB
875  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
876  // TODO: Issue an error.
877  }; // if
878  (*((int *)user_lock))++;
879  #else
880  __kmpc_set_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
881  #endif
882 }
883 
884 void FTN_STDCALL
885 FTN_UNSET_LOCK( void **user_lock )
886 {
887  #ifdef KMP_STUB
888  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
889  // TODO: Issue an error.
890  }; // if
891  if ( *((kmp_stub_lock_t *)user_lock) == UNLOCKED ) {
892  // TODO: Issue an error.
893  }; // if
894  *((kmp_stub_lock_t *)user_lock) = UNLOCKED;
895  #else
896  __kmpc_unset_lock( NULL, __kmp_entry_gtid(), user_lock );
897  #endif
898 }
899 
900 void FTN_STDCALL
901 FTN_UNSET_NEST_LOCK( void **user_lock )
902 {
903  #ifdef KMP_STUB
904  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
905  // TODO: Issue an error.
906  }; // if
907  if ( *((kmp_stub_lock_t *)user_lock) == UNLOCKED ) {
908  // TODO: Issue an error.
909  }; // if
910  (*((int *)user_lock))--;
911  #else
912  __kmpc_unset_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
913  #endif
914 }
915 
916 int FTN_STDCALL
917 FTN_TEST_LOCK( void **user_lock )
918 {
919  #ifdef KMP_STUB
920  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
921  // TODO: Issue an error.
922  }; // if
923  if ( *((kmp_stub_lock_t *)user_lock) == LOCKED ) {
924  return 0;
925  }; // if
926  *((kmp_stub_lock_t *)user_lock) = LOCKED;
927  return 1;
928  #else
929  return __kmpc_test_lock( NULL, __kmp_entry_gtid(), user_lock );
930  #endif
931 }
932 
933 int FTN_STDCALL
934 FTN_TEST_NEST_LOCK( void **user_lock )
935 {
936  #ifdef KMP_STUB
937  if ( *((kmp_stub_lock_t *)user_lock) == UNINIT ) {
938  // TODO: Issue an error.
939  }; // if
940  return ++(*((int *)user_lock));
941  #else
942  return __kmpc_test_nest_lock( NULL, __kmp_entry_gtid(), user_lock );
943  #endif
944 }
945 
946 double FTN_STDCALL
947 FTN_GET_WTIME( void )
948 {
949  #ifdef KMP_STUB
950  return __kmps_get_wtime();
951  #else
952  double data;
953  #if ! KMP_OS_LINUX
954  // We don't need library initialization to get the time on Linux* OS.
955  // The routine can be used to measure library initialization time on Linux* OS now.
956  if ( ! __kmp_init_serial ) {
957  __kmp_serial_initialize();
958  };
959  #endif
960  __kmp_elapsed( & data );
961  return data;
962  #endif
963 }
964 
965 double FTN_STDCALL
966 FTN_GET_WTICK( void )
967 {
968  #ifdef KMP_STUB
969  return __kmps_get_wtick();
970  #else
971  double data;
972  if ( ! __kmp_init_serial ) {
973  __kmp_serial_initialize();
974  };
975  __kmp_elapsed_tick( & data );
976  return data;
977  #endif
978 }
979 
980 /* ------------------------------------------------------------------------ */
981 
982 void * FTN_STDCALL
983 FTN_MALLOC( size_t KMP_DEREF size )
984 {
985  // kmpc_malloc initializes the library if needed
986  return kmpc_malloc( KMP_DEREF size );
987 }
988 
989 void * FTN_STDCALL
990 FTN_CALLOC( size_t KMP_DEREF nelem, size_t KMP_DEREF elsize )
991 {
992  // kmpc_calloc initializes the library if needed
993  return kmpc_calloc( KMP_DEREF nelem, KMP_DEREF elsize );
994 }
995 
996 void * FTN_STDCALL
997 FTN_REALLOC( void * KMP_DEREF ptr, size_t KMP_DEREF size )
998 {
999  // kmpc_realloc initializes the library if needed
1000  return kmpc_realloc( KMP_DEREF ptr, KMP_DEREF size );
1001 }
1002 
1003 void FTN_STDCALL
1004 FTN_FREE( void * KMP_DEREF ptr )
1005 {
1006  // does nothing if the library is not initialized
1007  kmpc_free( KMP_DEREF ptr );
1008 }
1009 
1010 void FTN_STDCALL
1011 FTN_SET_WARNINGS_ON( void )
1012 {
1013  #ifndef KMP_STUB
1014  __kmp_generate_warnings = kmp_warnings_explicit;
1015  #endif
1016 }
1017 
1018 void FTN_STDCALL
1019 FTN_SET_WARNINGS_OFF( void )
1020 {
1021  #ifndef KMP_STUB
1022  __kmp_generate_warnings = FALSE;
1023  #endif
1024 }
1025 
1026 void FTN_STDCALL
1027 FTN_SET_DEFAULTS( char const * str
1028  #ifndef PASS_ARGS_BY_VALUE
1029  , int len
1030  #endif
1031 )
1032 {
1033  #ifndef KMP_STUB
1034  #ifdef PASS_ARGS_BY_VALUE
1035  int len = strlen( str );
1036  #endif
1037  __kmp_aux_set_defaults( str, len );
1038  #endif
1039 }
1040 
1041 /* ------------------------------------------------------------------------ */
1042 
1043 
1044 #ifdef __cplusplus
1045  } //extern "C"
1046 #endif // __cplusplus
1047 
1048 // end of file //