From: Pascal Brisset <Pascal.Brisset@wanadoo.fr>
Date: Fri, 30 Oct 1998 18:56:38 +0100 (MET)
To: Thierry Bravier <thierry.bravier@dassault-aviation.fr>
Subject: Re: problem with ocamlmktop (contd)
In-Reply-To: <13881.37437.266875.483207@lsun162>
<19981015192243.14795@pauillac.inria.fr>
--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 <pascal.brisset@cnet.francetelecom.fr> +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 <stdio.h>
#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 <stdio.h>
extern "C" {
# include <caml/mlvalues.h>
# include <caml/alloc.h>
# include <caml/callback.h>
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--
This archive was generated by hypermail 2b29 : Sun Jan 02 2000 - 11:58:16 MET