[Caml-list] Opaque pointers with camlidl

[Caml-list] Opaque pointers with camlidl

[Michael Tucker]

Hi,

  I am trying to write an O'Caml program that interfaces with Berkeley DB
(which has a C interface). Some of the calls include arguments that are
pointers to opaque structures -- that is, I pass a pointer, the server
goes to the address, fills it, but then my only use of it is to pass it
back to the server. In other words, I will not be examining or altering
the contents, just holding it to preserve state. Some of these structures
are fairly complex, and may require a lot of code-schlepping to get into
IDL format, so it would be great if I could signify that there is a truly
opaque (I don't care about its layout, I just know the size) structure
coming into O'Caml. I looked in the camlidl manual, but didn't see any
attributes that looked relevant. I would like the data to be transferred
and stored in OCaml, but I am fine with it being stored as raw data (a
string?). Is there anything like this that will let me effectively pickle
and unpickle structures without supplying any information beyond their
size?

I'm sure I'm fouling up my explanation, so feel free to send questions...
I am just hoping that someone has run into a similar situation in the
past!

Thanks,
Mike

-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners

Re: [Caml-list] Opaque pointers with camlidl

[Jacques Garrigue]

From: Michael Tucker <mtucker@e...>

>   I am trying to write an O'Caml program that interfaces with Berkeley DB
> (which has a C interface).

This may be a little known fact, but ocaml has a Berkeley DB interface
in the distribution.  It is a bit partial (only support for btree
method), but this maybe a start.
(If it's not in the distribution, at least it is in the CVS)

Jacques
-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners

Re: [Caml-list] Opaque pointers with camlidl

[Alexander V.Voinov]

Hi Jacques,

From: Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>
Subject: Re: [Caml-list] Opaque pointers with camlidl
Date: Thu, 18 Jul 2002 08:29:31 +0900

> From: Michael Tucker <mtucker@e...>
> 
> >   I am trying to write an O'Caml program that interfaces with Berkeley DB
> > (which has a C interface).
> 
> This may be a little known fact, but ocaml has a Berkeley DB interface
> in the distribution.  It is a bit partial (only support for btree
> method), but this maybe a start.
> (If it's not in the distribution, at least it is in the CVS)

Which version of bsddb do you mean? There are four and at least two are actively used.

Alexander
-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners

Re: [Caml-list] Opaque pointers with camlidl

[Yaron M. Minsky]

[-- Attachment #1: Type: text/plain, Size: 2647 bytes --]

For what it's worth, I have written a small berkeley DB interface (for
version 3.3.11, the one found in RH 7.3), which I've attached to this
email.  The ml is actually embedded inside the bdb_stubs.c file in
comment lines beginning with "//+".  There's a little python script
called ocextr(yeah, yeah, I should have written it in ocaml) for
extracting the appropriate code.

The makefile is optimized for my own little environment, and this isn't
really ready for public consumption, but you might find a use for it. 
It has decent support for dbenvs, direct db access and cursors.  At some
point I'll add transactions, but I haven't gotten around to it yet.  If
you find any bugs, please tell me about them.

Also, if you figure out a nice way of doing this with camlidl, please
post it to the list.  I'd love to be avoid hand-coding this kind of
interface.

y

On Wed, 2002-07-17 at 18:09, Michael Tucker wrote:
> Hi,
> 
>   I am trying to write an O'Caml program that interfaces with Berkeley DB
> (which has a C interface). Some of the calls include arguments that are
> pointers to opaque structures -- that is, I pass a pointer, the server
> goes to the address, fills it, but then my only use of it is to pass it
> back to the server. In other words, I will not be examining or altering
> the contents, just holding it to preserve state. Some of these structures
> are fairly complex, and may require a lot of code-schlepping to get into
> IDL format, so it would be great if I could signify that there is a truly
> opaque (I don't care about its layout, I just know the size) structure
> coming into O'Caml. I looked in the camlidl manual, but didn't see any
> attributes that looked relevant. I would like the data to be transferred
> and stored in OCaml, but I am fine with it being stored as raw data (a
> string?). Is there anything like this that will let me effectively pickle
> and unpickle structures without supplying any information beyond their
> size?
> 
> I'm sure I'm fouling up my explanation, so feel free to send questions...
> I am just hoping that someone has run into a similar situation in the
> past!
> 
> Thanks,
> Mike
> 
> -------------------
> To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
> Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
> Beginner's list: http://groups.yahoo.com/group/ocaml_beginners
-- 
|--------/            Yaron M. Minsky              \--------|
|--------\ http://www.cs.cornell.edu/home/yminsky/ /--------|

Open PGP --- KeyID B1FFD916 (new key as of Dec 4th)
Fingerprint: 5BF6 83E1 0CE3 1043 95D8 F8D5 9F12 B3A9 B1FF D916

[-- Attachment #2: bdb_stubs.c --]
[-- Type: text/x-c, Size: 27140 bytes --]

#include <stdio.h>
#include <stdlib.h>
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/fail.h>
#include <caml/memory.h>
#include <caml/callback.h>

#include <sys/stat.h>
#include <sys/types.h>
#include <limits.h>
#include <db.h>
/* O_CREAT and others are not defined in db.h */
#include <fcntl.h>

#include <string.h>
#include "bdb_stubs.h"

#define True 1
#define False 0


// comments starting with "//+" are extracted automatically to create the .ml
// file that forms the other half of this interface.

/************************************************************/
/***  Custom Operations *************************************/
/************************************************************/

// Close the DB_ENV
int caml_dbenv_close_internal(value dbenv) {
  if (!(UW_dbenv_closed(dbenv))) { 
    UW_dbenv_closed(dbenv) = True;
    return UW_dbenv(dbenv)->close(UW_dbenv(dbenv),0);
  }
  else return 0;
}

static void finalize_caml_dbenv(value dbenv) { 
  CAMLparam1(dbenv);
  caml_dbenv_close_internal(dbenv); 
  CAMLreturn0;
}

static struct custom_operations dbenv_custom = { 
  "dbenv",  
  finalize_caml_dbenv,  
  custom_compare_default,  
  custom_hash_default,
  custom_serialize_default,  
  custom_deserialize_default 
}; 

/************************************************************/

// Close the DB
int caml_db_close_internal(value db) {
  if (!(UW_db_closed(db))) { 
    UW_db_closed(db) = True;
    return UW_db(db)->close(UW_db(db),0);
  }
  else return 0;
}

static void finalize_caml_db(value db) { 
  CAMLparam1(db);
  caml_db_close_internal(db); 
  CAMLreturn0;
}

static struct custom_operations db_custom = { 
  "db",  
  finalize_caml_db,  
  custom_compare_default,  
  custom_hash_default,
  custom_serialize_default,  
  custom_deserialize_default 
}; 

/************************************************************/

// Close the Transaction
int caml_cursor_close_internal(value cursor) {
  if (!(UW_cursor_closed(cursor))) { 
    UW_cursor_closed(cursor) = 1;
    return UW_cursor(cursor)->c_close(UW_cursor(cursor));
  }
  else return 0;
}

static void finalize_caml_cursor(value cursor) {
  CAMLparam1(cursor);
  caml_cursor_close_internal(cursor); 
  CAMLreturn0;
}

static struct custom_operations cursor_custom = { 
  "cursor",  
  finalize_caml_cursor,  
  custom_compare_default,  
  custom_hash_default,
  custom_serialize_default,  
  custom_deserialize_default 
}; 

/************************************************************/
/************ Exception buckets *****************************/
/************************************************************/

static value *caml_db_exn = NULL;
static value *caml_key_exists_exn = NULL;

value caml_db_init(value v){
  CAMLparam1(v);
  if (caml_db_exn == NULL) 
    caml_db_exn = caml_named_value("dberror");
  if (caml_key_exists_exn == NULL) 
    caml_key_exists_exn = caml_named_value("keyexists");
  CAMLreturn (Val_unit);
}

//+ (* Exception declarations *)
//+ 
//+ exception DBError of string
//+ let _ = Callback.register_exception "dberror" (DBError "")
//+
//+ exception Key_exists
//+ let _ = Callback.register_exception "keyexists" Key_exists
//+
//+ external db_init : unit -> unit = "caml_db_init"
//+ let _ = db_init ()
//+
//+ type cursor
//+ type dbenv
//+ type db

void raise_db(char *msg) {
  raise_with_string(*caml_db_exn, msg);
}

void raise_key_exists() {
  // failwith("Key Exists");
  raise_constant(*caml_key_exists_exn);
}

// Used as callback by db infrastructure for setting errors.  As a result,
// calls to DB->err and DBENV->err lead to exceptions.

// FIX: currently, prefix is ignored.  Should be concatenated.
void raise_db_cb(const char *prefix, char *msg) { raise_db(msg); }



/************************************************************/
/**  DBENV call interface  *******************************/
/************************************************************/

// Opening of Dbenv moudle
//+
//+
//+ module Dbenv =
//+ struct
//+ 
//+   type t = dbenv


/**  DBENV Flags  ********************************************/

// Declaration of flag enums in ocaml must be in same order as in C

static int dbenv_create_flags[] = { DB_CLIENT };

//+
//+   type create_flag = CLIENT

static int dbenv_open_flags[] = {
  DB_JOINENV, DB_INIT_CDB, DB_INIT_LOCK, DB_INIT_LOG, DB_INIT_MPOOL, 
  DB_INIT_TXN, DB_RECOVER, DB_RECOVER_FATAL, DB_USE_ENVIRON,
  DB_USE_ENVIRON_ROOT, DB_CREATE, DB_LOCKDOWN, DB_PRIVATE, 
  DB_SYSTEM_MEM, DB_THREAD
};

//+ 
//+   type open_flag = 
//+       JOINENV | INIT_CDB | INIT_LOCK | INIT_LOG 
//+     | INIT_MPOOL | INIT_TXN | RECOVER | RECOVER_FATAL 
//+     | USE_ENVIRON | USE_ENVIRON_ROOT | CREATE 
//+     | LOCKDOWN | PRIVATE | SYSTEM_MEM | THREAD

static int dbenv_verbose_flags[] = {
  DB_VERB_CHKPOINT, DB_VERB_DEADLOCK, DB_VERB_RECOVERY, DB_VERB_WAITSFOR
};

//+ 
//+   type verbose_flag = 
//+       VERB_CHKPOINT | VERB_DEADLOCK | VERB_RECOVERY | VERB_WAITSFOR

/**  DBENV Calls  *******************************************/
//+

//+   external create : create_flag list -> t = "caml_dbenv_create"
value caml_dbenv_create(value vflags){
  CAMLparam1(vflags);
  CAMLlocal1(rval);
  int err;
  int flags = convert_flag_list(vflags,dbenv_create_flags);
  DB_ENV *dbenv;
  
  err = db_env_create(&dbenv,flags);
  if (err != 0) { raise_db(db_strerror(err)); }

  dbenv->set_errcall(dbenv,raise_db_cb);

  rval = alloc_custom(&dbenv_custom,Camldbenv_wosize,0,1);
  UW_dbenv(rval) = dbenv;
  UW_dbenv_closed(rval) = False;
  CAMLreturn (rval);
}


//+   external dopen : t -> string -> open_flag list -> int -> unit = 
//+        "caml_dbenv_open"
value caml_dbenv_open(value dbenv, value vdirectory, 
		      value vflags, value vmode){
  CAMLparam4(dbenv,vdirectory,vflags,vmode);
  int err;
  char *directory = String_val(vdirectory);
  int flags = convert_flag_list(vflags,dbenv_open_flags);

  if (UW_dbenv_closed(dbenv)) { 
    invalid_argument("Attempt to use closed dbenv");
  }

  err = UW_dbenv(dbenv)->open(UW_dbenv(dbenv), directory, 
			      flags, 
			      Long_val(vmode) ); 
  if (err != 0) { 
    UW_dbenv(dbenv)->err(UW_dbenv(dbenv),err,
			 "caml_dbenv_open: open failed."); 
  }

  CAMLreturn (Val_unit);
}
// simple open, combination of create and open
//+   let sopen dirname flags mode = 
//+     let dbenv = create [] in
//+     dopen dbenv dirname flags mode;
//+     dbenv



//+   external close : t -> unit = "caml_dbenv_close"
value caml_dbenv_close(value dbenv) {
  CAMLparam1(dbenv);
  int err = caml_dbenv_close_internal(dbenv);
  if (err != 0) { raise_db(db_strerror(err)); }
  CAMLreturn (Val_unit);
}


//+   external set_verbose_internal : t -> verbose_flag list -> 
//+           bool -> unit =  "caml_dbenv_set_verbose"
//+   let set_verbose dbenv flag onoff = 
//+       set_verbose_internal dbenv [flag] onoff
value caml_dbenv_set_verbose(value dbenv, value vflags, 
			     value v_onoff) {
  CAMLparam3(dbenv,vflags,v_onoff);
  int err;

  int which = convert_flag_list(vflags,dbenv_verbose_flags) + 1;
  int onoff = Bool_val(v_onoff);
  
  if (UW_dbenv_closed(dbenv)) { 
    invalid_argument("Attempt to use closed dbenv");
  }

  err = UW_dbenv(dbenv)->set_verbose(UW_dbenv(dbenv),which,onoff);

  if (err != 0) {
    UW_dbenv(dbenv)->err(UW_dbenv(dbenv),err,
			 "caml_dbenv_set_verbose:"); 
  }
  CAMLreturn (Val_unit);
}

//+   external set_cachesize : t -> gbytes:int -> bytes:int -> ncache:int -> unit
//+          = "caml_dbenv_set_cachesize"
value caml_dbenv_set_cachesize(value dbenv, value gbytes, 
			       value bytes, value ncache) {
  CAMLparam4(dbenv, gbytes, bytes, ncache);
  int err;

  err = UW_dbenv(dbenv)->set_cachesize(UW_dbenv(dbenv),Int_val(gbytes), 
				       Int_val(bytes), Int_val(ncache));
  if (err != 0) { UW_dbenv(dbenv)->err(UW_dbenv(dbenv),err,
				       "caml_dbenv_set_cachesize"); }

  CAMLreturn (Val_unit);
}



// Termination of Dbenv module
//+ 
//+ end


/************************************************************/
/**  DB call interface  *************************************/
/************************************************************/

// Opening of Db moudle
//+
//+
//+ module Db =
//+ struct
//+ 
//+   type t = db



/**  DB Flags  ***********************************************/
static int db_create_flags[] = {
  DB_XA_CREATE
};

//+
//+   type create_flag = XA_CREATE

static int db_open_flags[] = {
  DB_CREATE, DB_EXCL, DB_NOMMAP, DB_RDONLY, DB_THREAD, DB_TRUNCATE 
};

//+ 
//+   type open_flag = 
//+      CREATE | EXCL | NOMMAP | RDONLY | THREAD | TRUNCATE 

static int db_types[] = {
  DB_BTREE, DB_HASH, DB_QUEUE, DB_RECNO, DB_UNKNOWN
};

//+ 
//+   type db_type = BTREE | HASH | QUEUE | RECNO | UNKNOWN


static int db_put_flags[] = { DB_APPEND, DB_NODUPDATA, DB_NOOVERWRITE };

//+
//+   type put_flag = APPEND | NODUPDATA | NOOVERWRITE

// DB_GET_BOTH is omitted because it doesn't make sense given our interface
static int db_get_flags[] = { 
  DB_CONSUME, DB_CONSUME_WAIT, DB_SET_RECNO, DB_RMW
};

//+ 
//+   type get_flag = CONSUME | CONSUME_WAIT | SET_RECNO | RMW


static int db_set_flags[] = {
  DB_DUP, DB_DUPSORT, DB_RECNUM, DB_REVSPLITOFF, DB_RENUMBER, DB_SNAPSHOT
};

//+ 
//+   type set_flag = DUP | DUPSORT | RECNUM | REVSPLITOFF 
//+                 | RENUMBER | SNAPSHOT

/** DB Calls **************************************************/
//+

//+   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 = convert_flag_list(vflags,db_create_flags);
  DB *db;
  DB_ENV *dbenv;
  CAMLlocal1(rval);

  if (Is_None(dbenv_opt)) { dbenv = NULL; }
  else { dbenv = UW_dbenv(Some_val(dbenv_opt)); }
  
  if (dbenv != NULL && UW_dbenv_closed(dbenv)) { 
    invalid_argument("Attempt to use closed dbenv");
  }

  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);
  
}

//+   external dopen : t -> string -> db_type -> open_flag list -> int -> unit = 
//+        "caml_db_open"
value caml_db_open(value db, value vfname, 
		   value vdbtype, value vflags, 
		   value vmode){
  CAMLparam5(db, vfname, vdbtype, vflags, vmode);
  int err;
  char *fname = String_val(vfname);
  int flags = convert_flag_list(vflags,db_open_flags);
  int dbtype = Flag_val(vdbtype,db_types);

  if (UW_db_closed(db)) { 
    invalid_argument("Attempt to use closed db");
  }


  err = UW_db(db)->open(UW_db(db), fname, NULL, /* no support for database */
			dbtype, flags, Long_val(vmode) ); 
  if (err != 0) { 
    UW_db(db)->err(UW_db(db),err,
			 "caml_db_open"); 
  }

  CAMLreturn (Val_unit);
}

//+   external close : t -> unit = "caml_db_close"
value caml_db_close(value db) {
  CAMLparam1(db);
  int err = caml_db_close_internal(db);
  if (err != 0) { raise_db(db_strerror(err)); }
  CAMLreturn (Val_unit);
}

//+   external del : t -> string -> unit = "caml_db_del"
value caml_db_del(value db, value key) {
  CAMLparam2(db,key);
  DBT dbt; // static keyword initializes record to zero.
  int err;

  if (UW_db_closed(db)) { 
    invalid_argument("Attempt to use closed db");
  }

  bzero(&dbt,sizeof(DBT));

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

  
  err = UW_db(db)->del(UW_db(db), 
		       NULL /* No TXN_ID */, 
		       &dbt,
		       0 /* no flags */);
  if (err != 0) { UW_db(db)->err(UW_db(db),err, "caml_db_del"); }

  CAMLreturn (Val_unit);
}


//+   external put : t -> key:string -> data:string -> put_flag list -> unit
//+             = "caml_db_put"
value caml_db_put(value db, value vkey, value vdata, value vflags) {
  CAMLparam4(db, vkey, vdata, vflags);
  DBT key, data;
  int flags, err;
  
  if (UW_db_closed(db)) { 
    invalid_argument("Attempt to use closed db");
  }
  bzero(&key,sizeof(DBT)); bzero(&data,sizeof(DBT));


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

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

  CAMLreturn (Val_unit);
}


//+   external get : t -> string -> get_flag list -> string
//+             = "caml_db_get"
value caml_db_get(value db, value vkey, value vflags) {
  CAMLparam3(db, vkey, vflags);
  DBT key,data;
  int flags, err;
  CAMLlocal1(rval);

  if (UW_db_closed(db)) { 
    invalid_argument("Attempt to use closed db");
  }

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

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


  err = UW_db(db)->get(UW_db(db), NULL, &key, &data, flags);
  if (err != 0) { 
    if (err == DB_NOTFOUND) { raise_not_found(); }
    UW_db(db)->err(UW_db(db),err,"caml_db_get"); 
  }

  // FIX: this currently uses an extra, unnecessary copy in order to simplify
  // memory management.
  rval = alloc_string(data.size);
  memcpy (String_val(rval), data.data, data.size);
  CAMLreturn (rval);
}

//+   external set_flags : t -> set_flag list -> unit = "caml_db_set_flags"
value caml_db_set_flags(value db, value vflags) {
  CAMLparam2(db,vflags);
  int flags=0,err;

  if (UW_db_closed(db)) { 
    invalid_argument("Attempt to use closed db");
  }

  flags = convert_flag_list(vflags,db_set_flags);

  err = UW_db(db)->set_flags(UW_db(db),flags);
  if (err != 0) { UW_db(db)->err(UW_db(db),err,"caml_db_set_flags"); }

  CAMLreturn (Val_unit);
}


//  More user-friendly version of dopen (simple open)
//+
//+   let sopen ?dbenv fname dbtype ?moreflags flags mode = 
//+     let db = create ?dbenv [] in
//+     (match moreflags with 
//+         None -> ()
//+       | Some flags -> set_flags db flags );
//+     dopen db fname dbtype flags mode;
//+     db



//+   external set_h_ffactor : t -> int -> unit
//+          = "caml_db_set_h_ffactor"
value caml_db_set_h_ffactor(value db, value v) {
  CAMLparam2(db,v);
  int err;

  err = UW_db(db)->set_h_ffactor(UW_db(db),Int_val(v));
  if (err != 0) { UW_db(db)->err(UW_db(db),err,"caml_db_set_h_ffactor"); }

  CAMLreturn (Val_unit);
}

//+   external set_pagesize : t -> int -> unit
//+          = "caml_db_set_pagesize"
value caml_db_set_pagesize(value db, value v) {
  CAMLparam2(db,v);
  int err;

  err = UW_db(db)->set_pagesize(UW_db(db),Int_val(v));
  if (err != 0) { UW_db(db)->err(UW_db(db),err,"caml_db_set_pagesize"); }

  CAMLreturn (Val_unit);
}

//+   external set_cachesize : t -> gbytes:int -> bytes:int -> ncache:int -> unit
//+          = "caml_db_set_cachesize"
value caml_db_set_cachesize(value db, value gbytes, value bytes, value ncache) {
  CAMLparam4(db, gbytes, bytes, ncache);
  int err;

  err = UW_db(db)->set_cachesize(UW_db(db),Int_val(gbytes), Int_val(bytes),
				 Int_val(ncache));
  if (err != 0) { UW_db(db)->err(UW_db(db),err,"caml_db_set_cachesize"); }

  CAMLreturn (Val_unit);
}




// Termination of Db module
//+ 
//+ end
//+

//*******************************************************************
//*******************************************************************

// Opening of Cursor moudle
//+
//+ module Cursor =
//+ struct
//+ 
//+   type t = cursor

//*******************************************************************
//*******************************************************************

static int cursor_put_flags[] = { 
  DB_AFTER, DB_BEFORE, DB_CURRENT 
};

//+
//+   type put_flag = AFTER | BEFORE | CURRENT 

static int cursor_kput_flags[] = {
  DB_KEYFIRST, DB_KEYLAST, DB_NODUPDATA
};

//+
//+   type kput_flag = KEYFIRST | KEYLAST | NODUPDATA

static int cursor_get_type[] = { 
  DB_CURRENT, DB_FIRST, DB_LAST, 
  DB_NEXT, DB_PREV, DB_NEXT_DUP, DB_NEXT_NODUP, DB_PREV_NODUP, 0
};

//+
//+   type get_type = CURRENT | FIRST | LAST 
//+          | NEXT | PREV | NEXT_DUP | NEXT_NODUP
//+          | PREV_NODUP | NULL

static int cursor_get_flags[] = { DB_DIRTY_READ, DB_RMW };

//+
//+   type get_flag = DIRTY_READ | RMW

//*******************************************************************
//*******************************************************************

//+ 
//+   external create : ?writecursor:bool -> Db.t -> t = "caml_cursor_create"
value caml_cursor_create(value vwritecursor, value db) {
  CAMLparam2(vwritecursor,db);
  int err;
  int flags = 0;
  CAMLlocal1(rval);
  DBC *cursor;

  if (UW_db_closed(db)) { 
    invalid_argument("Attempt to use closed db");
  }


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

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

  rval = alloc_custom(&cursor_custom,Camldb_wosize,0,1);
  UW_cursor(rval) = cursor;
  UW_cursor_closed(rval) = False;
  CAMLreturn (rval);
}

//+   external close : t -> unit = "caml_cursor_close"
value caml_cursor_close(value cursor) {
  CAMLparam1(cursor);
  int err = caml_cursor_close_internal(cursor);
  if (err != 0) { raise_db(db_strerror(err)); }
  CAMLreturn (Val_unit);
}

//+   external put : t -> string -> put_flag -> unit
//+          = "caml_cursor_put"
value caml_cursor_put(value cursor, value vdata, value vflag) {
  CAMLparam3(cursor,vdata,vflag);
  DBT key, data;
  int flags, err;
  
  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

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

  data.data = String_val(vdata);
  data.size = string_length(vdata);
  flags = Flag_val(vflag, cursor_put_flags);

  err = UW_cursor(cursor)->c_put(UW_cursor(cursor), &key, &data, flags);
  if (err != 0) { 
    if (err == DB_KEYEXIST) { raise_key_exists(); }
    raise_db(db_strerror(err)); 
  }

  CAMLreturn (Val_unit);
}

//+   external kput : t -> key:string -> data:string -> kput_flag -> unit
//+          = "caml_cursor_kput"
value caml_cursor_kput(value cursor, value vkey, value vdata, value vflag) {
  CAMLparam4(cursor,vkey,vdata,vflag);
  DBT key, data;
  int flags, err;
  
  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

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

  key.data = String_val(vkey);
  key.size = string_length(vkey);
  data.data = String_val(vdata);
  data.size = string_length(vdata);
  flags = Flag_val(vflag,cursor_kput_flags);

  err = UW_cursor(cursor)->c_put(UW_cursor(cursor), &key, &data, flags);
  if (err != 0) { 
    if (err == DB_KEYEXIST) { raise_key_exists(); }
    raise_db(db_strerror(err)); 
  }

  CAMLreturn (Val_unit);
}


//+   external init :  t -> string -> get_flag list -> string
//+          = "caml_cursor_init"
value caml_cursor_init(value cursor, value vkey, value vflags) {
  CAMLparam3(cursor,vkey,vflags);
  CAMLlocal1(rval);
  DBT key,data;
  int flags = convert_flag_list(vflags,cursor_get_flags) | DB_SET;
  int err;

  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

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

  key.data = String_val(vkey);
  key.size = string_length(vkey);
  
  err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data, flags);
  if (err != 0) { 
    if (err == DB_NOTFOUND) { raise_not_found(); }
    raise_db(db_strerror(err));
  }

  rval = alloc_string(data.size);
  memcpy (String_val(rval), data.data, data.size);
  CAMLreturn (rval);
}


//+   external init_range :  t -> string -> get_flag list -> string * string
//+          = "caml_cursor_init_range"
value caml_cursor_init_range(value cursor, value vkey, value vflags) {
  CAMLparam3(cursor,vkey,vflags);
  CAMLlocal3(rkey,rdata,rpair);
  DBT key,data;
  int flags = convert_flag_list(vflags,cursor_get_flags) | DB_SET_RANGE;
  int err;

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

  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }


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

  err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data, flags);
  if (err != 0) { 
    if (err == DB_NOTFOUND) { raise_not_found(); }
    raise_db(db_strerror(err));
  }

  rdata = alloc_string(data.size);
  memcpy (String_val(rdata), data.data, data.size);
  rkey = alloc_string(key.size);
  memcpy (String_val(rkey), key.data, key.size);
  rpair = alloc(2,0);
  Store_field(rpair,0,rkey);
  Store_field(rpair,0,rdata);
  CAMLreturn (rpair);
}

//+   external init_both :  t -> key:string -> data:string 
//+               -> get_flag list -> unit = "caml_cursor_init"
value caml_cursor_init_both(value cursor, value vkey, value vdata, 
			    value vflags) {
  CAMLparam4(cursor,vkey,vdata,vflags);
  DBT key,data;
  int flags = convert_flag_list(vflags,cursor_get_flags) | DB_GET_BOTH;
  int err;

  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

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

  key.data = String_val(vkey);
  key.size = string_length(vkey);
  
  data.data = String_val(vdata);
  data.size = string_length(vdata);

  err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data, flags);
  if (err != 0) { 
    if (err == DB_NOTFOUND) { raise_not_found(); }
    raise_db(db_strerror(err));
  }

  CAMLreturn (Val_unit);
}


//+   external get : t -> get_type -> get_flag list -> string * string
//+                = "caml_cursor_get"
value caml_cursor_get(value cursor, value vtype, value vflags) {
  CAMLparam3(cursor,vtype,vflags);
  CAMLlocal3(rpair,rkey,rdata);
  DBT key,data;
  int flags = Flag_val(vtype,cursor_get_type) | 
    convert_flag_list(vflags,cursor_get_flags);
  int err;
  bzero(&key,sizeof(DBT)); bzero(&data,sizeof(DBT));

  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

  err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data,flags);
  if (err != 0) { 
    if (err == DB_NOTFOUND) { raise_not_found(); }
    raise_db(db_strerror(err));
  }

  rkey = alloc_string(key.size);
  memcpy (String_val(rkey), key.data, key.size);
  rdata = alloc_string(data.size);
  memcpy (String_val(rdata), data.data, data.size);
  rpair = alloc(2,0);
  Store_field(rpair,0,rkey);
  Store_field(rpair,1,rdata);
  CAMLreturn (rpair);
}


//+   external get_keyonly : t -> get_type -> get_flag list -> string
//+                = "caml_cursor_get_keyonly"
value caml_cursor_get_keyonly(value cursor, value vtype, value vflags) {
  CAMLparam3(cursor,vtype,vflags);
  CAMLlocal1(rkey);
  DBT key,data;
  int flags = Flag_val(vtype,cursor_get_type) | 
    convert_flag_list(vflags,cursor_get_flags);
  int err;
  bzero(&key,sizeof(DBT)); bzero(&data,sizeof(DBT));

  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

  err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data,flags);
  if (err != 0) { 
    if (err == DB_NOTFOUND) { raise_not_found(); }
    raise_db(db_strerror(err));
  }

  rkey = alloc_string(key.size);
  memcpy (String_val(rkey), key.data, key.size);
  CAMLreturn (rkey);
}



//+   external del : t -> unit = "caml_cursor_del"
value caml_cursor_del(value cursor) {
  CAMLparam1(cursor);
  int err;

  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

  err = UW_cursor(cursor)->c_del(UW_cursor(cursor), 0);
  if (err != 0) { raise_db(db_strerror(err)); }

  CAMLreturn (Val_unit);
}


//+   external count : t -> int = "caml_cursor_count"
value caml_cursor_count(value cursor) {
  CAMLparam1(cursor);
  int err;
  db_recno_t counter;

  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

  err = UW_cursor(cursor)->c_count(UW_cursor(cursor), &counter,0);
  if (err != 0) { raise_db(db_strerror(err)); }

  CAMLreturn (Val_long(counter));
}

//+   external dup : ?keep_position:bool -> t -> t = "caml_cursor_dup"
value caml_cursor_dup(value vkeep_position, value cursor) {
  CAMLparam2(vkeep_position,cursor);
  CAMLlocal1(rval);
  int flags = 0, err;
  DBC *newcursor;

  if (UW_cursor_closed(cursor)) { 
    invalid_argument("Attempt to use closed cursor");
  }

  if (Is_Some(vkeep_position) && Bool_val(vkeep_position)) { 
    flags = DB_POSITION; 
  }
  
  err = UW_cursor(cursor)->c_dup(UW_cursor(cursor), &newcursor, flags);
  if (err != 0) { raise_db(db_strerror(err)); }

  rval = alloc_custom(&cursor_custom,Camldb_wosize,0,1);
  UW_cursor(rval) = newcursor;
  UW_cursor_closed(rval) = False;

  CAMLreturn (rval);
}


//+   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;

  if UW_db_closed(db) {       
    invalid_argument("caml_join_cursors: Attempt to use closed db");
  }
  
  UW_db(db)->join(UW_db(db),cursors,&jcurs,flags);
  

  rval = alloc_custom(&cursor_custom,Camldb_wosize,0,1);
  UW_cursor(rval) = jcurs;
  UW_cursor_closed(rval) = False;
  CAMLreturn (rval);
}


// +   external join_cursors : ?nosort:bool -> t -> cursor array -> cursor
// value caml_db_join_cursors(value ) {
//  
// }



// Termination of Cursor module
//+ 
//+ end
//+




[-- Attachment #3: bdb_stubs.h --]
[-- Type: text/x-c-header, Size: 2259 bytes --]

/*****************************************************************/
/**  DBENV *******************************************************/
/*****************************************************************/

struct camldbenv {
  DB_ENV *dbenv;
  int closed;
};

/*****************************************************************/
/***  DB  ********************************************************/
/*****************************************************************/

struct camldb {
  DB *db;
  int closed;
};

/*****************************************************************/
/***  DB_TXN  ****************************************************/
/*****************************************************************/

struct camltxn {
  DB_TXN *txn;
  int closed;
};

/*****************************************************************/
/***  DB_CURSOR  *************************************************/
/*****************************************************************/

struct camlcursor {
  DBC *cursor;
  int closed;
};

/*****************************************************************/
/**  DB and DBENV macros  ****************************************/
/*****************************************************************/

// datatype syzes
#define Camldbenv_wosize \
  ((sizeof(struct camldbenv) + sizeof(value) - 1) / sizeof(value))
#define Camldb_wosize \
  ((sizeof(struct camldb) + sizeof(value) - 1) / sizeof(value))

// Unwrapping functions
#define UW_dbenv(v) (((struct camldbenv *)(Bp_val(v)))->dbenv)
#define UW_dbenv_closed(v) (((struct camldbenv *)(Bp_val(v)))->closed)

#define UW_db(v) (((struct camldb *)(Bp_val(v)))->db)
#define UW_db_closed(v) (((struct camldb *)(Bp_val(v)))->closed)

#define UW_txn(v) (((struct camltxn *)(Bp_val(v)))->txn)
#define UW_txn_closed(v) (((struct camltxn *)(Bp_val(v)))->closed)

#define UW_cursor(v) (((struct camlcursor *)(Bp_val(v)))->cursor)
#define UW_cursor_closed(v) (((struct camlcursor *)(Bp_val(v)))->closed)

#define Is_string(v)   (Is_block(v) && (Tag_val(v) == String_tag))
#define Is_None(v)  (Is_long(v))
#define Is_Some(v)  (~Is_long(v))
#define Some_val(v) (Field(v,0))
#define Flag_val(vflag,flags) (flags[Long_val(vflag)])


[-- Attachment #4: Makefile --]
[-- Type: text/x-makefile, Size: 3000 bytes --]

#########################################################################
#                                                                       #
#                            Objective Caml                             #
#                                                                       #
#            Xavier Leroy, projet Cristal, INRIA Rocquencourt           #
#                                                                       #
#   Copyright 1999 Institut National de Recherche en Informatique et    #
#   en Automatique.  All rights reserved.  This file is distributed     #
#   under the terms of the GNU Library General Public License, with     #
#   the special exception on linking described in file ../../LICENSE.   #
#                                                                       #
#########################################################################

# $Id: Makefile,v 1.5 2001/12/07 13:39:50 xleroy Exp $

CINCLUDES=-I$(CAMLLIB)
ifeq ($(OSTYPE),cygwin)
   CC=gcc
   CXX=g++
   CFLAGS=-O3 -Werror-implicit-function-declaration $(CINCLUDES) -I .
   CXXFLAGS=-O3 $(CINCLUDES) -I .
   OCAMLC=ocamlc.opt
   OCAMLOPT=ocamlopt.opt
else
   CC=gcc
   CXX=g++
   CFLAGS=-O3 -Werror-implicit-function-declaration $(CINCLUDES) -I .
   CXXFLAGS=-O3 $(CINCLUDES) -I .
   OCAMLC=ocamlc.opt
   OCAMLOPT=ocamlopt.opt
endif

#PP=-pp "cpp -traditional -UNTL"

RANLIB=ranlib
OCAMLDEP=ocamldep $(PP)
CAMLINCLUDE=-I $(HOME)/arch/noarch/lib/ocaml -I $(HOME)/arch/x86-Linux/lib/ocaml
COMMONCAMLFLAGS= $(CAMLINCLUDE) $(PP) #-thread 
CAMLLIBS=unix.cma str.cma mylibs.cma 
OCAMLFLAGS=$(COMMONCAMLFLAGS) -g 
OCAMLOPTFLAGS=$(COMMONCAMLFLAGS) -inline 40 

COBJS = bdb_stubs.o

libmlbdb.a: $(COBJS)
	rm -rf libmlbdb.a
	ar rc libmlbdb.a $(COBJS)
	$(RANLIB) libmlbdb.a

bdb.ml: bdb_stubs.c
	ocextr bdb_stubs.c > bdb.ml

test: bdb.cma test.ml
	$(OCAMLC) $(OCAMLFLAGS) $(CAMLLIBS) -o test bdb.cma test.ml 

bdb.cma: bdb.cmo libmlbdb.a
	$(OCAMLC) $(OCAMLFLAGS) -a -o bdb.cma -custom bdb.cmo -cclib -lmlbdb -cclib -ldb -ccopt "-L ."

bdb.cmxa: bdb.cmx
	$(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o bdb.cmxa bdb.cmx -cclib -lmlbdb -cclib -ldb

bdbcaml: bdb.cma
	ocamlmktop -o bdbcaml -custom unix.cma $^

partialclean:
	rm -f *.cm*

clean: partialclean
	rm -f *.a *.o

install:
	cp libmldb.a $(LIBDIR)/libmldb.a
	cd $(LIBDIR); $(RANLIB) libmldb.a
	cp db.cma db.cmi db.mli $(LIBDIR)

installopt:
	cp db.cmx db.cmxa db.a $(LIBDIR)
	cd $(LIBDIR); $(RANLIB) db.a



# Common rules
.SUFFIXES: .ml .mli .cmo .cmi .cmx

.ml.o:
	$(OCAMLOPT) -output-obj $(OCAMLOPTFLAGS) $< 

.cpp.o:
	$(CXX) $(CXXFLAGS) -c $<

.c.o:
	$(CC) $(CFLAGS) -c $< 

.c.obj:
	$(CC) $(CFLAGS) /c $< 

.ml.cmo:
	$(OCAMLC) $(OCAMLFLAGS) -c $<

.mli.cmi:
	$(OCAMLC) $(OCAMLFLAGS) -c $<

.ml.cmx:
	$(OCAMLOPT) $(OCAMLOPTFLAGS) -c $<

# Dependencies
dep:
	$(OCAMLDEP) $(INCLUDES) *.ml *.mli > .depend

include .depend


# DO NOT DELETE

[-- Attachment #5: ocextr --]
[-- Type: text/plain, Size: 399 bytes --]

#!/usr/bin/env python2

import string
import os
import sys

try:
    fnames = sys.argv[1:]
except:
    print "Failed: no arguments given"
    sys.exit(-1)

for fname in fnames:
    file = open(fname)
    for line in file.readlines():
        if line[:3] == "//+":
            if line[3] == " ":
                print line[4:],
            else:
                print
        

Re: [Caml-list] Opaque pointers with camlidl

[Michael Tucker]

Hi,

  Thanks for all the responses, I definitely have somewhere to start from.
I need transaction support, so it may need some tinkering. Also, I've been
working with the latest version of Berkeley DB (from Sleepycat) - I have
their header files, and the .in files they generate them from (they build
the interface for C, C++, Java, etc from the same .in file). Does anyone
have any tips for annotating header files?

Thanks!
Mike

-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners

Re: [Caml-list] Opaque pointers with camlidl

[Olivier Andrieu]

 Yaron M. Minsky [ 17 July 2002] :
 > For what it's worth, I have written a small berkeley DB interface (for
 > version 3.3.11, the one found in RH 7.3), which I've attached to this
 > email. 

Hi, 

At the beginning, of your stub I noticed this :

static void finalize_caml_dbenv(value dbenv) { 
  CAMLparam1(dbenv);
  caml_dbenv_close_internal(dbenv); 
  CAMLreturn0;
}

I think it's not a good idea to use CAMLparam* in the finalisation
function. IIRC, the manual explicitly says not to.

-- 
	  Olivier
-------------------
To unsubscribe, mail caml-list-request@inria.fr Archives: http://caml.inria.fr
Bug reports: http://caml.inria.fr/bin/caml-bugs FAQ: http://caml.inria.fr/FAQ/
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners