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);
}
Exemple #4
0
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);
}
Exemple #6
0
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);
}
Exemple #7
0
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);
}
Exemple #11
0
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);
}
Exemple #12
0
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);
}
Exemple #13
0
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);

}
Exemple #16
0
CAMLprim value mltds_ct_con_alloc(value context)
{
    CAMLparam1(context);
    CS_CONNECTION* conn;
    CAMLlocal1(result);

    retval_inspect( "ct_con_alloc", ct_con_alloc(context_ptr(context), &conn) );

    retval_inspect( "ct_diag",
                    ct_diag(conn, CS_INIT, CS_UNUSED, CS_UNUSED, NULL) );

    result = alloc_custom(&connection_operations, sizeof(CS_CONNECTION*), 0, 1);
    connection_ptr(result) = conn;

    CAMLreturn(result);
}
/*     LibPar.register_untyped_function(
      fn_name_c_str,
      globals_array, n_globals,
      postional_args_array, n_positional,
      default_args_array, default_values_array, n_defaults,
      parakeet_syntax))
      */
int register_untyped_function(
  char *name,
  char **globals, int num_globals,
  char **args, int num_args,
  char **default_args, paranode *default_arg_values, int num_defaults,
  paranode ast) {

  CAMLparam0();

  CAMLlocal3(val_name, globals_list, args_list);
  CAMLlocal2(default_arg_names_list, default_arg_values_list);
  CAMLlocal1(fn_id);

  printf(":: registering untyped fn (%s, %d/%d/%d globals/args/defaults)\n",
    name, num_globals, num_args, num_defaults);
  printf("::: ast pointer %p\n", ast);


  val_name = caml_copy_string(name);

  printf("::: building globals list\n");

  globals_list = build_str_list(globals, num_globals);
  printf("::: building args list\n");
  args_list    = build_str_list(args, num_args);
  printf("::: building defaults list\n");
  default_arg_names_list = build_str_list(default_args, num_defaults);

  printf("::: building default values list\n");
  default_arg_values_list = mk_val_list(default_arg_values, num_defaults);
  printf("::: building fn args\n");
  printf("::: ast = %d\n", ast);
  printf("::: ast->v = %d\n", ast->v);
  value func_args[6] = {
    val_name,
    globals_list,
    args_list,
    default_arg_names_list, 
    default_arg_values_list,
    ast->v
  };
  printf("\n\n");
  printf("  ...calling into OCaml's register function\n");
  fn_id = caml_callbackN(*ocaml_register_untyped_function, 6, func_args);
  printf("DONE WITH FN ID: %d\n", Int_val(fn_id));
  CAMLreturnT(int, Int_val(fn_id));
}
Exemple #18
0
value
v2v_xml_copy_doc (value docv, value recursivev)
{
  CAMLparam2 (docv, recursivev);
  CAMLlocal1 (copyv);
  xmlDocPtr doc, copy;

  doc = Doc_val (docv);
  copy = xmlCopyDoc (doc, Bool_val (recursivev));
  if (copy == NULL)
    caml_invalid_argument ("copy_doc: failed to copy");

  copyv = caml_alloc_custom (&doc_custom_operations, sizeof (xmlDocPtr), 0, 1);
  Doc_val (copyv) = copy;

  CAMLreturn (copyv);
}
Exemple #19
0
value mk_actual_ast_args(
          paranode *args, 
          int num_args,
          char** keywords,
          paranode* keyword_values,
          int num_keyword_args) {
  CAMLparam0(); 
  CAMLlocal3(pos_list, kwd_list, kwd_values_list);
  CAMLlocal1(actual_args);
  printf("Creating args, n_positional = %d, n_kwd = %d\n", num_args, num_keyword_args);
  pos_list = mk_val_list(args, num_args);
  kwd_list = build_str_list(keywords, num_keyword_args);
  kwd_values_list = mk_val_list(keyword_values, num_keyword_args);
  actual_args = \
    caml_callback3(*ocaml_mk_actual_args, pos_list, kwd_list, kwd_values_list);
  CAMLreturn(actual_args);
}
Exemple #20
0
CAMLprim value
camluv_key_init(value unit)
{
  CAMLparam0();
  CAMLlocal1(key);

  int rc = -1;
  camluv_key_t *camluv_key = camluv_key_new();
  rc = uv_key_create(&(camluv_key->uv_key));
  if (rc != UV_OK) {
    // TODO: error handling.
  }
  camluv_key->initialized = 1;
  key = camluv_copy_key(camluv_key);

  CAMLreturn(key);
}
Exemple #21
0
CAMLprim value win_filedescr_of_channel(value vchan)
{
  CAMLparam1(vchan);
  CAMLlocal1(fd);
  struct channel * chan;
  HANDLE h;

  chan = Channel(vchan);
  if (chan->fd == -1) uerror("descr_of_channel", Nothing);
  h = (HANDLE) _get_osfhandle(chan->fd);
  if (chan->flags & CHANNEL_FLAG_FROM_SOCKET)
    fd = win_alloc_socket((SOCKET) h);
  else
    fd = win_alloc_handle(h);
  CRT_fd_val(fd) = chan->fd;
  CAMLreturn(fd);
}
Exemple #22
0
CAMLprim value caml_gc_counters(value v)
{
  CAMLparam0 ();   /* v is ignored */
  CAMLlocal1 (res);

  /* get a copy of these before allocating anything... */
  double minwords = caml_stat_minor_words
                    + (double) (caml_young_alloc_end - caml_young_ptr);
  double prowords = caml_stat_promoted_words;
  double majwords = caml_stat_major_words + (double) caml_allocated_words;

  res = caml_alloc_tuple (3);
  Store_field (res, 0, caml_copy_double (minwords));
  Store_field (res, 1, caml_copy_double (prowords));
  Store_field (res, 2, caml_copy_double (majwords));
  CAMLreturn (res);
}
Exemple #23
0
value
ocaml_guestfs_last_errno (value gv)
{
  CAMLparam1 (gv);
  CAMLlocal1 (rv);
  int r;
  guestfs_h *g;

  g = Guestfs_val (gv);
  if (g == NULL)
    ocaml_guestfs_raise_closed ("last_errno");

  r = guestfs_last_errno (g);

  rv = Val_int (r);
  CAMLreturn (rv);
}
Exemple #24
0
//+   external create : unit -> t = "caml_dbenv_create"
value caml_dbenv_create(value unit){
  CAMLparam1(unit);
  CAMLlocal1(rval);
  int err;
  int flags = 0;
  DB_ENV *dbenv;
  
  err = db_env_create(&dbenv,flags);
  if (err != 0) { raise_db(db_strerror(err)); }

  dbenv->set_errcall(dbenv,raise_db_cb);

  rval = alloc_custom(&dbenv_custom,Camldbenv_wosize,0,1);
  UW_dbenv(rval) = dbenv;
  UW_dbenv_closed(rval) = False;
  CAMLreturn (rval);
}
Exemple #25
0
CAMLprim value stub_get_out_data(value ssl)
{
  CAMLparam1(ssl);
  CAMLlocal1(v);
  unsigned char *str;

  int rc=matrixSslGetOutdata(ssl_t_val(ssl), &str);

  if(rc>0) {
    v=caml_alloc_string(rc);
    memcpy(String_val(v),str,rc);
  } else {
    caml_failwith("No data");
  }

  CAMLreturn(v);
}
Exemple #26
0
/**
 * Export the constants provided by Facebook's build system to ocaml-land, since
 * their FFI only allows you to call functions, not reference variables. Doing
 * it this way makes sense for Facebook internally since our build system has
 * machinery for providing these two constants automatically (and no machinery
 * for doing codegen in a consistent way to build an ocaml file with them) but
 * is very roundabout for external users who have to have CMake codegen these
 * constants anyways. Sorry about that.
 */
value hh_get_build_revision(void) {
  CAMLparam0();
  CAMLlocal1(result);

#ifdef HH_BUILD_ID
  const char* const buf =
    STRINGIFY_VALUE(HH_BUILD_ID) "-" HHVM_VERSION_C_STRING_LITERALS;
#else
  const char* const buf = BuildInfo_kRevision;
#endif
  const size_t len = strlen(buf);
  result = caml_alloc_string(len);

  memcpy(String_val(result), buf, len);

  CAMLreturn(result);
}
Exemple #27
0
CAMLprim value perform_lgetxattr(value file, value name)
{
 CAMLparam2(file, name);
 CAMLlocal1(ret);
 ssize_t siz;

 siz = LGETXATTR(String_val(file), String_val(name), NULL, 0);
 if(siz < 0)
     caml_failwith("lgetxattr");

 ret = caml_alloc_string(siz);
 if(LGETXATTR(String_val(file), String_val(name), String_val(ret), siz) < 0) {
     caml_failwith("lgetxattr");
 }

 CAMLreturn(ret);
}
Exemple #28
0
CAMLprim value
ml_cairo_fill_extents (value v_cr)
{
  double x1, y1, x2, y2;
  cairo_fill_extents (cairo_t_val (v_cr), &x1, &y1, &x2, &y2);
  check_cairo_status (v_cr);
  {
    CAMLparam0 ();
    CAMLlocal1 (t);
    t = caml_alloc_tuple (4);
    Store_field (t, 0, caml_copy_double (x1));
    Store_field (t, 1, caml_copy_double (y1));
    Store_field (t, 2, caml_copy_double (x2));
    Store_field (t, 3, caml_copy_double (y2));
    CAMLreturn (t);
  }
}
Exemple #29
0
// Get grid values from a GRIB field
value ml_get_data( value ml_field ) {
    CAMLparam1( ml_field );
    CAMLlocal1( ml_data );

    int i;
    gribfield *field;
    field = Gribfield_val( ml_field );

    // Allocate an OCaml array and copy the data over
    ml_data = caml_alloc( field->ndpts * Double_wosize, Double_array_tag );
    for ( i = 0; i < field->ndpts; i++ ) {
        Store_double_field( ml_data, i, field->fld[i] );
    }

    // Return the OCaml-formatted data copy
    CAMLreturn( ml_data );
}
Exemple #30
0
CAMLprim value win_getenv(value var)
{
  LPWSTR s;
  DWORD len;
  CAMLparam1(var);
  CAMLlocal1(res);

  s = stat_alloc (65536);

  len = GetEnvironmentVariableW((LPCWSTR) String_val(var), s, 65536);
  if (len == 0) { stat_free (s); raise_not_found(); }

  res = copy_wstring(s);
  stat_free (s);
  CAMLreturn (res);

}