1 /*
2  * kmp_csupport.cpp -- kfront linkage support for OpenMP.
3  */
4 
5 //===----------------------------------------------------------------------===//
6 //
7 //                     The LLVM Compiler Infrastructure
8 //
9 // This file is dual licensed under the MIT and the University of Illinois Open
10 // Source Licenses. See LICENSE.txt for details.
11 //
12 //===----------------------------------------------------------------------===//
13 
14 #include "omp.h" /* extern "C" declarations of user-visible routines */
15 #include "kmp.h"
16 #include "kmp_error.h"
17 #include "kmp_i18n.h"
18 #include "kmp_itt.h"
19 #include "kmp_lock.h"
20 #include "kmp_stats.h"
21 
22 #if OMPT_SUPPORT
23 #include "ompt-internal.h"
24 #include "ompt-specific.h"
25 #endif
26 
27 #define MAX_MESSAGE 512
28 
29 // flags will be used in future, e.g. to implement openmp_strict library
30 // restrictions
31 
32 /*!
33  * @ingroup STARTUP_SHUTDOWN
34  * @param loc   in   source location information
35  * @param flags in   for future use (currently ignored)
36  *
37  * Initialize the runtime library. This call is optional; if it is not made then
38  * it will be implicitly called by attempts to use other library functions.
39  */
40 void __kmpc_begin(ident_t *loc, kmp_int32 flags) {
41   // By default __kmpc_begin() is no-op.
42   char *env;
43   if ((env = getenv("KMP_INITIAL_THREAD_BIND")) != NULL &&
44       __kmp_str_match_true(env)) {
45     __kmp_middle_initialize();
46     KC_TRACE(10, ("__kmpc_begin: middle initialization called\n"));
47   } else if (__kmp_ignore_mppbeg() == FALSE) {
48     // By default __kmp_ignore_mppbeg() returns TRUE.
49     __kmp_internal_begin();
50     KC_TRACE(10, ("__kmpc_begin: called\n"));
51   }
52 }
53 
54 /*!
55  * @ingroup STARTUP_SHUTDOWN
56  * @param loc source location information
57  *
58  * Shutdown the runtime library. This is also optional, and even if called will
59  * not do anything unless the `KMP_IGNORE_MPPEND` environment variable is set to
60  * zero.
61  */
62 void __kmpc_end(ident_t *loc) {
63   // By default, __kmp_ignore_mppend() returns TRUE which makes __kmpc_end()
64   // call no-op. However, this can be overridden with KMP_IGNORE_MPPEND
65   // environment variable. If KMP_IGNORE_MPPEND is 0, __kmp_ignore_mppend()
66   // returns FALSE and __kmpc_end() will unregister this root (it can cause
67   // library shut down).
68   if (__kmp_ignore_mppend() == FALSE) {
69     KC_TRACE(10, ("__kmpc_end: called\n"));
70     KA_TRACE(30, ("__kmpc_end\n"));
71 
72     __kmp_internal_end_thread(-1);
73   }
74 }
75 
76 /*!
77 @ingroup THREAD_STATES
78 @param loc Source location information.
79 @return The global thread index of the active thread.
80 
81 This function can be called in any context.
82 
83 If the runtime has ony been entered at the outermost level from a
84 single (necessarily non-OpenMP<sup>*</sup>) thread, then the thread number is
85 that which would be returned by omp_get_thread_num() in the outermost
86 active parallel construct. (Or zero if there is no active parallel
87 construct, since the master thread is necessarily thread zero).
88 
89 If multiple non-OpenMP threads all enter an OpenMP construct then this
90 will be a unique thread identifier among all the threads created by
91 the OpenMP runtime (but the value cannote be defined in terms of
92 OpenMP thread ids returned by omp_get_thread_num()).
93 */
94 kmp_int32 __kmpc_global_thread_num(ident_t *loc) {
95   kmp_int32 gtid = __kmp_entry_gtid();
96 
97   KC_TRACE(10, ("__kmpc_global_thread_num: T#%d\n", gtid));
98 
99   return gtid;
100 }
101 
102 /*!
103 @ingroup THREAD_STATES
104 @param loc Source location information.
105 @return The number of threads under control of the OpenMP<sup>*</sup> runtime
106 
107 This function can be called in any context.
108 It returns the total number of threads under the control of the OpenMP runtime.
109 That is not a number that can be determined by any OpenMP standard calls, since
110 the library may be called from more than one non-OpenMP thread, and this
111 reflects the total over all such calls. Similarly the runtime maintains
112 underlying threads even when they are not active (since the cost of creating
113 and destroying OS threads is high), this call counts all such threads even if
114 they are not waiting for work.
115 */
116 kmp_int32 __kmpc_global_num_threads(ident_t *loc) {
117   KC_TRACE(10,
118            ("__kmpc_global_num_threads: num_threads = %d\n", __kmp_all_nth));
119 
120   return TCR_4(__kmp_all_nth);
121 }
122 
123 /*!
124 @ingroup THREAD_STATES
125 @param loc Source location information.
126 @return The thread number of the calling thread in the innermost active parallel
127 construct.
128 */
129 kmp_int32 __kmpc_bound_thread_num(ident_t *loc) {
130   KC_TRACE(10, ("__kmpc_bound_thread_num: called\n"));
131   return __kmp_tid_from_gtid(__kmp_entry_gtid());
132 }
133 
134 /*!
135 @ingroup THREAD_STATES
136 @param loc Source location information.
137 @return The number of threads in the innermost active parallel construct.
138 */
139 kmp_int32 __kmpc_bound_num_threads(ident_t *loc) {
140   KC_TRACE(10, ("__kmpc_bound_num_threads: called\n"));
141 
142   return __kmp_entry_thread()->th.th_team->t.t_nproc;
143 }
144 
145 /*!
146  * @ingroup DEPRECATED
147  * @param loc location description
148  *
149  * This function need not be called. It always returns TRUE.
150  */
151 kmp_int32 __kmpc_ok_to_fork(ident_t *loc) {
152 #ifndef KMP_DEBUG
153 
154   return TRUE;
155 
156 #else
157 
158   const char *semi2;
159   const char *semi3;
160   int line_no;
161 
162   if (__kmp_par_range == 0) {
163     return TRUE;
164   }
165   semi2 = loc->psource;
166   if (semi2 == NULL) {
167     return TRUE;
168   }
169   semi2 = strchr(semi2, ';');
170   if (semi2 == NULL) {
171     return TRUE;
172   }
173   semi2 = strchr(semi2 + 1, ';');
174   if (semi2 == NULL) {
175     return TRUE;
176   }
177   if (__kmp_par_range_filename[0]) {
178     const char *name = semi2 - 1;
179     while ((name > loc->psource) && (*name != '/') && (*name != ';')) {
180       name--;
181     }
182     if ((*name == '/') || (*name == ';')) {
183       name++;
184     }
185     if (strncmp(__kmp_par_range_filename, name, semi2 - name)) {
186       return __kmp_par_range < 0;
187     }
188   }
189   semi3 = strchr(semi2 + 1, ';');
190   if (__kmp_par_range_routine[0]) {
191     if ((semi3 != NULL) && (semi3 > semi2) &&
192         (strncmp(__kmp_par_range_routine, semi2 + 1, semi3 - semi2 - 1))) {
193       return __kmp_par_range < 0;
194     }
195   }
196   if (KMP_SSCANF(semi3 + 1, "%d", &line_no) == 1) {
197     if ((line_no >= __kmp_par_range_lb) && (line_no <= __kmp_par_range_ub)) {
198       return __kmp_par_range > 0;
199     }
200     return __kmp_par_range < 0;
201   }
202   return TRUE;
203 
204 #endif /* KMP_DEBUG */
205 }
206 
207 /*!
208 @ingroup THREAD_STATES
209 @param loc Source location information.
210 @return 1 if this thread is executing inside an active parallel region, zero if
211 not.
212 */
213 kmp_int32 __kmpc_in_parallel(ident_t *loc) {
214   return __kmp_entry_thread()->th.th_root->r.r_active;
215 }
216 
217 /*!
218 @ingroup PARALLEL
219 @param loc source location information
220 @param global_tid global thread number
221 @param num_threads number of threads requested for this parallel construct
222 
223 Set the number of threads to be used by the next fork spawned by this thread.
224 This call is only required if the parallel construct has a `num_threads` clause.
225 */
226 void __kmpc_push_num_threads(ident_t *loc, kmp_int32 global_tid,
227                              kmp_int32 num_threads) {
228   KA_TRACE(20, ("__kmpc_push_num_threads: enter T#%d num_threads=%d\n",
229                 global_tid, num_threads));
230 
231   __kmp_push_num_threads(loc, global_tid, num_threads);
232 }
233 
234 void __kmpc_pop_num_threads(ident_t *loc, kmp_int32 global_tid) {
235   KA_TRACE(20, ("__kmpc_pop_num_threads: enter\n"));
236 
237   /* the num_threads are automatically popped */
238 }
239 
240 #if OMP_40_ENABLED
241 
242 void __kmpc_push_proc_bind(ident_t *loc, kmp_int32 global_tid,
243                            kmp_int32 proc_bind) {
244   KA_TRACE(20, ("__kmpc_push_proc_bind: enter T#%d proc_bind=%d\n", global_tid,
245                 proc_bind));
246 
247   __kmp_push_proc_bind(loc, global_tid, (kmp_proc_bind_t)proc_bind);
248 }
249 
250 #endif /* OMP_40_ENABLED */
251 
252 /*!
253 @ingroup PARALLEL
254 @param loc  source location information
255 @param argc  total number of arguments in the ellipsis
256 @param microtask  pointer to callback routine consisting of outlined parallel
257 construct
258 @param ...  pointers to shared variables that aren't global
259 
260 Do the actual fork and call the microtask in the relevant number of threads.
261 */
262 void __kmpc_fork_call(ident_t *loc, kmp_int32 argc, kmpc_micro microtask, ...) {
263   int gtid = __kmp_entry_gtid();
264 
265 #if (KMP_STATS_ENABLED)
266   int inParallel = __kmpc_in_parallel(loc);
267   if (inParallel) {
268     KMP_COUNT_BLOCK(OMP_NESTED_PARALLEL);
269   } else {
270     KMP_COUNT_BLOCK(OMP_PARALLEL);
271   }
272 #endif
273 
274   // maybe to save thr_state is enough here
275   {
276     va_list ap;
277     va_start(ap, microtask);
278 
279 #if OMPT_SUPPORT
280     ompt_frame_t *ompt_frame;
281     if (ompt_enabled) {
282       kmp_info_t *master_th = __kmp_threads[gtid];
283       kmp_team_t *parent_team = master_th->th.th_team;
284       ompt_lw_taskteam_t *lwt = parent_team->t.ompt_serialized_team_info;
285       if (lwt)
286         ompt_frame = &(lwt->ompt_task_info.frame);
287       else {
288         int tid = __kmp_tid_from_gtid(gtid);
289         ompt_frame = &(
290             parent_team->t.t_implicit_task_taskdata[tid].ompt_task_info.frame);
291       }
292       ompt_frame->reenter_runtime_frame = __builtin_frame_address(1);
293     }
294 #endif
295 
296 #if INCLUDE_SSC_MARKS
297     SSC_MARK_FORKING();
298 #endif
299     __kmp_fork_call(loc, gtid, fork_context_intel, argc,
300 #if OMPT_SUPPORT
301                     VOLATILE_CAST(void *) microtask, // "unwrapped" task
302 #endif
303                     VOLATILE_CAST(microtask_t) microtask, // "wrapped" task
304                     VOLATILE_CAST(launch_t) __kmp_invoke_task_func,
305 /* TODO: revert workaround for Intel(R) 64 tracker #96 */
306 #if (KMP_ARCH_X86_64 || KMP_ARCH_ARM || KMP_ARCH_AARCH64) && KMP_OS_LINUX
307                     &ap
308 #else
309                     ap
310 #endif
311                     );
312 #if INCLUDE_SSC_MARKS
313     SSC_MARK_JOINING();
314 #endif
315     __kmp_join_call(loc, gtid
316 #if OMPT_SUPPORT
317                     ,
318                     fork_context_intel
319 #endif
320                     );
321 
322     va_end(ap);
323   }
324 }
325 
326 #if OMP_40_ENABLED
327 /*!
328 @ingroup PARALLEL
329 @param loc source location information
330 @param global_tid global thread number
331 @param num_teams number of teams requested for the teams construct
332 @param num_threads number of threads per team requested for the teams construct
333 
334 Set the number of teams to be used by the teams construct.
335 This call is only required if the teams construct has a `num_teams` clause
336 or a `thread_limit` clause (or both).
337 */
338 void __kmpc_push_num_teams(ident_t *loc, kmp_int32 global_tid,
339                            kmp_int32 num_teams, kmp_int32 num_threads) {
340   KA_TRACE(20,
341            ("__kmpc_push_num_teams: enter T#%d num_teams=%d num_threads=%d\n",
342             global_tid, num_teams, num_threads));
343 
344   __kmp_push_num_teams(loc, global_tid, num_teams, num_threads);
345 }
346 
347 /*!
348 @ingroup PARALLEL
349 @param loc  source location information
350 @param argc  total number of arguments in the ellipsis
351 @param microtask  pointer to callback routine consisting of outlined teams
352 construct
353 @param ...  pointers to shared variables that aren't global
354 
355 Do the actual fork and call the microtask in the relevant number of threads.
356 */
357 void __kmpc_fork_teams(ident_t *loc, kmp_int32 argc, kmpc_micro microtask,
358                        ...) {
359   int gtid = __kmp_entry_gtid();
360   kmp_info_t *this_thr = __kmp_threads[gtid];
361   va_list ap;
362   va_start(ap, microtask);
363 
364   KMP_COUNT_BLOCK(OMP_TEAMS);
365 
366   // remember teams entry point and nesting level
367   this_thr->th.th_teams_microtask = microtask;
368   this_thr->th.th_teams_level =
369       this_thr->th.th_team->t.t_level; // AC: can be >0 on host
370 
371 #if OMPT_SUPPORT
372   kmp_team_t *parent_team = this_thr->th.th_team;
373   int tid = __kmp_tid_from_gtid(gtid);
374   if (ompt_enabled) {
375     parent_team->t.t_implicit_task_taskdata[tid]
376         .ompt_task_info.frame.reenter_runtime_frame =
377         __builtin_frame_address(1);
378   }
379 #endif
380 
381   // check if __kmpc_push_num_teams called, set default number of teams
382   // otherwise
383   if (this_thr->th.th_teams_size.nteams == 0) {
384     __kmp_push_num_teams(loc, gtid, 0, 0);
385   }
386   KMP_DEBUG_ASSERT(this_thr->th.th_set_nproc >= 1);
387   KMP_DEBUG_ASSERT(this_thr->th.th_teams_size.nteams >= 1);
388   KMP_DEBUG_ASSERT(this_thr->th.th_teams_size.nth >= 1);
389 
390   __kmp_fork_call(loc, gtid, fork_context_intel, argc,
391 #if OMPT_SUPPORT
392                   VOLATILE_CAST(void *) microtask, // "unwrapped" task
393 #endif
394                   VOLATILE_CAST(microtask_t)
395                       __kmp_teams_master, // "wrapped" task
396                   VOLATILE_CAST(launch_t) __kmp_invoke_teams_master,
397 #if (KMP_ARCH_X86_64 || KMP_ARCH_ARM || KMP_ARCH_AARCH64) && KMP_OS_LINUX
398                   &ap
399 #else
400                   ap
401 #endif
402                   );
403   __kmp_join_call(loc, gtid
404 #if OMPT_SUPPORT
405                   ,
406                   fork_context_intel
407 #endif
408                   );
409 
410   this_thr->th.th_teams_microtask = NULL;
411   this_thr->th.th_teams_level = 0;
412   *(kmp_int64 *)(&this_thr->th.th_teams_size) = 0L;
413   va_end(ap);
414 }
415 #endif /* OMP_40_ENABLED */
416 
417 // I don't think this function should ever have been exported.
418 // The __kmpc_ prefix was misapplied.  I'm fairly certain that no generated
419 // openmp code ever called it, but it's been exported from the RTL for so
420 // long that I'm afraid to remove the definition.
421 int __kmpc_invoke_task_func(int gtid) { return __kmp_invoke_task_func(gtid); }
422 
423 /*!
424 @ingroup PARALLEL
425 @param loc  source location information
426 @param global_tid  global thread number
427 
428 Enter a serialized parallel construct. This interface is used to handle a
429 conditional parallel region, like this,
430 @code
431 #pragma omp parallel if (condition)
432 @endcode
433 when the condition is false.
434 */
435 void __kmpc_serialized_parallel(ident_t *loc, kmp_int32 global_tid) {
436   // The implementation is now in kmp_runtime.cpp so that it can share static
437   // functions with kmp_fork_call since the tasks to be done are similar in
438   // each case.
439   __kmp_serialized_parallel(loc, global_tid);
440 }
441 
442 /*!
443 @ingroup PARALLEL
444 @param loc  source location information
445 @param global_tid  global thread number
446 
447 Leave a serialized parallel construct.
448 */
449 void __kmpc_end_serialized_parallel(ident_t *loc, kmp_int32 global_tid) {
450   kmp_internal_control_t *top;
451   kmp_info_t *this_thr;
452   kmp_team_t *serial_team;
453 
454   KC_TRACE(10,
455            ("__kmpc_end_serialized_parallel: called by T#%d\n", global_tid));
456 
457   /* skip all this code for autopar serialized loops since it results in
458      unacceptable overhead */
459   if (loc != NULL && (loc->flags & KMP_IDENT_AUTOPAR))
460     return;
461 
462   // Not autopar code
463   if (!TCR_4(__kmp_init_parallel))
464     __kmp_parallel_initialize();
465 
466   this_thr = __kmp_threads[global_tid];
467   serial_team = this_thr->th.th_serial_team;
468 
469 #if OMP_45_ENABLED
470   kmp_task_team_t *task_team = this_thr->th.th_task_team;
471 
472   // we need to wait for the proxy tasks before finishing the thread
473   if (task_team != NULL && task_team->tt.tt_found_proxy_tasks)
474     __kmp_task_team_wait(this_thr, serial_team USE_ITT_BUILD_ARG(NULL));
475 #endif
476 
477   KMP_MB();
478   KMP_DEBUG_ASSERT(serial_team);
479   KMP_ASSERT(serial_team->t.t_serialized);
480   KMP_DEBUG_ASSERT(this_thr->th.th_team == serial_team);
481   KMP_DEBUG_ASSERT(serial_team != this_thr->th.th_root->r.r_root_team);
482   KMP_DEBUG_ASSERT(serial_team->t.t_threads);
483   KMP_DEBUG_ASSERT(serial_team->t.t_threads[0] == this_thr);
484 
485   /* If necessary, pop the internal control stack values and replace the team
486    * values */
487   top = serial_team->t.t_control_stack_top;
488   if (top && top->serial_nesting_level == serial_team->t.t_serialized) {
489     copy_icvs(&serial_team->t.t_threads[0]->th.th_current_task->td_icvs, top);
490     serial_team->t.t_control_stack_top = top->next;
491     __kmp_free(top);
492   }
493 
494   // if( serial_team -> t.t_serialized > 1 )
495   serial_team->t.t_level--;
496 
497   /* pop dispatch buffers stack */
498   KMP_DEBUG_ASSERT(serial_team->t.t_dispatch->th_disp_buffer);
499   {
500     dispatch_private_info_t *disp_buffer =
501         serial_team->t.t_dispatch->th_disp_buffer;
502     serial_team->t.t_dispatch->th_disp_buffer =
503         serial_team->t.t_dispatch->th_disp_buffer->next;
504     __kmp_free(disp_buffer);
505   }
506 
507   --serial_team->t.t_serialized;
508   if (serial_team->t.t_serialized == 0) {
509 
510 /* return to the parallel section */
511 
512 #if KMP_ARCH_X86 || KMP_ARCH_X86_64
513     if (__kmp_inherit_fp_control && serial_team->t.t_fp_control_saved) {
514       __kmp_clear_x87_fpu_status_word();
515       __kmp_load_x87_fpu_control_word(&serial_team->t.t_x87_fpu_control_word);
516       __kmp_load_mxcsr(&serial_team->t.t_mxcsr);
517     }
518 #endif /* KMP_ARCH_X86 || KMP_ARCH_X86_64 */
519 
520     this_thr->th.th_team = serial_team->t.t_parent;
521     this_thr->th.th_info.ds.ds_tid = serial_team->t.t_master_tid;
522 
523     /* restore values cached in the thread */
524     this_thr->th.th_team_nproc = serial_team->t.t_parent->t.t_nproc; /*  JPH */
525     this_thr->th.th_team_master =
526         serial_team->t.t_parent->t.t_threads[0]; /* JPH */
527     this_thr->th.th_team_serialized = this_thr->th.th_team->t.t_serialized;
528 
529     /* TODO the below shouldn't need to be adjusted for serialized teams */
530     this_thr->th.th_dispatch =
531         &this_thr->th.th_team->t.t_dispatch[serial_team->t.t_master_tid];
532 
533     __kmp_pop_current_task_from_thread(this_thr);
534 
535     KMP_ASSERT(this_thr->th.th_current_task->td_flags.executing == 0);
536     this_thr->th.th_current_task->td_flags.executing = 1;
537 
538     if (__kmp_tasking_mode != tskm_immediate_exec) {
539       // Copy the task team from the new child / old parent team to the thread.
540       this_thr->th.th_task_team =
541           this_thr->th.th_team->t.t_task_team[this_thr->th.th_task_state];
542       KA_TRACE(20,
543                ("__kmpc_end_serialized_parallel: T#%d restoring task_team %p / "
544                 "team %p\n",
545                 global_tid, this_thr->th.th_task_team, this_thr->th.th_team));
546     }
547   } else {
548     if (__kmp_tasking_mode != tskm_immediate_exec) {
549       KA_TRACE(20, ("__kmpc_end_serialized_parallel: T#%d decreasing nesting "
550                     "depth of serial team %p to %d\n",
551                     global_tid, serial_team, serial_team->t.t_serialized));
552     }
553   }
554 
555   if (__kmp_env_consistency_check)
556     __kmp_pop_parallel(global_tid, NULL);
557 }
558 
559 /*!
560 @ingroup SYNCHRONIZATION
561 @param loc  source location information.
562 
563 Execute <tt>flush</tt>. This is implemented as a full memory fence. (Though
564 depending on the memory ordering convention obeyed by the compiler
565 even that may not be necessary).
566 */
567 void __kmpc_flush(ident_t *loc) {
568   KC_TRACE(10, ("__kmpc_flush: called\n"));
569 
570   /* need explicit __mf() here since use volatile instead in library */
571   KMP_MB(); /* Flush all pending memory write invalidates.  */
572 
573 #if (KMP_ARCH_X86 || KMP_ARCH_X86_64)
574 #if KMP_MIC
575 // fence-style instructions do not exist, but lock; xaddl $0,(%rsp) can be used.
576 // We shouldn't need it, though, since the ABI rules require that
577 // * If the compiler generates NGO stores it also generates the fence
578 // * If users hand-code NGO stores they should insert the fence
579 // therefore no incomplete unordered stores should be visible.
580 #else
581   // C74404
582   // This is to address non-temporal store instructions (sfence needed).
583   // The clflush instruction is addressed either (mfence needed).
584   // Probably the non-temporal load monvtdqa instruction should also be
585   // addressed.
586   // mfence is a SSE2 instruction. Do not execute it if CPU is not SSE2.
587   if (!__kmp_cpuinfo.initialized) {
588     __kmp_query_cpuid(&__kmp_cpuinfo);
589   }
590   if (!__kmp_cpuinfo.sse2) {
591     // CPU cannot execute SSE2 instructions.
592   } else {
593 #if KMP_COMPILER_ICC
594     _mm_mfence();
595 #elif KMP_COMPILER_MSVC
596     MemoryBarrier();
597 #else
598     __sync_synchronize();
599 #endif // KMP_COMPILER_ICC
600   }
601 #endif // KMP_MIC
602 #elif (KMP_ARCH_ARM || KMP_ARCH_AARCH64 || KMP_ARCH_MIPS || KMP_ARCH_MIPS64)
603 // Nothing to see here move along
604 #elif KMP_ARCH_PPC64
605 // Nothing needed here (we have a real MB above).
606 #if KMP_OS_CNK
607   // The flushing thread needs to yield here; this prevents a
608   // busy-waiting thread from saturating the pipeline. flush is
609   // often used in loops like this:
610   // while (!flag) {
611   //   #pragma omp flush(flag)
612   // }
613   // and adding the yield here is good for at least a 10x speedup
614   // when running >2 threads per core (on the NAS LU benchmark).
615   __kmp_yield(TRUE);
616 #endif
617 #else
618 #error Unknown or unsupported architecture
619 #endif
620 }
621 
622 /* -------------------------------------------------------------------------- */
623 /*!
624 @ingroup SYNCHRONIZATION
625 @param loc source location information
626 @param global_tid thread id.
627 
628 Execute a barrier.
629 */
630 void __kmpc_barrier(ident_t *loc, kmp_int32 global_tid) {
631   KMP_COUNT_BLOCK(OMP_BARRIER);
632   KC_TRACE(10, ("__kmpc_barrier: called T#%d\n", global_tid));
633 
634   if (!TCR_4(__kmp_init_parallel))
635     __kmp_parallel_initialize();
636 
637   if (__kmp_env_consistency_check) {
638     if (loc == 0) {
639       KMP_WARNING(ConstructIdentInvalid); // ??? What does it mean for the user?
640     }
641 
642     __kmp_check_barrier(global_tid, ct_barrier, loc);
643   }
644 
645 #if OMPT_SUPPORT && OMPT_TRACE
646   ompt_frame_t *ompt_frame;
647   if (ompt_enabled) {
648     ompt_frame = __ompt_get_task_frame_internal(0);
649     if (ompt_frame->reenter_runtime_frame == NULL)
650       ompt_frame->reenter_runtime_frame = __builtin_frame_address(1);
651   }
652 #endif
653   __kmp_threads[global_tid]->th.th_ident = loc;
654   // TODO: explicit barrier_wait_id:
655   //   this function is called when 'barrier' directive is present or
656   //   implicit barrier at the end of a worksharing construct.
657   // 1) better to add a per-thread barrier counter to a thread data structure
658   // 2) set to 0 when a new team is created
659   // 4) no sync is required
660 
661   __kmp_barrier(bs_plain_barrier, global_tid, FALSE, 0, NULL, NULL);
662 #if OMPT_SUPPORT && OMPT_TRACE
663   if (ompt_enabled) {
664     ompt_frame->reenter_runtime_frame = NULL;
665   }
666 #endif
667 }
668 
669 /* The BARRIER for a MASTER section is always explicit   */
670 /*!
671 @ingroup WORK_SHARING
672 @param loc  source location information.
673 @param global_tid  global thread number .
674 @return 1 if this thread should execute the <tt>master</tt> block, 0 otherwise.
675 */
676 kmp_int32 __kmpc_master(ident_t *loc, kmp_int32 global_tid) {
677   int status = 0;
678 
679   KC_TRACE(10, ("__kmpc_master: called T#%d\n", global_tid));
680 
681   if (!TCR_4(__kmp_init_parallel))
682     __kmp_parallel_initialize();
683 
684   if (KMP_MASTER_GTID(global_tid)) {
685     KMP_COUNT_BLOCK(OMP_MASTER);
686     KMP_PUSH_PARTITIONED_TIMER(OMP_master);
687     status = 1;
688   }
689 
690 #if OMPT_SUPPORT && OMPT_TRACE
691   if (status) {
692     if (ompt_enabled && ompt_callbacks.ompt_callback(ompt_event_master_begin)) {
693       kmp_info_t *this_thr = __kmp_threads[global_tid];
694       kmp_team_t *team = this_thr->th.th_team;
695 
696       int tid = __kmp_tid_from_gtid(global_tid);
697       ompt_callbacks.ompt_callback(ompt_event_master_begin)(
698           team->t.ompt_team_info.parallel_id,
699           team->t.t_implicit_task_taskdata[tid].ompt_task_info.task_id);
700     }
701   }
702 #endif
703 
704   if (__kmp_env_consistency_check) {
705 #if KMP_USE_DYNAMIC_LOCK
706     if (status)
707       __kmp_push_sync(global_tid, ct_master, loc, NULL, 0);
708     else
709       __kmp_check_sync(global_tid, ct_master, loc, NULL, 0);
710 #else
711     if (status)
712       __kmp_push_sync(global_tid, ct_master, loc, NULL);
713     else
714       __kmp_check_sync(global_tid, ct_master, loc, NULL);
715 #endif
716   }
717 
718   return status;
719 }
720 
721 /*!
722 @ingroup WORK_SHARING
723 @param loc  source location information.
724 @param global_tid  global thread number .
725 
726 Mark the end of a <tt>master</tt> region. This should only be called by the
727 thread that executes the <tt>master</tt> region.
728 */
729 void __kmpc_end_master(ident_t *loc, kmp_int32 global_tid) {
730   KC_TRACE(10, ("__kmpc_end_master: called T#%d\n", global_tid));
731 
732   KMP_DEBUG_ASSERT(KMP_MASTER_GTID(global_tid));
733   KMP_POP_PARTITIONED_TIMER();
734 
735 #if OMPT_SUPPORT && OMPT_TRACE
736   kmp_info_t *this_thr = __kmp_threads[global_tid];
737   kmp_team_t *team = this_thr->th.th_team;
738   if (ompt_enabled && ompt_callbacks.ompt_callback(ompt_event_master_end)) {
739     int tid = __kmp_tid_from_gtid(global_tid);
740     ompt_callbacks.ompt_callback(ompt_event_master_end)(
741         team->t.ompt_team_info.parallel_id,
742         team->t.t_implicit_task_taskdata[tid].ompt_task_info.task_id);
743   }
744 #endif
745 
746   if (__kmp_env_consistency_check) {
747     if (global_tid < 0)
748       KMP_WARNING(ThreadIdentInvalid);
749 
750     if (KMP_MASTER_GTID(global_tid))
751       __kmp_pop_sync(global_tid, ct_master, loc);
752   }
753 }
754 
755 /*!
756 @ingroup WORK_SHARING
757 @param loc  source location information.
758 @param gtid  global thread number.
759 
760 Start execution of an <tt>ordered</tt> construct.
761 */
762 void __kmpc_ordered(ident_t *loc, kmp_int32 gtid) {
763   int cid = 0;
764   kmp_info_t *th;
765   KMP_DEBUG_ASSERT(__kmp_init_serial);
766 
767   KC_TRACE(10, ("__kmpc_ordered: called T#%d\n", gtid));
768 
769   if (!TCR_4(__kmp_init_parallel))
770     __kmp_parallel_initialize();
771 
772 #if USE_ITT_BUILD
773   __kmp_itt_ordered_prep(gtid);
774 // TODO: ordered_wait_id
775 #endif /* USE_ITT_BUILD */
776 
777   th = __kmp_threads[gtid];
778 
779 #if OMPT_SUPPORT && OMPT_TRACE
780   if (ompt_enabled) {
781     /* OMPT state update */
782     th->th.ompt_thread_info.wait_id = (uint64_t)loc;
783     th->th.ompt_thread_info.state = ompt_state_wait_ordered;
784 
785     /* OMPT event callback */
786     if (ompt_callbacks.ompt_callback(ompt_event_wait_ordered)) {
787       ompt_callbacks.ompt_callback(ompt_event_wait_ordered)(
788           th->th.ompt_thread_info.wait_id);
789     }
790   }
791 #endif
792 
793   if (th->th.th_dispatch->th_deo_fcn != 0)
794     (*th->th.th_dispatch->th_deo_fcn)(&gtid, &cid, loc);
795   else
796     __kmp_parallel_deo(&gtid, &cid, loc);
797 
798 #if OMPT_SUPPORT && OMPT_TRACE
799   if (ompt_enabled) {
800     /* OMPT state update */
801     th->th.ompt_thread_info.state = ompt_state_work_parallel;
802     th->th.ompt_thread_info.wait_id = 0;
803 
804     /* OMPT event callback */
805     if (ompt_callbacks.ompt_callback(ompt_event_acquired_ordered)) {
806       ompt_callbacks.ompt_callback(ompt_event_acquired_ordered)(
807           th->th.ompt_thread_info.wait_id);
808     }
809   }
810 #endif
811 
812 #if USE_ITT_BUILD
813   __kmp_itt_ordered_start(gtid);
814 #endif /* USE_ITT_BUILD */
815 }
816 
817 /*!
818 @ingroup WORK_SHARING
819 @param loc  source location information.
820 @param gtid  global thread number.
821 
822 End execution of an <tt>ordered</tt> construct.
823 */
824 void __kmpc_end_ordered(ident_t *loc, kmp_int32 gtid) {
825   int cid = 0;
826   kmp_info_t *th;
827 
828   KC_TRACE(10, ("__kmpc_end_ordered: called T#%d\n", gtid));
829 
830 #if USE_ITT_BUILD
831   __kmp_itt_ordered_end(gtid);
832 // TODO: ordered_wait_id
833 #endif /* USE_ITT_BUILD */
834 
835   th = __kmp_threads[gtid];
836 
837   if (th->th.th_dispatch->th_dxo_fcn != 0)
838     (*th->th.th_dispatch->th_dxo_fcn)(&gtid, &cid, loc);
839   else
840     __kmp_parallel_dxo(&gtid, &cid, loc);
841 
842 #if OMPT_SUPPORT && OMPT_BLAME
843   if (ompt_enabled &&
844       ompt_callbacks.ompt_callback(ompt_event_release_ordered)) {
845     ompt_callbacks.ompt_callback(ompt_event_release_ordered)(
846         th->th.ompt_thread_info.wait_id);
847   }
848 #endif
849 }
850 
851 #if KMP_USE_DYNAMIC_LOCK
852 
853 static __forceinline void
854 __kmp_init_indirect_csptr(kmp_critical_name *crit, ident_t const *loc,
855                           kmp_int32 gtid, kmp_indirect_locktag_t tag) {
856   // Pointer to the allocated indirect lock is written to crit, while indexing
857   // is ignored.
858   void *idx;
859   kmp_indirect_lock_t **lck;
860   lck = (kmp_indirect_lock_t **)crit;
861   kmp_indirect_lock_t *ilk = __kmp_allocate_indirect_lock(&idx, gtid, tag);
862   KMP_I_LOCK_FUNC(ilk, init)(ilk->lock);
863   KMP_SET_I_LOCK_LOCATION(ilk, loc);
864   KMP_SET_I_LOCK_FLAGS(ilk, kmp_lf_critical_section);
865   KA_TRACE(20,
866            ("__kmp_init_indirect_csptr: initialized indirect lock #%d\n", tag));
867 #if USE_ITT_BUILD
868   __kmp_itt_critical_creating(ilk->lock, loc);
869 #endif
870   int status = KMP_COMPARE_AND_STORE_PTR(lck, nullptr, ilk);
871   if (status == 0) {
872 #if USE_ITT_BUILD
873     __kmp_itt_critical_destroyed(ilk->lock);
874 #endif
875     // We don't really need to destroy the unclaimed lock here since it will be
876     // cleaned up at program exit.
877     // KMP_D_LOCK_FUNC(&idx, destroy)((kmp_dyna_lock_t *)&idx);
878   }
879   KMP_DEBUG_ASSERT(*lck != NULL);
880 }
881 
882 // Fast-path acquire tas lock
883 #define KMP_ACQUIRE_TAS_LOCK(lock, gtid)                                       \
884   {                                                                            \
885     kmp_tas_lock_t *l = (kmp_tas_lock_t *)lock;                                \
886     if (l->lk.poll != KMP_LOCK_FREE(tas) ||                                    \
887         !KMP_COMPARE_AND_STORE_ACQ32(&(l->lk.poll), KMP_LOCK_FREE(tas),        \
888                                      KMP_LOCK_BUSY(gtid + 1, tas))) {          \
889       kmp_uint32 spins;                                                        \
890       KMP_FSYNC_PREPARE(l);                                                    \
891       KMP_INIT_YIELD(spins);                                                   \
892       if (TCR_4(__kmp_nth) >                                                   \
893           (__kmp_avail_proc ? __kmp_avail_proc : __kmp_xproc)) {               \
894         KMP_YIELD(TRUE);                                                       \
895       } else {                                                                 \
896         KMP_YIELD_SPIN(spins);                                                 \
897       }                                                                        \
898       kmp_backoff_t backoff = __kmp_spin_backoff_params;                       \
899       while (l->lk.poll != KMP_LOCK_FREE(tas) ||                               \
900              !KMP_COMPARE_AND_STORE_ACQ32(&(l->lk.poll), KMP_LOCK_FREE(tas),   \
901                                           KMP_LOCK_BUSY(gtid + 1, tas))) {     \
902         __kmp_spin_backoff(&backoff);                                          \
903         if (TCR_4(__kmp_nth) >                                                 \
904             (__kmp_avail_proc ? __kmp_avail_proc : __kmp_xproc)) {             \
905           KMP_YIELD(TRUE);                                                     \
906         } else {                                                               \
907           KMP_YIELD_SPIN(spins);                                               \
908         }                                                                      \
909       }                                                                        \
910     }                                                                          \
911     KMP_FSYNC_ACQUIRED(l);                                                     \
912   }
913 
914 // Fast-path test tas lock
915 #define KMP_TEST_TAS_LOCK(lock, gtid, rc)                                      \
916   {                                                                            \
917     kmp_tas_lock_t *l = (kmp_tas_lock_t *)lock;                                \
918     rc = l->lk.poll == KMP_LOCK_FREE(tas) &&                                   \
919          KMP_COMPARE_AND_STORE_ACQ32(&(l->lk.poll), KMP_LOCK_FREE(tas),        \
920                                      KMP_LOCK_BUSY(gtid + 1, tas));            \
921   }
922 
923 // Fast-path release tas lock
924 #define KMP_RELEASE_TAS_LOCK(lock, gtid)                                       \
925   {                                                                            \
926     TCW_4(((kmp_tas_lock_t *)lock)->lk.poll, KMP_LOCK_FREE(tas));              \
927     KMP_MB();                                                                  \
928   }
929 
930 #if KMP_USE_FUTEX
931 
932 #include <sys/syscall.h>
933 #include <unistd.h>
934 #ifndef FUTEX_WAIT
935 #define FUTEX_WAIT 0
936 #endif
937 #ifndef FUTEX_WAKE
938 #define FUTEX_WAKE 1
939 #endif
940 
941 // Fast-path acquire futex lock
942 #define KMP_ACQUIRE_FUTEX_LOCK(lock, gtid)                                     \
943   {                                                                            \
944     kmp_futex_lock_t *ftx = (kmp_futex_lock_t *)lock;                          \
945     kmp_int32 gtid_code = (gtid + 1) << 1;                                     \
946     KMP_MB();                                                                  \
947     KMP_FSYNC_PREPARE(ftx);                                                    \
948     kmp_int32 poll_val;                                                        \
949     while ((poll_val = KMP_COMPARE_AND_STORE_RET32(                            \
950                 &(ftx->lk.poll), KMP_LOCK_FREE(futex),                         \
951                 KMP_LOCK_BUSY(gtid_code, futex))) != KMP_LOCK_FREE(futex)) {   \
952       kmp_int32 cond = KMP_LOCK_STRIP(poll_val) & 1;                           \
953       if (!cond) {                                                             \
954         if (!KMP_COMPARE_AND_STORE_RET32(&(ftx->lk.poll), poll_val,            \
955                                          poll_val |                            \
956                                              KMP_LOCK_BUSY(1, futex))) {       \
957           continue;                                                            \
958         }                                                                      \
959         poll_val |= KMP_LOCK_BUSY(1, futex);                                   \
960       }                                                                        \
961       kmp_int32 rc;                                                            \
962       if ((rc = syscall(__NR_futex, &(ftx->lk.poll), FUTEX_WAIT, poll_val,     \
963                         NULL, NULL, 0)) != 0) {                                \
964         continue;                                                              \
965       }                                                                        \
966       gtid_code |= 1;                                                          \
967     }                                                                          \
968     KMP_FSYNC_ACQUIRED(ftx);                                                   \
969   }
970 
971 // Fast-path test futex lock
972 #define KMP_TEST_FUTEX_LOCK(lock, gtid, rc)                                    \
973   {                                                                            \
974     kmp_futex_lock_t *ftx = (kmp_futex_lock_t *)lock;                          \
975     if (KMP_COMPARE_AND_STORE_ACQ32(&(ftx->lk.poll), KMP_LOCK_FREE(futex),     \
976                                     KMP_LOCK_BUSY(gtid + 1 << 1, futex))) {    \
977       KMP_FSYNC_ACQUIRED(ftx);                                                 \
978       rc = TRUE;                                                               \
979     } else {                                                                   \
980       rc = FALSE;                                                              \
981     }                                                                          \
982   }
983 
984 // Fast-path release futex lock
985 #define KMP_RELEASE_FUTEX_LOCK(lock, gtid)                                     \
986   {                                                                            \
987     kmp_futex_lock_t *ftx = (kmp_futex_lock_t *)lock;                          \
988     KMP_MB();                                                                  \
989     KMP_FSYNC_RELEASING(ftx);                                                  \
990     kmp_int32 poll_val =                                                       \
991         KMP_XCHG_FIXED32(&(ftx->lk.poll), KMP_LOCK_FREE(futex));               \
992     if (KMP_LOCK_STRIP(poll_val) & 1) {                                        \
993       syscall(__NR_futex, &(ftx->lk.poll), FUTEX_WAKE,                         \
994               KMP_LOCK_BUSY(1, futex), NULL, NULL, 0);                         \
995     }                                                                          \
996     KMP_MB();                                                                  \
997     KMP_YIELD(TCR_4(__kmp_nth) >                                               \
998               (__kmp_avail_proc ? __kmp_avail_proc : __kmp_xproc));            \
999   }
1000 
1001 #endif // KMP_USE_FUTEX
1002 
1003 #else // KMP_USE_DYNAMIC_LOCK
1004 
1005 static kmp_user_lock_p __kmp_get_critical_section_ptr(kmp_critical_name *crit,
1006                                                       ident_t const *loc,
1007                                                       kmp_int32 gtid) {
1008   kmp_user_lock_p *lck_pp = (kmp_user_lock_p *)crit;
1009 
1010   // Because of the double-check, the following load doesn't need to be volatile
1011   kmp_user_lock_p lck = (kmp_user_lock_p)TCR_PTR(*lck_pp);
1012 
1013   if (lck == NULL) {
1014     void *idx;
1015 
1016     // Allocate & initialize the lock.
1017     // Remember alloc'ed locks in table in order to free them in __kmp_cleanup()
1018     lck = __kmp_user_lock_allocate(&idx, gtid, kmp_lf_critical_section);
1019     __kmp_init_user_lock_with_checks(lck);
1020     __kmp_set_user_lock_location(lck, loc);
1021 #if USE_ITT_BUILD
1022     __kmp_itt_critical_creating(lck);
1023 // __kmp_itt_critical_creating() should be called *before* the first usage
1024 // of underlying lock. It is the only place where we can guarantee it. There
1025 // are chances the lock will destroyed with no usage, but it is not a
1026 // problem, because this is not real event seen by user but rather setting
1027 // name for object (lock). See more details in kmp_itt.h.
1028 #endif /* USE_ITT_BUILD */
1029 
1030     // Use a cmpxchg instruction to slam the start of the critical section with
1031     // the lock pointer.  If another thread beat us to it, deallocate the lock,
1032     // and use the lock that the other thread allocated.
1033     int status = KMP_COMPARE_AND_STORE_PTR(lck_pp, 0, lck);
1034 
1035     if (status == 0) {
1036 // Deallocate the lock and reload the value.
1037 #if USE_ITT_BUILD
1038       __kmp_itt_critical_destroyed(lck);
1039 // Let ITT know the lock is destroyed and the same memory location may be reused
1040 // for another purpose.
1041 #endif /* USE_ITT_BUILD */
1042       __kmp_destroy_user_lock_with_checks(lck);
1043       __kmp_user_lock_free(&idx, gtid, lck);
1044       lck = (kmp_user_lock_p)TCR_PTR(*lck_pp);
1045       KMP_DEBUG_ASSERT(lck != NULL);
1046     }
1047   }
1048   return lck;
1049 }
1050 
1051 #endif // KMP_USE_DYNAMIC_LOCK
1052 
1053 /*!
1054 @ingroup WORK_SHARING
1055 @param loc  source location information.
1056 @param global_tid  global thread number .
1057 @param crit identity of the critical section. This could be a pointer to a lock
1058 associated with the critical section, or some other suitably unique value.
1059 
1060 Enter code protected by a `critical` construct.
1061 This function blocks until the executing thread can enter the critical section.
1062 */
1063 void __kmpc_critical(ident_t *loc, kmp_int32 global_tid,
1064                      kmp_critical_name *crit) {
1065 #if KMP_USE_DYNAMIC_LOCK
1066   __kmpc_critical_with_hint(loc, global_tid, crit, omp_lock_hint_none);
1067 #else
1068   KMP_COUNT_BLOCK(OMP_CRITICAL);
1069   KMP_TIME_PARTITIONED_BLOCK(
1070       OMP_critical_wait); /* Time spent waiting to enter the critical section */
1071   kmp_user_lock_p lck;
1072 
1073   KC_TRACE(10, ("__kmpc_critical: called T#%d\n", global_tid));
1074 
1075   // TODO: add THR_OVHD_STATE
1076 
1077   KMP_CHECK_USER_LOCK_INIT();
1078 
1079   if ((__kmp_user_lock_kind == lk_tas) &&
1080       (sizeof(lck->tas.lk.poll) <= OMP_CRITICAL_SIZE)) {
1081     lck = (kmp_user_lock_p)crit;
1082   }
1083 #if KMP_USE_FUTEX
1084   else if ((__kmp_user_lock_kind == lk_futex) &&
1085            (sizeof(lck->futex.lk.poll) <= OMP_CRITICAL_SIZE)) {
1086     lck = (kmp_user_lock_p)crit;
1087   }
1088 #endif
1089   else { // ticket, queuing or drdpa
1090     lck = __kmp_get_critical_section_ptr(crit, loc, global_tid);
1091   }
1092 
1093   if (__kmp_env_consistency_check)
1094     __kmp_push_sync(global_tid, ct_critical, loc, lck);
1095 
1096 // since the critical directive binds to all threads, not just the current
1097 // team we have to check this even if we are in a serialized team.
1098 // also, even if we are the uber thread, we still have to conduct the lock,
1099 // as we have to contend with sibling threads.
1100 
1101 #if USE_ITT_BUILD
1102   __kmp_itt_critical_acquiring(lck);
1103 #endif /* USE_ITT_BUILD */
1104   // Value of 'crit' should be good for using as a critical_id of the critical
1105   // section directive.
1106   __kmp_acquire_user_lock_with_checks(lck, global_tid);
1107 
1108 #if USE_ITT_BUILD
1109   __kmp_itt_critical_acquired(lck);
1110 #endif /* USE_ITT_BUILD */
1111 
1112   KMP_START_EXPLICIT_TIMER(OMP_critical);
1113   KA_TRACE(15, ("__kmpc_critical: done T#%d\n", global_tid));
1114 #endif // KMP_USE_DYNAMIC_LOCK
1115 }
1116 
1117 #if KMP_USE_DYNAMIC_LOCK
1118 
1119 // Converts the given hint to an internal lock implementation
1120 static __forceinline kmp_dyna_lockseq_t __kmp_map_hint_to_lock(uintptr_t hint) {
1121 #if KMP_USE_TSX
1122 #define KMP_TSX_LOCK(seq) lockseq_##seq
1123 #else
1124 #define KMP_TSX_LOCK(seq) __kmp_user_lock_seq
1125 #endif
1126 
1127 #if KMP_ARCH_X86 || KMP_ARCH_X86_64
1128 #define KMP_CPUINFO_RTM (__kmp_cpuinfo.rtm)
1129 #else
1130 #define KMP_CPUINFO_RTM 0
1131 #endif
1132 
1133   // Hints that do not require further logic
1134   if (hint & kmp_lock_hint_hle)
1135     return KMP_TSX_LOCK(hle);
1136   if (hint & kmp_lock_hint_rtm)
1137     return KMP_CPUINFO_RTM ? KMP_TSX_LOCK(rtm) : __kmp_user_lock_seq;
1138   if (hint & kmp_lock_hint_adaptive)
1139     return KMP_CPUINFO_RTM ? KMP_TSX_LOCK(adaptive) : __kmp_user_lock_seq;
1140 
1141   // Rule out conflicting hints first by returning the default lock
1142   if ((hint & omp_lock_hint_contended) && (hint & omp_lock_hint_uncontended))
1143     return __kmp_user_lock_seq;
1144   if ((hint & omp_lock_hint_speculative) &&
1145       (hint & omp_lock_hint_nonspeculative))
1146     return __kmp_user_lock_seq;
1147 
1148   // Do not even consider speculation when it appears to be contended
1149   if (hint & omp_lock_hint_contended)
1150     return lockseq_queuing;
1151 
1152   // Uncontended lock without speculation
1153   if ((hint & omp_lock_hint_uncontended) && !(hint & omp_lock_hint_speculative))
1154     return lockseq_tas;
1155 
1156   // HLE lock for speculation
1157   if (hint & omp_lock_hint_speculative)
1158     return KMP_TSX_LOCK(hle);
1159 
1160   return __kmp_user_lock_seq;
1161 }
1162 
1163 /*!
1164 @ingroup WORK_SHARING
1165 @param loc  source location information.
1166 @param global_tid  global thread number.
1167 @param crit identity of the critical section. This could be a pointer to a lock
1168 associated with the critical section, or some other suitably unique value.
1169 @param hint the lock hint.
1170 
1171 Enter code protected by a `critical` construct with a hint. The hint value is
1172 used to suggest a lock implementation. This function blocks until the executing
1173 thread can enter the critical section unless the hint suggests use of
1174 speculative execution and the hardware supports it.
1175 */
1176 void __kmpc_critical_with_hint(ident_t *loc, kmp_int32 global_tid,
1177                                kmp_critical_name *crit, uintptr_t hint) {
1178   KMP_COUNT_BLOCK(OMP_CRITICAL);
1179   kmp_user_lock_p lck;
1180 
1181   KC_TRACE(10, ("__kmpc_critical: called T#%d\n", global_tid));
1182 
1183   kmp_dyna_lock_t *lk = (kmp_dyna_lock_t *)crit;
1184   // Check if it is initialized.
1185   if (*lk == 0) {
1186     kmp_dyna_lockseq_t lckseq = __kmp_map_hint_to_lock(hint);
1187     if (KMP_IS_D_LOCK(lckseq)) {
1188       KMP_COMPARE_AND_STORE_ACQ32((volatile kmp_int32 *)crit, 0,
1189                                   KMP_GET_D_TAG(lckseq));
1190     } else {
1191       __kmp_init_indirect_csptr(crit, loc, global_tid, KMP_GET_I_TAG(lckseq));
1192     }
1193   }
1194   // Branch for accessing the actual lock object and set operation. This
1195   // branching is inevitable since this lock initialization does not follow the
1196   // normal dispatch path (lock table is not used).
1197   if (KMP_EXTRACT_D_TAG(lk) != 0) {
1198     lck = (kmp_user_lock_p)lk;
1199     if (__kmp_env_consistency_check) {
1200       __kmp_push_sync(global_tid, ct_critical, loc, lck,
1201                       __kmp_map_hint_to_lock(hint));
1202     }
1203 #if USE_ITT_BUILD
1204     __kmp_itt_critical_acquiring(lck);
1205 #endif
1206 #if KMP_USE_INLINED_TAS
1207     if (__kmp_user_lock_seq == lockseq_tas && !__kmp_env_consistency_check) {
1208       KMP_ACQUIRE_TAS_LOCK(lck, global_tid);
1209     } else
1210 #elif KMP_USE_INLINED_FUTEX
1211     if (__kmp_user_lock_seq == lockseq_futex && !__kmp_env_consistency_check) {
1212       KMP_ACQUIRE_FUTEX_LOCK(lck, global_tid);
1213     } else
1214 #endif
1215     {
1216       KMP_D_LOCK_FUNC(lk, set)(lk, global_tid);
1217     }
1218   } else {
1219     kmp_indirect_lock_t *ilk = *((kmp_indirect_lock_t **)lk);
1220     lck = ilk->lock;
1221     if (__kmp_env_consistency_check) {
1222       __kmp_push_sync(global_tid, ct_critical, loc, lck,
1223                       __kmp_map_hint_to_lock(hint));
1224     }
1225 #if USE_ITT_BUILD
1226     __kmp_itt_critical_acquiring(lck);
1227 #endif
1228     KMP_I_LOCK_FUNC(ilk, set)(lck, global_tid);
1229   }
1230 
1231 #if USE_ITT_BUILD
1232   __kmp_itt_critical_acquired(lck);
1233 #endif /* USE_ITT_BUILD */
1234 
1235   KMP_PUSH_PARTITIONED_TIMER(OMP_critical);
1236   KA_TRACE(15, ("__kmpc_critical: done T#%d\n", global_tid));
1237 } // __kmpc_critical_with_hint
1238 
1239 #endif // KMP_USE_DYNAMIC_LOCK
1240 
1241 /*!
1242 @ingroup WORK_SHARING
1243 @param loc  source location information.
1244 @param global_tid  global thread number .
1245 @param crit identity of the critical section. This could be a pointer to a lock
1246 associated with the critical section, or some other suitably unique value.
1247 
1248 Leave a critical section, releasing any lock that was held during its execution.
1249 */
1250 void __kmpc_end_critical(ident_t *loc, kmp_int32 global_tid,
1251                          kmp_critical_name *crit) {
1252   kmp_user_lock_p lck;
1253 
1254   KC_TRACE(10, ("__kmpc_end_critical: called T#%d\n", global_tid));
1255 
1256 #if KMP_USE_DYNAMIC_LOCK
1257   if (KMP_IS_D_LOCK(__kmp_user_lock_seq)) {
1258     lck = (kmp_user_lock_p)crit;
1259     KMP_ASSERT(lck != NULL);
1260     if (__kmp_env_consistency_check) {
1261       __kmp_pop_sync(global_tid, ct_critical, loc);
1262     }
1263 #if USE_ITT_BUILD
1264     __kmp_itt_critical_releasing(lck);
1265 #endif
1266 #if KMP_USE_INLINED_TAS
1267     if (__kmp_user_lock_seq == lockseq_tas && !__kmp_env_consistency_check) {
1268       KMP_RELEASE_TAS_LOCK(lck, global_tid);
1269     } else
1270 #elif KMP_USE_INLINED_FUTEX
1271     if (__kmp_user_lock_seq == lockseq_futex && !__kmp_env_consistency_check) {
1272       KMP_RELEASE_FUTEX_LOCK(lck, global_tid);
1273     } else
1274 #endif
1275     {
1276       KMP_D_LOCK_FUNC(lck, unset)((kmp_dyna_lock_t *)lck, global_tid);
1277     }
1278   } else {
1279     kmp_indirect_lock_t *ilk =
1280         (kmp_indirect_lock_t *)TCR_PTR(*((kmp_indirect_lock_t **)crit));
1281     KMP_ASSERT(ilk != NULL);
1282     lck = ilk->lock;
1283     if (__kmp_env_consistency_check) {
1284       __kmp_pop_sync(global_tid, ct_critical, loc);
1285     }
1286 #if USE_ITT_BUILD
1287     __kmp_itt_critical_releasing(lck);
1288 #endif
1289     KMP_I_LOCK_FUNC(ilk, unset)(lck, global_tid);
1290   }
1291 
1292 #else // KMP_USE_DYNAMIC_LOCK
1293 
1294   if ((__kmp_user_lock_kind == lk_tas) &&
1295       (sizeof(lck->tas.lk.poll) <= OMP_CRITICAL_SIZE)) {
1296     lck = (kmp_user_lock_p)crit;
1297   }
1298 #if KMP_USE_FUTEX
1299   else if ((__kmp_user_lock_kind == lk_futex) &&
1300            (sizeof(lck->futex.lk.poll) <= OMP_CRITICAL_SIZE)) {
1301     lck = (kmp_user_lock_p)crit;
1302   }
1303 #endif
1304   else { // ticket, queuing or drdpa
1305     lck = (kmp_user_lock_p)TCR_PTR(*((kmp_user_lock_p *)crit));
1306   }
1307 
1308   KMP_ASSERT(lck != NULL);
1309 
1310   if (__kmp_env_consistency_check)
1311     __kmp_pop_sync(global_tid, ct_critical, loc);
1312 
1313 #if USE_ITT_BUILD
1314   __kmp_itt_critical_releasing(lck);
1315 #endif /* USE_ITT_BUILD */
1316   // Value of 'crit' should be good for using as a critical_id of the critical
1317   // section directive.
1318   __kmp_release_user_lock_with_checks(lck, global_tid);
1319 
1320 #if OMPT_SUPPORT && OMPT_BLAME
1321   if (ompt_enabled &&
1322       ompt_callbacks.ompt_callback(ompt_event_release_critical)) {
1323     ompt_callbacks.ompt_callback(ompt_event_release_critical)((uint64_t)lck);
1324   }
1325 #endif
1326 
1327 #endif // KMP_USE_DYNAMIC_LOCK
1328   KMP_POP_PARTITIONED_TIMER();
1329   KA_TRACE(15, ("__kmpc_end_critical: done T#%d\n", global_tid));
1330 }
1331 
1332 /*!
1333 @ingroup SYNCHRONIZATION
1334 @param loc source location information
1335 @param global_tid thread id.
1336 @return one if the thread should execute the master block, zero otherwise
1337 
1338 Start execution of a combined barrier and master. The barrier is executed inside
1339 this function.
1340 */
1341 kmp_int32 __kmpc_barrier_master(ident_t *loc, kmp_int32 global_tid) {
1342   int status;
1343 
1344   KC_TRACE(10, ("__kmpc_barrier_master: called T#%d\n", global_tid));
1345 
1346   if (!TCR_4(__kmp_init_parallel))
1347     __kmp_parallel_initialize();
1348 
1349   if (__kmp_env_consistency_check)
1350     __kmp_check_barrier(global_tid, ct_barrier, loc);
1351 
1352 #if USE_ITT_NOTIFY
1353   __kmp_threads[global_tid]->th.th_ident = loc;
1354 #endif
1355   status = __kmp_barrier(bs_plain_barrier, global_tid, TRUE, 0, NULL, NULL);
1356 
1357   return (status != 0) ? 0 : 1;
1358 }
1359 
1360 /*!
1361 @ingroup SYNCHRONIZATION
1362 @param loc source location information
1363 @param global_tid thread id.
1364 
1365 Complete the execution of a combined barrier and master. This function should
1366 only be called at the completion of the <tt>master</tt> code. Other threads will
1367 still be waiting at the barrier and this call releases them.
1368 */
1369 void __kmpc_end_barrier_master(ident_t *loc, kmp_int32 global_tid) {
1370   KC_TRACE(10, ("__kmpc_end_barrier_master: called T#%d\n", global_tid));
1371 
1372   __kmp_end_split_barrier(bs_plain_barrier, global_tid);
1373 }
1374 
1375 /*!
1376 @ingroup SYNCHRONIZATION
1377 @param loc source location information
1378 @param global_tid thread id.
1379 @return one if the thread should execute the master block, zero otherwise
1380 
1381 Start execution of a combined barrier and master(nowait) construct.
1382 The barrier is executed inside this function.
1383 There is no equivalent "end" function, since the
1384 */
1385 kmp_int32 __kmpc_barrier_master_nowait(ident_t *loc, kmp_int32 global_tid) {
1386   kmp_int32 ret;
1387 
1388   KC_TRACE(10, ("__kmpc_barrier_master_nowait: called T#%d\n", global_tid));
1389 
1390   if (!TCR_4(__kmp_init_parallel))
1391     __kmp_parallel_initialize();
1392 
1393   if (__kmp_env_consistency_check) {
1394     if (loc == 0) {
1395       KMP_WARNING(ConstructIdentInvalid); // ??? What does it mean for the user?
1396     }
1397     __kmp_check_barrier(global_tid, ct_barrier, loc);
1398   }
1399 
1400 #if USE_ITT_NOTIFY
1401   __kmp_threads[global_tid]->th.th_ident = loc;
1402 #endif
1403   __kmp_barrier(bs_plain_barrier, global_tid, FALSE, 0, NULL, NULL);
1404 
1405   ret = __kmpc_master(loc, global_tid);
1406 
1407   if (__kmp_env_consistency_check) {
1408     /*  there's no __kmpc_end_master called; so the (stats) */
1409     /*  actions of __kmpc_end_master are done here          */
1410 
1411     if (global_tid < 0) {
1412       KMP_WARNING(ThreadIdentInvalid);
1413     }
1414     if (ret) {
1415       /* only one thread should do the pop since only */
1416       /* one did the push (see __kmpc_master())       */
1417 
1418       __kmp_pop_sync(global_tid, ct_master, loc);
1419     }
1420   }
1421 
1422   return (ret);
1423 }
1424 
1425 /* The BARRIER for a SINGLE process section is always explicit   */
1426 /*!
1427 @ingroup WORK_SHARING
1428 @param loc  source location information
1429 @param global_tid  global thread number
1430 @return One if this thread should execute the single construct, zero otherwise.
1431 
1432 Test whether to execute a <tt>single</tt> construct.
1433 There are no implicit barriers in the two "single" calls, rather the compiler
1434 should introduce an explicit barrier if it is required.
1435 */
1436 
1437 kmp_int32 __kmpc_single(ident_t *loc, kmp_int32 global_tid) {
1438   kmp_int32 rc = __kmp_enter_single(global_tid, loc, TRUE);
1439 
1440   if (rc) {
1441     // We are going to execute the single statement, so we should count it.
1442     KMP_COUNT_BLOCK(OMP_SINGLE);
1443     KMP_PUSH_PARTITIONED_TIMER(OMP_single);
1444   }
1445 
1446 #if OMPT_SUPPORT && OMPT_TRACE
1447   kmp_info_t *this_thr = __kmp_threads[global_tid];
1448   kmp_team_t *team = this_thr->th.th_team;
1449   int tid = __kmp_tid_from_gtid(global_tid);
1450 
1451   if (ompt_enabled) {
1452     if (rc) {
1453       if (ompt_callbacks.ompt_callback(ompt_event_single_in_block_begin)) {
1454         ompt_callbacks.ompt_callback(ompt_event_single_in_block_begin)(
1455             team->t.ompt_team_info.parallel_id,
1456             team->t.t_implicit_task_taskdata[tid].ompt_task_info.task_id,
1457             team->t.ompt_team_info.microtask);
1458       }
1459     } else {
1460       if (ompt_callbacks.ompt_callback(ompt_event_single_others_begin)) {
1461         ompt_callbacks.ompt_callback(ompt_event_single_others_begin)(
1462             team->t.ompt_team_info.parallel_id,
1463             team->t.t_implicit_task_taskdata[tid].ompt_task_info.task_id);
1464       }
1465       this_thr->th.ompt_thread_info.state = ompt_state_wait_single;
1466     }
1467   }
1468 #endif
1469 
1470   return rc;
1471 }
1472 
1473 /*!
1474 @ingroup WORK_SHARING
1475 @param loc  source location information
1476 @param global_tid  global thread number
1477 
1478 Mark the end of a <tt>single</tt> construct.  This function should
1479 only be called by the thread that executed the block of code protected
1480 by the `single` construct.
1481 */
1482 void __kmpc_end_single(ident_t *loc, kmp_int32 global_tid) {
1483   __kmp_exit_single(global_tid);
1484   KMP_POP_PARTITIONED_TIMER();
1485 
1486 #if OMPT_SUPPORT && OMPT_TRACE
1487   kmp_info_t *this_thr = __kmp_threads[global_tid];
1488   kmp_team_t *team = this_thr->th.th_team;
1489   int tid = __kmp_tid_from_gtid(global_tid);
1490 
1491   if (ompt_enabled &&
1492       ompt_callbacks.ompt_callback(ompt_event_single_in_block_end)) {
1493     ompt_callbacks.ompt_callback(ompt_event_single_in_block_end)(
1494         team->t.ompt_team_info.parallel_id,
1495         team->t.t_implicit_task_taskdata[tid].ompt_task_info.task_id);
1496   }
1497 #endif
1498 }
1499 
1500 /*!
1501 @ingroup WORK_SHARING
1502 @param loc Source location
1503 @param global_tid Global thread id
1504 
1505 Mark the end of a statically scheduled loop.
1506 */
1507 void __kmpc_for_static_fini(ident_t *loc, kmp_int32 global_tid) {
1508   KE_TRACE(10, ("__kmpc_for_static_fini called T#%d\n", global_tid));
1509 
1510 #if OMPT_SUPPORT && OMPT_TRACE
1511   if (ompt_enabled && ompt_callbacks.ompt_callback(ompt_event_loop_end)) {
1512     ompt_team_info_t *team_info = __ompt_get_teaminfo(0, NULL);
1513     ompt_task_info_t *task_info = __ompt_get_taskinfo(0);
1514     ompt_callbacks.ompt_callback(ompt_event_loop_end)(team_info->parallel_id,
1515                                                       task_info->task_id);
1516   }
1517 #endif
1518 
1519   if (__kmp_env_consistency_check)
1520     __kmp_pop_workshare(global_tid, ct_pdo, loc);
1521 }
1522 
1523 // User routines which take C-style arguments (call by value)
1524 // different from the Fortran equivalent routines
1525 
1526 void ompc_set_num_threads(int arg) {
1527   // !!!!! TODO: check the per-task binding
1528   __kmp_set_num_threads(arg, __kmp_entry_gtid());
1529 }
1530 
1531 void ompc_set_dynamic(int flag) {
1532   kmp_info_t *thread;
1533 
1534   /* For the thread-private implementation of the internal controls */
1535   thread = __kmp_entry_thread();
1536 
1537   __kmp_save_internal_controls(thread);
1538 
1539   set__dynamic(thread, flag ? TRUE : FALSE);
1540 }
1541 
1542 void ompc_set_nested(int flag) {
1543   kmp_info_t *thread;
1544 
1545   /* For the thread-private internal controls implementation */
1546   thread = __kmp_entry_thread();
1547 
1548   __kmp_save_internal_controls(thread);
1549 
1550   set__nested(thread, flag ? TRUE : FALSE);
1551 }
1552 
1553 void ompc_set_max_active_levels(int max_active_levels) {
1554   /* TO DO */
1555   /* we want per-task implementation of this internal control */
1556 
1557   /* For the per-thread internal controls implementation */
1558   __kmp_set_max_active_levels(__kmp_entry_gtid(), max_active_levels);
1559 }
1560 
1561 void ompc_set_schedule(omp_sched_t kind, int modifier) {
1562   // !!!!! TODO: check the per-task binding
1563   __kmp_set_schedule(__kmp_entry_gtid(), (kmp_sched_t)kind, modifier);
1564 }
1565 
1566 int ompc_get_ancestor_thread_num(int level) {
1567   return __kmp_get_ancestor_thread_num(__kmp_entry_gtid(), level);
1568 }
1569 
1570 int ompc_get_team_size(int level) {
1571   return __kmp_get_team_size(__kmp_entry_gtid(), level);
1572 }
1573 
1574 void kmpc_set_stacksize(int arg) {
1575   // __kmp_aux_set_stacksize initializes the library if needed
1576   __kmp_aux_set_stacksize(arg);
1577 }
1578 
1579 void kmpc_set_stacksize_s(size_t arg) {
1580   // __kmp_aux_set_stacksize initializes the library if needed
1581   __kmp_aux_set_stacksize(arg);
1582 }
1583 
1584 void kmpc_set_blocktime(int arg) {
1585   int gtid, tid;
1586   kmp_info_t *thread;
1587 
1588   gtid = __kmp_entry_gtid();
1589   tid = __kmp_tid_from_gtid(gtid);
1590   thread = __kmp_thread_from_gtid(gtid);
1591 
1592   __kmp_aux_set_blocktime(arg, thread, tid);
1593 }
1594 
1595 void kmpc_set_library(int arg) {
1596   // __kmp_user_set_library initializes the library if needed
1597   __kmp_user_set_library((enum library_type)arg);
1598 }
1599 
1600 void kmpc_set_defaults(char const *str) {
1601   // __kmp_aux_set_defaults initializes the library if needed
1602   __kmp_aux_set_defaults(str, KMP_STRLEN(str));
1603 }
1604 
1605 void kmpc_set_disp_num_buffers(int arg) {
1606   // ignore after initialization because some teams have already
1607   // allocated dispatch buffers
1608   if (__kmp_init_serial == 0 && arg > 0)
1609     __kmp_dispatch_num_buffers = arg;
1610 }
1611 
1612 int kmpc_set_affinity_mask_proc(int proc, void **mask) {
1613 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
1614   return -1;
1615 #else
1616   if (!TCR_4(__kmp_init_middle)) {
1617     __kmp_middle_initialize();
1618   }
1619   return __kmp_aux_set_affinity_mask_proc(proc, mask);
1620 #endif
1621 }
1622 
1623 int kmpc_unset_affinity_mask_proc(int proc, void **mask) {
1624 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
1625   return -1;
1626 #else
1627   if (!TCR_4(__kmp_init_middle)) {
1628     __kmp_middle_initialize();
1629   }
1630   return __kmp_aux_unset_affinity_mask_proc(proc, mask);
1631 #endif
1632 }
1633 
1634 int kmpc_get_affinity_mask_proc(int proc, void **mask) {
1635 #if defined(KMP_STUB) || !KMP_AFFINITY_SUPPORTED
1636   return -1;
1637 #else
1638   if (!TCR_4(__kmp_init_middle)) {
1639     __kmp_middle_initialize();
1640   }
1641   return __kmp_aux_get_affinity_mask_proc(proc, mask);
1642 #endif
1643 }
1644 
1645 /* -------------------------------------------------------------------------- */
1646 /*!
1647 @ingroup THREADPRIVATE
1648 @param loc       source location information
1649 @param gtid      global thread number
1650 @param cpy_size  size of the cpy_data buffer
1651 @param cpy_data  pointer to data to be copied
1652 @param cpy_func  helper function to call for copying data
1653 @param didit     flag variable: 1=single thread; 0=not single thread
1654 
1655 __kmpc_copyprivate implements the interface for the private data broadcast
1656 needed for the copyprivate clause associated with a single region in an
1657 OpenMP<sup>*</sup> program (both C and Fortran).
1658 All threads participating in the parallel region call this routine.
1659 One of the threads (called the single thread) should have the <tt>didit</tt>
1660 variable set to 1 and all other threads should have that variable set to 0.
1661 All threads pass a pointer to a data buffer (cpy_data) that they have built.
1662 
1663 The OpenMP specification forbids the use of nowait on the single region when a
1664 copyprivate clause is present. However, @ref __kmpc_copyprivate implements a
1665 barrier internally to avoid race conditions, so the code generation for the
1666 single region should avoid generating a barrier after the call to @ref
1667 __kmpc_copyprivate.
1668 
1669 The <tt>gtid</tt> parameter is the global thread id for the current thread.
1670 The <tt>loc</tt> parameter is a pointer to source location information.
1671 
1672 Internal implementation: The single thread will first copy its descriptor
1673 address (cpy_data) to a team-private location, then the other threads will each
1674 call the function pointed to by the parameter cpy_func, which carries out the
1675 copy by copying the data using the cpy_data buffer.
1676 
1677 The cpy_func routine used for the copy and the contents of the data area defined
1678 by cpy_data and cpy_size may be built in any fashion that will allow the copy
1679 to be done. For instance, the cpy_data buffer can hold the actual data to be
1680 copied or it may hold a list of pointers to the data. The cpy_func routine must
1681 interpret the cpy_data buffer appropriately.
1682 
1683 The interface to cpy_func is as follows:
1684 @code
1685 void cpy_func( void *destination, void *source )
1686 @endcode
1687 where void *destination is the cpy_data pointer for the thread being copied to
1688 and void *source is the cpy_data pointer for the thread being copied from.
1689 */
1690 void __kmpc_copyprivate(ident_t *loc, kmp_int32 gtid, size_t cpy_size,
1691                         void *cpy_data, void (*cpy_func)(void *, void *),
1692                         kmp_int32 didit) {
1693   void **data_ptr;
1694 
1695   KC_TRACE(10, ("__kmpc_copyprivate: called T#%d\n", gtid));
1696 
1697   KMP_MB();
1698 
1699   data_ptr = &__kmp_team_from_gtid(gtid)->t.t_copypriv_data;
1700 
1701   if (__kmp_env_consistency_check) {
1702     if (loc == 0) {
1703       KMP_WARNING(ConstructIdentInvalid);
1704     }
1705   }
1706 
1707   // ToDo: Optimize the following two barriers into some kind of split barrier
1708 
1709   if (didit)
1710     *data_ptr = cpy_data;
1711 
1712 /* This barrier is not a barrier region boundary */
1713 #if USE_ITT_NOTIFY
1714   __kmp_threads[gtid]->th.th_ident = loc;
1715 #endif
1716   __kmp_barrier(bs_plain_barrier, gtid, FALSE, 0, NULL, NULL);
1717 
1718   if (!didit)
1719     (*cpy_func)(cpy_data, *data_ptr);
1720 
1721 // Consider next barrier a user-visible barrier for barrier region boundaries
1722 // Nesting checks are already handled by the single construct checks
1723 
1724 #if USE_ITT_NOTIFY
1725   __kmp_threads[gtid]->th.th_ident = loc; // TODO: check if it is needed (e.g.
1726 // tasks can overwrite the location)
1727 #endif
1728   __kmp_barrier(bs_plain_barrier, gtid, FALSE, 0, NULL, NULL);
1729 }
1730 
1731 /* -------------------------------------------------------------------------- */
1732 
1733 #define INIT_LOCK __kmp_init_user_lock_with_checks
1734 #define INIT_NESTED_LOCK __kmp_init_nested_user_lock_with_checks
1735 #define ACQUIRE_LOCK __kmp_acquire_user_lock_with_checks
1736 #define ACQUIRE_LOCK_TIMED __kmp_acquire_user_lock_with_checks_timed
1737 #define ACQUIRE_NESTED_LOCK __kmp_acquire_nested_user_lock_with_checks
1738 #define ACQUIRE_NESTED_LOCK_TIMED                                              \
1739   __kmp_acquire_nested_user_lock_with_checks_timed
1740 #define RELEASE_LOCK __kmp_release_user_lock_with_checks
1741 #define RELEASE_NESTED_LOCK __kmp_release_nested_user_lock_with_checks
1742 #define TEST_LOCK __kmp_test_user_lock_with_checks
1743 #define TEST_NESTED_LOCK __kmp_test_nested_user_lock_with_checks
1744 #define DESTROY_LOCK __kmp_destroy_user_lock_with_checks
1745 #define DESTROY_NESTED_LOCK __kmp_destroy_nested_user_lock_with_checks
1746 
1747 // TODO: Make check abort messages use location info & pass it into
1748 // with_checks routines
1749 
1750 #if KMP_USE_DYNAMIC_LOCK
1751 
1752 // internal lock initializer
1753 static __forceinline void __kmp_init_lock_with_hint(ident_t *loc, void **lock,
1754                                                     kmp_dyna_lockseq_t seq) {
1755   if (KMP_IS_D_LOCK(seq)) {
1756     KMP_INIT_D_LOCK(lock, seq);
1757 #if USE_ITT_BUILD
1758     __kmp_itt_lock_creating((kmp_user_lock_p)lock, NULL);
1759 #endif
1760   } else {
1761     KMP_INIT_I_LOCK(lock, seq);
1762 #if USE_ITT_BUILD
1763     kmp_indirect_lock_t *ilk = KMP_LOOKUP_I_LOCK(lock);
1764     __kmp_itt_lock_creating(ilk->lock, loc);
1765 #endif
1766   }
1767 }
1768 
1769 // internal nest lock initializer
1770 static __forceinline void
1771 __kmp_init_nest_lock_with_hint(ident_t *loc, void **lock,
1772                                kmp_dyna_lockseq_t seq) {
1773 #if KMP_USE_TSX
1774   // Don't have nested lock implementation for speculative locks
1775   if (seq == lockseq_hle || seq == lockseq_rtm || seq == lockseq_adaptive)
1776     seq = __kmp_user_lock_seq;
1777 #endif
1778   switch (seq) {
1779   case lockseq_tas:
1780     seq = lockseq_nested_tas;
1781     break;
1782 #if KMP_USE_FUTEX
1783   case lockseq_futex:
1784     seq = lockseq_nested_futex;
1785     break;
1786 #endif
1787   case lockseq_ticket:
1788     seq = lockseq_nested_ticket;
1789     break;
1790   case lockseq_queuing:
1791     seq = lockseq_nested_queuing;
1792     break;
1793   case lockseq_drdpa:
1794     seq = lockseq_nested_drdpa;
1795     break;
1796   default:
1797     seq = lockseq_nested_queuing;
1798   }
1799   KMP_INIT_I_LOCK(lock, seq);
1800 #if USE_ITT_BUILD
1801   kmp_indirect_lock_t *ilk = KMP_LOOKUP_I_LOCK(lock);
1802   __kmp_itt_lock_creating(ilk->lock, loc);
1803 #endif
1804 }
1805 
1806 /* initialize the lock with a hint */
1807 void __kmpc_init_lock_with_hint(ident_t *loc, kmp_int32 gtid, void **user_lock,
1808                                 uintptr_t hint) {
1809   KMP_DEBUG_ASSERT(__kmp_init_serial);
1810   if (__kmp_env_consistency_check && user_lock == NULL) {
1811     KMP_FATAL(LockIsUninitialized, "omp_init_lock_with_hint");
1812   }
1813 
1814   __kmp_init_lock_with_hint(loc, user_lock, __kmp_map_hint_to_lock(hint));
1815 }
1816 
1817 /* initialize the lock with a hint */
1818 void __kmpc_init_nest_lock_with_hint(ident_t *loc, kmp_int32 gtid,
1819                                      void **user_lock, uintptr_t hint) {
1820   KMP_DEBUG_ASSERT(__kmp_init_serial);
1821   if (__kmp_env_consistency_check && user_lock == NULL) {
1822     KMP_FATAL(LockIsUninitialized, "omp_init_nest_lock_with_hint");
1823   }
1824 
1825   __kmp_init_nest_lock_with_hint(loc, user_lock, __kmp_map_hint_to_lock(hint));
1826 }
1827 
1828 #endif // KMP_USE_DYNAMIC_LOCK
1829 
1830 /* initialize the lock */
1831 void __kmpc_init_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
1832 #if KMP_USE_DYNAMIC_LOCK
1833 
1834   KMP_DEBUG_ASSERT(__kmp_init_serial);
1835   if (__kmp_env_consistency_check && user_lock == NULL) {
1836     KMP_FATAL(LockIsUninitialized, "omp_init_lock");
1837   }
1838   __kmp_init_lock_with_hint(loc, user_lock, __kmp_user_lock_seq);
1839 
1840 #else // KMP_USE_DYNAMIC_LOCK
1841 
1842   static char const *const func = "omp_init_lock";
1843   kmp_user_lock_p lck;
1844   KMP_DEBUG_ASSERT(__kmp_init_serial);
1845 
1846   if (__kmp_env_consistency_check) {
1847     if (user_lock == NULL) {
1848       KMP_FATAL(LockIsUninitialized, func);
1849     }
1850   }
1851 
1852   KMP_CHECK_USER_LOCK_INIT();
1853 
1854   if ((__kmp_user_lock_kind == lk_tas) &&
1855       (sizeof(lck->tas.lk.poll) <= OMP_LOCK_T_SIZE)) {
1856     lck = (kmp_user_lock_p)user_lock;
1857   }
1858 #if KMP_USE_FUTEX
1859   else if ((__kmp_user_lock_kind == lk_futex) &&
1860            (sizeof(lck->futex.lk.poll) <= OMP_LOCK_T_SIZE)) {
1861     lck = (kmp_user_lock_p)user_lock;
1862   }
1863 #endif
1864   else {
1865     lck = __kmp_user_lock_allocate(user_lock, gtid, 0);
1866   }
1867   INIT_LOCK(lck);
1868   __kmp_set_user_lock_location(lck, loc);
1869 
1870 #if OMPT_SUPPORT && OMPT_TRACE
1871   if (ompt_enabled && ompt_callbacks.ompt_callback(ompt_event_init_lock)) {
1872     ompt_callbacks.ompt_callback(ompt_event_init_lock)((uint64_t)lck);
1873   }
1874 #endif
1875 
1876 #if USE_ITT_BUILD
1877   __kmp_itt_lock_creating(lck);
1878 #endif /* USE_ITT_BUILD */
1879 
1880 #endif // KMP_USE_DYNAMIC_LOCK
1881 } // __kmpc_init_lock
1882 
1883 /* initialize the lock */
1884 void __kmpc_init_nest_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
1885 #if KMP_USE_DYNAMIC_LOCK
1886 
1887   KMP_DEBUG_ASSERT(__kmp_init_serial);
1888   if (__kmp_env_consistency_check && user_lock == NULL) {
1889     KMP_FATAL(LockIsUninitialized, "omp_init_nest_lock");
1890   }
1891   __kmp_init_nest_lock_with_hint(loc, user_lock, __kmp_user_lock_seq);
1892 
1893 #else // KMP_USE_DYNAMIC_LOCK
1894 
1895   static char const *const func = "omp_init_nest_lock";
1896   kmp_user_lock_p lck;
1897   KMP_DEBUG_ASSERT(__kmp_init_serial);
1898 
1899   if (__kmp_env_consistency_check) {
1900     if (user_lock == NULL) {
1901       KMP_FATAL(LockIsUninitialized, func);
1902     }
1903   }
1904 
1905   KMP_CHECK_USER_LOCK_INIT();
1906 
1907   if ((__kmp_user_lock_kind == lk_tas) &&
1908       (sizeof(lck->tas.lk.poll) + sizeof(lck->tas.lk.depth_locked) <=
1909        OMP_NEST_LOCK_T_SIZE)) {
1910     lck = (kmp_user_lock_p)user_lock;
1911   }
1912 #if KMP_USE_FUTEX
1913   else if ((__kmp_user_lock_kind == lk_futex) &&
1914            (sizeof(lck->futex.lk.poll) + sizeof(lck->futex.lk.depth_locked) <=
1915             OMP_NEST_LOCK_T_SIZE)) {
1916     lck = (kmp_user_lock_p)user_lock;
1917   }
1918 #endif
1919   else {
1920     lck = __kmp_user_lock_allocate(user_lock, gtid, 0);
1921   }
1922 
1923   INIT_NESTED_LOCK(lck);
1924   __kmp_set_user_lock_location(lck, loc);
1925 
1926 #if OMPT_SUPPORT && OMPT_TRACE
1927   if (ompt_enabled && ompt_callbacks.ompt_callback(ompt_event_init_nest_lock)) {
1928     ompt_callbacks.ompt_callback(ompt_event_init_nest_lock)((uint64_t)lck);
1929   }
1930 #endif
1931 
1932 #if USE_ITT_BUILD
1933   __kmp_itt_lock_creating(lck);
1934 #endif /* USE_ITT_BUILD */
1935 
1936 #endif // KMP_USE_DYNAMIC_LOCK
1937 } // __kmpc_init_nest_lock
1938 
1939 void __kmpc_destroy_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
1940 #if KMP_USE_DYNAMIC_LOCK
1941 
1942 #if USE_ITT_BUILD
1943   kmp_user_lock_p lck;
1944   if (KMP_EXTRACT_D_TAG(user_lock) == 0) {
1945     lck = ((kmp_indirect_lock_t *)KMP_LOOKUP_I_LOCK(user_lock))->lock;
1946   } else {
1947     lck = (kmp_user_lock_p)user_lock;
1948   }
1949   __kmp_itt_lock_destroyed(lck);
1950 #endif
1951   KMP_D_LOCK_FUNC(user_lock, destroy)((kmp_dyna_lock_t *)user_lock);
1952 #else
1953   kmp_user_lock_p lck;
1954 
1955   if ((__kmp_user_lock_kind == lk_tas) &&
1956       (sizeof(lck->tas.lk.poll) <= OMP_LOCK_T_SIZE)) {
1957     lck = (kmp_user_lock_p)user_lock;
1958   }
1959 #if KMP_USE_FUTEX
1960   else if ((__kmp_user_lock_kind == lk_futex) &&
1961            (sizeof(lck->futex.lk.poll) <= OMP_LOCK_T_SIZE)) {
1962     lck = (kmp_user_lock_p)user_lock;
1963   }
1964 #endif
1965   else {
1966     lck = __kmp_lookup_user_lock(user_lock, "omp_destroy_lock");
1967   }
1968 
1969 #if OMPT_SUPPORT && OMPT_TRACE
1970   if (ompt_enabled && ompt_callbacks.ompt_callback(ompt_event_destroy_lock)) {
1971     ompt_callbacks.ompt_callback(ompt_event_destroy_lock)((uint64_t)lck);
1972   }
1973 #endif
1974 
1975 #if USE_ITT_BUILD
1976   __kmp_itt_lock_destroyed(lck);
1977 #endif /* USE_ITT_BUILD */
1978   DESTROY_LOCK(lck);
1979 
1980   if ((__kmp_user_lock_kind == lk_tas) &&
1981       (sizeof(lck->tas.lk.poll) <= OMP_LOCK_T_SIZE)) {
1982     ;
1983   }
1984 #if KMP_USE_FUTEX
1985   else if ((__kmp_user_lock_kind == lk_futex) &&
1986            (sizeof(lck->futex.lk.poll) <= OMP_LOCK_T_SIZE)) {
1987     ;
1988   }
1989 #endif
1990   else {
1991     __kmp_user_lock_free(user_lock, gtid, lck);
1992   }
1993 #endif // KMP_USE_DYNAMIC_LOCK
1994 } // __kmpc_destroy_lock
1995 
1996 /* destroy the lock */
1997 void __kmpc_destroy_nest_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
1998 #if KMP_USE_DYNAMIC_LOCK
1999 
2000 #if USE_ITT_BUILD
2001   kmp_indirect_lock_t *ilk = KMP_LOOKUP_I_LOCK(user_lock);
2002   __kmp_itt_lock_destroyed(ilk->lock);
2003 #endif
2004   KMP_D_LOCK_FUNC(user_lock, destroy)((kmp_dyna_lock_t *)user_lock);
2005 
2006 #else // KMP_USE_DYNAMIC_LOCK
2007 
2008   kmp_user_lock_p lck;
2009 
2010   if ((__kmp_user_lock_kind == lk_tas) &&
2011       (sizeof(lck->tas.lk.poll) + sizeof(lck->tas.lk.depth_locked) <=
2012        OMP_NEST_LOCK_T_SIZE)) {
2013     lck = (kmp_user_lock_p)user_lock;
2014   }
2015 #if KMP_USE_FUTEX
2016   else if ((__kmp_user_lock_kind == lk_futex) &&
2017            (sizeof(lck->futex.lk.poll) + sizeof(lck->futex.lk.depth_locked) <=
2018             OMP_NEST_LOCK_T_SIZE)) {
2019     lck = (kmp_user_lock_p)user_lock;
2020   }
2021 #endif
2022   else {
2023     lck = __kmp_lookup_user_lock(user_lock, "omp_destroy_nest_lock");
2024   }
2025 
2026 #if OMPT_SUPPORT && OMPT_TRACE
2027   if (ompt_enabled &&
2028       ompt_callbacks.ompt_callback(ompt_event_destroy_nest_lock)) {
2029     ompt_callbacks.ompt_callback(ompt_event_destroy_nest_lock)((uint64_t)lck);
2030   }
2031 #endif
2032 
2033 #if USE_ITT_BUILD
2034   __kmp_itt_lock_destroyed(lck);
2035 #endif /* USE_ITT_BUILD */
2036 
2037   DESTROY_NESTED_LOCK(lck);
2038 
2039   if ((__kmp_user_lock_kind == lk_tas) &&
2040       (sizeof(lck->tas.lk.poll) + sizeof(lck->tas.lk.depth_locked) <=
2041        OMP_NEST_LOCK_T_SIZE)) {
2042     ;
2043   }
2044 #if KMP_USE_FUTEX
2045   else if ((__kmp_user_lock_kind == lk_futex) &&
2046            (sizeof(lck->futex.lk.poll) + sizeof(lck->futex.lk.depth_locked) <=
2047             OMP_NEST_LOCK_T_SIZE)) {
2048     ;
2049   }
2050 #endif
2051   else {
2052     __kmp_user_lock_free(user_lock, gtid, lck);
2053   }
2054 #endif // KMP_USE_DYNAMIC_LOCK
2055 } // __kmpc_destroy_nest_lock
2056 
2057 void __kmpc_set_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
2058   KMP_COUNT_BLOCK(OMP_set_lock);
2059 #if KMP_USE_DYNAMIC_LOCK
2060   int tag = KMP_EXTRACT_D_TAG(user_lock);
2061 #if USE_ITT_BUILD
2062   __kmp_itt_lock_acquiring(
2063       (kmp_user_lock_p)
2064           user_lock); // itt function will get to the right lock object.
2065 #endif
2066 #if KMP_USE_INLINED_TAS
2067   if (tag == locktag_tas && !__kmp_env_consistency_check) {
2068     KMP_ACQUIRE_TAS_LOCK(user_lock, gtid);
2069   } else
2070 #elif KMP_USE_INLINED_FUTEX
2071   if (tag == locktag_futex && !__kmp_env_consistency_check) {
2072     KMP_ACQUIRE_FUTEX_LOCK(user_lock, gtid);
2073   } else
2074 #endif
2075   {
2076     __kmp_direct_set[tag]((kmp_dyna_lock_t *)user_lock, gtid);
2077   }
2078 #if USE_ITT_BUILD
2079   __kmp_itt_lock_acquired((kmp_user_lock_p)user_lock);
2080 #endif
2081 
2082 #else // KMP_USE_DYNAMIC_LOCK
2083 
2084   kmp_user_lock_p lck;
2085 
2086   if ((__kmp_user_lock_kind == lk_tas) &&
2087       (sizeof(lck->tas.lk.poll) <= OMP_LOCK_T_SIZE)) {
2088     lck = (kmp_user_lock_p)user_lock;
2089   }
2090 #if KMP_USE_FUTEX
2091   else if ((__kmp_user_lock_kind == lk_futex) &&
2092            (sizeof(lck->futex.lk.poll) <= OMP_LOCK_T_SIZE)) {
2093     lck = (kmp_user_lock_p)user_lock;
2094   }
2095 #endif
2096   else {
2097     lck = __kmp_lookup_user_lock(user_lock, "omp_set_lock");
2098   }
2099 
2100 #if USE_ITT_BUILD
2101   __kmp_itt_lock_acquiring(lck);
2102 #endif /* USE_ITT_BUILD */
2103 
2104   ACQUIRE_LOCK(lck, gtid);
2105 
2106 #if USE_ITT_BUILD
2107   __kmp_itt_lock_acquired(lck);
2108 #endif /* USE_ITT_BUILD */
2109 
2110 #if OMPT_SUPPORT && OMPT_TRACE
2111   if (ompt_enabled && ompt_callbacks.ompt_callback(ompt_event_acquired_lock)) {
2112     ompt_callbacks.ompt_callback(ompt_event_acquired_lock)((uint64_t)lck);
2113   }
2114 #endif
2115 
2116 #endif // KMP_USE_DYNAMIC_LOCK
2117 }
2118 
2119 void __kmpc_set_nest_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
2120 #if KMP_USE_DYNAMIC_LOCK
2121 
2122 #if USE_ITT_BUILD
2123   __kmp_itt_lock_acquiring((kmp_user_lock_p)user_lock);
2124 #endif
2125   KMP_D_LOCK_FUNC(user_lock, set)((kmp_dyna_lock_t *)user_lock, gtid);
2126 #if USE_ITT_BUILD
2127   __kmp_itt_lock_acquired((kmp_user_lock_p)user_lock);
2128 #endif
2129 
2130 #if OMPT_SUPPORT && OMPT_TRACE
2131   if (ompt_enabled) {
2132     // missing support here: need to know whether acquired first or not
2133   }
2134 #endif
2135 
2136 #else // KMP_USE_DYNAMIC_LOCK
2137   int acquire_status;
2138   kmp_user_lock_p lck;
2139 
2140   if ((__kmp_user_lock_kind == lk_tas) &&
2141       (sizeof(lck->tas.lk.poll) + sizeof(lck->tas.lk.depth_locked) <=
2142        OMP_NEST_LOCK_T_SIZE)) {
2143     lck = (kmp_user_lock_p)user_lock;
2144   }
2145 #if KMP_USE_FUTEX
2146   else if ((__kmp_user_lock_kind == lk_futex) &&
2147            (sizeof(lck->futex.lk.poll) + sizeof(lck->futex.lk.depth_locked) <=
2148             OMP_NEST_LOCK_T_SIZE)) {
2149     lck = (kmp_user_lock_p)user_lock;
2150   }
2151 #endif
2152   else {
2153     lck = __kmp_lookup_user_lock(user_lock, "omp_set_nest_lock");
2154   }
2155 
2156 #if USE_ITT_BUILD
2157   __kmp_itt_lock_acquiring(lck);
2158 #endif /* USE_ITT_BUILD */
2159 
2160   ACQUIRE_NESTED_LOCK(lck, gtid, &acquire_status);
2161 
2162 #if USE_ITT_BUILD
2163   __kmp_itt_lock_acquired(lck);
2164 #endif /* USE_ITT_BUILD */
2165 
2166 #if OMPT_SUPPORT && OMPT_TRACE
2167   if (ompt_enabled) {
2168     if (acquire_status == KMP_LOCK_ACQUIRED_FIRST) {
2169       if (ompt_callbacks.ompt_callback(ompt_event_acquired_nest_lock_first))
2170         ompt_callbacks.ompt_callback(ompt_event_acquired_nest_lock_first)(
2171             (uint64_t)lck);
2172     } else {
2173       if (ompt_callbacks.ompt_callback(ompt_event_acquired_nest_lock_next))
2174         ompt_callbacks.ompt_callback(ompt_event_acquired_nest_lock_next)(
2175             (uint64_t)lck);
2176     }
2177   }
2178 #endif
2179 
2180 #endif // KMP_USE_DYNAMIC_LOCK
2181 }
2182 
2183 void __kmpc_unset_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
2184 #if KMP_USE_DYNAMIC_LOCK
2185 
2186   int tag = KMP_EXTRACT_D_TAG(user_lock);
2187 #if USE_ITT_BUILD
2188   __kmp_itt_lock_releasing((kmp_user_lock_p)user_lock);
2189 #endif
2190 #if KMP_USE_INLINED_TAS
2191   if (tag == locktag_tas && !__kmp_env_consistency_check) {
2192     KMP_RELEASE_TAS_LOCK(user_lock, gtid);
2193   } else
2194 #elif KMP_USE_INLINED_FUTEX
2195   if (tag == locktag_futex && !__kmp_env_consistency_check) {
2196     KMP_RELEASE_FUTEX_LOCK(user_lock, gtid);
2197   } else
2198 #endif
2199   {
2200     __kmp_direct_unset[tag]((kmp_dyna_lock_t *)user_lock, gtid);
2201   }
2202 
2203 #else // KMP_USE_DYNAMIC_LOCK
2204 
2205   kmp_user_lock_p lck;
2206 
2207   /* Can't use serial interval since not block structured */
2208   /* release the lock */
2209 
2210   if ((__kmp_user_lock_kind == lk_tas) &&
2211       (sizeof(lck->tas.lk.poll) <= OMP_LOCK_T_SIZE)) {
2212 #if KMP_OS_LINUX &&                                                            \
2213     (KMP_ARCH_X86 || KMP_ARCH_X86_64 || KMP_ARCH_ARM || KMP_ARCH_AARCH64)
2214 // "fast" path implemented to fix customer performance issue
2215 #if USE_ITT_BUILD
2216     __kmp_itt_lock_releasing((kmp_user_lock_p)user_lock);
2217 #endif /* USE_ITT_BUILD */
2218     TCW_4(((kmp_user_lock_p)user_lock)->tas.lk.poll, 0);
2219     KMP_MB();
2220     return;
2221 #else
2222     lck = (kmp_user_lock_p)user_lock;
2223 #endif
2224   }
2225 #if KMP_USE_FUTEX
2226   else if ((__kmp_user_lock_kind == lk_futex) &&
2227            (sizeof(lck->futex.lk.poll) <= OMP_LOCK_T_SIZE)) {
2228     lck = (kmp_user_lock_p)user_lock;
2229   }
2230 #endif
2231   else {
2232     lck = __kmp_lookup_user_lock(user_lock, "omp_unset_lock");
2233   }
2234 
2235 #if USE_ITT_BUILD
2236   __kmp_itt_lock_releasing(lck);
2237 #endif /* USE_ITT_BUILD */
2238 
2239   RELEASE_LOCK(lck, gtid);
2240 
2241 #if OMPT_SUPPORT && OMPT_BLAME
2242   if (ompt_enabled && ompt_callbacks.ompt_callback(ompt_event_release_lock)) {
2243     ompt_callbacks.ompt_callback(ompt_event_release_lock)((uint64_t)lck);
2244   }
2245 #endif
2246 
2247 #endif // KMP_USE_DYNAMIC_LOCK
2248 }
2249 
2250 /* release the lock */
2251 void __kmpc_unset_nest_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
2252 #if KMP_USE_DYNAMIC_LOCK
2253 
2254 #if USE_ITT_BUILD
2255   __kmp_itt_lock_releasing((kmp_user_lock_p)user_lock);
2256 #endif
2257   KMP_D_LOCK_FUNC(user_lock, unset)((kmp_dyna_lock_t *)user_lock, gtid);
2258 
2259 #else // KMP_USE_DYNAMIC_LOCK
2260 
2261   kmp_user_lock_p lck;
2262 
2263   /* Can't use serial interval since not block structured */
2264 
2265   if ((__kmp_user_lock_kind == lk_tas) &&
2266       (sizeof(lck->tas.lk.poll) + sizeof(lck->tas.lk.depth_locked) <=
2267        OMP_NEST_LOCK_T_SIZE)) {
2268 #if KMP_OS_LINUX &&                                                            \
2269     (KMP_ARCH_X86 || KMP_ARCH_X86_64 || KMP_ARCH_ARM || KMP_ARCH_AARCH64)
2270     // "fast" path implemented to fix customer performance issue
2271     kmp_tas_lock_t *tl = (kmp_tas_lock_t *)user_lock;
2272 #if USE_ITT_BUILD
2273     __kmp_itt_lock_releasing((kmp_user_lock_p)user_lock);
2274 #endif /* USE_ITT_BUILD */
2275     if (--(tl->lk.depth_locked) == 0) {
2276       TCW_4(tl->lk.poll, 0);
2277     }
2278     KMP_MB();
2279     return;
2280 #else
2281     lck = (kmp_user_lock_p)user_lock;
2282 #endif
2283   }
2284 #if KMP_USE_FUTEX
2285   else if ((__kmp_user_lock_kind == lk_futex) &&
2286            (sizeof(lck->futex.lk.poll) + sizeof(lck->futex.lk.depth_locked) <=
2287             OMP_NEST_LOCK_T_SIZE)) {
2288     lck = (kmp_user_lock_p)user_lock;
2289   }
2290 #endif
2291   else {
2292     lck = __kmp_lookup_user_lock(user_lock, "omp_unset_nest_lock");
2293   }
2294 
2295 #if USE_ITT_BUILD
2296   __kmp_itt_lock_releasing(lck);
2297 #endif /* USE_ITT_BUILD */
2298 
2299   int release_status;
2300   release_status = RELEASE_NESTED_LOCK(lck, gtid);
2301 #if OMPT_SUPPORT && OMPT_BLAME
2302   if (ompt_enabled) {
2303     if (release_status == KMP_LOCK_RELEASED) {
2304       if (ompt_callbacks.ompt_callback(ompt_event_release_nest_lock_last)) {
2305         ompt_callbacks.ompt_callback(ompt_event_release_nest_lock_last)(
2306             (uint64_t)lck);
2307       }
2308     } else if (ompt_callbacks.ompt_callback(
2309                    ompt_event_release_nest_lock_prev)) {
2310       ompt_callbacks.ompt_callback(ompt_event_release_nest_lock_prev)(
2311           (uint64_t)lck);
2312     }
2313   }
2314 #endif
2315 
2316 #endif // KMP_USE_DYNAMIC_LOCK
2317 }
2318 
2319 /* try to acquire the lock */
2320 int __kmpc_test_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
2321   KMP_COUNT_BLOCK(OMP_test_lock);
2322 
2323 #if KMP_USE_DYNAMIC_LOCK
2324   int rc;
2325   int tag = KMP_EXTRACT_D_TAG(user_lock);
2326 #if USE_ITT_BUILD
2327   __kmp_itt_lock_acquiring((kmp_user_lock_p)user_lock);
2328 #endif
2329 #if KMP_USE_INLINED_TAS
2330   if (tag == locktag_tas && !__kmp_env_consistency_check) {
2331     KMP_TEST_TAS_LOCK(user_lock, gtid, rc);
2332   } else
2333 #elif KMP_USE_INLINED_FUTEX
2334   if (tag == locktag_futex && !__kmp_env_consistency_check) {
2335     KMP_TEST_FUTEX_LOCK(user_lock, gtid, rc);
2336   } else
2337 #endif
2338   {
2339     rc = __kmp_direct_test[tag]((kmp_dyna_lock_t *)user_lock, gtid);
2340   }
2341   if (rc) {
2342 #if USE_ITT_BUILD
2343     __kmp_itt_lock_acquired((kmp_user_lock_p)user_lock);
2344 #endif
2345     return FTN_TRUE;
2346   } else {
2347 #if USE_ITT_BUILD
2348     __kmp_itt_lock_cancelled((kmp_user_lock_p)user_lock);
2349 #endif
2350     return FTN_FALSE;
2351   }
2352 
2353 #else // KMP_USE_DYNAMIC_LOCK
2354 
2355   kmp_user_lock_p lck;
2356   int rc;
2357 
2358   if ((__kmp_user_lock_kind == lk_tas) &&
2359       (sizeof(lck->tas.lk.poll) <= OMP_LOCK_T_SIZE)) {
2360     lck = (kmp_user_lock_p)user_lock;
2361   }
2362 #if KMP_USE_FUTEX
2363   else if ((__kmp_user_lock_kind == lk_futex) &&
2364            (sizeof(lck->futex.lk.poll) <= OMP_LOCK_T_SIZE)) {
2365     lck = (kmp_user_lock_p)user_lock;
2366   }
2367 #endif
2368   else {
2369     lck = __kmp_lookup_user_lock(user_lock, "omp_test_lock");
2370   }
2371 
2372 #if USE_ITT_BUILD
2373   __kmp_itt_lock_acquiring(lck);
2374 #endif /* USE_ITT_BUILD */
2375 
2376   rc = TEST_LOCK(lck, gtid);
2377 #if USE_ITT_BUILD
2378   if (rc) {
2379     __kmp_itt_lock_acquired(lck);
2380   } else {
2381     __kmp_itt_lock_cancelled(lck);
2382   }
2383 #endif /* USE_ITT_BUILD */
2384   return (rc ? FTN_TRUE : FTN_FALSE);
2385 
2386 /* Can't use serial interval since not block structured */
2387 
2388 #endif // KMP_USE_DYNAMIC_LOCK
2389 }
2390 
2391 /* try to acquire the lock */
2392 int __kmpc_test_nest_lock(ident_t *loc, kmp_int32 gtid, void **user_lock) {
2393 #if KMP_USE_DYNAMIC_LOCK
2394   int rc;
2395 #if USE_ITT_BUILD
2396   __kmp_itt_lock_acquiring((kmp_user_lock_p)user_lock);
2397 #endif
2398   rc = KMP_D_LOCK_FUNC(user_lock, test)((kmp_dyna_lock_t *)user_lock, gtid);
2399 #if USE_ITT_BUILD
2400   if (rc) {
2401     __kmp_itt_lock_acquired((kmp_user_lock_p)user_lock);
2402   } else {
2403     __kmp_itt_lock_cancelled((kmp_user_lock_p)user_lock);
2404   }
2405 #endif
2406   return rc;
2407 
2408 #else // KMP_USE_DYNAMIC_LOCK
2409 
2410   kmp_user_lock_p lck;
2411   int rc;
2412 
2413   if ((__kmp_user_lock_kind == lk_tas) &&
2414       (sizeof(lck->tas.lk.poll) + sizeof(lck->tas.lk.depth_locked) <=
2415        OMP_NEST_LOCK_T_SIZE)) {
2416     lck = (kmp_user_lock_p)user_lock;
2417   }
2418 #if KMP_USE_FUTEX
2419   else if ((__kmp_user_lock_kind == lk_futex) &&
2420            (sizeof(lck->futex.lk.poll) + sizeof(lck->futex.lk.depth_locked) <=
2421             OMP_NEST_LOCK_T_SIZE)) {
2422     lck = (kmp_user_lock_p)user_lock;
2423   }
2424 #endif
2425   else {
2426     lck = __kmp_lookup_user_lock(user_lock, "omp_test_nest_lock");
2427   }
2428 
2429 #if USE_ITT_BUILD
2430   __kmp_itt_lock_acquiring(lck);
2431 #endif /* USE_ITT_BUILD */
2432 
2433   rc = TEST_NESTED_LOCK(lck, gtid);
2434 #if USE_ITT_BUILD
2435   if (rc) {
2436     __kmp_itt_lock_acquired(lck);
2437   } else {
2438     __kmp_itt_lock_cancelled(lck);
2439   }
2440 #endif /* USE_ITT_BUILD */
2441   return rc;
2442 
2443 /* Can't use serial interval since not block structured */
2444 
2445 #endif // KMP_USE_DYNAMIC_LOCK
2446 }
2447 
2448 // Interface to fast scalable reduce methods routines
2449 
2450 // keep the selected method in a thread local structure for cross-function
2451 // usage: will be used in __kmpc_end_reduce* functions;
2452 // another solution: to re-determine the method one more time in
2453 // __kmpc_end_reduce* functions (new prototype required then)
2454 // AT: which solution is better?
2455 #define __KMP_SET_REDUCTION_METHOD(gtid, rmethod)                              \
2456   ((__kmp_threads[(gtid)]->th.th_local.packed_reduction_method) = (rmethod))
2457 
2458 #define __KMP_GET_REDUCTION_METHOD(gtid)                                       \
2459   (__kmp_threads[(gtid)]->th.th_local.packed_reduction_method)
2460 
2461 // description of the packed_reduction_method variable: look at the macros in
2462 // kmp.h
2463 
2464 // used in a critical section reduce block
2465 static __forceinline void
2466 __kmp_enter_critical_section_reduce_block(ident_t *loc, kmp_int32 global_tid,
2467                                           kmp_critical_name *crit) {
2468 
2469   // this lock was visible to a customer and to the threading profile tool as a
2470   // serial overhead span (although it's used for an internal purpose only)
2471   //            why was it visible in previous implementation?
2472   //            should we keep it visible in new reduce block?
2473   kmp_user_lock_p lck;
2474 
2475 #if KMP_USE_DYNAMIC_LOCK
2476 
2477   kmp_dyna_lock_t *lk = (kmp_dyna_lock_t *)crit;
2478   // Check if it is initialized.
2479   if (*lk == 0) {
2480     if (KMP_IS_D_LOCK(__kmp_user_lock_seq)) {
2481       KMP_COMPARE_AND_STORE_ACQ32((volatile kmp_int32 *)crit, 0,
2482                                   KMP_GET_D_TAG(__kmp_user_lock_seq));
2483     } else {
2484       __kmp_init_indirect_csptr(crit, loc, global_tid,
2485                                 KMP_GET_I_TAG(__kmp_user_lock_seq));
2486     }
2487   }
2488   // Branch for accessing the actual lock object and set operation. This
2489   // branching is inevitable since this lock initialization does not follow the
2490   // normal dispatch path (lock table is not used).
2491   if (KMP_EXTRACT_D_TAG(lk) != 0) {
2492     lck = (kmp_user_lock_p)lk;
2493     KMP_DEBUG_ASSERT(lck != NULL);
2494     if (__kmp_env_consistency_check) {
2495       __kmp_push_sync(global_tid, ct_critical, loc, lck, __kmp_user_lock_seq);
2496     }
2497     KMP_D_LOCK_FUNC(lk, set)(lk, global_tid);
2498   } else {
2499     kmp_indirect_lock_t *ilk = *((kmp_indirect_lock_t **)lk);
2500     lck = ilk->lock;
2501     KMP_DEBUG_ASSERT(lck != NULL);
2502     if (__kmp_env_consistency_check) {
2503       __kmp_push_sync(global_tid, ct_critical, loc, lck, __kmp_user_lock_seq);
2504     }
2505     KMP_I_LOCK_FUNC(ilk, set)(lck, global_tid);
2506   }
2507 
2508 #else // KMP_USE_DYNAMIC_LOCK
2509 
2510   // We know that the fast reduction code is only emitted by Intel compilers
2511   // with 32 byte critical sections. If there isn't enough space, then we
2512   // have to use a pointer.
2513   if (__kmp_base_user_lock_size <= INTEL_CRITICAL_SIZE) {
2514     lck = (kmp_user_lock_p)crit;
2515   } else {
2516     lck = __kmp_get_critical_section_ptr(crit, loc, global_tid);
2517   }
2518   KMP_DEBUG_ASSERT(lck != NULL);
2519 
2520   if (__kmp_env_consistency_check)
2521     __kmp_push_sync(global_tid, ct_critical, loc, lck);
2522 
2523   __kmp_acquire_user_lock_with_checks(lck, global_tid);
2524 
2525 #endif // KMP_USE_DYNAMIC_LOCK
2526 }
2527 
2528 // used in a critical section reduce block
2529 static __forceinline void
2530 __kmp_end_critical_section_reduce_block(ident_t *loc, kmp_int32 global_tid,
2531                                         kmp_critical_name *crit) {
2532 
2533   kmp_user_lock_p lck;
2534 
2535 #if KMP_USE_DYNAMIC_LOCK
2536 
2537   if (KMP_IS_D_LOCK(__kmp_user_lock_seq)) {
2538     lck = (kmp_user_lock_p)crit;
2539     if (__kmp_env_consistency_check)
2540       __kmp_pop_sync(global_tid, ct_critical, loc);
2541     KMP_D_LOCK_FUNC(lck, unset)((kmp_dyna_lock_t *)lck, global_tid);
2542   } else {
2543     kmp_indirect_lock_t *ilk =
2544         (kmp_indirect_lock_t *)TCR_PTR(*((kmp_indirect_lock_t **)crit));
2545     if (__kmp_env_consistency_check)
2546       __kmp_pop_sync(global_tid, ct_critical, loc);
2547     KMP_I_LOCK_FUNC(ilk, unset)(ilk->lock, global_tid);
2548   }
2549 
2550 #else // KMP_USE_DYNAMIC_LOCK
2551 
2552   // We know that the fast reduction code is only emitted by Intel compilers
2553   // with 32 byte critical sections. If there isn't enough space, then we have
2554   // to use a pointer.
2555   if (__kmp_base_user_lock_size > 32) {
2556     lck = *((kmp_user_lock_p *)crit);
2557     KMP_ASSERT(lck != NULL);
2558   } else {
2559     lck = (kmp_user_lock_p)crit;
2560   }
2561 
2562   if (__kmp_env_consistency_check)
2563     __kmp_pop_sync(global_tid, ct_critical, loc);
2564 
2565   __kmp_release_user_lock_with_checks(lck, global_tid);
2566 
2567 #endif // KMP_USE_DYNAMIC_LOCK
2568 } // __kmp_end_critical_section_reduce_block
2569 
2570 /* 2.a.i. Reduce Block without a terminating barrier */
2571 /*!
2572 @ingroup SYNCHRONIZATION
2573 @param loc source location information
2574 @param global_tid global thread number
2575 @param num_vars number of items (variables) to be reduced
2576 @param reduce_size size of data in bytes to be reduced
2577 @param reduce_data pointer to data to be reduced
2578 @param reduce_func callback function providing reduction operation on two
2579 operands and returning result of reduction in lhs_data
2580 @param lck pointer to the unique lock data structure
2581 @result 1 for the master thread, 0 for all other team threads, 2 for all team
2582 threads if atomic reduction needed
2583 
2584 The nowait version is used for a reduce clause with the nowait argument.
2585 */
2586 kmp_int32
2587 __kmpc_reduce_nowait(ident_t *loc, kmp_int32 global_tid, kmp_int32 num_vars,
2588                      size_t reduce_size, void *reduce_data,
2589                      void (*reduce_func)(void *lhs_data, void *rhs_data),
2590                      kmp_critical_name *lck) {
2591 
2592   KMP_COUNT_BLOCK(REDUCE_nowait);
2593   int retval = 0;
2594   PACKED_REDUCTION_METHOD_T packed_reduction_method;
2595 #if OMP_40_ENABLED
2596   kmp_team_t *team;
2597   kmp_info_t *th;
2598   int teams_swapped = 0, task_state;
2599 #endif
2600   KA_TRACE(10, ("__kmpc_reduce_nowait() enter: called T#%d\n", global_tid));
2601 
2602   // why do we need this initialization here at all?
2603   // Reduction clause can not be used as a stand-alone directive.
2604 
2605   // do not call __kmp_serial_initialize(), it will be called by
2606   // __kmp_parallel_initialize() if needed
2607   // possible detection of false-positive race by the threadchecker ???
2608   if (!TCR_4(__kmp_init_parallel))
2609     __kmp_parallel_initialize();
2610 
2611 // check correctness of reduce block nesting
2612 #if KMP_USE_DYNAMIC_LOCK
2613   if (__kmp_env_consistency_check)
2614     __kmp_push_sync(global_tid, ct_reduce, loc, NULL, 0);
2615 #else
2616   if (__kmp_env_consistency_check)
2617     __kmp_push_sync(global_tid, ct_reduce, loc, NULL);
2618 #endif
2619 
2620 #if OMP_40_ENABLED
2621   th = __kmp_thread_from_gtid(global_tid);
2622   if (th->th.th_teams_microtask) { // AC: check if we are inside the teams
2623     // construct?
2624     team = th->th.th_team;
2625     if (team->t.t_level == th->th.th_teams_level) {
2626       // this is reduction at teams construct
2627       KMP_DEBUG_ASSERT(!th->th.th_info.ds.ds_tid); // AC: check that tid == 0
2628       // Let's swap teams temporarily for the reduction barrier
2629       teams_swapped = 1;
2630       th->th.th_info.ds.ds_tid = team->t.t_master_tid;
2631       th->th.th_team = team->t.t_parent;
2632       th->th.th_team_nproc = th->th.th_team->t.t_nproc;
2633       th->th.th_task_team = th->th.th_team->t.t_task_team[0];
2634       task_state = th->th.th_task_state;
2635       th->th.th_task_state = 0;
2636     }
2637   }
2638 #endif // OMP_40_ENABLED
2639 
2640   // packed_reduction_method value will be reused by __kmp_end_reduce* function,
2641   // the value should be kept in a variable
2642   // the variable should be either a construct-specific or thread-specific
2643   // property, not a team specific property
2644   //     (a thread can reach the next reduce block on the next construct, reduce
2645   //     method may differ on the next construct)
2646   // an ident_t "loc" parameter could be used as a construct-specific property
2647   // (what if loc == 0?)
2648   //     (if both construct-specific and team-specific variables were shared,
2649   //     then unness extra syncs should be needed)
2650   // a thread-specific variable is better regarding two issues above (next
2651   // construct and extra syncs)
2652   // a thread-specific "th_local.reduction_method" variable is used currently
2653   // each thread executes 'determine' and 'set' lines (no need to execute by one
2654   // thread, to avoid unness extra syncs)
2655 
2656   packed_reduction_method = __kmp_determine_reduction_method(
2657       loc, global_tid, num_vars, reduce_size, reduce_data, reduce_func, lck);
2658   __KMP_SET_REDUCTION_METHOD(global_tid, packed_reduction_method);
2659 
2660   if (packed_reduction_method == critical_reduce_block) {
2661 
2662     __kmp_enter_critical_section_reduce_block(loc, global_tid, lck);
2663     retval = 1;
2664 
2665   } else if (packed_reduction_method == empty_reduce_block) {
2666 
2667     // usage: if team size == 1, no synchronization is required ( Intel
2668     // platforms only )
2669     retval = 1;
2670 
2671   } else if (packed_reduction_method == atomic_reduce_block) {
2672 
2673     retval = 2;
2674 
2675     // all threads should do this pop here (because __kmpc_end_reduce_nowait()
2676     // won't be called by the code gen)
2677     //     (it's not quite good, because the checking block has been closed by
2678     //     this 'pop',
2679     //      but atomic operation has not been executed yet, will be executed
2680     //      slightly later, literally on next instruction)
2681     if (__kmp_env_consistency_check)
2682       __kmp_pop_sync(global_tid, ct_reduce, loc);
2683 
2684   } else if (TEST_REDUCTION_METHOD(packed_reduction_method,
2685                                    tree_reduce_block)) {
2686 
2687 // AT: performance issue: a real barrier here
2688 // AT:     (if master goes slow, other threads are blocked here waiting for the
2689 // master to come and release them)
2690 // AT:     (it's not what a customer might expect specifying NOWAIT clause)
2691 // AT:     (specifying NOWAIT won't result in improvement of performance, it'll
2692 // be confusing to a customer)
2693 // AT: another implementation of *barrier_gather*nowait() (or some other design)
2694 // might go faster and be more in line with sense of NOWAIT
2695 // AT: TO DO: do epcc test and compare times
2696 
2697 // this barrier should be invisible to a customer and to the threading profile
2698 // tool (it's neither a terminating barrier nor customer's code, it's
2699 // used for an internal purpose)
2700 #if USE_ITT_NOTIFY
2701     __kmp_threads[global_tid]->th.th_ident = loc;
2702 #endif
2703     retval =
2704         __kmp_barrier(UNPACK_REDUCTION_BARRIER(packed_reduction_method),
2705                       global_tid, FALSE, reduce_size, reduce_data, reduce_func);
2706     retval = (retval != 0) ? (0) : (1);
2707 
2708     // all other workers except master should do this pop here
2709     //     ( none of other workers will get to __kmpc_end_reduce_nowait() )
2710     if (__kmp_env_consistency_check) {
2711       if (retval == 0) {
2712         __kmp_pop_sync(global_tid, ct_reduce, loc);
2713       }
2714     }
2715 
2716   } else {
2717 
2718     // should never reach this block
2719     KMP_ASSERT(0); // "unexpected method"
2720   }
2721 #if OMP_40_ENABLED
2722   if (teams_swapped) {
2723     // Restore thread structure
2724     th->th.th_info.ds.ds_tid = 0;
2725     th->th.th_team = team;
2726     th->th.th_team_nproc = team->t.t_nproc;
2727     th->th.th_task_team = team->t.t_task_team[task_state];
2728     th->th.th_task_state = task_state;
2729   }
2730 #endif
2731   KA_TRACE(
2732       10,
2733       ("__kmpc_reduce_nowait() exit: called T#%d: method %08x, returns %08x\n",
2734        global_tid, packed_reduction_method, retval));
2735 
2736   return retval;
2737 }
2738 
2739 /*!
2740 @ingroup SYNCHRONIZATION
2741 @param loc source location information
2742 @param global_tid global thread id.
2743 @param lck pointer to the unique lock data structure
2744 
2745 Finish the execution of a reduce nowait.
2746 */
2747 void __kmpc_end_reduce_nowait(ident_t *loc, kmp_int32 global_tid,
2748                               kmp_critical_name *lck) {
2749 
2750   PACKED_REDUCTION_METHOD_T packed_reduction_method;
2751 
2752   KA_TRACE(10, ("__kmpc_end_reduce_nowait() enter: called T#%d\n", global_tid));
2753 
2754   packed_reduction_method = __KMP_GET_REDUCTION_METHOD(global_tid);
2755 
2756   if (packed_reduction_method == critical_reduce_block) {
2757 
2758     __kmp_end_critical_section_reduce_block(loc, global_tid, lck);
2759 
2760   } else if (packed_reduction_method == empty_reduce_block) {
2761 
2762     // usage: if team size == 1, no synchronization is required ( on Intel
2763     // platforms only )
2764 
2765   } else if (packed_reduction_method == atomic_reduce_block) {
2766 
2767     // neither master nor other workers should get here
2768     //     (code gen does not generate this call in case 2: atomic reduce block)
2769     // actually it's better to remove this elseif at all;
2770     // after removal this value will checked by the 'else' and will assert
2771 
2772   } else if (TEST_REDUCTION_METHOD(packed_reduction_method,
2773                                    tree_reduce_block)) {
2774 
2775     // only master gets here
2776 
2777   } else {
2778 
2779     // should never reach this block
2780     KMP_ASSERT(0); // "unexpected method"
2781   }
2782 
2783   if (__kmp_env_consistency_check)
2784     __kmp_pop_sync(global_tid, ct_reduce, loc);
2785 
2786   KA_TRACE(10, ("__kmpc_end_reduce_nowait() exit: called T#%d: method %08x\n",
2787                 global_tid, packed_reduction_method));
2788 
2789   return;
2790 }
2791 
2792 /* 2.a.ii. Reduce Block with a terminating barrier */
2793 
2794 /*!
2795 @ingroup SYNCHRONIZATION
2796 @param loc source location information
2797 @param global_tid global thread number
2798 @param num_vars number of items (variables) to be reduced
2799 @param reduce_size size of data in bytes to be reduced
2800 @param reduce_data pointer to data to be reduced
2801 @param reduce_func callback function providing reduction operation on two
2802 operands and returning result of reduction in lhs_data
2803 @param lck pointer to the unique lock data structure
2804 @result 1 for the master thread, 0 for all other team threads, 2 for all team
2805 threads if atomic reduction needed
2806 
2807 A blocking reduce that includes an implicit barrier.
2808 */
2809 kmp_int32 __kmpc_reduce(ident_t *loc, kmp_int32 global_tid, kmp_int32 num_vars,
2810                         size_t reduce_size, void *reduce_data,
2811                         void (*reduce_func)(void *lhs_data, void *rhs_data),
2812                         kmp_critical_name *lck) {
2813   KMP_COUNT_BLOCK(REDUCE_wait);
2814   int retval = 0;
2815   PACKED_REDUCTION_METHOD_T packed_reduction_method;
2816 
2817   KA_TRACE(10, ("__kmpc_reduce() enter: called T#%d\n", global_tid));
2818 
2819   // why do we need this initialization here at all?
2820   // Reduction clause can not be a stand-alone directive.
2821 
2822   // do not call __kmp_serial_initialize(), it will be called by
2823   // __kmp_parallel_initialize() if needed
2824   // possible detection of false-positive race by the threadchecker ???
2825   if (!TCR_4(__kmp_init_parallel))
2826     __kmp_parallel_initialize();
2827 
2828 // check correctness of reduce block nesting
2829 #if KMP_USE_DYNAMIC_LOCK
2830   if (__kmp_env_consistency_check)
2831     __kmp_push_sync(global_tid, ct_reduce, loc, NULL, 0);
2832 #else
2833   if (__kmp_env_consistency_check)
2834     __kmp_push_sync(global_tid, ct_reduce, loc, NULL);
2835 #endif
2836 
2837   packed_reduction_method = __kmp_determine_reduction_method(
2838       loc, global_tid, num_vars, reduce_size, reduce_data, reduce_func, lck);
2839   __KMP_SET_REDUCTION_METHOD(global_tid, packed_reduction_method);
2840 
2841   if (packed_reduction_method == critical_reduce_block) {
2842 
2843     __kmp_enter_critical_section_reduce_block(loc, global_tid, lck);
2844     retval = 1;
2845 
2846   } else if (packed_reduction_method == empty_reduce_block) {
2847 
2848     // usage: if team size == 1, no synchronization is required ( Intel
2849     // platforms only )
2850     retval = 1;
2851 
2852   } else if (packed_reduction_method == atomic_reduce_block) {
2853 
2854     retval = 2;
2855 
2856   } else if (TEST_REDUCTION_METHOD(packed_reduction_method,
2857                                    tree_reduce_block)) {
2858 
2859 // case tree_reduce_block:
2860 // this barrier should be visible to a customer and to the threading profile
2861 // tool (it's a terminating barrier on constructs if NOWAIT not specified)
2862 #if USE_ITT_NOTIFY
2863     __kmp_threads[global_tid]->th.th_ident =
2864         loc; // needed for correct notification of frames
2865 #endif
2866     retval =
2867         __kmp_barrier(UNPACK_REDUCTION_BARRIER(packed_reduction_method),
2868                       global_tid, TRUE, reduce_size, reduce_data, reduce_func);
2869     retval = (retval != 0) ? (0) : (1);
2870 
2871     // all other workers except master should do this pop here
2872     // ( none of other workers except master will enter __kmpc_end_reduce() )
2873     if (__kmp_env_consistency_check) {
2874       if (retval == 0) { // 0: all other workers; 1: master
2875         __kmp_pop_sync(global_tid, ct_reduce, loc);
2876       }
2877     }
2878 
2879   } else {
2880 
2881     // should never reach this block
2882     KMP_ASSERT(0); // "unexpected method"
2883   }
2884 
2885   KA_TRACE(10,
2886            ("__kmpc_reduce() exit: called T#%d: method %08x, returns %08x\n",
2887             global_tid, packed_reduction_method, retval));
2888 
2889   return retval;
2890 }
2891 
2892 /*!
2893 @ingroup SYNCHRONIZATION
2894 @param loc source location information
2895 @param global_tid global thread id.
2896 @param lck pointer to the unique lock data structure
2897 
2898 Finish the execution of a blocking reduce.
2899 The <tt>lck</tt> pointer must be the same as that used in the corresponding
2900 start function.
2901 */
2902 void __kmpc_end_reduce(ident_t *loc, kmp_int32 global_tid,
2903                        kmp_critical_name *lck) {
2904 
2905   PACKED_REDUCTION_METHOD_T packed_reduction_method;
2906 
2907   KA_TRACE(10, ("__kmpc_end_reduce() enter: called T#%d\n", global_tid));
2908 
2909   packed_reduction_method = __KMP_GET_REDUCTION_METHOD(global_tid);
2910 
2911   // this barrier should be visible to a customer and to the threading profile
2912   // tool (it's a terminating barrier on constructs if NOWAIT not specified)
2913 
2914   if (packed_reduction_method == critical_reduce_block) {
2915 
2916     __kmp_end_critical_section_reduce_block(loc, global_tid, lck);
2917 
2918 // TODO: implicit barrier: should be exposed
2919 #if USE_ITT_NOTIFY
2920     __kmp_threads[global_tid]->th.th_ident = loc;
2921 #endif
2922     __kmp_barrier(bs_plain_barrier, global_tid, FALSE, 0, NULL, NULL);
2923 
2924   } else if (packed_reduction_method == empty_reduce_block) {
2925 
2926 // usage: if team size==1, no synchronization is required (Intel platforms only)
2927 
2928 // TODO: implicit barrier: should be exposed
2929 #if USE_ITT_NOTIFY
2930     __kmp_threads[global_tid]->th.th_ident = loc;
2931 #endif
2932     __kmp_barrier(bs_plain_barrier, global_tid, FALSE, 0, NULL, NULL);
2933 
2934   } else if (packed_reduction_method == atomic_reduce_block) {
2935 
2936 // TODO: implicit barrier: should be exposed
2937 #if USE_ITT_NOTIFY
2938     __kmp_threads[global_tid]->th.th_ident = loc;
2939 #endif
2940     __kmp_barrier(bs_plain_barrier, global_tid, FALSE, 0, NULL, NULL);
2941 
2942   } else if (TEST_REDUCTION_METHOD(packed_reduction_method,
2943                                    tree_reduce_block)) {
2944 
2945     // only master executes here (master releases all other workers)
2946     __kmp_end_split_barrier(UNPACK_REDUCTION_BARRIER(packed_reduction_method),
2947                             global_tid);
2948 
2949   } else {
2950 
2951     // should never reach this block
2952     KMP_ASSERT(0); // "unexpected method"
2953   }
2954 
2955   if (__kmp_env_consistency_check)
2956     __kmp_pop_sync(global_tid, ct_reduce, loc);
2957 
2958   KA_TRACE(10, ("__kmpc_end_reduce() exit: called T#%d: method %08x\n",
2959                 global_tid, packed_reduction_method));
2960 
2961   return;
2962 }
2963 
2964 #undef __KMP_GET_REDUCTION_METHOD
2965 #undef __KMP_SET_REDUCTION_METHOD
2966 
2967 /* end of interface to fast scalable reduce routines */
2968 
2969 kmp_uint64 __kmpc_get_taskid() {
2970 
2971   kmp_int32 gtid;
2972   kmp_info_t *thread;
2973 
2974   gtid = __kmp_get_gtid();
2975   if (gtid < 0) {
2976     return 0;
2977   }
2978   thread = __kmp_thread_from_gtid(gtid);
2979   return thread->th.th_current_task->td_task_id;
2980 
2981 } // __kmpc_get_taskid
2982 
2983 kmp_uint64 __kmpc_get_parent_taskid() {
2984 
2985   kmp_int32 gtid;
2986   kmp_info_t *thread;
2987   kmp_taskdata_t *parent_task;
2988 
2989   gtid = __kmp_get_gtid();
2990   if (gtid < 0) {
2991     return 0;
2992   }
2993   thread = __kmp_thread_from_gtid(gtid);
2994   parent_task = thread->th.th_current_task->td_parent;
2995   return (parent_task == NULL ? 0 : parent_task->td_task_id);
2996 
2997 } // __kmpc_get_parent_taskid
2998 
2999 #if OMP_45_ENABLED
3000 /*!
3001 @ingroup WORK_SHARING
3002 @param loc  source location information.
3003 @param gtid  global thread number.
3004 @param num_dims  number of associated doacross loops.
3005 @param dims  info on loops bounds.
3006 
3007 Initialize doacross loop information.
3008 Expect compiler send us inclusive bounds,
3009 e.g. for(i=2;i<9;i+=2) lo=2, up=8, st=2.
3010 */
3011 void __kmpc_doacross_init(ident_t *loc, int gtid, int num_dims,
3012                           struct kmp_dim *dims) {
3013   int j, idx;
3014   kmp_int64 last, trace_count;
3015   kmp_info_t *th = __kmp_threads[gtid];
3016   kmp_team_t *team = th->th.th_team;
3017   kmp_uint32 *flags;
3018   kmp_disp_t *pr_buf = th->th.th_dispatch;
3019   dispatch_shared_info_t *sh_buf;
3020 
3021   KA_TRACE(
3022       20,
3023       ("__kmpc_doacross_init() enter: called T#%d, num dims %d, active %d\n",
3024        gtid, num_dims, !team->t.t_serialized));
3025   KMP_DEBUG_ASSERT(dims != NULL);
3026   KMP_DEBUG_ASSERT(num_dims > 0);
3027 
3028   if (team->t.t_serialized) {
3029     KA_TRACE(20, ("__kmpc_doacross_init() exit: serialized team\n"));
3030     return; // no dependencies if team is serialized
3031   }
3032   KMP_DEBUG_ASSERT(team->t.t_nproc > 1);
3033   idx = pr_buf->th_doacross_buf_idx++; // Increment index of shared buffer for
3034   // the next loop
3035   sh_buf = &team->t.t_disp_buffer[idx % __kmp_dispatch_num_buffers];
3036 
3037   // Save bounds info into allocated private buffer
3038   KMP_DEBUG_ASSERT(pr_buf->th_doacross_info == NULL);
3039   pr_buf->th_doacross_info = (kmp_int64 *)__kmp_thread_malloc(
3040       th, sizeof(kmp_int64) * (4 * num_dims + 1));
3041   KMP_DEBUG_ASSERT(pr_buf->th_doacross_info != NULL);
3042   pr_buf->th_doacross_info[0] =
3043       (kmp_int64)num_dims; // first element is number of dimensions
3044   // Save also address of num_done in order to access it later without knowing
3045   // the buffer index
3046   pr_buf->th_doacross_info[1] = (kmp_int64)&sh_buf->doacross_num_done;
3047   pr_buf->th_doacross_info[2] = dims[0].lo;
3048   pr_buf->th_doacross_info[3] = dims[0].up;
3049   pr_buf->th_doacross_info[4] = dims[0].st;
3050   last = 5;
3051   for (j = 1; j < num_dims; ++j) {
3052     kmp_int64
3053         range_length; // To keep ranges of all dimensions but the first dims[0]
3054     if (dims[j].st == 1) { // most common case
3055       // AC: should we care of ranges bigger than LLONG_MAX? (not for now)
3056       range_length = dims[j].up - dims[j].lo + 1;
3057     } else {
3058       if (dims[j].st > 0) {
3059         KMP_DEBUG_ASSERT(dims[j].up > dims[j].lo);
3060         range_length = (kmp_uint64)(dims[j].up - dims[j].lo) / dims[j].st + 1;
3061       } else { // negative increment
3062         KMP_DEBUG_ASSERT(dims[j].lo > dims[j].up);
3063         range_length =
3064             (kmp_uint64)(dims[j].lo - dims[j].up) / (-dims[j].st) + 1;
3065       }
3066     }
3067     pr_buf->th_doacross_info[last++] = range_length;
3068     pr_buf->th_doacross_info[last++] = dims[j].lo;
3069     pr_buf->th_doacross_info[last++] = dims[j].up;
3070     pr_buf->th_doacross_info[last++] = dims[j].st;
3071   }
3072 
3073   // Compute total trip count.
3074   // Start with range of dims[0] which we don't need to keep in the buffer.
3075   if (dims[0].st == 1) { // most common case
3076     trace_count = dims[0].up - dims[0].lo + 1;
3077   } else if (dims[0].st > 0) {
3078     KMP_DEBUG_ASSERT(dims[0].up > dims[0].lo);
3079     trace_count = (kmp_uint64)(dims[0].up - dims[0].lo) / dims[0].st + 1;
3080   } else { // negative increment
3081     KMP_DEBUG_ASSERT(dims[0].lo > dims[0].up);
3082     trace_count = (kmp_uint64)(dims[0].lo - dims[0].up) / (-dims[0].st) + 1;
3083   }
3084   for (j = 1; j < num_dims; ++j) {
3085     trace_count *= pr_buf->th_doacross_info[4 * j + 1]; // use kept ranges
3086   }
3087   KMP_DEBUG_ASSERT(trace_count > 0);
3088 
3089   // Check if shared buffer is not occupied by other loop (idx -
3090   // __kmp_dispatch_num_buffers)
3091   if (idx != sh_buf->doacross_buf_idx) {
3092     // Shared buffer is occupied, wait for it to be free
3093     __kmp_wait_yield_4((volatile kmp_uint32 *)&sh_buf->doacross_buf_idx, idx,
3094                        __kmp_eq_4, NULL);
3095   }
3096   // Check if we are the first thread. After the CAS the first thread gets 0,
3097   // others get 1 if initialization is in progress, allocated pointer otherwise.
3098   flags = (kmp_uint32 *)KMP_COMPARE_AND_STORE_RET64(
3099       (kmp_int64 *)&sh_buf->doacross_flags, NULL, (kmp_int64)1);
3100   if (flags == NULL) {
3101     // we are the first thread, allocate the array of flags
3102     kmp_int64 size =
3103         trace_count / 8 + 8; // in bytes, use single bit per iteration
3104     sh_buf->doacross_flags = (kmp_uint32 *)__kmp_thread_calloc(th, size, 1);
3105   } else if ((kmp_int64)flags == 1) {
3106     // initialization is still in progress, need to wait
3107     while ((volatile kmp_int64)sh_buf->doacross_flags == 1) {
3108       KMP_YIELD(TRUE);
3109     }
3110   }
3111   KMP_DEBUG_ASSERT((kmp_int64)sh_buf->doacross_flags >
3112                    1); // check value of pointer
3113   pr_buf->th_doacross_flags =
3114       sh_buf->doacross_flags; // save private copy in order to not
3115   // touch shared buffer on each iteration
3116   KA_TRACE(20, ("__kmpc_doacross_init() exit: T#%d\n", gtid));
3117 }
3118 
3119 void __kmpc_doacross_wait(ident_t *loc, int gtid, long long *vec) {
3120   kmp_int32 shft, num_dims, i;
3121   kmp_uint32 flag;
3122   kmp_int64 iter_number; // iteration number of "collapsed" loop nest
3123   kmp_info_t *th = __kmp_threads[gtid];
3124   kmp_team_t *team = th->th.th_team;
3125   kmp_disp_t *pr_buf;
3126   kmp_int64 lo, up, st;
3127 
3128   KA_TRACE(20, ("__kmpc_doacross_wait() enter: called T#%d\n", gtid));
3129   if (team->t.t_serialized) {
3130     KA_TRACE(20, ("__kmpc_doacross_wait() exit: serialized team\n"));
3131     return; // no dependencies if team is serialized
3132   }
3133 
3134   // calculate sequential iteration number and check out-of-bounds condition
3135   pr_buf = th->th.th_dispatch;
3136   KMP_DEBUG_ASSERT(pr_buf->th_doacross_info != NULL);
3137   num_dims = pr_buf->th_doacross_info[0];
3138   lo = pr_buf->th_doacross_info[2];
3139   up = pr_buf->th_doacross_info[3];
3140   st = pr_buf->th_doacross_info[4];
3141   if (st == 1) { // most common case
3142     if (vec[0] < lo || vec[0] > up) {
3143       KA_TRACE(20, ("__kmpc_doacross_wait() exit: T#%d iter %lld is out of "
3144                     "bounds [%lld,%lld]\n",
3145                     gtid, vec[0], lo, up));
3146       return;
3147     }
3148     iter_number = vec[0] - lo;
3149   } else if (st > 0) {
3150     if (vec[0] < lo || vec[0] > up) {
3151       KA_TRACE(20, ("__kmpc_doacross_wait() exit: T#%d iter %lld is out of "
3152                     "bounds [%lld,%lld]\n",
3153                     gtid, vec[0], lo, up));
3154       return;
3155     }
3156     iter_number = (kmp_uint64)(vec[0] - lo) / st;
3157   } else { // negative increment
3158     if (vec[0] > lo || vec[0] < up) {
3159       KA_TRACE(20, ("__kmpc_doacross_wait() exit: T#%d iter %lld is out of "
3160                     "bounds [%lld,%lld]\n",
3161                     gtid, vec[0], lo, up));
3162       return;
3163     }
3164     iter_number = (kmp_uint64)(lo - vec[0]) / (-st);
3165   }
3166   for (i = 1; i < num_dims; ++i) {
3167     kmp_int64 iter, ln;
3168     kmp_int32 j = i * 4;
3169     ln = pr_buf->th_doacross_info[j + 1];
3170     lo = pr_buf->th_doacross_info[j + 2];
3171     up = pr_buf->th_doacross_info[j + 3];
3172     st = pr_buf->th_doacross_info[j + 4];
3173     if (st == 1) {
3174       if (vec[i] < lo || vec[i] > up) {
3175         KA_TRACE(20, ("__kmpc_doacross_wait() exit: T#%d iter %lld is out of "
3176                       "bounds [%lld,%lld]\n",
3177                       gtid, vec[i], lo, up));
3178         return;
3179       }
3180       iter = vec[i] - lo;
3181     } else if (st > 0) {
3182       if (vec[i] < lo || vec[i] > up) {
3183         KA_TRACE(20, ("__kmpc_doacross_wait() exit: T#%d iter %lld is out of "
3184                       "bounds [%lld,%lld]\n",
3185                       gtid, vec[i], lo, up));
3186         return;
3187       }
3188       iter = (kmp_uint64)(vec[i] - lo) / st;
3189     } else { // st < 0
3190       if (vec[i] > lo || vec[i] < up) {
3191         KA_TRACE(20, ("__kmpc_doacross_wait() exit: T#%d iter %lld is out of "
3192                       "bounds [%lld,%lld]\n",
3193                       gtid, vec[i], lo, up));
3194         return;
3195       }
3196       iter = (kmp_uint64)(lo - vec[i]) / (-st);
3197     }
3198     iter_number = iter + ln * iter_number;
3199   }
3200   shft = iter_number % 32; // use 32-bit granularity
3201   iter_number >>= 5; // divided by 32
3202   flag = 1 << shft;
3203   while ((flag & pr_buf->th_doacross_flags[iter_number]) == 0) {
3204     KMP_YIELD(TRUE);
3205   }
3206   KA_TRACE(20,
3207            ("__kmpc_doacross_wait() exit: T#%d wait for iter %lld completed\n",
3208             gtid, (iter_number << 5) + shft));
3209 }
3210 
3211 void __kmpc_doacross_post(ident_t *loc, int gtid, long long *vec) {
3212   kmp_int32 shft, num_dims, i;
3213   kmp_uint32 flag;
3214   kmp_int64 iter_number; // iteration number of "collapsed" loop nest
3215   kmp_info_t *th = __kmp_threads[gtid];
3216   kmp_team_t *team = th->th.th_team;
3217   kmp_disp_t *pr_buf;
3218   kmp_int64 lo, st;
3219 
3220   KA_TRACE(20, ("__kmpc_doacross_post() enter: called T#%d\n", gtid));
3221   if (team->t.t_serialized) {
3222     KA_TRACE(20, ("__kmpc_doacross_post() exit: serialized team\n"));
3223     return; // no dependencies if team is serialized
3224   }
3225 
3226   // calculate sequential iteration number (same as in "wait" but no
3227   // out-of-bounds checks)
3228   pr_buf = th->th.th_dispatch;
3229   KMP_DEBUG_ASSERT(pr_buf->th_doacross_info != NULL);
3230   num_dims = pr_buf->th_doacross_info[0];
3231   lo = pr_buf->th_doacross_info[2];
3232   st = pr_buf->th_doacross_info[4];
3233   if (st == 1) { // most common case
3234     iter_number = vec[0] - lo;
3235   } else if (st > 0) {
3236     iter_number = (kmp_uint64)(vec[0] - lo) / st;
3237   } else { // negative increment
3238     iter_number = (kmp_uint64)(lo - vec[0]) / (-st);
3239   }
3240   for (i = 1; i < num_dims; ++i) {
3241     kmp_int64 iter, ln;
3242     kmp_int32 j = i * 4;
3243     ln = pr_buf->th_doacross_info[j + 1];
3244     lo = pr_buf->th_doacross_info[j + 2];
3245     st = pr_buf->th_doacross_info[j + 4];
3246     if (st == 1) {
3247       iter = vec[i] - lo;
3248     } else if (st > 0) {
3249       iter = (kmp_uint64)(vec[i] - lo) / st;
3250     } else { // st < 0
3251       iter = (kmp_uint64)(lo - vec[i]) / (-st);
3252     }
3253     iter_number = iter + ln * iter_number;
3254   }
3255   shft = iter_number % 32; // use 32-bit granularity
3256   iter_number >>= 5; // divided by 32
3257   flag = 1 << shft;
3258   if ((flag & pr_buf->th_doacross_flags[iter_number]) == 0)
3259     KMP_TEST_THEN_OR32(&pr_buf->th_doacross_flags[iter_number], flag);
3260   KA_TRACE(20, ("__kmpc_doacross_post() exit: T#%d iter %lld posted\n", gtid,
3261                 (iter_number << 5) + shft));
3262 }
3263 
3264 void __kmpc_doacross_fini(ident_t *loc, int gtid) {
3265   kmp_int64 num_done;
3266   kmp_info_t *th = __kmp_threads[gtid];
3267   kmp_team_t *team = th->th.th_team;
3268   kmp_disp_t *pr_buf = th->th.th_dispatch;
3269 
3270   KA_TRACE(20, ("__kmpc_doacross_fini() enter: called T#%d\n", gtid));
3271   if (team->t.t_serialized) {
3272     KA_TRACE(20, ("__kmpc_doacross_fini() exit: serialized team %p\n", team));
3273     return; // nothing to do
3274   }
3275   num_done = KMP_TEST_THEN_INC64((kmp_int64 *)pr_buf->th_doacross_info[1]) + 1;
3276   if (num_done == th->th.th_team_nproc) {
3277     // we are the last thread, need to free shared resources
3278     int idx = pr_buf->th_doacross_buf_idx - 1;
3279     dispatch_shared_info_t *sh_buf =
3280         &team->t.t_disp_buffer[idx % __kmp_dispatch_num_buffers];
3281     KMP_DEBUG_ASSERT(pr_buf->th_doacross_info[1] ==
3282                      (kmp_int64)&sh_buf->doacross_num_done);
3283     KMP_DEBUG_ASSERT(num_done == (kmp_int64)sh_buf->doacross_num_done);
3284     KMP_DEBUG_ASSERT(idx == sh_buf->doacross_buf_idx);
3285     __kmp_thread_free(th, CCAST(kmp_uint32 *, sh_buf->doacross_flags));
3286     sh_buf->doacross_flags = NULL;
3287     sh_buf->doacross_num_done = 0;
3288     sh_buf->doacross_buf_idx +=
3289         __kmp_dispatch_num_buffers; // free buffer for future re-use
3290   }
3291   // free private resources (need to keep buffer index forever)
3292   __kmp_thread_free(th, (void *)pr_buf->th_doacross_info);
3293   pr_buf->th_doacross_info = NULL;
3294   KA_TRACE(20, ("__kmpc_doacross_fini() exit: T#%d\n", gtid));
3295 }
3296 #endif
3297 
3298 // end of file //
3299