commit 03ab5b5471a21954be76755d25e189121db9504a Author: eknauel Date: Fri Sep 17 10:50:50 2004 +0000 *** empty log message *** diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..da8168b --- /dev/null +++ b/.gitignore @@ -0,0 +1,28 @@ +# CVS default ignores begin +tags +TAGS +.make.state +.nse_depinfo +*~ +\#* +.#* +,* +_$* +*$ +*.old +*.bak +*.BAK +*.orig +*.rej +.del-* +*.a +*.olb +*.o +*.obj +*.so +*.exe +*.Z +*.elc +*.ln +core +# CVS default ignores end diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 0000000..3c112d0 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,2 @@ +Daniel Brintzinger +Eric Knauel diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..59bb642 --- /dev/null +++ b/COPYING @@ -0,0 +1,26 @@ +Copyright (c) 2004 by Eric Knauel +Copyright (c) 2004 by Daniel Brintzinger + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the authors may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..e69de29 diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..54caf7c --- /dev/null +++ b/INSTALL @@ -0,0 +1,229 @@ +Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software +Foundation, Inc. + + This file is free documentation; the Free Software Foundation gives +unlimited permission to copy, distribute and modify it. + +Basic Installation +================== + + These are generic installation instructions. + + The `configure' shell script attempts to guess correct values for +various system-dependent variables used during compilation. It uses +those values to create a `Makefile' in each directory of the package. +It may also create one or more `.h' files containing system-dependent +definitions. Finally, it creates a shell script `config.status' that +you can run in the future to recreate the current configuration, and a +file `config.log' containing compiler output (useful mainly for +debugging `configure'). + + It can also use an optional file (typically called `config.cache' +and enabled with `--cache-file=config.cache' or simply `-C') that saves +the results of its tests to speed up reconfiguring. (Caching is +disabled by default to prevent problems with accidental use of stale +cache files.) + + If you need to do unusual things to compile the package, please try +to figure out how `configure' could check whether to do them, and mail +diffs or instructions to the address given in the `README' so they can +be considered for the next release. If you are using the cache, and at +some point `config.cache' contains results you don't want to keep, you +may remove or edit it. + + The file `configure.ac' (or `configure.in') is used to create +`configure' by a program called `autoconf'. You only need +`configure.ac' if you want to change it or regenerate `configure' using +a newer version of `autoconf'. + +The simplest way to compile this package is: + + 1. `cd' to the directory containing the package's source code and type + `./configure' to configure the package for your system. If you're + using `csh' on an old version of System V, you might need to type + `sh ./configure' instead to prevent `csh' from trying to execute + `configure' itself. + + Running `configure' takes awhile. While running, it prints some + messages telling which features it is checking for. + + 2. Type `make' to compile the package. + + 3. Optionally, type `make check' to run any self-tests that come with + the package. + + 4. Type `make install' to install the programs and any data files and + documentation. + + 5. You can remove the program binaries and object files from the + source code directory by typing `make clean'. To also remove the + files that `configure' created (so you can compile the package for + a different kind of computer), type `make distclean'. There is + also a `make maintainer-clean' target, but that is intended mainly + for the package's developers. If you use it, you may have to get + all sorts of other programs in order to regenerate files that came + with the distribution. + +Compilers and Options +===================== + + Some systems require unusual options for compilation or linking that +the `configure' script does not know about. Run `./configure --help' +for details on some of the pertinent environment variables. + + You can give `configure' initial values for configuration parameters +by setting variables in the command line or in the environment. Here +is an example: + + ./configure CC=c89 CFLAGS=-O2 LIBS=-lposix + + *Note Defining Variables::, for more details. + +Compiling For Multiple Architectures +==================================== + + You can compile the package for more than one kind of computer at the +same time, by placing the object files for each architecture in their +own directory. To do this, you must use a version of `make' that +supports the `VPATH' variable, such as GNU `make'. `cd' to the +directory where you want the object files and executables to go and run +the `configure' script. `configure' automatically checks for the +source code in the directory that `configure' is in and in `..'. + + If you have to use a `make' that does not support the `VPATH' +variable, you have to compile the package for one architecture at a +time in the source code directory. After you have installed the +package for one architecture, use `make distclean' before reconfiguring +for another architecture. + +Installation Names +================== + + By default, `make install' will install the package's files in +`/usr/local/bin', `/usr/local/man', etc. You can specify an +installation prefix other than `/usr/local' by giving `configure' the +option `--prefix=PATH'. + + You can specify separate installation prefixes for +architecture-specific files and architecture-independent files. If you +give `configure' the option `--exec-prefix=PATH', the package will use +PATH as the prefix for installing programs and libraries. +Documentation and other data files will still use the regular prefix. + + In addition, if you use an unusual directory layout you can give +options like `--bindir=PATH' to specify different values for particular +kinds of files. Run `configure --help' for a list of the directories +you can set and what kinds of files go in them. + + If the package supports it, you can cause programs to be installed +with an extra prefix or suffix on their names by giving `configure' the +option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. + +Optional Features +================= + + Some packages pay attention to `--enable-FEATURE' options to +`configure', where FEATURE indicates an optional part of the package. +They may also pay attention to `--with-PACKAGE' options, where PACKAGE +is something like `gnu-as' or `x' (for the X Window System). The +`README' should mention any `--enable-' and `--with-' options that the +package recognizes. + + For packages that use the X Window System, `configure' can usually +find the X include and library files automatically, but if it doesn't, +you can use the `configure' options `--x-includes=DIR' and +`--x-libraries=DIR' to specify their locations. + +Specifying the System Type +========================== + + There may be some features `configure' cannot figure out +automatically, but needs to determine by the type of machine the package +will run on. Usually, assuming the package is built to be run on the +_same_ architectures, `configure' can figure that out, but if it prints +a message saying it cannot guess the machine type, give it the +`--build=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name which has the form: + + CPU-COMPANY-SYSTEM + +where SYSTEM can have one of these forms: + + OS KERNEL-OS + + See the file `config.sub' for the possible values of each field. If +`config.sub' isn't included in this package, then this package doesn't +need to know the machine type. + + If you are _building_ compiler tools for cross-compiling, you should +use the `--target=TYPE' option to select the type of system they will +produce code for. + + If you want to _use_ a cross compiler, that generates code for a +platform different from the build platform, you should specify the +"host" platform (i.e., that on which the generated programs will +eventually be run) with `--host=TYPE'. + +Sharing Defaults +================ + + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. +`configure' looks for `PREFIX/share/config.site' if it exists, then +`PREFIX/etc/config.site' if it exists. Or, you can set the +`CONFIG_SITE' environment variable to the location of the site script. +A warning: not all `configure' scripts look for a site script. + +Defining Variables +================== + + Variables not defined in a site shell script can be set in the +environment passed to `configure'. However, some packages may run +configure again during the build, and the customized values of these +variables may be lost. In order to avoid this problem, you should set +them in the `configure' command line, using `VAR=value'. For example: + + ./configure CC=/usr/local2/bin/gcc + +will cause the specified gcc to be used as the C compiler (unless it is +overridden in the site shell script). + +`configure' Invocation +====================== + + `configure' recognizes the following options to control how it +operates. + +`--help' +`-h' + Print a summary of the options to `configure', and exit. + +`--version' +`-V' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`--cache-file=FILE' + Enable the cache: use and save the results of the tests in FILE, + traditionally `config.cache'. FILE defaults to `/dev/null' to + disable caching. + +`--config-cache' +`-C' + Alias for `--cache-file=config.cache'. + +`--quiet' +`--silent' +`-q' + Do not print messages saying which checks are being made. To + suppress all normal output, redirect it to `/dev/null' (any error + messages will still be shown). + +`--srcdir=DIR' + Look for the package's source code in directory DIR. Usually + `configure' can determine that directory automatically. + +`configure' also accepts some other, not widely useful, options. Run +`configure --help' for more details. + diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..75a8c9d --- /dev/null +++ b/Makefile.am @@ -0,0 +1 @@ +SUBDIRS = c \ No newline at end of file diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..e69de29 diff --git a/README b/README new file mode 100644 index 0000000..e69de29 diff --git a/c/Makefile.am b/c/Makefile.am new file mode 100644 index 0000000..a575001 --- /dev/null +++ b/c/Makefile.am @@ -0,0 +1,8 @@ +INCLUDES = -I@top_srcdir@/c + +libsys_LTLIBRARIES= libscshbdb.la + +libscshbdb_la_SOURCES=bdb.c +libscshbdb_la_LDFLAGS=-avoid-version -module +libscshbdb_la_DEPENDENCIES= + diff --git a/c/bdb.c b/c/bdb.c new file mode 100644 index 0000000..0344c61 --- /dev/null +++ b/c/bdb.c @@ -0,0 +1,797 @@ +#include "bdb.h" + +/* initialise flag constants */ +static s48_value scheme_DB_RPCCLIENT = S48_FALSE; +static s48_value scheme_DB_INIT_LOCK = S48_FALSE; +static s48_value scheme_DB_JOINENV = S48_FALSE; +static s48_value scheme_DB_INIT_MPOOL = S48_FALSE; +static s48_value scheme_DB_INIT_LOG = S48_FALSE; +static s48_value scheme_DB_INIT_REP = S48_FALSE; +static s48_value scheme_DB_INIT_TXN = S48_FALSE; +static s48_value scheme_DB_RECOVER = S48_FALSE; +static s48_value scheme_DB_RECOVER_FATAL = S48_FALSE; +static s48_value scheme_DB_USE_ENVIRON = S48_FALSE; +static s48_value scheme_DB_USE_ENVIRON_ROOT = S48_FALSE; +static s48_value scheme_DB_CREATE = S48_FALSE; +static s48_value scheme_DB_LOCKDOWN = S48_FALSE; +static s48_value scheme_DB_PRIVATE = S48_FALSE; +static s48_value scheme_DB_SYSTEM_MEM = S48_FALSE; +static s48_value scheme_DB_THREAD = S48_FALSE; +static s48_value scheme_DB_XA_CREATE = S48_FALSE; +static s48_value scheme_DB_AUTO_COMMIT = S48_FALSE; +static s48_value scheme_DB_DIRTY_READ = S48_FALSE; +static s48_value scheme_DB_EXCL = S48_FALSE; +static s48_value scheme_DB_NOMMAP = S48_FALSE; +static s48_value scheme_DB_RDONLY = S48_FALSE; +static s48_value scheme_DB_TRUNCATE = S48_FALSE; +static s48_value scheme_DB_NOSYNC = S48_FALSE; +static s48_value scheme_DB_CONSUME = S48_FALSE; +static s48_value scheme_DB_CONSUME_WAIT = S48_FALSE; +static s48_value scheme_DB_GET_BOTH = S48_FALSE; +static s48_value scheme_DB_RMW = S48_FALSE; +static s48_value scheme_DB_MULTIPLE = S48_FALSE; +static s48_value scheme_DB_SET_RECNO = S48_FALSE; +static s48_value scheme_DB_APPEND = S48_FALSE; +static s48_value scheme_DB_NODUPDATA = S48_FALSE; +static s48_value scheme_DB_NOOVERWRITE = S48_FALSE; +static s48_value scheme_DB_CURRENT = S48_FALSE; +static s48_value scheme_DB_FIRST = S48_FALSE; +static s48_value scheme_DB_WRITECURSOR = S48_FALSE; +static s48_value scheme_DB_GET_BOTH_RANGE = S48_FALSE; +static s48_value scheme_DB_GET_RECNO = S48_FALSE; +static s48_value scheme_DB_JOIN_ITEM = S48_FALSE; +static s48_value scheme_DB_LAST = S48_FALSE; +static s48_value scheme_DB_NEXT = S48_FALSE; +static s48_value scheme_DB_NEXT_DUP = S48_FALSE; +static s48_value scheme_DB_NEXT_NODUP = S48_FALSE; +static s48_value scheme_DB_PREV = S48_FALSE; +static s48_value scheme_DB_SET = S48_FALSE; +static s48_value scheme_DB_SET_RANGE = S48_FALSE; +static s48_value scheme_DB_MULTIPLE_KEY = S48_FALSE; +static s48_value scheme_DB_TXN_NOSYNC = S48_FALSE; +static s48_value scheme_DB_TXN_NOWAIT = S48_FALSE; +static s48_value scheme_DB_TXN_SYNC = S48_FALSE; + +/* initialise DB_TYPES */ +static s48_value scheme_DB_BTREE = S48_FALSE; +static s48_value scheme_DB_HASH = S48_FALSE; +static s48_value scheme_DB_QUEUE = S48_FALSE; +static s48_value scheme_DB_RECNO = S48_FALSE; +static s48_value scheme_DB_UNKNOWN = S48_FALSE; + +s48_value scsh_enter_db(DB *h) +{ + s48_value rec = S48_FALSE; + + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(rec); + + rec = s48_make_record(bdb_db_record_type); + S48_RECORD_SET(rec, 0, s48_enter_integer((long) h)); + + S48_GC_UNPROTECT(); + return rec; +} + +s48_value scsh_enter_txnid(DB_TXN *txnid) +{ + s48_value rec = S48_FALSE; + + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(rec); + + rec = s48_make_record(bdb_txn_record_type); + S48_RECORD_SET(rec, 0, s48_enter_integer((long) txnid)); + + S48_GC_UNPROTECT(); + return rec; +} + +s48_value scsh_enter_cursor(DBC *dbc) +{ + s48_value rec = S48_FALSE; + + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(rec); + + rec = s48_make_record(bdb_dbc_record_type); + S48_RECORD_SET(rec, 0, s48_enter_integer((long) dbc)); + + S48_GC_UNPROTECT(); + return rec; +} + +s48_value scsh_enter_dbenv(DB_ENV *h) +{ + s48_value rec = S48_FALSE; + + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(rec); + + rec = s48_make_record(bdb_env_record_type); + S48_RECORD_SET(rec, 0, s48_enter_integer((long) h)); + + S48_GC_UNPROTECT(); + return rec; +} + +/* BDB operations */ + +/* database environment */ + +/* create an environment handle */ +s48_value scsh_bdb_env_create(s48_value sflags) +{ + + DB_ENV *dbenv; + int res; + u_int32_t flags = S48_FALSE; + + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(sflags); + flags = s48_extract_integer(sflags); + S48_GC_UNPROTECT(); + + res = db_env_create(&dbenv, flags); + + CHECK_BDB_RESULT_CODE(res); + return scsh_enter_env(dbenv); +} + +/* close an environment */ +s48_value scsh_bdb_env_close(s48_value env, s48_value sflags) +{ + int res; + DB_ENV *dbenv; + u_int32_t flags; + + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(env, sflags); + + dbenv = scsh_extract_dbenv(env); + flags = s48_extract_integer(sflags); + S48_GC_UNPROTECT(); + + res = dbenv->close(dbenv, flags); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +/* remove a database */ +/* s48_value scsh_bdb_dbremove(...) */ +/* { */ +/* DB_ENV->dbremove(); */ +/* } */ + +/* rename a database */ +/* s48_value scsh_bdb_dbrename(...) */ +/* { */ +/* DB_ENV->dbrename(); */ +/* } */ + +/* open an environment */ +s48_value scsh_bdb_env_open(s48_value env_handle, s48_value sdb_home, + s48_value sflags, s48_value smode) +{ + int res, mode; + char *dbhome; + DB_ENV *dbenv; + u_int32_t flags; + + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(env_handle, sdb_home, sflags, smode); + + dbhome = s48_extract_string(sdb_home); + dbenv = scsh_extract_dbenv(env_handle); + mode = s48_extract_integer(smode); + //flags = bdb_extract_flags(sflags); + // as of now default is set to transaction and locking support + flags = DB_CREATE | DB_INIT_LOG | DB_INIT_LOCK | DB_INIT_TXN; + + S48_GC_UNPROTECT(); + + res = dbenv->open(dbenv, dbhome, flags, mode); + CHECK_BDB_RESULT_CODE(res); + + return S48_TRUE; +} + +/* remove an environment */ +s48_value scsh_bdb_env_remove(s48_value db_home, s48_value sflags) +{ + DB_ENV *dbenv; + int res; + char *dbhome; + u_int32_t flags; + + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(db_home, sflags); + dbhome = s48_extract_string(db_home); + flags = s48_extract_integer(sflags); + + S48_GC_UNPROTECT(); + + res = dbenv->remove(dbenv, dbhome, flags); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +/* environment configuration */ + +/* set the environment data directory */ +/* s48_value scsh_bdb_env_set_data_dir(...) */ +/* { */ +/* DB_ENV->set_data_dir(); */ +/* } */ + +/* set the environment cryptographic key */ +/* s48_value scsh_bdb_env_set_encrypt(...) */ +/* { */ +/* DB_ENV->set_encrypt(); */ +/* } */ + +/* create DB - returns dbp handle */ +s48_value scsh_bdb_create(s48_value env, s48_value sflags) +{ + DB *dbp; + DB_ENV *dbenv; + int res; + u_int32_t flags; + + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(env, sflags); + flags = s48_extract_integer(sflags); + dbenv = EXTRACT_OPTIONAL_ENV(env); + S48_GC_UNPROTECT(); + + res = db_create(&dbp, dbenv, flags); + CHECK_BDB_RESULT_CODE(res); + return scsh_enter_db(dbp); +} + +/* open DB */ +s48_value scsh_bdb_open(s48_value db, s48_value sfile, s48_value sdatabase, + s48_value stxnid, s48_value stype, s48_value sflags, + s48_value smode) +{ + int res, mode; + char *dbfile; + char *database; + DB *dbp; + DB_TXN *txnid; + DBTYPE type; + u_int32_t flags; + + S48_DECLARE_GC_PROTECT(7); + S48_GC_PROTECT_7(db, sfile, sdatabase, stxnid, stype, sflags, smode); + dbfile = s48_extract_string(sfile); + database = EXTRACT_OPTIONAL_STRING(sdatabase); + dbp = scsh_extract_db(db); + txnid = EXTRACT_OPTIONAL_TXNID(stxnid); + type = s48_extract_integer(stype); + flags = s48_extract_integer(sflags); + mode = s48_extract_integer(smode); + + S48_GC_UNPROTECT(); + + res = dbp->open(dbp, txnid, dbfile, database, type, flags, mode); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +/* close DB */ +s48_value scsh_bdb_close(s48_value db, s48_value sflags) +{ + int res; + DB *dbp; + u_int32_t flags; + + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(db, sflags); + dbp= scsh_extract_db(db); + flags = s48_extract_integer(sflags); + S48_GC_UNPROTECT(); + + res = dbp->close(dbp, flags); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +s48_value scsh_bdb_truncate(s48_value db, s48_value stxnid, s48_value sflags) +{ + int res; + DB *dbp; + u_int32_t flags; + u_int32_t *countp; + DB_TXN *txnid; + + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(db, stxnid, sflags); + dbp= scsh_extract_db(db); + txnid = EXTRACT_OPTIONAL_TXNID(stxnid); + flags = s48_extract_integer(sflags); + S48_GC_UNPROTECT(); + + res = dbp->truncate(dbp, txnid, countp, flags); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +s48_value scsh_bdb_sync(s48_value db) +{ + int res; + DB *dbp; + + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(db); + dbp = scsh_extract_db(db); + S48_GC_UNPROTECT(); + + res = dbp->sync(dbp, 0); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +/* DBT as byte vectors */ +s48_value scsh_enter_DBT_as_bytevector(DBT* dt) +{ + int i; + s48_value res = S48_FALSE; + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(res); + + res = s48_make_byte_vector(dt->size, 0); + i = 0; + + for (i = 0; i < dt->size; i++) + S48_BYTE_VECTOR_SET(res, i, ((char*)(dt->data))[i]); + + S48_GC_UNPROTECT(); + return res; +} + +void scsh_extract_bytevector_as_DBT(s48_value bytevector, DBT* dt) +{ + S48_DECLARE_GC_PROTECT(1); + + S48_GC_PROTECT_1(bytevector); + dt->data = s48_extract_byte_vector(bytevector); + dt->size = S48_BYTE_VECTOR_LENGTH(bytevector); + S48_GC_UNPROTECT(); +} + +/* DBT operations */ + +/* Put key and data DBT's in DB */ +s48_value scsh_bdb_put(s48_value db, s48_value skey, s48_value sdata, + s48_value stxnid, s48_value sflags) +{ + int res; + DB *dbp; + DB_TXN *txnid; + DBT key, data; + u_int32_t flags; + S48_DECLARE_GC_PROTECT(5); + + S48_GC_PROTECT_5(db, skey, sdata, stxnid, sflags); + + dbp = scsh_extract_db(db); + txnid = EXTRACT_OPTIONAL_TXNID(stxnid); + flags = s48_extract_integer(sflags); + + scsh_extract_bytevector_as_DBT(skey, &key); + scsh_extract_bytevector_as_DBT(sdata, &data); + S48_GC_UNPROTECT(); + + res = dbp->put(dbp, txnid, &key, &data, flags); + CHECK_BDB_RESULT_CODE(res); + return scsh_enter_DBT_as_bytevector(&key); +} + +/* Get DBT to corresponding key */ +s48_value scsh_bdb_get(s48_value handle, s48_value skey, + s48_value stxnid, s48_value sflags) +{ + int res; + DB *dbp; + u_int32_t flags; + DB_TXN *txnid; + DBT key, data; + + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(handle, skey, stxnid, sflags); + + dbp = scsh_extract_db(handle); + flags = s48_extract_integer(sflags); + txnid = EXTRACT_OPTIONAL_TXNID(stxnid); + scsh_extract_bytevector_as_DBT(skey, &key); + S48_GC_UNPROTECT(); + + res = dbp->get(dbp, txnid, &key, &data, flags); + CHECK_BDB_RESULT_CODE(res); + return scsh_enter_DBT_as_bytevector(&data); +} + +/* Delete DBT to corresponding key */ +s48_value scsh_bdb_del(s48_value handle, s48_value skey, + s48_value stxnid, s48_value sflags) +{ + int res; + DB* dbp; + DB_TXN *txnid; + DBT key; + u_int32_t flags; + + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(handle, skey, stxnid, sflags); + + dbp = scsh_extract_db(handle); + flags = s48_extract_integer(sflags); + txnid = EXTRACT_OPTIONAL_TXNID(stxnid); + scsh_extract_bytevector_as_DBT(skey, &key); + + S48_GC_UNPROTECT(); + res = dbp->del(dbp, txnid, &key, flags); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +s48_value scsh_bdb_create_cursor(s48_value handle, s48_value stxnid, + s48_value sflags) +{ + int res; + DB* dbp; + DBC* dbcp; + DB_TXN *txnid; + u_int32_t flags; + s48_value ret = S48_FALSE; + + S48_DECLARE_GC_PROTECT(4); + S48_GC_PROTECT_4(handle, stxnid, sflags, ret); + + dbp = scsh_extract_db(handle); + flags = s48_extract_integer(sflags); + txnid = EXTRACT_OPTIONAL_TXNID(stxnid); + + S48_GC_UNPROTECT(); + res = dbp->cursor(dbp,txnid, &dbcp, flags); + CHECK_BDB_RESULT_CODE(res); + return scsh_enter_cursor(dbcp); +} + +/* retrieve values from cursor */ +s48_value scsh_bdb_cursor_cget(s48_value dbc, s48_value sflags) +{ + int res; + DBC* dbcp; + u_int32_t flags; + DBT *key, *data; + + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(dbc, sflags); + + dbcp = scsh_extract_cursor(dbc); + flags = s48_extract_integer(sflags); + S48_GC_UNPROTECT(); + + res = dbcp->c_get(dbcp, key, data, flags); + CHECK_BDB_RESULT_CODE(res); + return scsh_enter_DBT_as_bytevector(data); +} + +s48_value scsh_bdb_txn_begin (s48_value handle, s48_value sparent, + s48_value sflags) +{ + int res; + DB_ENV* env; + DBC* dbcp; + DB_TXN* parent, *txnid; + u_int32_t flags; + s48_value ret = S48_FALSE; + //parent = NULL; // only for nested transactions + + S48_DECLARE_GC_PROTECT(3); + S48_GC_PROTECT_3(handle, sflags, ret); + + env = scsh_extract_env(handle); + flags = s48_extract_integer(sflags); + S48_GC_UNPROTECT(); + + res = env->txn_begin(env, NULL, &txnid, flags); + CHECK_BDB_RESULT_CODE(res); + return scsh_enter_txnid(txnid); +} + +s48_value scsh_bdb_txn_abort(s48_value stxnid) +{ + int res; + DB_TXN *txnid; + s48_value ret = S48_FALSE; + + S48_DECLARE_GC_PROTECT(1); + S48_GC_PROTECT_1(stxnid); + + txnid = EXTRACT_OPTIONAL_TXNID(stxnid); + S48_GC_UNPROTECT(); + + res = txnid->abort(txnid); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +s48_value scsh_bdb_txn_commit(s48_value stxnid, s48_value sflags) +{ + int res; + DB_TXN *txnid; + s48_value ret = S48_FALSE; + u_int32_t flags; + S48_DECLARE_GC_PROTECT(2); + S48_GC_PROTECT_2(stxnid, sflags); + flags = s48_extract_integer(sflags); + txnid = EXTRACT_OPTIONAL_TXNID(stxnid); + S48_GC_UNPROTECT(); + + res = txnid->commit(txnid, flags); + CHECK_BDB_RESULT_CODE(res); + return S48_TRUE; +} + +/* initialize bindings */ +void scsh_init_bdb_bindings(void) +{ + /* records */ + S48_GC_PROTECT_GLOBAL(bdb_db_record_type); + bdb_db_record_type = s48_get_imported_binding("bdb-db"); + + S48_GC_PROTECT_GLOBAL(bdb_env_record_type); + bdb_env_record_type = s48_get_imported_binding("bdb-env"); + + S48_GC_PROTECT_GLOBAL(bdb_mpoolfile_record_type); + bdb_mpoolfile_record_type = s48_get_imported_binding("bdb-mpoolfile"); + + S48_GC_PROTECT_GLOBAL(bdb_txn_record_type); + bdb_txn_record_type = s48_get_imported_binding("bdb-txn"); + + S48_GC_PROTECT_GLOBAL(bdb_dbc_record_type); + bdb_dbc_record_type = s48_get_imported_binding("bdb-dbc"); + + /* flag constants */ + S48_GC_PROTECT_GLOBAL(scheme_DB_RPCCLIENT); + scheme_DB_RPCCLIENT = s48_enter_integer(DB_RPCCLIENT); + s48_define_exported_binding("scheme_DB_RPCCLIENT",scheme_DB_RPCCLIENT); + + S48_GC_PROTECT_GLOBAL(scheme_DB_INIT_LOCK); + scheme_DB_INIT_LOCK = s48_enter_integer(DB_INIT_LOCK); + s48_define_exported_binding("scheme_DB_INIT_LOCK",scheme_DB_INIT_LOCK); + + S48_GC_PROTECT_GLOBAL(scheme_DB_JOINENV); + scheme_DB_JOINENV = s48_enter_integer(DB_JOINENV); + s48_define_exported_binding("scheme_DB_JOINENV",scheme_DB_JOINENV); + + S48_GC_PROTECT_GLOBAL(scheme_DB_INIT_MPOOL); + scheme_DB_INIT_MPOOL = s48_enter_integer(DB_INIT_MPOOL); + s48_define_exported_binding("scheme_DB_INIT_MPOOL",scheme_DB_INIT_MPOOL); + + S48_GC_PROTECT_GLOBAL(scheme_DB_INIT_LOG); + scheme_DB_INIT_LOG = s48_enter_integer(DB_INIT_LOG); + s48_define_exported_binding("scheme_DB_INIT_LOG",scheme_DB_INIT_LOG); + + S48_GC_PROTECT_GLOBAL(scheme_DB_INIT_REP); + scheme_DB_INIT_REP = s48_enter_integer(DB_INIT_REP); + s48_define_exported_binding("scheme_DB_INIT_REP",scheme_DB_INIT_REP); + + S48_GC_PROTECT_GLOBAL(scheme_DB_INIT_TXN); + scheme_DB_INIT_TXN = s48_enter_integer(DB_INIT_TXN); + s48_define_exported_binding("scheme_DB_INIT_TXN",scheme_DB_INIT_TXN); + + S48_GC_PROTECT_GLOBAL(scheme_DB_RECOVER); + scheme_DB_RECOVER = s48_enter_integer(DB_RECOVER); + s48_define_exported_binding("scheme_DB_RECOVER",scheme_DB_RECOVER); + + S48_GC_PROTECT_GLOBAL(scheme_DB_RECOVER_FATAL); + scheme_DB_RECOVER_FATAL = s48_enter_integer(DB_RECOVER_FATAL); + s48_define_exported_binding("scheme_DB_RECOVER_FATAL",scheme_DB_RECOVER_FATAL); + + S48_GC_PROTECT_GLOBAL(scheme_DB_USE_ENVIRON); + scheme_DB_USE_ENVIRON = s48_enter_integer(DB_USE_ENVIRON); + s48_define_exported_binding("scheme_DB_USE_ENVIRON",scheme_DB_USE_ENVIRON); + + S48_GC_PROTECT_GLOBAL(scheme_DB_USE_ENVIRON_ROOT); + scheme_DB_USE_ENVIRON_ROOT = s48_enter_integer(DB_USE_ENVIRON_ROOT); + s48_define_exported_binding("scheme_DB_USE_ENVIRON_ROOT",scheme_DB_USE_ENVIRON_ROOT); + + S48_GC_PROTECT_GLOBAL(scheme_DB_CREATE); + scheme_DB_CREATE = s48_enter_integer(DB_CREATE); + s48_define_exported_binding("scheme_DB_CREATE",scheme_DB_CREATE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_LOCKDOWN); + scheme_DB_LOCKDOWN = s48_enter_integer(DB_LOCKDOWN); + s48_define_exported_binding("scheme_DB_LOCKDOWN",scheme_DB_LOCKDOWN); + + S48_GC_PROTECT_GLOBAL(scheme_DB_PRIVATE); + scheme_DB_PRIVATE = s48_enter_integer(DB_PRIVATE); + s48_define_exported_binding("scheme_DB_PRIVATE",scheme_DB_PRIVATE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_SYSTEM_MEM); + scheme_DB_SYSTEM_MEM = s48_enter_integer(DB_SYSTEM_MEM); + s48_define_exported_binding("scheme_DB_SYSTEM_MEM",scheme_DB_SYSTEM_MEM); + + S48_GC_PROTECT_GLOBAL(scheme_DB_THREAD); + scheme_DB_THREAD = s48_enter_integer(DB_THREAD); + s48_define_exported_binding("scheme_DB_THREAD",scheme_DB_THREAD); + + S48_GC_PROTECT_GLOBAL(scheme_DB_AUTO_COMMIT); + scheme_DB_AUTO_COMMIT = s48_enter_integer(DB_AUTO_COMMIT); + s48_define_exported_binding("scheme_DB_AUTO_COMMIT",scheme_DB_AUTO_COMMIT); + + S48_GC_PROTECT_GLOBAL(scheme_DB_DIRTY_READ); + scheme_DB_DIRTY_READ = s48_enter_integer(DB_DIRTY_READ); + s48_define_exported_binding("scheme_DB_DIRTY_READ",scheme_DB_DIRTY_READ); + + S48_GC_PROTECT_GLOBAL(scheme_DB_EXCL); + scheme_DB_EXCL = s48_enter_integer(DB_EXCL); + s48_define_exported_binding("scheme_DB_EXCL",scheme_DB_EXCL); + + S48_GC_PROTECT_GLOBAL(scheme_DB_NOMMAP); + scheme_DB_NOMMAP = s48_enter_integer(DB_NOMMAP); + s48_define_exported_binding("scheme_DB_NOMMAP",scheme_DB_NOMMAP); + + S48_GC_PROTECT_GLOBAL(scheme_DB_RDONLY); + scheme_DB_RDONLY = s48_enter_integer(DB_RDONLY); + s48_define_exported_binding("scheme_DB_RDONLY",scheme_DB_RDONLY); + + S48_GC_PROTECT_GLOBAL(scheme_DB_SYSTEM_MEM); + scheme_DB_SYSTEM_MEM = s48_enter_integer(DB_SYSTEM_MEM); + s48_define_exported_binding("scheme_DB_SYSTEM_MEM",scheme_DB_SYSTEM_MEM); + + S48_GC_PROTECT_GLOBAL(scheme_DB_TRUNCATE); + scheme_DB_TRUNCATE = s48_enter_integer(DB_TRUNCATE); + s48_define_exported_binding("scheme_DB_TRUNCATE",scheme_DB_TRUNCATE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_NOSYNC); + scheme_DB_NOSYNC = s48_enter_integer(DB_NOSYNC); + s48_define_exported_binding("scheme_DB_NOSYNC",scheme_DB_NOSYNC); + + S48_GC_PROTECT_GLOBAL(scheme_DB_CONSUME); + scheme_DB_CONSUME = s48_enter_integer(DB_CONSUME); + s48_define_exported_binding("scheme_DB_CONSUME",scheme_DB_CONSUME); + + S48_GC_PROTECT_GLOBAL(scheme_DB_CONSUME_WAIT); + scheme_DB_CONSUME_WAIT = s48_enter_integer(DB_CONSUME_WAIT); + s48_define_exported_binding("scheme_DB_CONSUME_WAIT",scheme_DB_CONSUME_WAIT); + + S48_GC_PROTECT_GLOBAL(scheme_DB_GET_BOTH); + scheme_DB_GET_BOTH = s48_enter_integer(DB_GET_BOTH); + s48_define_exported_binding("scheme_DB_GET_BOTH",scheme_DB_GET_BOTH); + + S48_GC_PROTECT_GLOBAL(scheme_DB_RMW); + scheme_DB_RMW = s48_enter_integer(DB_RMW); + s48_define_exported_binding("scheme_DB_RMW",scheme_DB_RMW); + + S48_GC_PROTECT_GLOBAL(scheme_DB_MULTIPLE); + scheme_DB_MULTIPLE = s48_enter_integer(DB_MULTIPLE); + s48_define_exported_binding("scheme_DB_MULTIPLE",scheme_DB_MULTIPLE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_SET_RECNO); + scheme_DB_SET_RECNO = s48_enter_integer(DB_SET_RECNO); + s48_define_exported_binding("scheme_DB_SET_RECNO",scheme_DB_SET_RECNO); + + S48_GC_PROTECT_GLOBAL(scheme_DB_APPEND); + scheme_DB_APPEND = s48_enter_integer(DB_APPEND); + s48_define_exported_binding("scheme_DB_APPEND",scheme_DB_APPEND); + + S48_GC_PROTECT_GLOBAL(scheme_DB_NODUPDATA); + scheme_DB_NODUPDATA = s48_enter_integer(DB_NODUPDATA); + s48_define_exported_binding("scheme_DB_NODUPDATA",scheme_DB_NODUPDATA); + + S48_GC_PROTECT_GLOBAL(scheme_DB_NOOVERWRITE); + scheme_DB_NOOVERWRITE = s48_enter_integer(DB_NOOVERWRITE); + s48_define_exported_binding("scheme_DB_NOOVERWRITE",scheme_DB_NOOVERWRITE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_CURRENT); + scheme_DB_CURRENT = s48_enter_integer(DB_CURRENT); + s48_define_exported_binding("scheme_DB_CURRENT",scheme_DB_CURRENT); + + S48_GC_PROTECT_GLOBAL(scheme_DB_FIRST); + scheme_DB_FIRST = s48_enter_integer(DB_FIRST); + s48_define_exported_binding("scheme_DB_FIRST",scheme_DB_FIRST); + + S48_GC_PROTECT_GLOBAL(scheme_DB_WRITECURSOR); + scheme_DB_WRITECURSOR = s48_enter_integer(DB_WRITECURSOR); + s48_define_exported_binding("scheme_DB_WRITECURSOR",scheme_DB_WRITECURSOR); + + S48_GC_PROTECT_GLOBAL(scheme_DB_GET_BOTH_RANGE); + scheme_DB_GET_BOTH_RANGE = s48_enter_integer(DB_GET_BOTH_RANGE); + s48_define_exported_binding("scheme_DB_GET_BOTH_RANGE",scheme_DB_GET_BOTH_RANGE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_GET_RECNO); + scheme_DB_GET_RECNO = s48_enter_integer(DB_GET_RECNO); + s48_define_exported_binding("scheme_DB_GET_RECNO",scheme_DB_GET_RECNO); + + S48_GC_PROTECT_GLOBAL(scheme_DB_JOIN_ITEM); + scheme_DB_JOIN_ITEM = s48_enter_integer(DB_JOIN_ITEM); + s48_define_exported_binding("scheme_DB_JOIN_ITEM",scheme_DB_JOIN_ITEM); + + S48_GC_PROTECT_GLOBAL(scheme_DB_LAST); + scheme_DB_LAST = s48_enter_integer(DB_LAST); + s48_define_exported_binding("scheme_DB_LAST",scheme_DB_LAST); + + S48_GC_PROTECT_GLOBAL(scheme_DB_NEXT); + scheme_DB_NEXT = s48_enter_integer(DB_NEXT); + s48_define_exported_binding("scheme_DB_NEXT",scheme_DB_NEXT); + + S48_GC_PROTECT_GLOBAL(scheme_DB_NEXT_DUP); + scheme_DB_NEXT_DUP = s48_enter_integer(DB_NEXT_DUP); + s48_define_exported_binding("scheme_DB_NEXT_DUP",scheme_DB_NEXT_DUP); + + S48_GC_PROTECT_GLOBAL(scheme_DB_NEXT_NODUP); + scheme_DB_NEXT_NODUP = s48_enter_integer(DB_NEXT_NODUP); + s48_define_exported_binding("scheme_DB_NEXT_NODUP",scheme_DB_NEXT_NODUP); + + S48_GC_PROTECT_GLOBAL(scheme_DB_PREV); + scheme_DB_PREV = s48_enter_integer(DB_PREV); + s48_define_exported_binding("scheme_DB_PREV",scheme_DB_PREV); + + S48_GC_PROTECT_GLOBAL(scheme_DB_SET); + scheme_DB_SET = s48_enter_integer(DB_SET); + s48_define_exported_binding("scheme_DB_SET",scheme_DB_SET); + + S48_GC_PROTECT_GLOBAL(scheme_DB_SET_RANGE); + scheme_DB_SET_RANGE = s48_enter_integer(DB_SET_RANGE); + s48_define_exported_binding("scheme_DB_SET_RANGE",scheme_DB_SET_RANGE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_MULTIPLE_KEY); + scheme_DB_MULTIPLE_KEY = s48_enter_integer(DB_MULTIPLE_KEY); + s48_define_exported_binding("scheme_DB_MULTIPLE_KEY",scheme_DB_MULTIPLE_KEY); + + S48_GC_PROTECT_GLOBAL(scheme_DB_TXN_NOSYNC); + scheme_DB_TXN_NOSYNC = s48_enter_integer(DB_TXN_NOSYNC); + s48_define_exported_binding("scheme_DB_TXN_NOSYNC",scheme_DB_TXN_NOSYNC); + + S48_GC_PROTECT_GLOBAL(scheme_DB_TXN_NOWAIT); + scheme_DB_TXN_NOWAIT = s48_enter_integer(DB_TXN_NOWAIT); + s48_define_exported_binding("scheme_DB_TXN_NOWAIT",scheme_DB_TXN_NOWAIT); + + S48_GC_PROTECT_GLOBAL(scheme_DB_TXN_SYNC); + scheme_DB_TXN_SYNC = s48_enter_integer(DB_TXN_SYNC); + s48_define_exported_binding("scheme_DB_TXN_SYNC",scheme_DB_TXN_SYNC); + + S48_GC_PROTECT_GLOBAL(scheme_DB_BTREE); + scheme_DB_BTREE = s48_enter_integer(DB_BTREE); + s48_define_exported_binding("scheme_DB_BTREE",scheme_DB_BTREE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_HASH); + scheme_DB_HASH = s48_enter_integer(DB_HASH); + s48_define_exported_binding("scheme_DB_HASH",scheme_DB_HASH); + + S48_GC_PROTECT_GLOBAL(scheme_DB_QUEUE); + scheme_DB_QUEUE = s48_enter_integer(DB_QUEUE); + s48_define_exported_binding("scheme_DB_QUEUE",scheme_DB_QUEUE); + + S48_GC_PROTECT_GLOBAL(scheme_DB_RECNO); + scheme_DB_RECNO = s48_enter_integer(DB_RECNO); + s48_define_exported_binding("scheme_DB_RECNO",scheme_DB_RECNO); + + S48_GC_PROTECT_GLOBAL(scheme_DB_UNKNOWN); + scheme_DB_UNKNOWN = s48_enter_integer(DB_UNKNOWN); + s48_define_exported_binding("scheme_DB_UNKNOWN",scheme_DB_UNKNOWN); + + /* export functions to scheme */ + S48_EXPORT_FUNCTION(scsh_bdb_create); + S48_EXPORT_FUNCTION(scsh_bdb_open); + S48_EXPORT_FUNCTION(scsh_bdb_close); + S48_EXPORT_FUNCTION(scsh_bdb_put); + S48_EXPORT_FUNCTION(scsh_bdb_get); + S48_EXPORT_FUNCTION(scsh_bdb_del); + S48_EXPORT_FUNCTION(scsh_bdb_env_create); + S48_EXPORT_FUNCTION(scsh_bdb_env_open); + S48_EXPORT_FUNCTION(scsh_bdb_env_close); + S48_EXPORT_FUNCTION(scsh_bdb_env_remove); + S48_EXPORT_FUNCTION(scsh_bdb_truncate); + S48_EXPORT_FUNCTION(scsh_bdb_sync); + S48_EXPORT_FUNCTION(scsh_bdb_create_cursor); + S48_EXPORT_FUNCTION(scsh_bdb_cursor_cget); + S48_EXPORT_FUNCTION(scsh_bdb_txn_begin); + S48_EXPORT_FUNCTION(scsh_bdb_txn_abort); + S48_EXPORT_FUNCTION(scsh_bdb_txn_commit); +} diff --git a/c/bdb.h b/c/bdb.h new file mode 100644 index 0000000..2233316 --- /dev/null +++ b/c/bdb.h @@ -0,0 +1,48 @@ +#include +#include +#include +#include + +#include "scheme48.h" +#include "db.h" + +/* record types */ +static s48_value bdb_db_record_type = S48_FALSE; +static s48_value bdb_env_record_type = S48_FALSE; +static s48_value bdb_mpoolfile_record_type = S48_FALSE; +static s48_value bdb_txn_record_type = S48_FALSE; +static s48_value bdb_dbc_record_type = S48_FALSE; + +/* prototypes and macros */ +s48_value scsh_enter_db(DB *h); +#define scsh_extract_db(x) \ + ((DB *) s48_extract_integer(S48_RECORD_REF(x, 0))) + +s48_value scsh_enter_txnid(DB_TXN *txnid); +#define scsh_extract_txnid(x) \ + ((DB_TXN *) s48_extract_integer(S48_RECORD_REF(x, 0))) + +s48_value scsh_enter_cursor(DBC *dbc); +#define scsh_extract_cursor(x) \ + ((DBC *) s48_extract_integer(S48_RECORD_REF(x, 0))) + +s48_value scsh_enter_dbenv(DB_ENV *h); +#define scsh_extract_dbenv(x) \ + ((DB_ENV *) s48_extract_integer(S48_RECORD_REF(x, 0))) + +#define CHECK_BDB_RESULT_CODE(res) \ + do { \ + if (res < 0) \ + s48_raise_os_error(res); \ + if (res > 0) \ + return s48_enter_integer(res); \ + } while (0); + +#define EXTRACT_OPTIONAL_STRING(string) \ + ((string == S48_FALSE) ? NULL : s48_extract_string(string)) + +#define EXTRACT_OPTIONAL_TXNID(txnid) \ + ((txnid == S48_FALSE) ? NULL : scsh_extract_txnid(txnid)) + +#define EXTRACT_OPTIONAL_ENV(env) \ + ((env == S48_FALSE) ? NULL : scsh_extract_dbenv(env)) diff --git a/configure.in b/configure.in new file mode 100644 index 0000000..90f5298 --- /dev/null +++ b/configure.in @@ -0,0 +1,39 @@ +AC_INIT(c/bdb.c) +AM_INIT_AUTOMAKE(scsh-bdb, 0.1) +AM_CONFIG_HEADER(c/config.h) + +AC_ENABLE_SHARED +AM_PROG_LIBTOOL + +AC_PROG_CC +AC_STDC_HEADERS + +dnl scsh include path +AC_ARG_WITH(scsh-includes, + AC_HELP_STRING([--with-scsh-includes=DIR], + [scsh include files are in DIR [default is /usr/local/include]]), + scsh_includes=$withval, + scsh_includes=/usr/local/include) +AC_SUBST(CFLAGS, "$CFLAGS -I${scsh_includes}") +AC_SUBST(CPPFLAGS, "$CPPFLAGS -I${scsh_includes}") + +dnl Berkeley DB prefix +AC_ARG_WITH(bdb-prefix, + AC_HELP_STRING([--with-bdb-prefix=DIR], + [Berkeley DB library and include have prefix DIR [default is /usr/local]]), + [bdb_lib=$withval/lib bdb_include=$withval/include], + [bdb_lib=/usr/local/lib bdb_include=/usr/local/include]) +AC_SUBST(LDFLAGS, "$LDFLAGS -L${bdb_lib} -ldb-4") +AC_SUBST(CFLAGS, "$CFLAGS -I${bdb_include}") +AC_SUBST(CPPFLAGS, "$CPPFLAGS -I${bdb_include}") + +schemedir='${prefix}'"/scheme" +libdir='${prefix}'"/lib" +libsysdir='${prefix}' + +AC_SUBST(libdir) +AC_SUBST(libsysdir) +AC_SUBST(schemedir) +AC_SUBST(CC) +AC_OUTPUT([Makefile c/Makefile]) + diff --git a/pkg-def.scm b/pkg-def.scm new file mode 100644 index 0000000..b2abdd5 --- /dev/null +++ b/pkg-def.scm @@ -0,0 +1,74 @@ +(define-package "bdb" (0 1 0) + ((install-lib-version (1 0)) + (options (bdb-prefix "Uses Berkeley DB library with prefix" "" #t #f #f))) + + (define (display-bold text) + (display "\033[1m") + (display text) + (display "\033[m")) + + (newline) + (display-bold "Configuring, compiling and installing C-stubs") + (newline) + + (let* ((scsh-includes (include-dir)) + (build-host (get-option-value 'build)) + (prefix (string-append (get-directory 'lib #f) "/" build-host)) + (configure (append + (list "./configure" + (string-append "--prefix=" prefix) + (string-append "--with-scsh-includes=" scsh-includes) + (string-append "--enable-static=no") + (string-append "--build=" build-host)) + (cond ((get-option-value 'bdb-prefix) + => (lambda (prefix) + (list + (string-append "--with-bdb-prefix=" prefix)))) + (else '())))) + (make `(make install + ,(string-append "DESTDIR=" (get-option-value 'dest-dir))))) + (if (get-option-value 'dry-run) + (begin + (display configure) (newline) + (display make) (newline)) + (if (not (and (zero? (run ,configure)) + (zero? (run ,make)))) + (exit)))) + + (newline) + (display-bold "Creating load.scm") + (newline) + + (let ((schemedir (get-directory 'scheme #f)) + (libdir (get-directory 'lib #f))) + (write-to-load-script + `((user) + (load-package 'dynamic-externals) + (open 'dynamic-externals) + (open 'external-calls) + (open 'configure) + (open 'signals) + ,@(map (lambda (x) `(run ',x)) tmpl-libtool-la-reader) + (run '(let* ((lib-dir (string-append ,libdir "/" (host))) + (la-file-name (string-append lib-dir "/libscshbdb.la")) + (initializer-name "scsh_init_bdb_bindings")) + (let ((la-alist (read-libtool-la la-file-name))) + (cond + ((assoc 'dlname la-alist) + => (lambda (p) + (let ((module-file (string-append lib-dir "/" (cdr p)))) + (dynamic-load module-file) + (call-external (get-external initializer-name))))) + (else + (error "Could not figure out libscshbdb's name" la-file-name)))))) + (config) + (load ,(string-append schemedir "/packages.scm")) + (user)))) + + (newline) + (display-bold "Installing Scheme files") + (newline) + + (install-directory-contents "scheme" 'scheme) + ) + diff --git a/scheme/bdb.scm b/scheme/bdb.scm new file mode 100644 index 0000000..e85e9f5 --- /dev/null +++ b/scheme/bdb.scm @@ -0,0 +1,603 @@ +;;; macro +(define-syntax lookup-shared-value + (syntax-rules () + ((lookup-shared-value %s) + (shared-binding-ref + (lookup-imported-binding %s))))) + +;;; weak lists +(define (cons-weak obj list) + (cons (make-weak-pointer obj) list)) + +(define (filter-collected list) + (filter (lambda (weak-pointer) + (not (weak-pointer-ref weak-pointer))) + list)) + +;;; fluids +(define $current-env (make-fluid #f)) +(define $current-db (make-fluid #f)) +(define $current-transaction-id (make-fluid #f)) + +(define (current-env) + (fluid $current-env)) + +(define (current-db) + (fluid $current-db)) + +(define (current-transaction-id) + (fluid $current-transaction-id)) + +(define (with-env db-env thunk) + (let-fluid $current-env db-env thunk)) + +(define (with-db db thunk) + (let-fluid $current-db db thunk)) + +(define (with-transaction options proc) + (let-fluid + $current-transaction-id + (bdb-begin-transaction options) + (lambda () + (proc (lambda () + (bdb-abort-transaction (current-transaction-id)))) + (bdb-commit-transaction (current-transaction-id))))) + +;; constants +(define-finite-type bdb-flags :bdb-flags + (id) + bdb-flags-object? + bdb-flags-elements + bdb-flags-name + bdb-flags-index + (id bdb-flags-id) + ((default 0) + (rpc-client (lookup-shared-value "scheme_DB_RPCCLIENT")) + (join-env (lookup-shared-value "scheme_DB_JOINENV")) + (init-lock (lookup-shared-value "scheme_DB_INIT_LOCK")) + (init-log (lookup-shared-value "scheme_DB_INIT_LOG")) + (init-mpool (lookup-shared-value "scheme_DB_INIT_MPOOL")) + (init-replication (lookup-shared-value "scheme_DB_INIT_REP")) + (init-transactions (lookup-shared-value "scheme_DB_INIT_TXN")) + (run-recover (lookup-shared-value "scheme_DB_RECOVER")) + (recover-fatal (lookup-shared-value "scheme_DB_RECOVER_FATAL")) + (use-environ (lookup-shared-value "scheme_DB_USE_ENVIRON")) + (use-environ-root (lookup-shared-value "scheme_DB_USE_ENVIRON_ROOT")) + (create (lookup-shared-value "scheme_DB_CREATE")) + (lockdown (lookup-shared-value "scheme_DB_LOCKDOWN")) + (private (lookup-shared-value "scheme_DB_PRIVATE")) + (system-mem (lookup-shared-value "scheme_DB_SYSTEM_MEM")) + (thread (lookup-shared-value "scheme_DB_THREAD")) + (force (lookup-shared-value "scheme_DB_FORCE")) + (xa-create (lookup-shared-value "scheme_DB_XA_CREATE")) + (auto-commit (lookup-shared-value "scheme_DB_AUTO_COMMIT")) + (dirty-read (lookup-shared-value "scheme_DB_DIRTY_READ")) + (excl (lookup-shared-value "scheme_DB_EXCL")) + (nommap (lookup-shared-value "scheme_DB_NOMMAP")) + (rdonly (lookup-shared-value "scheme_DB_RDONLY")) + (thread (lookup-shared-value "scheme_DB_SYSTEM_MEM")) + (truncate (lookup-shared-value "scheme_DB_TRUNCATE")) + (nosync (lookup-shared-value "scheme_DB_NOSYNC")) + (consume (lookup-shared-value "scheme_DB_CONSUME")) + (consume-wait (lookup-shared-value "scheme_DB_CONSUME_WAIT")) + (get-both (lookup-shared-value "scheme_DB_GET_BOTH")) + (multiple (lookup-shared-value "scheme_DB_MULTIPLE")) + (rmw (lookup-shared-value "scheme_DB_RMW")) + (set-recno (lookup-shared-value "scheme_DB_SET_RECNO")) + (append (lookup-shared-value "scheme_DB_APPEND")) + (nodupdata (lookup-shared-value "scheme_DB_NODUPDATA")) + (nooverwrite (lookup-shared-value "scheme_DB_NOOVERWRITE")) + (current (lookup-shared-value "scheme_DB_CURRENT")) + (first (lookup-shared-value "scheme_DB_FIRST")) + (get-both (lookup-shared-value "scheme_DB_GET_BOTH")) + (writecursor (lookup-shared-value "scheme_DB_WRITECURSOR")) + (get-both-range (lookup-shared-value "scheme_DB_GET_BOTH_RANGE")) + (get-recno (lookup-shared-value "scheme_DB_GET_RECNO")) + (join-item (lookup-shared-value "scheme_DB_JOIN_ITEM")) + (last (lookup-shared-value "scheme_DB_LAST")) + (next (lookup-shared-value "scheme_DB_NEXT")) + (next-dup (lookup-shared-value "scheme_DB_NEXT_DUP")) + (next-nodup (lookup-shared-value "scheme_DB_NEXT_NODUP")) + (prev (lookup-shared-value "scheme_DB_PREV")) + (prev-nodup (lookup-shared-value "scheme_DB_PREV_NODUP")) + (set (lookup-shared-value "scheme_DB_SET")) + (set-range (lookup-shared-value "scheme_DB_SET_RANGE")) + (multiple-key (lookup-shared-value "scheme_DB_MULTIPLE_KEY")) + (txn-nosync (lookup-shared-value "scheme_DB_TXN_NOSYNC")) + (txn-nowait (lookup-shared-value "scheme_DB_TXN_NOWAIT")) + (txn-sync (lookup-shared-value "scheme_DB_TXN_SYNC")))) + +(define (fold-flags valid unit given) + (fold-right + (lambda (f flag) + (if (member f valid) + (bitwise-ior (bdb-flags-id f) flag) + (raise (condition + (&bdb-invalid-flag (value given)))))) + (bdb-flags-id unit) + (if (list? given) given (list given)))) + +(define (flag-one-of valid given) + (cond + ((null? given) + (bdb-flags-id (bdb-flags default))) + ((member given valid) + => (lambda (l) + (bdb-flags-id (car l)))) + (else + (raise + (condition + (&bdb-invalid-flag (value given))))))) + +(define-finite-type database-type :database-type + (id) + database-type-object? + database-type-elements + database-type-name + database-type-index + (id database-type-id) + ((binary-tree (lookup-shared-value "scheme_DB_BTREE")) + (hash (lookup-shared-value "scheme_DB_HASH")) + (queue (lookup-shared-value "scheme_DB_QUEUE")) + (recno (lookup-shared-value "scheme_DB_RECNO")) + (unknown (lookup-shared-value "scheme_DB_UNKNOWN")))) + +;;; define error conditions +;;; with subconditions +(define-condition-type &bdb-error &condition + bdb-error?) + +;;; without subconditions + +;; DB_LOCK_DEADLOCK +(define-condition-type &bdb-lock-deadlock &bdb-error + bdb-lock-deadlock?) + +;;DB_LOCK_NOTGRANTED +(define-condition-type &bdb-lock-not-granted &bdb-error + bdb-lock-not-granted?) + +;; DB_OLD_VERSION +(define-condition-type &bdb-old-db-version &bdb-error + bdb-old-db-version?) + +;; DB_REP_HANDLE_DEAD +(define-condition-type &bdb-db-handle-dead &bdb-error + bdb-db-handle-dead?) + +;; DB_SECONDARY_BAD +(define-condition-type &bdb-secondary-index-bad &bdb-error + bdb-secondary-index-bad?) + +(define-condition-type &bdb-invalid-flag &bdb-error + bdb-invalid-flag?) + +(define raise-bdb-condition + (let ((alist + `((,-30995 ,&bdb-lock-deadlock) + (,-30994 ,&bdb-lock-not-granted) + (,-30989 ,&bdb-old-db-version) + (,-30986 ,&bdb-db-handle-dead) + (,-30977 , &bdb-secondary-index-bad)))) + (lambda (return-object) + (cond + ((assoc return-object alist) + => (lambda (p) + (let ((the-condition (cadr p))) + (raise (condition (the-condition)))))) + (else + (raise + (condition (&bdb-error + (code return-object))))))))) + + +;;; define bdb records +;;; DB handle : DB +(define-record-type bdb-db :bdb-db + (make-bdb-db c-pointer) + bdb-db? + (c-pointer bdb-db-c-pointer)) + +(define-exported-binding "bdb-db" :bdb-db) + +;;; DB environement handle : DB_ENV +(define-record-type bdb-env :bdb-env + (make-bdb-env c-pointer weak-list) + bdb-env? + (c-pointer bdb-env-c-pointer) + (weak-list bdb-env-weak-list set-bdb-env-weak-list!)) + +(define-exported-binding "bdb-env" :bdb-env) + +(define (bdb-env-weak-list-add! session thing) + (set-bdb-env-weak-list! + session (cons-weak thing (bdb-env-weak-list session)))) + +(define (bdb-env-weak-list-filter! session) + (set-bdb-env-weak-list! + session (filter-collected (bdb-env-weak-list session)))) + +(define (bdb-env-finalizer-free session) + (bdb-env-close session)) + +(define (bdb-env-finalizer session) + (bdb-env-weak-list-filter! session) + (if (null? (bdb-env-weak-list session)) + (add-finalizer! session bdb-env-finalizer-free) + (add-finalizer! session bdb-env-finalizer))) + +;;; DB memory poolfile : DB_MPOOLFILE +(define-record-type bdb-mpoolfile :bdb-mpoolfile + (make-bdb-mpoolfile c-pointer) + bdb-mpoolfile? + (c-pointer bdb-mpoolfile-c-pointer)) + +(define-exported-binding "bdb-mpoolfile" :bdb-mpoolfile) + +;;; DB transaction : DB_TXN +(define-record-type bdb-txn :bdb-txn + (make-bdb-txn c-pointer) + bdb-txn? + (c-pointer bdb-txn-c-pointer)) + +(define-exported-binding "bdb-txn" :bdb-txn) + +;;; DB Cursor : DBC +(define-record-type bdb-dbc :bdb-dbc + (make-bdb-dbc c-pointer) + bdb-dbc? + (c-pointer bdb-dbc-c-pointer)) + +(define-exported-binding "bdb-dbc" :bdb-dbc) + +(import-lambda-definition bdb-env-create-int (flags) + "scsh_bdb_env_create") + +(define bdb-env-create + (let ((valid-flags (list (bdb-flags rpc-client)))) + (lambda args + (let-optionals args + ((flags '())) + (let ((handle + (bdb-env-create-int (flag-one-of valid-flags flags)))) + (if (integer? handle) + (raise-bdb-condition handle) + (begin + (add-finalizer! handle bdb-env-close) + handle))))))) + +(import-lambda-definition + bdb-env-open-int + (env-handle db-home flags mode) + "scsh_bdb_env_open") + +(define bdb-env-open + (let ((valid-flags + (list (bdb-flags join-env) (bdb-flags init-lock) + (bdb-flags init-log) (bdb-flags init-mpool) + (bdb-flags init-replication) (bdb-flags init-transactions) + (bdb-flags run-recover) (bdb-flags recover-fatal)))) + (lambda (env-handle home-dir . args) + (let-optionals args + ((flags '()) + (mode 0)) + (let ((ret-object + (bdb-env-open-int + env-handle home-dir + (fold-flags valid-flags (bdb-flags default) flags) + mode))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(import-lambda-definition + bdb-env-close-int + (env-handle flags) + "scsh_bdb_env_close") + +(define (bdb-env-close env-handle) + (let ((ret-object + (bdb-env-close-int env-handle (bdb-flags default)))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object))) + +(import-lambda-definition + bdb-env-remove-int + (db-home flags) + "scsh_bdb_env_remove") + +;;; FIXME +; (define (bdb-env-remove env_handle db_home . args) +; (let-optionals args +; ((flags (bdb-flags DB_DEFAULT))) +; (let* ((ret-object (bdb-env-remove-int env_handle db_home (bdb-flags-id flags)))) +; (if (integer? ret-object) +; (raise-bdb-condition ret-object) +; (begin +; (values ret-object)))))) + +(import-lambda-definition + bdb-create-int + (env-handle flags) + "scsh_bdb_create") + +(define (bdb-create . args) + (let ((valid-flags (list (bdb-flags xa-create)))) + (let-optionals args + ((env (or (current-env) #f)) + (flags '())) + (let ((handle + (bdb-create-int + env + (flag-one-of valid-flags flags)))) + (if (integer? handle) + (raise-bdb-condition handle) + (begin + (add-finalizer! handle bdb-close) + handle)))))) + +(import-lambda-definition + bdb-open-int + (db-handle db-file database txnid type flags mode) + "scsh_bdb_open") + +(define bdb-open + (let ((valid-flags + (list (bdb-flags auto-commit)(bdb-flags create) + (bdb-flags dirty-read) (bdb-flags excl) + (bdb-flags nommap) (bdb-flags rdonly) + (bdb-flags thread) (bdb-flags truncate)))) + (lambda (db-handle db-file . args) + (let-optionals args + ((type (database-type binary-tree)) + (flags '()) + (mode 0) + (database (or (current-db) #f)) + (txn-id (or (current-transaction-id) #f))) + (let ((ret-object + (bdb-open-int db-handle db-file database txn-id + (database-type-id type) + (fold-flags valid-flags (bdb-flags default) flags) + mode))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(import-lambda-definition + bdb-close-int + (db-handle flags) + "scsh_bdb_close") + +(define bdb-close + (let ((valid-flags (list (bdb-flags nosync)))) + (lambda (db-handle . args) + (let-optionals args + ((flags '())) + (let ((ret-object + (bdb-close-int + db-handle + (fold-flags valid-flags (bdb-flags default) flags)))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(import-lambda-definition + bdb-put-int + (db-handle key data txn-id flags) + "scsh_bdb_put") + +(define bdb-put + (let ((valid-flags-0 + (list (bdb-flags append) (bdb-flags nodupdata) + (bdb-flags nooverwrite))) + (valid-flags-1 + (list (bdb-flags auto-commit)))) + (lambda (db-handle key data . args) + (let-optionals args + ((txn-id (or (current-transaction-id) #f)) + (flags-0 #f) + (flags-1 #f)) + (let* ((flags-0 + (if flags-0 + (fold-flags valid-flags-0 (bdb-flags default) flags-0) + (bdb-flags-id (bdb-flags default)))) + (flags-1 + (if flags-1 + (fold-flags valid-flags-1 flags-0 flags-1) + (bdb-flags-id (bdb-flags default)))) + (ret-object + (bdb-put-int db-handle key data txn-id flags-1))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(import-lambda-definition + bdb-get-int + (db-handle key txn-id flags) + "scsh_bdb_get") + +(define bdb-get + (let ((valid-flags-0 + (list (bdb-flags consume) (bdb-flags consume-wait) + (bdb-flags get-both) (bdb-flags set-recno))) + (valid-flags-1 + (list (bdb-flags auto-commit) (bdb-flags multiple) + (bdb-flags rmw)))) + (lambda (db-handle key . args) + (let-optionals args + ((txn-id (or (current-transaction-id) #f)) + (flags-0 #f) + (flags-1 #f)) + (let* ((flags-0 + (if flags-0 + (fold-flags valid-flags-0 (bdb-flags default) flags-0) + (bdb-flags-id (bdb-flags default)))) + (flags-1 + (if flags-1 + (fold-flags valid-flags-1 flags-0 flags-1) + (bdb-flags-id (bdb-flags default)))) + (ret-object + (bdb-get-int db-handle key txn-id flags-1))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(import-lambda-definition + bdb-del-int + (db-handle key txn-id flags) + "scsh_bdb_del") + +(define bdb-del + (let ((valid-flags (list (bdb-flags auto-commit)))) + (lambda (db-handle key . args) + (let-optionals args + ((txn-id (or (current-transaction-id) #f)) + (flags '())) + (let ((ret-object + (bdb-del-int db-handle key txn-id + (flag-one-of valid-flags flags)))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(import-lambda-definition + bdb-truncate-int + (db-home txn-id flags) + "scsh_bdb_truncate") + +(define bdb-truncate + (let ((valid-flags (list (bdb-flags auto-commit)))) + (lambda (db-handle . args) + (let-optionals args + ((txn-id (or (current-transaction-id) #f)) + (flags '())) + (let ((ret-object + (bdb-truncate-int db-handle txn-id + (flag-one-of valid-flags flags)))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(import-lambda-definition + bdb-sync-int + (db-handle) + "scsh_bdb_sync") + +(define bdb-sync + (lambda (db-handle) + (let ((ret-object (bdb-sync-int db-handle))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))) + +(import-lambda-definition + bdb-create-cursor-int + (db-handle txn-id flags) + "scsh_bdb_create_cursor") + +;;; no need for finalizer since cursor is unitialized after return +; (define (bdb-create-cursor db_handle . args) +; (let-optionals args +; ((txnid #f) +; (flags (bdb-flags DB_DEFAULT))) +; (let* ((ret-object(bdb-create-cursor-int db_handle txnid (bdb-flags-id flags)))) +; (if (integer? ret-object)(raise-bdb-condition ret-object) +; (begin (values ret-object)))))) + +(import-lambda-definition + bdb-cursor-cget-int + (db-handle flags) + "scsh_bdb_cursor_cget") + +; (define (bdb-cursor-cget dbc . args) +; (let-optionals args +; ((flags (bdb-flags DB_DEFAULT))) +; (let* ((ret-object(bdb-cursor-cget-int dbc (bdb-flags-id flags)))) +; (if (integer? ret-object)(raise-bdb-condition ret-object) +; (begin (values ret-object)))))) + +(import-lambda-definition + bdb-txn-begin-int + (env-handle parent flags) + "scsh_bdb_txn_begin") + +(define bdb-begin-transaction + (let ((valid-flags + (list (bdb-flags dirty-read) (bdb-flags txn-nosync) + (bdb-flags txn-nowait) (bdb-flags txn-sync)))) + (lambda (db-env . args) + (let-optionals args + ((parent #f) + (flags #f)) + (let* ((flags + (if flags + (fold-flags valid-flags (bdb-flags default) flags) + (bdb-flags-id (bdb-flags default)))) + (ret-object (bdb-txn-begin-int db-env parent flags))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(import-lambda-definition + bdb-txn-abort-int (txn-id) + "scsh_bdb_txn_abort") + +(define (bdb-abort-transaction txn-id) + (let ((ret-object (bdb-txn-abort-int txn-id))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object))) + +(import-lambda-definition + bdb-txn-commit-int + (txn-id flags) + "scsh_bdb_txn_commit") + +(define bdb-commit-transaction + (let ((valid-flags + (list (bdb-flags txn-nosync) (bdb-flags txn-sync)))) + (lambda (txn-id . args) + (let-optionals args + ((flags '())) + (let ((ret-object + (bdb-txn-commit-int txn-id (flag-one-of valid-flags flags)))) + (if (integer? ret-object) + (raise-bdb-condition ret-object) + ret-object)))))) + +(define (string->byte-vector string) + (let* ((length (string-length string)) + (bv (make-byte-vector length 0))) + (let lp ((index (- length 1))) + (if (< index 0) + bv + (begin + (byte-vector-set! + bv index (char->ascii (string-ref string index))) + (lp (- index 1))))))) + +(define (byte-vector->string byte-vector) + (let* ((length (byte-vector-length byte-vector)) + (string (make-string length (ascii->char 0)))) + (let lp ((index (- length 1))) + (if (< index 0) + string + (begin + (string-set! + string index + (ascii->char (byte-vector-ref byte-vector index))) + (lp (- index 1))))))) + +(define (value->byte-vector thing) + (let ((port (make-string-output-port))) + (write thing port) + (string->byte-vector + (string-output-port-output port)))) + +(define (byte-vector->value byte-vector) + (let ((port (make-string-input-port + (byte-vector->string byte-vector)))) + (read port))) + + diff --git a/scheme/packages.scm b/scheme/packages.scm new file mode 100644 index 0000000..a314db1 --- /dev/null +++ b/scheme/packages.scm @@ -0,0 +1,63 @@ +(define-interface berkeley-db-interface + (export + bdb-flags-object? + bdb-flags-elements + bdb-flags-name + (bdb-flags :syntax) + + database-type-object? + database-type-elements + database-type-name + (database-type :syntax) + + &bdb-error bdb-error? + &bdb-lock-deadlock bdb-lock-deadlock? + &bdb-lock-not-granted bdb-lock-not-granted? + &bdb-old-db-version bdb-old-db-version? + &bdb-db-handle-dead bdb-db-handle-dead? + &bdb-secondary-index-bad bdb-secondary-index-bad? + &bdb-invalid-flag bdb-invalid-flag? + + bdb-db? + bdb-env? + bdb-mpoolfile? + bdb-txn? + bdb-dbc? + + bdb-env-create + bdb-env-open + bdb-env-close + ;bdb-env-remove + + bdb-create + bdb-open + bdb-close + bdb-put + bdb-get + bdb-del + bdb-truncate + bdb-sync + ;bdb-create-cursor + ;bdb-cursor-cget + + bdb-begin-transaction + bdb-abort-transaction + bdb-commit-transaction)) + +(define-structure berkeley-db berkeley-db-interface + (open scheme + srfi-1 + srfi-34 + srfi-35 + fluids + weak + byte-vectors + extended-ports + ascii + let-opt + bitwise + define-record-types + finite-types + external-calls) + (files bdb)) + \ No newline at end of file