void bli_her2_int( conj_t conjh,
obj_t* alpha,
obj_t* alpha_conj,
obj_t* x,
obj_t* y,
obj_t* c,
cntx_t* cntx,
her2_t* cntl )
{
varnum_t n;
impl_t i;
FUNCPTR_T f;
obj_t alpha_local;
obj_t alpha_conj_local;
obj_t x_local;
obj_t y_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
{
if ( bli_is_conj( conjh ) ) bli_her2_check( alpha, x, y, c );
else bli_syr2_check( alpha, x, y, c );
}
// If C, x, or y has a zero dimension, return early.
if ( bli_obj_has_zero_dim( c ) ) return;
if ( bli_obj_has_zero_dim( x ) ) return;
if ( bli_obj_has_zero_dim( y ) ) return;
// Alias the operands in case we need to apply conjugations.
bli_obj_alias_to( x, &x_local );
bli_obj_alias_to( y, &y_local );
bli_obj_alias_to( c, &c_local );
// If matrix C is marked for conjugation, we interpret this as a request
// to apply a conjugation to the other operands.
if ( bli_obj_has_conj( &c_local ) )
{
bli_obj_toggle_conj( &c_local );
bli_obj_toggle_conj( &x_local );
bli_obj_toggle_conj( &y_local );
bli_obj_scalar_init_detached_copy_of( bli_obj_dt( alpha ),
BLIS_CONJUGATE,
alpha,
&alpha_local );
bli_obj_scalar_init_detached_copy_of( bli_obj_dt( alpha_conj ),
BLIS_CONJUGATE,
alpha_conj,
&alpha_conj_local );
}
else
{
bli_obj_alias_to( *alpha, alpha_local );
bli_obj_alias_to( *alpha_conj, alpha_conj_local );
}
// Extract the variant number and implementation type.
n = bli_cntl_var_num( cntl );
i = bli_cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( conjh,
&alpha_local,
&alpha_conj_local,
&x_local,
&y_local,
&c_local,
cntx,
cntl );
}
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_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 );
}
void bli_unpackv_int( obj_t* p,
obj_t* a,
cntx_t* cntx,
unpackv_t* cntl )
{
// The unpackv operation consists of an optional casting post-process.
// (This post-process is analogous to the cast pre-process in packv.)
// Here are the following possible ways unpackv can execute:
// 1. unpack and cast: Unpack to a temporary vector c and then cast
// c to a.
// 2. unpack only: Unpack directly to vector a since typecasting is
// not needed.
// 3. cast only: Not yet supported / not used.
// 4. no-op: The control tree directs us to skip the unpack operation
// entirely. No action is taken.
obj_t c;
varnum_t n;
impl_t i;
FUNCPTR_T f;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_unpackv_check( p, a, cntx );
// Sanity check; A should never have a zero dimension. If we must support
// it, then we should fold it into the next alias-and-early-exit block.
if ( bli_obj_has_zero_dim( *a ) ) bli_abort();
// First check if we are to skip this operation because the control tree
// is NULL, and if so, simply return.
if ( bli_cntl_is_noop( cntl ) )
{
return;
}
// If p was aliased to a during the pack stage (because it was already
// in an acceptable packed/contiguous format), then no unpack is actually
// necessary, so we return.
if ( bli_obj_is_alias_of( *p, *a ) )
{
return;
}
// Now, if we are not skipping the unpack operation, then the only
// question left is whether we are to typecast vector a after unpacking.
if ( bli_obj_datatype( *p ) != bli_obj_datatype( *a ) )
bli_abort();
/*
if ( bli_obj_datatype( *p ) != bli_obj_datatype( *a ) )
{
// Initialize an object c for the intermediate typecast vector.
bli_unpackv_init_cast( p,
a,
&c );
}
else
*/
{
// If no cast is needed, then aliasing object c to the original
// vector serves as a minor optimization. This causes the unpackv
// implementation to unpack directly into vector a.
bli_obj_alias_to( *a, c );
}
// Now we are ready to proceed with the unpacking.
// Extract the variant number and implementation type.
n = bli_cntl_var_num( cntl );
i = bli_cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( p,
&c,
cntx,
cntl );
// Now, if necessary, we cast the contents of c to vector a. If casting
// was not necessary, then we are done because the call to the unpackv
// implementation would have unpacked directly to vector a.
/*
if ( bli_obj_datatype( *p ) != bli_obj_datatype( *a ) )
{
// Copy/typecast vector c to vector a.
// NOTE: Here, we use copynzv instead of copym because, in the cases
// where we are unpacking/typecasting a real vector c to a complex
// vector a, we want to touch only the real components of a, rather
// than also set the imaginary components to zero. This comes about
// because of the fact that, if we are unpacking real-to-complex,
// then it is because all of the computation occurred in the real
// domain, and so we would want to leave whatever imaginary values
// there are in vector a untouched. Notice that for unpackings that
// entail complex-to-complex data movements, the copynzv operation
// behaves exactly as copym, so no use cases are lost (at least none
// that I can think of).
bli_copynzv( &c,
a );
// NOTE: The above code/comment is outdated. What should happen is
// as follows:
// - If dt(a) is complex and dt(p) is real, then create an alias of
// a and then tweak it so that it looks like a real domain object.
// This will involve:
// - projecting the datatype to real domain
// - scaling both the row and column strides by 2
// ALL OF THIS should be done in the front-end, NOT here, as
// unpackv() won't even be needed in that case.
}
*/
}
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_trmm_front( side_t side,
obj_t* alpha,
obj_t* a,
obj_t* b,
gemm_t* cntl )
{
obj_t a_local;
obj_t b_local;
obj_t c_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_trmm_check( side, alpha, a, b );
// If alpha is zero, scale by beta and return.
if ( bli_obj_equals( alpha, &BLIS_ZERO ) )
{
bli_scalm( alpha, b );
return;
}
// 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 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 );
trmm_thrinfo_t** infos = bli_create_trmm_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,
(level3_int_t) bli_trmm_int,
alpha,
&a_local,
&b_local,
&BLIS_ZERO,
&c_local,
(void*) cntl,
(void**) infos );
bli_trmm_thrinfo_free_paths( infos, n_threads );
#ifdef BLIS_ENABLE_FLOP_COUNT
// Increment the global flop counter.
bli_flop_count_inc( 1.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_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
);
}
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_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_int( obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
trsm_t* cntl,
trsm_thrinfo_t* thread )
{
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_trsm_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;
}
// 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 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 ) )
{
side = 0;
if ( bli_obj_root_is_lower( *a ) ) uplo = 0;
else uplo = 1;
// 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 ) )
{
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;
// 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 );
}
}
thread_obarrier( thread );
// 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,
thread );
}
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_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_hemv_int( conj_t conjh,
obj_t* alpha,
obj_t* a,
obj_t* x,
obj_t* beta,
obj_t* y,
cntx_t* cntx,
hemv_t* cntl )
{
varnum_t n;
impl_t i;
FUNCPTR_T f;
obj_t a_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
{
if ( bli_is_conj( conjh ) ) bli_hemv_check( alpha, a, x, beta, y );
else bli_symv_check( alpha, a, x, beta, y );
}
// If y has a zero dimension, return early.
if ( bli_obj_has_zero_dim( *y ) ) return;
// If x has a zero dimension, scale y by beta and return early.
if ( bli_obj_has_zero_dim( *x ) )
{
bli_scalm( beta, y );
return;
}
// Alias A in case we need to induce the upper triangular case.
bli_obj_alias_to( *a, a_local );
/*
// Our blocked algorithms only [explicitly] implement the lower triangular
// case, so if matrix A is stored as upper triangular, we must toggle the
// transposition (and conjugation) bits so that the diagonal partitioning
// routines grab the correct partitions corresponding to the upper
// triangular case. But we only need to do this for blocked algorithms,
// since unblocked algorithms are responsible for handling the upper case
// explicitly (and they should not be inspecting the transposition bit anyway).
if ( bli_cntl_is_blocked( cntl ) && bli_obj_is_upper( *a ) )
{
bli_obj_toggle_conj( a_local );
bli_obj_toggle_trans( a_local );
}
*/
// Extract the variant number and implementation type.
n = bli_cntl_var_num( cntl );
i = bli_cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( conjh,
alpha,
&a_local,
x,
beta,
y,
cntx,
cntl );
}
void libblis_test_dotaxpyv_experiment( test_params_t* params,
test_op_t* op,
iface_t iface,
num_t datatype,
char* pc_str,
char* sc_str,
unsigned int p_cur,
double* perf,
double* resid )
{
unsigned int n_repeats = params->n_repeats;
unsigned int i;
double time_min = 1e9;
double time;
dim_t m;
conj_t conjxt, conjx, conjy;
conj_t conjconjxty;
obj_t alpha, xt, x, y, rho, z;
obj_t z_save;
// Map the dimension specifier to an actual dimension.
m = libblis_test_get_dim_from_prob_size( op->dim_spec[0], p_cur );
// Map parameter characters to BLIS constants.
bli_param_map_char_to_blis_conj( pc_str[0], &conjxt );
bli_param_map_char_to_blis_conj( pc_str[1], &conjx );
bli_param_map_char_to_blis_conj( pc_str[2], &conjy );
// Create test scalars.
bli_obj_scalar_init_detached( datatype, &alpha );
bli_obj_scalar_init_detached( datatype, &rho );
// Create test operands (vectors and/or matrices).
libblis_test_vobj_create( params, datatype, sc_str[0], m, &x );
libblis_test_vobj_create( params, datatype, sc_str[1], m, &y );
libblis_test_vobj_create( params, datatype, sc_str[2], m, &z );
libblis_test_vobj_create( params, datatype, sc_str[2], m, &z_save );
// Set alpha.
if ( bli_obj_is_real( z ) )
{
bli_setsc( -0.8, 0.0, &alpha );
}
else
{
bli_setsc( 0.0, -0.8, &alpha );
}
// Randomize x and z, and save z.
bli_randv( &x );
bli_randv( &z );
bli_copyv( &z, &z_save );
// Create an alias to x for xt. (Note that it doesn't actually need to be
// transposed.)
bli_obj_alias_to( x, xt );
// Determine whether to make a copy of x with or without conjugation.
//
// conjx conjy ~conjx^conjy y is initialized as
// n n c y = conj(x)
// n c n y = x
// c n n y = x
// c c c y = conj(x)
//
conjconjxty = bli_apply_conj( conjxt, conjy );
conjconjxty = bli_conj_toggled( conjconjxty );
bli_obj_set_conj( conjconjxty, xt );
bli_copyv( &xt, &y );
// Apply the parameters.
bli_obj_set_conj( conjxt, xt );
bli_obj_set_conj( conjx, x );
bli_obj_set_conj( conjy, y );
// Repeat the experiment n_repeats times and record results.
for ( i = 0; i < n_repeats; ++i )
{
bli_copysc( &BLIS_MINUS_ONE, &rho );
bli_copyv( &z_save, &z );
time = bli_clock();
libblis_test_dotaxpyv_impl( iface, &alpha, &xt, &x, &y, &rho, &z );
time_min = bli_clock_min_diff( time_min, time );
}
// Estimate the performance of the best experiment repeat.
*perf = ( 2.0 * m + 2.0 * m ) / time_min / FLOPS_PER_UNIT_PERF;
if ( bli_obj_is_complex( z ) ) *perf *= 4.0;
// Perform checks.
libblis_test_dotaxpyv_check( &alpha, &xt, &x, &y, &rho, &z, &z_save, resid );
// Zero out performance and residual if output vector is empty.
libblis_test_check_empty_problem( &z, perf, resid );
// Free the test objects.
bli_obj_free( &x );
bli_obj_free( &y );
bli_obj_free( &z );
bli_obj_free( &z_save );
}
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 );
}
int main( int argc, char** argv )
{
//bli_init();
#if 0
obj_t a, b, c;
obj_t aa, bb, cc;
dim_t m, n, k;
num_t dt;
uplo_t uploa, uplob, uploc;
{
dt = BLIS_DOUBLE;
m = 6;
k = 6;
n = 6;
bli_obj_create( dt, m, k, 0, 0, &a );
bli_obj_create( dt, k, n, 0, 0, &b );
bli_obj_create( dt, m, n, 0, 0, &c );
uploa = BLIS_UPPER;
uploa = BLIS_LOWER;
bli_obj_set_struc( BLIS_TRIANGULAR, &a );
bli_obj_set_uplo( uploa, &a );
bli_obj_set_diag_offset( -2, &a );
uplob = BLIS_UPPER;
uplob = BLIS_LOWER;
bli_obj_set_struc( BLIS_TRIANGULAR, &b );
bli_obj_set_uplo( uplob, &b );
bli_obj_set_diag_offset( -2, &b );
uploc = BLIS_UPPER;
//uploc = BLIS_LOWER;
//uploc = BLIS_ZEROS;
//uploc = BLIS_DENSE;
bli_obj_set_struc( BLIS_HERMITIAN, &c );
//bli_obj_set_struc( BLIS_TRIANGULAR, &c );
bli_obj_set_uplo( uploc, &c );
bli_obj_set_diag_offset( 1, &c );
bli_obj_alias_to( &a, &aa ); (void)aa;
bli_obj_alias_to( &b, &bb ); (void)bb;
bli_obj_alias_to( &c, &cc ); (void)cc;
bli_randm( &a );
bli_randm( &b );
bli_randm( &c );
//bli_mkherm( &a );
//bli_mktrim( &a );
bli_prune_unref_mparts( &cc, BLIS_M,
&aa, BLIS_N );
bli_printm( "c orig", &c, "%4.1f", "" );
bli_printm( "c alias", &cc, "%4.1f", "" );
bli_printm( "a orig", &a, "%4.1f", "" );
bli_printm( "a alias", &aa, "%4.1f", "" );
//bli_obj_print( "a struct", &a );
}
#endif
dim_t p_begin, p_max, p_inc;
gint_t m_input, n_input;
char uploa_ch;
doff_t diagoffa;
dim_t bf;
dim_t n_way;
char part_dim_ch;
bool_t go_fwd;
char out_ch;
obj_t a;
blksz_t bfs;
thrinfo_t thrinfo;
dim_t m, n;
uplo_t uploa;
bool_t part_m_dim, part_n_dim;
bool_t go_bwd;
dim_t p;
num_t dt;
dim_t start, end;
dim_t width;
siz_t area;
gint_t t_begin, t_stop, t_inc;
dim_t t;
if ( argc == 13 )
{
sscanf( argv[1], "%u", &p_begin );
sscanf( argv[2], "%u", &p_max );
sscanf( argv[3], "%u", &p_inc );
sscanf( argv[4], "%d", &m_input );
sscanf( argv[5], "%d", &n_input );
sscanf( argv[6], "%c", &uploa_ch );
sscanf( argv[7], "%d", &diagoffa );
sscanf( argv[8], "%u", &bf );
sscanf( argv[9], "%u", &n_way );
sscanf( argv[10], "%c", &part_dim_ch );
sscanf( argv[11], "%u", &go_fwd );
sscanf( argv[12], "%c", &out_ch );
}
else
{
printf( "\n" );
printf( " %s\n", argv[0] );
printf( "\n" );
printf( " Simulate the dimension ranges assigned to threads when\n" );
printf( " partitioning a matrix for parallelism in BLIS.\n" );
printf( "\n" );
printf( " Usage:\n" );
printf( "\n" );
printf( " %s p_beg p_max p_inc m n uplo doff bf n_way part_dim go_fwd out\n", argv[0] );
printf( "\n" );
printf( " p_beg: the first problem size p to test.\n" );
printf( " p_max: the maximum problem size p to test.\n" );
printf( " p_inc: the increase in problem size p between tests.\n" );
printf( " m: the m dimension:\n" );
printf( " n: the n dimension:\n" );
printf( " if m,n = -1: bind m,n to problem size p.\n" );
printf( " if m,n = 0: bind m,n to p_max.\n" );
printf( " if m,n > 0: hold m,n = c constant for all p.\n" );
printf( " uplo: the uplo field of the matrix being partitioned:\n" );
printf( " 'l': lower-stored (BLIS_LOWER)\n" );
printf( " 'u': upper-stored (BLIS_UPPER)\n" );
printf( " 'd': densely-stored (BLIS_DENSE)\n" );
printf( " doff: the diagonal offset of the matrix being partitioned.\n" );
printf( " bf: the simulated blocking factor. all thread ranges must\n" );
printf( " be a multiple of bf, except for the range that contains\n" );
printf( " the edge case (if one exists). the blocking factor\n" );
printf( " would typically correspond to a register blocksize.\n" );
printf( " n_way: the number of ways of parallelism for which we are\n" );
printf( " partitioning (i.e.: the number of threads, or thread\n" );
printf( " groups).\n" );
printf( " part_dim: the dimension to partition:\n" );
printf( " 'm': partition the m dimension.\n" );
printf( " 'n': partition the n dimension.\n" );
printf( " go_fwd: the direction to partition:\n" );
printf( " '1': forward, e.g. left-to-right (part_dim = 'm') or\n" );
printf( " top-to-bottom (part_dim = 'n')\n" );
printf( " '0': backward, e.g. right-to-left (part_dim = 'm') or\n" );
printf( " bottom-to-top (part_dim = 'n')\n" );
printf( " NOTE: reversing the direction does not change the\n" );
printf( " subpartitions' widths, but it does change which end of\n" );
printf( " the index range receives the edge case, if it exists.\n" );
printf( " out: the type of output per thread-column:\n" );
printf( " 'w': the width (and area) of the thread's subpartition\n" );
printf( " 'r': the actual ranges of the thread's subpartition\n" );
printf( " where the start and end points of each range are\n" );
printf( " inclusive and exclusive, respectively.\n" );
printf( "\n" );
exit(1);
}
if ( m_input == 0 ) m_input = p_max;
if ( n_input == 0 ) n_input = p_max;
if ( part_dim_ch == 'm' ) { part_m_dim = TRUE; part_n_dim = FALSE; }
else { part_m_dim = FALSE; part_n_dim = TRUE; }
go_bwd = !go_fwd;
if ( uploa_ch == 'l' ) uploa = BLIS_LOWER;
else if ( uploa_ch == 'u' ) uploa = BLIS_UPPER;
else uploa = BLIS_DENSE;
if ( part_n_dim )
{
if ( bli_is_upper( uploa ) ) { t_begin = n_way-1; t_stop = -1; t_inc = -1; }
else /* if lower or dense */ { t_begin = 0; t_stop = n_way; t_inc = 1; }
}
else // if ( part_m_dim )
{
if ( bli_is_lower( uploa ) ) { t_begin = n_way-1; t_stop = -1; t_inc = -1; }
else /* if upper or dense */ { t_begin = 0; t_stop = n_way; t_inc = 1; }
}
printf( "\n" );
printf( " part: %3s doff: %3d bf: %3d output: %s\n",
( part_n_dim ? ( go_fwd ? "l2r" : "r2l" )
: ( go_fwd ? "t2b" : "b2t" ) ),
( int )diagoffa, ( int )bf,
( out_ch == 'w' ? "width(area)" : "ranges" ) );
printf( " uplo: %3c nt: %3u\n", uploa_ch, ( unsigned )n_way );
printf( "\n" );
printf( " " );
for ( t = t_begin; t != t_stop; t += t_inc )
{
if ( part_n_dim )
{
if ( t == t_begin ) printf( "left... " );
else if ( t == t_stop-t_inc ) printf( " ...right" );
else printf( " " );
}
else // if ( part_m_dim )
{
if ( t == t_begin ) printf( "top... " );
else if ( t == t_stop-t_inc ) printf( " ...bottom" );
else printf( " " );
}
}
printf( "\n" );
printf( "%4c x %4c ", 'm', 'n' );
for ( t = t_begin; t != t_stop; t += t_inc )
{
printf( "%9s %u ", "thread", ( unsigned )t );
}
printf( "\n" );
printf( "-------------" );
for ( t = t_begin; t != t_stop; t += t_inc )
{
printf( "-------------" );
}
printf( "\n" );
for ( p = p_begin; p <= p_max; p += p_inc )
{
if ( m_input < 0 ) m = ( dim_t )p;
else m = ( dim_t )m_input;
if ( n_input < 0 ) n = ( dim_t )p;
else n = ( dim_t )n_input;
dt = BLIS_DOUBLE;
bli_obj_create( dt, m, n, 0, 0, &a );
bli_obj_set_struc( BLIS_TRIANGULAR, &a );
bli_obj_set_uplo( uploa, &a );
bli_obj_set_diag_offset( diagoffa, &a );
bli_randm( &a );
bli_blksz_init_easy( &bfs, bf, bf, bf, bf );
printf( "%4u x %4u ", ( unsigned )m, ( unsigned )n );
for ( t = t_begin; t != t_stop; t += t_inc )
{
thrinfo.n_way = n_way;
thrinfo.work_id = t;
if ( part_n_dim && go_fwd )
area = bli_thread_get_range_weighted_l2r( &thrinfo, &a, &bfs, &start, &end );
else if ( part_n_dim && go_bwd )
area = bli_thread_get_range_weighted_r2l( &thrinfo, &a, &bfs, &start, &end );
else if ( part_m_dim && go_fwd )
area = bli_thread_get_range_weighted_t2b( &thrinfo, &a, &bfs, &start, &end );
else // ( part_m_dim && go_bwd )
area = bli_thread_get_range_weighted_b2t( &thrinfo, &a, &bfs, &start, &end );
width = end - start;
if ( out_ch == 'w' ) printf( "%4u(%6u) ", ( unsigned )width,
( unsigned )area );
else printf( "[%4u,%4u) ", ( unsigned )start,
( unsigned )end );
}
printf( "\n" );
bli_obj_free( &a );
}
//bli_finalize();
return 0;
}
void libblis_test_syr_check
(
test_params_t* params,
obj_t* alpha,
obj_t* x,
obj_t* a,
obj_t* a_orig,
double* resid
)
{
num_t dt = bli_obj_datatype( *a );
num_t dt_real = bli_obj_datatype_proj_to_real( *a );
dim_t m_a = bli_obj_length( *a );
obj_t xt, t, v, w;
obj_t rho, norm;
double junk;
//
// Pre-conditions:
// - x is randomized.
// - a is randomized and symmetric.
// Note:
// - alpha should have a non-zero imaginary component in the
// complex cases in order to more fully exercise the implementation.
//
// Under these conditions, we assume that the implementation for
//
// A := A_orig + alpha * conjx(x) * conjx(x)^T
//
// is functioning correctly if
//
// normf( v - w )
//
// is negligible, where
//
// v = A * t
// w = ( A_orig + alpha * conjx(x) * conjx(x)^T ) * t
// = A_orig * t + alpha * conjx(x) * conjx(x)^T * t
// = A_orig * t + alpha * conjx(x) * rho
// = A_orig * t + w
//
bli_mksymm( a );
bli_mksymm( a_orig );
bli_obj_set_struc( BLIS_GENERAL, *a );
bli_obj_set_struc( BLIS_GENERAL, *a_orig );
bli_obj_set_uplo( BLIS_DENSE, *a );
bli_obj_set_uplo( BLIS_DENSE, *a_orig );
bli_obj_scalar_init_detached( dt, &rho );
bli_obj_scalar_init_detached( dt_real, &norm );
bli_obj_create( dt, m_a, 1, 0, 0, &t );
bli_obj_create( dt, m_a, 1, 0, 0, &v );
bli_obj_create( dt, m_a, 1, 0, 0, &w );
bli_obj_alias_to( *x, xt );
libblis_test_vobj_randomize( params, TRUE, &t );
bli_gemv( &BLIS_ONE, a, &t, &BLIS_ZERO, &v );
bli_dotv( &xt, &t, &rho );
bli_mulsc( alpha, &rho );
bli_scal2v( &rho, x, &w );
bli_gemv( &BLIS_ONE, a_orig, &t, &BLIS_ONE, &w );
bli_subv( &w, &v );
bli_normfv( &v, &norm );
bli_getsc( &norm, resid, &junk );
bli_obj_free( &t );
bli_obj_free( &v );
bli_obj_free( &w );
}
void bli_gemmsup_ref_var1n
(
trans_t trans,
obj_t* alpha,
obj_t* a,
obj_t* b,
obj_t* beta,
obj_t* c,
stor3_t eff_id,
cntx_t* cntx,
rntm_t* rntm
)
{
#if 0
obj_t at, bt;
bli_obj_alias_to( a, &at );
bli_obj_alias_to( b, &bt );
// 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( &at ) ) { bli_obj_induce_fast_trans( &at ); }
if ( bli_obj_has_trans( &bt ) ) { bli_obj_induce_fast_trans( &bt ); }
const num_t dt_exec = bli_obj_dt( c );
const conj_t conja = bli_obj_conj_status( a );
const conj_t conjb = bli_obj_conj_status( b );
const dim_t m = bli_obj_length( c );
const dim_t n = bli_obj_width( c );
const dim_t k = bli_obj_width( &at );
void* restrict buf_a = bli_obj_buffer_at_off( &at );
const inc_t rs_a = bli_obj_row_stride( &at );
const inc_t cs_a = bli_obj_col_stride( &at );
void* restrict buf_b = bli_obj_buffer_at_off( &bt );
const inc_t rs_b = bli_obj_row_stride( &bt );
const inc_t cs_b = bli_obj_col_stride( &bt );
void* restrict buf_c = bli_obj_buffer_at_off( c );
const inc_t rs_c = bli_obj_row_stride( c );
const inc_t cs_c = bli_obj_col_stride( c );
void* restrict buf_alpha = bli_obj_buffer_for_1x1( dt_exec, alpha );
void* restrict buf_beta = bli_obj_buffer_for_1x1( dt_exec, beta );
#else
const num_t dt_exec = bli_obj_dt( c );
const conj_t conja = bli_obj_conj_status( a );
const conj_t conjb = bli_obj_conj_status( b );
const dim_t m = bli_obj_length( c );
const dim_t n = bli_obj_width( c );
dim_t k;
void* restrict buf_a = bli_obj_buffer_at_off( a );
inc_t rs_a;
inc_t cs_a;
void* restrict buf_b = bli_obj_buffer_at_off( b );
inc_t rs_b;
inc_t cs_b;
if ( bli_obj_has_notrans( a ) )
{
k = bli_obj_width( a );
rs_a = bli_obj_row_stride( a );
cs_a = bli_obj_col_stride( a );
}
else // if ( bli_obj_has_trans( a ) )
{
// Assign the variables with an implicit transposition.
k = bli_obj_length( a );
rs_a = bli_obj_col_stride( a );
cs_a = bli_obj_row_stride( a );
}
if ( bli_obj_has_notrans( b ) )
{
rs_b = bli_obj_row_stride( b );
cs_b = bli_obj_col_stride( b );
}
else // if ( bli_obj_has_trans( b ) )
{
// Assign the variables with an implicit transposition.
rs_b = bli_obj_col_stride( b );
cs_b = bli_obj_row_stride( b );
}
void* restrict buf_c = bli_obj_buffer_at_off( c );
const inc_t rs_c = bli_obj_row_stride( c );
const inc_t cs_c = bli_obj_col_stride( c );
void* restrict buf_alpha = bli_obj_buffer_for_1x1( dt_exec, alpha );
void* restrict buf_beta = bli_obj_buffer_for_1x1( dt_exec, beta );
#endif
// Index into the type combination array to extract the correct
// function pointer.
FUNCPTR_T f = ftypes_var1n[dt_exec];
if ( bli_is_notrans( trans ) )
{
// Invoke the function.
f
(
conja,
conjb,
m,
n,
k,
buf_alpha,
buf_a, rs_a, cs_a,
buf_b, rs_b, cs_b,
buf_beta,
buf_c, rs_c, cs_c,
eff_id,
cntx,
rntm
);
}
else
{
// Invoke the function (transposing the operation).
f
(
conjb, // swap the conj values.
conja,
n, // swap the m and n dimensions.
m,
k,
buf_alpha,
buf_b, cs_b, rs_b, // swap the positions of A and B.
buf_a, cs_a, rs_a, // swap the strides of A and B.
buf_beta,
buf_c, cs_c, rs_c, // swap the strides of C.
bli_stor3_trans( eff_id ), // transpose the stor3_t id.
cntx,
rntm
);
}
}
void bli_her2k_int( obj_t* alpha_abh,
obj_t* a,
obj_t* bh,
obj_t* alpha_bah,
obj_t* b,
obj_t* ah,
obj_t* beta,
obj_t* c,
her2k_t* cntl )
{
obj_t a_local;
obj_t bh_local;
obj_t b_local;
obj_t ah_local;
obj_t c_local;
varnum_t n;
impl_t i;
bool_t uplo;
FUNCPTR_T f;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_her2k_int_check( alpha_abh, a, bh, alpha_bah, b, ah, 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( *ah ) ||
bli_obj_has_zero_dim( *b ) ||
bli_obj_has_zero_dim( *bh ) )
{
bli_scalm( beta, c );
return;
}
// Alias A, B', B, and A' in case we need to update attached scalars.
bli_obj_alias_to( *a, a_local );
bli_obj_alias_to( *bh, bh_local );
bli_obj_alias_to( *b, b_local );
bli_obj_alias_to( *ah, ah_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_abh is non-unit, typecast and apply it to the scalar
// attached to B'.
if ( !bli_obj_equals( alpha_abh, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( alpha_abh, &bh_local );
}
// If alpha_bah is non-unit, typecast and apply it to the scalar
// attached to A'.
if ( !bli_obj_equals( alpha_bah, &BLIS_ONE ) )
{
bli_obj_scalar_apply_scalar( alpha_bah, &ah_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 a bool based on the uplo field of c.
if ( bli_obj_root_is_lower( c_local ) ) 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[uplo][n][i];
// Invoke the variant.
f( &a_local,
&bh_local,
&b_local,
&ah_local,
&c_local,
cntl );
}
void bli_ger_int( conj_t conjx,
conj_t conjy,
obj_t* alpha,
obj_t* x,
obj_t* y,
obj_t* a,
cntx_t* cntx,
ger_t* cntl )
{
varnum_t n;
impl_t i;
FUNCPTR_T f;
obj_t alpha_local;
obj_t x_local;
obj_t y_local;
obj_t a_local;
// Check parameters.
if ( bli_error_checking_is_enabled() )
bli_ger_check( alpha, x, y, a );
// If A has a zero dimension, return early.
if ( bli_obj_has_zero_dim( a ) ) return;
// If x or y has a zero dimension, return early.
if ( bli_obj_has_zero_dim( x ) ||
bli_obj_has_zero_dim( y ) ) return;
// Alias the objects, applying conjx and conjy to x and y, respectively.
bli_obj_alias_with_conj( conjx, x, &x_local );
bli_obj_alias_with_conj( conjy, y, &y_local );
bli_obj_alias_to( a, &a_local );
// If matrix A is marked for conjugation, we interpret this as a request
// to apply a conjugation to the other operands.
if ( bli_obj_has_conj( &a_local ) )
{
bli_obj_toggle_conj( &a_local );
bli_obj_toggle_conj( &x_local );
bli_obj_toggle_conj( &y_local );
bli_obj_scalar_init_detached_copy_of( bli_obj_dt( alpha ),
BLIS_CONJUGATE,
alpha,
&alpha_local );
}
else
{
bli_obj_alias_to( *alpha, alpha_local );
}
// If we are about the call a leaf-level implementation, and matrix A
// still needs a transposition, then we must induce one by swapping the
// strides and dimensions.
if ( bli_cntl_is_leaf( cntl ) && bli_obj_has_trans( &a_local ) )
{
bli_obj_induce_trans( &a_local );
bli_obj_set_onlytrans( BLIS_NO_TRANSPOSE, &a_local );
}
// Extract the variant number and implementation type.
n = bli_cntl_var_num( cntl );
i = bli_cntl_impl_type( cntl );
// Index into the variant array to extract the correct function pointer.
f = vars[n][i];
// Invoke the variant.
f( &alpha_local,
&x_local,
&y_local,
&a_local,
cntx,
cntl );
}
