+
+CAMLprim value
+ancient_is_ancient (value obj)
+{
+ CAMLparam1 (obj);
+ CAMLlocal1 (v);
+
+ v = Is_in_heap_or_young (obj) ? Val_false : Val_true;
+
+ CAMLreturn (v);
+}
+
+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);
+ CAMLlocal1 (mdv);
+
+ int fd = Int_val (fdv);
+ void *baseaddr = (void *) Nativeint_val (baseaddrv);
+ void *md = mmalloc_attach (fd, baseaddr);
+ if (md == 0) {
+ perror ("mmalloc_attach");
+ caml_failwith ("mmalloc_attach");
+ }
+
+ mdv = caml_alloc (1, Abstract_tag);
+ Field (mdv, 0) = (value) md;
+
+ CAMLreturn (mdv);
+}
+
+CAMLprim value
+ancient_detach (value mdv)
+{
+ CAMLparam1 (mdv);
+
+ void *md = (void *) Field (mdv, 0);
+
+ if (mmalloc_detach (md) != 0) {
+ perror ("mmalloc_detach");
+ caml_failwith ("mmalloc_detach");
+ }
+
+ CAMLreturn (Val_unit);
+}
+
+struct keytable {
+ void **keys;
+ int allocated;
+};
+
+CAMLprim value
+ancient_share_info (value mdv, value keyv, value obj)
+{
+ CAMLparam3 (mdv, keyv, obj);
+ CAMLlocal3 (proxy, info, rv);
+
+ 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.
+ 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);
+
+ // Add the key to the keytable.
+ keytable->keys[key] = ptr;
+
+ // Make the proxy.
+ proxy = caml_alloc (1, Abstract_tag);
+ Field (proxy, 0) = (value) ptr;
+
+ // Make the info struct.
+ info = caml_alloc (1, 0);
+ Field (info, 0) = Val_long (size);
+
+ rv = caml_alloc (2, 0);
+ Field (rv, 0) = proxy;
+ Field (rv, 1) = info;
+
+ CAMLreturn (rv);
+}
+
+CAMLprim value
+ancient_get (value mdv, value keyv)
+{
+ CAMLparam2 (mdv, keyv);
+ CAMLlocal1 (proxy);
+
+ void *md = (void *) Field (mdv, 0);
+ int key = Int_val (keyv);
+
+ // 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);
+ Field (proxy, 0) = (value) ptr;
+
+ CAMLreturn (proxy);
+}