Fix a subtle bug where OCaml/C function stack are not aligned on a 16 byte

boundary. This causes problem when calling optimized C code (in e.g. libcds)
where g++ assumed that all stacks are alligned on a 16 byte boundary (to use
instructions such as movaps freely).

diff --git a/src/common_stub.cpp b/src/common_stub.cpp
index 85be940..781d079 100644 (file)
--- a/src/common_stub.cpp
+++ b/src/common_stub.cpp
@@ -71,7 +71,7 @@ value alloc_custom_(char* name)
 }
 
 
-extern "C" value sxsi_cpp_init(value unit)
+ML_BINDING value sxsi_cpp_init(value unit)
 {
   struct rlimit rlim;
   init_exception();

diff --git a/src/common_stub.hpp b/src/common_stub.hpp
index 45aa0ca..b771f33 100644 (file)
--- a/src/common_stub.hpp
+++ b/src/common_stub.hpp
@@ -18,6 +18,10 @@ extern "C" {
 
 #define NoAlloc
 
+//Must be used in front of every function that is called from OCaml.
+
+#define ML_BINDING extern "C" __attribute__ ((force_align_arg_pointer)) 
+
 
 void register_custom_(char* name,
                      size_t size,
@@ -58,8 +62,7 @@ sxsi_alloc_custom(void (*finalize)(value) = sxsi_finalize_custom<X>)
 
 void sxsi_raise_msg(const char * msg);
 
-extern "C" value sxsi_cpp_init(value unit);
-
+ML_BINDING value sxsi_cpp_init(value unit);
 
 
 #endif

diff --git a/src/xml-tree-builder_stub.cpp b/src/xml-tree-builder_stub.cpp
index 6fc1c60..89442da 100644 (file)
--- a/src/xml-tree-builder_stub.cpp
+++ b/src/xml-tree-builder_stub.cpp
@@ -8,7 +8,7 @@ static xml_tree_builder*& OBJ_VAL(value v)
   return Obj_val<xml_tree_builder*>(v);
 }
 
-extern "C" value caml_xml_tree_builder_create(value unit)
+ML_BINDING value caml_xml_tree_builder_create(value unit)
 {
   CAMLparam1(unit);
   CAMLlocal1(result);
@@ -18,7 +18,7 @@ extern "C" value caml_xml_tree_builder_create(value unit)
   CAMLreturn(result);
 }
 
-extern "C" value caml_xml_tree_builder_open_document(value vbuilder,
+ML_BINDING value caml_xml_tree_builder_open_document(value vbuilder,
                                                      value vsrate,
                                                      value vdtc,
                                                      value vidxtype)
@@ -47,7 +47,9 @@ extern "C" value caml_xml_tree_builder_open_document(value vbuilder,
   CAMLreturn (Val_unit);
 }
 
-extern "C" value caml_xml_tree_builder_close_document(value vbuilder)
+
+ML_BINDING value caml_xml_tree_builder_close_document(value vbuilder)
+
 {
   CAMLparam1(vbuilder);
   CAMLlocal1(result);
@@ -59,7 +61,7 @@ extern "C" value caml_xml_tree_builder_close_document(value vbuilder)
   CAMLreturn (result);
 }
 
-extern "C" value caml_xml_tree_builder_open_tag(value vbuilder, value vtag)
+ML_BINDING value caml_xml_tree_builder_open_tag(value vbuilder, value vtag)
 {
   CAMLparam2(vbuilder, vtag);
   const char * tag = String_val(vtag);
@@ -67,7 +69,7 @@ extern "C" value caml_xml_tree_builder_open_tag(value vbuilder, value vtag)
   CAMLreturn (Val_unit);
 }
 
-extern "C" value caml_xml_tree_builder_close_tag(value vbuilder, value vtag)
+ML_BINDING value caml_xml_tree_builder_close_tag(value vbuilder, value vtag)
 {
   CAMLparam2(vbuilder, vtag);
   const char * tag = String_val(vtag);
@@ -75,7 +77,7 @@ extern "C" value caml_xml_tree_builder_close_tag(value vbuilder, value vtag)
   CAMLreturn (Val_unit);
 }
 
-extern "C" value caml_xml_tree_builder_text(value vbuilder, value vtext)
+ML_BINDING value caml_xml_tree_builder_text(value vbuilder, value vtext)
 {
   CAMLparam2(vbuilder, vtext);
   const char * text = String_val(vtext);

diff --git a/src/xml-tree_stub.cpp b/src/xml-tree_stub.cpp
index 1d52a9d..5dbdf36 100644 (file)
--- a/src/xml-tree_stub.cpp
+++ b/src/xml-tree_stub.cpp
@@ -19,14 +19,14 @@ static xml_tree::tag_t TAG(value i)
   return static_cast<xml_tree::tag_t>(Int_val(i));
 }
 
-extern "C"  value caml_xml_tree_save(value tree, value fd, value prefix)
+ML_BINDING  value caml_xml_tree_save(value tree, value fd, value prefix)
 {
   CAMLparam3(tree, fd, prefix);
   XMLTREE(tree)->save(Int_val(fd), String_val(prefix));
   CAMLreturn (Val_unit);
 }
 
-extern "C" value
+ML_BINDING value
 caml_xml_tree_load(value fd, value prefix, value load_tc, value sf)
 {
   CAMLparam4(fd, prefix, load_tc, sf);
@@ -50,188 +50,188 @@ caml_xml_tree_load(value fd, value prefix, value load_tc, value sf)
   return (Val_unit);
 }
 
-NoAlloc extern "C"  value caml_xml_tree_root(value tree)
+NoAlloc ML_BINDING  value caml_xml_tree_root(value tree)
 {
   return (Val_int(XMLTREE(tree)->root()));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_size(value tree)
+NoAlloc ML_BINDING  value caml_xml_tree_size(value tree)
 {
   return (Val_int(XMLTREE(tree)->size()));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_num_tags(value tree)
+NoAlloc ML_BINDING  value caml_xml_tree_num_tags(value tree)
 {
   return (Val_int(XMLTREE(tree)->num_tags()));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_subtree_size(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_subtree_size(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->subtree_size(TREENODE(node))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_subtree_tags(value tree, value node, value tag)
 {
   return (Val_int(XMLTREE(tree)->subtree_tags(TREENODE(node),
                                               TAG(tag))));
 }
 
-NoAlloc extern "C" value caml_xml_tree_subtree_elements(value tree,
+NoAlloc ML_BINDING value caml_xml_tree_subtree_elements(value tree,
                                                         value node)
 {
   return (Val_int(XMLTREE(tree)->subtree_elements(TREENODE(node))));
 }
 
-NoAlloc extern "C" value caml_xml_tree_is_leaf(value tree, value node){
+NoAlloc ML_BINDING value caml_xml_tree_is_leaf(value tree, value node){
   return (Val_bool(XMLTREE(tree)->is_leaf(TREENODE(node))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_is_ancestor(value tree, value node1, value node2)
 {
   return (Val_bool(XMLTREE(tree)->is_ancestor(TREENODE(node1),
                                               TREENODE(node2))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_is_child(value tree, value node1, value node2)
 {
   return (Val_bool(XMLTREE(tree)->is_child(TREENODE(node1),
                                            TREENODE(node2))));
 }
 
-NoAlloc extern "C" value caml_xml_tree_is_first_child(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_is_first_child(value tree, value node)
 {
   return (Val_bool(XMLTREE(tree)->is_first_child(TREENODE(node))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_is_right_descendant(value tree, value x, value y)
 {
   return (Val_bool(XMLTREE(tree)->is_right_descendant(TREENODE(x),
                                                       TREENODE(y))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_num_children(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_num_children(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->num_children(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_child_pos(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_child_pos(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->child_pos(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_depth(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_depth(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->depth(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_preorder(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_preorder(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->preorder(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_postorder(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_postorder(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->postorder(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_tag(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_tag(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->tag(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_parent(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_parent(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->parent(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_child(value tree, value node, value idx)
+NoAlloc ML_BINDING  value caml_xml_tree_child(value tree, value node, value idx)
 {
   return (Val_int(XMLTREE(tree)->child(TREENODE(node), Int_val(idx))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_first_child(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_first_child(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->first_child(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_first_element(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_first_element(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->first_element(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_last_child(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_last_child(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->last_child(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_next_sibling(value tree, value node)
+NoAlloc ML_BINDING  value caml_xml_tree_next_sibling(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->next_sibling(TREENODE(node))));
 }
 
-NoAlloc extern "C" value caml_xml_tree_next_element(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_next_element(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->next_element(TREENODE(node))));
 }
 
-NoAlloc extern "C" value caml_xml_tree_prev_sibling(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_prev_sibling(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->prev_sibling(TREENODE(node))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_tagged_child(value tree, value node, value tag)
 {
   return (Val_int(XMLTREE(tree)->tagged_child(TREENODE(node),
                                               TAG(tag))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_select_child(value tree, value node, value tags)
 {
   return (Val_int(XMLTREE(tree)->select_child(TREENODE(node), TAGLIST(tags))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_tagged_sibling(value tree, value node, value tag)
 {
   return (Val_int(XMLTREE(tree)->tagged_sibling(TREENODE(node),
                                                 TAG(tag))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_select_sibling(value tree, value node, value tags)
 {
   return (Val_int(XMLTREE(tree)->select_sibling(TREENODE(node),
                                                 TAGLIST(tags))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_tagged_descendant(value tree, value node, value tag)
 {
   return (Val_int(XMLTREE(tree)->tagged_descendant(TREENODE(node),
                                                    TAG(tag))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_tagged_next(value tree, value node, value tag)
 {
   return (Val_int(XMLTREE(tree)->tagged_next(TREENODE(node),
                                              TAG(tag))));
 }
 
-NoAlloc extern "C" value
+NoAlloc ML_BINDING value
 caml_xml_tree_select_descendant(value tree, value node, value tags)
 {
   return (Val_int(XMLTREE(tree)->select_descendant(TREENODE(node),
                                                    TAGLIST(tags))));
 }
 
-NoAlloc extern "C" value caml_xml_tree_tagged_following_before(value tree,
+NoAlloc ML_BINDING value caml_xml_tree_tagged_following_before(value tree,
                                                                value node,
                                                                value tag,
                                                                value closing)
@@ -241,7 +241,7 @@ NoAlloc extern "C" value caml_xml_tree_tagged_following_before(value tree,
                                                          TREENODE(closing))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_select_following_before(value tree,
+NoAlloc ML_BINDING  value caml_xml_tree_select_following_before(value tree,
                                                                 value node,
                                                                 value tags,
                                                                 value closing)
@@ -253,7 +253,7 @@ NoAlloc extern "C"  value caml_xml_tree_select_following_before(value tree,
 
 
 
-extern "C" value caml_xml_tree_get_text_collection(value tree)
+ML_BINDING value caml_xml_tree_get_text_collection(value tree)
 {
   CAMLparam1(tree);
   CAMLlocal1(text);
@@ -262,17 +262,17 @@ extern "C" value caml_xml_tree_get_text_collection(value tree)
   CAMLreturn (text);
 }
 
-NoAlloc extern "C" value caml_xml_tree_closing(value tree, value node)
+NoAlloc ML_BINDING value caml_xml_tree_closing(value tree, value node)
 {
   return (Val_int(XMLTREE(tree)->closing(TREENODE(node))));
 }
 
-NoAlloc extern "C"  value caml_xml_tree_nullt(value unit){
+NoAlloc ML_BINDING  value caml_xml_tree_nullt(value unit){
   return (Val_int(xml_tree::NIL));
 }
 
 
-extern "C" value caml_xml_tree_print(value tree, value node, value fd)
+ML_BINDING value caml_xml_tree_print(value tree, value node, value fd)
 {
   CAMLparam3(tree, node, fd);
   XMLTREE(tree)->print(TREENODE(node), Int_val(fd));
@@ -280,7 +280,7 @@ extern "C" value caml_xml_tree_print(value tree, value node, value fd)
 }
 
 
-extern "C" value caml_xml_tree_get_tag_name(value tree, value tag)
+ML_BINDING value caml_xml_tree_get_tag_name(value tree, value tag)
 {
   CAMLparam2(tree, tag);
   CAMLlocal1(res);
@@ -289,13 +289,13 @@ extern "C" value caml_xml_tree_get_tag_name(value tree, value tag)
   CAMLreturn(res);
 }
 
-NoAlloc extern "C" value caml_xml_tree_flush(value tree, value fd)
+NoAlloc ML_BINDING value caml_xml_tree_flush(value tree, value fd)
 {
   XMLTREE(tree)->flush(Int_val(fd));
   return Val_unit;
 }
 
-extern "C" value caml_xml_tree_register_tag(value tree, value str)
+ML_BINDING value caml_xml_tree_register_tag(value tree, value str)
 {
   CAMLparam2(tree, str);
   value res;
@@ -329,7 +329,7 @@ static std::vector<int32_t> sort_results(std::vector<int32_t> v, xml_tree *t)
 }
 
 #define BV_QUERY(pref, Pref) \
-  extern "C" value caml_text_collection_## pref ##_bv(value tree, value str, value dobvv){ \
+  ML_BINDING value caml_text_collection_## pref ##_bv(value tree, value str, value dobvv){ \
     CAMLparam3(tree, str, dobvv);                                      \
     CAMLlocal3(res, res_bv, res_array);                                        \
     int j;                                                             \
@@ -349,7 +349,7 @@ static std::vector<int32_t> sort_results(std::vector<int32_t> v, xml_tree *t)
       };                                                               \
       caml_initialize(&Field(res_array, i), Val_int(j));               \
     };                                                                 \
-    fprintf(stderr, "Raw results: %lu, Sorted reulsts %lu\n", uresults.size(), results.size()); \
+    fprintf(stderr, "Raw results: %zu, Sorted results %zu\n", uresults.size(), results.size()); \
     free(cstr);                                                                \
     res = caml_alloc(2, 0);                                            \
     Store_field(res, 0, res_bv);                                       \