X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=ancient_c.c;h=d5b11af7bcecb7316da087d55cec1b1116b1921a;hb=b082c2b2bd7990ed0cfaa07f18aae9597c5a6892;hp=ea2ca558f285997e243324f84e8d7db9a6a0145f;hpb=719c696df6e88ec0fd23084fb10b80ad997285f2;p=ocaml-ancient.git

diff --git a/ancient_c.c b/ancient_c.c
index ea2ca55..d5b11af 100644
--- a/ancient_c.c
+++ b/ancient_c.c
@@ -1,5 +1,4 @@
 /* Mark objects as 'ancient' so they are taken out of the OCaml heap.
- * $Id: ancient_c.c,v 1.10 2006-10-13 12:28:20 rich Exp $
  */
 
 #include <string.h>
@@ -13,10 +12,24 @@
 
 #include "mmalloc/mmalloc.h"
 
+// uintnat, intnat only appeared in Caml 3.09.x.
+#if OCAML_VERSION_MAJOR == 3 && OCAML_VERSION_MINOR < 9
+typedef unsigned long uintnat;
+typedef long intnat;
+#endif
+
+/* We need the macro 'Is_in_young_or_heap' which tell us if a block
+ * address is within the OCaml minor or major heaps.  This comes out
+ * of the guts of OCaml.
+ */
+
+#if OCAML_VERSION_MAJOR == 3 && OCAML_VERSION_MINOR <= 10
+// Up to OCaml 3.10 there was a single contiguous page table.
+
 // From byterun/misc.h:
 typedef char * addr;
 
-// From byterun/minor_gc.c:
+// From byterun/minor_gc.h:
 CAMLextern char *caml_young_start;
 CAMLextern char *caml_young_end;
 #define Is_young(val) \
@@ -41,6 +54,47 @@ CAMLextern page_table_entry *caml_page_table;
    (addr)(p) >= (addr)caml_heap_start && (addr)(p) < (addr)caml_heap_end \
    && caml_page_table [Page (p)])
 
+#define Is_in_heap_or_young(p) (Is_young (p) || Is_in_heap (p))
+
+#else /* OCaml >= 3.11 */
+
+// GC was rewritten in OCaml 3.11 so there is no longer a
+// single contiguous page table.
+
+// From byterun/memory.h:
+#define Not_in_heap 0
+#define In_heap 1
+#define In_young 2
+#define In_static_data 4
+#define In_code_area 8
+
+#ifdef ARCH_SIXTYFOUR
+
+/* 64 bits: Represent page table as a sparse hash table */
+int caml_page_table_lookup(void * addr);
+#define Classify_addr(a) (caml_page_table_lookup((void *)(a)))
+
+#else
+
+/* 32 bits: Represent page table as a 2-level array */
+#define Pagetable2_log 11
+#define Pagetable2_size (1 << Pagetable2_log)
+#define Pagetable1_log (Page_log + Pagetable2_log)
+#define Pagetable1_size (1 << (32 - Pagetable1_log))
+CAMLextern unsigned char * caml_page_table[Pagetable1_size];
+
+#define Pagetable_index1(a) (((uintnat)(a)) >> Pagetable1_log)
+#define Pagetable_index2(a) \
+  ((((uintnat)(a)) >> Page_log) & (Pagetable2_size - 1))
+#define Classify_addr(a) \
+  caml_page_table[Pagetable_index1(a)][Pagetable_index2(a)]
+
+#endif
+
+#define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young))
+
+#endif /* OCaml >= 3.11 */
+
 // Area is an expandable buffer, allocated on the C heap.
 typedef struct area {
   void *ptr;			// Start of area.
@@ -147,7 +201,7 @@ _mark (value obj, area *ptr, area *restore, area *fixups)
 {
   // XXX This assertion might fail if someone tries to mark an object
   // which is already ancient.
-  assert (Is_young (obj) || Is_in_heap (obj));
+  assert (Is_in_heap_or_young (obj));
 
   char *header = Hp_val (obj);
 
@@ -179,7 +233,7 @@ _mark (value obj, area *ptr, area *restore, area *fixups)
       value field = Field (obj, i);
 
       if (Is_block (field) &&
-	  (Is_young (field) || Is_in_heap (field))) {
+	  Is_in_heap_or_young (field)) {
 	size_t field_offset = _mark (field, ptr, restore, fixups);
 	if (field_offset == -1) return -1; // Propagate out of memory errors.
 
@@ -359,7 +413,7 @@ ancient_delete (value obj)
   if (Is_long (v)) caml_invalid_argument ("deleted");
 
   // Otherwise v is a pointer to the out of heap malloc'd object.
-  assert (!Is_young (v) && !Is_in_heap (v));
+  assert (!Is_in_heap_or_young (v));
   free ((void *) v);
 
   // Replace the proxy (a pointer) with an int 0 so we know it's
@@ -375,7 +429,7 @@ ancient_is_ancient (value obj)
   CAMLparam1 (obj);
   CAMLlocal1 (v);
 
-  v = Is_young (obj) || Is_in_heap (obj) ? Val_false : Val_true;
+  v = Is_in_heap_or_young (obj) ? Val_false : Val_true;
 
   CAMLreturn (v);
 }