LLVM OpenMP* Runtime Library
kmp_runtime.cpp
1 /*
2  * kmp_runtime.cpp -- KPTS runtime support library
3  */
4 
5 //===----------------------------------------------------------------------===//
6 //
7 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
8 // See https://llvm.org/LICENSE.txt for license information.
9 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
10 //
11 //===----------------------------------------------------------------------===//
12 
13 #include "kmp.h"
14 #include "kmp_affinity.h"
15 #include "kmp_atomic.h"
16 #include "kmp_environment.h"
17 #include "kmp_error.h"
18 #include "kmp_i18n.h"
19 #include "kmp_io.h"
20 #include "kmp_itt.h"
21 #include "kmp_settings.h"
22 #include "kmp_stats.h"
23 #include "kmp_str.h"
24 #include "kmp_wait_release.h"
25 #include "kmp_wrapper_getpid.h"
26 #include "kmp_dispatch.h"
27 #if KMP_USE_HIER_SCHED
28 #include "kmp_dispatch_hier.h"
29 #endif
30 
31 #if OMPT_SUPPORT
32 #include "ompt-specific.h"
33 #endif
34 #if OMPD_SUPPORT
35 #include "ompd-specific.h"
36 #endif
37 
38 #if OMP_PROFILING_SUPPORT
39 #include "llvm/Support/TimeProfiler.h"
40 static char *ProfileTraceFile = nullptr;
41 #endif
42 
43 /* these are temporary issues to be dealt with */
44 #define KMP_USE_PRCTL 0
45 
46 #if KMP_OS_WINDOWS
47 #include <process.h>
48 #endif
49 
50 #if KMP_OS_WINDOWS
51 // windows does not need include files as it doesn't use shared memory
52 #else
53 #include <sys/mman.h>
54 #include <sys/stat.h>
55 #include <fcntl.h>
56 #define SHM_SIZE 1024
57 #endif
58 
59 #if defined(KMP_GOMP_COMPAT)
60 char const __kmp_version_alt_comp[] =
61  KMP_VERSION_PREFIX "alternative compiler support: yes";
62 #endif /* defined(KMP_GOMP_COMPAT) */
63 
64 char const __kmp_version_omp_api[] =
65  KMP_VERSION_PREFIX "API version: 5.0 (201611)";
66 
67 #ifdef KMP_DEBUG
68 char const __kmp_version_lock[] =
69  KMP_VERSION_PREFIX "lock type: run time selectable";
70 #endif /* KMP_DEBUG */
71 
72 #define KMP_MIN(x, y) ((x) < (y) ? (x) : (y))
73 
74 /* ------------------------------------------------------------------------ */
75 
76 #if KMP_USE_MONITOR
77 kmp_info_t __kmp_monitor;
78 #endif
79 
80 /* Forward declarations */
81 
82 void __kmp_cleanup(void);
83 
84 static void __kmp_initialize_info(kmp_info_t *, kmp_team_t *, int tid,
85  int gtid);
86 static void __kmp_initialize_team(kmp_team_t *team, int new_nproc,
87  kmp_internal_control_t *new_icvs,
88  ident_t *loc);
89 #if KMP_AFFINITY_SUPPORTED
90 static void __kmp_partition_places(kmp_team_t *team,
91  int update_master_only = 0);
92 #endif
93 static void __kmp_do_serial_initialize(void);
94 void __kmp_fork_barrier(int gtid, int tid);
95 void __kmp_join_barrier(int gtid);
96 void __kmp_setup_icv_copy(kmp_team_t *team, int new_nproc,
97  kmp_internal_control_t *new_icvs, ident_t *loc);
98 
99 #ifdef USE_LOAD_BALANCE
100 static int __kmp_load_balance_nproc(kmp_root_t *root, int set_nproc);
101 #endif
102 
103 static int __kmp_expand_threads(int nNeed);
104 #if KMP_OS_WINDOWS
105 static int __kmp_unregister_root_other_thread(int gtid);
106 #endif
107 static void __kmp_reap_thread(kmp_info_t *thread, int is_root);
108 kmp_info_t *__kmp_thread_pool_insert_pt = NULL;
109 
110 /* Calculate the identifier of the current thread */
111 /* fast (and somewhat portable) way to get unique identifier of executing
112  thread. Returns KMP_GTID_DNE if we haven't been assigned a gtid. */
113 int __kmp_get_global_thread_id() {
114  int i;
115  kmp_info_t **other_threads;
116  size_t stack_data;
117  char *stack_addr;
118  size_t stack_size;
119  char *stack_base;
120 
121  KA_TRACE(
122  1000,
123  ("*** __kmp_get_global_thread_id: entering, nproc=%d all_nproc=%d\n",
124  __kmp_nth, __kmp_all_nth));
125 
126  /* JPH - to handle the case where __kmpc_end(0) is called immediately prior to
127  a parallel region, made it return KMP_GTID_DNE to force serial_initialize
128  by caller. Had to handle KMP_GTID_DNE at all call-sites, or else guarantee
129  __kmp_init_gtid for this to work. */
130 
131  if (!TCR_4(__kmp_init_gtid))
132  return KMP_GTID_DNE;
133 
134 #ifdef KMP_TDATA_GTID
135  if (TCR_4(__kmp_gtid_mode) >= 3) {
136  KA_TRACE(1000, ("*** __kmp_get_global_thread_id: using TDATA\n"));
137  return __kmp_gtid;
138  }
139 #endif
140  if (TCR_4(__kmp_gtid_mode) >= 2) {
141  KA_TRACE(1000, ("*** __kmp_get_global_thread_id: using keyed TLS\n"));
142  return __kmp_gtid_get_specific();
143  }
144  KA_TRACE(1000, ("*** __kmp_get_global_thread_id: using internal alg.\n"));
145 
146  stack_addr = (char *)&stack_data;
147  other_threads = __kmp_threads;
148 
149  /* ATT: The code below is a source of potential bugs due to unsynchronized
150  access to __kmp_threads array. For example:
151  1. Current thread loads other_threads[i] to thr and checks it, it is
152  non-NULL.
153  2. Current thread is suspended by OS.
154  3. Another thread unregisters and finishes (debug versions of free()
155  may fill memory with something like 0xEF).
156  4. Current thread is resumed.
157  5. Current thread reads junk from *thr.
158  TODO: Fix it. --ln */
159 
160  for (i = 0; i < __kmp_threads_capacity; i++) {
161 
162  kmp_info_t *thr = (kmp_info_t *)TCR_SYNC_PTR(other_threads[i]);
163  if (!thr)
164  continue;
165 
166  stack_size = (size_t)TCR_PTR(thr->th.th_info.ds.ds_stacksize);
167  stack_base = (char *)TCR_PTR(thr->th.th_info.ds.ds_stackbase);
168 
169  /* stack grows down -- search through all of the active threads */
170 
171  if (stack_addr <= stack_base) {
172  size_t stack_diff = stack_base - stack_addr;
173 
174  if (stack_diff <= stack_size) {
175  /* The only way we can be closer than the allocated */
176  /* stack size is if we are running on this thread. */
177  KMP_DEBUG_ASSERT(__kmp_gtid_get_specific() == i);
178  return i;
179  }
180  }
181  }
182 
183  /* get specific to try and determine our gtid */
184  KA_TRACE(1000,
185  ("*** __kmp_get_global_thread_id: internal alg. failed to find "
186  "thread, using TLS\n"));
187  i = __kmp_gtid_get_specific();
188 
189  /*fprintf( stderr, "=== %d\n", i ); */ /* GROO */
190 
191  /* if we havn't been assigned a gtid, then return code */
192  if (i < 0)
193  return i;
194 
195  /* dynamically updated stack window for uber threads to avoid get_specific
196  call */
197  if (!TCR_4(other_threads[i]->th.th_info.ds.ds_stackgrow)) {
198  KMP_FATAL(StackOverflow, i);
199  }
200 
201  stack_base = (char *)other_threads[i]->th.th_info.ds.ds_stackbase;
202  if (stack_addr > stack_base) {
203  TCW_PTR(other_threads[i]->th.th_info.ds.ds_stackbase, stack_addr);
204  TCW_PTR(other_threads[i]->th.th_info.ds.ds_stacksize,
205  other_threads[i]->th.th_info.ds.ds_stacksize + stack_addr -
206  stack_base);
207  } else {
208  TCW_PTR(other_threads[i]->th.th_info.ds.ds_stacksize,
209  stack_base - stack_addr);
210  }
211 
212  /* Reprint stack bounds for ubermaster since they have been refined */
213  if (__kmp_storage_map) {
214  char *stack_end = (char *)other_threads[i]->th.th_info.ds.ds_stackbase;
215  char *stack_beg = stack_end - other_threads[i]->th.th_info.ds.ds_stacksize;
216  __kmp_print_storage_map_gtid(i, stack_beg, stack_end,
217  other_threads[i]->th.th_info.ds.ds_stacksize,
218  "th_%d stack (refinement)", i);
219  }
220  return i;
221 }
222 
223 int __kmp_get_global_thread_id_reg() {
224  int gtid;
225 
226  if (!__kmp_init_serial) {
227  gtid = KMP_GTID_DNE;
228  } else
229 #ifdef KMP_TDATA_GTID
230  if (TCR_4(__kmp_gtid_mode) >= 3) {
231  KA_TRACE(1000, ("*** __kmp_get_global_thread_id_reg: using TDATA\n"));
232  gtid = __kmp_gtid;
233  } else
234 #endif
235  if (TCR_4(__kmp_gtid_mode) >= 2) {
236  KA_TRACE(1000, ("*** __kmp_get_global_thread_id_reg: using keyed TLS\n"));
237  gtid = __kmp_gtid_get_specific();
238  } else {
239  KA_TRACE(1000,
240  ("*** __kmp_get_global_thread_id_reg: using internal alg.\n"));
241  gtid = __kmp_get_global_thread_id();
242  }
243 
244  /* we must be a new uber master sibling thread */
245  if (gtid == KMP_GTID_DNE) {
246  KA_TRACE(10,
247  ("__kmp_get_global_thread_id_reg: Encountered new root thread. "
248  "Registering a new gtid.\n"));
249  __kmp_acquire_bootstrap_lock(&__kmp_initz_lock);
250  if (!__kmp_init_serial) {
251  __kmp_do_serial_initialize();
252  gtid = __kmp_gtid_get_specific();
253  } else {
254  gtid = __kmp_register_root(FALSE);
255  }
256  __kmp_release_bootstrap_lock(&__kmp_initz_lock);
257  /*__kmp_printf( "+++ %d\n", gtid ); */ /* GROO */
258  }
259 
260  KMP_DEBUG_ASSERT(gtid >= 0);
261 
262  return gtid;
263 }
264 
265 /* caller must hold forkjoin_lock */
266 void __kmp_check_stack_overlap(kmp_info_t *th) {
267  int f;
268  char *stack_beg = NULL;
269  char *stack_end = NULL;
270  int gtid;
271 
272  KA_TRACE(10, ("__kmp_check_stack_overlap: called\n"));
273  if (__kmp_storage_map) {
274  stack_end = (char *)th->th.th_info.ds.ds_stackbase;
275  stack_beg = stack_end - th->th.th_info.ds.ds_stacksize;
276 
277  gtid = __kmp_gtid_from_thread(th);
278 
279  if (gtid == KMP_GTID_MONITOR) {
280  __kmp_print_storage_map_gtid(
281  gtid, stack_beg, stack_end, th->th.th_info.ds.ds_stacksize,
282  "th_%s stack (%s)", "mon",
283  (th->th.th_info.ds.ds_stackgrow) ? "initial" : "actual");
284  } else {
285  __kmp_print_storage_map_gtid(
286  gtid, stack_beg, stack_end, th->th.th_info.ds.ds_stacksize,
287  "th_%d stack (%s)", gtid,
288  (th->th.th_info.ds.ds_stackgrow) ? "initial" : "actual");
289  }
290  }
291 
292  /* No point in checking ubermaster threads since they use refinement and
293  * cannot overlap */
294  gtid = __kmp_gtid_from_thread(th);
295  if (__kmp_env_checks == TRUE && !KMP_UBER_GTID(gtid)) {
296  KA_TRACE(10,
297  ("__kmp_check_stack_overlap: performing extensive checking\n"));
298  if (stack_beg == NULL) {
299  stack_end = (char *)th->th.th_info.ds.ds_stackbase;
300  stack_beg = stack_end - th->th.th_info.ds.ds_stacksize;
301  }
302 
303  for (f = 0; f < __kmp_threads_capacity; f++) {
304  kmp_info_t *f_th = (kmp_info_t *)TCR_SYNC_PTR(__kmp_threads[f]);
305 
306  if (f_th && f_th != th) {
307  char *other_stack_end =
308  (char *)TCR_PTR(f_th->th.th_info.ds.ds_stackbase);
309  char *other_stack_beg =
310  other_stack_end - (size_t)TCR_PTR(f_th->th.th_info.ds.ds_stacksize);
311  if ((stack_beg > other_stack_beg && stack_beg < other_stack_end) ||
312  (stack_end > other_stack_beg && stack_end < other_stack_end)) {
313 
314  /* Print the other stack values before the abort */
315  if (__kmp_storage_map)
316  __kmp_print_storage_map_gtid(
317  -1, other_stack_beg, other_stack_end,
318  (size_t)TCR_PTR(f_th->th.th_info.ds.ds_stacksize),
319  "th_%d stack (overlapped)", __kmp_gtid_from_thread(f_th));
320 
321  __kmp_fatal(KMP_MSG(StackOverlap), KMP_HNT(ChangeStackLimit),
322  __kmp_msg_null);
323  }
324  }
325  }
326  }
327  KA_TRACE(10, ("__kmp_check_stack_overlap: returning\n"));
328 }
329 
330 /* ------------------------------------------------------------------------ */
331 
332 void __kmp_infinite_loop(void) {
333  static int done = FALSE;
334 
335  while (!done) {
336  KMP_YIELD(TRUE);
337  }
338 }
339 
340 #define MAX_MESSAGE 512
341 
342 void __kmp_print_storage_map_gtid(int gtid, void *p1, void *p2, size_t size,
343  char const *format, ...) {
344  char buffer[MAX_MESSAGE];
345  va_list ap;
346 
347  va_start(ap, format);
348  KMP_SNPRINTF(buffer, sizeof(buffer), "OMP storage map: %p %p%8lu %s\n", p1,
349  p2, (unsigned long)size, format);
350  __kmp_acquire_bootstrap_lock(&__kmp_stdio_lock);
351  __kmp_vprintf(kmp_err, buffer, ap);
352 #if KMP_PRINT_DATA_PLACEMENT
353  int node;
354  if (gtid >= 0) {
355  if (p1 <= p2 && (char *)p2 - (char *)p1 == size) {
356  if (__kmp_storage_map_verbose) {
357  node = __kmp_get_host_node(p1);
358  if (node < 0) /* doesn't work, so don't try this next time */
359  __kmp_storage_map_verbose = FALSE;
360  else {
361  char *last;
362  int lastNode;
363  int localProc = __kmp_get_cpu_from_gtid(gtid);
364 
365  const int page_size = KMP_GET_PAGE_SIZE();
366 
367  p1 = (void *)((size_t)p1 & ~((size_t)page_size - 1));
368  p2 = (void *)(((size_t)p2 - 1) & ~((size_t)page_size - 1));
369  if (localProc >= 0)
370  __kmp_printf_no_lock(" GTID %d localNode %d\n", gtid,
371  localProc >> 1);
372  else
373  __kmp_printf_no_lock(" GTID %d\n", gtid);
374 #if KMP_USE_PRCTL
375  /* The more elaborate format is disabled for now because of the prctl
376  * hanging bug. */
377  do {
378  last = p1;
379  lastNode = node;
380  /* This loop collates adjacent pages with the same host node. */
381  do {
382  (char *)p1 += page_size;
383  } while (p1 <= p2 && (node = __kmp_get_host_node(p1)) == lastNode);
384  __kmp_printf_no_lock(" %p-%p memNode %d\n", last, (char *)p1 - 1,
385  lastNode);
386  } while (p1 <= p2);
387 #else
388  __kmp_printf_no_lock(" %p-%p memNode %d\n", p1,
389  (char *)p1 + (page_size - 1),
390  __kmp_get_host_node(p1));
391  if (p1 < p2) {
392  __kmp_printf_no_lock(" %p-%p memNode %d\n", p2,
393  (char *)p2 + (page_size - 1),
394  __kmp_get_host_node(p2));
395  }
396 #endif
397  }
398  }
399  } else
400  __kmp_printf_no_lock(" %s\n", KMP_I18N_STR(StorageMapWarning));
401  }
402 #endif /* KMP_PRINT_DATA_PLACEMENT */
403  __kmp_release_bootstrap_lock(&__kmp_stdio_lock);
404 }
405 
406 void __kmp_warn(char const *format, ...) {
407  char buffer[MAX_MESSAGE];
408  va_list ap;
409 
410  if (__kmp_generate_warnings == kmp_warnings_off) {
411  return;
412  }
413 
414  va_start(ap, format);
415 
416  KMP_SNPRINTF(buffer, sizeof(buffer), "OMP warning: %s\n", format);
417  __kmp_acquire_bootstrap_lock(&__kmp_stdio_lock);
418  __kmp_vprintf(kmp_err, buffer, ap);
419  __kmp_release_bootstrap_lock(&__kmp_stdio_lock);
420 
421  va_end(ap);
422 }
423 
424 void __kmp_abort_process() {
425  // Later threads may stall here, but that's ok because abort() will kill them.
426  __kmp_acquire_bootstrap_lock(&__kmp_exit_lock);
427 
428  if (__kmp_debug_buf) {
429  __kmp_dump_debug_buffer();
430  }
431 
432  if (KMP_OS_WINDOWS) {
433  // Let other threads know of abnormal termination and prevent deadlock
434  // if abort happened during library initialization or shutdown
435  __kmp_global.g.g_abort = SIGABRT;
436 
437  /* On Windows* OS by default abort() causes pop-up error box, which stalls
438  nightly testing. Unfortunately, we cannot reliably suppress pop-up error
439  boxes. _set_abort_behavior() works well, but this function is not
440  available in VS7 (this is not problem for DLL, but it is a problem for
441  static OpenMP RTL). SetErrorMode (and so, timelimit utility) does not
442  help, at least in some versions of MS C RTL.
443 
444  It seems following sequence is the only way to simulate abort() and
445  avoid pop-up error box. */
446  raise(SIGABRT);
447  _exit(3); // Just in case, if signal ignored, exit anyway.
448  } else {
449  __kmp_unregister_library();
450  abort();
451  }
452 
453  __kmp_infinite_loop();
454  __kmp_release_bootstrap_lock(&__kmp_exit_lock);
455 
456 } // __kmp_abort_process
457 
458 void __kmp_abort_thread(void) {
459  // TODO: Eliminate g_abort global variable and this function.
460  // In case of abort just call abort(), it will kill all the threads.
461  __kmp_infinite_loop();
462 } // __kmp_abort_thread
463 
464 /* Print out the storage map for the major kmp_info_t thread data structures
465  that are allocated together. */
466 
467 static void __kmp_print_thread_storage_map(kmp_info_t *thr, int gtid) {
468  __kmp_print_storage_map_gtid(gtid, thr, thr + 1, sizeof(kmp_info_t), "th_%d",
469  gtid);
470 
471  __kmp_print_storage_map_gtid(gtid, &thr->th.th_info, &thr->th.th_team,
472  sizeof(kmp_desc_t), "th_%d.th_info", gtid);
473 
474  __kmp_print_storage_map_gtid(gtid, &thr->th.th_local, &thr->th.th_pri_head,
475  sizeof(kmp_local_t), "th_%d.th_local", gtid);
476 
477  __kmp_print_storage_map_gtid(
478  gtid, &thr->th.th_bar[0], &thr->th.th_bar[bs_last_barrier],
479  sizeof(kmp_balign_t) * bs_last_barrier, "th_%d.th_bar", gtid);
480 
481  __kmp_print_storage_map_gtid(gtid, &thr->th.th_bar[bs_plain_barrier],
482  &thr->th.th_bar[bs_plain_barrier + 1],
483  sizeof(kmp_balign_t), "th_%d.th_bar[plain]",
484  gtid);
485 
486  __kmp_print_storage_map_gtid(gtid, &thr->th.th_bar[bs_forkjoin_barrier],
487  &thr->th.th_bar[bs_forkjoin_barrier + 1],
488  sizeof(kmp_balign_t), "th_%d.th_bar[forkjoin]",
489  gtid);
490 
491 #if KMP_FAST_REDUCTION_BARRIER
492  __kmp_print_storage_map_gtid(gtid, &thr->th.th_bar[bs_reduction_barrier],
493  &thr->th.th_bar[bs_reduction_barrier + 1],
494  sizeof(kmp_balign_t), "th_%d.th_bar[reduction]",
495  gtid);
496 #endif // KMP_FAST_REDUCTION_BARRIER
497 }
498 
499 /* Print out the storage map for the major kmp_team_t team data structures
500  that are allocated together. */
501 
502 static void __kmp_print_team_storage_map(const char *header, kmp_team_t *team,
503  int team_id, int num_thr) {
504  int num_disp_buff = team->t.t_max_nproc > 1 ? __kmp_dispatch_num_buffers : 2;
505  __kmp_print_storage_map_gtid(-1, team, team + 1, sizeof(kmp_team_t), "%s_%d",
506  header, team_id);
507 
508  __kmp_print_storage_map_gtid(-1, &team->t.t_bar[0],
509  &team->t.t_bar[bs_last_barrier],
510  sizeof(kmp_balign_team_t) * bs_last_barrier,
511  "%s_%d.t_bar", header, team_id);
512 
513  __kmp_print_storage_map_gtid(-1, &team->t.t_bar[bs_plain_barrier],
514  &team->t.t_bar[bs_plain_barrier + 1],
515  sizeof(kmp_balign_team_t), "%s_%d.t_bar[plain]",
516  header, team_id);
517 
518  __kmp_print_storage_map_gtid(-1, &team->t.t_bar[bs_forkjoin_barrier],
519  &team->t.t_bar[bs_forkjoin_barrier + 1],
520  sizeof(kmp_balign_team_t),
521  "%s_%d.t_bar[forkjoin]", header, team_id);
522 
523 #if KMP_FAST_REDUCTION_BARRIER
524  __kmp_print_storage_map_gtid(-1, &team->t.t_bar[bs_reduction_barrier],
525  &team->t.t_bar[bs_reduction_barrier + 1],
526  sizeof(kmp_balign_team_t),
527  "%s_%d.t_bar[reduction]", header, team_id);
528 #endif // KMP_FAST_REDUCTION_BARRIER
529 
530  __kmp_print_storage_map_gtid(
531  -1, &team->t.t_dispatch[0], &team->t.t_dispatch[num_thr],
532  sizeof(kmp_disp_t) * num_thr, "%s_%d.t_dispatch", header, team_id);
533 
534  __kmp_print_storage_map_gtid(
535  -1, &team->t.t_threads[0], &team->t.t_threads[num_thr],
536  sizeof(kmp_info_t *) * num_thr, "%s_%d.t_threads", header, team_id);
537 
538  __kmp_print_storage_map_gtid(-1, &team->t.t_disp_buffer[0],
539  &team->t.t_disp_buffer[num_disp_buff],
540  sizeof(dispatch_shared_info_t) * num_disp_buff,
541  "%s_%d.t_disp_buffer", header, team_id);
542 }
543 
544 static void __kmp_init_allocator() {
545  __kmp_init_memkind();
546  __kmp_init_target_mem();
547 }
548 static void __kmp_fini_allocator() { __kmp_fini_memkind(); }
549 
550 /* ------------------------------------------------------------------------ */
551 
552 #if KMP_DYNAMIC_LIB
553 #if KMP_OS_WINDOWS
554 
555 BOOL WINAPI DllMain(HINSTANCE hInstDLL, DWORD fdwReason, LPVOID lpReserved) {
556  //__kmp_acquire_bootstrap_lock( &__kmp_initz_lock );
557 
558  switch (fdwReason) {
559 
560  case DLL_PROCESS_ATTACH:
561  KA_TRACE(10, ("DllMain: PROCESS_ATTACH\n"));
562 
563  return TRUE;
564 
565  case DLL_PROCESS_DETACH:
566  KA_TRACE(10, ("DllMain: PROCESS_DETACH T#%d\n", __kmp_gtid_get_specific()));
567 
568  // According to Windows* documentation for DllMain entry point:
569  // for DLL_PROCESS_DETACH, lpReserved is used for telling the difference:
570  // lpReserved == NULL when FreeLibrary() is called,
571  // lpReserved != NULL when the process is terminated.
572  // When FreeLibrary() is called, worker threads remain alive. So the
573  // runtime's state is consistent and executing proper shutdown is OK.
574  // When the process is terminated, worker threads have exited or been
575  // forcefully terminated by the OS and only the shutdown thread remains.
576  // This can leave the runtime in an inconsistent state.
577  // Hence, only attempt proper cleanup when FreeLibrary() is called.
578  // Otherwise, rely on OS to reclaim resources.
579  if (lpReserved == NULL)
580  __kmp_internal_end_library(__kmp_gtid_get_specific());
581 
582  return TRUE;
583 
584  case DLL_THREAD_ATTACH:
585  KA_TRACE(10, ("DllMain: THREAD_ATTACH\n"));
586 
587  /* if we want to register new siblings all the time here call
588  * __kmp_get_gtid(); */
589  return TRUE;
590 
591  case DLL_THREAD_DETACH:
592  KA_TRACE(10, ("DllMain: THREAD_DETACH T#%d\n", __kmp_gtid_get_specific()));
593 
594  __kmp_internal_end_thread(__kmp_gtid_get_specific());
595  return TRUE;
596  }
597 
598  return TRUE;
599 }
600 
601 #endif /* KMP_OS_WINDOWS */
602 #endif /* KMP_DYNAMIC_LIB */
603 
604 /* __kmp_parallel_deo -- Wait until it's our turn. */
605 void __kmp_parallel_deo(int *gtid_ref, int *cid_ref, ident_t *loc_ref) {
606  int gtid = *gtid_ref;
607 #ifdef BUILD_PARALLEL_ORDERED
608  kmp_team_t *team = __kmp_team_from_gtid(gtid);
609 #endif /* BUILD_PARALLEL_ORDERED */
610 
611  if (__kmp_env_consistency_check) {
612  if (__kmp_threads[gtid]->th.th_root->r.r_active)
613 #if KMP_USE_DYNAMIC_LOCK
614  __kmp_push_sync(gtid, ct_ordered_in_parallel, loc_ref, NULL, 0);
615 #else
616  __kmp_push_sync(gtid, ct_ordered_in_parallel, loc_ref, NULL);
617 #endif
618  }
619 #ifdef BUILD_PARALLEL_ORDERED
620  if (!team->t.t_serialized) {
621  KMP_MB();
622  KMP_WAIT(&team->t.t_ordered.dt.t_value, __kmp_tid_from_gtid(gtid), KMP_EQ,
623  NULL);
624  KMP_MB();
625  }
626 #endif /* BUILD_PARALLEL_ORDERED */
627 }
628 
629 /* __kmp_parallel_dxo -- Signal the next task. */
630 void __kmp_parallel_dxo(int *gtid_ref, int *cid_ref, ident_t *loc_ref) {
631  int gtid = *gtid_ref;
632 #ifdef BUILD_PARALLEL_ORDERED
633  int tid = __kmp_tid_from_gtid(gtid);
634  kmp_team_t *team = __kmp_team_from_gtid(gtid);
635 #endif /* BUILD_PARALLEL_ORDERED */
636 
637  if (__kmp_env_consistency_check) {
638  if (__kmp_threads[gtid]->th.th_root->r.r_active)
639  __kmp_pop_sync(gtid, ct_ordered_in_parallel, loc_ref);
640  }
641 #ifdef BUILD_PARALLEL_ORDERED
642  if (!team->t.t_serialized) {
643  KMP_MB(); /* Flush all pending memory write invalidates. */
644 
645  /* use the tid of the next thread in this team */
646  /* TODO replace with general release procedure */
647  team->t.t_ordered.dt.t_value = ((tid + 1) % team->t.t_nproc);
648 
649  KMP_MB(); /* Flush all pending memory write invalidates. */
650  }
651 #endif /* BUILD_PARALLEL_ORDERED */
652 }
653 
654 /* ------------------------------------------------------------------------ */
655 /* The BARRIER for a SINGLE process section is always explicit */
656 
657 int __kmp_enter_single(int gtid, ident_t *id_ref, int push_ws) {
658  int status;
659  kmp_info_t *th;
660  kmp_team_t *team;
661 
662  if (!TCR_4(__kmp_init_parallel))
663  __kmp_parallel_initialize();
664  __kmp_resume_if_soft_paused();
665 
666  th = __kmp_threads[gtid];
667  team = th->th.th_team;
668  status = 0;
669 
670  th->th.th_ident = id_ref;
671 
672  if (team->t.t_serialized) {
673  status = 1;
674  } else {
675  kmp_int32 old_this = th->th.th_local.this_construct;
676 
677  ++th->th.th_local.this_construct;
678  /* try to set team count to thread count--success means thread got the
679  single block */
680  /* TODO: Should this be acquire or release? */
681  if (team->t.t_construct == old_this) {
682  status = __kmp_atomic_compare_store_acq(&team->t.t_construct, old_this,
683  th->th.th_local.this_construct);
684  }
685 #if USE_ITT_BUILD
686  if (__itt_metadata_add_ptr && __kmp_forkjoin_frames_mode == 3 &&
687  KMP_MASTER_GTID(gtid) && th->th.th_teams_microtask == NULL &&
688  team->t.t_active_level == 1) {
689  // Only report metadata by primary thread of active team at level 1
690  __kmp_itt_metadata_single(id_ref);
691  }
692 #endif /* USE_ITT_BUILD */
693  }
694 
695  if (__kmp_env_consistency_check) {
696  if (status && push_ws) {
697  __kmp_push_workshare(gtid, ct_psingle, id_ref);
698  } else {
699  __kmp_check_workshare(gtid, ct_psingle, id_ref);
700  }
701  }
702 #if USE_ITT_BUILD
703  if (status) {
704  __kmp_itt_single_start(gtid);
705  }
706 #endif /* USE_ITT_BUILD */
707  return status;
708 }
709 
710 void __kmp_exit_single(int gtid) {
711 #if USE_ITT_BUILD
712  __kmp_itt_single_end(gtid);
713 #endif /* USE_ITT_BUILD */
714  if (__kmp_env_consistency_check)
715  __kmp_pop_workshare(gtid, ct_psingle, NULL);
716 }
717 
718 /* determine if we can go parallel or must use a serialized parallel region and
719  * how many threads we can use
720  * set_nproc is the number of threads requested for the team
721  * returns 0 if we should serialize or only use one thread,
722  * otherwise the number of threads to use
723  * The forkjoin lock is held by the caller. */
724 static int __kmp_reserve_threads(kmp_root_t *root, kmp_team_t *parent_team,
725  int master_tid, int set_nthreads,
726  int enter_teams) {
727  int capacity;
728  int new_nthreads;
729  KMP_DEBUG_ASSERT(__kmp_init_serial);
730  KMP_DEBUG_ASSERT(root && parent_team);
731  kmp_info_t *this_thr = parent_team->t.t_threads[master_tid];
732 
733  // If dyn-var is set, dynamically adjust the number of desired threads,
734  // according to the method specified by dynamic_mode.
735  new_nthreads = set_nthreads;
736  if (!get__dynamic_2(parent_team, master_tid)) {
737  ;
738  }
739 #ifdef USE_LOAD_BALANCE
740  else if (__kmp_global.g.g_dynamic_mode == dynamic_load_balance) {
741  new_nthreads = __kmp_load_balance_nproc(root, set_nthreads);
742  if (new_nthreads == 1) {
743  KC_TRACE(10, ("__kmp_reserve_threads: T#%d load balance reduced "
744  "reservation to 1 thread\n",
745  master_tid));
746  return 1;
747  }
748  if (new_nthreads < set_nthreads) {
749  KC_TRACE(10, ("__kmp_reserve_threads: T#%d load balance reduced "
750  "reservation to %d threads\n",
751  master_tid, new_nthreads));
752  }
753  }
754 #endif /* USE_LOAD_BALANCE */
755  else if (__kmp_global.g.g_dynamic_mode == dynamic_thread_limit) {
756  new_nthreads = __kmp_avail_proc - __kmp_nth +
757  (root->r.r_active ? 1 : root->r.r_hot_team->t.t_nproc);
758  if (new_nthreads <= 1) {
759  KC_TRACE(10, ("__kmp_reserve_threads: T#%d thread limit reduced "
760  "reservation to 1 thread\n",
761  master_tid));
762  return 1;
763  }
764  if (new_nthreads < set_nthreads) {
765  KC_TRACE(10, ("__kmp_reserve_threads: T#%d thread limit reduced "
766  "reservation to %d threads\n",
767  master_tid, new_nthreads));
768  } else {
769  new_nthreads = set_nthreads;
770  }
771  } else if (__kmp_global.g.g_dynamic_mode == dynamic_random) {
772  if (set_nthreads > 2) {
773  new_nthreads = __kmp_get_random(parent_team->t.t_threads[master_tid]);
774  new_nthreads = (new_nthreads % set_nthreads) + 1;
775  if (new_nthreads == 1) {
776  KC_TRACE(10, ("__kmp_reserve_threads: T#%d dynamic random reduced "
777  "reservation to 1 thread\n",
778  master_tid));
779  return 1;
780  }
781  if (new_nthreads < set_nthreads) {
782  KC_TRACE(10, ("__kmp_reserve_threads: T#%d dynamic random reduced "
783  "reservation to %d threads\n",
784  master_tid, new_nthreads));
785  }
786  }
787  } else {
788  KMP_ASSERT(0);
789  }
790 
791  // Respect KMP_ALL_THREADS/KMP_DEVICE_THREAD_LIMIT.
792  if (__kmp_nth + new_nthreads -
793  (root->r.r_active ? 1 : root->r.r_hot_team->t.t_nproc) >
794  __kmp_max_nth) {
795  int tl_nthreads = __kmp_max_nth - __kmp_nth +
796  (root->r.r_active ? 1 : root->r.r_hot_team->t.t_nproc);
797  if (tl_nthreads <= 0) {
798  tl_nthreads = 1;
799  }
800 
801  // If dyn-var is false, emit a 1-time warning.
802  if (!get__dynamic_2(parent_team, master_tid) && (!__kmp_reserve_warn)) {
803  __kmp_reserve_warn = 1;
804  __kmp_msg(kmp_ms_warning,
805  KMP_MSG(CantFormThrTeam, set_nthreads, tl_nthreads),
806  KMP_HNT(Unset_ALL_THREADS), __kmp_msg_null);
807  }
808  if (tl_nthreads == 1) {
809  KC_TRACE(10, ("__kmp_reserve_threads: T#%d KMP_DEVICE_THREAD_LIMIT "
810  "reduced reservation to 1 thread\n",
811  master_tid));
812  return 1;
813  }
814  KC_TRACE(10, ("__kmp_reserve_threads: T#%d KMP_DEVICE_THREAD_LIMIT reduced "
815  "reservation to %d threads\n",
816  master_tid, tl_nthreads));
817  new_nthreads = tl_nthreads;
818  }
819 
820  // Respect OMP_THREAD_LIMIT
821  int cg_nthreads = this_thr->th.th_cg_roots->cg_nthreads;
822  int max_cg_threads = this_thr->th.th_cg_roots->cg_thread_limit;
823  if (cg_nthreads + new_nthreads -
824  (root->r.r_active ? 1 : root->r.r_hot_team->t.t_nproc) >
825  max_cg_threads) {
826  int tl_nthreads = max_cg_threads - cg_nthreads +
827  (root->r.r_active ? 1 : root->r.r_hot_team->t.t_nproc);
828  if (tl_nthreads <= 0) {
829  tl_nthreads = 1;
830  }
831 
832  // If dyn-var is false, emit a 1-time warning.
833  if (!get__dynamic_2(parent_team, master_tid) && (!__kmp_reserve_warn)) {
834  __kmp_reserve_warn = 1;
835  __kmp_msg(kmp_ms_warning,
836  KMP_MSG(CantFormThrTeam, set_nthreads, tl_nthreads),
837  KMP_HNT(Unset_ALL_THREADS), __kmp_msg_null);
838  }
839  if (tl_nthreads == 1) {
840  KC_TRACE(10, ("__kmp_reserve_threads: T#%d OMP_THREAD_LIMIT "
841  "reduced reservation to 1 thread\n",
842  master_tid));
843  return 1;
844  }
845  KC_TRACE(10, ("__kmp_reserve_threads: T#%d OMP_THREAD_LIMIT reduced "
846  "reservation to %d threads\n",
847  master_tid, tl_nthreads));
848  new_nthreads = tl_nthreads;
849  }
850 
851  // Check if the threads array is large enough, or needs expanding.
852  // See comment in __kmp_register_root() about the adjustment if
853  // __kmp_threads[0] == NULL.
854  capacity = __kmp_threads_capacity;
855  if (TCR_PTR(__kmp_threads[0]) == NULL) {
856  --capacity;
857  }
858  // If it is not for initializing the hidden helper team, we need to take
859  // __kmp_hidden_helper_threads_num out of the capacity because it is included
860  // in __kmp_threads_capacity.
861  if (__kmp_enable_hidden_helper && !TCR_4(__kmp_init_hidden_helper_threads)) {
862  capacity -= __kmp_hidden_helper_threads_num;
863  }
864  if (__kmp_nth + new_nthreads -
865  (root->r.r_active ? 1 : root->r.r_hot_team->t.t_nproc) >
866  capacity) {
867  // Expand the threads array.
868  int slotsRequired = __kmp_nth + new_nthreads -
869  (root->r.r_active ? 1 : root->r.r_hot_team->t.t_nproc) -
870  capacity;
871  int slotsAdded = __kmp_expand_threads(slotsRequired);
872  if (slotsAdded < slotsRequired) {
873  // The threads array was not expanded enough.
874  new_nthreads -= (slotsRequired - slotsAdded);
875  KMP_ASSERT(new_nthreads >= 1);
876 
877  // If dyn-var is false, emit a 1-time warning.
878  if (!get__dynamic_2(parent_team, master_tid) && (!__kmp_reserve_warn)) {
879  __kmp_reserve_warn = 1;
880  if (__kmp_tp_cached) {
881  __kmp_msg(kmp_ms_warning,
882  KMP_MSG(CantFormThrTeam, set_nthreads, new_nthreads),
883  KMP_HNT(Set_ALL_THREADPRIVATE, __kmp_tp_capacity),
884  KMP_HNT(PossibleSystemLimitOnThreads), __kmp_msg_null);
885  } else {
886  __kmp_msg(kmp_ms_warning,
887  KMP_MSG(CantFormThrTeam, set_nthreads, new_nthreads),
888  KMP_HNT(SystemLimitOnThreads), __kmp_msg_null);
889  }
890  }
891  }
892  }
893 
894 #ifdef KMP_DEBUG
895  if (new_nthreads == 1) {
896  KC_TRACE(10,
897  ("__kmp_reserve_threads: T#%d serializing team after reclaiming "
898  "dead roots and rechecking; requested %d threads\n",
899  __kmp_get_gtid(), set_nthreads));
900  } else {
901  KC_TRACE(10, ("__kmp_reserve_threads: T#%d allocating %d threads; requested"
902  " %d threads\n",
903  __kmp_get_gtid(), new_nthreads, set_nthreads));
904  }
905 #endif // KMP_DEBUG
906  return new_nthreads;
907 }
908 
909 /* Allocate threads from the thread pool and assign them to the new team. We are
910  assured that there are enough threads available, because we checked on that
911  earlier within critical section forkjoin */
912 static void __kmp_fork_team_threads(kmp_root_t *root, kmp_team_t *team,
913  kmp_info_t *master_th, int master_gtid) {
914  int i;
915  int use_hot_team;
916 
917  KA_TRACE(10, ("__kmp_fork_team_threads: new_nprocs = %d\n", team->t.t_nproc));
918  KMP_DEBUG_ASSERT(master_gtid == __kmp_get_gtid());
919  KMP_MB();
920 
921  /* first, let's setup the primary thread */
922  master_th->th.th_info.ds.ds_tid = 0;
923  master_th->th.th_team = team;
924  master_th->th.th_team_nproc = team->t.t_nproc;
925  master_th->th.th_team_master = master_th;
926  master_th->th.th_team_serialized = FALSE;
927  master_th->th.th_dispatch = &team->t.t_dispatch[0];
928 
929 /* make sure we are not the optimized hot team */
930 #if KMP_NESTED_HOT_TEAMS
931  use_hot_team = 0;
932  kmp_hot_team_ptr_t *hot_teams = master_th->th.th_hot_teams;
933  if (hot_teams) { // hot teams array is not allocated if
934  // KMP_HOT_TEAMS_MAX_LEVEL=0
935  int level = team->t.t_active_level - 1; // index in array of hot teams
936  if (master_th->th.th_teams_microtask) { // are we inside the teams?
937  if (master_th->th.th_teams_size.nteams > 1) {
938  ++level; // level was not increased in teams construct for
939  // team_of_masters
940  }
941  if (team->t.t_pkfn != (microtask_t)__kmp_teams_master &&
942  master_th->th.th_teams_level == team->t.t_level) {
943  ++level; // level was not increased in teams construct for
944  // team_of_workers before the parallel
945  } // team->t.t_level will be increased inside parallel
946  }
947  if (level < __kmp_hot_teams_max_level) {
948  if (hot_teams[level].hot_team) {
949  // hot team has already been allocated for given level
950  KMP_DEBUG_ASSERT(hot_teams[level].hot_team == team);
951  use_hot_team = 1; // the team is ready to use
952  } else {
953  use_hot_team = 0; // AC: threads are not allocated yet
954  hot_teams[level].hot_team = team; // remember new hot team
955  hot_teams[level].hot_team_nth = team->t.t_nproc;
956  }
957  } else {
958  use_hot_team = 0;
959  }
960  }
961 #else
962  use_hot_team = team == root->r.r_hot_team;
963 #endif
964  if (!use_hot_team) {
965 
966  /* install the primary thread */
967  team->t.t_threads[0] = master_th;
968  __kmp_initialize_info(master_th, team, 0, master_gtid);
969 
970  /* now, install the worker threads */
971  for (i = 1; i < team->t.t_nproc; i++) {
972 
973  /* fork or reallocate a new thread and install it in team */
974  kmp_info_t *thr = __kmp_allocate_thread(root, team, i);
975  team->t.t_threads[i] = thr;
976  KMP_DEBUG_ASSERT(thr);
977  KMP_DEBUG_ASSERT(thr->th.th_team == team);
978  /* align team and thread arrived states */
979  KA_TRACE(20, ("__kmp_fork_team_threads: T#%d(%d:%d) init arrived "
980  "T#%d(%d:%d) join =%llu, plain=%llu\n",
981  __kmp_gtid_from_tid(0, team), team->t.t_id, 0,
982  __kmp_gtid_from_tid(i, team), team->t.t_id, i,
983  team->t.t_bar[bs_forkjoin_barrier].b_arrived,
984  team->t.t_bar[bs_plain_barrier].b_arrived));
985  thr->th.th_teams_microtask = master_th->th.th_teams_microtask;
986  thr->th.th_teams_level = master_th->th.th_teams_level;
987  thr->th.th_teams_size = master_th->th.th_teams_size;
988  { // Initialize threads' barrier data.
989  int b;
990  kmp_balign_t *balign = team->t.t_threads[i]->th.th_bar;
991  for (b = 0; b < bs_last_barrier; ++b) {
992  balign[b].bb.b_arrived = team->t.t_bar[b].b_arrived;
993  KMP_DEBUG_ASSERT(balign[b].bb.wait_flag != KMP_BARRIER_PARENT_FLAG);
994 #if USE_DEBUGGER
995  balign[b].bb.b_worker_arrived = team->t.t_bar[b].b_team_arrived;
996 #endif
997  }
998  }
999  }
1000 
1001 #if KMP_AFFINITY_SUPPORTED
1002  __kmp_partition_places(team);
1003 #endif
1004  }
1005 
1006  if (__kmp_display_affinity && team->t.t_display_affinity != 1) {
1007  for (i = 0; i < team->t.t_nproc; i++) {
1008  kmp_info_t *thr = team->t.t_threads[i];
1009  if (thr->th.th_prev_num_threads != team->t.t_nproc ||
1010  thr->th.th_prev_level != team->t.t_level) {
1011  team->t.t_display_affinity = 1;
1012  break;
1013  }
1014  }
1015  }
1016 
1017  KMP_MB();
1018 }
1019 
1020 #if KMP_ARCH_X86 || KMP_ARCH_X86_64
1021 // Propagate any changes to the floating point control registers out to the team
1022 // We try to avoid unnecessary writes to the relevant cache line in the team
1023 // structure, so we don't make changes unless they are needed.
1024 inline static void propagateFPControl(kmp_team_t *team) {
1025  if (__kmp_inherit_fp_control) {
1026  kmp_int16 x87_fpu_control_word;
1027  kmp_uint32 mxcsr;
1028 
1029  // Get primary thread's values of FPU control flags (both X87 and vector)
1030  __kmp_store_x87_fpu_control_word(&x87_fpu_control_word);
1031  __kmp_store_mxcsr(&mxcsr);
1032  mxcsr &= KMP_X86_MXCSR_MASK;
1033 
1034  // There is no point looking at t_fp_control_saved here.
1035  // If it is TRUE, we still have to update the values if they are different
1036  // from those we now have. If it is FALSE we didn't save anything yet, but
1037  // our objective is the same. We have to ensure that the values in the team
1038  // are the same as those we have.
1039  // So, this code achieves what we need whether or not t_fp_control_saved is
1040  // true. By checking whether the value needs updating we avoid unnecessary
1041  // writes that would put the cache-line into a written state, causing all
1042  // threads in the team to have to read it again.
1043  KMP_CHECK_UPDATE(team->t.t_x87_fpu_control_word, x87_fpu_control_word);
1044  KMP_CHECK_UPDATE(team->t.t_mxcsr, mxcsr);
1045  // Although we don't use this value, other code in the runtime wants to know
1046  // whether it should restore them. So we must ensure it is correct.
1047  KMP_CHECK_UPDATE(team->t.t_fp_control_saved, TRUE);
1048  } else {
1049  // Similarly here. Don't write to this cache-line in the team structure
1050  // unless we have to.
1051  KMP_CHECK_UPDATE(team->t.t_fp_control_saved, FALSE);
1052  }
1053 }
1054 
1055 // Do the opposite, setting the hardware registers to the updated values from
1056 // the team.
1057 inline static void updateHWFPControl(kmp_team_t *team) {
1058  if (__kmp_inherit_fp_control && team->t.t_fp_control_saved) {
1059  // Only reset the fp control regs if they have been changed in the team.
1060  // the parallel region that we are exiting.
1061  kmp_int16 x87_fpu_control_word;
1062  kmp_uint32 mxcsr;
1063  __kmp_store_x87_fpu_control_word(&x87_fpu_control_word);
1064  __kmp_store_mxcsr(&mxcsr);
1065  mxcsr &= KMP_X86_MXCSR_MASK;
1066 
1067  if (team->t.t_x87_fpu_control_word != x87_fpu_control_word) {
1068  __kmp_clear_x87_fpu_status_word();
1069  __kmp_load_x87_fpu_control_word(&team->t.t_x87_fpu_control_word);
1070  }
1071 
1072  if (team->t.t_mxcsr != mxcsr) {
1073  __kmp_load_mxcsr(&team->t.t_mxcsr);
1074  }
1075  }
1076 }
1077 #else
1078 #define propagateFPControl(x) ((void)0)
1079 #define updateHWFPControl(x) ((void)0)
1080 #endif /* KMP_ARCH_X86 || KMP_ARCH_X86_64 */
1081 
1082 static void __kmp_alloc_argv_entries(int argc, kmp_team_t *team,
1083  int realloc); // forward declaration
1084 
1085 /* Run a parallel region that has been serialized, so runs only in a team of the
1086  single primary thread. */
1087 void __kmp_serialized_parallel(ident_t *loc, kmp_int32 global_tid) {
1088  kmp_info_t *this_thr;
1089  kmp_team_t *serial_team;
1090 
1091  KC_TRACE(10, ("__kmpc_serialized_parallel: called by T#%d\n", global_tid));
1092 
1093  /* Skip all this code for autopar serialized loops since it results in
1094  unacceptable overhead */
1095  if (loc != NULL && (loc->flags & KMP_IDENT_AUTOPAR))
1096  return;
1097 
1098  if (!TCR_4(__kmp_init_parallel))
1099  __kmp_parallel_initialize();
1100  __kmp_resume_if_soft_paused();
1101 
1102  this_thr = __kmp_threads[global_tid];
1103  serial_team = this_thr->th.th_serial_team;
1104 
1105  /* utilize the serialized team held by this thread */
1106  KMP_DEBUG_ASSERT(serial_team);
1107  KMP_MB();
1108 
1109  if (__kmp_tasking_mode != tskm_immediate_exec) {
1110  KMP_DEBUG_ASSERT(
1111  this_thr->th.th_task_team ==
1112  this_thr->th.th_team->t.t_task_team[this_thr->th.th_task_state]);
1113  KMP_DEBUG_ASSERT(serial_team->t.t_task_team[this_thr->th.th_task_state] ==
1114  NULL);
1115  KA_TRACE(20, ("__kmpc_serialized_parallel: T#%d pushing task_team %p / "
1116  "team %p, new task_team = NULL\n",
1117  global_tid, this_thr->th.th_task_team, this_thr->th.th_team));
1118  this_thr->th.th_task_team = NULL;
1119  }
1120 
1121  kmp_proc_bind_t proc_bind = this_thr->th.th_set_proc_bind;
1122  if (this_thr->th.th_current_task->td_icvs.proc_bind == proc_bind_false) {
1123  proc_bind = proc_bind_false;
1124  } else if (proc_bind == proc_bind_default) {
1125  // No proc_bind clause was specified, so use the current value
1126  // of proc-bind-var for this parallel region.
1127  proc_bind = this_thr->th.th_current_task->td_icvs.proc_bind;
1128  }
1129  // Reset for next parallel region
1130  this_thr->th.th_set_proc_bind = proc_bind_default;
1131 
1132 #if OMPT_SUPPORT
1133  ompt_data_t ompt_parallel_data = ompt_data_none;
1134  void *codeptr = OMPT_LOAD_RETURN_ADDRESS(global_tid);
1135  if (ompt_enabled.enabled &&
1136  this_thr->th.ompt_thread_info.state != ompt_state_overhead) {
1137 
1138  ompt_task_info_t *parent_task_info;
1139  parent_task_info = OMPT_CUR_TASK_INFO(this_thr);
1140 
1141  parent_task_info->frame.enter_frame.ptr = OMPT_GET_FRAME_ADDRESS(0);
1142  if (ompt_enabled.ompt_callback_parallel_begin) {
1143  int team_size = 1;
1144 
1145  ompt_callbacks.ompt_callback(ompt_callback_parallel_begin)(
1146  &(parent_task_info->task_data), &(parent_task_info->frame),
1147  &ompt_parallel_data, team_size,
1148  ompt_parallel_invoker_program | ompt_parallel_team, codeptr);
1149  }
1150  }
1151 #endif // OMPT_SUPPORT
1152 
1153  if (this_thr->th.th_team != serial_team) {
1154  // Nested level will be an index in the nested nthreads array
1155  int level = this_thr->th.th_team->t.t_level;
1156 
1157  if (serial_team->t.t_serialized) {
1158  /* this serial team was already used
1159  TODO increase performance by making this locks more specific */
1160  kmp_team_t *new_team;
1161 
1162  __kmp_acquire_bootstrap_lock(&__kmp_forkjoin_lock);
1163 
1164  new_team =
1165  __kmp_allocate_team(this_thr->th.th_root, 1, 1,
1166 #if OMPT_SUPPORT
1167  ompt_parallel_data,
1168 #endif
1169  proc_bind, &this_thr->th.th_current_task->td_icvs,
1170  0 USE_NESTED_HOT_ARG(NULL));
1171  __kmp_release_bootstrap_lock(&__kmp_forkjoin_lock);
1172  KMP_ASSERT(new_team);
1173 
1174  /* setup new serialized team and install it */
1175  new_team->t.t_threads[0] = this_thr;
1176  new_team->t.t_parent = this_thr->th.th_team;
1177  serial_team = new_team;
1178  this_thr->th.th_serial_team = serial_team;
1179 
1180  KF_TRACE(
1181  10,
1182  ("__kmpc_serialized_parallel: T#%d allocated new serial team %p\n",
1183  global_tid, serial_team));
1184 
1185  /* TODO the above breaks the requirement that if we run out of resources,
1186  then we can still guarantee that serialized teams are ok, since we may
1187  need to allocate a new one */
1188  } else {
1189  KF_TRACE(
1190  10,
1191  ("__kmpc_serialized_parallel: T#%d reusing cached serial team %p\n",
1192  global_tid, serial_team));
1193  }
1194 
1195  /* we have to initialize this serial team */
1196  KMP_DEBUG_ASSERT(serial_team->t.t_threads);
1197  KMP_DEBUG_ASSERT(serial_team->t.t_threads[0] == this_thr);
1198  KMP_DEBUG_ASSERT(this_thr->th.th_team != serial_team);
1199  serial_team->t.t_ident = loc;
1200  serial_team->t.t_serialized = 1;
1201  serial_team->t.t_nproc = 1;
1202  serial_team->t.t_parent = this_thr->th.th_team;
1203  serial_team->t.t_sched.sched = this_thr->th.th_team->t.t_sched.sched;
1204  this_thr->th.th_team = serial_team;
1205  serial_team->t.t_master_tid = this_thr->th.th_info.ds.ds_tid;
1206 
1207  KF_TRACE(10, ("__kmpc_serialized_parallel: T#d curtask=%p\n", global_tid,
1208  this_thr->th.th_current_task));
1209  KMP_ASSERT(this_thr->th.th_current_task->td_flags.executing == 1);
1210  this_thr->th.th_current_task->td_flags.executing = 0;
1211 
1212  __kmp_push_current_task_to_thread(this_thr, serial_team, 0);
1213 
1214  /* TODO: GEH: do ICVs work for nested serialized teams? Don't we need an
1215  implicit task for each serialized task represented by
1216  team->t.t_serialized? */
1217  copy_icvs(&this_thr->th.th_current_task->td_icvs,
1218  &this_thr->th.th_current_task->td_parent->td_icvs);
1219 
1220  // Thread value exists in the nested nthreads array for the next nested
1221  // level
1222  if (__kmp_nested_nth.used && (level + 1 < __kmp_nested_nth.used)) {
1223  this_thr->th.th_current_task->td_icvs.nproc =
1224  __kmp_nested_nth.nth[level + 1];
1225  }
1226 
1227  if (__kmp_nested_proc_bind.used &&
1228  (level + 1 < __kmp_nested_proc_bind.used)) {
1229  this_thr->th.th_current_task->td_icvs.proc_bind =
1230  __kmp_nested_proc_bind.bind_types[level + 1];
1231  }
1232 
1233 #if USE_DEBUGGER
1234  serial_team->t.t_pkfn = (microtask_t)(~0); // For the debugger.
1235 #endif
1236  this_thr->th.th_info.ds.ds_tid = 0;
1237 
1238  /* set thread cache values */
1239  this_thr->th.th_team_nproc = 1;
1240  this_thr->th.th_team_master = this_thr;
1241  this_thr->th.th_team_serialized = 1;
1242 
1243  serial_team->t.t_level = serial_team->t.t_parent->t.t_level + 1;
1244  serial_team->t.t_active_level = serial_team->t.t_parent->t.t_active_level;
1245  serial_team->t.t_def_allocator = this_thr->th.th_def_allocator; // save
1246 
1247  propagateFPControl(serial_team);
1248 
1249  /* check if we need to allocate dispatch buffers stack */
1250  KMP_DEBUG_ASSERT(serial_team->t.t_dispatch);
1251  if (!serial_team->t.t_dispatch->th_disp_buffer) {
1252  serial_team->t.t_dispatch->th_disp_buffer =
1253  (dispatch_private_info_t *)__kmp_allocate(
1254  sizeof(dispatch_private_info_t));
1255  }
1256  this_thr->th.th_dispatch = serial_team->t.t_dispatch;
1257 
1258  KMP_MB();
1259 
1260  } else {
1261  /* this serialized team is already being used,
1262  * that's fine, just add another nested level */
1263  KMP_DEBUG_ASSERT(this_thr->th.th_team == serial_team);
1264  KMP_DEBUG_ASSERT(serial_team->t.t_threads);
1265  KMP_DEBUG_ASSERT(serial_team->t.t_threads[0] == this_thr);
1266  ++serial_team->t.t_serialized;
1267  this_thr->th.th_team_serialized = serial_team->t.t_serialized;
1268 
1269  // Nested level will be an index in the nested nthreads array
1270  int level = this_thr->th.th_team->t.t_level;
1271  // Thread value exists in the nested nthreads array for the next nested
1272  // level
1273  if (__kmp_nested_nth.used && (level + 1 < __kmp_nested_nth.used)) {
1274  this_thr->th.th_current_task->td_icvs.nproc =
1275  __kmp_nested_nth.nth[level + 1];
1276  }
1277  serial_team->t.t_level++;
1278  KF_TRACE(10, ("__kmpc_serialized_parallel: T#%d increasing nesting level "
1279  "of serial team %p to %d\n",
1280  global_tid, serial_team, serial_team->t.t_level));
1281 
1282  /* allocate/push dispatch buffers stack */
1283  KMP_DEBUG_ASSERT(serial_team->t.t_dispatch);
1284  {
1285  dispatch_private_info_t *disp_buffer =
1286  (dispatch_private_info_t *)__kmp_allocate(
1287  sizeof(dispatch_private_info_t));
1288  disp_buffer->next = serial_team->t.t_dispatch->th_disp_buffer;
1289  serial_team->t.t_dispatch->th_disp_buffer = disp_buffer;
1290  }
1291  this_thr->th.th_dispatch = serial_team->t.t_dispatch;
1292 
1293  KMP_MB();
1294  }
1295  KMP_CHECK_UPDATE(serial_team->t.t_cancel_request, cancel_noreq);
1296 
1297  // Perform the display affinity functionality for
1298  // serialized parallel regions
1299  if (__kmp_display_affinity) {
1300  if (this_thr->th.th_prev_level != serial_team->t.t_level ||
1301  this_thr->th.th_prev_num_threads != 1) {
1302  // NULL means use the affinity-format-var ICV
1303  __kmp_aux_display_affinity(global_tid, NULL);
1304  this_thr->th.th_prev_level = serial_team->t.t_level;
1305  this_thr->th.th_prev_num_threads = 1;
1306  }
1307  }
1308 
1309  if (__kmp_env_consistency_check)
1310  __kmp_push_parallel(global_tid, NULL);
1311 #if OMPT_SUPPORT
1312  serial_team->t.ompt_team_info.master_return_address = codeptr;
1313  if (ompt_enabled.enabled &&
1314  this_thr->th.ompt_thread_info.state != ompt_state_overhead) {
1315  OMPT_CUR_TASK_INFO(this_thr)->frame.exit_frame.ptr =
1316  OMPT_GET_FRAME_ADDRESS(0);
1317 
1318  ompt_lw_taskteam_t lw_taskteam;
1319  __ompt_lw_taskteam_init(&lw_taskteam, this_thr, global_tid,
1320  &ompt_parallel_data, codeptr);
1321 
1322  __ompt_lw_taskteam_link(&lw_taskteam, this_thr, 1);
1323  // don't use lw_taskteam after linking. content was swaped
1324 
1325  /* OMPT implicit task begin */
1326  if (ompt_enabled.ompt_callback_implicit_task) {
1327  ompt_callbacks.ompt_callback(ompt_callback_implicit_task)(
1328  ompt_scope_begin, OMPT_CUR_TEAM_DATA(this_thr),
1329  OMPT_CUR_TASK_DATA(this_thr), 1, __kmp_tid_from_gtid(global_tid),
1330  ompt_task_implicit); // TODO: Can this be ompt_task_initial?
1331  OMPT_CUR_TASK_INFO(this_thr)->thread_num =
1332  __kmp_tid_from_gtid(global_tid);
1333  }
1334 
1335  /* OMPT state */
1336  this_thr->th.ompt_thread_info.state = ompt_state_work_parallel;
1337  OMPT_CUR_TASK_INFO(this_thr)->frame.exit_frame.ptr =
1338  OMPT_GET_FRAME_ADDRESS(0);
1339  }
1340 #endif
1341 }
1342 
1343 /* most of the work for a fork */
1344 /* return true if we really went parallel, false if serialized */
1345 int __kmp_fork_call(ident_t *loc, int gtid,
1346  enum fork_context_e call_context, // Intel, GNU, ...
1347  kmp_int32 argc, microtask_t microtask, launch_t invoker,
1348  kmp_va_list ap) {
1349  void **argv;
1350  int i;
1351  int master_tid;
1352  int master_this_cons;
1353  kmp_team_t *team;
1354  kmp_team_t *parent_team;
1355  kmp_info_t *master_th;
1356  kmp_root_t *root;
1357  int nthreads;
1358  int master_active;
1359  int master_set_numthreads;
1360  int level;
1361  int active_level;
1362  int teams_level;
1363 #if KMP_NESTED_HOT_TEAMS
1364  kmp_hot_team_ptr_t **p_hot_teams;
1365 #endif
1366  { // KMP_TIME_BLOCK
1367  KMP_TIME_DEVELOPER_PARTITIONED_BLOCK(KMP_fork_call);
1368  KMP_COUNT_VALUE(OMP_PARALLEL_args, argc);
1369 
1370  KA_TRACE(20, ("__kmp_fork_call: enter T#%d\n", gtid));
1371  if (__kmp_stkpadding > 0 && __kmp_root[gtid] != NULL) {
1372  /* Some systems prefer the stack for the root thread(s) to start with */
1373  /* some gap from the parent stack to prevent false sharing. */
1374  void *dummy = KMP_ALLOCA(__kmp_stkpadding);
1375  /* These 2 lines below are so this does not get optimized out */
1376  if (__kmp_stkpadding > KMP_MAX_STKPADDING)
1377  __kmp_stkpadding += (short)((kmp_int64)dummy);
1378  }
1379 
1380  /* initialize if needed */
1381  KMP_DEBUG_ASSERT(
1382  __kmp_init_serial); // AC: potentially unsafe, not in sync with shutdown
1383  if (!TCR_4(__kmp_init_parallel))
1384  __kmp_parallel_initialize();
1385  __kmp_resume_if_soft_paused();
1386 
1387  /* setup current data */
1388  master_th = __kmp_threads[gtid]; // AC: potentially unsafe, not in sync with
1389  // shutdown
1390  parent_team = master_th->th.th_team;
1391  master_tid = master_th->th.th_info.ds.ds_tid;
1392  master_this_cons = master_th->th.th_local.this_construct;
1393  root = master_th->th.th_root;
1394  master_active = root->r.r_active;
1395  master_set_numthreads = master_th->th.th_set_nproc;
1396 
1397 #if OMPT_SUPPORT
1398  ompt_data_t ompt_parallel_data = ompt_data_none;
1399  ompt_data_t *parent_task_data;
1400  ompt_frame_t *ompt_frame;
1401  ompt_data_t *implicit_task_data;
1402  void *return_address = NULL;
1403 
1404  if (ompt_enabled.enabled) {
1405  __ompt_get_task_info_internal(0, NULL, &parent_task_data, &ompt_frame,
1406  NULL, NULL);
1407  return_address = OMPT_LOAD_RETURN_ADDRESS(gtid);
1408  }
1409 #endif
1410 
1411  // Assign affinity to root thread if it hasn't happened yet
1412  __kmp_assign_root_init_mask();
1413 
1414  // Nested level will be an index in the nested nthreads array
1415  level = parent_team->t.t_level;
1416  // used to launch non-serial teams even if nested is not allowed
1417  active_level = parent_team->t.t_active_level;
1418  // needed to check nesting inside the teams
1419  teams_level = master_th->th.th_teams_level;
1420 #if KMP_NESTED_HOT_TEAMS
1421  p_hot_teams = &master_th->th.th_hot_teams;
1422  if (*p_hot_teams == NULL && __kmp_hot_teams_max_level > 0) {
1423  *p_hot_teams = (kmp_hot_team_ptr_t *)__kmp_allocate(
1424  sizeof(kmp_hot_team_ptr_t) * __kmp_hot_teams_max_level);
1425  (*p_hot_teams)[0].hot_team = root->r.r_hot_team;
1426  // it is either actual or not needed (when active_level > 0)
1427  (*p_hot_teams)[0].hot_team_nth = 1;
1428  }
1429 #endif
1430 
1431 #if OMPT_SUPPORT
1432  if (ompt_enabled.enabled) {
1433  if (ompt_enabled.ompt_callback_parallel_begin) {
1434  int team_size = master_set_numthreads
1435  ? master_set_numthreads
1436  : get__nproc_2(parent_team, master_tid);
1437  int flags = OMPT_INVOKER(call_context) |
1438  ((microtask == (microtask_t)__kmp_teams_master)
1439  ? ompt_parallel_league
1440  : ompt_parallel_team);
1441  ompt_callbacks.ompt_callback(ompt_callback_parallel_begin)(
1442  parent_task_data, ompt_frame, &ompt_parallel_data, team_size, flags,
1443  return_address);
1444  }
1445  master_th->th.ompt_thread_info.state = ompt_state_overhead;
1446  }
1447 #endif
1448 
1449  master_th->th.th_ident = loc;
1450 
1451  if (master_th->th.th_teams_microtask && ap &&
1452  microtask != (microtask_t)__kmp_teams_master && level == teams_level) {
1453  // AC: This is start of parallel that is nested inside teams construct.
1454  // The team is actual (hot), all workers are ready at the fork barrier.
1455  // No lock needed to initialize the team a bit, then free workers.
1456  parent_team->t.t_ident = loc;
1457  __kmp_alloc_argv_entries(argc, parent_team, TRUE);
1458  parent_team->t.t_argc = argc;
1459  argv = (void **)parent_team->t.t_argv;
1460  for (i = argc - 1; i >= 0; --i)
1461  *argv++ = va_arg(kmp_va_deref(ap), void *);
1462  // Increment our nested depth levels, but not increase the serialization
1463  if (parent_team == master_th->th.th_serial_team) {
1464  // AC: we are in serialized parallel
1465  __kmpc_serialized_parallel(loc, gtid);
1466  KMP_DEBUG_ASSERT(parent_team->t.t_serialized > 1);
1467 
1468  if (call_context == fork_context_gnu) {
1469  // AC: need to decrement t_serialized for enquiry functions to work
1470  // correctly, will restore at join time
1471  parent_team->t.t_serialized--;
1472  return TRUE;
1473  }
1474 
1475 #if OMPD_SUPPORT
1476  parent_team->t.t_pkfn = microtask;
1477 #endif
1478 
1479 #if OMPT_SUPPORT
1480  void *dummy;
1481  void **exit_frame_p;
1482 
1483  ompt_lw_taskteam_t lw_taskteam;
1484 
1485  if (ompt_enabled.enabled) {
1486  __ompt_lw_taskteam_init(&lw_taskteam, master_th, gtid,
1487  &ompt_parallel_data, return_address);
1488  exit_frame_p = &(lw_taskteam.ompt_task_info.frame.exit_frame.ptr);
1489 
1490  __ompt_lw_taskteam_link(&lw_taskteam, master_th, 0);
1491  // don't use lw_taskteam after linking. content was swaped
1492 
1493  /* OMPT implicit task begin */
1494  implicit_task_data = OMPT_CUR_TASK_DATA(master_th);
1495  if (ompt_enabled.ompt_callback_implicit_task) {
1496  OMPT_CUR_TASK_INFO(master_th)->thread_num =
1497  __kmp_tid_from_gtid(gtid);
1498  ompt_callbacks.ompt_callback(ompt_callback_implicit_task)(
1499  ompt_scope_begin, OMPT_CUR_TEAM_DATA(master_th),
1500  implicit_task_data, 1,
1501  OMPT_CUR_TASK_INFO(master_th)->thread_num, ompt_task_implicit);
1502  }
1503 
1504  /* OMPT state */
1505  master_th->th.ompt_thread_info.state = ompt_state_work_parallel;
1506  } else {
1507  exit_frame_p = &dummy;
1508  }
1509 #endif
1510  // AC: need to decrement t_serialized for enquiry functions to work
1511  // correctly, will restore at join time
1512  parent_team->t.t_serialized--;
1513 
1514  {
1515  KMP_TIME_PARTITIONED_BLOCK(OMP_parallel);
1516  KMP_SET_THREAD_STATE_BLOCK(IMPLICIT_TASK);
1517  __kmp_invoke_microtask(microtask, gtid, 0, argc, parent_team->t.t_argv
1518 #if OMPT_SUPPORT
1519  ,
1520  exit_frame_p
1521 #endif
1522  );
1523  }
1524 
1525 #if OMPT_SUPPORT
1526  if (ompt_enabled.enabled) {
1527  *exit_frame_p = NULL;
1528  OMPT_CUR_TASK_INFO(master_th)->frame.exit_frame = ompt_data_none;
1529  if (ompt_enabled.ompt_callback_implicit_task) {
1530  ompt_callbacks.ompt_callback(ompt_callback_implicit_task)(
1531  ompt_scope_end, NULL, implicit_task_data, 1,
1532  OMPT_CUR_TASK_INFO(master_th)->thread_num, ompt_task_implicit);
1533  }
1534  ompt_parallel_data = *OMPT_CUR_TEAM_DATA(master_th);
1535  __ompt_lw_taskteam_unlink(master_th);
1536  if (ompt_enabled.ompt_callback_parallel_end) {
1537  ompt_callbacks.ompt_callback(ompt_callback_parallel_end)(
1538  &ompt_parallel_data, OMPT_CUR_TASK_DATA(master_th),
1539  OMPT_INVOKER(call_context) | ompt_parallel_team,
1540  return_address);
1541  }
1542  master_th->th.ompt_thread_info.state = ompt_state_overhead;
1543  }
1544 #endif
1545  return TRUE;
1546  }
1547 
1548  parent_team->t.t_pkfn = microtask;
1549  parent_team->t.t_invoke = invoker;
1550  KMP_ATOMIC_INC(&root->r.r_in_parallel);
1551  parent_team->t.t_active_level++;
1552  parent_team->t.t_level++;
1553  parent_team->t.t_def_allocator = master_th->th.th_def_allocator; // save
1554 
1555 #if OMPT_SUPPORT
1556  if (ompt_enabled.enabled) {
1557  ompt_lw_taskteam_t lw_taskteam;
1558  __ompt_lw_taskteam_init(&lw_taskteam, master_th, gtid,
1559  &ompt_parallel_data, return_address);
1560  __ompt_lw_taskteam_link(&lw_taskteam, master_th, 1, true);
1561  }
1562 #endif
1563 
1564  /* Change number of threads in the team if requested */
1565  if (master_set_numthreads) { // The parallel has num_threads clause
1566  if (master_set_numthreads < master_th->th.th_teams_size.nth) {
1567  // AC: only can reduce number of threads dynamically, can't increase
1568  kmp_info_t **other_threads = parent_team->t.t_threads;
1569  parent_team->t.t_nproc = master_set_numthreads;
1570  for (i = 0; i < master_set_numthreads; ++i) {
1571  other_threads[i]->th.th_team_nproc = master_set_numthreads;
1572  }
1573  // Keep extra threads hot in the team for possible next parallels
1574  }
1575  master_th->th.th_set_nproc = 0;
1576  }
1577 
1578 #if USE_DEBUGGER
1579  if (__kmp_debugging) { // Let debugger override number of threads.
1580  int nth = __kmp_omp_num_threads(loc);
1581  if (nth > 0) { // 0 means debugger doesn't want to change num threads
1582  master_set_numthreads = nth;
1583  }
1584  }
1585 #endif
1586 
1587 #if USE_ITT_BUILD && USE_ITT_NOTIFY
1588  if (((__itt_frame_submit_v3_ptr && __itt_get_timestamp_ptr) ||
1589  KMP_ITT_DEBUG) &&
1590  __kmp_forkjoin_frames_mode == 3 &&
1591  parent_team->t.t_active_level == 1 // only report frames at level 1
1592  && master_th->th.th_teams_size.nteams == 1) {
1593  kmp_uint64 tmp_time = __itt_get_timestamp();
1594  master_th->th.th_frame_time = tmp_time;
1595  parent_team->t.t_region_time = tmp_time;
1596  }
1597  if (__itt_stack_caller_create_ptr) {
1598  KMP_DEBUG_ASSERT(parent_team->t.t_stack_id == NULL);
1599  // create new stack stitching id before entering fork barrier
1600  parent_team->t.t_stack_id = __kmp_itt_stack_caller_create();
1601  }
1602 #endif /* USE_ITT_BUILD && USE_ITT_NOTIFY */
1603 
1604  KF_TRACE(10, ("__kmp_fork_call: before internal fork: root=%p, team=%p, "
1605  "master_th=%p, gtid=%d\n",
1606  root, parent_team, master_th, gtid));
1607  __kmp_internal_fork(loc, gtid, parent_team);
1608  KF_TRACE(10, ("__kmp_fork_call: after internal fork: root=%p, team=%p, "
1609  "master_th=%p, gtid=%d\n",
1610  root, parent_team, master_th, gtid));
1611 
1612  if (call_context == fork_context_gnu)
1613  return TRUE;
1614 
1615  /* Invoke microtask for PRIMARY thread */
1616  KA_TRACE(20, ("__kmp_fork_call: T#%d(%d:0) invoke microtask = %p\n", gtid,
1617  parent_team->t.t_id, parent_team->t.t_pkfn));
1618 
1619  if (!parent_team->t.t_invoke(gtid)) {
1620  KMP_ASSERT2(0, "cannot invoke microtask for PRIMARY thread");
1621  }
1622  KA_TRACE(20, ("__kmp_fork_call: T#%d(%d:0) done microtask = %p\n", gtid,
1623  parent_team->t.t_id, parent_team->t.t_pkfn));
1624  KMP_MB(); /* Flush all pending memory write invalidates. */
1625 
1626  KA_TRACE(20, ("__kmp_fork_call: parallel exit T#%d\n", gtid));
1627 
1628  return TRUE;
1629  } // Parallel closely nested in teams construct
1630 
1631 #if KMP_DEBUG
1632  if (__kmp_tasking_mode != tskm_immediate_exec) {
1633  KMP_DEBUG_ASSERT(master_th->th.th_task_team ==
1634  parent_team->t.t_task_team[master_th->th.th_task_state]);
1635  }
1636 #endif
1637 
1638  int enter_teams = 0;
1639  if (parent_team->t.t_active_level >=
1640  master_th->th.th_current_task->td_icvs.max_active_levels) {
1641  nthreads = 1;
1642  } else {
1643  enter_teams = ((ap == NULL && active_level == 0) ||
1644  (ap && teams_level > 0 && teams_level == level));
1645  nthreads =
1646  master_set_numthreads
1647  ? master_set_numthreads
1648  : get__nproc_2(
1649  parent_team,
1650  master_tid); // TODO: get nproc directly from current task
1651 
1652  // Check if we need to take forkjoin lock? (no need for serialized
1653  // parallel out of teams construct). This code moved here from
1654  // __kmp_reserve_threads() to speedup nested serialized parallels.
1655  if (nthreads > 1) {
1656  if ((get__max_active_levels(master_th) == 1 &&
1657  (root->r.r_in_parallel && !enter_teams)) ||
1658  (__kmp_library == library_serial)) {
1659  KC_TRACE(10, ("__kmp_fork_call: T#%d serializing team; requested %d"
1660  " threads\n",
1661  gtid, nthreads));
1662  nthreads = 1;
1663  }
1664  }
1665  if (nthreads > 1) {
1666  /* determine how many new threads we can use */
1667  __kmp_acquire_bootstrap_lock(&__kmp_forkjoin_lock);
1668  /* AC: If we execute teams from parallel region (on host), then teams
1669  should be created but each can only have 1 thread if nesting is
1670  disabled. If teams called from serial region, then teams and their
1671  threads should be created regardless of the nesting setting. */
1672  nthreads = __kmp_reserve_threads(root, parent_team, master_tid,
1673  nthreads, enter_teams);
1674  if (nthreads == 1) {
1675  // Free lock for single thread execution here; for multi-thread
1676  // execution it will be freed later after team of threads created
1677  // and initialized
1678  __kmp_release_bootstrap_lock(&__kmp_forkjoin_lock);
1679  }
1680  }
1681  }
1682  KMP_DEBUG_ASSERT(nthreads > 0);
1683 
1684  // If we temporarily changed the set number of threads then restore it now
1685  master_th->th.th_set_nproc = 0;
1686 
1687  /* create a serialized parallel region? */
1688  if (nthreads == 1) {
1689 /* josh todo: hypothetical question: what do we do for OS X*? */
1690 #if KMP_OS_LINUX && \
1691  (KMP_ARCH_X86 || KMP_ARCH_X86_64 || KMP_ARCH_ARM || KMP_ARCH_AARCH64)
1692  void *args[argc];
1693 #else
1694  void **args = (void **)KMP_ALLOCA(argc * sizeof(void *));
1695 #endif /* KMP_OS_LINUX && ( KMP_ARCH_X86 || KMP_ARCH_X86_64 || KMP_ARCH_ARM || \
1696  KMP_ARCH_AARCH64) */
1697 
1698  KA_TRACE(20,
1699  ("__kmp_fork_call: T#%d serializing parallel region\n", gtid));
1700 
1701  __kmpc_serialized_parallel(loc, gtid);
1702 
1703 #if OMPD_SUPPORT
1704  master_th->th.th_serial_team->t.t_pkfn = microtask;
1705 #endif
1706 
1707  if (call_context == fork_context_intel) {
1708  /* TODO this sucks, use the compiler itself to pass args! :) */
1709  master_th->th.th_serial_team->t.t_ident = loc;
1710  if (!ap) {
1711  // revert change made in __kmpc_serialized_parallel()
1712  master_th->th.th_serial_team->t.t_level--;
1713  // Get args from parent team for teams construct
1714 
1715 #if OMPT_SUPPORT
1716  void *dummy;
1717  void **exit_frame_p;
1718  ompt_task_info_t *task_info;
1719 
1720  ompt_lw_taskteam_t lw_taskteam;
1721 
1722  if (ompt_enabled.enabled) {
1723  __ompt_lw_taskteam_init(&lw_taskteam, master_th, gtid,
1724  &ompt_parallel_data, return_address);
1725 
1726  __ompt_lw_taskteam_link(&lw_taskteam, master_th, 0);
1727  // don't use lw_taskteam after linking. content was swaped
1728 
1729  task_info = OMPT_CUR_TASK_INFO(master_th);
1730  exit_frame_p = &(task_info->frame.exit_frame.ptr);
1731  if (ompt_enabled.ompt_callback_implicit_task) {
1732  OMPT_CUR_TASK_INFO(master_th)->thread_num =
1733  __kmp_tid_from_gtid(gtid);
1734  ompt_callbacks.ompt_callback(ompt_callback_implicit_task)(
1735  ompt_scope_begin, OMPT_CUR_TEAM_DATA(master_th),
1736  &(task_info->task_data), 1,
1737  OMPT_CUR_TASK_INFO(master_th)->thread_num,
1738  ompt_task_implicit);
1739  }
1740 
1741  /* OMPT state */
1742  master_th->th.ompt_thread_info.state = ompt_state_work_parallel;
1743  } else {
1744  exit_frame_p = &dummy;
1745  }
1746 #endif
1747 
1748  {
1749  KMP_TIME_PARTITIONED_BLOCK(OMP_parallel);
1750  KMP_SET_THREAD_STATE_BLOCK(IMPLICIT_TASK);
1751  __kmp_invoke_microtask(microtask, gtid, 0, argc,
1752  parent_team->t.t_argv
1753 #if OMPT_SUPPORT
1754  ,
1755  exit_frame_p
1756 #endif
1757  );
1758  }
1759 
1760 #if OMPT_SUPPORT
1761  if (ompt_enabled.enabled) {
1762  *exit_frame_p = NULL;
1763  if (ompt_enabled.ompt_callback_implicit_task) {
1764  ompt_callbacks.ompt_callback(ompt_callback_implicit_task)(
1765  ompt_scope_end, NULL, &(task_info->task_data), 1,
1766  OMPT_CUR_TASK_INFO(master_th)->thread_num,
1767  ompt_task_implicit);
1768  }
1769  ompt_parallel_data = *OMPT_CUR_TEAM_DATA(master_th);
1770  __ompt_lw_taskteam_unlink(master_th);
1771  if (ompt_enabled.ompt_callback_parallel_end) {
1772  ompt_callbacks.ompt_callback(ompt_callback_parallel_end)(
1773  &ompt_parallel_data, parent_task_data,
1774  OMPT_INVOKER(call_context) | ompt_parallel_team,
1775  return_address);
1776  }
1777  master_th->th.ompt_thread_info.state = ompt_state_overhead;
1778  }
1779 #endif
1780  } else if (microtask == (microtask_t)__kmp_teams_master) {
1781  KMP_DEBUG_ASSERT(master_th->th.th_team ==
1782  master_th->th.th_serial_team);
1783  team = master_th->th.th_team;
1784  // team->t.t_pkfn = microtask;
1785  team->t.t_invoke = invoker;
1786  __kmp_alloc_argv_entries(argc, team, TRUE);
1787  team->t.t_argc = argc;
1788  argv = (void **)team->t.t_argv;
1789  if (ap) {
1790  for (i = argc - 1; i >= 0; --i)
1791  *argv++ = va_arg(kmp_va_deref(ap), void *);
1792  } else {
1793  for (i = 0; i < argc; ++i)
1794  // Get args from parent team for teams construct
1795  argv[i] = parent_team->t.t_argv[i];
1796  }
1797  // AC: revert change made in __kmpc_serialized_parallel()
1798  // because initial code in teams should have level=0
1799  team->t.t_level--;
1800  // AC: call special invoker for outer "parallel" of teams construct
1801  invoker(gtid);
1802 #if OMPT_SUPPORT
1803  if (ompt_enabled.enabled) {
1804  ompt_task_info_t *task_info = OMPT_CUR_TASK_INFO(master_th);
1805  if (ompt_enabled.ompt_callback_implicit_task) {
1806  ompt_callbacks.ompt_callback(ompt_callback_implicit_task)(
1807  ompt_scope_end, NULL, &(task_info->task_data), 0,
1808  OMPT_CUR_TASK_INFO(master_th)->thread_num, ompt_task_initial);
1809  }
1810  if (ompt_enabled.ompt_callback_parallel_end) {
1811  ompt_callbacks.ompt_callback(ompt_callback_parallel_end)(
1812  &ompt_parallel_data, parent_task_data,
1813  OMPT_INVOKER(call_context) | ompt_parallel_league,
1814  return_address);
1815  }
1816  master_th->th.ompt_thread_info.state = ompt_state_overhead;
1817  }
1818 #endif
1819  } else {
1820  argv = args;
1821  for (i = argc - 1; i >= 0; --i)
1822  *argv++ = va_arg(kmp_va_deref(ap), void *);
1823  KMP_MB();
1824 
1825 #if OMPT_SUPPORT
1826  void *dummy;
1827  void **exit_frame_p;
1828  ompt_task_info_t *task_info;
1829 
1830  ompt_lw_taskteam_t lw_taskteam;
1831 
1832  if (ompt_enabled.enabled) {
1833  __ompt_lw_taskteam_init(&lw_taskteam, master_th, gtid,
1834  &ompt_parallel_data, return_address);
1835  __ompt_lw_taskteam_link(&lw_taskteam, master_th, 0);
1836  // don't use lw_taskteam after linking. content was swaped
1837  task_info = OMPT_CUR_TASK_INFO(master_th);
1838  exit_frame_p = &(task_info->frame.exit_frame.ptr);
1839 
1840  /* OMPT implicit task begin */
1841  implicit_task_data = OMPT_CUR_TASK_DATA(master_th);
1842  if (ompt_enabled.ompt_callback_implicit_task) {
1843  ompt_callbacks.ompt_callback(ompt_callback_implicit_task)(
1844  ompt_scope_begin, OMPT_CUR_TEAM_DATA(master_th),
1845  implicit_task_data, 1, __kmp_tid_from_gtid(gtid),
1846  ompt_task_implicit);
1847  OMPT_CUR_TASK_INFO(master_th)->thread_num =
1848  __kmp_tid_from_gtid(gtid);
1849  }
1850 
1851  /* OMPT state */
1852  master_th->th.ompt_thread_info.state = ompt_state_work_parallel;
1853  } else {
1854  exit_frame_p = &dummy;
1855  }
1856 #endif
1857 
1858  {
1859  KMP_TIME_PARTITIONED_BLOCK(OMP_parallel);
1860  KMP_SET_THREAD_STATE_BLOCK(IMPLICIT_TASK);
1861  __kmp_invoke_microtask(microtask, gtid, 0, argc, args
1862 #if OMPT_SUPPORT
1863  ,
1864  exit_frame_p
1865 #endif
1866  );
1867  }
1868 
1869 #if OMPT_SUPPORT
1870  if (ompt_enabled.enabled) {
1871  *exit_frame_p = NULL;
1872  if (ompt_enabled.ompt_callback_implicit_task) {
1873  ompt_callbacks.ompt_callback(ompt_callback_implicit_task)(
1874  ompt_scope_end, NULL, &(task_info->task_data), 1,
1875  OMPT_CUR_TASK_INFO(master_th)->thread_num,
1876  ompt_task_implicit);
1877  }
1878 
1879  ompt_parallel_data = *OMPT_CUR_TEAM_DATA(master_th);
1880  __ompt_lw_taskteam_unlink(master_th);
1881  if (ompt_enabled.ompt_callback_parallel_end) {
1882  ompt_callbacks.ompt_callback(ompt_callback_parallel_end)(
1883  &ompt_parallel_data, parent_task_data,
1884  OMPT_INVOKER(call_context) | ompt_parallel_team,
1885  return_address);
1886  }
1887  master_th->th.ompt_thread_info.state = ompt_state_overhead;
1888  }
1889 #endif
1890  }
1891  } else if (call_context == fork_context_gnu) {
1892 #if OMPT_SUPPORT
1893  ompt_lw_taskteam_t lwt;
1894  __ompt_lw_taskteam_init(&lwt, master_th, gtid, &ompt_parallel_data,
1895  return_address);
1896 
1897  lwt.ompt_task_info.frame.exit_frame = ompt_data_none;
1898  __ompt_lw_taskteam_link(&lwt, master_th, 1);
1899 // don't use lw_taskteam after linking. content was swaped
1900 #endif
1901 
1902  // we were called from GNU native code
1903  KA_TRACE(20, ("__kmp_fork_call: T#%d serial exit\n", gtid));
1904  return FALSE;
1905  } else {
1906  KMP_ASSERT2(call_context < fork_context_last,
1907  "__kmp_fork_call: unknown fork_context parameter");
1908  }
1909 
1910  KA_TRACE(20, ("__kmp_fork_call: T#%d serial exit\n", gtid));
1911  KMP_MB();
1912  return FALSE;
1913  } // if (nthreads == 1)
1914 
1915  // GEH: only modify the executing flag in the case when not serialized
1916  // serialized case is handled in kmpc_serialized_parallel
1917  KF_TRACE(10, ("__kmp_fork_call: parent_team_aclevel=%d, master_th=%p, "
1918  "curtask=%p, curtask_max_aclevel=%d\n",
1919  parent_team->t.t_active_level, master_th,
1920  master_th->th.th_current_task,
1921  master_th->th.th_current_task->td_icvs.max_active_levels));
1922  // TODO: GEH - cannot do this assertion because root thread not set up as
1923  // executing
1924  // KMP_ASSERT( master_th->th.th_current_task->td_flags.executing == 1 );
1925  master_th->th.th_current_task->td_flags.executing = 0;
1926 
1927  if (!master_th->th.th_teams_microtask || level > teams_level) {
1928  /* Increment our nested depth level */
1929  KMP_ATOMIC_INC(&root->r.r_in_parallel);
1930  }
1931 
1932  // See if we need to make a copy of the ICVs.
1933  int nthreads_icv = master_th->th.th_current_task->td_icvs.nproc;
1934  if ((level + 1 < __kmp_nested_nth.used) &&
1935  (__kmp_nested_nth.nth[level + 1] != nthreads_icv)) {
1936  nthreads_icv = __kmp_nested_nth.nth[level + 1];
1937  } else {
1938  nthreads_icv = 0; // don't update
1939  }
1940 
1941  // Figure out the proc_bind_policy for the new team.
1942  kmp_proc_bind_t proc_bind = master_th->th.th_set_proc_bind;
1943  kmp_proc_bind_t proc_bind_icv =
1944  proc_bind_default; // proc_bind_default means don't update
1945  if (master_th->th.th_current_task->td_icvs.proc_bind == proc_bind_false) {
1946  proc_bind = proc_bind_false;
1947  } else {
1948  if (proc_bind == proc_bind_default) {
1949  // No proc_bind clause specified; use current proc-bind-var for this
1950  // parallel region
1951  proc_bind = master_th->th.th_current_task->td_icvs.proc_bind;
1952  }
1953  /* else: The proc_bind policy was specified explicitly on parallel clause.
1954  This overrides proc-bind-var for this parallel region, but does not
1955  change proc-bind-var. */
1956  // Figure the value of proc-bind-var for the child threads.
1957  if ((level + 1 < __kmp_nested_proc_bind.used) &&
1958  (__kmp_nested_proc_bind.bind_types[level + 1] !=
1959  master_th->th.th_current_task->td_icvs.proc_bind)) {
1960  proc_bind_icv = __kmp_nested_proc_bind.bind_types[level + 1];
1961  }
1962  }
1963 
1964  // Reset for next parallel region
1965  master_th->th.th_set_proc_bind = proc_bind_default;
1966 
1967  if ((nthreads_icv > 0) || (proc_bind_icv != proc_bind_default)) {
1968  kmp_internal_control_t new_icvs;
1969  copy_icvs(&new_icvs, &master_th->th.th_current_task->td_icvs);
1970  new_icvs.next = NULL;
1971  if (nthreads_icv > 0) {
1972  new_icvs.nproc = nthreads_icv;
1973  }
1974  if (proc_bind_icv != proc_bind_default) {
1975  new_icvs.proc_bind = proc_bind_icv;
1976  }
1977 
1978  /* allocate a new parallel team */
1979  KF_TRACE(10, ("__kmp_fork_call: before __kmp_allocate_team\n"));
1980  team = __kmp_allocate_team(root, nthreads, nthreads,
1981 #if OMPT_SUPPORT
1982  ompt_parallel_data,
1983 #endif
1984  proc_bind, &new_icvs,
1985  argc USE_NESTED_HOT_ARG(master_th));
1986  } else {
1987  /* allocate a new parallel team */
1988  KF_TRACE(10, ("__kmp_fork_call: before __kmp_allocate_team\n"));
1989  team = __kmp_allocate_team(root, nthreads, nthreads,
1990 #if OMPT_SUPPORT
1991  ompt_parallel_data,
1992 #endif
1993  proc_bind,
1994  &master_th->th.th_current_task->td_icvs,
1995  argc USE_NESTED_HOT_ARG(master_th));
1996  }
1997  KF_TRACE(
1998  10, ("__kmp_fork_call: after __kmp_allocate_team - team = %p\n", team));
1999 
2000  /* setup the new team */
2001  KMP_CHECK_UPDATE(team->t.t_master_tid, master_tid);
2002  KMP_CHECK_UPDATE(team->t.t_master_this_cons, master_this_cons);
2003  KMP_CHECK_UPDATE(team->t.t_ident, loc);
2004  KMP_CHECK_UPDATE(team->t.t_parent, parent_team);
2005  KMP_CHECK_UPDATE_SYNC(team->t.t_pkfn, microtask);
2006 #if OMPT_SUPPORT
2007  KMP_CHECK_UPDATE_SYNC(team->t.ompt_team_info.master_return_address,
2008  return_address);
2009 #endif
2010  KMP_CHECK_UPDATE(team->t.t_invoke, invoker); // TODO move to root, maybe
2011  // TODO: parent_team->t.t_level == INT_MAX ???
2012  if (!master_th->th.th_teams_microtask || level > teams_level) {
2013  int new_level = parent_team->t.t_level + 1;
2014  KMP_CHECK_UPDATE(team->t.t_level, new_level);
2015  new_level = parent_team->t.t_active_level + 1;
2016  KMP_CHECK_UPDATE(team->t.t_active_level, new_level);
2017  } else {
2018  // AC: Do not increase parallel level at start of the teams construct
2019  int new_level = parent_team->t.t_level;
2020  KMP_CHECK_UPDATE(team->t.t_level, new_level);
2021  new_level = parent_team->t.t_active_level;
2022  KMP_CHECK_UPDATE(team->t.t_active_level, new_level);
2023  }
2024  kmp_r_sched_t new_sched = get__sched_2(parent_team, master_tid);
2025  // set primary thread's schedule as new run-time schedule
2026  KMP_CHECK_UPDATE(team->t.t_sched.sched, new_sched.sched);
2027 
2028  KMP_CHECK_UPDATE(team->t.t_cancel_request, cancel_noreq);
2029  KMP_CHECK_UPDATE(team->t.t_def_allocator, master_th->th.th_def_allocator);
2030 
2031  // Update the floating point rounding in the team if required.
2032  propagateFPControl(team);
2033 #if OMPD_SUPPORT
2034  if (ompd_state & OMPD_ENABLE_BP)
2035  ompd_bp_parallel_begin();
2036 #endif
2037 
2038  if (__kmp_tasking_mode != tskm_immediate_exec) {
2039  // Set primary thread's task team to team's task team. Unless this is hot
2040  // team, it should be NULL.
2041  KMP_DEBUG_ASSERT(master_th->th.th_task_team ==
2042  parent_team->t.t_task_team[master_th->th.th_task_state]);
2043  KA_TRACE(20, ("__kmp_fork_call: Primary T#%d pushing task_team %p / team "
2044  "%p, new task_team %p / team %p\n",
2045  __kmp_gtid_from_thread(master_th),
2046  master_th->th.th_task_team, parent_team,
2047  team->t.t_task_team[master_th->th.th_task_state], team));
2048 
2049  if (active_level || master_th->th.th_task_team) {
2050  // Take a memo of primary thread's task_state
2051  KMP_DEBUG_ASSERT(master_th->th.th_task_state_memo_stack);
2052  if (master_th->th.th_task_state_top >=
2053  master_th->th.th_task_state_stack_sz) { // increase size
2054  kmp_uint32 new_size = 2 * master_th->th.th_task_state_stack_sz;
2055  kmp_uint8 *old_stack, *new_stack;
2056  kmp_uint32 i;
2057  new_stack = (kmp_uint8 *)__kmp_allocate(new_size);
2058  for (i = 0; i < master_th->th.th_task_state_stack_sz; ++i) {
2059  new_stack[i] = master_th->th.th_task_state_memo_stack[i];
2060  }
2061  for (i = master_th->th.th_task_state_stack_sz; i < new_size;
2062  ++i) { // zero-init rest of stack
2063  new_stack[i] = 0;
2064  }
2065  old_stack = master_th->th.th_task_state_memo_stack;
2066  master_th->th.th_task_state_memo_stack = new_stack;
2067  master_th->th.th_task_state_stack_sz = new_size;
2068  __kmp_free(old_stack);
2069  }
2070  // Store primary thread's task_state on stack
2071  master_th->th
2072  .th_task_state_memo_stack[master_th->th.th_task_state_top] =
2073  master_th->th.th_task_state;
2074  master_th->th.th_task_state_top++;
2075 #if KMP_NESTED_HOT_TEAMS
2076  if (master_th->th.th_hot_teams &&
2077  active_level < __kmp_hot_teams_max_level &&
2078  team == master_th->th.th_hot_teams[active_level].hot_team) {
2079  // Restore primary thread's nested state if nested hot team
2080  master_th->th.th_task_state =
2081  master_th->th
2082  .th_task_state_memo_stack[master_th->th.th_task_state_top];
2083  } else {
2084 #endif
2085  master_th->th.th_task_state = 0;
2086 #if KMP_NESTED_HOT_TEAMS
2087  }
2088 #endif
2089  }
2090 #if !KMP_NESTED_HOT_TEAMS
2091  KMP_DEBUG_ASSERT((master_th->th.th_task_team == NULL) ||
2092  (team == root->r.r_hot_team));
2093 #endif
2094  }
2095 
2096  KA_TRACE(
2097  20,
2098  ("__kmp_fork_call: T#%d(%d:%d)->(%d:0) created a team of %d threads\n",
2099  gtid, parent_team->t.t_id, team->t.t_master_tid, team->t.t_id,
2100  team->t.t_nproc));