| /* |
| * kmp_error.c -- KPTS functions for error checking at runtime |
| */ |
| |
| |
| //===----------------------------------------------------------------------===// |
| // |
| // The LLVM Compiler Infrastructure |
| // |
| // This file is dual licensed under the MIT and the University of Illinois Open |
| // Source Licenses. See LICENSE.txt for details. |
| // |
| //===----------------------------------------------------------------------===// |
| |
| |
| #include "kmp.h" |
| #include "kmp_i18n.h" |
| #include "kmp_str.h" |
| #include "kmp_error.h" |
| |
| /* ------------------------------------------------------------------------ */ |
| /* ------------------------------------------------------------------------ */ |
| |
| #define MIN_STACK 100 |
| |
| |
| static char const * cons_text_c[] = { |
| "(none)", |
| "\"parallel\"", |
| "work-sharing", /* this is not called "for" because of lowering of "sections" pragmas */ |
| "\"ordered\" work-sharing", /* this is not called "for ordered" because of lowering of "sections" pragmas */ |
| "\"sections\"", |
| "work-sharing", /* this is not called "single" because of lowering of "sections" pragmas */ |
| "\"taskq\"", |
| "\"taskq\"", |
| "\"taskq ordered\"", |
| "\"critical\"", |
| "\"ordered\"", /* in PARALLEL */ |
| "\"ordered\"", /* in PDO */ |
| "\"ordered\"", /* in TASKQ */ |
| "\"master\"", |
| "\"reduce\"", |
| "\"barrier\"" |
| }; |
| |
| #define get_src( ident ) ( (ident) == NULL ? NULL : (ident)->psource ) |
| |
| #define PUSH_MSG( ct, ident ) \ |
| "\tpushing on stack: %s (%s)\n", cons_text_c[ (ct) ], get_src( (ident) ) |
| #define POP_MSG( p ) \ |
| "\tpopping off stack: %s (%s)\n", \ |
| cons_text_c[ (p)->stack_data[ tos ].type ], \ |
| get_src( (p)->stack_data[ tos ].ident ) |
| |
| static int const cons_text_c_num = sizeof( cons_text_c ) / sizeof( char const * ); |
| |
| /* ------------------------------------------------------------------------ */ |
| /* --------------- START OF STATIC LOCAL ROUTINES ------------------------- */ |
| /* ------------------------------------------------------------------------ */ |
| |
| static void |
| __kmp_check_null_func( void ) |
| { |
| /* nothing to do */ |
| } |
| |
| static void |
| __kmp_expand_cons_stack( int gtid, struct cons_header *p ) |
| { |
| int i; |
| struct cons_data *d; |
| |
| /* TODO for monitor perhaps? */ |
| if (gtid < 0) |
| __kmp_check_null_func(); |
| |
| KE_TRACE( 10, ("expand cons_stack (%d %d)\n", gtid, __kmp_get_gtid() ) ); |
| |
| d = p->stack_data; |
| |
| p->stack_size = (p->stack_size * 2) + 100; |
| |
| /* TODO free the old data */ |
| p->stack_data = (struct cons_data *) __kmp_allocate( sizeof( struct cons_data ) * (p->stack_size+1) ); |
| |
| for (i = p->stack_top; i >= 0; --i) |
| p->stack_data[i] = d[i]; |
| |
| /* NOTE: we do not free the old stack_data */ |
| } |
| |
| // NOTE: Function returns allocated memory, caller must free it! |
| static char const * |
| __kmp_pragma( |
| int ct, |
| ident_t const * ident |
| ) { |
| char const * cons = NULL; // Construct name. |
| char * file = NULL; // File name. |
| char * func = NULL; // Function (routine) name. |
| char * line = NULL; // Line number. |
| kmp_str_buf_t buffer; |
| kmp_msg_t prgm; |
| __kmp_str_buf_init( & buffer ); |
| if ( 0 < ct && ct < cons_text_c_num ) { |
| cons = cons_text_c[ ct ]; |
| } else { |
| KMP_DEBUG_ASSERT( 0 ); |
| }; |
| if ( ident != NULL && ident->psource != NULL ) { |
| char * tail = NULL; |
| __kmp_str_buf_print( & buffer, "%s", ident->psource ); // Copy source to buffer. |
| // Split string in buffer to file, func, and line. |
| tail = buffer.str; |
| __kmp_str_split( tail, ';', NULL, & tail ); |
| __kmp_str_split( tail, ';', & file, & tail ); |
| __kmp_str_split( tail, ';', & func, & tail ); |
| __kmp_str_split( tail, ';', & line, & tail ); |
| }; // if |
| prgm = __kmp_msg_format( kmp_i18n_fmt_Pragma, cons, file, func, line ); |
| __kmp_str_buf_free( & buffer ); |
| return prgm.str; |
| } // __kmp_pragma |
| |
| /* ------------------------------------------------------------------------ */ |
| /* ----------------- END OF STATIC LOCAL ROUTINES ------------------------- */ |
| /* ------------------------------------------------------------------------ */ |
| |
| |
| void |
| __kmp_error_construct( |
| kmp_i18n_id_t id, // Message identifier. |
| enum cons_type ct, // Construct type. |
| ident_t const * ident // Construct ident. |
| ) { |
| char const * construct = __kmp_pragma( ct, ident ); |
| __kmp_msg( kmp_ms_fatal, __kmp_msg_format( id, construct ), __kmp_msg_null ); |
| KMP_INTERNAL_FREE( (void *) construct ); |
| } |
| |
| void |
| __kmp_error_construct2( |
| kmp_i18n_id_t id, // Message identifier. |
| enum cons_type ct, // First construct type. |
| ident_t const * ident, // First construct ident. |
| struct cons_data const * cons // Second construct. |
| ) { |
| char const * construct1 = __kmp_pragma( ct, ident ); |
| char const * construct2 = __kmp_pragma( cons->type, cons->ident ); |
| __kmp_msg( kmp_ms_fatal, __kmp_msg_format( id, construct1, construct2 ), __kmp_msg_null ); |
| KMP_INTERNAL_FREE( (void *) construct1 ); |
| KMP_INTERNAL_FREE( (void *) construct2 ); |
| } |
| |
| |
| struct cons_header * |
| __kmp_allocate_cons_stack( int gtid ) |
| { |
| struct cons_header *p; |
| |
| /* TODO for monitor perhaps? */ |
| if ( gtid < 0 ) { |
| __kmp_check_null_func(); |
| }; // if |
| KE_TRACE( 10, ("allocate cons_stack (%d)\n", gtid ) ); |
| p = (struct cons_header *) __kmp_allocate( sizeof( struct cons_header ) ); |
| p->p_top = p->w_top = p->s_top = 0; |
| p->stack_data = (struct cons_data *) __kmp_allocate( sizeof( struct cons_data ) * (MIN_STACK+1) ); |
| p->stack_size = MIN_STACK; |
| p->stack_top = 0; |
| p->stack_data[ 0 ].type = ct_none; |
| p->stack_data[ 0 ].prev = 0; |
| p->stack_data[ 0 ].ident = NULL; |
| return p; |
| } |
| |
| void |
| __kmp_free_cons_stack( void * ptr ) { |
| struct cons_header * p = (struct cons_header *) ptr; |
| if ( p != NULL ) { |
| if ( p->stack_data != NULL ) { |
| __kmp_free( p->stack_data ); |
| p->stack_data = NULL; |
| }; // if |
| __kmp_free( p ); |
| }; // if |
| } |
| |
| |
| #if KMP_DEBUG |
| static void |
| dump_cons_stack( int gtid, struct cons_header * p ) { |
| int i; |
| int tos = p->stack_top; |
| kmp_str_buf_t buffer; |
| __kmp_str_buf_init( & buffer ); |
| __kmp_str_buf_print( & buffer, "+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-\n" ); |
| __kmp_str_buf_print( & buffer, "Begin construct stack with %d items for thread %d\n", tos, gtid ); |
| __kmp_str_buf_print( & buffer, " stack_top=%d { P=%d, W=%d, S=%d }\n", tos, p->p_top, p->w_top, p->s_top ); |
| for ( i = tos; i > 0; i-- ) { |
| struct cons_data * c = & ( p->stack_data[ i ] ); |
| __kmp_str_buf_print( & buffer, " stack_data[%2d] = { %s (%s) %d %p }\n", i, cons_text_c[ c->type ], get_src( c->ident ), c->prev, c->name ); |
| }; // for i |
| __kmp_str_buf_print( & buffer, "End construct stack for thread %d\n", gtid ); |
| __kmp_str_buf_print( & buffer, "+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-\n" ); |
| __kmp_debug_printf( "%s", buffer.str ); |
| __kmp_str_buf_free( & buffer ); |
| } |
| #endif |
| |
| void |
| __kmp_push_parallel( int gtid, ident_t const * ident ) |
| { |
| int tos; |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| |
| KMP_DEBUG_ASSERT( __kmp_threads[ gtid ]-> th.th_cons ); |
| KE_TRACE( 10, ("__kmp_push_parallel (%d %d)\n", gtid, __kmp_get_gtid() ) ); |
| KE_TRACE( 100, ( PUSH_MSG( ct_parallel, ident ) ) ); |
| if ( p->stack_top >= p->stack_size ) { |
| __kmp_expand_cons_stack( gtid, p ); |
| }; // if |
| tos = ++p->stack_top; |
| p->stack_data[ tos ].type = ct_parallel; |
| p->stack_data[ tos ].prev = p->p_top; |
| p->stack_data[ tos ].ident = ident; |
| p->stack_data[ tos ].name = NULL; |
| p->p_top = tos; |
| KE_DUMP( 1000, dump_cons_stack( gtid, p ) ); |
| } |
| |
| void |
| __kmp_check_workshare( int gtid, enum cons_type ct, ident_t const * ident ) |
| { |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| |
| KMP_DEBUG_ASSERT( __kmp_threads[ gtid ]-> th.th_cons ); |
| KE_TRACE( 10, ("__kmp_check_workshare (%d %d)\n", gtid, __kmp_get_gtid() ) ); |
| |
| |
| if ( p->stack_top >= p->stack_size ) { |
| __kmp_expand_cons_stack( gtid, p ); |
| }; // if |
| if ( p->w_top > p->p_top && |
| !(IS_CONS_TYPE_TASKQ(p->stack_data[ p->w_top ].type) && IS_CONS_TYPE_TASKQ(ct))) { |
| // We are already in a WORKSHARE construct for this PARALLEL region. |
| __kmp_error_construct2( kmp_i18n_msg_CnsInvalidNesting, ct, ident, & p->stack_data[ p->w_top ] ); |
| }; // if |
| if ( p->s_top > p->p_top ) { |
| // We are already in a SYNC construct for this PARALLEL region. |
| __kmp_error_construct2( kmp_i18n_msg_CnsInvalidNesting, ct, ident, & p->stack_data[ p->s_top ] ); |
| }; // if |
| } |
| |
| void |
| __kmp_push_workshare( int gtid, enum cons_type ct, ident_t const * ident ) |
| { |
| int tos; |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| KE_TRACE( 10, ("__kmp_push_workshare (%d %d)\n", gtid, __kmp_get_gtid() ) ); |
| __kmp_check_workshare( gtid, ct, ident ); |
| KE_TRACE( 100, ( PUSH_MSG( ct, ident ) ) ); |
| tos = ++p->stack_top; |
| p->stack_data[ tos ].type = ct; |
| p->stack_data[ tos ].prev = p->w_top; |
| p->stack_data[ tos ].ident = ident; |
| p->stack_data[ tos ].name = NULL; |
| p->w_top = tos; |
| KE_DUMP( 1000, dump_cons_stack( gtid, p ) ); |
| } |
| |
| void |
| #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 ) |
| #else |
| __kmp_check_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck ) |
| #endif |
| { |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| |
| KE_TRACE( 10, ("__kmp_check_sync (gtid=%d)\n", __kmp_get_gtid() ) ); |
| |
| if (p->stack_top >= p->stack_size) |
| __kmp_expand_cons_stack( gtid, p ); |
| |
| if (ct == ct_ordered_in_parallel || ct == ct_ordered_in_pdo || ct == ct_ordered_in_taskq ) { |
| if (p->w_top <= p->p_top) { |
| /* we are not in a worksharing construct */ |
| #ifdef BUILD_PARALLEL_ORDERED |
| /* do not report error messages for PARALLEL ORDERED */ |
| KMP_ASSERT( ct == ct_ordered_in_parallel ); |
| #else |
| __kmp_error_construct( kmp_i18n_msg_CnsBoundToWorksharing, ct, ident ); |
| #endif /* BUILD_PARALLEL_ORDERED */ |
| } else { |
| /* inside a WORKSHARING construct for this PARALLEL region */ |
| if (!IS_CONS_TYPE_ORDERED(p->stack_data[ p->w_top ].type)) { |
| if (p->stack_data[ p->w_top ].type == ct_taskq) { |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsNotInTaskConstruct, |
| ct, ident, |
| & p->stack_data[ p->w_top ] |
| ); |
| } else { |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsNoOrderedClause, |
| ct, ident, |
| & p->stack_data[ p->w_top ] |
| ); |
| } |
| } |
| } |
| if (p->s_top > p->p_top && p->s_top > p->w_top) { |
| /* inside a sync construct which is inside a worksharing construct */ |
| int index = p->s_top; |
| enum cons_type stack_type; |
| |
| stack_type = p->stack_data[ index ].type; |
| |
| if (stack_type == ct_critical || |
| ( ( stack_type == ct_ordered_in_parallel || |
| stack_type == ct_ordered_in_pdo || |
| stack_type == ct_ordered_in_taskq ) && /* C doesn't allow named ordered; ordered in ordered gets error */ |
| p->stack_data[ index ].ident != NULL && |
| (p->stack_data[ index ].ident->flags & KMP_IDENT_KMPC ))) { |
| /* we are in ORDERED which is inside an ORDERED or CRITICAL construct */ |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsInvalidNesting, |
| ct, ident, |
| & p->stack_data[ index ] |
| ); |
| } |
| } |
| } else if ( ct == ct_critical ) { |
| #if KMP_USE_DYNAMIC_LOCK |
| if ( lck != NULL && __kmp_get_user_lock_owner( lck, seq ) == gtid ) { /* this same thread already has lock for this critical section */ |
| #else |
| if ( lck != NULL && __kmp_get_user_lock_owner( lck ) == gtid ) { /* this same thread already has lock for this critical section */ |
| #endif |
| int index = p->s_top; |
| struct cons_data cons = { NULL, ct_critical, 0, NULL }; |
| /* walk up construct stack and try to find critical with matching name */ |
| while ( index != 0 && p->stack_data[ index ].name != lck ) { |
| index = p->stack_data[ index ].prev; |
| } |
| if ( index != 0 ) { |
| /* found match on the stack (may not always because of interleaved critical for Fortran) */ |
| cons = p->stack_data[ index ]; |
| } |
| /* we are in CRITICAL which is inside a CRITICAL construct of the same name */ |
| __kmp_error_construct2( kmp_i18n_msg_CnsNestingSameName, ct, ident, & cons ); |
| } |
| } else if ( ct == ct_master || ct == ct_reduce ) { |
| if (p->w_top > p->p_top) { |
| /* inside a WORKSHARING construct for this PARALLEL region */ |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsInvalidNesting, |
| ct, ident, |
| & p->stack_data[ p->w_top ] |
| ); |
| } |
| if (ct == ct_reduce && p->s_top > p->p_top) { |
| /* inside a another SYNC construct for this PARALLEL region */ |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsInvalidNesting, |
| ct, ident, |
| & p->stack_data[ p->s_top ] |
| ); |
| }; // if |
| }; // if |
| } |
| |
| void |
| #if KMP_USE_DYNAMIC_LOCK |
| __kmp_push_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck, kmp_uint32 seq ) |
| #else |
| __kmp_push_sync( int gtid, enum cons_type ct, ident_t const * ident, kmp_user_lock_p lck ) |
| #endif |
| { |
| int tos; |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| |
| KMP_ASSERT( gtid == __kmp_get_gtid() ); |
| KE_TRACE( 10, ("__kmp_push_sync (gtid=%d)\n", gtid ) ); |
| #if KMP_USE_DYNAMIC_LOCK |
| __kmp_check_sync( gtid, ct, ident, lck, seq ); |
| #else |
| __kmp_check_sync( gtid, ct, ident, lck ); |
| #endif |
| KE_TRACE( 100, ( PUSH_MSG( ct, ident ) ) ); |
| tos = ++ p->stack_top; |
| p->stack_data[ tos ].type = ct; |
| p->stack_data[ tos ].prev = p->s_top; |
| p->stack_data[ tos ].ident = ident; |
| p->stack_data[ tos ].name = lck; |
| p->s_top = tos; |
| KE_DUMP( 1000, dump_cons_stack( gtid, p ) ); |
| } |
| |
| /* ------------------------------------------------------------------------ */ |
| |
| void |
| __kmp_pop_parallel( int gtid, ident_t const * ident ) |
| { |
| int tos; |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| tos = p->stack_top; |
| KE_TRACE( 10, ("__kmp_pop_parallel (%d %d)\n", gtid, __kmp_get_gtid() ) ); |
| if ( tos == 0 || p->p_top == 0 ) { |
| __kmp_error_construct( kmp_i18n_msg_CnsDetectedEnd, ct_parallel, ident ); |
| } |
| if ( tos != p->p_top || p->stack_data[ tos ].type != ct_parallel ) { |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsExpectedEnd, |
| ct_parallel, ident, |
| & p->stack_data[ tos ] |
| ); |
| } |
| KE_TRACE( 100, ( POP_MSG( p ) ) ); |
| p->p_top = p->stack_data[ tos ].prev; |
| p->stack_data[ tos ].type = ct_none; |
| p->stack_data[ tos ].ident = NULL; |
| p->stack_top = tos - 1; |
| KE_DUMP( 1000, dump_cons_stack( gtid, p ) ); |
| } |
| |
| enum cons_type |
| __kmp_pop_workshare( int gtid, enum cons_type ct, ident_t const * ident ) |
| { |
| int tos; |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| |
| tos = p->stack_top; |
| KE_TRACE( 10, ("__kmp_pop_workshare (%d %d)\n", gtid, __kmp_get_gtid() ) ); |
| if ( tos == 0 || p->w_top == 0 ) { |
| __kmp_error_construct( kmp_i18n_msg_CnsDetectedEnd, ct, ident ); |
| } |
| |
| if ( tos != p->w_top || |
| ( p->stack_data[ tos ].type != ct && |
| /* below are two exceptions to the rule that construct types must match */ |
| ! ( p->stack_data[ tos ].type == ct_pdo_ordered && ct == ct_pdo ) && |
| ! ( p->stack_data[ tos ].type == ct_task_ordered && ct == ct_task ) |
| ) |
| ) { |
| __kmp_check_null_func(); |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsExpectedEnd, |
| ct, ident, |
| & p->stack_data[ tos ] |
| ); |
| } |
| KE_TRACE( 100, ( POP_MSG( p ) ) ); |
| p->w_top = p->stack_data[ tos ].prev; |
| p->stack_data[ tos ].type = ct_none; |
| p->stack_data[ tos ].ident = NULL; |
| p->stack_top = tos - 1; |
| KE_DUMP( 1000, dump_cons_stack( gtid, p ) ); |
| return p->stack_data[ p->w_top ].type; |
| } |
| |
| void |
| __kmp_pop_sync( int gtid, enum cons_type ct, ident_t const * ident ) |
| { |
| int tos; |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| tos = p->stack_top; |
| KE_TRACE( 10, ("__kmp_pop_sync (%d %d)\n", gtid, __kmp_get_gtid() ) ); |
| if ( tos == 0 || p->s_top == 0 ) { |
| __kmp_error_construct( kmp_i18n_msg_CnsDetectedEnd, ct, ident ); |
| }; |
| if ( tos != p->s_top || p->stack_data[ tos ].type != ct ) { |
| __kmp_check_null_func(); |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsExpectedEnd, |
| ct, ident, |
| & p->stack_data[ tos ] |
| ); |
| }; |
| if ( gtid < 0 ) { |
| __kmp_check_null_func(); |
| }; |
| KE_TRACE( 100, ( POP_MSG( p ) ) ); |
| p->s_top = p->stack_data[ tos ].prev; |
| p->stack_data[ tos ].type = ct_none; |
| p->stack_data[ tos ].ident = NULL; |
| p->stack_top = tos - 1; |
| KE_DUMP( 1000, dump_cons_stack( gtid, p ) ); |
| } |
| |
| /* ------------------------------------------------------------------------ */ |
| |
| void |
| __kmp_check_barrier( int gtid, enum cons_type ct, ident_t const * ident ) |
| { |
| struct cons_header *p = __kmp_threads[ gtid ]->th.th_cons; |
| KE_TRACE( 10, ("__kmp_check_barrier (loc: %p, gtid: %d %d)\n", ident, gtid, __kmp_get_gtid() ) ); |
| if ( ident != 0 ) { |
| __kmp_check_null_func(); |
| } |
| if ( p->w_top > p->p_top ) { |
| /* we are already in a WORKSHARING construct for this PARALLEL region */ |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsInvalidNesting, |
| ct, ident, |
| & p->stack_data[ p->w_top ] |
| ); |
| } |
| if (p->s_top > p->p_top) { |
| /* we are already in a SYNC construct for this PARALLEL region */ |
| __kmp_error_construct2( |
| kmp_i18n_msg_CnsInvalidNesting, |
| ct, ident, |
| & p->stack_data[ p->s_top ] |
| ); |
| } |
| } |
| |
| /* ------------------------------------------------------------------------ */ |
| |
| |
| /* ------------------------------------------------------------------------ */ |
| /* ------------------------------------------------------------------------ */ |