From 8c3aa2796959837e89a86d0076cdec89a46d9bb6 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= <kn@lri.fr>
Date: Wed, 14 Mar 2012 13:45:17 +0100
Subject: [PATCH] Add a C implementation of leading_bit and clz to optimize
 Patricia tree library.

---
 src/OCamlDriver.cpp |  9 +++++++++
 src/ptset.ml        | 22 ++++++++++++----------
 2 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/src/OCamlDriver.cpp b/src/OCamlDriver.cpp
index 4a31dad..6b4e773 100644
--- a/src/OCamlDriver.cpp
+++ b/src/OCamlDriver.cpp
@@ -45,6 +45,15 @@ extern "C" {
 }
 
 
+extern "C" value caml_clz(value i)
+{
+  return Val_long( ((sizeof(unsigned long)*8) - __builtin_clzl(Long_val(i))) - 1);
+}
+
+extern "C" value caml_leading_bit(value i)
+{
+  return Val_long( ( 1 << (sizeof(unsigned long)*8 - __builtin_clzl(Long_val(i)) - 1)));
+}
 
 /** XMLTreeBuilder bindings
  *
diff --git a/src/ptset.ml b/src/ptset.ml
index fc1f592..bb58049 100644
--- a/src/ptset.ml
+++ b/src/ptset.ml
@@ -153,7 +153,8 @@ struct
 
   let hbit = Array.init 256 naive_highest_bit
 
-
+  external clz : int -> int = "caml_clz" "noalloc"
+  external leading_bit : int -> int = "caml_leading_bit" "noalloc"
   let highest_bit x =
     try
       let n = (x) lsr 24 in
@@ -168,14 +169,15 @@ struct
     let n = x lsr 32 in if n != 0 then highest_bit n lsl 32
       else highest_bit x
 
-  let branching_bit p0 p1 = highest_bit64 (p0 lxor p1)
+  let branching_bit p0 p1 = leading_bit (p0 lxor p1)
 
   let join p0 t0 p1 t1 =
     let m = branching_bit p0 p1  in
+    let msk = mask p0 m in
       if zero_bit p0 m then
-	branch (mask p0 m) m t0 t1
+	branch_ne msk m t0 t1
       else
-	branch (mask p0 m) m t1 t0
+	branch_ne msk m t1 t0
 
   let match_prefix k p m = (mask k m) == p
 
@@ -188,9 +190,9 @@ struct
       | Branch (p,m,t0,t1)  ->
 	  if match_prefix kid p m then
 	    if zero_bit kid m then
-	      branch p m (ins t0) t1
+	      branch_ne p m (ins t0) t1
 	    else
-	      branch p m t0 (ins t1)
+	      branch_ne p m t0 (ins t1)
 	  else
 	    join kid (leaf k)  p n
     in
@@ -232,14 +234,14 @@ struct
 	    branch p  m  (merge s0 t0) (merge s1 t1)
 	  else if m > n && match_prefix q p m then
 	    if zero_bit q m then
-	      branch p m (merge s0 t) s1
+	      branch_ne p m (merge s0 t) s1
             else
-	      branch p m s0 (merge s1 t)
+	      branch_ne p m s0 (merge s1 t)
 	  else if m < n && match_prefix p q n then
 	    if zero_bit p n then
-	      branch q n (merge s t0) t1
+	      branch_ne q n (merge s t0) t1
 	    else
-	      branch q n t0 (merge s t1)
+	      branch_ne q n t0 (merge s t1)
 	  else
 	    (* The prefixes disagree. *)
 	    join p s q t
-- 
2.17.1