Exemple #1
0
CAMLprim value ocaml_f0r_dlopen(value fname)
{
  CAMLparam1(fname);
  CAMLlocal1(ans);
  plugin_t *p = malloc(sizeof(plugin_t));

  p->handle = dlopen(String_val(fname), RTLD_LAZY);
  if (!p->handle) { free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->init = dlsym(p->handle, "f0r_init");
  if (!p->init) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->deinit = dlsym(p->handle, "f0r_deinit");
  if (!p->deinit) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->get_plugin_info = dlsym(p->handle, "f0r_get_plugin_info");
  if (!p->get_plugin_info) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->get_param_info = dlsym(p->handle, "f0r_get_param_info");
  if (!p->get_param_info) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->construct = dlsym(p->handle, "f0r_construct");
  if (!p->construct) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->destruct = dlsym(p->handle, "f0r_destruct");
  if (!p->destruct) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->get_param_value = dlsym(p->handle, "f0r_get_param_value");
  if (!p->get_param_value) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->set_param_value = dlsym(p->handle, "f0r_set_param_value");
  if (!p->set_param_value) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }
  p->update = dlsym(p->handle, "f0r_update");
  p->update2 = dlsym(p->handle, "f0r_update2");
  if (!p->update && !p->update2) { dlclose(p->handle); free(p); caml_raise_constant(*caml_named_value("f0r_exn_not_a_plugin")); }

  p->init();
  ans = caml_alloc_custom(&plugin_ops, sizeof(plugin_t*), 0, 1);
  Plugin_val(ans) = p;

  CAMLreturn(ans);
}
Exemple #2
0
 void zompInitCamlCallbacks() {
     isBoundCB = caml_named_value("isBound");
     lookupCB = caml_named_value("lookup");
     parseCB = caml_named_value("parse");
     getCounterValueInt = caml_named_value("zompCommonGetCounterValueInt");
     getCounterValueFloat = caml_named_value("zompCommonGetCounterValueFloat");
 }
Exemple #3
0
static uint64 on_state_change (utp_callback_arguments *a)
{
  CAMLparam0 ();
  value *cb;
  static value *on_connect_fun = NULL;
  static value *on_writable_fun = NULL;
  static value *on_eof_fun = NULL;
  static value *on_close_fun = NULL;

  if (on_connect_fun == NULL) on_connect_fun = caml_named_value ("utp_on_connect");
  if (on_writable_fun == NULL) on_writable_fun = caml_named_value ("utp_on_writable");
  if (on_eof_fun == NULL) on_eof_fun = caml_named_value ("utp_on_eof");
  if (on_close_fun == NULL) on_close_fun = caml_named_value ("utp_on_close");
  switch (a->state) {
    case UTP_STATE_CONNECT:
      cb = on_connect_fun;
      break;
    case UTP_STATE_WRITABLE:
      cb = on_writable_fun;
      break;
    case UTP_STATE_EOF:
      cb = on_eof_fun;
      break;
    case UTP_STATE_DESTROYING:
      UTP_DEBUG ("destroying socket");
      cb = on_close_fun;
      break;
    default:
      UTP_DEBUG ("unknown state change: %d", a->state);
      cb = NULL;
      break;
  }
  if (cb) caml_callback (*cb, Val_utp_socket (a->socket));
  CAMLreturn (0);
}
Exemple #4
0
CAMLprim value ocaml_ssl_embed_socket(value socket_, value context)
{
  CAMLparam1(context);
  CAMLlocal1(block);
#ifdef Socket_val
  SOCKET socket = Socket_val(socket_);
#else
  int socket = Int_val(socket_);
#endif
  SSL_CTX *ctx = Ctx_val(context);
  SSL *ssl;

  block = caml_alloc_custom(&socket_ops, sizeof(SSL*), 0, 1);

  if (socket < 0)
    caml_raise_constant(*caml_named_value("ssl_exn_invalid_socket"));
  caml_enter_blocking_section();
  ssl = SSL_new(ctx);
  if (!ssl)
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_handler_error"));
  }
  SSL_set_fd(ssl, socket);
  caml_leave_blocking_section();
  SSL_val(block) = ssl;

  CAMLreturn(block);
}
CAMLprim value ocaml_gstreamer_appsrc_push_buffer_data(value _as, value _buf)
{
  CAMLparam2(_as, _buf);
  int buflen = Caml_ba_array_val(_buf)->dim[0];
  appsrc *as = Appsrc_val(_as);
  GstBuffer *gstbuf;
  GstMapInfo map;
  GstFlowReturn ret;
  gboolean bret;

  caml_release_runtime_system();
  gstbuf = gst_buffer_new_and_alloc(buflen);
  bret = gst_buffer_map(gstbuf, &map, GST_MAP_WRITE);
  caml_acquire_runtime_system();

  if(!bret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
  memcpy(map.data, (unsigned char*)Caml_ba_data_val(_buf), buflen);

  caml_release_runtime_system();
  gst_buffer_unmap(gstbuf, &map);
  ret = gst_app_src_push_buffer(as->appsrc, gstbuf);
  caml_acquire_runtime_system();

  if (ret != GST_FLOW_OK) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
  CAMLreturn(Val_unit);
}
Exemple #6
0
CAMLprim value ocaml_ssl_ctx_init_ec_from_named_curve(value context, value curve_name)
{
  CAMLparam2(context, curve_name);
  EC_KEY *ecdh = NULL;
  int nid = 0;
  SSL_CTX *ctx = Ctx_val(context);
  char *ec_curve_name = String_val(curve_name);

  if(*ec_curve_name == 0)
    caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));

  nid = OBJ_sn2nid(ec_curve_name);
  if(nid == 0){
    caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));
  }

  caml_enter_blocking_section();
  ecdh = EC_KEY_new_by_curve_name(nid);
  if(ecdh != NULL){
    if(SSL_CTX_set_tmp_ecdh(ctx,ecdh) != 1){
      caml_leave_blocking_section();
      caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));
    }
    SSL_CTX_set_options(ctx, SSL_OP_SINGLE_ECDH_USE);
    caml_leave_blocking_section();
    EC_KEY_free(ecdh);
  }
  else{
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_ec_curve_error"));
  }
  CAMLreturn(Val_unit);
}
Exemple #7
0
CAMLprim value ocaml_ssl_ctx_init_dh_from_file(value context, value dh_file_path)
{
  CAMLparam2(context, dh_file_path);
  DH *dh = NULL;
  SSL_CTX *ctx = Ctx_val(context);
  char *dh_cfile_path = String_val(dh_file_path);

  if(*dh_cfile_path == 0)
    caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error"));

  dh = load_dh_param(dh_cfile_path);
  caml_enter_blocking_section();
  if (dh != NULL){
    if(SSL_CTX_set_tmp_dh(ctx,dh) != 1){
      caml_leave_blocking_section();
      caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error"));
    }
    SSL_CTX_set_options(ctx, SSL_OP_SINGLE_DH_USE);
    caml_leave_blocking_section();
    DH_free(dh);
  }
  else{
      caml_leave_blocking_section();
      caml_raise_constant(*caml_named_value("ssl_exn_diffie_hellman_error"));
  }
  CAMLreturn(Val_unit);
}
Exemple #8
0
CAMLprim value ocaml_ssl_ctx_use_certificate(value context, value cert, value privkey)
{
  CAMLparam3(context, cert, privkey);
  SSL_CTX *ctx = Ctx_val(context);
  char *cert_name = String_val(cert);
  char *privkey_name = String_val(privkey);

  caml_enter_blocking_section();
  if (SSL_CTX_use_certificate_chain_file(ctx, cert_name) <= 0)
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_certificate_error"));
  }
  if (SSL_CTX_use_PrivateKey_file(ctx, privkey_name, SSL_FILETYPE_PEM) <= 0)
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_private_key_error"));
  }
  if (!SSL_CTX_check_private_key(ctx))
  {
    caml_leave_blocking_section();
    caml_raise_constant(*caml_named_value("ssl_exn_unmatching_keys"));
  }
  caml_leave_blocking_section();

  CAMLreturn(Val_unit);
}
Exemple #9
0
CAMLprim value caml_sqlite3_init(value __unused v_unit)
{
  caml_sqlite3_InternalError = caml_named_value("Sqlite3.InternalError");
  caml_sqlite3_Error = caml_named_value("Sqlite3.Error");
  caml_sqlite3_RangeError = caml_named_value("Sqlite3.RangeError");
  return Val_unit;
}
CAMLprim value PQocaml_init(value __unused v_unit)
{
  v_empty_string = caml_alloc_string(0);
  caml_register_generational_global_root(&v_empty_string);
  v_exc_Oid = caml_named_value("Postgresql.Oid");
  v_null_param = caml_named_value("Postgresql.null");
  return Val_unit;
}
Exemple #11
0
CAMLprim value camltk_init(value v)
{
  /* Initialize the OCaml pointers */
  if (tkerror_exn == NULL)
    tkerror_exn = caml_named_value("tkerror");
  if (handler_code == NULL)
    handler_code = caml_named_value("camlcb");
  return Val_unit;
}
Exemple #12
0
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");
  if (caml_db_run_recovery_exn == NULL) 
    caml_db_run_recovery_exn = caml_named_value("dbrunrecovery");
  CAMLreturn (Val_unit);
}
Exemple #13
0
void ast_init(void) {
  if (ast_inited) return;

  ast_inited = 1;

  ocaml_mk_ast_info    = caml_named_value("mk_ast_info");
  ocaml_print_ast_node = caml_named_value("print_ast_node"); 
  ocaml_get_prim       = caml_named_value("get_prim");
  ocaml_mk_formal_args = caml_named_value("mk_formal_args");
  ocaml_mk_actual_args = caml_named_value("mk_actual_args");
}
CAMLprim value ocaml_gstreamer_appsink_pull_buffer(value _as, value string_mode)
{
  CAMLparam1(_as);
  CAMLlocal1(ans);
  appsink *as = Appsink_val(_as);
  GstSample *gstsample;
  GstBuffer *gstbuf;
  GstMapInfo map;
  intnat len;
  gboolean ret;

  caml_release_runtime_system();
  gstsample = gst_app_sink_pull_sample(as->appsink);
  caml_acquire_runtime_system();

  if (!gstsample)
    {
      if (gst_app_sink_is_eos(as->appsink))
        caml_raise_constant(*caml_named_value("gstreamer_exn_eos"));
      else
        caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
    }

  caml_release_runtime_system();
  gstbuf = gst_sample_get_buffer(gstsample);
  caml_acquire_runtime_system();

  if (!gstbuf) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));

  caml_release_runtime_system();
  ret = gst_buffer_map(gstbuf, &map, GST_MAP_READ);
  caml_acquire_runtime_system();

  if (!ret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));

  len = map.size;
  if (string_mode == Val_false) {
    ans = caml_ba_alloc(CAML_BA_C_LAYOUT | CAML_BA_UINT8, 1, NULL, &len);
    memcpy(Caml_ba_data_val(ans), map.data, len);
  } else {
    ans = caml_alloc_string(len);
    memcpy(String_val(ans), map.data, len);
  }

  caml_release_runtime_system();
  gst_buffer_unmap(gstbuf, &map);
  gst_sample_unref(gstsample);
  caml_acquire_runtime_system();

  CAMLreturn(ans);
}
Exemple #15
0
CAMLprim value caml_bjack_read(value device, value len)
{
    CAMLparam2(device,len);
    CAMLlocal1(ans);
    int n = Int_val(len) ;
    char* buf = malloc(n) ;
    jack_driver_t* drv = Bjack_drv_val(device);
    long ret;

    if (drv->num_input_channels > 0)
    {
        caml_enter_blocking_section();
        ret = JACK_Read(drv,(unsigned char *)buf,n);
        caml_leave_blocking_section();
    }
    else
    {
        caml_raise_constant(*caml_named_value("bio2jack_exn_too_many_input_channels"));
    }

    if (ret < 0) caml_failwith("jack_read");

    ans = caml_alloc_string(ret);
    memcpy(String_val(ans),buf,ret);
    free(buf);

    CAMLreturn(ans);
}
Exemple #16
0
CAMLprim value caml_bjack_write(value device, value data)
{
    CAMLparam2(device,data);
    int n = caml_string_length(data) ;
    jack_driver_t* drv = Bjack_drv_val(device);
    long ret;
    char* buf = malloc(n) ;
    memcpy(buf,String_val(data),n);

    if (drv->num_output_channels > 0)
    {
        caml_enter_blocking_section();
        ret = JACK_Write(drv,(unsigned char *)buf,n);
        caml_leave_blocking_section();
    }
    else
    {
        caml_raise_constant(*caml_named_value("bio2jack_exn_too_many_output_channels"));
    }

    if (ret < 0) caml_failwith("jack_write");

    free(buf);

    CAMLreturn(Val_long(ret));
}
Exemple #17
0
/* Fetchs the named OCaml-values + caches them and
   calculates + caches the variant hash values */
CAMLprim value pcre_ocaml_init(value __unused v_unit)
{
  pcre_exc_Error     = caml_named_value("Pcre.Error");
  pcre_exc_Backtrack = caml_named_value("Pcre.Backtrack");

  var_Start_only  = caml_hash_variant("Start_only");
  var_ANCHORED    = caml_hash_variant("ANCHORED");
  var_Char        = caml_hash_variant("Char");
  var_Not_studied = caml_hash_variant("Not_studied");
  var_Studied     = caml_hash_variant("Studied");
  var_Optimal     = caml_hash_variant("Optimal");

  pcre_callout = &pcre_callout_handler;

  return Val_unit;
}
Exemple #18
0
CAMLprim value caml_mdb_cursor_get(value curs,value key,value data,value op){
  CAMLparam4(curs,key,data,op);
  CAMLlocal3(result,mlkey,mldata);
  MDB_val key_,data_;
  key_.mv_data=String_val(key);
  key_.mv_size=caml_string_length(key);
  data_.mv_data=String_val(data);
  data_.mv_size=caml_string_length(data);

  int ret;
  if((ret=mdb_cursor_get(  (MDB_cursor*)curs,  &key_,  &data_, Int_val(op) ))){
    if(ret==MDB_NOTFOUND) {
      static value *exn=NULL;
      if(exn==NULL) exn=caml_named_value("lmdb_not_found");
      caml_raise_constant(*exn);
    } else
      caml_failwith("error in mdb_cursor_get");
  }
  mlkey=caml_alloc_string(key_.mv_size);
  memcpy(String_val(mlkey),key_.mv_data,key_.mv_size);
  mldata=caml_alloc_string(data_.mv_size);
  memcpy(String_val(mldata),data_.mv_data,data_.mv_size);
  result=caml_alloc(2,0);
  Store_field(result,0,mlkey);
  Store_field(result,1,mldata);
  CAMLreturn(result);
}
Exemple #19
0
/* Do a minor collection and a slice of major collection, call finalisation
   functions, etc.
   Leave the minor heap empty.
*/
CAMLexport void caml_minor_collection (void)
{
  value *note_gc;
  uint64_t start_time;

  note_gc = caml_named_value("MProf.Trace.note_gc");
  if (note_gc)
    start_time = NOW();

  intnat prev_alloc_words = caml_allocated_words;

  caml_empty_minor_heap ();

  caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
  ++ caml_stat_minor_collections;
  caml_major_collection_slice (0);
  caml_force_major_slice = 0;

  caml_final_do_calls ();

  if (note_gc){
    double duration_ns = (double) (NOW () - start_time);
    value result = caml_callback_exn(*note_gc, caml_copy_double(duration_ns / 1000000000));
    if (Is_exception_result(result))
      printk("warning: note_gc threw an exception!\n");
  }

  caml_empty_minor_heap ();
}
Exemple #20
0
CAMLprim value wrapper_bdd_allsat(value r) {
    CAMLparam1(r);
    BDD bdd = BDD_val(r);
    value* f = caml_named_value("__allsat_handler");
    void handler(char* varset, int size) {
        CAMLlocal2(tl,v);
        int i = 0;
        tl = Val_emptylist;
        //printf("size : %d\n", size);
        for (i = 0 ; i < size; i++) {
            //printf("%d : %d\n", i, varset[i]);
            // variants in ocaml range from 0 to n-1 !!!
            switch (varset[i]) {
            case  0 :
                v = Val_int(0);
                break; // False
            case  1 :
                v = Val_int(1);
                break; // True
            case -1 :
                v = Val_int(2);
                break; // Unknown
            default :
                caml_failwith("Unknown variable value");
                break;
            }
            if (varset[i] != -1) {
                tl = append(tuple(Val_int(i),v),tl);
            }
        }
        caml_callback(*f,tl);
        CAMLreturn0;
    }
Exemple #21
0
int function_in_wrapper(void){
   printf("Calling back into OCaml...\n");
   CAMLlocal2(provided_to_wrapper_v, from_callback);
   provided_to_wrapper_v = *caml_named_value("provided_to_wrapper");
   from_callback = caml_callback(provided_to_wrapper_v, Val_unit);
   return 0;
}
Exemple #22
0
void proc_start( const char* logdir,
                 const uint32_t analysis_id,
                 const char* sockname,
                 bool debug_flag,
                 const THREADID tid,
                 char** argvp,
                 int envc,
                 char** envp )
{
    CAMLparam0();
    CAMLlocalN( caml_args, 8 );
    static value *proc_start_closure = NULL;

    if ( !proc_start_closure ) {
        proc_start_closure = caml_named_value( "proc_start" );
    }

    caml_args[0] = caml_copy_string( logdir );
    caml_args[1] = caml_copy_int32( analysis_id );
    caml_args[2] = caml_copy_string( sockname );
    caml_args[3] = Val_bool( debug_flag );
    caml_args[4] = Val_int( tid );
    caml_args[5] = caml_copy_nativeint( (long) argvp );
    caml_args[6] = caml_copy_int32( envc );
    caml_args[7] = caml_copy_nativeint( (long) envp );

    caml_callbackN( *proc_start_closure, 8, caml_args );

    CAMLreturn0;
}
Exemple #23
0
bool check_mems_taint( memorylog_entry* memlog, unsigned int cnt )
{
    CAMLparam0();
    CAMLlocal4( addrs, ret, v, tupl );
    static value *proc_check_mems_taint = NULL;

    if ( !proc_check_mems_taint ) {
        proc_check_mems_taint = caml_named_value( "check_mems_taint" );
    }

    addrs = Val_emptylist;
    for ( unsigned int i = 0; i < cnt; i ++  ) {
        tupl = caml_alloc_tuple( 2 );
        Store_field( tupl, 0, caml_copy_nativeint( memlog[i].addr ) );
        Store_field( tupl, 1, Val_int( memlog[i].size * 8 ) );
        v = caml_alloc_small( 2, 0 );
        Field( v, 0 ) = tupl;
        Field( v, 1 ) = addrs;
        addrs = v;
    }

    ret = caml_callback( *proc_check_mems_taint, addrs );

    CAMLreturnT( bool, Bool_val( ret ) );
}
Exemple #24
0
static void raise_dbm(char *errmsg)
{
  static value * dbm_exn = NULL;
  if (dbm_exn == NULL)
    dbm_exn = caml_named_value("dbmerror");
  raise_with_string(*dbm_exn, errmsg);
}
Exemple #25
0
CAMLexport
int triunsuitable(vertex triorg, vertex tridest, vertex triapex, REAL area)
{
  CAMLparam0();
  CAMLlocal1(vd);
  static value * closure = NULL;
  value args[NARGS_TRIUNSUITABLE];
  if (closure == NULL) {
    closure = caml_named_value("triunsuitable_callback");
  }

#define COPY_DOUBLE(dest, d) \
  vd = caml_copy_double(d);  \
  dest = vd

  COPY_DOUBLE(args[0], triorg[0]);
  COPY_DOUBLE(args[1], triorg[1]);
  COPY_DOUBLE(args[2], tridest[0]);
  COPY_DOUBLE(args[3], tridest[1]);
  COPY_DOUBLE(args[4], triapex[0]);
  COPY_DOUBLE(args[5], triapex[1]);
  COPY_DOUBLE(args[6], area);
  CAMLreturn(Bool_val(callbackN(*closure, NARGS_TRIUNSUITABLE, args)));

#undef COPY_DOUBLE
}
Exemple #26
0
CAMLprim void p_print_int_test(value b, value num) {
	CAMLparam2(b, num);
	intnat x = Long_val(num);

	static value *buffer_add_char = NULL;
	if(buffer_add_char == NULL) {
		buffer_add_char = caml_named_value("Buffer__add_char");
		if(buffer_add_char == NULL) {
			caml_failwith("Could not find Buffer.add_char");
		}
	}

	if(x < 0) {
		caml_callback2(*buffer_add_char, b, Val_int((int)'-'));
		// TODO: min_int
		if(x == (1 << (8 * SIZEOF_PTR - 2))) {
			intnat div_me = x / 10;
			intnat mod_me = x % 10;
			p_do_enough(b, (uintnat)(-div_me), buffer_add_char);
			p_do_enough(b, (uintnat)(-mod_me), buffer_add_char);
		} else {
			p_do_enough(b, (uintnat)(-x), buffer_add_char);
		}
	} else {
		p_do_enough(b, (uintnat)x, buffer_add_char);
	}

	CAMLreturn0;
}
Exemple #27
0
CAMLprim value ocaml_ladspa_open(value fname)
{
  void *handle = dlopen(String_val(fname), RTLD_LAZY);
  LADSPA_Descriptor_Function ladspa_descriptor;

  if (!handle)
    caml_raise_constant(*caml_named_value("ocaml_ladspa_exn_not_a_plugin"));
  ladspa_descriptor = (LADSPA_Descriptor_Function)dlsym((void*)handle, "ladspa_descriptor");
  if (dlerror() != NULL || !ladspa_descriptor)
  {
    dlclose(handle);
    caml_raise_constant(*caml_named_value("ocaml_ladspa_exn_not_a_plugin"));
  }

  return (value)handle;
}
Exemple #28
0
void null_pointer_exn() {
	static value*  e = NULL;
	if(e == NULL) {
		e = caml_named_value("Null_pointer_exn");
	}
	caml_raise_constant(*e);
}
/* llmodule -> ExecutionEngine.t */
CAMLprim LLVMExecutionEngineRef llvm_ee_create(LLVMModuleRef M) {
  LLVMExecutionEngineRef Interp;
  char *Error;
  if (LLVMCreateExecutionEngineForModule(&Interp, M, &Error))
    llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error);
  return Interp;
}
void caml_fatal_uncaught_exception(value exn)
{
  char * msg;
  value * at_exit;
  int saved_backtrace_active, saved_backtrace_pos;

  /* Build a string representation of the exception */
  msg = caml_format_exception(exn);
  /* Perform "at_exit" processing, ignoring all exceptions that may
     be triggered by this */
  saved_backtrace_active = caml_backtrace_active;
  saved_backtrace_pos = caml_backtrace_pos;
  caml_backtrace_active = 0;
  at_exit = caml_named_value("Pervasives.do_at_exit");
  if (at_exit != NULL) caml_callback_exn(*at_exit, Val_unit);
  caml_backtrace_active = saved_backtrace_active;
  caml_backtrace_pos = saved_backtrace_pos;
  /* Display the uncaught exception */
  fprintf(stderr, "Fatal error: exception %s\n", msg);
  free(msg);
  /* Display the backtrace if available */
  if (caml_backtrace_active
#ifndef NATIVE_CODE
      && !caml_debugger_in_use
#endif
      ) {
    caml_print_exception_backtrace();
  }
  /* Terminate the process */
  exit(2);
}