src/common_stub.hpp

   1 #ifndef COMMON_STUB_HPP_
   2 #define COMMON_STUB_HPP_
   3
   4 extern "C" {
   5 #define CAML_NAME_SPACE
   6
   7 #include <caml/mlvalues.h>
   8 #include <caml/alloc.h>
   9 #include <caml/memory.h>
  10 #include <caml/callback.h>
  11 #include <caml/fail.h>
  12 #include <caml/custom.h>
  13 #include <caml/bigarray.h>
  14 }
  15 #include <typeinfo>
  16 #include <cstdio>
  17 #include <cassert>
  18
  19 #define NoAlloc
  20
  21 //Must be used in front of every function that is called from OCaml.
  22 #if _M_IX86 || __i386
  23 #define ML_BINDING extern "C" __attribute__ ((force_align_arg_pointer))
  24 #else
  25 #define ML_BINDING extern "C"
  26 #endif
  27
  28
  29 void register_custom_(char* name,
  30                       size_t size,
  31                       void (*finalize)(value v));
  32
  33 value alloc_custom_(char* name);
  34
  35 template <class X> X& Obj_val(value v)
  36 {
  37   assert(Tag_val(v) == Custom_tag);
  38   return * (X*) Data_custom_val(v);
  39 }
  40
  41 template <class X> void sxsi_finalize_obj(X) {
  42 }
  43
  44 template <class X> void sxsi_finalize_obj(X* x){
  45   delete x;
  46 }
  47
  48 template <class X> void sxsi_finalize_custom(value v)
  49 {
  50   sxsi_finalize_obj(Obj_val<X>(v));
  51 }
  52
  53 template <class X> value
  54 sxsi_alloc_custom(void (*finalize)(value) = sxsi_finalize_custom<X>)
  55 {
  56   char * name = const_cast<char*>(typeid(X).name());
  57
  58   value v = alloc_custom_(name);
  59   if (v == Val_unit) {
  60     register_custom_(name, sizeof(X), finalize);
  61     v = alloc_custom_(name);
  62   };
  63   return v;
  64 }
  65
  66 void sxsi_raise_msg(const char * msg);
  67
  68 ML_BINDING value sxsi_cpp_init(value unit);
  69
  70
  71 #endif