From mboxrd@z Thu Jan 1 00:00:00 1970 Received: (from weis@localhost) by pauillac.inria.fr (8.7.6/8.7.3) id UAA19968 for caml-redistribution; Fri, 30 Oct 1998 20:00:24 +0100 (MET) Received: from nez-perce.inria.fr (nez-perce.inria.fr [192.93.2.78]) by pauillac.inria.fr (8.7.6/8.7.3) with ESMTP id SAA19380 for ; Fri, 30 Oct 1998 18:56:51 +0100 (MET) Received: from wanadoo.fr (smtp-out-2.wanadoo.fr [193.252.19.69]) by nez-perce.inria.fr (8.8.7/8.8.7) with ESMTP id SAA21458 for ; Fri, 30 Oct 1998 18:56:50 +0100 (MET) Received: from root@tamaya.wanadoo.fr [193.252.19.31] by wanadoo.fr for Paris Fri, 30 Oct 1998 18:55:12 +0100 (MET) Received: from stbri2-160.abo.wanadoo.fr [193.252.209.160] by smtp.wanadoo.fr for Paris Fri, 30 Oct 1998 18:55:08 +0100 (MET) From: Pascal Brisset Message-ID: <13881.64982.392952.452261@whynot> Date: Fri, 30 Oct 1998 18:56:38 +0100 (MET) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="QQVnq0P0rj" Content-Transfer-Encoding: 7bit To: Thierry Bravier CC: caml-list@inria.fr Subject: Re: problem with ocamlmktop (contd) In-Reply-To: <13881.37437.266875.483207@lsun162> References: <3624D5BE.3060@dassault-aviation.fr> <19981015192243.14795@pauillac.inria.fr> <3627228B.20CE@dassault-aviation.fr> <36349D52.1E7B@dassault-aviation.fr> <13881.37437.266875.483207@lsun162> X-Mailer: VM 6.47 under Emacs 19.34.1 Sender: weis --QQVnq0P0rj Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit Here is a more complete example demonstrating: (1) destructors of global objects being called correctly on exit; (2) translation of C++ exceptions to Caml exceptions; (3) catching a C++ exception generated by a C++ primitive called through a Caml callback. The only trick is that if you really need (3), you have to modify libcamlrun.a (found in ocaml-1.07/byterun) as follows: - Insert `extern "C" {' at the beginning of interp.c and callback.c - Insert `}' at the end of interp.c and callback.c - Compile interp.c and callback.c with g++ (This will add ".eh_frame" sections which are required for exceptions handling): g++ -O -fno-defer-pop -Wall -c interp.c -o interp.o g++ -O -fno-defer-pop -Wall -c callback.c -o callback.o - Compile everything else normally (make libcamlrun.a) The Makefile assumes that the modified libcamlrun.a is in /tmp/ocaml-1.07/byterun/. This was tested with ocaml-1.07 and g++-2.8.1. Again, things seem to have improved a lot since gcc-2.7. - Pascal Brisset +33296051928 - - France Telecom CNET DTL/MSV | 2 av Pierre Marzin | F-22307 Lannion - --QQVnq0P0rj Content-Type: text/plain Content-Description: Makefile Content-Disposition: inline; filename="Makefile" Content-Transfer-Encoding: 7bit LIBCAMLRUN=-cclib /tmp/ocaml-1.07/byterun/libcamlrun.a run: g++ -I/usr/local/lib/ocaml -c libcell.C g++ -I/usr/local/lib/ocaml -c mlcell.C ocamlc -custom libcell.o mlcell.o cell.ml -o cell.out $(LIBCAMLRUN) ./cell.out clean: /bin/rm -f *.out *.o *.cm[io] *~ \#*\# --QQVnq0P0rj Content-Type: text/plain Content-Description: cell.ml Content-Disposition: inline; filename="cell.ml" Content-Transfer-Encoding: 7bit module Cell = struct type t external global : unit -> t = "caml_global_cell" external create : int -> t = "caml_cell_create" external set : t -> int -> unit = "caml_cell_set" external get : t -> int = "caml_cell_get" external throw : unit -> string = "caml_cell_throw" external call : string -> string = "caml_cell_call" end let test_cell c = Printf.printf "c=%d\n" (Cell.get c); flush stdout; Printf.printf "set 42... "; flush stdout; Cell.set c 42; Printf.printf "c=%d\n" (Cell.get c); flush stdout; begin try Printf.printf "set -1... "; flush stdout; Cell.set c (-1); with e -> 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 (); test_cell (Cell.global ()); print_newline () let _ = Callback.register "caml-throw" Cell.throw; print_endline ("callback: "^Cell.call "caml-throw"); flush stdout --QQVnq0P0rj Content-Type: text/plain Content-Description: libcell.C Content-Disposition: inline; filename="libcell.C" Content-Transfer-Encoding: 7bit #include #include "libcell.h" Exc::Exc(const char *m) : msg(m) { } Cell::Cell(int init) : val(init) { printf("init %p=%d\n", this, init); } Cell::~Cell() { printf("free %p (was %d)\n", this, val); } void Cell::set(int x) { if ( x < 0 ) throw Exc("< 0"); val = x; } int Cell::get() { return val; } Cell global_cell(3141592); --QQVnq0P0rj Content-Type: text/plain Content-Description: libcell.h Content-Disposition: inline; filename="libcell.h" Content-Transfer-Encoding: 7bit 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; --QQVnq0P0rj Content-Type: text/plain Content-Description: mlcell.C Content-Disposition: inline; filename="mlcell.C" Content-Transfer-Encoding: 7bit #include extern "C" { # include # include # include extern void failwith(char *s); } #include "libcell.h" typedef struct { final_fun f; Cell *c; } mlcell; static void free_cell(value mlc) { delete ((mlcell*)mlc)->c; } static mlcell mlglobal_cell = { free_cell, &global_cell }; extern "C" value caml_global_cell(value) { return (value)&mlglobal_cell; } extern "C" value caml_cell_create(value mlv) { value res = alloc_final(sizeof(mlcell)/sizeof(value), free_cell, 1, 1000); /* ? */ ((mlcell*)res)->c = new Cell(Int_val(mlv)); return res; } extern "C" value caml_cell_set(value mlc, value mlv) { try { ((mlcell*)mlc)->c->set(Int_val(mlv)); } catch (Exc e) { failwith((char*)e.msg); } return Val_unit; } extern "C" value caml_cell_get(value mlc) { int v = ((mlcell*)mlc)->c->get(); return Val_int(v); } extern "C" value caml_cell_throw(value) { throw Exc("caml_cell_throw"); } extern "C" value caml_cell_call(value mlname) { value f = *caml_named_value(String_val(mlname)); try { return callback(f, Val_unit); } catch (Exc e) { return copy_string((char*)e.msg); } } --QQVnq0P0rj--