Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge branch 'master' of github.com:Whiteknight/parrot-linear-algebra
  • Loading branch information
Whiteknight committed Sep 1, 2010
2 parents 1831e83 + 0161a22 commit 8b3241e
Show file tree
Hide file tree
Showing 7 changed files with 1,504 additions and 648 deletions.
61 changes: 41 additions & 20 deletions setup.nqp
Expand Up @@ -32,8 +32,8 @@ sub MAIN(@argv) {
$mode := @argv[0];
}
if $mode eq "build" {
probe_for_cblas(%PLA);
find_blas(%PLA);
probe_for_cblas_h(%PLA);
find_lapack(%PLA);
}
if $mode eq "test" {
Expand All @@ -45,6 +45,7 @@ sub MAIN(@argv) {
setup_testlib(%PLA);
setup_nqp_bootstrapper(%PLA);
setup_dynpmc_flags(%PLA);
setup_docs(%PLA);

setup(@argv, %PLA);
}
Expand All @@ -70,15 +71,18 @@ sub setup_PLA_keys(%PLA) {
%PLA{'inst_lib'} := new_array();
%PLA{'pir_pir'} := new_hash();
%PLA{'pir_pir'}{'t/testlib/pla_test.pir'} := new_array();
%PLA{'need_cblas_h'} := 0;
}

#
sub probe_for_cblas(%PLA) {
if probe_include("cblas.h", :verbose(1)) {
pir::say("Cannot find cblas.h\nPlease install libatlas-base-dev");
pir::exit__vI(1);
} else {
%PLA{'dynpmc_cflags_list'}.push("-D_PLA_HAVE_CBLAS_H");
sub probe_for_cblas_h(%PLA) {
if %PLA{'need_cblas_h'} {
if probe_include("cblas.h", :verbose(1)) {
pir::say("Cannot find cblas.h. This is required if you are using CBLAS or ATLAS");
pir::exit(1);
} else {
%PLA{'dynpmc_cflags_list'}.push("-D_PLA_HAVE_CBLAS_H");
}
}
}

Expand All @@ -87,19 +91,7 @@ sub find_blas(%PLA) {
my $osname := %config{'osname'};
my $found_blas := 0;
if $osname eq 'linux' {
my %searches;
%searches{'/usr/lib/libblas.so'} := ['-lblas', '-D_PLA_HAVE_ATLAS'];
%searches{'/usr/lib/atlas/libcblas.so'} := ['-L/usr/lib/atlas -lcblas', '-D_PLA_HAVE_ATLAS'];
for %searches {
my $searchloc := $_;
my $test_ldd := pir::spawnw__IS('ldd ' ~ $searchloc);
if $test_ldd == 0 {
$found_blas := 1;
%PLA{'dynpmc_ldflags_list'}.push(%searches{$searchloc}[0]);
%PLA{'dynpmc_cflags_list'}.push(%searches{$searchloc}[1]);
return;
}
}
$found_blas := find_blas_linux(%PLA);
}
else {
pir::say("Only Linux is currently supported");
Expand All @@ -111,6 +103,29 @@ sub find_blas(%PLA) {
}
}

sub find_blas_linux(%PLA) {
my $found_blas := 0;
my %searches;
# TODO: We should search in /usr/lib and /usr/local/lib for each
%searches{'/usr/lib/libblas-3.so'} := ['-lblas-3', '-D_PLA_HAVE_BLAS', 0];
%searches{'/usr/lib/libblas.so'} := ['-lblas', '-D_PLA_HAVE_ATLAS', 1];
%searches{'/usr/lib/atlas/libcblas.so'} := ['-L/usr/lib/atlas -lcblas', '-D_PLA_HAVE_ATLAS', 1];
for %searches {
my $searchloc := $_;
my $test_ldd := pir::spawnw__IS('ldd ' ~ $searchloc);
if $test_ldd == 0 {
$found_blas := 1;
my @options := %searches{$searchloc};
%PLA{'dynpmc_ldflags_list'}.push(@options[0]);
%PLA{'dynpmc_cflags_list'}.push(@options[1]);
%PLA{'need_cblas_h'} := @options[2];
pir::say("=== PLA: Using BLAS library $searchloc");
return $found_blas;
}
}
return $found_blas;
}

sub find_lapack(%PLA) {
my %config := get_config();
my $osname := %config{'osname'};
Expand Down Expand Up @@ -236,4 +251,10 @@ sub setup_nqp_bootstrapper(%PLA) {
%PLA{'inst_lib'}.push('pla_nqp.pbc');
}

sub setup_docs(%PLA) {
%PLA{'html_pod'}{'docs/nummatrix2d.html'} := 'src/pmc/nummatrix2d.pmc';
%PLA{'html_pod'}{'docs/pmcmatrix2d.html'} := 'src/pmc/pmcmatrix2d.pmc';
%PLA{'html_pod'}{'docs/complexmatrix2d.html'} := 'src/pmc/complexmatrix2d.pmc';
}


79 changes: 43 additions & 36 deletions src/include/pla_blas.h
Expand Up @@ -5,60 +5,67 @@
need to manually write bindings for that */
#ifdef _PLA_HAVE_CBLAS_H
# include <cblas.h>
# define dgemm cblas_dgemm
# define zgemm cblas_zgemm
# define PLA_HAVE_CBLAS
# define IS_TRANSPOSED_BLAS(flags) (IS_TRANSPOSED(flags) ? CblasTrans : CblasNoTrans)
#else
# define IS_TRANSPOSED_BLAS(flags) (IS_TRANSPOSED(flags) ? "T" : "N")
# ifdef PLA_HAVE_CBLAS
# undef PLA_HAVE_CBLAS
# endif

/* Define manual mappings to the BLAS library here, and map them to the same
function names that would be used by ATLAS/cblas.h */

/* Using the same names for these enums as cblas.h does, so that we can be
transparent between the two */
typedef enum CBLAS_ORDER_ {
CblasRowMajor = 101,
CblasColMajor=102
} CBLAS_ORDER;

typedef enum CBLAS_TRANSPOSE_ {
CblasNoTrans = 111,
CblasTrans = 112,
CblasConjTrans = 113
} CBLAS_TRANSPOSE;

extern void dgemm_(
const CBLAS_ORDER Order,
const CBLAS_TRANSPOSE TransA,
const CBLAS_TRANSPOSE TransB,
const int M,
const int N,
const int K,
const double alpha,
const void *TransA,
const void *TransB,
const void *M,
const void *N,
const void *K,
const double *alpha,
const double *A,
const int lda,
const void *lda,
const double *B,
const int ldb,
const double beta,
const void *ldb,
const double *beta,
double *C,
const int ldc
const void *ldc
);
#define dgemm dgemm_

extern void zgemm_(
const CBLAS_ORDER Order,
const CBLAS_TRANSPOSE TransA,
const CBLAS_TRANSPOSE TransB,
const int M,
const int N,
const int K,
const void *TransA,
const void *TransB,
const void *M,
const void *N,
const void *K,
const void *alpha,
const void *A,
const int lda,
const void *lda,
const void *B,
const int ldb,
const void *ldb,
const void *beta,
void *C,
const int ldc
const void *ldc
);

# endif /* _PLA_HAVE_CBLAS_H */

void call_dgemm(
FLOATVAL alpha,
INTVAL flags_A, FLOATVAL * A, INTVAL rows_A, INTVAL cols_A,
INTVAL flags_B, FLOATVAL * B, INTVAL cols_B,
FLOATVAL beta,
FLOATVAL * C
);

void call_zgemm(
FLOATVAL alpha_r, FLOATVAL alpha_i,
INTVAL flags_a, FLOATVAL * A, INTVAL rows_a, INTVAL cols_a,
INTVAL flags_b, FLOATVAL * B, INTVAL cols_b,
FLOATVAL beta_r, FLOATVAL beta_i,
FLOATVAL * C
);



#endif /* _PLA_BLAS_H_ */
15 changes: 14 additions & 1 deletion src/include/pla_matrix_types.h
Expand Up @@ -5,6 +5,20 @@ extern INTVAL __PLA_Type_NumMatrix2D;
extern INTVAL __PLA_Type_ComplexMatrix2D;
extern INTVAL __PLA_Type_PMCMatrix2D;

#define ALLOCATE_STORAGE_NumMatrix2D(s) \
(FLOATVAL *)mem_sys_allocate_zeroed(s * sizeof (FLOATVAL))
#define DECLATTRS_NumMatrix2D(p, a) Parrot_NumMatrix2D_attributes * const (a) = \
(Parrot_NumMatrix2D_attributes *)((p)->data)

#define ALLOCATE_STORAGE_ComplexMatrix2D(s) \
(FLOATVAL *)mem_sys_allocate_zeroed(s * sizeof (FLOATVAL) * 2)
#define DECLATTRS_ComplexMatrix2D(p, a) Parrot_ComplexMatrix2D_attributes * const (a) = \
(Parrot_ComplexMatrix2D_attributes *)((p)->data)

#define ALLOCATE_STORAGE_PMCMatrix2D(s) (PMC **)mem_sys_allocate_zeroed(s * sizeof (PMC *))
#define DECLATTRS_PMCMatrix2D(p, a) Parrot_PMCMatrix2D_attributes * const (a) = \
(Parrot_PMCMatrix2D_attributes *)((p)->data)

#define SWAP_XY(a) do { \
const INTVAL __temp_val = a->rows; \
a->rows = a->cols; \
Expand Down Expand Up @@ -164,6 +178,5 @@ do { \
#define IS_DIAGONAL(flags) ((((flags) & (FLAG_DIAGONAL)) == FLAG_DIAGONAL))
#define IS_TRIDIAGONAL(flags) (((flags) & (FLAG_TRIDIAGONAL)))
#define IS_TRANSPOSED(flags) (((flags) & (FLAG_TRANSPOSED)))
#define IS_TRANSPOSED_BLAS(flags) (IS_TRANSPOSED(flags) ? CblasTrans : CblasNoTrans)

#endif /* _PLA_MATRIX_TYPES_H_ */
111 changes: 65 additions & 46 deletions src/lib/pla_blas.c
Expand Up @@ -3,81 +3,100 @@
/* Wrapper to call the dgemm function from BLAS with PMC arguments. Assumes
A, B, and C are all NumMatrix2D. */
void
call_dgemm(PARROT_INTERP, FLOATVAL alpha, PMC * A, PMC *B, FLOATVAL beta, PMC *C)
call_dgemm(FLOATVAL alpha,
INTVAL flags_a, FLOATVAL * A, INTVAL rows_a, INTVAL cols_a,
INTVAL flags_b, FLOATVAL * B, INTVAL cols_b,
FLOATVAL beta, FLOATVAL * C)
{
DECLATTRS(A, attrs_a);
DECLATTRS(B, attrs_b);
DECLATTRS(C, attrs_c);
const INTVAL M = attrs_a->rows;
const INTVAL N = attrs_b->cols;
const INTVAL K = attrs_a->cols;
if (attrs_c->rows != M)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"PLA DGEMM: A, C indices do not match in gemm");
if (attrs_c->cols != N)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"PLA DGEMM: B, C indices do not match in gemm");
if (attrs_b->rows != K)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"PLA DGEMM: A, B indeces do not match in gemm");
dgemm(CblasRowMajor,
IS_TRANSPOSED_BLAS(attrs_a->flags),
IS_TRANSPOSED_BLAS(attrs_b->flags),
const INTVAL M = rows_a;
const INTVAL N = cols_b;
const INTVAL K = cols_a;
#ifdef PLA_HAVE_CBLAS
cblas_dgemm(CblasRowMajor,
IS_TRANSPOSED_BLAS(flags_a),
IS_TRANSPOSED_BLAS(flags_b),
M,
N,
K,
alpha,
attrs_a->storage,
A,
M,
attrs_b->storage,
B,
N,
beta,
attrs_c->storage,
C,
M
);
#else
dgemm_(
IS_TRANSPOSED_BLAS(flags_a),
IS_TRANSPOSED_BLAS(flags_b),
&M,
&N,
&K,
&alpha,
A,
&M,
B,
&N,
&beta,
C,
&M
);
#endif
}

/* Wrapper to call the zdgemm function from BLAS with PMC arguments. Assumes
A, B, and C are all ComplexMatrix2D. */
static void
call_zgemm(PARROT_INTERP, FLOATVAL alpha_r, FLOATVAL alpha_i, PMC * A, PMC *B,
FLOATVAL beta_r, FLOATVAL beta_i, PMC *C)
void
call_zgemm(FLOATVAL alpha_r, FLOATVAL alpha_i,
INTVAL flags_a, FLOATVAL * A, INTVAL rows_a, INTVAL cols_a,
INTVAL flags_b, FLOATVAL * B, INTVAL cols_b,
FLOATVAL beta_r, FLOATVAL beta_i, FLOATVAL * C)
{
DECLATTRS(A, attrs_a);
DECLATTRS(B, attrs_b);
DECLATTRS(C, attrs_c);
const INTVAL M = attrs_a->rows;
const INTVAL N = attrs_b->cols;
const INTVAL K = attrs_a->cols;
const INTVAL M = rows_a;
const INTVAL N = cols_b;
const INTVAL K = cols_a;
FLOATVAL alpha_p[2];
FLOATVAL beta_p[2];
if (attrs_c->rows != M)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"PLA ZGEMM: A, C indices do not match in gemm");
if (attrs_c->cols != N)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"PLA ZGEMM: B, C indices do not match in gemm");
if (attrs_b->rows != K)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"PLA ZGEMM: A, B indeces do not match in gemm");

alpha_p[0] = alpha_r;
alpha_p[1] = alpha_i;
beta_p[0] = beta_r;
beta_p[1] = beta_i;
zgemm(CblasRowMajor,
IS_TRANSPOSED_BLAS(attrs_a->flags),
IS_TRANSPOSED_BLAS(attrs_b->flags),

#ifdef PLA_HAVE_CBLAS
cblas_zgemm(CblasRowMajor,
IS_TRANSPOSED_BLAS(flags_a),
IS_TRANSPOSED_BLAS(flags_b),
M,
N,
K,
alpha_p,
attrs_a->storage,
A,
M,
attrs_b->storage,
B,
N,
beta_p,
attrs_c->storage,
C,
M
);
#else
zgemm_(
IS_TRANSPOSED_BLAS(flags_a),
IS_TRANSPOSED_BLAS(flags_b),
&M,
&N,
&K,
alpha_p,
A,
&M,
B,
&N,
beta_p,
C,
&M
);
#endif
}

0 comments on commit 8b3241e

Please sign in to comment.