From 719c696df6e88ec0fd23084fb10b80ad997285f2 Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Fri, 13 Oct 2006 12:28:20 +0000
Subject: [PATCH] Remove the limitation on the number of keys.

---
 README.txt          |  8 ++------
 ancient.ml          |  6 +++---
 ancient.mli         | 19 +++++++++---------
 ancient_c.c         | 58 ++++++++++++++++++++++++++++++++++++++++++++++-------
 mmalloc/mmprivate.h |  2 +-
 5 files changed, 66 insertions(+), 27 deletions(-)

diff --git a/README.txt b/README.txt
index 67bf422..42159e6 100644
--- a/README.txt
+++ b/README.txt
@@ -1,6 +1,6 @@
 'Ancient' module for OCaml
 ----------------------------------------------------------------------
-$Id: README.txt,v 1.2 2006-10-09 12:18:05 rich Exp $
+$Id: README.txt,v 1.3 2006-10-13 12:28:20 rich Exp $
 
 What does this module do?
 ----------------------------------------------------------------------
@@ -133,11 +133,7 @@ data to OCaml heap data.  In theory it should be possible to modify
 ancient data to point to other ancient data, but we have not tried
 this.
 
-(5) You can store more than just one compound object per backing file
-by supplying a key to Ancient.share and Ancient.get.  The keys are
-integers in the range [0..1023].  The upper limit is hard coded into
-the mmalloc library.  This hard coded upper limit is a bug which
-should be fixed.
+(5) [Limit on number of keys -- issue fixed]
 
 (6) [Advanced topic] The _mark function in ancient_c.c makes no
 attempt to arrange the data structures in memory / on disk in a way
diff --git a/ancient.ml b/ancient.ml
index 640e0d4..75c3039 100644
--- a/ancient.ml
+++ b/ancient.ml
@@ -1,5 +1,5 @@
 (* Mark objects as 'ancient' so they are taken out of the OCaml heap.
- * $Id: ancient.ml,v 1.6 2006-10-09 14:43:00 rich Exp $
+ * $Id: ancient.ml,v 1.7 2006-10-13 12:28:20 rich Exp $
  *)
 
 type 'a ancient
@@ -18,6 +18,8 @@ external delete : 'a ancient -> unit = "ancient_delete"
 
 external is_ancient : 'a -> bool = "ancient_is_ancient"
 
+external address_of : 'a -> nativeint = "ancient_address_of"
+
 type md
 
 external attach : Unix.file_descr -> nativeint -> md = "ancient_attach"
@@ -30,5 +32,3 @@ external share_info : md -> int -> 'a -> 'a ancient * info
 let share md key obj = fst (share_info md key obj)
 
 external get : md -> int -> 'a ancient = "ancient_get"
-
-let max_key = 1023 (* MMALLOC_KEYS-1.  See mmprivate.h *)
diff --git a/ancient.mli b/ancient.mli
index 37a1cb3..38a60fa 100644
--- a/ancient.mli
+++ b/ancient.mli
@@ -1,5 +1,5 @@
 (** Mark objects as 'ancient' so they are taken out of the OCaml heap.
-  * $Id: ancient.mli,v 1.7 2006-10-09 14:43:00 rich Exp $
+  * $Id: ancient.mli,v 1.8 2006-10-13 12:28:20 rich Exp $
   *)
 
 type 'a ancient
@@ -35,6 +35,11 @@ val is_ancient : 'a -> bool
     * heap.
     *)
 
+val address_of : 'a -> nativeint
+  (** [address_of obj] returns the address of [obj], or [0n] if [obj]
+    * is not a block.
+    *)
+
 (** {6 Shared memory mappings} *)
 
 type md
@@ -77,10 +82,8 @@ val share : md -> int -> 'a -> 'a ancient
     * other OCaml processes which can access the underlying
     * file.  See {!Ancient.attach}, {!Ancient.detach}.
     *
-    * More than one object can be stored in a file.  They are
-    * indexed using integers in the range [0..max_key] (the limit
-    * is hard-coded in [mmalloc/mmprivate.h]).  The [key] parameter
-    * controls which object is written/overwritten by [share].
+    * More than one object can be stored in a file.  The [key]
+    * parameter controls which object is written/overwritten by [share].
     * If you do not wish to use this feature, just pass [0]
     * as the key.
     *
@@ -101,9 +104,7 @@ val get : md -> int -> 'a ancient
   (** [get md key] returns the object indexed by [key] in the
     * attached file.
     *
-    * The key is in the range [0..max_key] (the limit is hard-coded in
-    * [mmalloc/mmprivate.h]).  If you do not wish to use this feature,
-    * just pass [0] as the key when sharing / getting.
+    * For details of the [key] parameter see {!Ancient.share}.
     *
     * You need to annotate the returned object with the correct
     * type.  As with the Marshal module, there is no type checking,
@@ -114,8 +115,6 @@ val get : md -> int -> 'a ancient
     * @raises [Not_found] if no object is associated with the key.
     *)
 
-val max_key : int
-
 (** {6 Additional information} *)
 
 type info = {
diff --git a/ancient_c.c b/ancient_c.c
index e00b008..ea2ca55 100644
--- a/ancient_c.c
+++ b/ancient_c.c
@@ -1,5 +1,5 @@
 /* Mark objects as 'ancient' so they are taken out of the OCaml heap.
- * $Id: ancient_c.c,v 1.9 2006-10-09 14:43:00 rich Exp $
+ * $Id: ancient_c.c,v 1.10 2006-10-13 12:28:20 rich Exp $
  */
 
 #include <string.h>
@@ -381,6 +381,18 @@ ancient_is_ancient (value obj)
 }
 
 CAMLprim value
+ancient_address_of (value obj)
+{
+  CAMLparam1 (obj);
+  CAMLlocal1 (v);
+
+  if (Is_block (obj)) v = caml_copy_nativeint ((intnat) obj);
+  else v = caml_copy_nativeint (0);
+
+  CAMLreturn (v);
+}
+
+CAMLprim value
 ancient_attach (value fdv, value baseaddrv)
 {
   CAMLparam2 (fdv, baseaddrv);
@@ -415,6 +427,11 @@ ancient_detach (value mdv)
   CAMLreturn (Val_unit);
 }
 
+struct keytable {
+  void **keys;
+  int allocated;
+};
+
 CAMLprim value
 ancient_share_info (value mdv, value keyv, value obj)
 {
@@ -424,15 +441,39 @@ ancient_share_info (value mdv, value keyv, value obj)
   void *md = (void *) Field (mdv, 0);
   int key = Int_val (keyv);
 
+  // Get the key table.
+  struct keytable *keytable = mmalloc_getkey (md, 0);
+  if (keytable == 0) {
+    keytable = mmalloc (md, sizeof (struct keytable));
+    if (keytable == 0) caml_failwith ("out of memory");
+    keytable->keys = 0;
+    keytable->allocated = 0;
+    mmalloc_setkey (md, 0, keytable);
+  }
+
   // Existing key exists?  Free it.
-  void *old_obj = mmalloc_getkey (md, key);
-  if (old_obj != 0) mfree (md, old_obj);
-  mmalloc_setkey (md, key, 0);
+  if (key < keytable->allocated && keytable->keys[key] != 0) {
+    mfree (md, keytable->keys[key]);
+    keytable->keys[key] = 0;
+  }
+
+  // Keytable large enough?  If not, realloc it.
+  if (key >= keytable->allocated) {
+    int allocated = keytable->allocated == 0 ? 32 : keytable->allocated * 2;
+    void **keys = mrealloc (md, keytable->keys, allocated * sizeof (void *));
+    if (keys == 0) caml_failwith ("out of memory");
+    int i;
+    for (i = keytable->allocated; i < allocated; ++i) keys[i] = 0;
+    keytable->keys = keys;
+    keytable->allocated = allocated;
+  }
 
+  // Do the mark.
   size_t size;
   void *ptr = mark (obj, mrealloc, mfree, md, &size);
 
-  mmalloc_setkey (md, key, ptr);
+  // Add the key to the keytable.
+  keytable->keys[key] = ptr;
 
   // Make the proxy.
   proxy = caml_alloc (1, Abstract_tag);
@@ -458,8 +499,11 @@ ancient_get (value mdv, value keyv)
   void *md = (void *) Field (mdv, 0);
   int key = Int_val (keyv);
 
-  void *ptr = mmalloc_getkey (md, key);
-  if (!ptr) caml_raise_not_found ();
+  // Key exists?
+  struct keytable *keytable = mmalloc_getkey (md, 0);
+  if (keytable == 0 || key >= keytable->allocated || keytable->keys[key] == 0)
+    caml_raise_not_found ();
+  void *ptr = keytable->keys[key];
 
   // Return the proxy.
   proxy = caml_alloc (1, Abstract_tag);
diff --git a/mmalloc/mmprivate.h b/mmalloc/mmprivate.h
index 6cf3ad5..4576262 100644
--- a/mmalloc/mmprivate.h
+++ b/mmalloc/mmprivate.h
@@ -43,7 +43,7 @@ Boston, MA 02111-1307, USA.
 #define MMALLOC_MAGIC		"mmalloc"	/* Mapped file magic number */
 #define MMALLOC_MAGIC_SIZE	8		/* Size of magic number buf */
 #define MMALLOC_VERSION		1		/* Current mmalloc version */
-#define MMALLOC_KEYS		1024		/* Keys for application use */
+#define MMALLOC_KEYS		16		/* Keys for application use */
 
 /* The allocator divides the heap into blocks of fixed size; large
    requests receive one or more whole blocks, and small requests
-- 
1.8.3.1