Exemple #1
0
//+   external create : ?dbenv:Dbenv.t -> create_flag list -> t = 
//+        "caml_db_create"
value caml_db_create(value dbenv_opt, value vflags){
  CAMLparam2(dbenv_opt,vflags);
  int err;
  int flags;
  DB *db;
  DB_ENV *dbenv;
  CAMLlocal1(rval);

  /* The flags parameter is currently unused, and must be set to 0. */
  if (vflags != Val_emptylist)
    invalid_argument("DB.create invalid create flag");
  flags = convert_flag_list(vflags,db_create_flags);

  if (Is_None(dbenv_opt)) { dbenv = NULL; }
  else { 
    test_dbenv_closed(Some_val(dbenv_opt));
    dbenv = UW_dbenv(Some_val(dbenv_opt)); 
  }
  
  err = db_create(&db,dbenv,flags);
  if (err != 0) { raise_db(db_strerror(err)); }

  db->set_errcall(db,raise_db_cb);

  rval = alloc_custom(&db_custom,Camldb_wosize,0,1);
  UW_db(rval) = db;
  UW_db_closed(rval) = False;
  CAMLreturn (rval);
  
}
Exemple #2
0
//+   external txn_begin : dbenv -> t option -> begin_flag list -> t
//+        = "caml_txn_begin"
value caml_txn_begin(value dbenv, value parent_opt, value vflags) {
  CAMLparam3(dbenv,parent_opt,vflags);
  CAMLlocal1(rval);
  int err,flags;
  DB_TXN *parent, *newtxn;

  test_dbenv_closed(dbenv);

  flags = convert_flag_list(vflags,txn_begin_flags);

  if (Is_None(parent_opt)) { parent = NULL; }
  else { 
    test_txn_closed(Some_val(parent_opt));
    parent = UW_txn(Some_val(parent_opt)); 
    //printf("********* parented transaction ***************\n"); fflush(stdout);
  }
  
  err = UW_dbenv(dbenv)->txn_begin(UW_dbenv(dbenv), parent, &newtxn, flags);
  if (err != 0) {
    if (err == ENOMEM) { 
      failwith("Maximum # of concurrent transactions reached"); 
    } else {
      UW_dbenv(dbenv)->err(UW_dbenv(dbenv), err,"caml_txn_begin");
    }
  }

  rval = alloc_custom(&txn_custom,Camltxn_wosize,0,1);
  UW_txn(rval) = newtxn;
  UW_txn_closed(rval) = False;
  CAMLreturn(rval);
}
Exemple #3
0
//+   external del : t -> ?txn:txn -> string -> unit = "caml_db_del"
value caml_db_del(value db, value txn_opt, value key) {
  CAMLparam3(db,txn_opt,key);
  DBT dbt; // static keyword initializes record to zero.
  int err;
  DB_TXN *txn;

  if (Is_None(txn_opt)) { txn = NULL; }
  else { 
    test_txn_closed(Some_val(txn_opt));
    txn = UW_txn(Some_val(txn_opt)); 
  }

  test_db_closed(db);

  zerob(&dbt,sizeof(DBT));

  dbt.data = String_val(key);
  dbt.size = string_length(key);

  
  err = UW_db(db)->del(UW_db(db), txn, &dbt, 0);
  if (err != 0) { UW_db(db)->err(UW_db(db),err, "caml_db_del"); }

  CAMLreturn (Val_unit);
}
Exemple #4
0
//+   external get : t -> ?txn:txn -> string -> get_flag list -> string
//+             = "caml_db_get"
value caml_db_get(value db, value txn_opt, value vkey, value vflags) {
  CAMLparam4(db, txn_opt, vkey, vflags);
  DBT key,data;
  int flags, err;
  DB_TXN *txn; 
  CAMLlocal1(rval);

  if (Is_None(txn_opt)) { txn = NULL; }
  else { 
    test_txn_closed(Some_val(txn_opt));
    txn = UW_txn(Some_val(txn_opt)); 
  }

  test_db_closed(db);

  zerob(&key,sizeof(DBT)); zerob(&data,sizeof(DBT));

  key.data = String_val(vkey);
  key.size = string_length(vkey);
  flags = convert_flag_list(vflags, db_get_flags);


  err = UW_db(db)->get(UW_db(db), txn, &key, &data, flags);
  if (err != 0) { 
    ////fprintf(stderr,"Error found: %d\n",err); fflush(stderr);
    if (err == DB_NOTFOUND) { raise_not_found(); }
    UW_db(db)->err(UW_db(db),err,"caml_db_get"); 
  }

  // FIX: this currently uses an extra, unnecessary copy in order to simplify
  // memory management.
  rval = alloc_string(data.size);
  memcpy (String_val(rval), data.data, data.size);
  CAMLreturn (rval);
}
Exemple #5
0
//+   external put : t -> ?txn:txn -> key:string -> data:string 
//+             -> put_flag list -> unit = "caml_db_put"
value caml_db_put(value db, value txn_opt, value vkey, 
		  value vdata, value vflags) {
  CAMLparam5(db, txn_opt, vkey, vdata, vflags);
  DBT key, data;
  int flags, err;
  DB_TXN *txn;

  if (Is_None(txn_opt)) { txn = NULL; }
  else { 
    test_txn_closed(Some_val(txn_opt));
    txn = UW_txn(Some_val(txn_opt)); 
  }

  test_db_closed(db);
  
  zerob(&key,sizeof(DBT)); zerob(&data,sizeof(DBT));

  key.data = String_val(vkey);
  key.size = string_length(vkey);
  data.data = String_val(vdata);
  data.size = string_length(vdata);
  flags = convert_flag_list(vflags, db_put_flags);

  err = UW_db(db)->put(UW_db(db), txn, &key, &data, flags);
  if (err != 0) { 
    if (err  == DB_KEYEXIST) {raise_key_exists();}
    UW_db(db)->err(UW_db(db),err,"caml_db_put"); 
  }

  CAMLreturn (Val_unit);
}
Exemple #6
0
//+   (* Note: A cursor created with a transaction must be closed before 
//+      the transaction is committed or aborted *)
//+   external create : ?writecursor:bool -> ?txn:txn -> Db.t -> t 
//+               = "caml_cursor_create"
value caml_cursor_create(value vwritecursor, value txn_opt, value db) {
  CAMLparam3(vwritecursor,txn_opt,db);
  int err;
  int flags = 0;
  CAMLlocal1(rval);
  DBC *cursor;
  DB_TXN *txn;

  if (Is_None(txn_opt)) { txn = NULL; }
  else { 
    test_txn_closed(Some_val(txn_opt));
    txn = UW_txn(Some_val(txn_opt)); 
  }

  test_db_closed(db);

  // setup flags from vwritecursor
  if (Is_Some(vwritecursor) && Bool_val(Some_val(vwritecursor))) { 
    flags = DB_WRITECURSOR; 
  }

  //  printf("%d\n",ctr++); fflush(stdout);

  err = UW_db(db)->cursor(UW_db(db),txn,&cursor,flags);
  if (err != 0) {
    UW_db(db)->err(UW_db(db),err, "caml_cursor_create"); 
  }

  rval = alloc_custom(&cursor_custom,Camlcursor_wosize,0,1);

  UW_cursor(rval) = cursor;
  UW_cursor_closed(rval) = False;
  CAMLreturn (rval);
}
static int jacfn_withsens( /* IDASlsSparseJacFnB */
	realtype t,
	realtype cjB,
	N_Vector yy,
	N_Vector yp,
	N_Vector *ys,
	N_Vector *yps,
	N_Vector yyB,
	N_Vector ypB,
	N_Vector resvalB,
	SlsMat jacB,
	void *user_data,
	N_Vector tmp1B,
	N_Vector tmp2B,
	N_Vector tmp3B)
{
    CAMLparam0();
    CAMLlocalN(args, 4);
    CAMLlocal4(session, bsensext, cb, smat);

    WEAK_DEREF (session, *(value*)user_data);
    bsensext = IDA_SENSEXT_FROM_ML(session);

    cb = IDA_LS_CALLBACKS_FROM_ML(session);
    cb = Field (cb, 0);

    args[0] = sunml_idas_make_jac_arg(t, yy, yp, yyB, ypB, resvalB, cjB,
			        sunml_ida_make_triple_tmp (tmp1B, tmp2B, tmp3B));

    int ns = Int_val(Field(bsensext, RECORD_IDAS_BWD_SESSION_NUMSENSITIVITIES));
    args[1] = IDAS_BSENSARRAY1_FROM_EXT(bsensext);
    sunml_idas_wrap_to_nvector_table(ns, args[1], ys);
    args[2] = IDAS_BSENSARRAY2_FROM_EXT(bsensext);
    sunml_idas_wrap_to_nvector_table(ns, args[2], yps);

    smat = Field(cb, 1);
    if (smat == Val_none) {
	Store_some(smat, sunml_matrix_sparse_wrap(jacB));
	Store_field(cb, 1, smat);

	args[3] = Some_val(smat);
    } else {
	args[3] = Some_val(smat);
	sunml_matrix_sparse_rewrap(args[3]);
    }

    /* NB: Don't trigger GC while processing this return value!  */
    value r = caml_callbackN_exn (Field(cb, 0), 4, args);

    CAMLreturnT(int, CHECK_EXCEPTION(session, r, RECOVERABLE));
}
/* XXX: WARNING: this function leaks memory if v_ident is not None!
   No way around that if syslog is called in a multi-threaded environment!
   Therefore it shouldn't be called too often.  What for, anyway? */
CAMLprim value openlog_stub(value v_ident, value v_option, value v_facility) {
  char *ident = NULL; /* default to argv[0], as per syslog(3) */
  if (v_ident != Val_none) {
    int len = caml_string_length(Some_val(v_ident)) + 1;
    ident = caml_stat_alloc(len);
    memcpy(ident, String_val(Some_val(v_ident)), len);
  }
  caml_enter_blocking_section();
  openlog(ident, Int_val(v_option), Int_val(v_facility));
  /* openlog doesn't inter ident (if specified), so freeing it here
     would create an invalid program. */
  caml_leave_blocking_section();
  return Val_unit;
}
Exemple #9
0
 CAMLprim // [`qobject ] obj -> string option 
 value getClassName(value cppobj) {
   CAMLparam1(cppobj);
   QObject *qobj = (QObject*)cppobj;
   if (qobj == NULL)
     CAMLreturn(Val_none);
   else 
     CAMLreturn(Some_val(caml_copy_string(qobj -> metaObject() -> className() ) ) );
 }
Exemple #10
0
CAMLextern_C value
caml_sfHttp_setHost(value http, value host, value port, value unit)
{
    if (port == Val_none)
        SfHttp_val(http)->setHost(String_val(host));
    else
        SfHttp_val(http)->setHost(String_val(host), Int_val(Some_val(port)));
    return Val_unit;
}
Exemple #11
0
CAMLprim value caml_extunix_sendmsg(value fd_val, value sendfd_val, value data_val)
{
  CAMLparam3(fd_val, sendfd_val, data_val);
  CAMLlocal1(data);
  size_t datalen;
  struct msghdr msg;
  struct iovec iov[1];
  int fd = Int_val(fd_val);
  ssize_t ret;
  char *buf;

  memset(&msg, 0, sizeof msg);

  if (sendfd_val != Val_none) {
    int sendfd = Int_val(Some_val(sendfd_val));
#if defined(CMSG_SPACE)
    union {
      struct cmsghdr cmsg; /* for alignment */
      char control[CMSG_SPACE(sizeof sendfd)];
    } control_un;
    struct cmsghdr *cmsgp;

    msg.msg_control = control_un.control;
    msg.msg_controllen = CMSG_LEN(sizeof sendfd);

    cmsgp = CMSG_FIRSTHDR(&msg);
    cmsgp->cmsg_len = CMSG_LEN(sizeof sendfd);
    cmsgp->cmsg_level = SOL_SOCKET;
    cmsgp->cmsg_type = SCM_RIGHTS;
    *(int *)CMSG_DATA(cmsgp) = sendfd;
#else
    msg.msg_accrights = (caddr_t)&sendfd;
    msg.msg_accrightslen = sizeof sendfd;
#endif
  }

  datalen = caml_string_length(data_val);
  buf = malloc(datalen);
  if (NULL == buf)
    uerror("sendmsg", Nothing);
  memcpy(buf, String_val(data_val), datalen);

  iov[0].iov_base = buf;
  iov[0].iov_len = datalen;
  msg.msg_iov = iov;
  msg.msg_iovlen = 1;

  caml_enter_blocking_section();
  ret = sendmsg(fd, &msg, 0);
  caml_leave_blocking_section();

  free(buf);

  if (ret == -1)
    uerror("sendmsg", Nothing);
  CAMLreturn (Val_unit);
}
Exemple #12
0
// constructor QWidget(QWidget* parent  = 0,Qt::WindowFlags f  = 0)
//argnames = (arg0 arg1)
    value native_pub_createeee_QWidget_QWidget_Qt_WindowFlags(value arg0,value arg1) {
        CAMLparam2(arg0,arg1);
        CAMLlocal1(_ans);
        QWidget* _arg0 = (arg0==Val_none) ? NULL : ((QWidget* )(Some_val(arg0)));
        Qt::WindowFlags _arg1 = enum_of_caml_Qt_WindowFlags(arg1);
        QWidget* ans = new QWidget(_arg0, _arg1);
        _ans = caml_alloc_small(1, Abstract_tag);
        (*((QWidget **) &Field(_ans, 0))) = ans;
        CAMLreturn(_ans);
    }
Exemple #13
0
CAMLextern_C value
caml_create_sfRenderStates(
        value blendMode,
        value transform,
        value texture,
        value shader,
        value unit)
{
    unsigned int pr = 0;
    sf::RenderStates *states = NULL;

    if (blendMode != Val_none) pr |= 0b0001;
    if (transform != Val_none) pr |= 0b0010;
    if (texture   != Val_none) pr |= 0b0100;
    if (shader    != Val_none) pr |= 0b1000;

    switch (pr) {
        case 0b0001:
            states = new sf::RenderStates(
                SfBlendMode_val(Some_val(blendMode)));
            break;
        case 0b0010:
            states = new sf::RenderStates(
                SfTransform_val_s(Some_val(transform)));
            break;
        case 0b0100:
            states = new sf::RenderStates(
                SfTexture_val(Some_val(texture)));
            break;
        case 0b1000:
            states = new sf::RenderStates(
                SfShader_val(Some_val(shader)));
            break;
        default:
            states = new sf::RenderStates(
                Option_val(blendMode, SfBlendMode_val, sf::BlendAlpha),
                Option_val(transform, SfTransform_val_s, sf::Transform()),
                Option_val(texture,   SfTexture_val, NULL),
                Option_val(shader,    SfShader_val, NULL));
    }

    return Val_sfRenderStates(states);
}
Exemple #14
0
 CAMLprim // [`qobject] obj -> 'a option
 value hasCamlObj(value cppobj) {
   CAMLparam1(cppobj);
   QObject *o = (QObject*)cppobj;
   value ans = takeCamlObj(o);
   if (ans != 0)
     CAMLreturn( Some_val((value)ans) );
   else
     CAMLreturn(Val_none);
 }
Exemple #15
0
/* ctypes_dlopen : filename:string -> flags:int -> library option */
value ctypes_dlopen(value filename, value flag)
{
  CAMLparam2(filename, flag);

  char *cfilename = filename == Val_none ? NULL : String_val(Some_val(filename));
  int cflag = Int_val(flag);

  void *handle = dlopen(cfilename, cflag);
  CAMLreturn (handle != NULL ? Val_some((value)handle) : Val_none);
}
Exemple #16
0
 CAMLprim
 value create_QWidget_twin(value arg0) {
     CAMLparam1(arg0);
     CAMLlocal1(ans);
     QWidget* _arg0 = (arg0==Val_none) ? NULL : QWidget_val(Some_val(arg0));
     QWidget_twin *_ans = new QWidget_twin(_arg0);
     setAbstrClass(ans,QSpinBox,_ans);
     printf("QWidget_twin created: %p, abstr = %p\n", _ans, (void*)ans);
     CAMLreturn(ans);
 }
Exemple #17
0
CAMLprim value
caml_sfShader_loadFromMemory(
        value vertexShader, value fragmentShader, value unit)
{
    sfShader *shader = NULL;

    if (vertexShader != Val_none && fragmentShader != Val_none)
        shader = sfShader_createFromMemory(
                String_val(Some_val(vertexShader)),
                String_val(Some_val(fragmentShader)));
    else if (vertexShader != Val_none)
        shader = sfShader_createFromMemory(
                String_val(Some_val(vertexShader)), NULL);
    else if (fragmentShader != Val_none)
        shader = sfShader_createFromMemory(
                NULL, String_val(Some_val(fragmentShader)));

    if (shader == NULL) caml_failwith("SFShader.loadFromMemory");
    return Val_sfShader(shader);
}
Exemple #18
0
CAMLextern_C value
caml_sfRenderWindow_drawText(value win, value text, value ml_states, value unit)
{
    if (ml_states == Val_none) {
        SfRenderWindow_val(win)->draw(*SfText_val_u(text));
    } else {
        sf::RenderStates states = *SfRenderStates_val(Some_val(ml_states));
        SfRenderWindow_val(win)->draw(*SfText_val_u(text), states);
    }
    return Val_unit;
}
static int jacfn_nosens( /* IDASlsSparseJacFnB */
	realtype t,
	realtype cjB,
	N_Vector yy,
	N_Vector yp,
	N_Vector yyB,
	N_Vector ypB,
	N_Vector resvalB,
	SlsMat jacB,
	void *user_data,
	N_Vector tmp1B,
	N_Vector tmp2B,
	N_Vector tmp3B)
{
    CAMLparam0();
    CAMLlocalN(args, 2);
    CAMLlocal3(session, cb, smat);

    WEAK_DEREF (session, *(value*)user_data);
    cb = IDA_LS_CALLBACKS_FROM_ML(session);
    cb = Field (cb, 0);

    args[0] = sunml_idas_make_jac_arg(t, yy, yp, yyB, ypB, resvalB, cjB,
			        sunml_ida_make_triple_tmp (tmp1B, tmp2B, tmp3B));

    smat = Field(cb, 1);
    if (smat == Val_none) {
	Store_some(smat, sunml_matrix_sparse_wrap(jacB));
	Store_field(cb, 1, smat);

	args[1] = Some_val(smat);
    } else {
	args[1] = Some_val(smat);
	sunml_matrix_sparse_rewrap(args[1]);
    }

    /* NB: Don't trigger GC while processing this return value!  */
    value r = caml_callbackN_exn (Field(cb, 0), 2, args);

    CAMLreturnT(int, CHECK_EXCEPTION(session, r, RECOVERABLE));
}
Exemple #20
0
CAMLextern_C value
caml_sfRenderWindow_drawCircleShape(
        value win, value shape, value ml_states, value unit)
{
    if (ml_states == Val_none) {
        SfRenderWindow_val(win)->draw(*SfCircleShape_val_u(shape));
    } else {
        sf::RenderStates states = *SfRenderStates_val(Some_val(ml_states));
        SfRenderWindow_val(win)->draw(*SfCircleShape_val_u(shape), states);
    }
    return Val_unit;
}
Exemple #21
0
// INPUT   a binding point and a texture id option
// OUTPUT  nothing, binds the texture
CAMLprim value
caml_bind_texture(value point, value tex_opt)
{
  CAMLparam2(point, tex_opt);

  if(tex_opt == Val_none)
    glBindTexture(Target_val(point), 0);
  else
    glBindTexture(Target_val(point), TEX(Some_val(tex_opt)));

  CAMLreturn(Val_unit);
}
Exemple #22
0
CAMLprim value caml_mcl(value inflation, value arr)
{
    CAMLparam2(inflation, arr);
    int i, cols = Wosize_val(arr);
    mclv *domc = mclvCanonical(NULL, cols, 1.0);
    mclv *domr = mclvCanonical(NULL, cols, 1.0);
    mclx *res_mat, *mx = mclxAllocZero(domc, domr);
    mclAlgParam *mlp;
    value res;

    for (i = 0; i < cols; ++i) {
        value col = Field(arr, i);
        int j, rows = Wosize_val(col);
        mclv *col_vec = &mx->cols[i];
        if (!cols)
            continue;

        mclvResize(col_vec, rows);
        for (j = 0; j < rows; ++j) {
            value t = Field(col, j);
            col_vec->ivps[j].idx = Int_val(Field(t, 0));
            col_vec->ivps[j].val = Double_val(Field(t, 1));
        }
    }


    mclAlgInterface(&mlp, NULL, 0, NULL, mx, 0);

    /* Optionally set inflation */
    if (inflation != Val_none) {
        mlp->mpp->mainInflation = Double_val(Some_val(inflation));
    }

    mclAlgorithm(mlp);

    res_mat = mlp->cl_result;
    cols = res_mat->dom_cols->n_ivps;
    res = caml_alloc(cols, 0);
    for (i = 0; i < cols; ++i) {
        mclv *col_vec = &res_mat->cols[i];
        int j, rows = col_vec->n_ivps;
        value row = caml_alloc(rows, 0);
        for (j = 0; j < rows; ++j) {
            Store_field(row, j, Val_int(col_vec->ivps[j].idx));
        }
        Store_field(res, i, row);
    }

    mclAlgParamFree(&mlp, TRUE);

    CAMLreturn(res);
}
Exemple #23
0
CAMLprim value
caml_SDL_RenderCopy(
        value renderer,
        value texture,
        value _srcrect,
        value _dstrect,
        value unit)
{
    SDL_Rect srcrect;
    SDL_Rect dstrect;

    SDL_Rect *srcrect_;
    SDL_Rect *dstrect_;

    if (_srcrect == Val_none) {
        srcrect_ = NULL;
    } else {
        SDL_Rect_val(&srcrect, Some_val(_srcrect));
        srcrect_ = &srcrect;
    }

    if (_dstrect == Val_none) {
        dstrect_ = NULL;
    } else {
        SDL_Rect_val(&dstrect, Some_val(_dstrect));
        dstrect_ = &dstrect;
    }

    int r = SDL_RenderCopy(
                SDL_Renderer_val(renderer),
                SDL_Texture_val(texture),
                srcrect_,
                dstrect_);

    if (r)
        caml_failwith("Sdlrender.copy");

    return Val_unit;
}
Exemple #24
0
/* ctypes_dlsym : ?handle:library -> symbol:string -> cvalue option */
value ctypes_dlsym(value handle_option, value symbol)
{
  CAMLparam2(handle_option, symbol);

  void *handle = handle_option == Val_none
    ? RTLD_DEFAULT
    : (void *)Some_val(handle_option);

  char *s = String_val(symbol);
  void *result = dlsym(handle, s);
  CAMLreturn(result == NULL
             ? Val_none
             : Val_some(caml_copy_int64((intptr_t)result)));
}
Exemple #25
0
CAMLextern_C value
caml_sfHttp_sendRequest(value http, value request, value timeout, value unit)
{
    sf::Http::Response resp;
    if (timeout != Val_none)
        resp = SfHttp_val(http)->sendRequest(
                *SfHttpRequest_val(request), *SfTime_val_u(Some_val(timeout)));
    else
        resp = SfHttp_val(http)->sendRequest(
                *SfHttpRequest_val(request));
    sf::Http::Response *r = new sf::Http::Response;
    *r = resp;
    return Val_sfHttpResponse(r);
}
Exemple #26
0
// INPUT   string option
// OUTPUT  display 
CAMLprim value
caml_xopen_display(value name)
{
  CAMLparam1(name);
  if(current_display != NULL)
    CAMLreturn((value)current_display);
  else if(name == Val_none) {
    current_display = XOpenDisplay(NULL);
    CAMLreturn((value)current_display);
  }
  else {
    current_display = XOpenDisplay(String_val(Some_val(name)));
    CAMLreturn((value)current_display);
  }
}
Exemple #27
0
// INPUT   a texture target, a level, a pixel format, a size, a texture format, some data
// OUTPUT  nothing, binds an image to the current texture2D
CAMLprim value
caml_tex_image_2D_native(value target, value lvl, value fmt, value size, value tfmt, value data)
{
  CAMLparam5(target, fmt, size, tfmt, data);
  CAMLxparam1(lvl);

  glTexImage2D(Target_val(target),
               Int_val(lvl),
               TextureFormat_val(tfmt),
               Int_val(Field(size,0)),
               Int_val(Field(size,1)),
               0,
               PixelFormat_val(fmt),
               GL_UNSIGNED_BYTE,
               (data == Val_none)? NULL : String_val(Some_val(data)));

  CAMLreturn(Val_unit);
}
Exemple #28
0
CAMLprim value
caml_spf_server_new(value debug_val, value dns_type_val)
{
    CAMLparam2(debug_val, dns_type_val);
    int debug;
    int dns_type;
    SPF_server_t *server;

    debug = (debug_val == Val_none) ? 0 : Bool_val(Some_val(debug_val));

    dns_type = dns_type_of_val(dns_type_val);
    if (dns_type == -1)
        spf_error("unknown DNS type");

    server = SPF_server_new(dns_type, debug);
    if (server == NULL)
        spf_error("cannot create SPF server");

    CAMLreturn((value)server);
}
static int bbbdcomm(sundials_ml_index nlocal, realtype t, N_Vector y,
		    N_Vector yb, void *user_data)
{
    CAMLparam0();
    CAMLlocal3(args, session, cb);

    args = caml_alloc_tuple (RECORD_CVODES_ADJ_BRHSFN_ARGS_SIZE);
    Store_field (args, RECORD_CVODES_ADJ_BRHSFN_ARGS_T, caml_copy_double (t));
    Store_field (args, RECORD_CVODES_ADJ_BRHSFN_ARGS_Y, NVEC_BACKLINK (y));
    Store_field (args, RECORD_CVODES_ADJ_BRHSFN_ARGS_YB, NVEC_BACKLINK (yb));

    WEAK_DEREF (session, *(value*)user_data);
    cb = CVODE_LS_PRECFNS_FROM_ML (session);
    cb = Field (cb, 0);
    cb = Field (cb, RECORD_CVODES_BBBD_PRECFNS_COMM_FN);
    cb = Some_val (cb);
    assert (Tag_val (cb) == Closure_tag);

    /* NB: Don't trigger GC while processing this return value!  */
    value r = caml_callback_exn (cb, args);

    CAMLreturnT(int, CHECK_EXCEPTION (session, r, RECOVERABLE));
}
Exemple #30
0
CAMLprim
value caml_extunix_signalfd(value vfd, value vsigs, value vflags, value v_unit)
{
  CAMLparam4(vfd, vsigs, vflags, v_unit);
  int fd = ((Val_none == vfd) ? -1 : Int_val(Some_val(vfd)));
  int flags = 0;
  int ret = 0;
  sigset_t ss;
  sigemptyset (&ss);
  while (!Is_long (vsigs)) {
    int sig = caml_convert_signal_number (Int_val (Field (vsigs, 0)));
    if (sigaddset (&ss, sig) < 0) uerror ("sigaddset", Nothing);
    vsigs = Field (vsigs, 1);
  }
  while (!Is_long (vflags)) {
    int f = Int_val (Field (vflags, 0));
    if (SFD_NONBLOCK == f) flags |= SFD_NONBLOCK;
    if (SFD_CLOEXEC == f)  flags |= SFD_CLOEXEC;
    vflags = Field (vflags, 1);
  }
  ret = signalfd (fd, &ss, flags);
  if (ret < 0) uerror ("signalfd", Nothing);
  CAMLreturn (Val_int (ret));
}