ligo/vendors/ocaml-lmdb/src/lmdb_stubs.c

567 lines
17 KiB
C
Raw Normal View History

2018-05-24 15:32:15 +04:00
/* --------------------------------------------------------------------------
Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
Distributed under the ISC license, see terms at the end of the file.
--------------------------------------------------------------------------- */
#include <string.h>
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/custom.h>
#include <caml/bigarray.h>
#include "lmdb.h"
CAMLprim value stub_mdb_version(value unit) {
CAMLparam1(unit);
CAMLlocal1(result);
int major, minor, patch;
mdb_version(&major, &minor, &patch);
result = caml_alloc_tuple(3);
Store_field(result, 0, Val_int(major));
Store_field(result, 1, Val_int(minor));
Store_field(result, 2, Val_int(patch));
CAMLreturn(result);
}
CAMLprim value stub_mdb_strerror(value errno) {
CAMLparam1(errno);
CAMLlocal1(result);
char *errstr;
errstr = mdb_strerror(Int_val(errno));
result = caml_copy_string(errstr);
CAMLreturn(result);
}
#define Env_val(v) (*((MDB_env **) Data_custom_val(v)))
#define Txn_val(v) (*((MDB_txn **) Data_custom_val(v)))
#define Cursor_val(v) (*((MDB_cursor **) Data_custom_val(v)))
#define Gen_custom_block(SNAME, CNAME, MNAME) \
static int compare_##SNAME(value a, value b) { \
CNAME *aa = MNAME(a), *bb = MNAME(b); \
return (aa == bb ? 0 : (aa < bb ? -1 : 1)); \
} \
\
static struct custom_operations lmdb_##SNAME##_ops = { \
.identifier = "lmdb_" #SNAME, \
.finalize = custom_finalize_default, \
.compare = compare_##SNAME, \
.compare_ext = custom_compare_ext_default, \
.hash = custom_hash_default, \
.serialize = custom_serialize_default, \
.deserialize = custom_deserialize_default \
}; \
\
static value alloc_##SNAME (CNAME *a) { \
value custom = alloc_custom(&lmdb_##SNAME##_ops, sizeof(CNAME *), 0, 1); \
MNAME(custom) = a; \
return custom; \
}
Gen_custom_block(env, MDB_env, Env_val)
Gen_custom_block(txn, MDB_txn, Txn_val)
Gen_custom_block(cursor, MDB_cursor, Cursor_val)
CAMLprim value stub_mdb_env_create(value unit) {
CAMLparam1(unit);
CAMLlocal2(result, ml_env);
int ret;
MDB_env *env;
ret = mdb_env_create(&env);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
ml_env = alloc_env(env);
Store_field(result, 0, ml_env);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_env_open(value env, value path, value flags, value mode) {
return Val_int(mdb_env_open(Env_val(env), String_val(path), Int_val(flags), Int_val(mode)));
}
CAMLprim value stub_mdb_env_close(value env) {
mdb_env_close(Env_val(env));
return Val_unit;
}
CAMLprim value stub_mdb_env_copy2(value env, value path, value flags) {
return Val_int(mdb_env_copy2(Env_val(env), String_val(path), Int_val(flags)));
}
CAMLprim value stub_mdb_env_copyfd2(value env, value fd, value flags) {
return Val_int(mdb_env_copyfd2(Env_val(env), Int_val(fd), Int_val(flags)));
}
static void caml_mdb_stat(value result, const MDB_stat *stat) {
Store_field(result, 0, Val_int(stat->ms_psize));
Store_field(result, 1, Val_int(stat->ms_depth));
Store_field(result, 2, Val_long(stat->ms_branch_pages));
Store_field(result, 3, Val_long(stat->ms_leaf_pages));
Store_field(result, 4, Val_long(stat->ms_overflow_pages));
Store_field(result, 5, Val_long(stat->ms_entries));
}
CAMLprim value stub_mdb_env_stat(value env) {
CAMLparam1(env);
CAMLlocal1(result);
MDB_stat stat;
mdb_env_stat(Env_val(env), &stat);
result = caml_alloc_tuple(6);
caml_mdb_stat(result, &stat);
CAMLreturn(result);
}
CAMLprim value stub_mdb_env_info(value env) {
CAMLparam1(env);
CAMLlocal1(result);
MDB_envinfo info;
mdb_env_info(Env_val(env), &info);
result = caml_alloc_tuple(5);
Store_field(result, 0, Val_long(info.me_mapsize));
Store_field(result, 1, Val_long(info.me_last_pgno));
Store_field(result, 2, Val_long(info.me_last_txnid));
Store_field(result, 3, Val_int(info.me_maxreaders));
Store_field(result, 4, Val_int(info.me_numreaders));
CAMLreturn(result);
}
CAMLprim value stub_mdb_env_sync(value env, value force) {
return Val_int(mdb_env_sync(Env_val(env), Bool_val(force)));
}
CAMLprim value stub_mdb_env_set_flags(value env, value flags, value onoff) {
return Val_int(mdb_env_set_flags(Env_val(env), Int_val(flags), Bool_val(onoff)));
}
CAMLprim value stub_mdb_env_get_flags(value env) {
int flags;
mdb_env_get_flags(Env_val(env), &flags);
return Val_int(flags);
}
CAMLprim value stub_mdb_env_get_path(value env) {
CAMLparam1(env);
CAMLlocal1(result);
const char *path;
mdb_env_get_path(Env_val(env), &path);
result = caml_copy_string(path);
CAMLreturn(result);
}
CAMLprim value stub_mdb_env_get_fd(value env) {
mdb_filehandle_t fd;
mdb_env_get_fd(Env_val(env), &fd);
return Val_int(fd);
}
CAMLprim value stub_mdb_env_set_mapsize(value env, value size) {
return Val_int(mdb_env_set_mapsize(Env_val(env), Int64_val(size)));
}
CAMLprim value stub_mdb_env_set_maxreaders(value env, value readers) {
return Val_int(mdb_env_set_maxreaders(Env_val(env), Int_val(readers)));
}
CAMLprim value stub_mdb_env_get_maxreaders(value env) {
unsigned int readers;
mdb_env_get_maxreaders(Env_val(env), &readers);
return Val_int(readers);
}
CAMLprim value stub_mdb_env_set_maxdbs(value env, value dbs) {
return Val_int(mdb_env_set_maxdbs(Env_val(env), Int_val(dbs)));
}
CAMLprim value stub_mdb_env_get_maxkeysize(value env) {
return Val_int(mdb_env_get_maxkeysize(Env_val(env)));
}
CAMLprim value stub_mdb_txn_begin(value env, value flags, value parent) {
CAMLparam3(env, flags, parent);
CAMLlocal2(result, ml_txn);
int ret;
MDB_txn *parent_txn = Is_block(parent) ? Txn_val(Field(parent, 0)) : NULL;
MDB_txn *new_txn;
ret = mdb_txn_begin(Env_val(env), parent_txn, Int_val(flags), &new_txn);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
ml_txn = alloc_txn(new_txn);
Store_field(result, 0, ml_txn);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_txn_env(value txn) {
CAMLparam1(txn);
CAMLlocal1(result);
MDB_env *env = mdb_txn_env(Txn_val(txn));
result = alloc_env(env);
CAMLreturn(result);
}
CAMLprim value stub_mdb_txn_id(value txn) {
return Val_long(mdb_txn_id(Txn_val(txn)));
}
CAMLprim value stub_mdb_txn_commit(value txn) {
return Val_int(mdb_txn_commit(Txn_val(txn)));
}
CAMLprim value stub_mdb_txn_abort(value txn) {
mdb_txn_abort(Txn_val(txn));
return Val_unit;
}
CAMLprim value stub_mdb_txn_reset(value txn) {
mdb_txn_reset(Txn_val(txn));
return Val_unit;
}
CAMLprim value stub_mdb_txn_renew(value txn) {
return Val_int(mdb_txn_renew(Txn_val(txn)));
}
CAMLprim value stub_mdb_dbi_open(value txn, value name, value flags) {
CAMLparam3(txn, name, flags);
CAMLlocal2(result, ml_dbi);
MDB_dbi dbi;
int ret;
const char* db_name = NULL;
if (Is_block(name)) db_name = String_val(Field(name, 0));
ret = mdb_dbi_open(Txn_val(txn), db_name, Int_val(flags), &dbi);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
ml_dbi = caml_copy_nativeint(dbi);
Store_field(result, 0, ml_dbi);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_stat(value txn, value dbi) {
CAMLparam2(txn, dbi);
CAMLlocal2(result, tuple);
MDB_stat stat;
int ret;
ret = mdb_stat(Txn_val(txn), Nativeint_val(dbi), &stat);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
tuple = caml_alloc_tuple(6);
caml_mdb_stat(tuple, &stat);
Store_field(result, 0, tuple);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_dbi_flags(value txn, value dbi) {
CAMLparam2(txn, dbi);
CAMLlocal1(result);
unsigned int flags;
int ret;
ret = mdb_dbi_flags(Txn_val(txn), Nativeint_val(dbi), &flags);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
Store_field(result, 0, Val_int(flags));
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_dbi_close(value env, value dbi) {
mdb_dbi_close(Env_val(env), Nativeint_val(dbi));
return Val_unit;
}
CAMLprim value stub_mdb_drop(value txn, value dbi, value del) {
return Val_int(mdb_drop(Txn_val(txn), Nativeint_val(dbi), Bool_val(del)));
}
static inline value alloc_mdb_val_ba (MDB_val *v) {
return
(v ?
caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, v->mv_data, v->mv_size) :
caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, NULL, 0));
}
CAMLprim value stub_mdb_get(value txn, value dbi, value key) {
CAMLparam3(txn, dbi, key);
CAMLlocal1(result);
MDB_val k, v;
int ret;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
ret = mdb_get(Txn_val(txn), Nativeint_val(dbi), &k, &v);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
Store_field(result, 0, alloc_mdb_val_ba(&v));
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_put(value txn, value dbi,
value key, value data, value flags) {
MDB_val k, v;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
v.mv_size = Caml_ba_array_val(data)->dim[0];
v.mv_data = Caml_ba_data_val(data);
return Val_int(mdb_put(Txn_val(txn), Nativeint_val(dbi), &k, &v, Int_val(flags)));
}
CAMLprim value stub_mdb_put_string(value txn, value dbi,
value key, value data, value flags) {
MDB_val k, v;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
v.mv_size = caml_string_length(data);
v.mv_data = String_val(data);
return Val_int(mdb_put(Txn_val(txn), Nativeint_val(dbi), &k, &v, Int_val(flags)));
}
CAMLprim value stub_mdb_del(value txn, value dbi, value key, value data) {
MDB_val k, v, *vp = NULL;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
if (Is_block(data)) {
v.mv_size = Caml_ba_array_val(Field(data, 0))->dim[0];
v.mv_data = Caml_ba_data_val(Field(data, 0));
vp = &v;
}
return Val_int(mdb_del(Txn_val(txn), Nativeint_val(dbi), &k, vp));
}
CAMLprim value stub_mdb_del_string(value txn, value dbi, value key, value data) {
MDB_val k, v, *vp = NULL;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
if (Is_block(data)) {
v.mv_size = caml_string_length(Field(data, 0));
v.mv_data = String_val(Field(data, 0));
vp = &v;
}
return Val_int(mdb_del(Txn_val(txn), Nativeint_val(dbi), &k, vp));
}
CAMLprim value stub_mdb_cursor_open(value txn, value dbi) {
CAMLparam2(txn, dbi);
CAMLlocal2(result, ml_cursor);
MDB_cursor *cursor;
int ret;
ret = mdb_cursor_open(Txn_val(txn), Nativeint_val(dbi), &cursor);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
ml_cursor = alloc_cursor(cursor);
Store_field(result, 0, ml_cursor);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_cursor_close(value cursor) {
mdb_cursor_close(Cursor_val(cursor));
return Val_unit;
}
CAMLprim value stub_mdb_cursor_renew(value txn, value cursor) {
return Val_int(mdb_cursor_renew(Txn_val(txn), Cursor_val(cursor)));
}
CAMLprim value stub_mdb_cursor_txn(value cursor) {
return (value) mdb_cursor_txn(Cursor_val(cursor));
}
CAMLprim value stub_mdb_cursor_dbi(value cursor) {
return Val_int(mdb_cursor_dbi(Cursor_val(cursor)));
}
CAMLprim value stub_mdb_cursor_get(value cursor, value key, value data, value op) {
CAMLparam4(cursor, key, data, op);
CAMLlocal2(result, tuple);
MDB_val k, v;
int ret;
if (Is_block(key)) {
k.mv_size = caml_string_length(Field(key, 0));
k.mv_data = String_val(Field(key, 0));
}
if (Is_block(data)) {
v.mv_size = Caml_ba_array_val(Field(data, 0))->dim[0];
v.mv_data = Caml_ba_data_val(Field(data, 0));
}
ret = mdb_cursor_get(Cursor_val(cursor), &k, &v, Int_val(op));
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
tuple = caml_alloc_tuple(2);
Store_field(tuple, 0, alloc_mdb_val_ba(&k));
Store_field(tuple, 1, alloc_mdb_val_ba(&v));
Store_field(result, 0, tuple);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_cursor_get_string(value cursor, value key, value data, value op) {
CAMLparam4(cursor, key, data, op);
CAMLlocal2(result, tuple);
MDB_val k, v;
int ret;
if (Is_block(key)) {
k.mv_size = caml_string_length(Field(key, 0));
k.mv_data = String_val(Field(key, 0));
}
if (Is_block(data)) {
v.mv_size = caml_string_length(Field(data, 0));
v.mv_data = String_val(Field(data, 0));
}
ret = mdb_cursor_get(Cursor_val(cursor), &k, &v, Int_val(op));
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
tuple = caml_alloc_tuple(2);
Store_field(tuple, 0, alloc_mdb_val_ba(&k));
Store_field(tuple, 1, alloc_mdb_val_ba(&v));
Store_field(result, 0, tuple);
}
CAMLreturn(result);
}
CAMLprim value stub_mdb_cursor_put(value cursor, value key, value data, value flags) {
MDB_val k, v;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
v.mv_size = Caml_ba_array_val(data)->dim[0];
v.mv_data = Caml_ba_data_val(data);
return Val_int(mdb_cursor_put(Cursor_val(cursor), &k, &v, Int_val(flags)));
}
CAMLprim value stub_mdb_cursor_put_string(value cursor, value key, value data, value flags) {
MDB_val k, v;
k.mv_size = caml_string_length(key);
k.mv_data = String_val(key);
v.mv_size = caml_string_length(data);
v.mv_data = String_val(data);
return Val_int(mdb_cursor_put(Cursor_val(cursor), &k, &v, Int_val(flags)));
}
CAMLprim value stub_mdb_cursor_del(value cursor, value flags) {
return Val_int(mdb_cursor_del(Cursor_val(cursor), Int_val(flags)));
}
CAMLprim value stub_mdb_cursor_count(value cursor) {
CAMLparam1(cursor);
CAMLlocal1(result);
mdb_size_t count;
int ret;
ret = mdb_cursor_count(Cursor_val(cursor), &count);
if (ret) {
result = caml_alloc(1, 1);
Store_field(result, 0, Val_int(ret));
}
else {
result = caml_alloc(1, 0);
Store_field(result, 0, Val_long(count));
}
CAMLreturn(result);
}
/* --------------------------------------------------------------------------
Copyright (c) 2018 Vincent Bernardoff
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
--------------------------------------------------------------------------- */