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