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); }