[Caml-list] Interfacing with C++: Gc pbm

[Christophe TROESTLER <debian00@tiscalinet.be>]

[-- Attachment #1: Type: Text/Plain, Size: 1625 bytes --]

Dear Caml riders,

I am trying to access C++ code from OCaml.  I have read
http://caml.inria.fr/Hump/msg778-782 but then this message uses the
interface prior to OCaml 3.00 so I have been trying to rewrite the
example using custom blocks (also to eventually have the added sugar
of comparison,...).  It sort of work; I have problems with the Garbage
Collector giving me a Segmentation fault.  The code is attached below.
If somebody is kind enough to have a look at the files and to point to
me the mistake I made I will be very grateful.

I also want to take opportunity of this message to mention another
problem I met.  To avoid name collisions, it is sometimes desirable to
use a private namespace for Caml .h files, e.g.:

namespace ml {
    extern "C" {
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/memory.h>
#include <caml/fail.h>
    }
}

This however has two consequences:

* Some macros do not work anymore since the namespace is not
  "propagated" into the macros definitions.  As a consequence, lost of
  macros need to be redefined which is not robust w.r.t. software
  upgrades...

* One must know what is a macro and what if a function: for example on
  must write ml::value, ml::alloc_custom, and
  ml::custom_serialize_default but one stays with Field, String_val,
  and custom_deserialize_default

Maybe future versions of the header files could solve this problem by
adding automatically a prefix/namespace for C++ compilation, making
everything a macro and making the macros compatible with the prefix
(or maybe there is a better solution ?).

Cheers,
ChriS


[-- Attachment #2: Makefile --]
[-- Type: Text/Plain, Size: 493 bytes --]

LIBCAMLRUN=	-cclib /usr/lib/ocaml/libcamlrun.a
CAMLMKTOP=	ocamlmktop
CC=		g++

test: test.ml cell.cma
	ocamlc -cc $(CC) -o test.out  cell.cma test.ml
	./test.out

cell.cma: cell.ml cell.cpp  libcell.o
	$(CC) -c cell.cpp
	ocamlc -cc $(CC) -c cell.ml
	ocamlc -cc $(CC) -a -o cell.cma  -custom cell.o cell.cmo   \
		libcell.o $(LIBCAMLRUN)


libcell.o: libcell.cpp libcell.h
	$(CC) -c libcell.cpp

cell_ocaml: 
	$(CAMLMKTOP) -cc $(CC) -custom cell.cma  -o $@


clean:
	rm -f *~ *.out *.o *.cm[oi]

[-- Attachment #3: libcell.h --]
[-- Type: Text/Plain, Size: 283 bytes --]

// libcell interface                      -*-c++-*-

class Exc {
public:
    Exc(const char *m);
    const char *msg;
};

class Cell {
public:
    Cell(int);
    ~Cell();
    void set(int);
    int get();
private:
    int val;
};


extern Cell global_cell;

  
	
    
    


  
    

[-- Attachment #4: libcell.cpp --]
[-- Type: Text/Plain, Size: 487 bytes --]

// libcell implementation

extern "C" {
#include <stdio.h>
}
#include "libcell.h"

using namespace std;


Exc::Exc(const char *m) : msg(m) {}

Cell::Cell(int init) : val(init) 
{
    printf("(libcell) init %p = %i\n", this, init);
    fflush(stdout);
}

Cell::~Cell()
{
    printf("(libcell) free %p (was %i)\n", this, val);
    fflush(stdout);
}


void Cell::set(int x)
{
    if (x < 0) throw Exc("< 0");
    val = x;
}

int Cell::get()
{
    return val;
}

Cell global_cell(3141592);


[-- Attachment #5: cell.cpp --]
[-- Type: Text/Plain, Size: 1832 bytes --]

// Stub code to access libcell from OCaml

extern "C" {
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/memory.h>
#include <caml/fail.h>
#include <caml/callback.h>
}

#include "libcell.h"


#define CELL_PTR(v) ((Cell *) Data_custom_val(v))
#define CELL_VAL(v) (* CELL_PTR(v))

static void free_cell(value v)
{
    delete CELL_PTR(v);
}

int compare_cell(value v1, value v2)
{
    return CELL_VAL(v1).get() - CELL_VAL(v2).get();
}

struct custom_operations cell_ops = {
    /* identifier */ "Cell/v0.1",
    /* finalize */ &free_cell,
    /* compare */ &compare_cell,
    /* hash */ custom_hash_default,
    /* serialize */ custom_serialize_default,
    /* deserialize */ custom_deserialize_default
};



extern "C"
value cell_global(value v)
{
    CAMLparam1(v);
    CAMLlocal1(res);
    extern struct custom_operations cell_ops;
    extern Cell global_cell;
    
    res = alloc_custom(&cell_ops, sizeof(Cell), sizeof(Cell), 1000);
    CELL_VAL(res) = global_cell;
    CAMLreturn(res);
}


extern "C"
value cell_create(value v)
{
    CAMLparam1(v);
    CAMLlocal1(res);
    extern struct custom_operations cell_ops;
    Cell c(Int_val(v));
    
    res = alloc_custom(&cell_ops, sizeof(Cell), sizeof(Cell), 1000);
    CELL_VAL(res) = c;
    CAMLreturn(res);
}


extern "C"
value cell_set(value v1, value v2)
{
    try {
	CELL_VAL(v1).set( Int_val(v2) );
    } catch (Exc e) {
	failwith((char *) e.msg);
    }
    return(Val_unit);
}

extern "C"
value cell_get(value v)
{
    return( Val_int(CELL_VAL(v).get()) );
}



extern "C"
value cell_throw(value)
{
    throw Exc("cell_throw");
}

extern "C"
value cell_call(value v)
{
    value f = *caml_named_value(String_val(v));
    try {
	return callback(f, Val_unit);
    } catch (Exc e) {
	return copy_string((char *) e.msg);
    }
}


    

[-- Attachment #6: cell.ml --]
[-- Type: Text/Plain, Size: 384 bytes --]

(* Implementation of the module [Cell].  Since no interface is
   defined, all functions will be exported. *)

type t

external global : unit -> t = "cell_global"
external create : int -> t = "cell_create"
external set : t -> int -> unit = "cell_set"
external get : t -> int = "cell_get"

external throw : unit -> string = "cell_throw"
external call : string -> string = "cell_call"


[-- Attachment #7: test.ml --]
[-- Type: Text/Plain, Size: 672 bytes --]

open Printf

let test_cell c =
  printf "c = %d\n" (Cell.get c); flush stdout;
  printf "set c to 42... "; flush stdout;
  Cell.set c 42;
  printf "c = %d\n" (Cell.get c); flush stdout;
  try
    printf "set c to -1... "; flush stdout;
    Cell.set c (-1);
  with 
      e -> begin print_endline (Printexc.to_string e); flush stdout end
	

let () =
  print_endline "Start..."; flush stdout;
  test_cell (Cell.create 271828);
  Gc.full_major();
  print_newline(); flush stdout;
  test_cell (Cell.global());
  print_newline(); flush stdout

(*
let () =
  Callback.register "caml-throw" Cell.throw;
  print_endline ("callback: " ^ (Cell.call "caml_throw")); flush stdout 
*)