value caml_ba_get_N(value vb, value * vind, int nind) { struct caml_ba_array * b = Caml_ba_array_val(vb); intnat index[CAML_BA_MAX_NUM_DIMS]; int i; intnat offset; /* Check number of indices = number of dimensions of array (maybe not necessary if ML typing guarantees this) */ if (nind != b->num_dims) caml_invalid_argument("Bigarray.get: wrong number of indices"); /* Compute offset and check bounds */ for (i = 0; i < b->num_dims; i++) index[i] = Long_val(vind[i]); offset = caml_ba_offset(b, index); /* Perform read */ switch ((b->flags) & CAML_BA_KIND_MASK) { default: Assert(0); #ifdef _KERNEL #else case CAML_BA_FLOAT32: return caml_copy_double(((float *) b->data)[offset]); case CAML_BA_FLOAT64: return caml_copy_double(((double *) b->data)[offset]); #endif case CAML_BA_SINT8: return Val_int(((int8 *) b->data)[offset]); case CAML_BA_UINT8: return Val_int(((uint8 *) b->data)[offset]); case CAML_BA_SINT16: return Val_int(((int16 *) b->data)[offset]); case CAML_BA_UINT16: return Val_int(((uint16 *) b->data)[offset]); case CAML_BA_INT32: return caml_copy_int32(((int32 *) b->data)[offset]); case CAML_BA_INT64: return caml_copy_int64(((int64 *) b->data)[offset]); case CAML_BA_NATIVE_INT: return caml_copy_nativeint(((intnat *) b->data)[offset]); case CAML_BA_CAML_INT: return Val_long(((intnat *) b->data)[offset]); #ifdef _KERNEL #else case CAML_BA_COMPLEX32: { float * p = ((float *) b->data) + offset * 2; return copy_two_doubles(p[0], p[1]); } case CAML_BA_COMPLEX64: { double * p = ((double *) b->data) + offset * 2; return copy_two_doubles(p[0], p[1]); } #endif } }
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)); }