'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?
----------------------------------------------------------------------
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
(* 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
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"
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 *)
(** 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
* 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
* 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.
*
(** [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,
* @raises [Not_found] if no object is associated with the key.
*)
-val max_key : int
-
(** {6 Additional information} *)
type info = {
/* 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>
}
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);
CAMLreturn (Val_unit);
}
+struct keytable {
+ void **keys;
+ int allocated;
+};
+
CAMLprim value
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);
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);
#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
git.annexia.org / ocaml-ancient.git / commitdiff