X-Git-Url: http://git.annexia.org/?p=ocaml-ancient.git;a=blobdiff_plain;f=ancient_c.c;h=95383be8e7033401ac70a97bfacbe2204c27bf9a;hp=52886c9091ad0c872f1bec037a50b0415bbe943e;hb=2f2d5af5cf03640650c8b49933c36665fdf52d61;hpb=690b40de4026658d385caf2cdbfa13837a1e679e

diff --git a/ancient_c.c b/ancient_c.c
index 52886c9..95383be 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.7 2006-10-06 12:25:20 rich Exp $
+ * $Id: ancient_c.c,v 1.8 2006-10-09 12:18:05 rich Exp $
  */
 
 #include <string.h>
@@ -145,18 +145,22 @@ static header_t visited = (unsigned long) -1;
 static size_t
 _mark (value obj, area *ptr, area *restore, area *fixups)
 {
-  char *header = Hp_val (obj);
-  assert (Wosize_hp (header) > 0); // Always true? (XXX)
-
   // XXX This assertion might fail if someone tries to mark an object
   // which is already ancient.
   assert (Is_young (obj) || Is_in_heap (obj));
 
+  char *header = Hp_val (obj);
+
   // If we've already visited this object, just return its offset
   // in the out-of-heap memory.
   if (memcmp (header, &visited, sizeof visited) == 0)
     return (Long_val (Field (obj, 0)));
 
+  // XXX Actually this fails if you try to persist a zero-length
+  // array.  Needs to be fixed, but it breaks some rather important
+  // functions below.
+  assert (Wosize_hp (header) > 0);
+
   // Offset where we will store this object in the out-of-heap memory.
   size_t offset = ptr->n;
 
@@ -354,6 +358,17 @@ ancient_delete (value obj)
 }
 
 CAMLprim value
+ancient_is_ancient (value obj)
+{
+  CAMLparam1 (obj);
+  CAMLlocal1 (v);
+
+  v = Is_young (obj) || Is_in_heap (obj) ? Val_false : Val_true;
+
+  CAMLreturn (v);
+}
+
+CAMLprim value
 ancient_attach (value fdv, value baseaddrv)
 {
   CAMLparam2 (fdv, baseaddrv);