Exemple #1
0
//+   external ajoin : ?nosort:bool -> db -> cursor array -> get_flag list ->
//+                       cursor = "caml_join_cursors"
//+   let join ?nosort  db cursor_list get_flag_list =
//+        ajoin ?nosort db (Array.of_list cursor_list) get_flag_list
value caml_join_cursors(value vnosort, value db, 
			value vcursors, value vflags) {
  CAMLparam4(vnosort,db,vcursors,vflags);
  CAMLlocal1(rval);
  DBC *jcurs; // pointer to joined cursor
  int carray_len = Wosize_val(vcursors);
  int flags = convert_flag_list(vflags,cursor_get_flags);
  DBC *cursors[carray_len + 1];
  int i;

  if (Is_Some(vnosort) && Bool_val(vnosort)) { 
    flags = flags | DB_JOIN_NOSORT; 
  }

  for (i=0; i < carray_len; i++) { 
    if (UW_cursor_closed(Field(vcursors,i))) {
      invalid_argument("caml_join_cursors: Attempt to use closed cursor");
    }
    cursors[i] = UW_cursor(Field(vcursors,i));
  }
  cursors[i] = NULL;
  test_db_closed(db);
  
  UW_db(db)->join(UW_db(db),cursors,&jcurs,flags);
  

  rval = alloc_custom(&cursor_custom,Camlcursor_wosize,0,1);
  UW_cursor(rval) = jcurs;
  UW_cursor_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 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 #4
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);
}
Exemple #5
0
value grappa_CAML_better_capping (value c_gene1, value c_gene2, value num_genes)
{
    CAMLparam3(c_gene1,c_gene2,num_genes);
    int NUM_GENES = Int_val(num_genes);
    long dims[1]; dims[0] = NUM_GENES;
    struct genome_struct *g1, *g2;
    g1 = (struct genome_struct *) Data_custom_val (c_gene1);
    g2 = (struct genome_struct *) Data_custom_val (c_gene2);
    struct genome_struct * out_genome_list;

    out_genome_list = (struct genome_struct *) malloc (sizeof (struct genome_struct) );
    if ( out_genome_list == ( struct genome_struct * ) NULL )
        failwith ("ERROR: genome_list in grappa_CAML_better_capping is NULL" );
    out_genome_list[0].gnamePtr =( char * ) malloc ( MAX_NAME * sizeof ( char ) );
    sprintf (out_genome_list[0].gnamePtr, "%i", 0);
    if ( out_genome_list[0].gnamePtr == ( char * ) NULL )
        failwith( "ERROR: gname of genome_list in grappa_CAML_better_capping is NULL" );
    out_genome_list[0].genes =( int * ) malloc ( 3*NUM_GENES * sizeof ( int ) );
    out_genome_list[0].delimiters = (int *) malloc (NUM_GENES * sizeof (int) );
    out_genome_list[0].magic_number = GRAPPA_MAGIC_NUMBER;
    out_genome_list[0].encoding = NULL; //we don't need encoding and gnamePtr;
    better_capping (g1->genes,g2->genes,NUM_GENES,g1->delimiters,g2->delimiters,g1->deli_num,g2->deli_num,out_genome_list);
    struct genome_arr_t *out_genome_arr;
    CAMLlocal1 (c_genome_arr);
    c_genome_arr = alloc_custom(&genomeArrOps, sizeof(struct genome_arr_t), 1, 10000);
    out_genome_arr = (struct genome_arr_t *) Data_custom_val(c_genome_arr);
    out_genome_arr->magic_number = GRAPPA_MAGIC_NUMBER;
    out_genome_arr->genome_ptr = out_genome_list;    
    assert(GRAPPA_MAGIC_NUMBER == out_genome_list[0].magic_number);
    out_genome_arr->num_genome = 1;
    out_genome_arr->num_gene = NUM_GENES;
    CAMLreturn(c_genome_arr); 

}
Exemple #6
0
value camlidl_gmp_randstate_ptr_c2ml(gmp_randstate_ptr* gmp_randstate)
{
    value val;

    val = alloc_custom(&camlidl_custom_gmp_randstate, sizeof(__gmp_randstate_struct), 0, 1);
    *((__gmp_randstate_struct*)(Data_custom_val(val))) = *(*gmp_randstate);
    return val;
}
value win_alloc_handle(HANDLE h)
{
  value res = alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
  Handle_val(res) = h;
  Descr_kind_val(res) = KIND_HANDLE;
  CRT_fd_val(res) = NO_CRT_FD;
  return res;
}
Exemple #8
0
value camlidl_mpz_ptr_c2ml(mpz_ptr* mpz)
{
    value val;

    val = alloc_custom(&camlidl_custom_mpz, sizeof(__mpz_struct), 0, 1);
    *(((__mpz_struct*)(Data_custom_val(val)))) = *(*mpz);
    return val;
}
value win_alloc_socket(SOCKET s)
{
  value res = alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
  Socket_val(res) = s;
  Descr_kind_val(res) = KIND_SOCKET;
  CRT_fd_val(res) = NO_CRT_FD;
  return res;
}
Exemple #10
0
static
value
wrap_ptr(struct custom_operations *custom, void* ptr)
{
  value v = alloc_custom(custom, sizeof(void*), 0, 1);
  * (void**) Data_custom_val(v) = ptr;
  return v;
}
static value alloc_sevenzip_in_file(CSzArEx db)
{
  CAMLparam0 ();
  CAMLlocal1 (sevenzip);
  sevenzip = alloc_custom(&sevenzip_in_file_ops, sizeof(CSzArEx), 0, 1);
  sevenzip_in_file_val(sevenzip) = db;
  CAMLreturn (sevenzip);
}
Exemple #12
0
CAMLprim value caml_mutex_new(value unit)
{
  value mut;
  mut = alloc_custom(&caml_mutex_ops, sizeof(HANDLE), 1, Max_mutex_number);
  Mutex_val(mut) = CreateMutex(0, FALSE, NULL);
  if (Mutex_val(mut) == NULL) caml_wthread_error("Mutex.create");
  return mut;
}
Exemple #13
0
value alloc_alpm_pkg_autofree ( pmpkg_t * pkg )
{
    value custom = alloc_custom( &alpm_pkg_free_opts,
                                 sizeof ( pmpkg_t * ),
                                 0, 1 );
    Package_val( custom ) = pkg;
    return custom;
}
Exemple #14
0
CAMLprim value wrapper_bdd_newpair() {
    CAMLparam0();
    CAMLlocal1(r);
    bddPair* shifter;
    r = alloc_custom(&bddpairops, sizeof (bddPair*), 1, 1);
    shifter = bdd_newpair();
    BDDPAIR_val(r) = shifter;
    CAMLreturn(r);
}
Exemple #15
0
static value caml_threadstatus_new (void)
{
  st_event ts = NULL;           /* suppress warning */
  value wrapper;
  st_check_error(st_event_create(&ts), "Thread.create");
  wrapper = alloc_custom(&caml_threadstatus_ops, sizeof(st_event *),
                         1, Max_threadstatus_number);
  Threadstatus_val(wrapper) = ts;
  return wrapper;
}
Exemple #16
0
CAMLprim value caml_mutex_new(value unit)        /* ML */
{
  st_mutex mut = NULL;          /* suppress warning */
  value wrapper;
  st_check_error(st_mutex_create(&mut), "Mutex.create");
  wrapper = alloc_custom(&caml_mutex_ops, sizeof(st_mutex *),
                         1, Max_mutex_number);
  Mutex_val(wrapper) = mut;
  return wrapper;
}
Exemple #17
0
value camlidl_mpq2_ptr_c2ml(mpq_ptr* mpq)
{
    value val;
    __mpq_struct* p;
    p = malloc(sizeof(__mpq_struct));
    *p = *(*mpq);
    val = alloc_custom(&camlidl_custom_mpq2, sizeof(__mpq_struct), 0, 1);
    *((__mpq_struct**)(Data_custom_val(val))) = p;
    return val;
}
Exemple #18
0
CAMLexport value caml_gdk_cairo_create(value vdrawable)
{
  CAMLparam1(vdrawable);
  CAMLlocal1(vcontext);
  cairo_t *cr = gdk_cairo_create(GdkDrawable_val(vdrawable));
  caml_cairo_raise_Error(cairo_status(cr)); /* caml_check_status not exported */
  vcontext = alloc_custom(&caml_cairo_ops, sizeof(void*), 1, 50);
  CAIRO_VAL(vcontext) = cr;
  CAMLreturn(vcontext);
}
Exemple #19
0
CAMLprim value caml_condition_new(value unit)        /* ML */
{
  st_condvar cond = NULL;       /* suppress warning */
  value wrapper;
  st_check_error(st_condvar_create(&cond), "Condition.create");
  wrapper = alloc_custom(&caml_condition_ops, sizeof(st_condvar *),
                         1, Max_condition_number);
  Condition_val(wrapper) = cond;
  return wrapper;
}
Exemple #20
0
value caml_gr_new_image(int w, int h)
{
  value res = alloc_custom(&image_ops, sizeof(struct grimage),
                           w * h, Max_image_mem);
  Width_im(res) = w;
  Height_im(res) = h;
  Data_im(res) = XCreatePixmap(caml_gr_display, caml_gr_window.win, w, h,
                               XDefaultDepth(caml_gr_display, caml_gr_screen));
  Mask_im(res) = None;
  return res;
}
Exemple #21
0
value knitro_new()
{
  value block = alloc_custom( &KnitroOperations, sizeof(KTR_context*), 0, 1 );
  assert( block != NULL );
  KTR_context* context = KTR_new();
  assert(context != NULL);
  void* block_data = Data_custom_val( block );
  assert(block_data !=  NULL);
  memcpy( block_data, &context, sizeof(KTR_context*) );
  return block;
}
Exemple #22
0
value camlidl_gmp_randstate2_ptr_c2ml(gmp_randstate_ptr* gmp_randstate)
{
    value val;
    __gmp_randstate_struct* p;
    p = malloc(sizeof(__gmp_randstate_struct));
    *p = *(*gmp_randstate);

    val = alloc_custom(&camlidl_custom_gmp_randstate2, sizeof(__gmp_randstate_struct*), 0, 1);
    *((__gmp_randstate_struct**)(Data_custom_val(val))) = p;
    return val;
}
Exemple #23
0
CAMLprim value caml_condition_new(value unit)
{
  value cond;
  cond = alloc_custom(&caml_condition_ops, sizeof(struct caml_condvar),
                      1, Max_condition_number);
  Condition_val(cond)->sem = CreateSemaphore(NULL, 0, 0x7FFFFFFF, NULL);
  if (Condition_val(cond)->sem == NULL)
    caml_wthread_error("Condition.create");
  Condition_val(cond)->count = 0;
  return cond;
}
Exemple #24
0
static value alloc_crc32_custom(void)
{
	CAMLparam0 ();
	CAMLlocal1 (custom);
	u_int32_t *context;

	context = (u_int32_t *) malloc(sizeof(u_int32_t));
	CrcInit (context);

	custom = alloc_custom(&crc32_custom_ops, sizeof(u_int32_t *), 0, 1);
	crc32_custom_val(custom) = context;
	CAMLreturn (custom);
}
Exemple #25
0
static value
alloc_vmnet_state(interface_ref i)
{
  value v = alloc_custom(&vmnet_state_ops, sizeof(struct vmnet_state *), 0, 1);
  struct vmnet_state *vms = malloc(sizeof(struct vmnet_state));
  if (!vms)
     caml_raise_out_of_memory();
  vms->iref = i;
  pthread_mutex_init(&vms->vmm, NULL);
  pthread_cond_init(&vms->vmc, NULL);
  Vmnet_state_val(v) = vms;
  return v;
}
Exemple #26
0
CAMLprim value mltds_ct_cmd_alloc(value conn)
{
    CAMLparam1(conn);
    CS_COMMAND* command;
    CAMLlocal1(result);

    retval_inspect( "ct_cmd_alloc",
                    ct_cmd_alloc(connection_ptr(conn), &command) );

    result = alloc_custom(&command_operations, sizeof(CS_COMMAND*), 0, 1);
    command_ptr(result) = command;

    CAMLreturn(result);
}
Exemple #27
0
/*** Allocation ***/
CAMLprim value mltds_cs_ctx_create(value unit)
{
    CAMLparam1(unit);
    CS_CONTEXT* context;
    CAMLlocal1(result);

    retval_inspect( "cs_ctx_alloc", cs_ctx_alloc(CS_VERSION_100, &context) );
    retval_inspect( "ct_init", ct_init(context, CS_VERSION_100) );

    result = alloc_custom(&context_operations, sizeof(CS_CONTEXT*), 0, 1);
    context_ptr(result) = context;

    CAMLreturn(result);
}
Exemple #28
0
CAMLprim value Wrapper_FT_New_Face(value filename)
{
  CAMLparam1(filename);
  CAMLlocal1(block);
  FT_Face *face;

  block = alloc_custom(&face_ops, sizeof(FT_Face), 0, 1);

  face = (FT_Face *)Data_custom_val(block);

  if (FT_New_Face(library, String_val(filename), 0, face))
    failwith("FT_New_Face");

  CAMLreturn(block);
};
Exemple #29
0
value column_of_buffer(struct binding_buffer* buf)
{
    CAMLparam0 ();
    CAMLlocal2(result, buffer);

    buffer = alloc_custom(&binding_buffer_operations,
                          sizeof(struct binding_buffer*), 0, 1);
    buffer_ptr(buffer) = buf;

    result = alloc(COL_SIZE, 0);
    Store_field(result, COL_NAME, copy_string(buf->fmt.name));
    Store_field(result, COL_STATUS, value_of_status_bitmask(buf->fmt.format));
    Store_field(result, COL_BUFFER, buffer);

    CAMLreturn(result);
}
Exemple #30
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);
}