C++ CAMLlocal2函数代码示例

CAMLprim value pattern_font_sort(value plist, value trim)
{
  CAMLparam0();
  CAMLlocal2(res, nres);
  FcPattern *pat;
  FcFontSet *match;
  FcResult result;
  int i;

  pat = FcPattern_val(plist);
  FcConfigSubstitute(NULL, pat, FcMatchPattern);
  FcDefaultSubstitute(pat);

  match = FcFontSort(NULL, pat, Bool_val(trim) ? FcTrue : FcFalse, NULL, &result);

  /* Reconstruire la belle liste */
  res = Val_int(0); /* empty list */
  for(i = match->nfont; i >= 0; i--) {
    nres = caml_alloc(2, 0);
    Store_field(nres, 0, caml_copy_pattern(match->fonts[i]));
    Store_field(nres, 1, res);
    res = nres;
  }

  FcFontSetDestroy(match);
  FcPatternDestroy(pat);
  CAMLreturn(res);
}

CAMLprim value stub_sem_init(value c) {
  CAMLparam1(c);
  CAMLlocal2(result, perrno);
  int rc, lerrno;
  sem_t *s;

  rc = -1;
  caml_release_runtime_system();
  if (NULL != (s = malloc(sizeof(sem_t)))) {
    rc = sem_init(s, 0, Int_val(c));
    lerrno = errno;
  } else {
    lerrno = ENOMEM;
    free(s);
  }
  caml_acquire_runtime_system();

  if (0 != rc) {
    goto ERROR;
  }

  result = caml_alloc(1, 0); // Result.Ok
  Store_field(result, 0, caml_copy_semaphore(s));
  goto END;

ERROR:
  perrno = caml_alloc(2, 0);
  Store_field(perrno, 0, eunix); // `EUnix
  Store_field(perrno, 1, unix_error_of_code(lerrno));
  result = caml_alloc(1, 1); // Result.Error
  Store_field(result, 0, perrno);

END:
  CAMLreturn(result);
}

CAMLprim value netsys_return_all_not_event_fd(value nev)
{
#ifdef HAVE_POLL
    struct not_event *ne;
    CAMLparam1(nev);
    CAMLlocal2(v1, v2);

    ne = *(Not_event_val(nev));
    v1 = Val_int(0);
    if (ne->fd1 != -1) {
	v2 = caml_alloc(2,0);
	Store_field(v2, 0, Val_int(ne->fd1));
	Store_field(v2, 1, v1);
	v1 = v2;
    };
    if (ne->fd2 != -1) {
	v2 = caml_alloc(2,0);
	Store_field(v2, 0, Val_int(ne->fd2));
	Store_field(v2, 1, v1);
	v1 = v2;
    };
    CAMLreturn(v1);
#else
    return Val_int(0);
#endif
}

CAMLprim value
stub_pcap_next (value p_p)
{
	CAMLparam1 (p_p);
	CAMLlocal2 (ret, ml_data);
	pcap_t *p;
	const u_char *packet;
	struct pcap_pkthdr header;

	p = (pcap_t *) p_p;

	packet = pcap_next(p, &header);

	if (packet == NULL) {
		raise_error ("No next packet received");
	}

	ret = caml_alloc (3, 0);

	Store_field (ret, 0, Val_int (header.len));
	Store_field (ret, 1, Val_int (header.caplen));

	ml_data = caml_alloc_string (header.caplen);
	memcpy (String_val(ml_data), packet, header.caplen);
	Store_field (ret, 2, ml_data);

	CAMLreturn (ret);
}

CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol)
{
  CAMLparam2 (filename, symbol);
  CAMLlocal2 (res, v);
  void *handle;
  char *p;

  /* TODO: dlclose in case of error... */

  p = caml_strdup(String_val(filename));
  caml_enter_blocking_section();
  handle = caml_dlopen(p, 1, 1);
  caml_leave_blocking_section();
  caml_stat_free(p);

  if (NULL == handle) {
    res = caml_alloc(1,1);
    v = caml_copy_string(caml_dlerror());
    Store_field(res, 0, v);
  } else {
    res = caml_alloc(1,0);
    v = caml_natdynlink_run(handle, symbol);
    Store_field(res, 0, v);
  }
  CAMLreturn(res);
}

CAMLprim value stub_sem_wait(value sem) {
  CAMLparam1(sem);
  CAMLlocal2(result, perrno);
  int rc, lerrno;
  sem_t *s;

  s = *Sem_val(sem);
  if (NULL == s) {
    lerrno = EINVAL;
    goto ERROR;
  }

  caml_release_runtime_system();
  rc = sem_wait(s);
  lerrno = errno;
  caml_acquire_runtime_system();

  if (0 != rc) {
    goto ERROR;
  }

  result = caml_alloc(1, 0); // Result.Ok
  Store_field(result, 0, Val_unit);
  goto END;

ERROR:
  perrno = caml_alloc(2, 0);
  Store_field(perrno, 0, eunix); // `EUnix
  Store_field(perrno, 1, unix_error_of_code(lerrno));
  result = caml_alloc(1, 1); // Result.Error
  Store_field(result, 0, perrno);

END:
  CAMLreturn(result);
}

value caml_from_fcvalue(FcValue v)
{
  CAMLparam0();
  CAMLlocal2(res, arr);
  switch(v.type) {
    case FcTypeVoid:
      res = Val_int(0);
      break;
    case FcTypeInteger:
      res = caml_alloc(1, 0);
      Store_field(res, 0, Val_int(v.u.i));
      break;
    case FcTypeDouble:
      res = caml_alloc(1, 1);
      Store_field(res, 0, caml_copy_double(v.u.d));
      break;
    case FcTypeString:
      res = caml_alloc(1, 2);
      Store_field(res, 0, caml_copy_string((char *)v.u.s));
      break;
    case FcTypeBool:
      res = caml_alloc(1, 3);
      Store_field(res, 0, v.u.b ? Val_true : Val_false);
      break;
    case FcTypeMatrix:
      res = caml_from_fcmatrix(v.u.m);
    default:
      /* caml_invalid_argument ? */
      break;
  }
  CAMLreturn(res);
}

CAMLprim value
tun_opendev(value devname, value kind, value pi, value persist, value user, value group)
{
  CAMLparam5(devname, kind, pi, persist, user);
  CAMLxparam1(group);
  CAMLlocal2(res, dev_caml);

  char dev[IFNAMSIZ];
  int fd;

#if defined (__APPLE__) && defined (__MACH__)
  if (caml_string_length(devname) < 4)
    caml_failwith("On MacOSX, you need to specify the name of the device, e.g. tap0");
#endif

  memset(dev, 0, sizeof dev);
  memcpy(dev, String_val(devname), caml_string_length(devname));

  // All errors are already checked by tun_alloc, returned fd is valid
  // otherwise it would have crashed before
  fd = tun_alloc(dev, Int_val(kind), Bool_val(pi), Bool_val(persist), Int_val(user), Int_val(group));

  res = caml_alloc_tuple(2);
  dev_caml = caml_copy_string(dev);

  Store_field(res, 0, Val_int(fd));
  Store_field(res, 1, dev_caml);

  CAMLreturn(res);
}

CAMLprim value
iface_addr(value ifap)
{
  CAMLparam0();
  CAMLlocal2(ret, opt);

  struct ifaddrs *c_ifap = (struct ifaddrs *)ifap;

  if(c_ifap->ifa_addr == NULL)
    CAMLreturn(Val_int(0));

  uint16_t family = c_ifap->ifa_addr->sa_family;

  if (family != AF_INET)
    opt = Val_int(0);
  else
    {
      opt = caml_alloc(1, 0);
      ret = caml_alloc(3, 0);
      Store_field(ret, 0, caml_copy_int32(ipv4_of_sockaddr(c_ifap->ifa_addr)));
      Store_field(ret, 1, caml_copy_int32(ipv4_of_sockaddr(c_ifap->ifa_netmask)));
#if defined (__linux__)
      Store_field(ret, 2, caml_copy_int32(ipv4_of_sockaddr(c_ifap->ifa_flags & IFF_BROADCAST ?
                                                           c_ifap->ifa_ifu.ifu_broadaddr :
                                                           c_ifap->ifa_ifu.ifu_dstaddr
                                                           )));
#elif defined(__APPLE__) && defined (__MACH__)
      Store_field(ret, 2, caml_copy_int32(ipv4_of_sockaddr(c_ifap->ifa_dstaddr)));
#endif
      Store_field(opt, 0, ret);

    }

  CAMLreturn(opt);
}

CAMLprim value caml_zmq_poll(value poll, value timeout) {
    CAMLparam2 (poll, timeout);
    CAMLlocal2 (events, some);
    int n = CAML_ZMQ_Poll_val(poll)->num_elems;
    zmq_pollitem_t *items = CAML_ZMQ_Poll_val(poll)->poll_items;
    int tm = Int_val(timeout);

    caml_release_runtime_system();
    int num_event_sockets = zmq_poll(items, n, tm);
    caml_acquire_runtime_system();

    caml_zmq_raise_if(num_event_sockets == -1);
    events = caml_alloc(n, 0);

    int i;
    for(i = 0; i < n; i++) {
        if (!((items[i].revents & ZMQ_POLLIN) || (items[i].revents & ZMQ_POLLOUT))) {
          Store_field(events, i, Val_int(0)); /* None */
        } else {
          some = caml_alloc(1, 0);
          Store_field(some, 0, CAML_ZMQ_Val_mask(items[i].revents));
          Store_field(events, i, some);
        }
    }

    CAMLreturn (events);
}

static int call_back (
   HRASCONN 		hrasconn,
   int 			istate,
   char 		state[],
   int 			ierror,
   char 		error[] ) 
{
   value_t	args[6], ret;
   CAMLparam0   ();
   CAMLlocal2	(v_state, v_error);

   if ( *cb_info.p_closure == 0 )
      return -1;

   v_state = copy_string ( state?state:"" );
   v_error = copy_string ( error?error:"" );

   args[0] = Val_int (LOWORD(hrasconn));
   args[1] = Val_int (HIWORD(hrasconn));
   args[2] = Val_int ( istate );
   args[3] = v_state;
   args[4] = Val_int ( error );
   args[5] = v_error;

   ret = callbackN ( *cb_info.p_closure, 6, args );

   CAMLreturn ( Bool_val ( ret ) );
   return 0;  /* dummy ! */
}

CAMLprim value
stub_start_info_get(value unit)
{
  CAMLparam1(unit);
  CAMLlocal2(result, tmp);
  char buf[MAX_GUEST_CMDLINE+1];

  result = caml_alloc_tuple(16);
  memcpy(buf, start_info.magic, sizeof(start_info.magic));
  buf[sizeof(start_info.magic)] = 0;
  tmp = caml_copy_string(buf);
  Store_field(result, 0, tmp);
  Store_field(result, 1, Val_int(start_info.nr_pages));
  Store_field(result, 2, Val_int(start_info.shared_info));
  Store_field(result, 3, Val_int(start_info.flags));
  Store_field(result, 4, Val_int(start_info.store_mfn));
  Store_field(result, 5, Val_int(start_info.store_evtchn));
  Store_field(result, 6, Val_int(start_info.console.domU.mfn));
  Store_field(result, 7, Val_int(start_info.console.domU.evtchn));
  Store_field(result, 8, Val_int(start_info.pt_base));
  Store_field(result, 9, Val_int(start_info.nr_pt_frames));
  Store_field(result, 10, Val_int(start_info.mfn_list));
  Store_field(result, 11, Val_int(start_info.mod_start));
  Store_field(result, 12, Val_int(start_info.mod_len));
  memcpy(buf, start_info.cmd_line, MAX_GUEST_CMDLINE);
  buf[MAX_GUEST_CMDLINE] = 0;
  tmp = caml_copy_string(buf);
  Store_field(result, 13, tmp);
  Store_field(result, 14, Val_int(start_info.first_p2m_pfn));
  Store_field(result, 15, Val_int(start_info.nr_p2m_frames));

  CAMLreturn(result);
}

/* Convert the raw backtrace to a data structure usable from OCaml */
CAMLprim value caml_convert_raw_backtrace_slot(value backtrace_slot)
{
  CAMLparam1(backtrace_slot);
  CAMLlocal2(p, fname);
  struct caml_loc_info li;

  if (!caml_debug_info_available())
    caml_failwith("No debug information available");

  caml_extract_location_info(caml_raw_backtrace_slot_val(backtrace_slot), &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);
  }

  CAMLreturn(p);
}

static value Val_physinfo(libxl_physinfo *c_val)
{
	CAMLparam0();
	CAMLlocal2(v, hwcap);
	int i;

	hwcap = caml_alloc_tuple(8);
	for (i = 0; i < 8; i++)
		Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i]));

	v = caml_alloc_tuple(11);
	Store_field(v, 0, Val_int(c_val->threads_per_core));
	Store_field(v, 1, Val_int(c_val->cores_per_socket));
	Store_field(v, 2, Val_int(c_val->max_cpu_id));
	Store_field(v, 3, Val_int(c_val->nr_cpus));
	Store_field(v, 4, Val_int(c_val->cpu_khz));
	Store_field(v, 5, caml_copy_int64(c_val->total_pages));
	Store_field(v, 6, caml_copy_int64(c_val->free_pages));
	Store_field(v, 7, caml_copy_int64(c_val->scrub_pages));
	Store_field(v, 8, Val_int(c_val->nr_nodes));
	Store_field(v, 9, hwcap);
	Store_field(v, 10, caml_copy_int32(c_val->phys_cap));

	CAMLreturn(v);
}

static value find_handle(LPSELECTRESULT iterResult, value readfds, value writefds, value exceptfds)
{
  CAMLparam3(readfds, writefds, exceptfds);
  CAMLlocal2(result, list);
  int i;

  switch( iterResult->EMode )
  {
    case SELECT_MODE_READ:
      list = readfds;
      break;
    case SELECT_MODE_WRITE:
      list = writefds;
      break;
    case SELECT_MODE_EXCEPT:
      list = exceptfds;
      break;
  };

  for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i )
  {
    list = Field(list, 1);
  }

  if (list == Val_unit)
    failwith ("select.c: original file handle not found");

  result = Field(list, 0);

  CAMLreturn( result );
}