void bli_scalv_int( obj_t* beta,
obj_t* x,
scalv_t* cntl )
{
varnum_t n;
impl_t i;
FUNCPTR_T f;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_scalv_int_check( beta, x, cntl );
// First check if we are to skip this operation.
if ( cntl_is_noop( cntl ) ) return;
// Return early if one of the matrix operands has a zero dimension.
if ( bli_obj_has_zero_dim( *x ) ) return;
// Return early if the beta scalar equals one.
if ( bli_obj_equals( beta, &BLIS_ONE ) ) return;
// Extract the variant number and implementation type.
n = cntl_var_num( cntl );
i = cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( beta,
x );
}
void bli_scalm_unb_var1( obj_t* alpha,
obj_t* x,
cntx_t* cntx )
{
num_t dt_x = bli_obj_datatype( *x );
doff_t diagoffx = bli_obj_diag_offset( *x );
uplo_t diagx = bli_obj_diag( *x );
uplo_t uplox = bli_obj_uplo( *x );
dim_t m = bli_obj_length( *x );
dim_t n = bli_obj_width( *x );
void* buf_x = bli_obj_buffer_at_off( *x );
inc_t rs_x = bli_obj_row_stride( *x );
inc_t cs_x = bli_obj_col_stride( *x );
void* buf_alpha;
obj_t x_local;
FUNCPTR_T f;
// Alias x to x_local so we can apply alpha if it is non-unit.
bli_obj_alias_to( *x, x_local );
// If alpha is non-unit, apply it to the scalar attached to x.
if ( !bli_obj_equals( alpha, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( alpha, &x_local );
}
// Grab the address of the internal scalar buffer for the scalar
// attached to x.
buf_alpha_x = bli_obj_internal_scalar_buffer( *x );
// Index into the type combination array to extract the correct
// function pointer.
// NOTE: We use dt_x for both alpha and x because alpha was obtained
// from the attached scalar of x, which is guaranteed to be of the
// same datatype as x.
f = ftypes[dt_x][dt_x];
// Invoke the function.
// NOTE: We unconditionally pass in BLIS_NO_CONJUGATE for alpha
// because it would have already been conjugated by the front-end.
f( BLIS_NO_CONJUGATE,
diagoffx,
diagx,
uplox,
m,
n,
buf_alpha,
buf_x, rs_x, cs_x );
}
void bli_scalm_int( obj_t* beta,
obj_t* x,
scalm_t* cntl )
{
obj_t x_local;
varnum_t n;
impl_t i;
FUNCPTR_T f;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_scalm_int_check( beta, x, cntl );
// First check if we are to skip this operation.
if ( cntl_is_noop( cntl ) ) return;
// Return early if one of the matrix operands has a zero dimension.
if ( bli_obj_has_zero_dim( *x ) ) return;
// Return early if both beta and the scalar attached to x are unit.
if ( bli_obj_equals( beta, &BLIS_ONE ) &&
bli_obj_scalar_equals( x, &BLIS_ONE ) ) return;
// Alias x to x_local so we can apply beta if it is non-unit.
bli_obj_alias_to( *x, x_local );
// If beta is non-unit, apply it to the scalar attached to x.
if ( !bli_obj_equals( beta, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( beta, &x_local );
}
// Extract the variant number and implementation type.
n = cntl_var_num( cntl );
i = cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( &x_local );
}
bool_t bli_obj_scalar_equals( obj_t* a,
obj_t* beta )
{
obj_t scalar_a;
bool_t r_val;
bli_obj_scalar_detach( a, &scalar_a );
r_val = bli_obj_equals( &scalar_a, beta );
return r_val;
}
void libblis_test_amaxv_check
(
test_params_t* params,
obj_t* x,
obj_t* index,
double* resid
)
{
obj_t index_test;
obj_t chi_i;
obj_t chi_i_test;
dim_t i;
dim_t i_test;
double i_d, junk;
double i_d_test;
//
// Pre-conditions:
// - x is randomized.
//
// Under these conditions, we assume that the implementation for
//
// index := amaxv( x )
//
// is functioning correctly if
//
// x[ index ] = max( x )
//
// where max() is implemented via the bli_?amaxv_test() function.
//
// The following two calls have already been made by the caller. That
// is, the index object has already been created and the library's
// amaxv implementation has already been tested.
//bli_obj_scalar_init_detached( BLIS_INT, &index );
//bli_amaxv( x, &index );
bli_getsc( index, &i_d, &junk );
i = i_d;
bli_acquire_vi( i, x, &chi_i );
bli_obj_scalar_init_detached( BLIS_INT, &index_test );
bli_amaxv_test( x, &index_test );
bli_getsc( &index_test, &i_d_test, &junk );
i_test = i_d_test;
bli_acquire_vi( i_test, x, &chi_i_test );
// Verify that the values referenced by index and index_test are equal.
if ( bli_obj_equals( &chi_i, &chi_i_test ) ) *resid = 0.0;
else *resid = 1.0;
}
void bli_symm_front
(
side_t side,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
cntx_t* cntx,
cntl_t* cntl
)
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_symm_check( side, alpha, a, b, beta, c, cntx );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Reinitialize the memory allocator to accommodate the blocksizes
// in the current context.
bli_memsys_reinit( cntx );
// Alias A, B, and C in case we need to apply transformations.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if ( bli_cntx_l3_ukr_dislikes_storage_of( &c_local, BLIS_GEMM_UKR, cntx ) )
{
bli_toggle_side( side );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
}
// Swap A and B if multiplying A from the right so that "B" contains
// the symmetric matrix.
if ( bli_is_right( side ) )
{
bli_obj_swap( a_local, b_local );
}
// Set the operation family id in the context.
bli_cntx_set_family( BLIS_GEMM, cntx );
// Record the threading for each level within the context.
bli_cntx_set_thrloop_from_env( BLIS_SYMM, BLIS_LEFT, cntx );
// Invoke the internal back-end.
bli_l3_thread_decorator
(
bli_gemm_int,
alpha,
&a_local,
&b_local,
beta,
&c_local,
cntx,
cntl
);
}
void bli_her2k_front
(
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
cntx_t* cntx,
cntl_t* cntl
)
{
bli_init_once();
obj_t alpha_conj;
obj_t c_local;
obj_t a_local;
obj_t bh_local;
obj_t b_local;
obj_t ah_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_her2k_check( alpha, a, b, beta, c, cntx );
// If alpha is zero, scale by beta, zero the imaginary components of
// the diagonal elements, and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
bli_setid( &BLIS_ZERO, c );
return;
}
// Alias A, B, and C in case we need to apply transformations.
bli_obj_alias_to( a, &a_local );
bli_obj_alias_to( b, &b_local );
bli_obj_alias_to( c, &c_local );
bli_obj_set_as_root( &c_local );
// For her2k, the first and second right-hand "B" operands are simply B'
// and A'.
bli_obj_alias_to( b, &bh_local );
bli_obj_induce_trans( &bh_local );
bli_obj_toggle_conj( &bh_local );
bli_obj_alias_to( a, &ah_local );
bli_obj_induce_trans( &ah_local );
bli_obj_toggle_conj( &ah_local );
// Initialize a conjugated copy of alpha.
bli_obj_scalar_init_detached_copy_of( bli_obj_dt( a ),
BLIS_CONJUGATE,
alpha,
&alpha_conj );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if ( bli_cntx_l3_ukr_dislikes_storage_of( &c_local, BLIS_GEMM_UKR, cntx ) )
{
bli_obj_swap( &a_local, &bh_local );
bli_obj_swap( &b_local, &ah_local );
bli_obj_induce_trans( &a_local );
bli_obj_induce_trans( &bh_local );
bli_obj_induce_trans( &b_local );
bli_obj_induce_trans( &ah_local );
bli_obj_induce_trans( &c_local );
}
// Record the threading for each level within the context.
bli_cntx_set_thrloop_from_env( BLIS_HER2K, BLIS_LEFT, cntx,
bli_obj_length( &c_local ),
bli_obj_width( &c_local ),
bli_obj_width( &a_local ) );
// Invoke herk twice, using beta only the first time.
// Invoke the internal back-end.
bli_l3_thread_decorator
(
bli_gemm_int,
BLIS_HERK, // operation family id
alpha,
&a_local,
&bh_local,
beta,
&c_local,
cntx,
cntl
);
bli_l3_thread_decorator
(
bli_gemm_int,
BLIS_HERK, // operation family id
&alpha_conj,
&b_local,
&ah_local,
&BLIS_ONE,
&c_local,
cntx,
cntl
);
// The Hermitian rank-2k product was computed as A*B'+B*A', even for
// the diagonal elements. Mathematically, the imaginary components of
// diagonal elements of a Hermitian rank-2k product should always be
// zero. However, in practice, they sometimes accumulate meaningless
// non-zero values. To prevent this, we explicitly set those values
// to zero before returning.
bli_setid( &BLIS_ZERO, &c_local );
}
void bli_her2k_front( obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
gemm_t* cntl )
{
obj_t alpha_conj;
obj_t c_local;
obj_t a_local;
obj_t bh_local;
obj_t b_local;
obj_t ah_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_her2k_check( alpha, a, b, beta, c );
// If alpha is zero, scale by beta, zero the imaginary components of
// the diagonal elements, and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
bli_setid( &BLIS_ZERO, c );
return;
}
// Alias A, B, and C in case we need to apply transformations.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
bli_obj_set_as_root( c_local );
// For her2k, the first and second right-hand "B" operands are simply B'
// and A'.
bli_obj_alias_to( *b, bh_local );
bli_obj_induce_trans( bh_local );
bli_obj_toggle_conj( bh_local );
bli_obj_alias_to( *a, ah_local );
bli_obj_induce_trans( ah_local );
bli_obj_toggle_conj( ah_local );
// Initialize a conjugated copy of alpha.
bli_obj_scalar_init_detached_copy_of( bli_obj_datatype( *a ),
BLIS_CONJUGATE,
alpha,
&alpha_conj );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if (
( bli_obj_is_row_stored( c_local ) &&
bli_func_prefers_contig_cols( bli_obj_datatype( c_local ),
bli_gemm_cntl_ukrs( cntl ) ) ) ||
( bli_obj_is_col_stored( c_local ) &&
bli_func_prefers_contig_rows( bli_obj_datatype( c_local ),
bli_gemm_cntl_ukrs( cntl ) ) )
)
{
bli_obj_swap( a_local, bh_local );
bli_obj_swap( b_local, ah_local );
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( bh_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( ah_local );
bli_obj_induce_trans( c_local );
}
#if 0
// Invoke the internal back-end.
bli_her2k_int( alpha,
&a_local,
&bh_local,
&alpha_conj,
&b_local,
&ah_local,
beta,
&c_local,
cntl );
#else
// Invoke herk twice, using beta only the first time.
herk_thrinfo_t** infos = bli_create_herk_thrinfo_paths();
dim_t n_threads = thread_num_threads( infos[0] );
// Invoke the internal back-end.
bli_level3_thread_decorator( n_threads,
(level3_int_t) bli_herk_int,
alpha,
&a_local,
&bh_local,
beta,
&c_local,
(void*) cntl,
(void**) infos );
bli_level3_thread_decorator( n_threads,
(level3_int_t) bli_herk_int,
&alpha_conj,
&b_local,
&ah_local,
&BLIS_ONE,
&c_local,
(void*) cntl,
(void**) infos );
bli_herk_thrinfo_free_paths( infos, n_threads );
#endif
// The Hermitian rank-2k product was computed as A*B'+B*A', even for
// the diagonal elements. Mathematically, the imaginary components of
// diagonal elements of a Hermitian rank-2k product should always be
// zero. However, in practice, they sometimes accumulate meaningless
// non-zero values. To prevent this, we explicitly set those values
// to zero before returning.
bli_setid( &BLIS_ZERO, &c_local );
}
void bli_trmm3_front( side_t side,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
trmm_t* l_cntl,
trmm_t* r_cntl )
{
trmm_t* cntl;
obj_t a_local;
obj_t b_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_trmm3_check( side, alpha, a, b, beta, c );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Alias A, B, and C so we can tweak the objects if necessary.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
// We do not explicitly implement the cases where A is transposed.
// However, we can still handle them. Specifically, if A is marked as
// needing a transposition, we simply induce a transposition. This
// allows us to only explicitly implement the no-transpose cases. Once
// the transposition is induced, the correct algorithm will be called,
// since, for example, an algorithm over a transposed lower triangular
// matrix A moves in the same direction (forwards) as a non-transposed
// upper triangular matrix. And with the transposition induced, the
// matrix now appears to be upper triangular, so the upper triangular
// algorithm will grab the correct partitions, as if it were upper
// triangular (with no transpose) all along.
if ( bli_obj_has_trans( a_local ) )
{
bli_obj_induce_trans( a_local );
bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, a_local );
}
#if 0
if ( bli_is_right( side ) )
{
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
bli_toggle_side( side );
}
#endif
#if 1
// If A is being multiplied from the right, swap A and B so that
// the matrix will actually be on the right.
if ( bli_is_right( side ) )
{
bli_obj_swap( a_local, b_local );
}
// An optimization: If C is row-stored, transpose the entire operation
// so as to allow the macro-kernel more favorable access patterns
// through C. (The effect of the transposition of A and B is negligible
// because those operands are always packed to contiguous memory.)
if ( bli_obj_is_row_stored( c_local ) )
{
bli_obj_swap( a_local, b_local );
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
bli_toggle_side( side );
}
#endif
// Set each alias as the root object.
// NOTE: We MUST wait until we are done potentially swapping the objects
// before setting the root fields!
bli_obj_set_as_root( a_local );
bli_obj_set_as_root( b_local );
bli_obj_set_as_root( c_local );
// Choose the control tree.
if ( bli_is_left( side ) ) cntl = l_cntl;
else cntl = r_cntl;
trmm_thrinfo_t** infos = bli_create_trmm_thrinfo_paths( FALSE );
dim_t n_threads = thread_num_threads( infos[0] );
// Invoke the internal back-end.
bli_level3_thread_decorator( n_threads,
(level3_int_t) bli_trmm_int,
alpha,
&a_local,
&b_local,
beta,
&c_local,
(void*) cntl,
(void**) infos );
bli_trmm_thrinfo_free_paths( infos, n_threads );
}
void bli_syrk_front( obj_t* alpha,
obj_t* a,
obj_t* beta,
obj_t* c,
gemm_t* cntl )
{
obj_t a_local;
obj_t at_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_syrk_check( alpha, a, beta, c );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Alias A and C in case we need to apply transformations.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *c, c_local );
bli_obj_set_as_root( c_local );
// For syrk, the right-hand "B" operand is simply A^T.
bli_obj_alias_to( *a, at_local );
bli_obj_induce_trans( at_local );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if (
( bli_obj_is_row_stored( c_local ) &&
bli_func_prefers_contig_cols( bli_obj_datatype( c_local ),
bli_gemm_cntl_ukrs( cntl ) ) ) ||
( bli_obj_is_col_stored( c_local ) &&
bli_func_prefers_contig_rows( bli_obj_datatype( c_local ),
bli_gemm_cntl_ukrs( cntl ) ) )
)
{
bli_obj_induce_trans( c_local );
}
herk_thrinfo_t** infos = bli_create_herk_thrinfo_paths();
dim_t n_threads = thread_num_threads( infos[0] );
// Invoke the internal back-end.
bli_level3_thread_decorator( n_threads,
(level3_int_t) bli_herk_int,
alpha,
&a_local,
&at_local,
beta,
&c_local,
(void*) cntl,
(void**) infos );
bli_herk_thrinfo_free_paths( infos, n_threads );
}
void bli_gemm_int
(
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
cntx_t* cntx,
cntl_t* cntl,
thrinfo_t* thread
)
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
gemm_voft f;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_gemm_basic_check( alpha, a, b, beta, c, cntx );
// If C has a zero dimension, return early.
if ( bli_obj_has_zero_dim( *c ) ) return;
// If A or B has a zero dimension, scale C by beta and return early.
if ( bli_obj_has_zero_dim( *a ) ||
bli_obj_has_zero_dim( *b ) )
{
if ( bli_thread_am_ochief( thread ) )
bli_scalm( beta, c );
bli_thread_obarrier( thread );
return;
}
// If A or B is marked as being filled with zeros, scale C by beta and
// return early.
if ( bli_obj_is_zeros( *a ) ||
bli_obj_is_zeros( *b ) )
{
// This should never execute.
bli_abort();
if ( bli_thread_am_ochief( thread ) )
bli_scalm( beta, c );
bli_thread_obarrier( thread );
return;
}
// Alias A, B, and C in case we need to update attached scalars.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
// If alpha is non-unit, typecast and apply it to the scalar attached
// to B.
if ( !bli_obj_equals( alpha, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( alpha, &b_local );
}
// If beta is non-unit, typecast and apply it to the scalar attached
// to C.
if ( !bli_obj_equals( beta, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( beta, &c_local );
}
// Create the next node in the thrinfo_t structure.
bli_thrinfo_grow( cntx, cntl, thread );
// Extract the function pointer from the current control tree node.
f = bli_cntl_var_func( cntl );
// Somewhat hackish support for 3m3, 3m2, and 4m1b method implementations.
{
ind_t im = bli_cntx_get_ind_method( cntx );
if ( im != BLIS_NAT )
{
if ( im == BLIS_3M3 && f == bli_gemm_packa ) f = bli_gemm3m3_packa;
else if ( im == BLIS_3M2 && f == bli_gemm_ker_var2 ) f = bli_gemm3m2_ker_var2;
else if ( im == BLIS_4M1B && f == bli_gemm_ker_var2 ) f = bli_gemm4mb_ker_var2;
}
}
// Invoke the variant.
f
(
&a_local,
&b_local,
&c_local,
cntx,
cntl,
thread
);
}
void bli_gemm_int( obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
gemm_t* cntl,
gemm_thrinfo_t* thread )
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
varnum_t n;
impl_t i;
FUNCPTR_T f;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_gemm_int_check( alpha, a, b, beta, c, cntl );
// If C has a zero dimension, return early.
if ( bli_obj_has_zero_dim( *c ) ) return;
// If A or B has a zero dimension, scale C by beta and return early.
if ( bli_obj_has_zero_dim( *a ) ||
bli_obj_has_zero_dim( *b ) )
{
if( thread_am_ochief( thread ) )
bli_scalm( beta, c );
thread_obarrier( thread );
return;
}
// If A or B is marked as being filled with zeros, scale C by beta and
// return early.
if ( bli_obj_is_zeros( *a ) ||
bli_obj_is_zeros( *b ) )
{
if( thread_am_ochief( thread ) )
bli_scalm( beta, c );
thread_obarrier( thread );
return;
}
// Alias A and B in case we need to update attached scalars.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
// Alias C in case we need to induce a transposition.
bli_obj_alias_to( *c, c_local );
// If we are about to call a leaf-level implementation, and matrix C
// still needs a transposition, then we must induce one by swapping the
// strides and dimensions. Note that this transposition would normally
// be handled explicitly in the packing of C, but if C is not being
// packed, this is our last chance to handle the transposition.
if ( cntl_is_leaf( cntl ) && bli_obj_has_trans( *c ) )
{
//if( thread_am_ochief( thread ) ) {
bli_obj_induce_trans( c_local );
bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, c_local );
// }
}
// If alpha is non-unit, typecast and apply it to the scalar attached
// to B.
if ( !bli_obj_equals( alpha, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( alpha, &b_local );
}
// If beta is non-unit, typecast and apply it to the scalar attached
// to C.
if ( !bli_obj_equals( beta, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( beta, &c_local );
}
// Extract the variant number and implementation type.
n = cntl_var_num( cntl );
i = cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( &a_local,
&b_local,
&c_local,
cntl,
thread );
}
void bli_trsm_front( side_t side,
obj_t* alpha,
obj_t* a,
obj_t* b,
cntx_t* cntx,
trsm_t* l_cntl,
trsm_t* r_cntl )
{
trsm_t* cntl;
obj_t a_local;
obj_t b_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_trsm_check( side, alpha, a, b, &BLIS_ZERO, b, cntx );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( alpha, b );
return;
}
// Reinitialize the memory allocator to accommodate the blocksizes
// in the current context.
bli_mem_reinit( cntx );
// Alias A and B so we can tweak the objects if necessary.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *b, c_local );
// We do not explicitly implement the cases where A is transposed.
// However, we can still handle them. Specifically, if A is marked as
// needing a transposition, we simply induce a transposition. This
// allows us to only explicitly implement the no-transpose cases. Once
// the transposition is induced, the correct algorithm will be called,
// since, for example, an algorithm over a transposed lower triangular
// matrix A moves in the same direction (forwards) as a non-transposed
// upper triangular matrix. And with the transposition induced, the
// matrix now appears to be upper triangular, so the upper triangular
// algorithm will grab the correct partitions, as if it were upper
// triangular (with no transpose) all along.
if ( bli_obj_has_trans( a_local ) )
{
bli_obj_induce_trans( a_local );
bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, a_local );
}
#if 0
// If A is being solved against from the right, transpose all operands
// so that we can perform the computation as if A were being solved
// from the left.
if ( bli_is_right( side ) )
{
bli_toggle_side( side );
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
}
#else
// If A is being solved against from the right, swap A and B so that
// the triangular matrix will actually be on the right.
if ( bli_is_right( side ) )
{
bli_obj_swap( a_local, b_local );
}
#endif
// Set each alias as the root object.
// NOTE: We MUST wait until we are done potentially swapping the objects
// before setting the root fields!
bli_obj_set_as_root( a_local );
bli_obj_set_as_root( b_local );
bli_obj_set_as_root( c_local );
// Choose the control tree.
if ( bli_is_left( side ) ) cntl = l_cntl;
else cntl = r_cntl;
trsm_thrinfo_t** infos = bli_create_trsm_thrinfo_paths( bli_is_right( side ) );
dim_t n_threads = thread_num_threads( infos[0] );
// Invoke the internal back-end.
bli_level3_thread_decorator( n_threads,
(l3_int_t) bli_trsm_int,
alpha,
&a_local,
&b_local,
alpha,
&c_local,
(void*) cntx,
(void*) cntl,
(void**) infos );
bli_trsm_thrinfo_free_paths( infos, n_threads );
}
void bli_trsm_int
(
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
cntx_t* cntx,
rntm_t* rntm,
cntl_t* cntl,
thrinfo_t* thread
)
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
trsm_var_oft f;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_gemm_basic_check( alpha, a, b, beta, c, cntx );
// If C has a zero dimension, return early.
if ( bli_obj_has_zero_dim( c ) ) return;
// If A or B has a zero dimension, scale C by beta and return early.
if ( bli_obj_has_zero_dim( a ) ||
bli_obj_has_zero_dim( b ) )
{
if ( bli_thread_am_ochief( thread ) )
bli_scalm( beta, c );
bli_thread_obarrier( thread );
return;
}
// Alias A and B in case we need to update attached scalars.
bli_obj_alias_to( a, &a_local );
bli_obj_alias_to( b, &b_local );
// Alias C in case we need to induce a transposition.
bli_obj_alias_to( c, &c_local );
// If we are about to call a leaf-level implementation, and matrix C
// still needs a transposition, then we must induce one by swapping the
// strides and dimensions. Note that this transposition would normally
// be handled explicitly in the packing of C, but if C is not being
// packed, this is our last chance to handle the transposition.
if ( bli_cntl_is_leaf( cntl ) && bli_obj_has_trans( c ) )
{
bli_obj_induce_trans( &c_local );
bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, &c_local );
}
// If beta is non-unit, apply it to the scalar attached to C.
if ( !bli_obj_equals( beta, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( beta, &c_local );
}
// Set two bools: one based on the implied side parameter (the structure
// of the root object) and one based on the uplo field of the triangular
// matrix's root object (whether that is matrix A or matrix B).
if ( bli_obj_root_is_triangular( a ) )
{
// If alpha is non-unit, typecast and apply it to the scalar
// attached to B (the non-triangular matrix).
if ( !bli_obj_equals( alpha, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( alpha, &b_local );
}
}
else // if ( bli_obj_root_is_triangular( b ) )
{
// If alpha is non-unit, typecast and apply it to the scalar
// attached to A (the non-triangular matrix).
if ( !bli_obj_equals( alpha, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( alpha, &a_local );
}
}
// FGVZ->TMS: Is this barrier still needed?
bli_thread_obarrier( thread );
// Create the next node in the thrinfo_t structure.
bli_thrinfo_grow( rntm, cntl, thread );
// Extract the function pointer from the current control tree node.
f = bli_cntl_var_func( cntl );
// Invoke the variant.
f
(
&a_local,
&b_local,
&c_local,
cntx,
rntm,
cntl,
thread
);
}
void bli_gemm_front
(
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
cntx_t* cntx,
cntl_t* cntl
)
{
#ifdef BLIS_SMALL_MATRIX_ENABLE
#ifndef BLIS_ENABLE_MULTITHREADING
gint_t status = bli_gemm_small_matrix(alpha, a, b, beta, c, cntx, cntl);
if(BLIS_SUCCESS != status)
#endif
#endif
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_gemm_check( alpha, a, b, beta, c, cntx );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Reinitialize the memory allocator to accommodate the blocksizes
// in the current context.
bli_memsys_reinit( cntx );
// Alias A, B, and C in case we need to apply transformations.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if ( bli_cntx_l3_ukr_dislikes_storage_of( &c_local, BLIS_GEMM_UKR, cntx ) )
{
bli_obj_swap( a_local, b_local );
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
}
// Set the operation family id in the context.
bli_cntx_set_family( BLIS_GEMM, cntx );
// Record the threading for each level within the context.
bli_cntx_set_thrloop_from_env( BLIS_GEMM, BLIS_LEFT, cntx,
bli_obj_length( c_local ),
bli_obj_width( c_local ),
bli_obj_width( a_local ) );
// Invoke the internal back-end via the thread handler.
bli_l3_thread_decorator
(
bli_gemm_int,
alpha,
&a_local,
&b_local,
beta,
&c_local,
cntx,
cntl
);
}
}
void bli_trmm3_front( side_t side,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
gemm_t* cntl )
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_trmm3_check( side, alpha, a, b, beta, c );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Alias A, B, and C so we can tweak the objects if necessary.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
// We do not explicitly implement the cases where A is transposed.
// However, we can still handle them. Specifically, if A is marked as
// needing a transposition, we simply induce a transposition. This
// allows us to only explicitly implement the no-transpose cases. Once
// the transposition is induced, the correct algorithm will be called,
// since, for example, an algorithm over a transposed lower triangular
// matrix A moves in the same direction (forwards) as a non-transposed
// upper triangular matrix. And with the transposition induced, the
// matrix now appears to be upper triangular, so the upper triangular
// algorithm will grab the correct partitions, as if it were upper
// triangular (with no transpose) all along.
if ( bli_obj_has_trans( a_local ) )
{
bli_obj_induce_trans( a_local );
bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, a_local );
}
#if 0
// If A is being multiplied from the right, transpose all operands
// so that we can perform the computation as if A were being multiplied
// from the left.
if ( bli_is_right( side ) )
{
bli_toggle_side( side );
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
}
#else
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if (
( bli_obj_is_row_stored( c_local ) &&
bli_func_prefers_contig_cols( bli_obj_datatype( c_local ),
bli_gemm_cntl_ukrs( cntl ) ) ) ||
( bli_obj_is_col_stored( c_local ) &&
bli_func_prefers_contig_rows( bli_obj_datatype( c_local ),
bli_gemm_cntl_ukrs( cntl ) ) )
)
{
bli_toggle_side( side );
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
}
// If A is being multiplied from the right, swap A and B so that
// the matrix will actually be on the right.
if ( bli_is_right( side ) )
{
bli_obj_swap( a_local, b_local );
}
#endif
// Set each alias as the root object.
// NOTE: We MUST wait until we are done potentially swapping the objects
// before setting the root fields!
bli_obj_set_as_root( a_local );
bli_obj_set_as_root( b_local );
bli_obj_set_as_root( c_local );
// Notice that, unlike trmm_r, there is no dependency in the jc loop
// for trmm3_r, so we can pass in FALSE for jc_dependency.
trmm_thrinfo_t** infos = bli_create_trmm_thrinfo_paths( FALSE );
dim_t n_threads = thread_num_threads( infos[0] );
// Invoke the internal back-end.
bli_level3_thread_decorator( n_threads,
(level3_int_t) bli_trmm_int,
alpha,
&a_local,
&b_local,
beta,
&c_local,
(void*) cntl,
(void**) infos );
bli_trmm_thrinfo_free_paths( infos, n_threads );
}
void bli_gemm_front( obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
gemm_t* cntl )
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_gemm_check( alpha, a, b, beta, c );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Alias A, B, and C in case we need to apply transformations.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if (
( bli_obj_is_row_stored( c_local ) &&
bli_func_prefers_contig_cols( bli_obj_datatype( c_local ),
bli_gemm_cntl_ukrs( cntl ) ) ) ||
( bli_obj_is_col_stored( c_local ) &&
bli_func_prefers_contig_rows( bli_obj_datatype( c_local ),
bli_gemm_cntl_ukrs( cntl ) ) )
)
{
bli_obj_swap( a_local, b_local );
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
}
gemm_thrinfo_t** infos = bli_create_gemm_thrinfo_paths();
dim_t n_threads = thread_num_threads( infos[0] );
// Invoke the internal back-end.
bli_level3_thread_decorator( n_threads,
(level3_int_t) bli_gemm_int,
alpha,
&a_local,
&b_local,
beta,
&c_local,
(void*) cntl,
(void**) infos );
bli_gemm_thrinfo_free_paths( infos, n_threads );
#ifdef BLIS_ENABLE_FLOP_COUNT
// Increment the global flop counter.
bli_flop_count_inc( 2.0 * bli_obj_length( *c )
* bli_obj_width( *c )
* bli_obj_width_after_trans( a_local )
* ( bli_obj_is_complex( *c ) ? 4.0 : 1.0 ) );
#endif
}
void bli_trmm_int( obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
trmm_t* cntl )
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
bool_t side, uplo;
varnum_t n;
impl_t i;
FUNCPTR_T f;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_trmm_int_check( alpha, a, b, beta, c, cntl );
// If C has a zero dimension, return early.
if ( bli_obj_has_zero_dim( *c ) ) return;
// If A or B has a zero dimension, scale C by beta and return early.
if ( bli_obj_has_zero_dim( *a ) ||
bli_obj_has_zero_dim( *b ) )
{
bli_scalm( beta, c );
return;
}
// Alias A and B in case we need to update attached scalars.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
// Alias C in case we need to induce a transposition.
bli_obj_alias_to( *c, c_local );
// If we are about to call a leaf-level implementation, and matrix C
// still needs a transposition, then we must induce one by swapping the
// strides and dimensions. Note that this transposition would normally
// be handled explicitly in the packing of C, but if C is not being
// packed, this is our last chance to handle the transposition.
if ( cntl_is_leaf( cntl ) && bli_obj_has_trans( *c ) )
{
bli_obj_induce_trans( c_local );
bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, c_local );
}
// If alpha is non-unit, typecast and apply it to the scalar attached
// to B.
if ( !bli_obj_equals( alpha, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( alpha, &b_local );
}
// If beta is non-unit, typecast and apply it to the scalar attached
// to C.
if ( !bli_obj_equals( beta, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( beta, &c_local );
}
// Set two bools: one based on the implied side parameter (the structure
// of the root object) and one based on the uplo field of the triangular
// matrix's root object (whether that is matrix A or matrix B).
if ( bli_obj_root_is_triangular( *a ) )
{
side = 0;
if ( bli_obj_root_is_lower( *a ) ) uplo = 0;
else uplo = 1;
}
else // if ( bli_obj_root_is_triangular( *b ) )
{
side = 1;
// Set a bool based on the uplo field of A's root object.
if ( bli_obj_root_is_lower( *b ) ) uplo = 0;
else uplo = 1;
}
// Extract the variant number and implementation type.
n = cntl_var_num( cntl );
i = cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[side][uplo][n][i];
// Invoke the variant.
f( &a_local,
&b_local,
&c_local,
cntl );
}
void bli_herk_front( obj_t* alpha,
obj_t* a,
obj_t* beta,
obj_t* c,
cntx_t* cntx,
gemm_t* cntl )
{
obj_t a_local;
obj_t ah_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_herk_check( alpha, a, beta, c, cntx );
// If alpha is zero, scale by beta, zero the imaginary components of
// the diagonal elements, and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
bli_setid( &BLIS_ZERO, c );
return;
}
// Reinitialize the memory allocator to accommodate the blocksizes
// in the current context.
bli_mem_reinit( cntx );
// Alias A and C in case we need to apply transformations.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *c, c_local );
bli_obj_set_as_root( c_local );
// For herk, the right-hand "B" operand is simply A'.
bli_obj_alias_to( *a, ah_local );
bli_obj_induce_trans( ah_local );
bli_obj_toggle_conj( ah_local );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if ( bli_cntx_l3_nat_ukr_dislikes_storage_of( &c_local, BLIS_GEMM_UKR, cntx ) )
{
bli_obj_toggle_conj( a_local );
bli_obj_toggle_conj( ah_local );
bli_obj_induce_trans( c_local );
}
thrinfo_t** infos = bli_l3_thrinfo_create_paths( BLIS_HERK, BLIS_LEFT );
dim_t n_threads = bli_thread_num_threads( infos[0] );
// Invoke the internal back-end.
bli_l3_thread_decorator( n_threads,
(l3_int_t) bli_herk_int,
alpha,
&a_local,
&ah_local,
beta,
&c_local,
(void*) cntx,
(void*) cntl,
(void**) infos );
bli_l3_thrinfo_free_paths( infos, n_threads );
// The Hermitian rank-k product was computed as A*A', even for the
// diagonal elements. Mathematically, the imaginary components of
// diagonal elements of a Hermitian rank-k product should always be
// zero. However, in practice, they sometimes accumulate meaningless
// non-zero values. To prevent this, we explicitly set those values
// to zero before returning.
bli_setid( &BLIS_ZERO, &c_local );
}
err_t bli_gemmsup_ref
(
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
cntx_t* cntx,
rntm_t* rntm
)
{
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_gemm_check( alpha, a, b, beta, c, cntx );
#if 0
// FGVZ: The datatype-specific variant is now responsible for checking for
// alpha == 0.0.
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return BLIS_SUCCESS;
}
#endif
#if 0
// FGVZ: Will this be needed for constructing thrinfo_t's (recall: the
// sba needs to be attached to the rntm; see below)? Or will those nodes
// just be created "locally," in an exposed manner?
// Parse and interpret the contents of the rntm_t object to properly
// set the ways of parallelism for each loop, and then make any
// additional modifications necessary for the current operation.
bli_rntm_set_ways_for_op
(
BLIS_GEMM,
BLIS_LEFT, // ignored for gemm/hemm/symm
bli_obj_length( &c_local ),
bli_obj_width( &c_local ),
bli_obj_width( &a_local ),
rntm
);
// FGVZ: the sba needs to be attached to the rntm. But it needs
// to be done in the thread region, since it needs a thread id.
//bli_sba_rntm_set_pool( tid, array, rntm_p );
#endif
#if 0
// FGVZ: The datatype-specific variant is now responsible for inducing a
// transposition, if needed.
// Induce transpositions on A and/or B if either object is marked for
// transposition. We can induce "fast" transpositions since they objects
// are guaranteed to not have structure or be packed.
if ( bli_obj_has_trans( a ) )
{
bli_obj_induce_fast_trans( a );
bli_obj_toggle_trans( a );
}
if ( bli_obj_has_trans( b ) )
{
bli_obj_induce_fast_trans( b );
bli_obj_toggle_trans( b );
}
#endif
#if 0
//bli_gemmsup_ref_var2
//bli_gemmsup_ref_var1
#if 0
bli_gemmsup_ref_var1n
#else
#endif
const stor3_t stor_id = bli_obj_stor3_from_strides( c, a, b );
const bool_t is_rrr_rrc_rcr_crr = ( stor_id == BLIS_RRR ||
stor_id == BLIS_RRC ||
stor_id == BLIS_RCR ||
stor_id == BLIS_CRR );
if ( is_rrr_rrc_rcr_crr )
{
bli_gemmsup_ref_var2m
(
BLIS_NO_TRANSPOSE, alpha, a, b, beta, c, stor_id, cntx, rntm
);
}
else
{
bli_gemmsup_ref_var2m
(
BLIS_TRANSPOSE, alpha, a, b, beta, c, stor_id, cntx, rntm
);
}
#else
const stor3_t stor_id = bli_obj_stor3_from_strides( c, a, b );
// Don't use the small/unpacked implementation if one of the matrices
// uses general stride.
if ( stor_id == BLIS_XXX ) return BLIS_FAILURE;
const bool_t is_rrr_rrc_rcr_crr = ( stor_id == BLIS_RRR ||
stor_id == BLIS_RRC ||
stor_id == BLIS_RCR ||
stor_id == BLIS_CRR );
const bool_t is_rcc_crc_ccr_ccc = !is_rrr_rrc_rcr_crr;
const num_t dt = bli_obj_dt( c );
const bool_t row_pref = bli_cntx_l3_sup_ker_prefers_rows_dt( dt, stor_id, cntx );
const bool_t is_primary = ( row_pref ? is_rrr_rrc_rcr_crr
: is_rcc_crc_ccr_ccc );
if ( is_primary )
{
// This branch handles:
// - rrr rrc rcr crr for row-preferential kernels
// - rcc crc ccr ccc for column-preferential kernels
const dim_t m = bli_obj_length( c );
const dim_t n = bli_obj_width( c );
const dim_t NR = bli_cntx_get_blksz_def_dt( dt, BLIS_NR, cntx ); \
const dim_t MR = bli_cntx_get_blksz_def_dt( dt, BLIS_MR, cntx ); \
const dim_t mu = m / MR;
const dim_t nu = n / NR;
if ( mu >= nu )
{
// block-panel macrokernel; m -> mc, mr; n -> nc, nr: var2()
bli_gemmsup_ref_var2m( BLIS_NO_TRANSPOSE,
alpha, a, b, beta, c, stor_id, cntx, rntm );
}
else // if ( mu < nu )
{
// panel-block macrokernel; m -> nc*,mr; n -> mc*,nr: var1()
bli_gemmsup_ref_var1n( BLIS_NO_TRANSPOSE,
alpha, a, b, beta, c, stor_id, cntx, rntm );
}
}
else
{
// This branch handles:
// - rrr rrc rcr crr for column-preferential kernels
// - rcc crc ccr ccc for row-preferential kernels
const dim_t mt = bli_obj_width( c );
const dim_t nt = bli_obj_length( c );
const dim_t NR = bli_cntx_get_blksz_def_dt( dt, BLIS_NR, cntx ); \
const dim_t MR = bli_cntx_get_blksz_def_dt( dt, BLIS_MR, cntx ); \
const dim_t mu = mt / MR;
const dim_t nu = nt / NR;
if ( mu >= nu )
{
// panel-block macrokernel; m -> nc, nr; n -> mc, mr: var2() + trans
bli_gemmsup_ref_var2m( BLIS_TRANSPOSE,
alpha, a, b, beta, c, stor_id, cntx, rntm );
}
else // if ( mu < nu )
{
// block-panel macrokernel; m -> mc*,nr; n -> nc*,mr: var1() + trans
bli_gemmsup_ref_var1n( BLIS_TRANSPOSE,
alpha, a, b, beta, c, stor_id, cntx, rntm );
}
// *requires nudging of mc,nc up to be a multiple of nr,mr.
}
#endif
// Return success so that the caller knows that we computed the solution.
return BLIS_SUCCESS;
}
void bli_symm_front( side_t side,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
gemm_t* cntl )
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_symm_check( side, alpha, a, b, beta, c );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Alias A, B, and C in case we need to apply transformations.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if (
( bli_obj_is_row_stored( c_local ) &&
bli_func_prefers_contig_cols( bli_obj_datatype( c_local ),
cntl_gemm_ukrs( cntl ) ) ) ||
( bli_obj_is_col_stored( c_local ) &&
bli_func_prefers_contig_rows( bli_obj_datatype( c_local ),
cntl_gemm_ukrs( cntl ) ) )
)
{
bli_toggle_side( side );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( c_local );
}
// Swap A and B if multiplying A from the right so that "B" contains
// the symmetric matrix.
if ( bli_is_right( side ) )
{
bli_obj_swap( a_local, b_local );
}
gemm_thrinfo_t** infos = bli_create_gemm_thrinfo_paths();
dim_t n_threads = thread_num_threads( infos[0] );
// Invoke the internal back-end.
bli_level3_thread_decorator( n_threads,
(level3_int_t) bli_gemm_int,
alpha,
&a_local,
&b_local,
beta,
&c_local,
(void*) cntl,
(void**) infos );
bli_gemm_thrinfo_free_paths( infos, n_threads );
}
void bli_her2k_front( obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
herk_t* cntl )
{
obj_t alpha_conj;
obj_t c_local;
obj_t a_local;
obj_t bh_local;
obj_t b_local;
obj_t ah_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_her2k_check( alpha, a, b, beta, c );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Alias A, B, and C in case we need to apply transformations.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *c, c_local );
bli_obj_set_as_root( c_local );
// For her2k, the first and second right-hand "B" operands are simply B'
// and A'.
bli_obj_alias_to( *b, bh_local );
bli_obj_induce_trans( bh_local );
bli_obj_toggle_conj( bh_local );
bli_obj_alias_to( *a, ah_local );
bli_obj_induce_trans( ah_local );
bli_obj_toggle_conj( ah_local );
// Initialize a conjugated copy of alpha.
bli_obj_scalar_init_detached_copy_of( bli_obj_datatype( *a ),
BLIS_CONJUGATE,
alpha,
&alpha_conj );
// An optimization: If C is row-stored, transpose the entire operation
// so as to allow the macro-kernel more favorable access patterns
// through C. (The effect of the transposition of A and A' is negligible
// because those operands are always packed to contiguous memory.)
if ( bli_obj_is_row_stored( c_local ) )
{
bli_obj_swap( a_local, bh_local );
bli_obj_swap( b_local, ah_local );
bli_obj_induce_trans( a_local );
bli_obj_induce_trans( bh_local );
bli_obj_induce_trans( b_local );
bli_obj_induce_trans( ah_local );
bli_obj_induce_trans( c_local );
}
#if 0
// Invoke the internal back-end.
bli_her2k_int( alpha,
&a_local,
&bh_local,
&alpha_conj,
&b_local,
&ah_local,
beta,
&c_local,
cntl );
#else
// Invoke herk twice, using beta only the first time.
bli_herk_int( alpha,
&a_local,
&bh_local,
beta,
&c_local,
cntl );
bli_herk_int( &alpha_conj,
&b_local,
&ah_local,
&BLIS_ONE,
&c_local,
cntl );
#endif
}
void bli_syr2k_front
(
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
cntx_t* cntx,
cntl_t* cntl
)
{
bli_init_once();
obj_t c_local;
obj_t a_local;
obj_t bt_local;
obj_t b_local;
obj_t at_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_syr2k_check( alpha, a, b, beta, c, cntx );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( beta, c );
return;
}
// Alias A, B, and C in case we need to apply transformations.
bli_obj_alias_to( a, &a_local );
bli_obj_alias_to( b, &b_local );
bli_obj_alias_to( c, &c_local );
bli_obj_set_as_root( &c_local );
// For syr2k, the first and second right-hand "B" operands are simply B'
// and A'.
bli_obj_alias_to( b, &bt_local );
bli_obj_induce_trans( &bt_local );
bli_obj_alias_to( a, &at_local );
bli_obj_induce_trans( &at_local );
// An optimization: If C is stored by rows and the micro-kernel prefers
// contiguous columns, or if C is stored by columns and the micro-kernel
// prefers contiguous rows, transpose the entire operation to allow the
// micro-kernel to access elements of C in its preferred manner.
if ( bli_cntx_l3_ukr_dislikes_storage_of( &c_local, BLIS_GEMM_UKR, cntx ) )
{
bli_obj_induce_trans( &c_local );
}
// Record the threading for each level within the context.
bli_cntx_set_thrloop_from_env( BLIS_SYR2K, BLIS_LEFT, cntx,
bli_obj_length( &c_local ),
bli_obj_width( &c_local ),
bli_obj_width( &a_local ) );
// Invoke herk twice, using beta only the first time.
// Invoke the internal back-end.
bli_l3_thread_decorator
(
bli_gemm_int,
BLIS_HERK, // operation family id
alpha,
&a_local,
&bt_local,
beta,
&c_local,
cntx,
cntl
);
bli_l3_thread_decorator
(
bli_gemm_int,
BLIS_HERK, // operation family id
alpha,
&b_local,
&at_local,
&BLIS_ONE,
&c_local,
cntx,
cntl
);
}