diff --git a/frame/base/bli_info.c b/frame/base/bli_info.c index 2e4c1347c..6d901c728 100644 --- a/frame/base/bli_info.c +++ b/frame/base/bli_info.c @@ -5,7 +5,7 @@ libraries. Copyright (C) 2014, The University of Texas at Austin - Copyright (C) 2018 - 2022, Advanced Micro Devices, Inc. All rights reserved. + Copyright (C) 2018 - 2023, Advanced Micro Devices, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are @@ -35,6 +35,9 @@ #include "blis.h" +// Make thread settings local to each thread calling BLIS routines. +// (The definition resides in bli_rntm.c.) +extern BLIS_THREAD_LOCAL rntm_t tl_rntm; // -- General library information ---------------------------------------------- @@ -157,6 +160,11 @@ gint_t bli_info_get_enable_sandbox( void ) #endif } +// -- Error code produced from within xerbla (if called), otherwise 0 +gint_t bli_info_get_info_value( void ) +{ + return tl_rntm.info_value; +} // -- Kernel implementation-related -------------------------------------------- diff --git a/frame/base/bli_info.h b/frame/base/bli_info.h index d900ca4f5..4cb5b1321 100644 --- a/frame/base/bli_info.h +++ b/frame/base/bli_info.h @@ -5,7 +5,7 @@ libraries. Copyright (C) 2014, The University of Texas at Austin - Copyright (C) 2018 - 2019, Advanced Micro Devices, Inc. + Copyright (C) 2018 - 2023, Advanced Micro Devices, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are @@ -75,6 +75,8 @@ BLIS_EXPORT_BLIS gint_t bli_info_get_thread_part_jrir_rr( void ); BLIS_EXPORT_BLIS gint_t bli_info_get_enable_memkind( void ); BLIS_EXPORT_BLIS gint_t bli_info_get_enable_sandbox( void ); +// -- Get value of info from within xerbla (if called), otherwise 0 returned +BLIS_EXPORT_BLIS gint_t bli_info_get_info_value( void ); // -- Kernel implementation-related -------------------------------------------- diff --git a/frame/base/bli_rntm.c b/frame/base/bli_rntm.c index e8c29b0cc..ce9a38798 100644 --- a/frame/base/bli_rntm.c +++ b/frame/base/bli_rntm.c @@ -37,7 +37,7 @@ // The global rntm_t structure, which holds the global thread settings // along with a few other key parameters. -rntm_t global_rntm; +rntm_t global_rntm = BLIS_RNTM_INITIALIZER; // Make thread settings local to each thread calling BLIS routines BLIS_THREAD_LOCAL rntm_t tl_rntm = BLIS_RNTM_INITIALIZER; diff --git a/frame/base/bli_rntm.h b/frame/base/bli_rntm.h index 13b576568..5df21f811 100644 --- a/frame/base/bli_rntm.h +++ b/frame/base/bli_rntm.h @@ -225,6 +225,21 @@ BLIS_INLINE dim_t bli_rntm_equals( rntm_t* rntm1, rntm_t* rntm2 ) } #endif +BLIS_INLINE bool bli_rntm_stop_on_error( rntm_t* rntm ) +{ + return rntm->stop_on_error; +} + +BLIS_INLINE bool bli_rntm_print_on_error( rntm_t* rntm ) +{ + return rntm->print_on_error; +} + +BLIS_INLINE gint_t bli_rntm_info_value( rntm_t* rntm ) +{ + return rntm->info_value; +} + // // -- rntm_t modification (internal use only) ---------------------------------- // @@ -312,6 +327,21 @@ BLIS_INLINE void bli_rntm_clear_pba( rntm_t* rntm ) bli_rntm_set_pba( NULL, rntm ); } +BLIS_INLINE void bli_rntm_set_stop_on_error_only( bool stop_on_error, rntm_t* rntm ) +{ + rntm->stop_on_error = stop_on_error; +} + +BLIS_INLINE void bli_rntm_set_print_on_error_only( bool print_on_error, rntm_t* rntm ) +{ + rntm->print_on_error = print_on_error; +} + +BLIS_INLINE void bli_rntm_set_info_value_only( gint_t info_value, rntm_t* rntm ) +{ + rntm->info_value = info_value; +} + // // -- rntm_t modification (public API) ----------------------------------------- // @@ -422,7 +452,10 @@ BLIS_INLINE void bli_rntm_clear_l3_sup( rntm_t* rntm ) .blis_mt = FALSE, \ .sba_pool = NULL, \ .pba = NULL, \ - } \ + .stop_on_error = FALSE, \ + .print_on_error = TRUE, \ + .info_value = 0, \ + } BLIS_INLINE void bli_rntm_init( rntm_t* rntm ) { diff --git a/frame/compat/bla_gemv_amd.c b/frame/compat/bla_gemv_amd.c index c2d743e80..4077711e5 100644 --- a/frame/compat/bla_gemv_amd.c +++ b/frame/compat/bla_gemv_amd.c @@ -54,8 +54,6 @@ void PASTEF77S(ch,blasname) \ ftype* y, const f77_int* incy \ ) \ { \ - AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_1); \ - AOCL_DTL_LOG_GEMV_INPUTS(AOCL_DTL_LEVEL_TRACE_1, *MKSTR(ch), *transa, *m, *n, (void*)alpha, *lda, *incx, (void*)beta, *incy); \ trans_t blis_transa; \ dim_t m0, n0; \ dim_t m_y, n_x; \ @@ -64,6 +62,9 @@ void PASTEF77S(ch,blasname) \ inc_t incx0; \ inc_t incy0; \ inc_t rs_a, cs_a; \ +\ + AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_1); \ + AOCL_DTL_LOG_GEMV_INPUTS(AOCL_DTL_LEVEL_TRACE_1, *MKSTR(ch), *transa, *m, *n, (void*)alpha, *lda, *incx, (void*)beta, *incy); \ \ /* Initialize BLIS. */ \ bli_init_auto(); \ @@ -186,6 +187,9 @@ void dgemv_blis_impl AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_1); AOCL_DTL_LOG_GEMV_INPUTS(AOCL_DTL_LEVEL_TRACE_1, 'D', *transa, *m, *n, (void*)alpha, *lda, *incx, (void*)beta, *incy); + /* Initialize BLIS. */ + bli_init_auto(); + /* Perform BLAS parameter checking. */ PASTEBLACHK(gemv) ( @@ -386,6 +390,10 @@ void sgemv_blis_impl AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_1); AOCL_DTL_LOG_GEMV_INPUTS(AOCL_DTL_LEVEL_TRACE_1, 'S', *transa, *m, *n, (void*)alpha, *lda, *incx, (void*)beta, *incy); + + /* Initialize BLIS. */ + bli_init_auto(); + /* Perform BLAS parameter checking. */ PASTEBLACHK(gemv) ( @@ -570,9 +578,6 @@ void cgemv_blis_impl scomplex* y, const f77_int* incy ) { - AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_1); - AOCL_DTL_LOG_GEMV_INPUTS(AOCL_DTL_LEVEL_TRACE_1, 'C', *transa, *m, *n, (void*)alpha, *lda, *incx, (void*)beta, *incy); - trans_t blis_transa; dim_t m0, n0; dim_t m_y, n_x; @@ -582,6 +587,12 @@ void cgemv_blis_impl inc_t incy0; inc_t rs_a, cs_a; + AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_1); + AOCL_DTL_LOG_GEMV_INPUTS(AOCL_DTL_LEVEL_TRACE_1, 'C', *transa, *m, *n, (void*)alpha, *lda, *incx, (void*)beta, *incy); + + /* Initialize BLIS. */ + bli_init_auto(); + /* Perform BLAS parameter checking. */ PASTEBLACHK(gemv) ( @@ -808,9 +819,6 @@ void zgemv_blis_impl dcomplex* y, const f77_int* incy ) { - AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_1); - AOCL_DTL_LOG_GEMV_INPUTS(AOCL_DTL_LEVEL_TRACE_1, 'Z', *transa, *m, *n, (void*)alpha, *lda, *incx, (void*)beta, *incy); - trans_t blis_transa; dim_t m0, n0; dim_t m_y, n_x; @@ -820,6 +828,12 @@ void zgemv_blis_impl inc_t incy0; inc_t rs_a, cs_a; + AOCL_DTL_TRACE_ENTRY(AOCL_DTL_LEVEL_TRACE_1); + AOCL_DTL_LOG_GEMV_INPUTS(AOCL_DTL_LEVEL_TRACE_1, 'Z', *transa, *m, *n, (void*)alpha, *lda, *incx, (void*)beta, *incy); + + /* Initialize BLIS. */ + bli_init_auto(); + /* Perform BLAS parameter checking. */ PASTEBLACHK(gemv) ( diff --git a/frame/compat/blis/thread/b77_thread.c b/frame/compat/blis/thread/b77_thread.c index fa28b959b..d8446ebf6 100644 --- a/frame/compat/blis/thread/b77_thread.c +++ b/frame/compat/blis/thread/b77_thread.c @@ -91,3 +91,14 @@ void PASTEF770(bli_thread_set_num_threads) //bli_finalize_auto(); } +f77_int PASTEF770(bli_info_get_info_value) + ( + ) +{ + // Call the BLIS function. + gint_t info_value = bli_info_get_info_value(); + f77_int f77_info_value = (f77_int) info_value; + + return f77_info_value; +} + diff --git a/frame/compat/blis/thread/b77_thread.h b/frame/compat/blis/thread/b77_thread.h index 922ed6e13..e3106d14e 100644 --- a/frame/compat/blis/thread/b77_thread.h +++ b/frame/compat/blis/thread/b77_thread.h @@ -51,3 +51,7 @@ BLIS_EXPORT_BLAS void PASTEF770(bli_thread_set_num_threads) const f77_int* nt ); +BLIS_EXPORT_BLAS f77_int PASTEF770(bli_info_get_info_value) + ( + ); + diff --git a/frame/compat/f2c/bla_xerbla.c b/frame/compat/f2c/bla_xerbla.c index 62dd6b5ed..0e0ec59d3 100644 --- a/frame/compat/f2c/bla_xerbla.c +++ b/frame/compat/f2c/bla_xerbla.c @@ -35,6 +35,13 @@ #include "blis.h" +// The global rntm_t structure. (The definition resides in bli_rntm.c.) +extern rntm_t global_rntm; + +// Make thread settings local to each thread calling BLIS routines. +// (The definition resides in bli_rntm.c.) +extern BLIS_THREAD_LOCAL rntm_t tl_rntm; + /* xerbla.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) @@ -76,10 +83,25 @@ //for ( i = 0; i < srname_len; ++i ) // srname[i] = toupper( srname[i] ); - printf("** On entry to %6s, parameter number %2i had an illegal value\n", - srname, (int)*info); + // Make sure rntm variables are initialized. + bli_init_once(); - //bli_abort(); + // Store info value in thread-local rntm data structure. + gint_t info_value = (gint_t) *info; + bli_rntm_set_info_value_only( info_value, &tl_rntm ); + + bool print_on_error = bli_rntm_print_on_error( &global_rntm ); + if (print_on_error) + { + printf("** On entry to %6s, parameter number %2i had an illegal value\n", + srname, (int)*info); + } + + bool stop_on_error = bli_rntm_stop_on_error( &global_rntm ); + if (stop_on_error) + { + bli_abort(); + } /* End of XERBLA */ diff --git a/frame/include/bli_type_defs.h b/frame/include/bli_type_defs.h index 304dfb781..4eb9c098c 100644 --- a/frame/include/bli_type_defs.h +++ b/frame/include/bli_type_defs.h @@ -1534,6 +1534,12 @@ typedef struct rntm_s // The packing block allocator, which is attached in the l3 thread decorator. pba_t* pba; + // Store values of environment variables to control BLIS version of xerbla + // and error code from xerbla + bool stop_on_error; + bool print_on_error; + gint_t info_value; + } rntm_t; diff --git a/frame/thread/bli_thread.c b/frame/thread/bli_thread.c index 0e21ab0f6..3333df89c 100644 --- a/frame/thread/bli_thread.c +++ b/frame/thread/bli_thread.c @@ -1853,6 +1853,35 @@ void bli_thread_init_rntm_from_env #endif // BLIS_ENABLE_MULTITHREADING + // Check environment for options to control xerbla + + // Default: Don't stop on error + gint_t bli_stop_on_error_int = bli_env_get_var( "BLIS_STOP_ON_ERROR", 0 ); + bool bli_stop_on_error; + + if ( bli_stop_on_error_int != 0 ) + { + bli_stop_on_error = TRUE; + } + else + { + bli_stop_on_error = FALSE; + } + bli_rntm_set_stop_on_error_only(bli_stop_on_error, rntm); + + // Default: print on error + gint_t bli_print_on_error_int = bli_env_get_var( "BLIS_PRINT_ON_ERROR", 1 ); + bool bli_print_on_error; + if (bli_print_on_error_int != 0 ) + { + bli_print_on_error = TRUE; + } + else + { + bli_print_on_error = FALSE; + } + bli_rntm_set_print_on_error_only(bli_print_on_error, rntm); + // Save the results back in the runtime object. bli_rntm_set_auto_factor_only( auto_factor, rntm ); bli_rntm_set_num_threads_only( nt, rntm ); @@ -2025,6 +2054,10 @@ void bli_thread_update_rntm_from_env bli_rntm_set_ways_only( jc, pc, ic, jr, ir, rntm ); bli_rntm_set_blis_mt_only( blis_mt, rntm ); + // Initialize info_value to 0 + gint_t info_value = 0; + bli_rntm_set_info_value_only( info_value, rntm ); + #ifdef PRINT_THREADING printf( "bli_thread_update_rntm_from_env(): tl_rntm\n" ); bli_rntm_print( rntm );