X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FOCamlDriver.cpp;h=7cf70c5a57f8908e1d7dc709d9fae52cd9504e4e;hb=960e4daabcffa00ab73a9b0edb7366f16df284ba;hp=0f15f493d6b854b110bfef3c22e23b44e0c659cd;hpb=7b50894295e91036042de481e02edb71842a6e7a;p=SXSI%2Fxpathcomp.git

diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp
index 0f15f49..7cf70c5 100644
--- a/src/OCamlDriver.cpp
+++ b/src/OCamlDriver.cpp
@@ -920,7 +920,6 @@ extern "C" value caml_grammar_get_symbol_at(value grammar, value symbol, value p
 {
   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)
@@ -935,17 +934,229 @@ extern "C" value caml_grammar_next_sibling(value grammar, value rule, value pos)
   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 symbol)
+extern "C" value caml_grammar_get_tag(value grammar, value tag)
 {
   CAMLparam1(grammar);
   CAMLlocal1(res);
-  const char * s = (GRAMMAR(grammar)->getTagName(Long_val(symbol) >> 2)).c_str();
+  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)
+{
+  CAMLparam1(size);
+  size_t bits = Long_val(size);
+  size_t words = bits / (8*sizeof(unsigned int));
+  unsigned int *buffer = (unsigned int*) calloc(words+1, sizeof(unsigned int));
+  if (buffer == NULL)
+    CAMLRAISEMSG("BP: cannot allocate memory");
+  CAMLreturn( (value) buffer);
+}
+
+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);
+  unsigned int * buffer = (unsigned int*) realloc((void *) bitmap, bytes);
+  if (buffer == NULL)
+    CAMLRAISEMSG("BP: cannot reallocate memory");
+  CAMLreturn((value) buffer);
+}
+
+extern "C" value caml_bitmap_setbit(value bitmap, value i, value b)
+{
+  CAMLparam3(bitmap, i, b);
+  unsigned int j = Int_val(i);
+  unsigned int x = Bool_val(b);
+  bp_setbit ((unsigned int*) bitmap, j, x);
+  CAMLreturn(Val_unit);
+}
+
+extern "C" void caml_bp_delete(value b)
+{
+  CAMLparam1(b);
+  bp * B = Obj_val<bp*>(b);
+  bp_delete(B);
+  CAMLreturn0;
+}
+
+extern "C" value caml_bp_construct(value bitmap, value npar)
+{
+  CAMLparam2(bitmap, npar);
+  CAMLlocal1(res);
+  bp * b = bp_construct(Int_val(npar), (unsigned int *) bitmap, OPT_DEGREE);
+  res = sxsi_alloc_custom<bp*>(caml_bp_delete);
+  Obj_val<bp*>(res) = b;
+  CAMLreturn(res);
+}
+
+extern "C" value caml_bp_first_child(value b, value idx)
+{
+  CAMLparam2(b, idx);
+  CAMLreturn (Val_int( bp_first_child(Obj_val<bp*>(b), Int_val(idx))));
+}
+
+
+extern "C" value caml_bp_next_sibling(value b, value idx)
+{
+  CAMLparam2(b, idx);
+  CAMLreturn (Val_int(bp_next_sibling(Obj_val<bp*>(b), Int_val(idx))));
+}
+
+extern "C" value caml_bp_preorder_rank(value b, value idx)
+{
+  CAMLparam2(b, idx);
+  CAMLreturn (Val_int(bp_preorder_rank(Obj_val<bp*>(b), Int_val(idx)) - 1));
+}
+
+
+extern "C" value caml_bp_load(value file)
+{
+  CAMLparam1(file);
+  CAMLlocal1(result);
+  bp *B;
+  int f1 = Int_val(file);
+  int f2 = dup(f1);
+  FILE * fd = fdopen(f2, "r");
+  if (fd == NULL)
+    CAMLRAISEMSG("Error opening bp file");
+  B = loadTree(fd);
+  fclose(fd);
+  result = sxsi_alloc_custom<bp*>(caml_bp_delete);
+  Obj_val<bp*>(result) = B;
+  CAMLreturn(result);
+}
+
+extern "C" value caml_bp_save(value b, value file)
+{
+  CAMLparam2(b, file);
+  bp *B = Obj_val<bp*>(b);
+  int f1 = Int_val(file);
+  int f2 = dup(f1);
+  FILE * fd = fdopen(f2, "a");
+  fflush(stderr);
+  if (fd == NULL)
+    CAMLRAISEMSG("Error saving bp file");
+  saveTree(B, fd);
+  fclose(fd);
+  CAMLreturn(Val_unit);
+}
+
+extern "C" value caml_bp_alloc_stats(value unit)
+{
+  CAMLparam1(unit);
+  CAMLreturn (Val_long(bp_get_alloc_stats()));
+}