C++ CAMLlocal1函数代码示例

CAMLprim value stub_string_of_header(value tid, value rid, value ty, value len)
{
	CAMLparam4(tid, rid, ty, len);
	CAMLlocal1(ret);
	struct xsd_sockmsg xsd = {
		.type = Int_val(ty),
		.tx_id = Int_val(tid),
		.req_id = Int_val(rid),
		.len = Int_val(len),
	};

	ret = caml_alloc_string(sizeof(struct xsd_sockmsg));
	memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg));

	CAMLreturn(ret);
}

extern CAMLprim
value kc_exists(value caml_db, value key)
{
  CAMLparam2(caml_db, key);
  CAMLlocal1(val);

  KCDB* db = get_db(caml_db);
  if (! kcdbaccept(db,
    String_val(key), caml_string_length(key),
    exists_some_value, exists_no_value, &val, 0
  )) {
     RAISE(kcdbemsg(db));
  }
  
  CAMLreturn(val);
}

CAMLprim value caml_picosat_sat(value limit) {
    CAMLparam1 (limit);
    CAMLlocal1( res );
    switch (picosat_sat(Int_val(limit))) {
    case PICOSAT_UNSATISFIABLE :
        res = Val_int(-1) ;
        break ;
    case PICOSAT_SATISFIABLE :
        res = Val_int(1) ;
        break ;
    case PICOSAT_UNKNOWN :
        res = Val_int(0) ;
        break ;
    }
    CAMLreturn(res);
}

value alpm_to_caml_list ( alpm_list_t * list, alpm_elem_conv converter )
{
    CAMLparam0();
    CAMLlocal1( cell );

    if ( list ) {
        cell = caml_alloc( 2, 0 );
        Store_field( cell, 0, (*converter)( list->data ));
        Store_field( cell, 1, alpm_to_caml_list( list->next, converter ));
    }
    else {
        cell = Val_int( 0 );
    }

    CAMLreturn( cell );
}

CAMLprim value stub_xc_gntshr_open(void)
{
	CAMLparam0();
	CAMLlocal1(result);
#ifdef HAVE_GNTSHR
	xc_gntshr *xgh;

	xgh = xc_gntshr_open(NULL, 0);
	if (NULL == xgh)
		failwith_xc(NULL);
	result = (value)xgh;
#else
	gntshr_missing();
#endif
	CAMLreturn(result);
}

static value
Val_SDL_RendererInfo(SDL_RendererInfo * info)
{
#if 0
    Uint32 flags;               /**< Supported ::SDL_RendererFlags */
    Uint32 num_texture_formats; /**< The number of available texture formats */
    Uint32 texture_formats[16]; /**< The available texture formats */
#endif
    CAMLparam0();
    CAMLlocal1(ret);
    ret = caml_alloc(3, 0);
    Store_field(ret, 0, caml_copy_string(info->name));
    Store_field(ret, 1, Val_int(info->max_texture_width));
    Store_field(ret, 2, Val_int(info->max_texture_height));
    CAMLreturn(ret);
}

CAMLprim value caml_sys_read_directory(value path)
{
  CAMLparam1(path);
  CAMLlocal1(result);
  struct ext_table tbl;

  caml_ext_table_init(&tbl, 50);
  if (caml_read_directory(String_val(path), &tbl) == -1){
    caml_ext_table_free(&tbl, 1);
    caml_sys_error(path);
  }
  caml_ext_table_add(&tbl, NULL);
  result = caml_copy_string_array((char const **) tbl.contents);
  caml_ext_table_free(&tbl, 1);
  CAMLreturn(result);
}

CAMLprim value stub_xc_gntshr_munmap(value xgh, value share) {
	CAMLparam2(xgh, share);
	CAMLlocal1(ml_map);
#ifdef HAVE_GNTSHR
	ml_map = Field(share, 1);

	int size = Caml_ba_array_val(ml_map)->dim[0];
	int pages = size >> XC_PAGE_SHIFT;
	int result = xc_gntshr_munmap(_G(xgh), Caml_ba_data_val(ml_map), pages);
	if(result != 0)
		failwith_xc(_G(xgh));
#else
	gntshr_missing();
#endif
	CAMLreturn(Val_unit);
}

CAMLprim value ocaml_gstreamer_caps_to_string(value _c)
{
  CAMLparam1(_c);
  CAMLlocal1(ans);
  GstCaps *c = Caps_val(_c);
  char *s;

  caml_release_runtime_system();
  s = gst_caps_to_string(c);
  caml_acquire_runtime_system();

  ans = caml_copy_string(s);
  free(s);

  CAMLreturn(ans);
}

CAMLprim value ocaml_gstreamer_version(value unit)
{
  CAMLparam0();
  CAMLlocal1(ans);

  unsigned int major, minor, micro, nano;
  gst_version(&major, &minor, &micro, &nano);

  ans = caml_alloc_tuple(4);
  Store_field(ans,0,Val_int(major));
  Store_field(ans,1,Val_int(minor));
  Store_field(ans,2,Val_int(micro));
  Store_field(ans,3,Val_int(nano));

  CAMLreturn(ans);
}

CAMLprim value ml_gtk_init (value argv)
{
    CAMLparam1 (argv);
    int argc = Wosize_val(argv), i;
    CAMLlocal1 (copy);

    copy = (argc ? alloc (argc, Abstract_tag) : Atom(0));
    for (i = 0; i < argc; i++) Field(copy,i) = Field(argv,i);
    if( !gtk_init_check (&argc, (char ***)&copy) ){
      ml_raise_gtk ("ml_gtk_init: initialization failed");
    }

    argv = (argc ? alloc (argc, 0) : Atom(0));
    for (i = 0; i < argc; i++) modify(&Field(argv,i), Field(copy,i));
    CAMLreturn (argv);
}

CAMLprim value stub_gntshr_open(value unit)
{
	CAMLparam1(unit);
	CAMLlocal1(result);
#ifdef HAVE_GNTSHR
	xc_gntshr *xgh;

	xgh = xc_gntshr_open(NULL, 0);
	if (NULL == xgh)
		caml_failwith("Failed to open interface");
	result = (value)xgh;
#else
	gntshr_missing();
#endif
	CAMLreturn(result);
}

CAMLprim value
netcgi2_apache_request_get_basic_auth_pw (value rv)
{
    CAMLparam1 (rv);
    CAMLlocal1 (c);
    request_rec *r = Request_rec_val (rv);
    const char *pw = 0;
    int i = ap_get_basic_auth_pw (r, &pw); /* no need to free(pw) */
    /* Return [i] as the first component of a couple so we can deal with
     * the possible errors on the Caml side. */
    if (i == DECLINED) pw = NULL;	/* FIXME */
    c = alloc_tuple (2);
    Store_field(c, 0, Val_int(i));
    Store_field(c, 1, Val_optstring(pw));
    CAMLreturn (c);
}

static int callml_custom_solve(SUNLinearSolver ls, SUNMatrix A, N_Vector x,
                               N_Vector b, realtype tol)
{
    CAMLparam0();
    CAMLlocal1(r);
    CAMLlocalN(args, 4);

    Store_field(args, 0, (A == NULL) ? Val_unit : MAT_BACKLINK(A));
    Store_field(args, 1, NVEC_BACKLINK(x));
    Store_field(args, 2, NVEC_BACKLINK(b));
    Store_field(args, 3, caml_copy_double(tol));

    r = caml_callbackN_exn(GET_OP(ls, SOLVE), 4, args);

    CAMLreturnT(int, CHECK_EXCEPTION_SUCCESS(r));
}

value caml_read_history(value name) {

    CAMLparam1(name);
    int result;
    result = read_history( String_val(name) );
    if (result == ENOENT) {
        raise_not_found();
    }
    else if (result != 0) {
        CAMLlocal1(error);
        error = copy_string(strerror( result ));
        raise_sys_error( error );
    }
    CAMLreturn(Val_unit);

}