From cbed4c9507473b8423977e7eba36d2fb47007674 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BA=BDn?= Date: Tue, 23 Oct 2012 15:45:36 +0200 Subject: [PATCH] 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). --- src/common_stub.cpp | 2 +- src/common_stub.hpp | 7 ++- src/xml-tree-builder_stub.cpp | 14 +++--- src/xml-tree_stub.cpp | 90 +++++++++++++++++------------------ 4 files changed, 59 insertions(+), 54 deletions(-) diff --git a/src/common_stub.cpp b/src/common_stub.cpp index 85be940..781d079 100644 --- 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 --- 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) 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 --- 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(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 --- 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(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 sort_results(std::vector 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 sort_results(std::vector 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); \ -- 2.17.1