repv gh_doubles2scm(const double *d, long n)
{
int i;
repv vec;
vec = rep_make_vector (n);
for (i = 0; i < n; i++)
rep_VECTI (vec, i) = rep_make_float (d[i], rep_FALSE);
return vec;
}
static char *
rep_ffi_demarshal (unsigned int type_id, char *ptr, repv *value)
{
rep_ffi_type *type = ffi_types[type_id];
switch (type->subtype)
{
DEFSTRING (err, "unknown ffi type id");
case rep_FFI_PRIMITIVE:
switch (type->type->type)
{
case FFI_TYPE_VOID:
*value = rep_undefined_value;
return ptr;
case FFI_TYPE_INT:
*value = rep_make_long_int (*(int *)ptr);
return ptr + sizeof (int);
case FFI_TYPE_FLOAT:
*value = rep_make_float (*(float *)ptr, rep_TRUE);
return ptr + sizeof (float);
case FFI_TYPE_DOUBLE:
*value = rep_make_float (*(double *)ptr, rep_TRUE);
return ptr + sizeof (double);
#if FFI_TYPE_LONGDOUBLE != FFI_TYPE_DOUBLE
case FFI_TYPE_LONGDOUBLE:
*value = rep_make_float (*(long double *)ptr, rep_TRUE);
return ptr + sizeof (long double);
#endif
case FFI_TYPE_UINT8:
*value = rep_MAKE_INT (*(uint8_t *)ptr);
return ptr + sizeof (uint8_t);
case FFI_TYPE_SINT8:
*value = rep_MAKE_INT (*(int8_t *)ptr);
return ptr + sizeof (int8_t);
case FFI_TYPE_UINT16:
*value = rep_MAKE_INT (*(uint16_t *)ptr);
return ptr + sizeof (uint16_t);
case FFI_TYPE_SINT16:
*value = rep_MAKE_INT (*(int16_t *)ptr);
return ptr + sizeof (int16_t);
case FFI_TYPE_UINT32:
*value = rep_make_long_int (*(uint32_t *)ptr);
return ptr + sizeof (uint32_t);
case FFI_TYPE_SINT32:
*value = rep_make_long_int (*(int32_t *)ptr);
return ptr + sizeof (int32_t);
case FFI_TYPE_UINT64:
*value = rep_make_longlong_int (*(uint64_t *)ptr);
return ptr + sizeof (uint64_t);
case FFI_TYPE_SINT64:
*value = rep_make_longlong_int (*(int64_t *)ptr);
return ptr + sizeof (int64_t);
case FFI_TYPE_POINTER:
*value = rep_make_pointer (*(void **)ptr);
return ptr + sizeof (void *);
case FFI_TYPE_STRUCT: /* FIXME: */
default:
Fsignal (Qerror, rep_list_2 (rep_VAL (&err),
rep_MAKE_INT (type_id)));
return NULL;
}
/* not reached */
case rep_FFI_STRUCT: {
rep_ffi_struct *s = (rep_ffi_struct *) type;
rep_GC_n_roots gc_value;
int i;
*value = rep_make_vector (s->n_elements);
rep_PUSHGCN (gc_value, value, 1);
for (i = 0; i < s->n_elements; i++)
{
ptr = rep_ffi_demarshal (s->element_ids[i], ptr,
&rep_VECTI (*value, i));
if (ptr == NULL) {
rep_POPGCN;
return NULL;
}
}
rep_POPGCN;
return ptr;
}
case rep_FFI_ALIAS: {
rep_ffi_alias *s = (rep_ffi_alias *) type;
ptr = rep_ffi_marshal (s->base, *value, ptr);
if (s->conv_in != rep_NULL) {
*value = rep_call_lisp1 (s->conv_out, *value);
if (*value == rep_NULL)
return NULL;
}
return ptr;
}
default:
Fsignal (Qerror, rep_list_2 (rep_VAL (&err), rep_MAKE_INT (type_id)));
return NULL;
}
}
repv gh_double2scm(double x)
{
return rep_make_float (x, rep_FALSE);
}
