Ejemplo n.º 1
0
value
mlptrace_peekregisters (value pid_v)
{
  pid_t pid;
  struct user usreg;
  long l = 0;
  int savederrno = errno;
  CAMLparam1 (pid_v);
  CAMLlocal5 (res_v, eip_v, eax_v, ebx_v, ecx_v);
  CAMLlocal5 (edx_v, esi_v, edi_v, ebp_v, esp_v);
  CAMLlocal2 (eflags_v, origeax_v);
  pid = Long_val (pid_v);
  memset (&usreg, 0, sizeof (usreg));
#ifndef NO_BLOCKING_SECTION
  caml_enter_blocking_section ();
#endif
  l = ptrace (PTRACE_GETREGS, pid, (void *) 0, &usreg);
#ifndef NO_BLOCKING_SECTION
  caml_leave_blocking_section ();
#endif
  if (l == -1 && errno)
    uerror ("Ptrace.peekregisters", Nothing);
  if (savederrno)
    errno = savederrno;
  eip_v = caml_copy_nativeint (usreg.regs.eip);
  eax_v = caml_copy_nativeint (usreg.regs.eax);
  ebx_v = caml_copy_nativeint (usreg.regs.ebx);
  ecx_v = caml_copy_nativeint (usreg.regs.ecx);
  edx_v = caml_copy_nativeint (usreg.regs.edx);
  esi_v = caml_copy_nativeint (usreg.regs.esi);
  edi_v = caml_copy_nativeint (usreg.regs.edi);
  ebp_v = caml_copy_nativeint (usreg.regs.ebp);
  esp_v = caml_copy_nativeint (usreg.regs.esp);
  eflags_v = caml_copy_nativeint (usreg.regs.eflags);
  origeax_v = caml_copy_nativeint (usreg.regs.orig_eax);
  res_v = alloc_small (0, 11);
  Field (res_v, 0) = eip_v;
  Field (res_v, 1) = eax_v;
  Field (res_v, 2) = ebx_v;
  Field (res_v, 3) = ecx_v;
  Field (res_v, 4) = edx_v;
  Field (res_v, 5) = esi_v;
  Field (res_v, 6) = edi_v;
  Field (res_v, 7) = ebp_v;
  Field (res_v, 8) = esp_v;
  Field (res_v, 9) = eflags_v;
  Field (res_v, 10) = origeax_v;
  CAMLreturn (res_v);
}
Ejemplo n.º 2
0
herr_t hdf5_h5l_operator(hid_t group, const char *name, const H5L_info_t *info,
  void *op_data)
{
  CAMLparam0();
  CAMLlocal5(ret, info_v, address_v, args0, args1);
  CAMLlocal2(args2, args3);
  value args[4];

  struct operator_data *operator_data = op_data;
  args0 = alloc_h5l(group);
  args1 = caml_copy_string(name);
  args2 = Val_h5l_info(info);
  args3 = *operator_data->operator_data;
  args[0] = args0;
  args[1] = args1;
  args[2] = args2;
  args[3] = args3;
  ret = caml_callbackN_exn(*operator_data->callback, 4, args);
  if (Is_exception_result(ret))
  {
    *(operator_data->exception) = Extract_exception(ret);
    return -1;
  }
  CAMLreturnT(herr_t, H5_iter_val(ret));
}
Ejemplo n.º 3
0
static value stat_aux(int use_64, struct stat *buf)
{
  CAMLparam0();
  CAMLlocal5(atime, mtime, ctime, offset, v);

  #include "nanosecond_stat.h"
  atime = caml_copy_double((double) buf->st_atime + (NSEC(buf, a) / 1000000000.0));
  mtime = caml_copy_double((double) buf->st_mtime + (NSEC(buf, m) / 1000000000.0));
  ctime = caml_copy_double((double) buf->st_ctime + (NSEC(buf, c) / 1000000000.0));
  #undef NSEC
  offset = use_64 ? Val_file_offset(buf->st_size) : Val_int (buf->st_size);
  v = alloc_small(12, 0);
  Init_field(v, 0, Val_int (buf->st_dev));
  Init_field(v, 1, Val_int (buf->st_ino));
  Init_field(v, 2, cst_to_constr(buf->st_mode & S_IFMT, file_kind_table,
                                  sizeof(file_kind_table) / sizeof(int), 0));
  Init_field(v, 3, Val_int (buf->st_mode & 07777));
  Init_field(v, 4, Val_int (buf->st_nlink));
  Init_field(v, 5, Val_int (buf->st_uid));
  Init_field(v, 6, Val_int (buf->st_gid));
  Init_field(v, 7, Val_int (buf->st_rdev));
  Init_field(v, 8, offset);
  Init_field(v, 9, atime);
  Init_field(v, 10, mtime);
  Init_field(v, 11, ctime);
  CAMLreturn(v);
}
Ejemplo n.º 4
0
CAMLprim value caml_get_exception_backtrace(value unit)
{
  CAMLparam0();
  CAMLlocal5(events, res, arr, p, fname);
  int i;
  struct loc_info li;

  events = read_debug_info();
  if (events == Val_false) {
    res = Val_int(0);           /* None */
  } else {
    arr = caml_alloc(caml_backtrace_pos, 0);
    for (i = 0; i < caml_backtrace_pos; i++) {
      extract_location_info(events, caml_backtrace_buffer[i], &li);
      if (li.loc_valid) {
        fname = caml_copy_string(li.loc_filename);
        p = caml_alloc_small(5, 0);
        Field(p, 0) = Val_bool(li.loc_is_raise);
        Field(p, 1) = fname;
        Field(p, 2) = Val_int(li.loc_lnum);
        Field(p, 3) = Val_int(li.loc_startchr);
        Field(p, 4) = Val_int(li.loc_endchr);
      } else {
        p = caml_alloc_small(1, 1);
        Field(p, 0) = Val_bool(li.loc_is_raise);
      }
      caml_modify(&Field(arr, i), p);
    }
    res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
  }
  CAMLreturn(res);
}
Ejemplo n.º 5
0
static value stat_aux(/*int use_64,*/ struct stat *buf)
{
  CAMLparam0();
  CAMLlocal5(atime, mtime, ctime, offset, v);

  atime = caml_copy_double((double) buf->st_atime);
  mtime = caml_copy_double((double) buf->st_mtime);
  ctime = caml_copy_double((double) buf->st_ctime);
  offset = /*use_64 ? Val_file_offset(buf->st_size) :*/ Val_int (buf->st_size);
  v = caml_alloc_small(12, 0);
  Field (v, 0) = Val_int (buf->st_dev);
  Field (v, 1) = Val_int (buf->st_ino);
  Field (v, 2) = cst_to_constr(buf->st_mode & S_IFMT, file_kind_table,
                               sizeof(file_kind_table) / sizeof(int), 0);
  Field (v, 3) = Val_int (buf->st_mode & 07777);
  Field (v, 4) = Val_int (buf->st_nlink);
  Field (v, 5) = Val_int (buf->st_uid);
  Field (v, 6) = Val_int (buf->st_gid);
  Field (v, 7) = Val_int (buf->st_rdev);
  Field (v, 8) = offset;
  Field (v, 9) = atime;
  Field (v, 10) = mtime;
  Field (v, 11) = ctime;
  CAMLreturn(v);
}
Ejemplo n.º 6
0
Archivo: skin.c Proyecto: Lenbok/dormin
CAMLprim value ml_skin_init (value use_vbo_v, value geom_v)
{
    CAMLparam2 (use_vbo_v, geom_v);
    CAMLlocal5 (vertexa_v, normala_v, uva_v, skin_v, colors_v);
    State *s = &glob_state;

    use_vbo = Bool_val (use_vbo_v);
#ifdef _WIN32
    if (use_vbo) {
        GETPA (BindBuffer);
        GETPA (GenBuffers);
        GETPA (BufferData);
        GETPA (BufferSubData);
        GETPA (MapBuffer);
        GETPA (UnmapBuffer);
    }
#endif
    vertexa_v = Field (geom_v, 0);
    normala_v = Field (geom_v, 1);
    uva_v     = Field (geom_v, 2);
    skin_v    = Field (geom_v, 3);
    colors_v  = Field (geom_v, 4);

    skin_init (s, vertexa_v, normala_v, uva_v, skin_v, colors_v);
    CAMLreturn (Val_unit);
}
Ejemplo n.º 7
0
static value
convert_json_t (json_t *val, int level)
{
  CAMLparam0 ();
  CAMLlocal5 (rv, v, tv, sv, consv);

  if (level > 20)
    caml_invalid_argument ("too many levels of object/array nesting");

  if (json_is_object (val)) {
    const char *key;
    json_t *jvalue;

    rv = caml_alloc (1, JSON_DICT_TAG);
    v = Val_int (0);
    /* This will create the OCaml list backwards, but JSON
     * dictionaries are supposed to be unordered so that shouldn't
     * matter, right?  Well except that for some consumers this does
     * matter (eg. simplestreams which incorrectly uses a dict when it
     * really should use an array).
     */
    json_object_foreach (val, key, jvalue) {
      tv = caml_alloc_tuple (2);
      sv = caml_copy_string (key);
      Store_field (tv, 0, sv);
      sv = convert_json_t (jvalue, level + 1);
      Store_field (tv, 1, sv);
      consv = caml_alloc (2, 0);
      Store_field (consv, 1, v);
      Store_field (consv, 0, tv);
      v = consv;
    }
    Store_field (rv, 0, v);
  }
Ejemplo n.º 8
0
static void
event_callback_wrapper_locked (guestfs_h *g,
                               void *data,
                               uint64_t event,
                               int event_handle,
                               int flags,
                               const char *buf, size_t buf_len,
                               const uint64_t *array, size_t array_len)
{
  CAMLparam0 ();
  CAMLlocal5 (gv, evv, ehv, bufv, arrayv);
  CAMLlocal2 (rv, v);
  value *root;
  size_t i;

  root = guestfs_get_private (g, "_ocaml_g");
  gv = *root;

  /* Only one bit should be set in 'event'.  Which one? */
  evv = Val_int (event_bitmask_to_event (event));

  ehv = Val_int (event_handle);

  bufv = caml_alloc_string (buf_len);
  memcpy (String_val (bufv), buf, buf_len);

  arrayv = caml_alloc (array_len, 0);
  for (i = 0; i < array_len; ++i) {
    v = caml_copy_int64 (array[i]);
    Store_field (arrayv, i, v);
  }

  value args[5] = { gv, evv, ehv, bufv, arrayv };

  rv = caml_callbackN_exn (*(value*)data, 5, args);

  /* Callbacks shouldn't throw exceptions.  There's not much we can do
   * except to print it.
   */
  if (Is_exception_result (rv))
    fprintf (stderr,
             "libguestfs: uncaught OCaml exception in event callback: %s",
             caml_format_exception (Extract_exception (rv)));

  CAMLreturn0;
}
Ejemplo n.º 9
0
value stub_if_getaddr(value unit)
{
	CAMLparam0();
	CAMLlocal5(result, temp, name, addrstr, netmaskstr);
	CAMLlocal1(tuple);
	int ret;
	struct ifaddrs *ifaddrs, *tmp;
	struct sockaddr *sock, *netmask;

	result = temp = Val_emptylist;
	name = addrstr = Val_int(0);

	ret = getifaddrs(&ifaddrs);
	if (ret < 0)
		caml_failwith("cannot get interface address");

	for (tmp = ifaddrs; tmp; tmp = tmp->ifa_next) {
		sock = tmp->ifa_addr;
		netmask = tmp->ifa_netmask;

		if (sock->sa_family == AF_INET || sock->sa_family == AF_INET6) {
			name = caml_copy_string(tmp->ifa_name);
			addrstr = alloc_addr(sock);
			netmaskstr = alloc_addr(netmask);

			tuple = caml_alloc_tuple(4);
			Store_field(tuple, 0, name);
			Store_field(tuple, 1, addrstr);
			Store_field(tuple, 2, netmaskstr);
			Store_field(tuple, 3, Val_bool(sock->sa_family == AF_INET6));

			result = caml_alloc_small(2, Tag_cons);
			Field(result, 0) = tuple;
			Field(result, 1) = temp;

			temp = result;
		}
	}

	freeifaddrs(ifaddrs);

	CAMLreturn(result);
}
Ejemplo n.º 10
0
static int
visitor_function_wrapper (const char *dir,
                          const char *filename,
                          const struct guestfs_statns *stat,
                          const struct guestfs_xattr_list *xattrs,
                          void *opaque)
{
  CAMLparam0 ();
  CAMLlocal5 (dirv, filenamev, statv, xattrsv, v);
  struct visitor_function_wrapper_args *args = opaque;

  assert (dir != NULL);
  assert (stat != NULL);
  assert (xattrs != NULL);
  assert (args != NULL);

  dirv = caml_copy_string (dir);
  if (filename == NULL)
    filenamev = Val_int (0);    /* None */
  else {
    filenamev = caml_alloc (1, 0);
    v = caml_copy_string (filename);
    Store_field (filenamev, 0, v);
  }
  statv = copy_statns (stat);
  xattrsv = copy_xattr_list (xattrs);

  /* Call the visitor_function. */
  value argsv[4] = { dirv, filenamev, statv, xattrsv };
  v = caml_callbackN_exn (*args->fvp, 4, argsv);
  if (Is_exception_result (v)) {
    /* The visitor_function raised an exception.  Store the exception
     * in the 'exn' field on the stack of guestfs_int_mllib_visit, and
     * return an error.
     */
    *args->exnp = Extract_exception (v);
    return -1;
  }

  /* No error, return normally. */
  CAMLreturnT (int, 0);
}
Ejemplo n.º 11
0
CAMLprim value lightsource_process(value record_lightsource,
                                   value list_polygon_objects,
                                   value polygon_view) {
  CAMLparam3(record_lightsource, list_polygon_objects, polygon_view);
  CAMLlocal5(polygon_prev_head, list_polygon_head, vector_prev_head,
             list_vector_head, tmp_polygon);
  CAMLlocal1(tmp_vector);
  LightSource l = LightSource(Vector_val(Field(record_lightsource, 0)),
                              Double_val(Field(record_lightsource, 1)),
                              Double_val(Field(record_lightsource, 2)));
  std::vector<Polygon> tmp_polygon_list = std::vector<Polygon>();
  polygon_list_to_std_vector(list_polygon_objects, &tmp_polygon_list);
  std::vector<Vector> tmp_vector_list = std::vector<Vector>();
  vector_list_to_std_vector(Field(polygon_view, 0), &tmp_vector_list);
  Polygon polygon = Polygon(tmp_vector_list);
  // auto start = std::chrono::steady_clock::now();
  std::vector<Polygon> list_polygon = l.process(tmp_polygon_list);
  // auto duration = std::chrono::duration_cast<std::chrono::milliseconds>(
  //     std::chrono::steady_clock::now() - start);
  // printf("--> %lld\n", duration.count());
  polygon_prev_head = Val_unit;
  for (Polygon p : list_polygon) {
    vector_prev_head = Val_unit;
    for (Vector v : p.get_vertices()) {
      tmp_vector = caml_alloc_small(2, Double_array_tag);
      Double_field(tmp_vector, 0) = v.x;
      Double_field(tmp_vector, 1) = v.y;
      list_vector_head = caml_alloc_small(2, 0);
      Field(list_vector_head, 0) = tmp_vector;
      Field(list_vector_head, 1) = vector_prev_head;
      vector_prev_head = list_vector_head;
    }
    tmp_polygon = caml_alloc_small(1, 0);
    Field(tmp_polygon, 0) = list_vector_head;

    list_polygon_head = caml_alloc_small(2, 0);
    Field(list_polygon_head, 0) = tmp_polygon;
    Field(list_polygon_head, 1) = polygon_prev_head;
    polygon_prev_head = list_polygon_head;
  }
  CAMLreturn(list_polygon_head);
}
Ejemplo n.º 12
0
SRes ml_sevenzip_read(void *object, void **buffer, size_t *size)
{

  CFileInStream *archive_in = (CFileInStream *) object;
  CAMLparam0 ();
  CAMLlocal5 (readable, read, tuple, ml_string, ml_size);

  readable = archive_in->readable;
  read = Field(readable, 0);
  tuple = caml_callback(read, Val_int(*size));
  ml_string = Field(tuple, 0);
  ml_size = Field(tuple, 1);
  *buffer = String_val(ml_string);
  *size = Int_val(ml_size);

  /* The GC might have moved the readable pointer */
  archive_in->readable = readable;

  CAMLreturnT(SRes, SZ_OK);
}
Ejemplo n.º 13
0
static value alloc_sevenzip_entry(CSzArEx db, int i)
{

  CSzFileItem *f = db.db.Files + i;
  CAMLparam0 ();
  CAMLlocal5 (entry, index, name, size, is_directory);

  entry = caml_alloc (4, 0);
  index = Val_int(i);
  name = caml_copy_string(f->Name);
  size = Val_int(f->Size);
  is_directory = Val_bool(f->IsDir);

  Store_field (entry, 0, index);
  Store_field (entry, 1, name);
  Store_field (entry, 2, size);
  Store_field (entry, 3, is_directory);

  CAMLreturn (entry);
}
Ejemplo n.º 14
0
CAMLprim value caml_context_split_r(CAML_R, value thread_no_as_value, value function)
{
#if defined(HAS_MULTICONTEXT) //&& defined(NATIVE_CODE)

  //DUMPROOTS("splitting: before GC-protecting locals");
  CAMLparam1(function);
  //CAMLlocal2(result, open_channels);
  CAMLlocal5(result, open_channels, res, tail, chan);
  //DUMPROOTS("splitting: after GC-protecting locals");

  int can_split = caml_can_split_r(ctx);
  if (! can_split)
    caml_raise_cannot_split_r(ctx);

  int thread_no = Int_val(thread_no_as_value);
  caml_global_context **new_contexts = caml_stat_alloc(sizeof(caml_global_context*) * thread_no);
  char *blob;
  sem_t semaphore;
  int i;
  caml_initialize_semaphore(&semaphore, 0);

  /* CAMLparam0(); CAMLlocal1(open_channels); */
  /* Make sure that the currently-existing channels stay alive until
     after deserialization; we can't keep reference counts within the
     blob, so we pin all alive channels by keeping this list alive: */
/* //if(0){//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
/*   struct channel *channel; */
/*   struct channel **channels; */
/*   int channel_no = 0; */
/*   caml_acquire_global_lock(); */
/*   for (channel = caml_all_opened_channels; */
/*        channel != NULL; */
/*        channel = channel->next) */
/*     channel_no ++; */
/*   channels = caml_stat_alloc(sizeof(struct channel*) * channel_no); */
/*   for (i = 0, channel = caml_all_opened_channels; */
/*        channel != NULL; */
/*        i ++, channel = channel->next){ */
/*     channels[i] = channel; */
/*     DUMP("split-pinning channel %p, with fd %i, refcount %i->%i", channel, (int)channel->fd, channel->refcount, channel->refcount + 1); */
/*     channel->refcount ++; */
/*   } */
/*   caml_release_global_lock(); */

  //open_channels = caml_ml_all_channels_list_r(ctx); // !!!!!!!!!!!!!!!!!!!! This can occasionally cause crashes related to channel picounts.  I certainly messed up something in io.c. //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
//}//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/* //EXPERIMENTAL: BEGIN */
/* { */
/*   struct channel * channel; */

/*   res = Val_emptylist; */
/* caml_acquire_global_lock(); */
/*  int ii, channel_index; */
/*  for(ii = 0; ii < 100; ii ++){ // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
/*   for (channel_index = 0, channel = caml_all_opened_channels; */
/*        channel != NULL; */
/*        channel = channel->next, channel_index ++) */
/*     /\* Testing channel->fd >= 0 looks unnecessary, as */
/*        caml_ml_close_channel changes max when setting fd to -1. *\/ */
/*     { */
/*       DUMP("round %i, channel_index %i", ii, channel_index); */
/*       // !!!!!!!!!!!!! BEGIN */
/*       /\* chan = *\/ caml_alloc_channel_r (ctx, channel); */
/*       // !!!!!!!!!!!!! END */
/*       chan = Val_unit;//caml_alloc_channel_r (ctx, channel); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
/*       tail = res; */
/*       res = caml_alloc_small_r (ctx, 2, 0); */
/*       Field (res, 0) = chan; */
/*       Field (res, 1) = tail; */
/*     } */
/*   DUMP("End of round %i: there are %i channels alive", ii, channel_index); */
/*   DUMP("Before GC'ing"); */
/*   caml_gc_compaction_r(ctx, Val_unit); //!!!!!@@@@@@@@@@@@@ */
/*   DUMP("After GC'ing"); */
/*  } */
/* caml_release_global_lock(); */
/*   //open_channels = Val_unit/\* res *\/; */
/*   open_channels = res; */
/* } */
/* //EXPERIMENTAL: END */

  /* Serialize the context in the main thread, then create threads,
     and in each one of them deserialize it back in parallel:  */
  blob = caml_serialize_context(ctx, function);
  //if(0){//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  caml_split_and_wait_r(ctx, blob, new_contexts, thread_no, &semaphore);
  //}//!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  /* Now we're done with the blob: */
  DUMP("destroying the blob");
  caml_stat_free(blob); // !!!!!!!!!!!!!!!!!!!!!!!!!!! This is needed !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  DUMP("GC'ing after destroying the blob");
  caml_gc_compaction_r(ctx, Val_unit); //!!!!!@@@@@@@@@@@@@
  DUMP("finalizing the semaphore");

  caml_finalize_semaphore(&semaphore);

  /* Copy the contexts we got, and we're done with new_contexts as well: */
  DUMP("copying the new context (descriptors) into the Caml data structure result");
  result = caml_alloc_r(ctx, thread_no, 0);
  caml_gc_compaction_r(ctx, Val_unit); //!!!!!@@@@@@@@@@@@
  for(i = 0; i < thread_no; i ++)
    caml_initialize_r(ctx, &Field(result, i), caml_value_of_context_descriptor(new_contexts[i]->descriptor));
  caml_stat_free(new_contexts);
  DUMP("destroyed the malloced buffer of pointers new_contexts");
  //DUMPROOTS("from parent, after splitting");

  /* caml_acquire_global_lock(); */
  /* for (i = 0; i < channel_no; i ++){ */
  /*   DUMP("split-unpinning channels[i] %p, with fd %i, refcount %i->%i", channels[i], (int)channels[i]->fd, channels[i]->refcount, channels[i]->refcount - 1); */
  /*   channels[i]->refcount --; */
  /* } */
  /* caml_release_global_lock(); */

  CAMLreturn(result);
  //CAMLreturn(Val_unit);
#else
  caml_raise_unimplemented_r(ctx);
  return Val_unit; // unreachable
#endif // #if defined(HAS_MULTICONTEXT) //&& defined(NATIVE_CODE)
}
Ejemplo n.º 15
0
CAMLprim value netcgi2_apache_request_finfo (value rv)
{
    CAMLparam1 (rv);
    request_rec *r = Request_rec_val (rv);
    CAMLlocal5 (v, sb, atime, mtime, ctime);

#if APACHE2
    if (r->finfo.filetype != APR_NOFILE) /* Some statbuf */
    {
        atime = (r->finfo.valid & APR_FINFO_ATIME) ?
                copy_double ((double) apr_time_sec (r->finfo.atime)) :
                copy_double (0.);
        mtime = (r->finfo.valid & APR_FINFO_MTIME) ?
                copy_double ((double) apr_time_sec (r->finfo.mtime)) :
                copy_double (0.);
        ctime = (r->finfo.valid & APR_FINFO_CTIME) ?
                copy_double ((double) apr_time_sec (r->finfo.ctime)) :
                copy_double (0.);

        sb = alloc_small (12, 0);
        Field (sb, 0) = Val_int (r->finfo.device);
        Field (sb, 1) = Val_int (r->finfo.inode);
        Field (sb, 2) =
            cst_to_constr (r->finfo.filetype, file_kind_table,
                           sizeof (file_kind_table) / sizeof (int), 0);
        Field (sb, 3) = Val_int (r->finfo.protection);
        Field (sb, 4) = Val_int (r->finfo.nlink);
        Field (sb, 5) = Val_int (r->finfo.user);
        Field (sb, 6) = Val_int (r->finfo.group);
        Field (sb, 7) = Val_int (0); /* FIXME rdev? */
        Field (sb, 8) = Val_int (r->finfo.size); /* FIXME 64 bit file offsets */

        Field (sb, 9) = atime;
        Field (sb, 10) = mtime;
        Field (sb, 11) = ctime;

        v = alloc (1, 0);		/* The "Some" block. */
        Field (v, 0) = sb;
    }
    else
        v = Val_int (0);		/* None. */

#else /* not APACHE2 */

    if (r->finfo.st_mode)		/* Some statbuf */
    {
        /* This code copied and modified from otherlibs/unix/stat.c. */
        atime = copy_double ((double) r->finfo.st_atime);
        mtime = copy_double ((double) r->finfo.st_mtime);
        ctime = copy_double ((double) r->finfo.st_ctime);

        sb = alloc_small (12, 0);
        Field (sb, 0) = Val_int (r->finfo.st_dev);
        Field (sb, 1) = Val_int (r->finfo.st_ino);
        Field (sb, 2) =
            cst_to_constr (r->finfo.st_mode & S_IFMT, file_kind_table,
                           sizeof (file_kind_table) / sizeof (int), 0);
        Field (sb, 3) = Val_int (r->finfo.st_mode & 07777);
        Field (sb, 4) = Val_int (r->finfo.st_nlink);
        Field (sb, 5) = Val_int (r->finfo.st_uid);
        Field (sb, 6) = Val_int (r->finfo.st_gid);
        Field (sb, 7) = Val_int (r->finfo.st_rdev);
        Field (sb, 8) = Val_int (r->finfo.st_size); /* FIXME: 64 bit file offsets */
        Field (sb, 9) = atime;
        Field (sb, 10) = mtime;
        Field (sb, 11) = ctime;

        v = alloc (1, 0);		/* The "Some" block. */
        Field (v, 0) = sb;
    }
    else
        v = Val_int (0);		/* None. */
#endif /* not APACHE2 */

    CAMLreturn (v);
}
Ejemplo n.º 16
0
CAMLprim value caml_extunix_recvmsg2(value vfd, value vbuf, value ofs, value vlen,
  value vflags)
{
  CAMLparam4(vfd, vbuf, ofs, vlen);
  CAMLlocal5(vres, vlist, v, vx, vsaddr);
  union {
    struct cmsghdr hdr;
    char buf[CMSG_SPACE(sizeof(int)) /* File descriptor passing */
#ifdef EXTUNIX_HAVE_IP_RECVIF
        + CMSG_SPACE(sizeof(struct sockaddr_dl)) /* IP_RECVIF */
#endif
#ifdef EXTUNIX_HAVE_IP_RECVDSTADDR
        + CMSG_SPACE(sizeof(struct in_addr))     /* IP_RECVDSTADDR */
#endif
    ];
  } cmsgbuf;
  struct iovec             iov;
  struct msghdr            msg;
  struct cmsghdr          *cmsg;
  ssize_t                  n;
  size_t                   len;
  char                     iobuf[UNIX_BUFFER_SIZE];
  struct sockaddr_storage  ss;
  int                      sendflags;
#ifdef EXTUNIX_HAVE_IP_RECVIF
  struct sockaddr_dl      *dst = NULL;
#endif

  len = Long_val(vlen);

  memset(&iov, 0, sizeof(iov));
  memset(&msg, 0, sizeof(msg));

  if (len > UNIX_BUFFER_SIZE)
    len = UNIX_BUFFER_SIZE;

  iov.iov_base = iobuf;
  iov.iov_len = len;
  msg.msg_name = &ss;
  msg.msg_namelen = sizeof(ss);
  msg.msg_iov = &iov;
  msg.msg_iovlen = 1;
  msg.msg_control = &cmsgbuf.buf;
  msg.msg_controllen = sizeof(cmsgbuf.buf);
  sendflags = caml_convert_flag_list(vflags, msg_flag_table);

  caml_enter_blocking_section();
  n = recvmsg(Int_val(vfd), &msg, sendflags);
  caml_leave_blocking_section();

  vres = caml_alloc_small(4, 0);

  if (n == -1) {
    uerror("recvmsg", Nothing);
    CAMLreturn (vres);
  }

  vsaddr = my_alloc_sockaddr(&ss);

  memmove(&Byte(vbuf, Long_val(ofs)), iobuf, n);

  vlist = Val_int(0);

  /* Build the variant list vlist */
  for (cmsg = CMSG_FIRSTHDR(&msg); cmsg != NULL;
       cmsg = CMSG_NXTHDR(&msg, cmsg)) {
    if (cmsg->cmsg_level == SOL_SOCKET &&
        cmsg->cmsg_type == SCM_RIGHTS) {
      /* CMSG_DATA is aligned, so the following is cool */
      v = caml_alloc_small(2, TAG_FILEDESCRIPTOR);
      Field(v, 0) = Val_int(*(int *)CMSG_DATA(cmsg));
      Field(v, 1) = vlist;
      vlist = v;
      continue;
    }

#ifdef EXTUNIX_HAVE_IP_RECVIF
    if (cmsg->cmsg_level == IPPROTO_IP &&
        cmsg->cmsg_type == IP_RECVIF) {
      dst = (struct sockaddr_dl *)CMSG_DATA(cmsg);
      v = caml_alloc_small(2, 0);
      vx = caml_alloc_small(1, TAG_IP_RECVIF);
      Field(vx, 0) = Val_int(dst->sdl_index);
      Field(v, 0) = vx;
      Field(v, 1) = vlist;
      vlist = v;
      continue;
    }
#endif
#ifdef EXTUNIX_HAVE_IP_RECVDSTADDR
    if (cmsg->cmsg_level == IPPROTO_IP &&
        cmsg->cmsg_type == IP_RECVDSTADDR) {
      struct in_addr ipdst;
      ipdst = *(struct in_addr *)CMSG_DATA(cmsg);
      v = caml_alloc_small(2, 0);
      vx = caml_alloc_small(1, TAG_IP_RECVDSTADDR);
      Field(vx, 0) = caml_alloc_string(4);
      memcpy(String_val(Field(vx, 0)), &ipdst, 4);
      Field(v, 0) = vx;
      Field(v, 1) = vlist;
      vlist = v;
      continue;
    }
#endif
  }

  /* Now build the result */
  Field(vres, 0) = Val_long(n);
  Field(vres, 1) = vsaddr;
  Field(vres, 2) = vlist;
  Field(vres, 3) = int_to_recvflags(msg.msg_flags);

  CAMLreturn(vres);
}
Ejemplo n.º 17
0
/* given a return value in OCaml land, translate it to 
   the return_val_t C structure
*/ 
return_val_t translate_return_value(value ocaml_result) {
  CAMLparam1(ocaml_result);
  CAMLlocal5(ocaml_shape, ocaml_strides, ocaml_data, ocaml_cur, ocaml_type);
  CAMLlocal1(v);
  
  return_val_t ret;
  
  if (Is_long(ocaml_result)) {
    // In this case, we know that the return code must have been Pass,
    // since the other two return codes have data.
    ret.return_code = RET_PASS;
    ret.results_len = 0;
  } else if (Tag_val(ocaml_result) == RET_FAIL) {
    ret.return_code = RET_FAIL;
    ret.results_len = caml_string_length(Field(ocaml_result, 0));
    ret.error_msg = malloc(ret.results_len + 1);
    strcpy(ret.error_msg, String_val(Field(ocaml_result, 0)));
  } else if (Tag_val(ocaml_result) == RET_SUCCESS) {
    
    ocaml_cur = Field(ocaml_result, 0);
    ret.return_code = RET_SUCCESS;
    ret.results_len = ocaml_list_length(ocaml_cur);
    ret.results = (ret_t*)malloc(sizeof(ret_t) * ret.results_len);
    
    int i, j;
    host_val h; 
    for (i = 0; i < ret.results_len; ++i) {
      v = Field(ocaml_cur, 0);
      h = create_host_val(v);  
      ocaml_cur = Field(ocaml_cur, 1);
      // returning a scalar
      if (value_is_scalar(h)) {

        ret.results[i].is_scalar = 1;
        ocaml_type = (scalar_type)value_type_of(h);
        ret.results[i].data.scalar.ret_type =
            get_scalar_element_type(ocaml_type);

        // WARNING:
        // Tiny Memory Leak Ahead
        // -----------------------
        // When scalar data is returned to the host language
        // on the heap, it should be manually deleted by the
        // host frontend

        if (type_is_bool(ocaml_type)) {
          ret.results[i].data.scalar.ret_scalar_value.boolean = get_bool(h);
        } else if (type_is_int32(ocaml_type)) {
          ret.results[i].data.scalar.ret_scalar_value.int32 = get_int32(h);
        } else if (type_is_int64(ocaml_type)) {
          ret.results[i].data.scalar.ret_scalar_value.int64 = get_int64(h);
        } else if (type_is_float32(ocaml_type)) { 
          ret.results[i].data.scalar.ret_scalar_value.float32 = get_float64(h);
        } else if (type_is_float64(ocaml_type)) {
          ret.results[i].data.scalar.ret_scalar_value.float64 = get_float64(h);
        } else {
          caml_failwith("Unable to return scalar of this type\n");
        }
      } else {
        // Pass the type
        ret.results[i].is_scalar = 0;
        ret.results[i].data.array.ret_type = array_type_of(h);

        // Pass the data
        ret.results[i].data.array.data = get_array_data(h);

        // Build the shape array
        ocaml_shape = value_get_shape(h);
        int shape_len = Wosize_val(ocaml_shape);

        ret.results[i].data.array.shape =
            (int*)malloc(shape_len * sizeof(int));
        ret.results[i].data.array.shape_len = shape_len;
        for (j = 0; j < shape_len; ++j) {
          ret.results[i].data.array.shape[j] = Int_val(Field(ocaml_shape, j));
        }

        // Build the strides array
        ocaml_strides = value_get_strides(h);
        int strides_len = Wosize_val(ocaml_strides);

        ret.results[i].data.array.strides_len = strides_len;
        ret.results[i].data.array.strides =
            (int*)malloc(strides_len * sizeof(int));
        for (j = 0; j < strides_len; ++j) {
          ret.results[i].data.array.strides[j] =
              Int_val(Field(ocaml_strides, j));
        }
      }
    }
  }
  CAMLreturnT(return_val_t, ret);
	
}
Ejemplo n.º 18
0
value read_dump_file(value filename) {
  CAMLparam1(filename);
  CAMLlocal5(ocaml_var, ocaml_list_el1, ocaml_list_el2,
             ocaml_dyn_type, ocaml_dyn_aux);
  CAMLlocal2(ocaml_name, ocaml_hostval);

  printf("opening %s\n", String_val(filename));
  FILE *ifile = fopen(String_val(filename), "r");
  if (ifile == NULL) {
    ocaml_var = Val_int(0);
    CAMLreturn(ocaml_var);
  }

  int num_vars = 0;
  fread(&num_vars, sizeof(int), 1, ifile);
  if (num_vars == 0) {
    ocaml_var = Val_int(0);
    CAMLreturn(ocaml_var);
  }

  printf("parsing vars\n");
  ocaml_list_el2 = caml_alloc_tuple(2);
  int i, j;
  int name_len, shape_len, type, num_bytes;
  int *shape;
  char *name, *data;
  for (i = 0; i < num_vars; ++i) {
    // Allocate the variable tuple of (name, hostval)
    ocaml_var = caml_alloc_tuple(2);

    // Build the name
    fread(&name_len, sizeof(int), 1, ifile);
    ocaml_name = caml_alloc_string(name_len);
    fread(String_val(ocaml_name), sizeof(char), name_len, ifile);
    Store_field(ocaml_var, 0, ocaml_name);
    printf("got var name: %s\n", String_val(ocaml_name));

    // Build the shape
    fread(&shape_len, sizeof(int), 1, ifile);
    shape = (int*)malloc(shape_len * sizeof(int));
    fread(shape, sizeof(int), shape_len, ifile);
    printf("got shape of len %d\n", shape_len);

    // Build the DynType
    fread(&ocaml_dyn_type, sizeof(value), 1, ifile);
    for (j = 0; j < shape_len; ++j) {
      ocaml_dyn_aux = ocaml_dyn_type;
      ocaml_dyn_type = caml_alloc(1, VecT);
      Store_field(ocaml_dyn_type, 0, ocaml_dyn_aux);
    }
    printf("built dyn_type\n");

    // Get the num_bytes
    fread(&num_bytes, sizeof(int), 1, ifile);

    // Get the payload
    data = (char*)malloc(num_bytes);
    fread(data, 1, num_bytes, ifile);
    printf("got payload of %d bytes\n", num_bytes);

    // Build the HostVal
    ocaml_hostval = build_ocaml_hostval(num_bytes, ocaml_dyn_type,
                                        shape, shape_len, data);
    printf("built hostval from inputs\n");
    Store_field(ocaml_var, 1, ocaml_hostval);
    
    // Insert the var into the list
    if (i == 0) {
      Store_field(ocaml_list_el2, 1, Val_int(0));
    } else {
      Store_field(ocaml_list_el2, 1, ocaml_list_el1);
    }
    Store_field(ocaml_list_el2, 0, ocaml_var);
    if (i < num_vars - 1) {
      ocaml_list_el1 = ocaml_list_el2;
      ocaml_list_el2 = caml_alloc_tuple(2);
    }
  }

  fclose(ifile);

  CAMLreturn(ocaml_list_el2);
}
Ejemplo n.º 19
0
CAMLprim value lwt_glib_poll(value val_fds, value val_count, value val_timeout)
{
  gint timeout, lwt_timeout;
  long count;
  int i;
  GPollFD *gpollfd;
  gint events, revents;

  CAMLparam3(val_fds, val_count, val_timeout);
  CAMLlocal5(node, src, node_result, src_result, tmp);

  count = Long_val(val_count);

  g_main_context_dispatch(gc);
  g_main_context_prepare(gc, &max_priority);

  while (fds_count < count + (n_fds = g_main_context_query(gc, max_priority, &timeout, gpollfds, fds_count))) {
    free(gpollfds);
    fds_count = n_fds + count;
    gpollfds = lwt_unix_malloc(fds_count * sizeof (GPollFD));
  }

  /* Clear all revents fields. */
  for (i = 0; i < n_fds + count; i++) gpollfds[i].revents = 0;

  /* Add all Lwt fds. */
  for (i = n_fds, node = val_fds; i < n_fds + count; i++, node = Field(node, 1)) {
    src = Field(node, 0);
    gpollfd = gpollfds + i;
#if defined(LWT_ON_WINDOWS)
    gpollfd->fd = Handle_val(Field(src, 0));
#else
    gpollfd->fd = Int_val(Field(src, 0));
#endif
    events = 0;
    if (Bool_val(Field(src, 1))) events |= G_IO_IN;
    if (Bool_val(Field(src, 2))) events |= G_IO_OUT;
    gpollfd->events = events;
  }

  lwt_timeout = Int_val(val_timeout);
  if (timeout < 0 || (lwt_timeout >= 0 && lwt_timeout < timeout))
    timeout = lwt_timeout;

  /* Do the blocking call. */
  caml_enter_blocking_section();
  g_main_context_get_poll_func(gc)(gpollfds, n_fds + count, timeout);
  caml_leave_blocking_section();

  g_main_context_check(gc, max_priority, gpollfds, n_fds);

  /* Build the result. */
  node_result = Val_int(0);
  for (i = n_fds, node = val_fds; i < n_fds + count; i++, node = Field(node, 1)) {
    gpollfd = gpollfds + i;
    src_result = caml_alloc_tuple(3);
    src = Field(node, 0);
    Field(src_result, 0) = Field(src, 0);
    revents = gpollfd->revents;
    if (revents & G_IO_HUP) {
      /* Treat HUP as ready. There's no point continuing to wait on this FD. */
      if (gpollfd->events & G_IO_IN)
        revents |= G_IO_IN;
      if (gpollfd->events & G_IO_OUT)
        revents |= G_IO_OUT;
    }
    Field(src_result, 1) = Val_bool(revents & G_IO_IN);
    Field(src_result, 2) = Val_bool(revents & G_IO_OUT);
    tmp = caml_alloc_tuple(2);
    Field(tmp, 0) = src_result;
    Field(tmp, 1) = node_result;
    node_result = tmp;
  }

  CAMLreturn(node_result);
}
Ejemplo n.º 20
0
CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout)
{
  /* Event associated to handle */
  DWORD   nEventsCount;
  DWORD   nEventsMax;
  HANDLE *lpEventsDone;

  /* Data for all handles */
  LPSELECTDATA lpSelectData;
  LPSELECTDATA iterSelectData;

  /* Iterator for results */
  LPSELECTRESULT iterResult;

  /* Iterator */
  DWORD i;

  /* Error status */
  DWORD err;

  /* Time to wait */
  DWORD milliseconds;

  /* Is there static select data */
  BOOL  hasStaticData = FALSE;

  /* Wait return */
  DWORD waitRet;

  /* Set of handle */
  SELECTHANDLESET hds;
  DWORD           hdsMax;
  LPHANDLE        hdsData;

  /* Length of each list */
  DWORD readfds_len;
  DWORD writefds_len;
  DWORD exceptfds_len;

  CAMLparam4 (readfds, writefds, exceptfds, timeout);
  CAMLlocal5 (read_list, write_list, except_list, res, l);
  CAMLlocal1 (fd);

  fd_set read, write, except;
  double tm;
  struct timeval tv;
  struct timeval * tvp;

  DEBUG_PRINT("in select");

  err = 0;
  tm = Double_val(timeout);
  if (readfds == Val_int(0) && writefds == Val_int(0) && exceptfds == Val_int(0)) {
    DEBUG_PRINT("nothing to do");
    if ( tm > 0.0 ) {
      enter_blocking_section();
      Sleep( (int)(tm * 1000));
      leave_blocking_section();
    }
    read_list = write_list = except_list = Val_int(0);
  } else {
    if (fdlist_to_fdset(readfds, &read) && fdlist_to_fdset(writefds, &write) && fdlist_to_fdset(exceptfds, &except)) {
      DEBUG_PRINT("only sockets to select on, using classic select");
      if (tm < 0.0) {
        tvp = (struct timeval *) NULL;
      } else {
        tv.tv_sec = (int) tm;
        tv.tv_usec = (int) (1e6 * (tm - (int) tm));
        tvp = &tv;
      }
      enter_blocking_section();
      if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1) {
        err = WSAGetLastError();
        DEBUG_PRINT("Error %ld occurred", err);
      }
      leave_blocking_section();
      if (err) {
        DEBUG_PRINT("Error %ld occurred", err);
        win32_maperr(err);
        uerror("select", Nothing);
      }
      read_list = fdset_to_fdlist(readfds, &read);
      write_list = fdset_to_fdlist(writefds, &write);
      except_list = fdset_to_fdlist(exceptfds, &except);
    } else {
      nEventsCount   = 0;
      nEventsMax     = 0;
      lpEventsDone   = NULL;
      lpSelectData   = NULL;
      iterSelectData = NULL;
      iterResult     = NULL;
      hasStaticData  = 0;
      waitRet        = 0;
      readfds_len    = caml_list_length(readfds);
      writefds_len   = caml_list_length(writefds);
      exceptfds_len  = caml_list_length(exceptfds);
      hdsMax         = MAX(readfds_len, MAX(writefds_len, exceptfds_len));

      hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);

      if (tm >= 0.0)
        {
          milliseconds = 1000 * tm;
          DEBUG_PRINT("Will wait %d ms", milliseconds);
        }
      else
        {
          milliseconds = INFINITE;
        }


      /* Create list of select data, based on the different list of fd to watch */
      DEBUG_PRINT("Dispatch read fd");
      handle_set_init(&hds, hdsData, hdsMax);
      i=0;
      for (l = readfds; l != Val_int(0); l = Field(l, 1))
        {
          fd = Field(l, 0);
          if (!handle_set_mem(&hds, Handle_val(fd)))
            {
              handle_set_add(&hds, Handle_val(fd));
              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_READ, fd, i++);
            }
          else
            {
              DEBUG_PRINT("Discarding handle %x which is already monitor for read", Handle_val(fd));
            }
        }
      handle_set_reset(&hds);

      DEBUG_PRINT("Dispatch write fd");
      handle_set_init(&hds, hdsData, hdsMax);
      i=0;
      for (l = writefds; l != Val_int(0); l = Field(l, 1))
        {
          fd = Field(l, 0);
          if (!handle_set_mem(&hds, Handle_val(fd)))
            {
              handle_set_add(&hds, Handle_val(fd));
              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_WRITE, fd, i++);
            }
          else
            {
              DEBUG_PRINT("Discarding handle %x which is already monitor for write", Handle_val(fd));
            }
        }
      handle_set_reset(&hds);

      DEBUG_PRINT("Dispatch exceptional fd");
      handle_set_init(&hds, hdsData, hdsMax);
      i=0;
      for (l = exceptfds; l != Val_int(0); l = Field(l, 1))
        {
          fd = Field(l, 0);
          if (!handle_set_mem(&hds, Handle_val(fd)))
            {
              handle_set_add(&hds, Handle_val(fd));
              lpSelectData = select_data_dispatch(lpSelectData, SELECT_MODE_EXCEPT, fd, i++);
            }
          else
            {
              DEBUG_PRINT("Discarding handle %x which is already monitor for exceptional", Handle_val(fd));
            }
        }
      handle_set_reset(&hds);

      /* Building the list of handle to wait for */
      DEBUG_PRINT("Building events done array");
      nEventsMax   = list_length((LPLIST)lpSelectData);
      nEventsCount = 0;
      lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);

      iterSelectData = lpSelectData;
      while (iterSelectData != NULL)
        {
          /* Check if it is static data. If this is the case, launch everything
           * but don't wait for events. It helps to test if there are events on
           * any other fd (which are not static), knowing that there is at least
           * one result (the static data).
           */
          if (iterSelectData->EType == SELECT_TYPE_STATIC)
            {
              hasStaticData = TRUE;
            };

          /* Execute APC */
          if (iterSelectData->funcWorker != NULL)
            {
              iterSelectData->lpWorker =
                worker_job_submit(
                                  iterSelectData->funcWorker,
                                  (void *)iterSelectData);
              DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker);
              lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
              nEventsCount++;
            };
          iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
        };

      DEBUG_PRINT("Need to watch %d workers", nEventsCount);

      /* Processing select itself */
      enter_blocking_section();
      /* There are worker started, waiting to be monitored */
      if (nEventsCount > 0)
        {
          /* Waiting for event */
          if (err == 0 && !hasStaticData)
            {
              DEBUG_PRINT("Waiting for one select worker to be done");
              switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
                {
                case WAIT_FAILED:
                  err = GetLastError();
                  break;

                case WAIT_TIMEOUT:
                  DEBUG_PRINT("Select timeout");
                  break;

                default:
                  DEBUG_PRINT("One worker is done");
                  break;
                };
            }

          /* Ordering stop to every worker */
          DEBUG_PRINT("Sending stop signal to every select workers");
          iterSelectData = lpSelectData;
          while (iterSelectData != NULL)
            {
              if (iterSelectData->lpWorker != NULL)
                {
                  worker_job_stop(iterSelectData->lpWorker);
                };
              iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
            };

          DEBUG_PRINT("Waiting for every select worker to be done");
          switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
            {
            case WAIT_FAILED:
              err = GetLastError();
              break;

            default:
              DEBUG_PRINT("Every worker is done");
              break;
            }
        }
      /* Nothing to monitor but some time to wait. */
      else if (!hasStaticData)
        {
          Sleep(milliseconds);
        }
      leave_blocking_section();

      DEBUG_PRINT("Error status: %d (0 is ok)", err);
      /* Build results */
      if (err == 0)
        {
          DEBUG_PRINT("Building result");
          read_list = Val_unit;
          write_list = Val_unit;
          except_list = Val_unit;

          iterSelectData = lpSelectData;
          while (iterSelectData != NULL)
            {
              for (i = 0; i < iterSelectData->nResultsCount; i++)
                {
                  iterResult = &(iterSelectData->aResults[i]);
                  l = alloc_small(2, 0);
                  Store_field(l, 0, find_handle(iterResult, readfds, writefds, exceptfds));
                  switch (iterResult->EMode)
                    {
                    case SELECT_MODE_READ:
                      Store_field(l, 1, read_list);
                      read_list = l;
                      break;
                    case SELECT_MODE_WRITE:
                      Store_field(l, 1, write_list);
                      write_list = l;
                      break;
                    case SELECT_MODE_EXCEPT:
                      Store_field(l, 1, except_list);
                      except_list = l;
                      break;
                    }
                }
              /* We try to only process the first error, bypass other errors */
              if (err == 0 && iterSelectData->EState == SELECT_STATE_ERROR)
                {
                  err = iterSelectData->nError;
                }
              iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
            }
        }

      /* Free resources */
      DEBUG_PRINT("Free selectdata resources");
      iterSelectData = lpSelectData;
      while (iterSelectData != NULL)
        {
          lpSelectData = iterSelectData;
          iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
          select_data_free(lpSelectData);
        }
      lpSelectData = NULL;

      /* Free allocated events/handle set array */
      DEBUG_PRINT("Free local allocated resources");
      caml_stat_free(lpEventsDone);
      caml_stat_free(hdsData);

      DEBUG_PRINT("Raise error if required");
      if (err != 0)
        {
          win32_maperr(err);
          uerror("select", Nothing);
        }
    }
  }

  DEBUG_PRINT("Build final result");
  res = alloc_small(3, 0);
  Store_field(res, 0, read_list);
  Store_field(res, 1, write_list);
  Store_field(res, 2, except_list);

  DEBUG_PRINT("out select");

  CAMLreturn(res);
}
Ejemplo n.º 21
0
CAMLprim value bigstring_recvmmsg_assume_fd_is_nonblocking_stub(
  value v_fd, value v_iovecs, value v_count, value v_srcs, value v_lens)
{
  CAMLparam5(v_fd, v_iovecs, v_count, v_srcs, v_lens);
  CAMLlocal5(v_iovec, v_buf, v_pos, v_len, v_sockaddrs);
  size_t total_len = 0;
  struct mmsghdr hdrs[Long_val(v_count)];
  union sock_addr_union addrs[Long_val(v_count)];
  struct iovec iovecs[Long_val(v_count)];
  unsigned i;
  ssize_t n_read;
  int save_source_addresses;
  int fd;
  unsigned int count;

  save_source_addresses = Is_block(v_srcs);
  fd = Int_val(v_fd);
  count = (unsigned int) Long_val(v_count);
  if (count != Long_val(v_count)) {
    caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
                          "v_count exceeds unsigned int");
  }
  if (!Is_block(v_lens)) {
    caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
                          "v_lens is not an array");
  }
  if (Wosize_val(v_lens) < count) {
    caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
                          "length v_lens < count");
  }

  for (i = 0; i < count; i++) {
    hdrs[i].msg_hdr.msg_name = (save_source_addresses ? &addrs[i].s_gen : 0);
    hdrs[i].msg_hdr.msg_namelen = sizeof(addrs[i]);

    v_iovec = Field(v_iovecs, i);
    v_buf = Field(v_iovec, 0);
    v_pos = Field(v_iovec, 1);
    v_len = Field(v_iovec, 2);

    iovecs[i].iov_base = get_bstr(v_buf, v_pos);
    iovecs[i].iov_len = Long_val(v_len);
    total_len += iovecs[i].iov_len;

    hdrs[i].msg_hdr.msg_iov = &iovecs[i];
    hdrs[i].msg_hdr.msg_iovlen = 1;

    hdrs[i].msg_hdr.msg_control = 0;
    hdrs[i].msg_hdr.msg_flags = 0;
  }

  if (total_len > THREAD_IO_CUTOFF) {
    caml_enter_blocking_section();
      n_read = recvmmsg(fd, hdrs, count, 0, 0);
    caml_leave_blocking_section();
  }
  else {
    n_read = recvmmsg(fd, hdrs, count, 0, 0);
  }

  if (n_read > count) {
    caml_failwith("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
                  "recvmmsg unexpectedly returned n_read > count");
  }

  if (n_read == -1) {
    uerror("recvmmsg_assume_fd_is_nonblocking", Nothing);
  }
  else {
    if (save_source_addresses) {
      v_sockaddrs = Field(v_srcs, 0);
      if (!Is_block(v_sockaddrs)) {
        caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
                              "v_sockaddrs is not an array");
      }
      if (Wosize_val(v_sockaddrs) < count) {
        caml_invalid_argument("bigstring_recvmmsg_assume_fd_is_nonblocking_stub: "
                              "length v_sockaddrs < count");
      }

      for (i = 0; i < n_read; i++) {
        value addr = alloc_sockaddr(&addrs[i], hdrs[i].msg_hdr.msg_namelen, -1);
        Store_field(v_sockaddrs, i, addr);
      }
    }
    for (i = 0; i < n_read; i++) {
      Field(v_lens, i) = Val_long(hdrs[i].msg_len);
    }
  }
  CAMLreturn(Val_long(n_read));
}