BLIS: 'zdotc_' API modified to support Fortran invocation in flang environment.

1) Added dcomplex based zdotc_ version as a function with additional parameter.
2) The datatypes (single , double, Complex)  functions retained as the macros.
3) This modification handles the ZDOTC_ invocation from Fortran based application
   for 'double complex' datatypes.
4) The modifications are placed under macro 'AOCL_F2C'.
5) Blis, Blas Test suites verified ALL PASS with GCC and Flang
   + with and without 'AOCL_F2C' macro on Ubuntu machine.
6) Adding BLIS_EXPORT_BLAS to make the APIs visible when linking dll.

Change-Id: I4ada39a73f416e3794708f5b55e947342c261117
Signed-off-by: Meghana <Meghana.Vankadari@amd.com>, Nagendra <Nagendra.PrasadM@amd.com>
AMD-Internal: [SWLCSG-177]
This commit is contained in:
nprasadm
2020-06-22 10:52:16 +05:30
committed by Meghana Vankadari
parent 6a0a65ee23
commit af1f9ab98d
6 changed files with 128 additions and 3 deletions

View File

@@ -459,8 +459,13 @@ static doublereal c_b52 = 0.;
integer lenx, leny;
extern /* Subroutine */ int ctest_(integer *, doublecomplex *,
doublecomplex *, doublecomplex *, doublereal *);
#ifdef AOCL_F2C
extern /* Double Complex */ doublecomplex zdotc_(doublecomplex*, integer *,
doublecomplex *, integer *, doublecomplex *, integer *);
#else
extern /* Double Complex */ doublecomplex zdotc_(integer *,
doublecomplex *, integer *, doublecomplex *, integer *);
#endif
integer ksize;
extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *,
doublecomplex *, integer *);
@@ -508,8 +513,13 @@ static doublereal c_b52 = 0.;
}
if (combla_1.icase == 1) {
/* .. ZDOTC .. */
#ifdef AOCL_F2C
z__1 = zdotc_(&z__1, &combla_1.n, cx, &combla_1.incx, cy, &
combla_1.incy);
#else
z__1 = zdotc_(&combla_1.n, cx, &combla_1.incx, cy, &
combla_1.incy);
#endif
cdot[0].r = z__1.r, cdot[0].i = z__1.i;
ctest_(&c__1, cdot, &ct6[kn + (ki << 2) - 5], &csize1[kn - 1],
sfac);

View File

@@ -87,6 +87,53 @@ ftype PASTEF772(ch,blasname,chc) \
}
#ifdef BLIS_ENABLE_BLAS
#ifdef AOCL_F2C
dcomplex zdotc_
(
dcomplex *ret_val,
const f77_int* n,
const dcomplex* x, const f77_int* incx,
const dcomplex* y, const f77_int* incy
)
{
dim_t n0;
dcomplex* x0;
dcomplex* y0;
inc_t incx0;
inc_t incy0;
dcomplex rho;
/* Initialize BLIS. */
bli_init_auto();
/* Convert/typecast negative values of n to zero. */
bli_convert_blas_dim1( *n, n0 );
/* If the input increments are negative, adjust the pointers so we can
use positive increments instead. */
bli_convert_blas_incv( n0, (dcomplex*)x, *incx, x0, incx0 );
bli_convert_blas_incv( n0, (dcomplex*)y, *incy, y0, incy0 );
/* Call BLIS interface. */
PASTEMAC2(z,dotv,_ex)
(
BLIS_CONJUGATE,
BLIS_NO_CONJUGATE,
n0,
x0, incx0,
y0, incy0,
&rho,
NULL,
NULL
);
/* Finalize BLIS. */
bli_finalize_auto();
*ret_val = rho;
return rho;
}
#endif
#ifdef BLIS_CONFIG_ZEN2
float sdot_
@@ -246,11 +293,18 @@ double ddot_
return rho;
}
#ifdef AOCL_F2C
INSERT_GENTFUNCDOT_BLAS_CZ_F2C( dot, dotv)
#else
INSERT_GENTFUNCDOT_BLAS_CZ( dot, dotv )
#endif
#else
#ifdef AOCL_F2C
INSERT_GENTFUNCDOT_BLAS_SDC( dot, dotv )
#else
INSERT_GENTFUNCDOT_BLAS( dot, dotv )
#endif
#endif
// -- "Black sheep" dot product function definitions --

View File

@@ -47,8 +47,21 @@ BLIS_EXPORT_BLAS ftype PASTEF772(ch,blasname,chc) \
);
#ifdef BLIS_ENABLE_BLAS
INSERT_GENTPROTDOT_BLAS( dot )
#ifdef AOCL_F2C
INSERT_GENTPROTDOT_BLAS_SDC( dot )
BLIS_EXPORT_BLAS dcomplex zdotc_
(
dcomplex *ret_val,
const f77_int* n,
const dcomplex* x, const f77_int* incx,
const dcomplex* y, const f77_int* incy
);
#else
INSERT_GENTPROTDOT_BLAS( dot )
#endif
// -- "Black sheep" dot product function prototypes --

View File

@@ -59,8 +59,28 @@ void PASTEF773(ch,blasname,chc,sub) \
}
#ifdef BLIS_ENABLE_CBLAS
INSERT_GENTFUNCDOT_BLAS( dot, NULL )
#ifdef AOCL_F2C
INSERT_GENTFUNCDOT_BLAS_SDC( dot, NULL )
void PASTEF773(z,dot,c,sub)
(
const f77_int* n,
const dcomplex* x, const f77_int* incx,
const dcomplex* y, const f77_int* incy,
dcomplex* rval
)
{
PASTEF772(z,dot,c)
(
rval,
n,
x, incx,
y, incy
);
}
#else
INSERT_GENTFUNCDOT_BLAS( dot, NULL )
#endif
// -- "Black sheep" dot product function definitions --

View File

@@ -89,6 +89,11 @@ GENTFUNCDOT( scomplex, c, u, BLIS_NO_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( dcomplex, z, c, BLIS_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( dcomplex, z, u, BLIS_NO_CONJUGATE, blasname, blisname )
#define INSERT_GENTFUNCDOT_BLAS_CZ_F2C( blasname, blisname ) \
\
GENTFUNCDOT( scomplex, c, c, BLIS_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( scomplex, c, u, BLIS_NO_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( dcomplex, z, u, BLIS_NO_CONJUGATE, blasname, blisname )
#define INSERT_GENTFUNCDOT_BLAS( blasname, blisname ) \
\
@@ -99,6 +104,17 @@ GENTFUNCDOT( scomplex, c, u, BLIS_NO_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( dcomplex, z, c, BLIS_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( dcomplex, z, u, BLIS_NO_CONJUGATE, blasname, blisname )
#ifdef AOCL_F2C
#define INSERT_GENTFUNCDOT_BLAS_SDC( blasname, blisname ) \
\
GENTFUNCDOT( float, s, , BLIS_NO_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( double, d, , BLIS_NO_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( scomplex, c, c, BLIS_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( scomplex, c, u, BLIS_NO_CONJUGATE, blasname, blisname ) \
GENTFUNCDOT( dcomplex, z, u, BLIS_NO_CONJUGATE, blasname, blisname )
#endif
// -- Basic one-operand macro with real projection --
@@ -205,6 +221,7 @@ GENTFUNC( double, d, tfuncname, varname1, varname2 ) \
GENTFUNC( scomplex, c, tfuncname, varname1, varname2 ) \
GENTFUNC( dcomplex, z, tfuncname, varname1, varname2 )
// -- (three auxiliary arguments) --
#define INSERT_GENTFUNC_BASIC3( tfuncname, varname1, varname2, varname3 ) \

View File

@@ -87,6 +87,17 @@ GENTPROTDOT( scomplex, c, u, blasname ) \
GENTPROTDOT( dcomplex, z, c, blasname ) \
GENTPROTDOT( dcomplex, z, u, blasname )
#ifdef AOCL_F2C
#define INSERT_GENTPROTDOT_BLAS_SDC( blasname ) \
\
GENTPROTDOT( float, s, , blasname ) \
GENTPROTDOT( double, d, , blasname ) \
GENTPROTDOT( scomplex, c, c, blasname ) \
GENTPROTDOT( scomplex, c, u, blasname ) \
GENTPROTDOT( dcomplex, z, u, blasname )
#endif
// -- Basic one-operand macro with real projection --