Ejemplo n.º 1
0
/* string_of_prim : 'a prim -> 'a -> string */
value ctypes_string_of_prim(value prim_, value v)
{
  CAMLparam2(prim_, v);
  CAMLlocal1(s);
  char buf[64];
  int len = 0;
  switch (Int_val(prim_))
  {
  case Char: len = snprintf(buf, sizeof buf, "'%c'", Int_val(v)); break;
  case Schar: len = snprintf(buf, sizeof buf, "%d", Int_val(v)); break;
  case Uchar: len = snprintf(buf, sizeof buf, "%d", (unsigned char)Uint8_val(v)); break;
  case Short: len = snprintf(buf, sizeof buf, "%hd", (short)Int_val(v)); break;
  case Int: len = snprintf(buf, sizeof buf, "%d", Int_val(v)); break;
  case Long: len = snprintf(buf, sizeof buf, "%ld", (long)ctypes_long_val(v)); break;
  case Llong: len = snprintf(buf, sizeof buf, "%lld", (long long)ctypes_llong_val(v)); break;
  case Ushort: len = snprintf(buf, sizeof buf, "%hu", (unsigned short)ctypes_ushort_val(v)); break;
  case Uint: len = snprintf(buf, sizeof buf, "%u", (unsigned)ctypes_uint_val(v)); break;
  case Ulong: len = snprintf(buf, sizeof buf, "%lu", (unsigned long)ctypes_ulong_val(v)); break;
  case Ullong: len = snprintf(buf, sizeof buf, "%llu", (unsigned long long)ctypes_ullong_val(v)); break;
  case Size_t: len = snprintf(buf, sizeof buf, "%zu", (size_t)ctypes_size_t_val(v)); break;
  case Int8_t: len = snprintf(buf, sizeof buf, "%" PRId8, (int8_t)Int_val(v)); break;
  case Int16_t: len = snprintf(buf, sizeof buf, "%" PRId16, (int16_t)Int_val(v)); break;
  case Int32_t: len = snprintf(buf, sizeof buf, "%" PRId32, Int32_val(v)); break;
  case Int64_t: len = snprintf(buf, sizeof buf, "%" PRId64, Int64_val(v)); break;
  case Uint8_t: len = snprintf(buf, sizeof buf, "%" PRIu8, Uint8_val(v)); break;
  case Uint16_t: len = snprintf(buf, sizeof buf, "%" PRIu16, Uint16_val(v)); break;
  case Uint32_t: len = snprintf(buf, sizeof buf, "%" PRIu32, Uint32_val(v)); break;
  case Uint64_t: len = snprintf(buf, sizeof buf, "%" PRIu64, Uint64_val(v)); break;
  case Camlint: len = snprintf(buf, sizeof buf, "%" ARCH_INTNAT_PRINTF_FORMAT "d",
                         (intnat)Int_val(v)); break;
  case Nativeint: len = snprintf(buf, sizeof buf, "%" ARCH_INTNAT_PRINTF_FORMAT "d",
                           (intnat)Nativeint_val(v)); break;
  case Float: len = snprintf(buf, sizeof buf, "%.12g", Double_val(v)); break;
  case Double: len = snprintf(buf, sizeof buf, "%.12g", Double_val(v)); break;
  case Complex32: {
    float complex c = ctypes_float_complex_val(v);
    len = snprintf(buf, sizeof buf, "%.12g+%.12gi", crealf(c), cimagf(c));
    break;
  }
  case Complex64: {
    double complex c = ctypes_double_complex_val(v);
    len = snprintf(buf, sizeof buf, "%.12g+%.12gi", creal(c), cimag(c));
    break;
  }
  default:
    assert(0);
  }
  s = caml_alloc_string(len);
  memcpy(String_val(s), buf, len);
  CAMLreturn (s);
}
Ejemplo n.º 2
0
/* write : 'a prim -> offset:int -> 'a -> raw_pointer -> unit */
value ctypes_write(value prim_, value offset_, value v, value buffer_)
{
  CAMLparam4(prim_, offset_, v, buffer_);
  int offset = Int_val(offset_);
  void *buf = (char *)CTYPES_TO_PTR(buffer_) + offset;
  switch (Int_val(prim_))
  {
   case Char: *(char *)buf = Int_val(v); break;
   case Schar: *(signed char *)buf = Int_val(v); break;
   case Uchar: *(unsigned char *)buf = Uint8_val(v); break;
   case Short: *(short *)buf = Int_val(v); break;
   case Int: *(int *)buf = Int_val(v); break;
   case Long: *(long *)buf = ctypes_long_val(v); break;
   case Llong: *(long long *)buf = ctypes_llong_val(v); break;
   case Ushort: *(unsigned short *)buf = ctypes_ushort_val(v); break;
   case Uint: *(unsigned int *)buf = ctypes_uint_val(v); break;
   case Ulong: *(unsigned long *)buf = ctypes_ulong_val(v); break;
   case Ullong: *(unsigned long long *)buf = ctypes_ullong_val(v); break;
   case Size_t: *(size_t *)buf = ctypes_size_t_val(v); break;
   case Int8_t: *(int8_t *)buf = Int_val(v); break;
   case Int16_t: *(int16_t *)buf = Int_val(v); break;
   case Int32_t: *(int32_t *)buf = Int32_val(v); break;
   case Int64_t: *(int64_t *)buf = Int64_val(v); break;
   case Uint8_t: *(uint8_t *)buf = Uint8_val(v); break;
   case Uint16_t: *(uint16_t *)buf = Uint16_val(v); break;
   case Uint32_t: *(uint32_t *)buf = Uint32_val(v); break;
   case Uint64_t: *(uint64 *)buf = Uint64_val(v); break;
   case Camlint: *(intnat *)buf = Int_val(v); break;
   case Nativeint: *(intnat *)buf = Nativeint_val(v); break;
   case Float: *(float *)buf = Double_val(v); break;
   case Double: *(double *)buf = Double_val(v); break;
   case Complex32: *(float complex *)buf = ctypes_float_complex_val(v); break;
   case Complex64: *(double complex *)buf = ctypes_double_complex_val(v); break;
   default:
    assert(0);
  }
  CAMLreturn(Val_unit);
}
Ejemplo n.º 3
0
CAMLprim value
nativeint_of_uint32(value v)
{
  CAMLparam1(v);
  CAMLreturn (caml_copy_nativeint((int)Uint32_val(v)));
}
Ejemplo n.º 4
0
CAMLprim value
uint40_of_uint32(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_uint64(((uint64_t)Uint32_val(v)) << 24));
}
Ejemplo n.º 5
0
CAMLprim value
int56_of_uint32(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_int64(((int64_t)Uint32_val(v)) << 8));
}
Ejemplo n.º 6
0
CAMLprim value
uint128_of_uint32(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_uint128((__uint128_t)Uint32_val(v)));
}
Ejemplo n.º 7
0
CAMLprim value
float_of_uint32(value v)
{
  CAMLparam1(v);
  CAMLreturn (caml_copy_double((double)Uint32_val(v)));
}
Ejemplo n.º 8
0
CAMLprim value
int8_of_uint32(value v)
{
  CAMLparam1(v);
  CAMLreturn (copy_int8((int8_t)Uint32_val(v)));
}