X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FOCamlDriver.cpp;h=4a31dad386e8b507824bd290ff2fdaf31ac3d88a;hb=feae5b72d47e0ae245145d401ba73804ce18fc8c;hp=146a0dfbc878bf9ff5458736ca250c6fad411ddc;hpb=be15ae2e9a7f0a1d7dade338529c2f9f207990bb;p=SXSI%2Fxpathcomp.git diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp index 146a0df..4a31dad 100644 --- a/src/OCamlDriver.cpp +++ b/src/OCamlDriver.cpp @@ -20,7 +20,6 @@ #include "XMLTree.h" #include "XMLTreeBuilder.h" -#include "Grammar.h" #include "Utils.h" #include "common_stub.hpp" @@ -32,8 +31,6 @@ #define XMLTREEBUILDER(x) (Obj_val(x)) -#define GRAMMAR(x) (Obj_val(x)) - #define TREENODEVAL(i) ((treeNode) (Int_val(i))) #define TAGVAL(i) ((TagType) (Int_val(i))) @@ -44,6 +41,7 @@ extern "C" { #include #include #include +#include } @@ -160,7 +158,7 @@ extern "C" value caml_xml_tree_load(value fd, value name, value load_tc,value s XMLTree * tree; try { - tree = XMLTree::Load(Int_val(fd),Bool_val(load_tc),Int_val(sf), String_val(name)); + tree = XMLTree::Load(Int_val(fd), Bool_val(load_tc), Int_val(sf), String_val(name)); result = sxsi_alloc_custom(); Obj_val(result) = tree; CAMLreturn(result); @@ -896,162 +894,6 @@ BV_QUERY(contains, Contains) BV_QUERY(lessthan, LessThan) - -//////////////////////////////////////////// Grammar stuff - -extern "C" value caml_grammar_load(value file, value load_bp) -{ - CAMLparam2(file, load_bp); - CAMLlocal1(result); - Grammar *grammar; - int f1 = Int_val(file); - int f2 = dup(f1); - FILE * fd = fdopen(f2, "r"); - if (fd == NULL) - CAMLRAISEMSG("Error opening grammar file"); - grammar = Grammar::load(fd, Bool_val(load_bp)); - fclose(fd); - result = sxsi_alloc_custom(); - Obj_val(result) = grammar; - CAMLreturn(result); -} - -extern "C" value caml_grammar_get_symbol_at(value grammar, value symbol, value preorder) -{ - CAMLparam3(grammar, symbol, preorder); - CAMLreturn(Val_long(GRAMMAR(grammar)->getSymbolAt(Long_val(symbol), Int_val(preorder)))); -} - -extern "C" value caml_grammar_first_child(value grammar, value rule, value pos) -{ - CAMLparam1(grammar); - CAMLreturn(Val_int(GRAMMAR(grammar)->firstChild(Long_val(rule), Int_val(pos)))); -} - -extern "C" value caml_grammar_next_sibling(value grammar, value rule, value pos) -{ - CAMLparam1(grammar); - CAMLreturn(Val_int(GRAMMAR(grammar)->nextSibling(Long_val(rule), Int_val(pos)))); -} - -extern "C" value caml_grammar_start_first_child(value grammar, value pos) -{ - CAMLparam1(grammar); - CAMLreturn(Val_int(GRAMMAR(grammar)->startFirstChild(Int_val(pos)))); -} - -extern "C" value caml_grammar_start_next_sibling(value grammar, value pos) -{ - CAMLparam1(grammar); - CAMLreturn(Val_int(GRAMMAR(grammar)->startNextSibling(Int_val(pos)))); -} - -extern "C" value caml_grammar_is_nil(value grammar, value rule) -{ - CAMLparam1(grammar); - CAMLreturn(Val_bool(GRAMMAR(grammar)->isNil(Long_val(rule)))); -} - -extern "C" value caml_grammar_get_tag(value grammar, value tag) -{ - CAMLparam1(grammar); - CAMLlocal1(res); - const char * s = (GRAMMAR(grammar)->getTagName(Long_val(tag))).c_str(); - res = caml_copy_string(s); - CAMLreturn(res); -} - -extern "C" value caml_grammar_get_id1(value grammar, value rule) -{ - CAMLparam1(grammar); - CAMLreturn(Val_long(GRAMMAR(grammar)->getID1(Long_val(rule)))); -} - -extern "C" value caml_grammar_get_id2(value grammar, value rule) -{ - CAMLparam1(grammar); - CAMLreturn(Val_long(GRAMMAR(grammar)->getID2(Long_val(rule)))); -} - -extern "C" value caml_grammar_get_param_pos(value grammar, value rule) -{ - CAMLparam1(grammar); - CAMLreturn(Val_int(GRAMMAR(grammar)->getParamPos(Long_val(rule)))); -} - -extern "C" value caml_grammar_translate_tag(value grammar, value tag) -{ - CAMLparam1(grammar); - CAMLreturn(Val_int(GRAMMAR(grammar)->translateTag(Int_val(tag)))); -} - -extern "C" value caml_grammar_register_tag(value grammar, value str) -{ - CAMLparam2(grammar, str); - char * s = String_val(str); - CAMLreturn(Val_int(GRAMMAR(grammar)->getTagID(s))); -} - -extern "C" value caml_grammar_nil_id(value grammar) -{ - CAMLparam1(grammar); - CAMLreturn(Val_long((GRAMMAR(grammar)->getNiltagid()) * 4 + 1)); -} - -extern "C" { -extern char *caml_young_end; -extern char *caml_young_start; -typedef char * addr; -#define Is_young(val) \ - ((addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start) - -} -extern "C" value caml_custom_is_young(value a){ - return Val_bool(Is_young(a)); -} - -extern "C" value caml_custom_array_blit(value a1, value ofs1, value a2, value ofs2, - value n) -{ - value * src, * dst; - intnat count; - - if (Is_young(a2)) { - /* Arrays of values, destination is in young generation. - Here too we can do a direct copy since this cannot create - old-to-young pointers, nor mess up with the incremental major GC. - Again, memmove takes care of overlap. */ - memmove(&Field(a2, Long_val(ofs2)), - &Field(a1, Long_val(ofs1)), - Long_val(n) * sizeof(value)); - return Val_unit; - } - /* Array of values, destination is in old generation. - We must use caml_modify. */ - count = Long_val(n); - if (a1 == a2 && Long_val(ofs1) < Long_val(ofs2)) { - /* Copy in descending order */ - for (dst = &Field(a2, Long_val(ofs2) + count - 1), - src = &Field(a1, Long_val(ofs1) + count - 1); - count > 0; - count--, src--, dst--) { - caml_modify(dst, *src); - } - } else { - /* Copy in ascending order */ - for (dst = &Field(a2, Long_val(ofs2)), src = &Field(a1, Long_val(ofs1)); - count > 0; - count--, src++, dst++) { - caml_modify(dst, *src); - } - } - /* Many caml_modify in a row can create a lot of old-to-young refs. - Give the minor GC a chance to run if it needs to. */ - //caml_check_urgent_gc(Val_unit); - return Val_unit; -} - - ////////////////////// BP extern "C" value caml_bitmap_create(value size) @@ -1070,7 +912,6 @@ extern "C" value caml_bitmap_resize(value bitmap, value nsize) CAMLparam2(bitmap, nsize); size_t bits = Long_val(nsize); size_t bytes = (bits / (8 * sizeof(unsigned int)) + 1 ) * sizeof(unsigned int); - fprintf(stderr, "Growing to: %lu bytes\n", (bits / (8 * sizeof(unsigned int)) + 1 ) * sizeof(unsigned int)); unsigned int * buffer = (unsigned int*) realloc((void *) bitmap, bytes); if (buffer == NULL) CAMLRAISEMSG("BP: cannot reallocate memory"); @@ -1148,7 +989,6 @@ extern "C" value caml_bp_save(value b, value file) int f1 = Int_val(file); int f2 = dup(f1); FILE * fd = fdopen(f2, "a"); - fprintf(stderr, "Writing %i %p bytes\n", ((B->n+D-1)/D)*8, B ); fflush(stderr); if (fd == NULL) CAMLRAISEMSG("Error saving bp file"); @@ -1157,3 +997,8 @@ extern "C" value caml_bp_save(value b, value file) CAMLreturn(Val_unit); } +extern "C" value caml_bp_alloc_stats(value unit) +{ + CAMLparam1(unit); + CAMLreturn (Val_long(bp_get_alloc_stats())); +}