Original bug ID: 1228
Reporter: administrator
Status: closed
Resolution: fixed
Priority: normal
Severity: minor
Category: ~DO NOT USE (was: OCaml general)

Bug description

Bonjour,

j'ai un problème avec les callback (code caml appelé depuis le C) qui
lèvent des exceptions.

Ci-joint un programme qui met en évidence le problème : j'ai une
fonction C que je veux interfacer qui a comme argument un pointeur
vers une fonction faisant un calcul numérique (ie qui renvoie un
double). En caml, je fais un external qui a un argument (float ->
float) et le wrapper se débrouille pour que la fonction C appelle
cette fermeture.

Ça marche bien mais je voudrais intercepter les exceptions levées par
la fermeture et les transformer en NaN (par exemple). Je fais donc
quelque chose dans ce goût là :

if(Is_exception_result(result))
return 0;

Ça marche bien avec le compileur natif mais le compilateur byte-code
se plante : le calcul se termine mais la fermeture est inutilisable
après (segfault).

Je ne comprends pas pourquoi ça ne marche pas et comme le ocamlopt y
arrive, je me disais que c'est peut-être un bug.

,----
| $ ocamlc -v
| The Objective Caml compiler, version 3.04+15 (2002-06-18)
| Standard library directory: /usr/akasha/ocaml/lib/ocaml
| $ ocamlc -custom -o callback test_callback_c.c test_callback.ml
| $ ./callback 2 0 1 0.4
| params: a=2.000000 from=0.000000 to=1.000000 step=0.400000
|
| callback with closure at 0x401f61ac
| calling f with params: a=2.000000 x=0.000000
| callback with closure at 0x401f61ac
| calling f with params: a=2.000000 x=0.400000
| callback with closure at 0x401f61ac
| calling f with params: a=2.000000 x=0.800000
| result= 0.266667
|
| calling f with params: a=3.000000 x=24.000000
|
| callback with closure at 0x401f5c74
| calling g with params: a=2.000000 x=0.000000
| callback with closure at 0x401f5c74
| calling g with params: a=2.000000 x=0.400000
| --> OCaml callback raised an exception
| callback with closure at 0x401f5c74
| calling g with params: a=2.000000 x=0.800000
| result= 0.213333
|
| Segmentation fault
`----

--
Olivier

/*
le callback C : un pointeur sur une fonction et un parametre.
/
struct function_struct
{
double ( function) (double x, void * params);
void * params;
};
typedef struct function_struct function ;
#define FN_EVAL(F,x) (*((F)->function))(x,(F)->params)

/*
une fonction à interfacer utilisant un callback tel que défini précédemment.
*/
double compute_mean(function *f, double from, double to, double step)
{
double i=from;
double acc=0;
int n=0;
for(i=from; i<to; i+=step){
acc += FN_EVAL(f, i);
n++;
}
return acc / n;
}

/* le code d'inbteraction avec caml maintenant ... */
#include <caml/mlvalues.h>
#include <caml/callback.h>
#include <caml/memory.h>
#include <caml/alloc.h>

#include <stdio.h>

/*
le callback C qui fait le lien avec une fermeture caml.
params est un pointeur vers la fermeture à appeler.

les exceptions sont interceptées.
*/
static double my_callback(double x, void *params)
{
CAMLparam0();
value v_x, res;
value *closure = (value *)params;
v_x = copy_double(x);
fprintf(stderr, "callback with closure at %p\n", (void *)(*closure));
fflush(stderr);
res = callback_exn(*closure, v_x);
if(Is_exception_result(res)){
fprintf(stderr, "--> OCaml callback raised an exception\n");
fflush(stderr);
CAMLreturn(0);
}
CAMLreturn(Double_val(res));
}

/*
le wrapper qui va appeler la fonction C. Il mets en place un
callback qui utilise la fermeture donnée en argument.
/
value ml_compute_mean(value fun, value from, value to, value step)
{
/ on met la fermeture dans les racines du GC /
CAMLparam4(fun, from, to, step);
function f;
double res;
/ on met en place le callback /
f.function = &my_callback;
f.params = &fun;
/ on appelle la fonction */
res = compute_mean(&f, Double_val(from), Double_val(to), Double_val(step));
CAMLreturn(copy_double(res));
}

external compute_mean : (float -> float) -> float -> float -> step:float -> float
= "ml_compute_mean"

let f a x =
Printf.eprintf "calling f with params: a=%f x=%f\n" a x ;
flush stderr ;
x ** a

let g a x =
Printf.eprintf "calling g with params: a=%f x=%f\n" a x ;
flush stderr ;
if x = 0.4 then raise Exit ;
x ** a

let _ =
let args = Array.map float_of_string (Array.sub Sys.argv 1 4) in
Printf.printf "params: a=%f from=%f to=%f step=%f\n\n"
args.(0) args.(1) args.(2) args.(3) ;
flush stdout ;

let res = compute_mean (f args.(0)) args.(1) args.(2) ~step:args.(3) in
Printf.printf "result= %f\n\n" res ;
flush stdout ;

ignore (f 3. 24.) ;
print_newline () ;
flush stdout ;

let res = compute_mean (g args.(0)) args.(1) args.(2) ~step:args.(3) in
Printf.printf "result= %f\n\n" res ;
flush stdout ;

ignore (g 3. 24.)