C++ caml_named_value函数代码示例

CAMLprim value ocaml_f0r_dlopen(value fname)
{
  CAMLparam1(fname);
  CAMLlocal1(ans);
  plugin_t *p = malloc(sizeof(plugin_t));

  p->handle = dlopen(String_val(fname), RTLD_LAZY);
  if (!p->handle) { free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->init = dlsym(p->handle, "f0r_init");
  if (!p->init) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->deinit = dlsym(p->handle, "f0r_deinit");
  if (!p->deinit) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->get_plugin_info = dlsym(p->handle, "f0r_get_plugin_info");
  if (!p->get_plugin_info) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->get_param_info = dlsym(p->handle, "f0r_get_param_info");
  if (!p->get_param_info) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->construct = dlsym(p->handle, "f0r_construct");
  if (!p->construct) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->destruct = dlsym(p->handle, "f0r_destruct");
  if (!p->destruct) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->get_param_value = dlsym(p->handle, "f0r_get_param_value");
  if (!p->get_param_value) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->set_param_value = dlsym(p->handle, "f0r_set_param_value");
  if (!p->set_param_value) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->update = dlsym(p->handle, "f0r_update");
  p->update2 = dlsym(p->handle, "f0r_update2");
  if (!p->update && !p->update2) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }

  p->init();
  ans = caml_alloc_custom(&plugin_ops, sizeof(plugin_t*), 0, 1);
  Plugin_val(ans) = p;

  CAMLreturn(ans);
}

 void zompInitCamlCallbacks() {
     isBoundCB = caml_named_value("isBound");
     lookupCB = caml_named_value("lookup");
     parseCB = caml_named_value("parse");
     getCounterValueInt = caml_named_value("zompCommonGetCounterValueInt");
     getCounterValueFloat = caml_named_value("zompCommonGetCounterValueFloat");
 }

static uint64 on_state_change (utp_callback_arguments *a)
{
  CAMLparam0 ();
  value *cb;
  static value *on_connect_fun = NULL;
  static value *on_writable_fun = NULL;
  static value *on_eof_fun = NULL;
  static value *on_close_fun = NULL;

  if (on_connect_fun == NULL) on_connect_fun = caml_named_value ("utp_on_connect");
  if (on_writable_fun == NULL) on_writable_fun = caml_named_value ("utp_on_writable");
  if (on_eof_fun == NULL) on_eof_fun = caml_named_value ("utp_on_eof");
  if (on_close_fun == NULL) on_close_fun = caml_named_value ("utp_on_close");
  switch (a->state) {
    case UTP_STATE_CONNECT:
      cb = on_connect_fun;
      break;
    case UTP_STATE_WRITABLE:
      cb = on_writable_fun;
      break;
    case UTP_STATE_EOF:
      cb = on_eof_fun;
      break;
    case UTP_STATE_DESTROYING:
      UTP_DEBUG ("destroying socket");
      cb = on_close_fun;
      break;
    default:
      UTP_DEBUG ("unknown state change: %d", a->state);
      cb = NULL;
      break;
  }
  if (cb) caml_callback (*cb, Val_utp_socket (a->socket));
  CAMLreturn (0);
}

CAMLprim value ocaml_ssl_embed_socket(value socket_, value context)
{
  CAMLparam1(context);
  CAMLlocal1(block);
#ifdef Socket_val
  SOCKET socket = Socket_val(socket_);
#else
  int socket = Int_val(socket_);
#endif
  SSL_CTX *ctx = Ctx_val(context);
  SSL *ssl;

  block = caml_alloc_custom(&socket_ops, sizeof(SSL*), 0, 1);

  if (socket < 0)
    caml_raise_constant(*caml_named_value("ssl_exn_invalid_socket"));
  caml_enter_blocking_section();
  ssl = SSL_new(ctx);
  if (!ssl)
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_handler_error"));
  }
  SSL_set_fd(ssl, socket);
  caml_leave_blocking_section();
  SSL_val(block) = ssl;

  CAMLreturn(block);
}

CAMLprim value ocaml_gstreamer_appsrc_push_buffer_data(value _as, value _buf)
{
  CAMLparam2(_as, _buf);
  int buflen = Caml_ba_array_val(_buf)->dim[0];
  appsrc *as = Appsrc_val(_as);
  GstBuffer *gstbuf;
  GstMapInfo map;
  GstFlowReturn ret;
  gboolean bret;

  caml_release_runtime_system();
  gstbuf = gst_buffer_new_and_alloc(buflen);
  bret = gst_buffer_map(gstbuf, &map, GST_MAP_WRITE);
  caml_acquire_runtime_system();

  if(!bret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
  memcpy(map.data, (unsigned char*)Caml_ba_data_val(_buf), buflen);

  caml_release_runtime_system();
  gst_buffer_unmap(gstbuf, &map);
  ret = gst_app_src_push_buffer(as->appsrc, gstbuf);
  caml_acquire_runtime_system();

  if (ret != GST_FLOW_OK) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
  CAMLreturn(Val_unit);
}

CAMLprim value ocaml_ssl_ctx_init_ec_from_named_curve(value context, value curve_name)
{
  CAMLparam2(context, curve_name);
  EC_KEY *ecdh = NULL;
  int nid = 0;
  SSL_CTX *ctx = Ctx_val(context);
  char *ec_curve_name = String_val(curve_name);

  if(*ec_curve_name == 0)
    caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));

  nid = OBJ_sn2nid(ec_curve_name);
  if(nid == 0){
    caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));
  }

  caml_enter_blocking_section();
  ecdh = EC_KEY_new_by_curve_name(nid);
  if(ecdh != NULL){
    if(SSL_CTX_set_tmp_ecdh(ctx,ecdh) != 1){
      caml_leave_blocking_section();
      caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));
    }
    SSL_CTX_set_options(ctx, SSL_OP_SINGLE_ECDH_USE);
    caml_leave_blocking_section();
    EC_KEY_free(ecdh);
  }
  else{
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));
  }
  CAMLreturn(Val_unit);
}

CAMLprim value ocaml_ssl_ctx_init_dh_from_file(value context, value dh_file_path)
{
  CAMLparam2(context, dh_file_path);
  DH *dh = NULL;
  SSL_CTX *ctx = Ctx_val(context);
  char *dh_cfile_path = String_val(dh_file_path);

  if(*dh_cfile_path == 0)
    caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error"));

  dh = load_dh_param(dh_cfile_path);
  caml_enter_blocking_section();
  if (dh != NULL){
    if(SSL_CTX_set_tmp_dh(ctx,dh) != 1){
      caml_leave_blocking_section();
      caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error"));
    }
    SSL_CTX_set_options(ctx, SSL_OP_SINGLE_DH_USE);
    caml_leave_blocking_section();
    DH_free(dh);
  }
  else{
      caml_leave_blocking_section();
      caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error"));
  }
  CAMLreturn(Val_unit);
}

CAMLprim value ocaml_ssl_ctx_use_certificate(value context, value cert, value privkey)
{
  CAMLparam3(context, cert, privkey);
  SSL_CTX *ctx = Ctx_val(context);
  char *cert_name = String_val(cert);
  char *privkey_name = String_val(privkey);

  caml_enter_blocking_section();
  if (SSL_CTX_use_certificate_chain_file(ctx, cert_name) <= 0)
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_certificate_error"));
  }
  if (SSL_CTX_use_PrivateKey_file(ctx, privkey_name, SSL_FILETYPE_PEM) <= 0)
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_private_key_error"));
  }
  if (!SSL_CTX_check_private_key(ctx))
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_unmatching_keys"));
  }
  caml_leave_blocking_section();

  CAMLreturn(Val_unit);
}

CAMLprim value caml_sqlite3_init(value __unused v_unit)
{
  caml_sqlite3_InternalError = caml_named_value("Sqlite3.InternalError");
  caml_sqlite3_Error = caml_named_value("Sqlite3.Error");
  caml_sqlite3_RangeError = caml_named_value("Sqlite3.RangeError");
  return Val_unit;
}

CAMLprim value PQocaml_init(value __unused v_unit)
{
  v_empty_string = caml_alloc_string(0);
  caml_register_generational_global_root(&v_empty_string);
  v_exc_Oid = caml_named_value("Postgresql.Oid");
  v_null_param = caml_named_value("Postgresql.null");
  return Val_unit;
}

CAMLprim value camltk_init(value v)
{
  /* Initialize the OCaml pointers */
  if (tkerror_exn == NULL)
    tkerror_exn = caml_named_value("tkerror");
  if (handler_code == NULL)
    handler_code = caml_named_value("camlcb");
  return Val_unit;
}

value caml_db_init(value v){
  CAMLparam1(v);
  if (caml_db_exn == NULL) 
    caml_db_exn = caml_named_value("dberror");
  if (caml_key_exists_exn == NULL) 
    caml_key_exists_exn = caml_named_value("keyexists");
  if (caml_db_run_recovery_exn == NULL) 
    caml_db_run_recovery_exn = caml_named_value("dbrunrecovery");
  CAMLreturn (Val_unit);
}

void ast_init(void) {
  if (ast_inited) return;

  ast_inited = 1;

  ocaml_mk_ast_info    = caml_named_value("mk_ast_info");
  ocaml_print_ast_node = caml_named_value("print_ast_node"); 
  ocaml_get_prim       = caml_named_value("get_prim");
  ocaml_mk_formal_args = caml_named_value("mk_formal_args");
  ocaml_mk_actual_args = caml_named_value("mk_actual_args");
}

CAMLprim value ocaml_gstreamer_appsink_pull_buffer(value _as, value string_mode)
{
  CAMLparam1(_as);
  CAMLlocal1(ans);
  appsink *as = Appsink_val(_as);
  GstSample *gstsample;
  GstBuffer *gstbuf;
  GstMapInfo map;
  intnat len;
  gboolean ret;

  caml_release_runtime_system();
  gstsample = gst_app_sink_pull_sample(as->appsink);
  caml_acquire_runtime_system();

  if (!gstsample)
    {
      if (gst_app_sink_is_eos(as->appsink))
        caml_raise_constant(*caml_named_value("gstreamer_exn_eos"));
      else
        caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
    }

  caml_release_runtime_system();
  gstbuf = gst_sample_get_buffer(gstsample);
  caml_acquire_runtime_system();

  if (!gstbuf) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));

  caml_release_runtime_system();
  ret = gst_buffer_map(gstbuf, &map, GST_MAP_READ);
  caml_acquire_runtime_system();

  if (!ret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));

  len = map.size;
  if (string_mode == Val_false) {
    ans = caml_ba_alloc(CAML_BA_C_LAYOUT | CAML_BA_UINT8, 1, NULL, &len);
    memcpy(Caml_ba_data_val(ans), map.data, len);
  } else {
    ans = caml_alloc_string(len);
    memcpy(String_val(ans), map.data, len);
  }

  caml_release_runtime_system();
  gst_buffer_unmap(gstbuf, &map);
  gst_sample_unref(gstsample);
  caml_acquire_runtime_system();

  CAMLreturn(ans);
}

CAMLprim value caml_bjack_read(value device, value len)
{
    CAMLparam2(device,len);
    CAMLlocal1(ans);
    int n = Int_val(len) ;
    char* buf = malloc(n) ;
    jack_driver_t* drv = Bjack_drv_val(device);
    long ret;

    if (drv->num_input_channels > 0)
    {
        caml_enter_blocking_section();
        ret = JACK_Read(drv,(unsigned char *)buf,n);
        caml_leave_blocking_section();
    }
    else
    {
        caml_raise_constant(*caml_named_value("bio2jack_exn_too_many_input_channels"));
    }

    if (ret < 0) caml_failwith("jack_read");

    ans = caml_alloc_string(ret);
    memcpy(String_val(ans),buf,ret);
    free(buf);

    CAMLreturn(ans);
}