CAMLprim value NAME(
value vN,
value vOFSZ, value vINCZ, value vZ,
value vOFSX, value vINCX, value vX,
value vOFSY, value vINCY, value vY)
{
CAMLparam3(vX, vY, vZ);
int GET_INT(N),
GET_INT(INCX),
GET_INT(INCY),
GET_INT(INCZ);
VEC_PARAMS(X);
VEC_PARAMS(Y);
VEC_PARAMS(Z);
NUMBER *start_src1, *last_src1, *start_src2, *dst;
caml_enter_blocking_section(); /* Allow other threads */
if (INCX > 0) {
start_src1 = X_data;
last_src1 = start_src1 + N*INCX;
}
else {
start_src1 = X_data - (N - 1)*INCX;
last_src1 = X_data + INCX;
};
if (INCY > 0) start_src2 = Y_data;
else start_src2 = Y_data - (N - 1)*INCY;
if (INCZ > 0) dst = Z_data;
else dst = Z_data - (N - 1)*INCZ;
while (start_src1 != last_src1) {
NUMBER x = *start_src1;
NUMBER y = *start_src2;
FUNC(dst, x, y);
start_src1 += INCX;
start_src2 += INCY;
dst += INCZ;
};
caml_leave_blocking_section(); /* Disallow other threads */
CAMLreturn(Val_unit);
}
CAMLprim value LFUN(sqr_nrm2_stub)(
value vSTABLE, value vN, value vOFSX, value vINCX, value vX)
{
CAMLparam1(vX);
integer GET_INT(N), GET_INT(INCX);
REAL res;
VEC_PARAMS(X);
caml_enter_blocking_section(); /* Allow other threads */
if (Bool_val(vSTABLE)) {
#ifndef LACAML_DOUBLE
res = scnrm2_(&N, X_data, &INCX);
#else
res = dznrm2_(&N, X_data, &INCX);
#endif
res *= res;
} else {
COMPLEX cres = FUN(dotc)(&N, X_data, &INCX, X_data, &INCX);
res = cres.r;
}
caml_leave_blocking_section(); /* Disallow other threads */
CAMLreturn(caml_copy_double(res));
}
CAMLprim value NAME(value vCMP, value vN,
value vOFSX, value vINCX, value vX)
{
CAMLparam2(vCMP, vX);
#if defined(OCAML_SORT_CALLBACK)
CAMLlocal2(va, vb);
#endif
const size_t GET_INT(N);
int GET_INT(INCX);
VEC_PARAMS(X);
NUMBER *const base_ptr = X_data;
const size_t max_thresh = MAX_THRESH * sizeof(NUMBER) * INCX;
if (N == 0) CAMLreturn(Val_unit);
#ifndef OCAML_SORT_CALLBACK
caml_enter_blocking_section(); /* Allow other threads */
#endif
#define QUICKSORT_LT(a, b) OCAML_SORT_LT((*a), (*b))
QUICKSORT(NUMBER, base_ptr, INCX, max_thresh);
#undef QUICKSORT_LT
#ifndef OCAML_SORT_CALLBACK
caml_leave_blocking_section(); /* Disallow other threads */
#endif
CAMLreturn(Val_unit);
}
CAMLprim value LFUN(gemm_diag_stub)(
value vTRANSA,
value vTRANSB,
value vN, value vK,
value vAR, value vAC, value vA,
value vBR, value vBC, value vB,
value vOFSY,
value vY,
value vALPHA,
value vBETA
)
{
CAMLparam3(vA, vB, vY);
integer GET_INT(N), GET_INT(K);
char GET_INT(TRANSA), GET_INT(TRANSB);
CREATE_NUMBER(ALPHA);
CREATE_NUMBER(BETA);
MAT_PARAMS(A);
MAT_PARAMS(B);
VEC_PARAMS(Y);
unsigned long iter_incr_A, iter_incr_B;
integer dot_incr_A, dot_incr_B;
NUMBER *last_Y = Y_data + N;
if (TRANSB == 'N') {
iter_incr_B = rows_B;
dot_incr_B = 1;
} else {
iter_incr_B = 1;
dot_incr_B = rows_B;
}
INIT_NUMBER(ALPHA);
INIT_NUMBER(BETA);
caml_enter_blocking_section(); /* Allow other threads */
if (TRANSA == 'N') {
iter_incr_A = 1;
dot_incr_A = rows_A;
} else {
iter_incr_A = rows_A;
dot_incr_A = 1;
}
COMMON_DIAG_LOOP(GEMM)
caml_leave_blocking_section(); /* Disallow other threads */
CAMLreturn(Val_unit);
}
CAMLprim value LFUN(sqr_nrm2_stub)(
value vSTABLE, value vN, value vOFSX, value vINCX, value vX)
{
CAMLparam1(vX);
integer GET_INT(N), GET_INT(INCX);
doublereal res;
VEC_PARAMS(X);
caml_enter_blocking_section(); /* Allow other threads */
if (Bool_val(vSTABLE)) {
res = FUN(nrm2)(&N, X_data, &INCX);
res *= res;
} else res = FUN(dot)(&N, X_data, &INCX, X_data, &INCX);
caml_leave_blocking_section(); /* Disallow other threads */
CAMLreturn(caml_copy_double(res));
}
CAMLprim value LFUN(ssqr_stub)(
value vN,
value vC,
value vOFSX, value vINCX, value vX)
{
CAMLparam1(vX);
integer GET_INT(N),
GET_INT(INCX);
VEC_PARAMS(X);
COMPLEX *start, *last;
COMPLEX acc = { 0.0, 0.0 };
REAL cr = Double_field(vC, 0);
REAL ci = Double_field(vC, 1);
REAL diffr;
REAL diffi;
caml_enter_blocking_section(); /* Allow other threads */
if (INCX > 0) {
start = X_data;
last = start + N*INCX;
}
else {
start = X_data - (N - 1)*INCX;
last = X_data + INCX;
};
while (start != last) {
diffr = start->r - cr;
diffi = start->i - ci;
acc.r += diffr * diffr - diffi * diffi;
acc.i += 2 * diffr * diffi;
start += INCX;
};
caml_leave_blocking_section(); /* Disallow other threads */
CAMLreturn(copy_two_doubles(acc.r, acc.i));
}
CAMLprim value NAME_PERM(value vCMP, value vN,
value vOFSP, value vINCP, value vP,
value vOFSX, value vINCX, value vX)
{
CAMLparam3(vCMP, vP, vX);
#if defined(OCAML_SORT_CALLBACK)
CAMLlocal2(va, vb);
#endif
const size_t GET_INT(N);
int GET_INT(INCX),
GET_INT(INCP);
VEC_PARAMS(X);
intnat OFSX = Long_val(vOFSX);
intnat *P_data = ((intnat *) Caml_ba_data_val(vP)) + (Long_val(vOFSP) - 1);
size_t i;
NUMBER *const X = X_data - OFSX; /* so P values are FORTRAN indices */
intnat *const base_ptr = P_data;
const size_t max_thresh = MAX_THRESH * sizeof(intnat) * INCP;
if (N == 0) CAMLreturn(Val_unit);
#ifndef OCAML_SORT_CALLBACK
caml_enter_blocking_section(); /* Allow other threads */
#endif
/* Initialize the permutation to the "identity". */
for(i = 0; i < N; i += 1)
P_data[i * INCP] = OFSX + i * INCX;
#define QUICKSORT_LT(a, b) OCAML_SORT_LT((X[*a]), (X[*b]))
QUICKSORT(intnat, base_ptr, INCP, max_thresh);
#undef QUICKSORT_LT
#ifndef OCAML_SORT_CALLBACK
caml_leave_blocking_section(); /* Disallow other threads */
#endif
CAMLreturn(Val_unit);
}
CAMLprim value LFUN(ssqr_stub)(
value vN,
value vC,
value vOFSX, value vINCX, value vX)
{
CAMLparam1(vX);
integer GET_INT(N),
GET_INT(INCX);
VEC_PARAMS(X);
REAL *start, *last;
REAL acc = 0.0;
REAL c = Double_val(vC);
REAL diff;
caml_enter_blocking_section(); /* Allow other threads */
if (INCX > 0) {
start = X_data;
last = start + N*INCX;
}
else {
start = X_data - (N - 1)*INCX;
last = X_data + INCX;
};
while (start != last) {
diff = *start - c;
acc += diff * diff;
start += INCX;
};
caml_leave_blocking_section(); /* Disallow other threads */
CAMLreturn(caml_copy_double(acc));
}
CAMLprim value LFUN(scal_rows_stub)(
value vM, value vN,
value vOFSALPHAs, value vALPHAs,
value vAR, value vAC, value vA)
{
CAMLparam2(vALPHAs, vA);
integer GET_INT(M), GET_INT(N);
if (M > 0 && N > 0) {
VEC_PARAMS(ALPHAs);
MAT_PARAMS(A);
NUMBER *A_last = A_data + M;
caml_enter_blocking_section();
do {
FUN(scal)(&N, ALPHAs_data, A_data, &rows_A);
A_data++;
ALPHAs_data++;
} while (A_data != A_last);
caml_leave_blocking_section();
}
CAMLreturn(Val_unit);
}
