xref: /freebsd/contrib/llvm-project/openmp/runtime/src/kmp_error.cpp (revision fe6060f10f634930ff71b7c50291ddc610da2475)
10b57cec5SDimitry Andric /*
20b57cec5SDimitry Andric  * kmp_error.cpp -- KPTS functions for error checking at runtime
30b57cec5SDimitry Andric  */
40b57cec5SDimitry Andric 
50b57cec5SDimitry Andric //===----------------------------------------------------------------------===//
60b57cec5SDimitry Andric //
70b57cec5SDimitry Andric // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
80b57cec5SDimitry Andric // See https://llvm.org/LICENSE.txt for license information.
90b57cec5SDimitry Andric // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
100b57cec5SDimitry Andric //
110b57cec5SDimitry Andric //===----------------------------------------------------------------------===//
120b57cec5SDimitry Andric 
130b57cec5SDimitry Andric #include "kmp.h"
140b57cec5SDimitry Andric #include "kmp_error.h"
150b57cec5SDimitry Andric #include "kmp_i18n.h"
160b57cec5SDimitry Andric #include "kmp_str.h"
170b57cec5SDimitry Andric 
180b57cec5SDimitry Andric /* ------------------------------------------------------------------------ */
190b57cec5SDimitry Andric 
200b57cec5SDimitry Andric #define MIN_STACK 100
210b57cec5SDimitry Andric 
220b57cec5SDimitry Andric static char const *cons_text_c[] = {
23*fe6060f1SDimitry Andric     "(none)",
24*fe6060f1SDimitry Andric     "\"parallel\"",
25*fe6060f1SDimitry Andric     "work-sharing", /* this is not called "for"
260b57cec5SDimitry Andric                        because of lowering of
270b57cec5SDimitry Andric                        "sections" pragmas */
280b57cec5SDimitry Andric     "\"ordered\" work-sharing", /* this is not called "for ordered" because of
290b57cec5SDimitry Andric                                    lowering of "sections" pragmas */
300b57cec5SDimitry Andric     "\"sections\"",
310b57cec5SDimitry Andric     "work-sharing", /* this is not called "single" because of lowering of
320b57cec5SDimitry Andric                        "sections" pragmas */
33*fe6060f1SDimitry Andric     "\"critical\"",
34*fe6060f1SDimitry Andric     "\"ordered\"", /* in PARALLEL */
350b57cec5SDimitry Andric     "\"ordered\"", /* in PDO */
36*fe6060f1SDimitry Andric     "\"master\"",
37*fe6060f1SDimitry Andric     "\"reduce\"",
38*fe6060f1SDimitry Andric     "\"barrier\"",
39*fe6060f1SDimitry Andric     "\"masked\""};
400b57cec5SDimitry Andric 
410b57cec5SDimitry Andric #define get_src(ident) ((ident) == NULL ? NULL : (ident)->psource)
420b57cec5SDimitry Andric 
430b57cec5SDimitry Andric #define PUSH_MSG(ct, ident)                                                    \
440b57cec5SDimitry Andric   "\tpushing on stack: %s (%s)\n", cons_text_c[(ct)], get_src((ident))
450b57cec5SDimitry Andric #define POP_MSG(p)                                                             \
460b57cec5SDimitry Andric   "\tpopping off stack: %s (%s)\n", cons_text_c[(p)->stack_data[tos].type],    \
470b57cec5SDimitry Andric       get_src((p)->stack_data[tos].ident)
480b57cec5SDimitry Andric 
490b57cec5SDimitry Andric static int const cons_text_c_num = sizeof(cons_text_c) / sizeof(char const *);
500b57cec5SDimitry Andric 
510b57cec5SDimitry Andric /* --------------- START OF STATIC LOCAL ROUTINES ------------------------- */
520b57cec5SDimitry Andric 
__kmp_check_null_func(void)530b57cec5SDimitry Andric static void __kmp_check_null_func(void) { /* nothing to do */
540b57cec5SDimitry Andric }
550b57cec5SDimitry Andric 
__kmp_expand_cons_stack(int gtid,struct cons_header * p)560b57cec5SDimitry Andric static void __kmp_expand_cons_stack(int gtid, struct cons_header *p) {
570b57cec5SDimitry Andric   int i;
580b57cec5SDimitry Andric   struct cons_data *d;
590b57cec5SDimitry Andric 
600b57cec5SDimitry Andric   /* TODO for monitor perhaps? */
610b57cec5SDimitry Andric   if (gtid < 0)
620b57cec5SDimitry Andric     __kmp_check_null_func();
630b57cec5SDimitry Andric 
640b57cec5SDimitry Andric   KE_TRACE(10, ("expand cons_stack (%d %d)\n", gtid, __kmp_get_gtid()));
650b57cec5SDimitry Andric 
660b57cec5SDimitry Andric   d = p->stack_data;
670b57cec5SDimitry Andric 
680b57cec5SDimitry Andric   p->stack_size = (p->stack_size * 2) + 100;
690b57cec5SDimitry Andric 
700b57cec5SDimitry Andric   /* TODO free the old data */
710b57cec5SDimitry Andric   p->stack_data = (struct cons_data *)__kmp_allocate(sizeof(struct cons_data) *
720b57cec5SDimitry Andric                                                      (p->stack_size + 1));
730b57cec5SDimitry Andric 
740b57cec5SDimitry Andric   for (i = p->stack_top; i >= 0; --i)
750b57cec5SDimitry Andric     p->stack_data[i] = d[i];
760b57cec5SDimitry Andric 
770b57cec5SDimitry Andric   /* NOTE: we do not free the old stack_data */
780b57cec5SDimitry Andric }
790b57cec5SDimitry Andric 
800b57cec5SDimitry Andric // NOTE: Function returns allocated memory, caller must free it!
__kmp_pragma(int ct,ident_t const * ident)810b57cec5SDimitry Andric static char *__kmp_pragma(int ct, ident_t const *ident) {
820b57cec5SDimitry Andric   char const *cons = NULL; // Construct name.
830b57cec5SDimitry Andric   char *file = NULL; // File name.
840b57cec5SDimitry Andric   char *func = NULL; // Function (routine) name.
850b57cec5SDimitry Andric   char *line = NULL; // Line number.
860b57cec5SDimitry Andric   kmp_str_buf_t buffer;
870b57cec5SDimitry Andric   kmp_msg_t prgm;
880b57cec5SDimitry Andric   __kmp_str_buf_init(&buffer);
890b57cec5SDimitry Andric   if (0 < ct && ct < cons_text_c_num) {
900b57cec5SDimitry Andric     cons = cons_text_c[ct];
910b57cec5SDimitry Andric   } else {
920b57cec5SDimitry Andric     KMP_DEBUG_ASSERT(0);
930b57cec5SDimitry Andric   }
940b57cec5SDimitry Andric   if (ident != NULL && ident->psource != NULL) {
950b57cec5SDimitry Andric     char *tail = NULL;
960b57cec5SDimitry Andric     __kmp_str_buf_print(&buffer, "%s",
970b57cec5SDimitry Andric                         ident->psource); // Copy source to buffer.
980b57cec5SDimitry Andric     // Split string in buffer to file, func, and line.
990b57cec5SDimitry Andric     tail = buffer.str;
1000b57cec5SDimitry Andric     __kmp_str_split(tail, ';', NULL, &tail);
1010b57cec5SDimitry Andric     __kmp_str_split(tail, ';', &file, &tail);
1020b57cec5SDimitry Andric     __kmp_str_split(tail, ';', &func, &tail);
1030b57cec5SDimitry Andric     __kmp_str_split(tail, ';', &line, &tail);
1040b57cec5SDimitry Andric   }
1050b57cec5SDimitry Andric   prgm = __kmp_msg_format(kmp_i18n_fmt_Pragma, cons, file, func, line);
1060b57cec5SDimitry Andric   __kmp_str_buf_free(&buffer);
1070b57cec5SDimitry Andric   return prgm.str;
1080b57cec5SDimitry Andric } // __kmp_pragma
1090b57cec5SDimitry Andric 
1100b57cec5SDimitry Andric /* ----------------- END OF STATIC LOCAL ROUTINES ------------------------- */
1110b57cec5SDimitry Andric 
__kmp_error_construct(kmp_i18n_id_t id,enum cons_type ct,ident_t const * ident)1120b57cec5SDimitry Andric void __kmp_error_construct(kmp_i18n_id_t id, // Message identifier.
1130b57cec5SDimitry Andric                            enum cons_type ct, // Construct type.
1140b57cec5SDimitry Andric                            ident_t const *ident // Construct ident.
1150b57cec5SDimitry Andric ) {
1160b57cec5SDimitry Andric   char *construct = __kmp_pragma(ct, ident);
1170b57cec5SDimitry Andric   __kmp_fatal(__kmp_msg_format(id, construct), __kmp_msg_null);
1180b57cec5SDimitry Andric   KMP_INTERNAL_FREE(construct);
1190b57cec5SDimitry Andric }
1200b57cec5SDimitry Andric 
__kmp_error_construct2(kmp_i18n_id_t id,enum cons_type ct,ident_t const * ident,struct cons_data const * cons)1210b57cec5SDimitry Andric void __kmp_error_construct2(kmp_i18n_id_t id, // Message identifier.
1220b57cec5SDimitry Andric                             enum cons_type ct, // First construct type.
1230b57cec5SDimitry Andric                             ident_t const *ident, // First construct ident.
1240b57cec5SDimitry Andric                             struct cons_data const *cons // Second construct.
1250b57cec5SDimitry Andric ) {
1260b57cec5SDimitry Andric   char *construct1 = __kmp_pragma(ct, ident);
1270b57cec5SDimitry Andric   char *construct2 = __kmp_pragma(cons->type, cons->ident);
1280b57cec5SDimitry Andric   __kmp_fatal(__kmp_msg_format(id, construct1, construct2), __kmp_msg_null);
1290b57cec5SDimitry Andric   KMP_INTERNAL_FREE(construct1);
1300b57cec5SDimitry Andric   KMP_INTERNAL_FREE(construct2);
1310b57cec5SDimitry Andric }
1320b57cec5SDimitry Andric 
__kmp_allocate_cons_stack(int gtid)1330b57cec5SDimitry Andric struct cons_header *__kmp_allocate_cons_stack(int gtid) {
1340b57cec5SDimitry Andric   struct cons_header *p;
1350b57cec5SDimitry Andric 
1360b57cec5SDimitry Andric   /* TODO for monitor perhaps? */
1370b57cec5SDimitry Andric   if (gtid < 0) {
1380b57cec5SDimitry Andric     __kmp_check_null_func();
1390b57cec5SDimitry Andric   }
1400b57cec5SDimitry Andric   KE_TRACE(10, ("allocate cons_stack (%d)\n", gtid));
1410b57cec5SDimitry Andric   p = (struct cons_header *)__kmp_allocate(sizeof(struct cons_header));
1420b57cec5SDimitry Andric   p->p_top = p->w_top = p->s_top = 0;
1430b57cec5SDimitry Andric   p->stack_data = (struct cons_data *)__kmp_allocate(sizeof(struct cons_data) *
1440b57cec5SDimitry Andric                                                      (MIN_STACK + 1));
1450b57cec5SDimitry Andric   p->stack_size = MIN_STACK;
1460b57cec5SDimitry Andric   p->stack_top = 0;
1470b57cec5SDimitry Andric   p->stack_data[0].type = ct_none;
1480b57cec5SDimitry Andric   p->stack_data[0].prev = 0;
1490b57cec5SDimitry Andric   p->stack_data[0].ident = NULL;
1500b57cec5SDimitry Andric   return p;
1510b57cec5SDimitry Andric }
1520b57cec5SDimitry Andric 
__kmp_free_cons_stack(void * ptr)1530b57cec5SDimitry Andric void __kmp_free_cons_stack(void *ptr) {
1540b57cec5SDimitry Andric   struct cons_header *p = (struct cons_header *)ptr;
1550b57cec5SDimitry Andric   if (p != NULL) {
1560b57cec5SDimitry Andric     if (p->stack_data != NULL) {
1570b57cec5SDimitry Andric       __kmp_free(p->stack_data);
1580b57cec5SDimitry Andric       p->stack_data = NULL;
1590b57cec5SDimitry Andric     }
1600b57cec5SDimitry Andric     __kmp_free(p);
1610b57cec5SDimitry Andric   }
1620b57cec5SDimitry Andric }
1630b57cec5SDimitry Andric 
1640b57cec5SDimitry Andric #if KMP_DEBUG
dump_cons_stack(int gtid,struct cons_header * p)1650b57cec5SDimitry Andric static void dump_cons_stack(int gtid, struct cons_header *p) {
1660b57cec5SDimitry Andric   int i;
1670b57cec5SDimitry Andric   int tos = p->stack_top;
1680b57cec5SDimitry Andric   kmp_str_buf_t buffer;
1690b57cec5SDimitry Andric   __kmp_str_buf_init(&buffer);
1700b57cec5SDimitry Andric   __kmp_str_buf_print(
1710b57cec5SDimitry Andric       &buffer,
1720b57cec5SDimitry Andric       "+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-\n");
1730b57cec5SDimitry Andric   __kmp_str_buf_print(&buffer,
1740b57cec5SDimitry Andric                       "Begin construct stack with %d items for thread %d\n",
1750b57cec5SDimitry Andric                       tos, gtid);
1760b57cec5SDimitry Andric   __kmp_str_buf_print(&buffer, "     stack_top=%d { P=%d, W=%d, S=%d }\n", tos,
1770b57cec5SDimitry Andric                       p->p_top, p->w_top, p->s_top);
1780b57cec5SDimitry Andric   for (i = tos; i > 0; i--) {
1790b57cec5SDimitry Andric     struct cons_data *c = &(p->stack_data[i]);
1800b57cec5SDimitry Andric     __kmp_str_buf_print(
1810b57cec5SDimitry Andric         &buffer, "        stack_data[%2d] = { %s (%s) %d %p }\n", i,
1820b57cec5SDimitry Andric         cons_text_c[c->type], get_src(c->ident), c->prev, c->name);
1830b57cec5SDimitry Andric   }
1840b57cec5SDimitry Andric   __kmp_str_buf_print(&buffer, "End construct stack for thread %d\n", gtid);
1850b57cec5SDimitry Andric   __kmp_str_buf_print(
1860b57cec5SDimitry Andric       &buffer,
1870b57cec5SDimitry Andric       "+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-\n");
1880b57cec5SDimitry Andric   __kmp_debug_printf("%s", buffer.str);
1890b57cec5SDimitry Andric   __kmp_str_buf_free(&buffer);
1900b57cec5SDimitry Andric }
1910b57cec5SDimitry Andric #endif
1920b57cec5SDimitry Andric 
__kmp_push_parallel(int gtid,ident_t const * ident)1930b57cec5SDimitry Andric void __kmp_push_parallel(int gtid, ident_t const *ident) {
1940b57cec5SDimitry Andric   int tos;
1950b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
1960b57cec5SDimitry Andric 
1970b57cec5SDimitry Andric   KMP_DEBUG_ASSERT(__kmp_threads[gtid]->th.th_cons);
1980b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_push_parallel (%d %d)\n", gtid, __kmp_get_gtid()));
1990b57cec5SDimitry Andric   KE_TRACE(100, (PUSH_MSG(ct_parallel, ident)));
2000b57cec5SDimitry Andric   if (p->stack_top >= p->stack_size) {
2010b57cec5SDimitry Andric     __kmp_expand_cons_stack(gtid, p);
2020b57cec5SDimitry Andric   }
2030b57cec5SDimitry Andric   tos = ++p->stack_top;
2040b57cec5SDimitry Andric   p->stack_data[tos].type = ct_parallel;
2050b57cec5SDimitry Andric   p->stack_data[tos].prev = p->p_top;
2060b57cec5SDimitry Andric   p->stack_data[tos].ident = ident;
2070b57cec5SDimitry Andric   p->stack_data[tos].name = NULL;
2080b57cec5SDimitry Andric   p->p_top = tos;
2090b57cec5SDimitry Andric   KE_DUMP(1000, dump_cons_stack(gtid, p));
2100b57cec5SDimitry Andric }
2110b57cec5SDimitry Andric 
__kmp_check_workshare(int gtid,enum cons_type ct,ident_t const * ident)2120b57cec5SDimitry Andric void __kmp_check_workshare(int gtid, enum cons_type ct, ident_t const *ident) {
2130b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
2140b57cec5SDimitry Andric 
2150b57cec5SDimitry Andric   KMP_DEBUG_ASSERT(__kmp_threads[gtid]->th.th_cons);
2160b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_check_workshare (%d %d)\n", gtid, __kmp_get_gtid()));
2170b57cec5SDimitry Andric 
2180b57cec5SDimitry Andric   if (p->stack_top >= p->stack_size) {
2190b57cec5SDimitry Andric     __kmp_expand_cons_stack(gtid, p);
2200b57cec5SDimitry Andric   }
2210b57cec5SDimitry Andric   if (p->w_top > p->p_top) {
2220b57cec5SDimitry Andric     // We are already in a WORKSHARE construct for this PARALLEL region.
2230b57cec5SDimitry Andric     __kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
2240b57cec5SDimitry Andric                            &p->stack_data[p->w_top]);
2250b57cec5SDimitry Andric   }
2260b57cec5SDimitry Andric   if (p->s_top > p->p_top) {
2270b57cec5SDimitry Andric     // We are already in a SYNC construct for this PARALLEL region.
2280b57cec5SDimitry Andric     __kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
2290b57cec5SDimitry Andric                            &p->stack_data[p->s_top]);
2300b57cec5SDimitry Andric   }
2310b57cec5SDimitry Andric }
2320b57cec5SDimitry Andric 
__kmp_push_workshare(int gtid,enum cons_type ct,ident_t const * ident)2330b57cec5SDimitry Andric void __kmp_push_workshare(int gtid, enum cons_type ct, ident_t const *ident) {
2340b57cec5SDimitry Andric   int tos;
2350b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
2360b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_push_workshare (%d %d)\n", gtid, __kmp_get_gtid()));
2370b57cec5SDimitry Andric   __kmp_check_workshare(gtid, ct, ident);
2380b57cec5SDimitry Andric   KE_TRACE(100, (PUSH_MSG(ct, ident)));
2390b57cec5SDimitry Andric   tos = ++p->stack_top;
2400b57cec5SDimitry Andric   p->stack_data[tos].type = ct;
2410b57cec5SDimitry Andric   p->stack_data[tos].prev = p->w_top;
2420b57cec5SDimitry Andric   p->stack_data[tos].ident = ident;
2430b57cec5SDimitry Andric   p->stack_data[tos].name = NULL;
2440b57cec5SDimitry Andric   p->w_top = tos;
2450b57cec5SDimitry Andric   KE_DUMP(1000, dump_cons_stack(gtid, p));
2460b57cec5SDimitry Andric }
2470b57cec5SDimitry Andric 
2480b57cec5SDimitry Andric void
2490b57cec5SDimitry Andric #if KMP_USE_DYNAMIC_LOCK
__kmp_check_sync(int gtid,enum cons_type ct,ident_t const * ident,kmp_user_lock_p lck,kmp_uint32 seq)2500b57cec5SDimitry Andric __kmp_check_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck, kmp_uint32 seq )
2510b57cec5SDimitry Andric #else
2520b57cec5SDimitry Andric __kmp_check_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck )
2530b57cec5SDimitry Andric #endif
2540b57cec5SDimitry Andric {
2550b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
2560b57cec5SDimitry Andric 
2570b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_check_sync (gtid=%d)\n", __kmp_get_gtid()));
2580b57cec5SDimitry Andric 
2590b57cec5SDimitry Andric   if (p->stack_top >= p->stack_size)
2600b57cec5SDimitry Andric     __kmp_expand_cons_stack(gtid, p);
2610b57cec5SDimitry Andric 
2620b57cec5SDimitry Andric   if (ct == ct_ordered_in_parallel || ct == ct_ordered_in_pdo) {
2630b57cec5SDimitry Andric     if (p->w_top <= p->p_top) {
2640b57cec5SDimitry Andric /* we are not in a worksharing construct */
2650b57cec5SDimitry Andric #ifdef BUILD_PARALLEL_ORDERED
2660b57cec5SDimitry Andric       /* do not report error messages for PARALLEL ORDERED */
2670b57cec5SDimitry Andric       KMP_ASSERT(ct == ct_ordered_in_parallel);
2680b57cec5SDimitry Andric #else
2690b57cec5SDimitry Andric       __kmp_error_construct(kmp_i18n_msg_CnsBoundToWorksharing, ct, ident);
2700b57cec5SDimitry Andric #endif /* BUILD_PARALLEL_ORDERED */
2710b57cec5SDimitry Andric     } else {
2720b57cec5SDimitry Andric       /* inside a WORKSHARING construct for this PARALLEL region */
2730b57cec5SDimitry Andric       if (!IS_CONS_TYPE_ORDERED(p->stack_data[p->w_top].type)) {
2740b57cec5SDimitry Andric         __kmp_error_construct2(kmp_i18n_msg_CnsNoOrderedClause, ct, ident,
2750b57cec5SDimitry Andric                                &p->stack_data[p->w_top]);
2760b57cec5SDimitry Andric       }
2770b57cec5SDimitry Andric     }
2780b57cec5SDimitry Andric     if (p->s_top > p->p_top && p->s_top > p->w_top) {
2790b57cec5SDimitry Andric       /* inside a sync construct which is inside a worksharing construct */
2800b57cec5SDimitry Andric       int index = p->s_top;
2810b57cec5SDimitry Andric       enum cons_type stack_type;
2820b57cec5SDimitry Andric 
2830b57cec5SDimitry Andric       stack_type = p->stack_data[index].type;
2840b57cec5SDimitry Andric 
2850b57cec5SDimitry Andric       if (stack_type == ct_critical ||
2860b57cec5SDimitry Andric           ((stack_type == ct_ordered_in_parallel ||
2870b57cec5SDimitry Andric             stack_type == ct_ordered_in_pdo) &&
2880b57cec5SDimitry Andric            /* C doesn't allow named ordered; ordered in ordered gets error */
2890b57cec5SDimitry Andric            p->stack_data[index].ident != NULL &&
2900b57cec5SDimitry Andric            (p->stack_data[index].ident->flags & KMP_IDENT_KMPC))) {
2910b57cec5SDimitry Andric         /* we are in ORDERED which is inside an ORDERED or CRITICAL construct */
2920b57cec5SDimitry Andric         __kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
2930b57cec5SDimitry Andric                                &p->stack_data[index]);
2940b57cec5SDimitry Andric       }
2950b57cec5SDimitry Andric     }
2960b57cec5SDimitry Andric   } else if (ct == ct_critical) {
2970b57cec5SDimitry Andric #if KMP_USE_DYNAMIC_LOCK
2980b57cec5SDimitry Andric     if (lck != NULL &&
2990b57cec5SDimitry Andric         __kmp_get_user_lock_owner(lck, seq) ==
3000b57cec5SDimitry Andric             gtid) { /* this thread already has lock for this critical section */
3010b57cec5SDimitry Andric #else
3020b57cec5SDimitry Andric     if (lck != NULL &&
3030b57cec5SDimitry Andric         __kmp_get_user_lock_owner(lck) ==
3040b57cec5SDimitry Andric             gtid) { /* this thread already has lock for this critical section */
3050b57cec5SDimitry Andric #endif
3060b57cec5SDimitry Andric       int index = p->s_top;
3070b57cec5SDimitry Andric       struct cons_data cons = {NULL, ct_critical, 0, NULL};
3080b57cec5SDimitry Andric       /* walk up construct stack and try to find critical with matching name */
3090b57cec5SDimitry Andric       while (index != 0 && p->stack_data[index].name != lck) {
3100b57cec5SDimitry Andric         index = p->stack_data[index].prev;
3110b57cec5SDimitry Andric       }
3120b57cec5SDimitry Andric       if (index != 0) {
3130b57cec5SDimitry Andric         /* found match on the stack (may not always because of interleaved
3140b57cec5SDimitry Andric          * critical for Fortran) */
3150b57cec5SDimitry Andric         cons = p->stack_data[index];
3160b57cec5SDimitry Andric       }
3170b57cec5SDimitry Andric       /* we are in CRITICAL which is inside a CRITICAL construct of same name */
3180b57cec5SDimitry Andric       __kmp_error_construct2(kmp_i18n_msg_CnsNestingSameName, ct, ident, &cons);
3190b57cec5SDimitry Andric     }
320*fe6060f1SDimitry Andric   } else if (ct == ct_master || ct == ct_masked || ct == ct_reduce) {
3210b57cec5SDimitry Andric     if (p->w_top > p->p_top) {
3220b57cec5SDimitry Andric       /* inside a WORKSHARING construct for this PARALLEL region */
3230b57cec5SDimitry Andric       __kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
3240b57cec5SDimitry Andric                              &p->stack_data[p->w_top]);
3250b57cec5SDimitry Andric     }
3260b57cec5SDimitry Andric     if (ct == ct_reduce && p->s_top > p->p_top) {
3270b57cec5SDimitry Andric       /* inside a another SYNC construct for this PARALLEL region */
3280b57cec5SDimitry Andric       __kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
3290b57cec5SDimitry Andric                              &p->stack_data[p->s_top]);
3300b57cec5SDimitry Andric     }
3310b57cec5SDimitry Andric   }
3320b57cec5SDimitry Andric }
3330b57cec5SDimitry Andric 
3340b57cec5SDimitry Andric void
3350b57cec5SDimitry Andric #if KMP_USE_DYNAMIC_LOCK
3360b57cec5SDimitry Andric __kmp_push_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck, kmp_uint32 seq )
3370b57cec5SDimitry Andric #else
3380b57cec5SDimitry Andric __kmp_push_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck )
3390b57cec5SDimitry Andric #endif
3400b57cec5SDimitry Andric {
3410b57cec5SDimitry Andric   int tos;
3420b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
3430b57cec5SDimitry Andric 
3440b57cec5SDimitry Andric   KMP_ASSERT(gtid == __kmp_get_gtid());
3450b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_push_sync (gtid=%d)\n", gtid));
3460b57cec5SDimitry Andric #if KMP_USE_DYNAMIC_LOCK
3470b57cec5SDimitry Andric   __kmp_check_sync(gtid, ct, ident, lck, seq);
3480b57cec5SDimitry Andric #else
3490b57cec5SDimitry Andric   __kmp_check_sync(gtid, ct, ident, lck);
3500b57cec5SDimitry Andric #endif
3510b57cec5SDimitry Andric   KE_TRACE(100, (PUSH_MSG(ct, ident)));
3520b57cec5SDimitry Andric   tos = ++p->stack_top;
3530b57cec5SDimitry Andric   p->stack_data[tos].type = ct;
3540b57cec5SDimitry Andric   p->stack_data[tos].prev = p->s_top;
3550b57cec5SDimitry Andric   p->stack_data[tos].ident = ident;
3560b57cec5SDimitry Andric   p->stack_data[tos].name = lck;
3570b57cec5SDimitry Andric   p->s_top = tos;
3580b57cec5SDimitry Andric   KE_DUMP(1000, dump_cons_stack(gtid, p));
3590b57cec5SDimitry Andric }
3600b57cec5SDimitry Andric 
3610b57cec5SDimitry Andric /* ------------------------------------------------------------------------ */
3620b57cec5SDimitry Andric 
3630b57cec5SDimitry Andric void __kmp_pop_parallel(int gtid, ident_t const *ident) {
3640b57cec5SDimitry Andric   int tos;
3650b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
3660b57cec5SDimitry Andric   tos = p->stack_top;
3670b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_pop_parallel (%d %d)\n", gtid, __kmp_get_gtid()));
3680b57cec5SDimitry Andric   if (tos == 0 || p->p_top == 0) {
3690b57cec5SDimitry Andric     __kmp_error_construct(kmp_i18n_msg_CnsDetectedEnd, ct_parallel, ident);
3700b57cec5SDimitry Andric   }
3710b57cec5SDimitry Andric   if (tos != p->p_top || p->stack_data[tos].type != ct_parallel) {
3720b57cec5SDimitry Andric     __kmp_error_construct2(kmp_i18n_msg_CnsExpectedEnd, ct_parallel, ident,
3730b57cec5SDimitry Andric                            &p->stack_data[tos]);
3740b57cec5SDimitry Andric   }
3750b57cec5SDimitry Andric   KE_TRACE(100, (POP_MSG(p)));
3760b57cec5SDimitry Andric   p->p_top = p->stack_data[tos].prev;
3770b57cec5SDimitry Andric   p->stack_data[tos].type = ct_none;
3780b57cec5SDimitry Andric   p->stack_data[tos].ident = NULL;
3790b57cec5SDimitry Andric   p->stack_top = tos - 1;
3800b57cec5SDimitry Andric   KE_DUMP(1000, dump_cons_stack(gtid, p));
3810b57cec5SDimitry Andric }
3820b57cec5SDimitry Andric 
3830b57cec5SDimitry Andric enum cons_type __kmp_pop_workshare(int gtid, enum cons_type ct,
3840b57cec5SDimitry Andric                                    ident_t const *ident) {
3850b57cec5SDimitry Andric   int tos;
3860b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
3870b57cec5SDimitry Andric 
3880b57cec5SDimitry Andric   tos = p->stack_top;
3890b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_pop_workshare (%d %d)\n", gtid, __kmp_get_gtid()));
3900b57cec5SDimitry Andric   if (tos == 0 || p->w_top == 0) {
3910b57cec5SDimitry Andric     __kmp_error_construct(kmp_i18n_msg_CnsDetectedEnd, ct, ident);
3920b57cec5SDimitry Andric   }
3930b57cec5SDimitry Andric 
3940b57cec5SDimitry Andric   if (tos != p->w_top ||
3950b57cec5SDimitry Andric       (p->stack_data[tos].type != ct &&
3960b57cec5SDimitry Andric        // below is the exception to the rule that construct types must match
3970b57cec5SDimitry Andric        !(p->stack_data[tos].type == ct_pdo_ordered && ct == ct_pdo))) {
3980b57cec5SDimitry Andric     __kmp_check_null_func();
3990b57cec5SDimitry Andric     __kmp_error_construct2(kmp_i18n_msg_CnsExpectedEnd, ct, ident,
4000b57cec5SDimitry Andric                            &p->stack_data[tos]);
4010b57cec5SDimitry Andric   }
4020b57cec5SDimitry Andric   KE_TRACE(100, (POP_MSG(p)));
4030b57cec5SDimitry Andric   p->w_top = p->stack_data[tos].prev;
4040b57cec5SDimitry Andric   p->stack_data[tos].type = ct_none;
4050b57cec5SDimitry Andric   p->stack_data[tos].ident = NULL;
4060b57cec5SDimitry Andric   p->stack_top = tos - 1;
4070b57cec5SDimitry Andric   KE_DUMP(1000, dump_cons_stack(gtid, p));
4080b57cec5SDimitry Andric   return p->stack_data[p->w_top].type;
4090b57cec5SDimitry Andric }
4100b57cec5SDimitry Andric 
4110b57cec5SDimitry Andric void __kmp_pop_sync(int gtid, enum cons_type ct, ident_t const *ident) {
4120b57cec5SDimitry Andric   int tos;
4130b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
4140b57cec5SDimitry Andric   tos = p->stack_top;
4150b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_pop_sync (%d %d)\n", gtid, __kmp_get_gtid()));
4160b57cec5SDimitry Andric   if (tos == 0 || p->s_top == 0) {
4170b57cec5SDimitry Andric     __kmp_error_construct(kmp_i18n_msg_CnsDetectedEnd, ct, ident);
4180b57cec5SDimitry Andric   }
4190b57cec5SDimitry Andric   if (tos != p->s_top || p->stack_data[tos].type != ct) {
4200b57cec5SDimitry Andric     __kmp_check_null_func();
4210b57cec5SDimitry Andric     __kmp_error_construct2(kmp_i18n_msg_CnsExpectedEnd, ct, ident,
4220b57cec5SDimitry Andric                            &p->stack_data[tos]);
4230b57cec5SDimitry Andric   }
4240b57cec5SDimitry Andric   KE_TRACE(100, (POP_MSG(p)));
4250b57cec5SDimitry Andric   p->s_top = p->stack_data[tos].prev;
4260b57cec5SDimitry Andric   p->stack_data[tos].type = ct_none;
4270b57cec5SDimitry Andric   p->stack_data[tos].ident = NULL;
4280b57cec5SDimitry Andric   p->stack_top = tos - 1;
4290b57cec5SDimitry Andric   KE_DUMP(1000, dump_cons_stack(gtid, p));
4300b57cec5SDimitry Andric }
4310b57cec5SDimitry Andric 
4320b57cec5SDimitry Andric /* ------------------------------------------------------------------------ */
4330b57cec5SDimitry Andric 
4340b57cec5SDimitry Andric void __kmp_check_barrier(int gtid, enum cons_type ct, ident_t const *ident) {
4350b57cec5SDimitry Andric   struct cons_header *p = __kmp_threads[gtid]->th.th_cons;
4360b57cec5SDimitry Andric   KE_TRACE(10, ("__kmp_check_barrier (loc: %p, gtid: %d %d)\n", ident, gtid,
4370b57cec5SDimitry Andric                 __kmp_get_gtid()));
4380b57cec5SDimitry Andric   if (ident != 0) {
4390b57cec5SDimitry Andric     __kmp_check_null_func();
4400b57cec5SDimitry Andric   }
4410b57cec5SDimitry Andric   if (p->w_top > p->p_top) {
4420b57cec5SDimitry Andric     /* we are already in a WORKSHARING construct for this PARALLEL region */
4430b57cec5SDimitry Andric     __kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
4440b57cec5SDimitry Andric                            &p->stack_data[p->w_top]);
4450b57cec5SDimitry Andric   }
4460b57cec5SDimitry Andric   if (p->s_top > p->p_top) {
4470b57cec5SDimitry Andric     /* we are already in a SYNC construct for this PARALLEL region */
4480b57cec5SDimitry Andric     __kmp_error_construct2(kmp_i18n_msg_CnsInvalidNesting, ct, ident,
4490b57cec5SDimitry Andric                            &p->stack_data[p->s_top]);
4500b57cec5SDimitry Andric   }
4510b57cec5SDimitry Andric }
452