diff options
| -rw-r--r-- | otherlibs/db/db.ml | 9 | ||||
| -rw-r--r-- | otherlibs/db/db.mli | 7 | ||||
| -rw-r--r-- | otherlibs/db/dbstubs.c | 24 |
3 files changed, 36 insertions, 4 deletions
diff --git a/otherlibs/db/db.ml b/otherlibs/db/db.ml index a0b1f39f9..5a96f34f3 100644 --- a/otherlibs/db/db.ml +++ b/otherlibs/db/db.ml @@ -30,6 +30,13 @@ type routine_flag = | R_PREV | R_SETCURSOR + +(* All other fields have default values *) +type btree_flag = + Duplicates (* means R_DUP *) + | Cachesize of int + + type file_perm = int exception DB_error of string @@ -46,7 +53,7 @@ type data = string type t (* Raw access *) -external dbopen : string -> open_flag list -> file_perm -> bool -> t +external dbopen : string -> open_flag list -> file_perm -> btree_flag list -> t = "caml_db_open" (* [dbopen file flags mode dupentries] *) diff --git a/otherlibs/db/db.mli b/otherlibs/db/db.mli index 125eae13f..a1d954369 100644 --- a/otherlibs/db/db.mli +++ b/otherlibs/db/db.mli @@ -30,6 +30,11 @@ type routine_flag = | R_PREV | R_SETCURSOR +(* All other fields have default values *) +type btree_flag = + Duplicates (* means R_DUP *) + | Cachesize of int + type file_perm = int exception DB_error of string @@ -41,7 +46,7 @@ type data = string type t (* Raw access *) -external dbopen : string -> open_flag list -> file_perm -> bool -> t +external dbopen : string -> open_flag list -> file_perm -> btree_flag list -> t = "caml_db_open" (* [dbopen file flags mode] *) diff --git a/otherlibs/db/dbstubs.c b/otherlibs/db/dbstubs.c index 5e2b67c67..c44daecd7 100644 --- a/otherlibs/db/dbstubs.c +++ b/otherlibs/db/dbstubs.c @@ -187,7 +187,7 @@ value caml_db_sync(value cdb) /* ML */ raise_db("sync"); } -value caml_db_open(value vfile, value vflags, value vmode, value vdup) /* ML */ +value caml_db_open(value vfile, value vflags, value vmode, value vpars) /* ML */ { char *file = String_val(vfile); int flags = convert_flag_list(vflags, db_open_flags); @@ -198,7 +198,27 @@ value caml_db_open(value vfile, value vflags, value vmode, value vdup) /* ML */ /* Infos for btree structure : 0 is default everywhere */ info = stat_alloc(sizeof(BTREEINFO)); bzero(info, sizeof(BTREEINFO)); - if (Bool_val(vdup)) info->flags |= R_DUP; + + while (Is_block(vpars)) { + value par = Field(vpars, 0); + if (Is_block(par)) { /* It's a non-constant constructor */ + switch(Tag_val(par)) { + case 0: /* Cachesize */ + info->cachesize = Int_val(Field(par, 0)); + default: + break; + } + } else { /* It's a constant constructor */ + switch (Int_val(par)) { + case 0: /* Duplicates */ + info->flags |= R_DUP; + break; + default: + break; + } + } + vpars = Field(vpars, 1); + } db = dbopen(file,flags,mode,DB_BTREE,info); if (db == NULL) { |