CAMLextern char *caml_heap_start;
CAMLextern char *caml_heap_end;
CAMLextern page_table_entry *caml_page_table;
CAMLextern char *caml_heap_start;
CAMLextern char *caml_heap_end;
CAMLextern page_table_entry *caml_page_table;
// Temporary solution: 'ulimit -s unlimited'. This function should
// be replaced with something iterative.
static size_t
// Temporary solution: 'ulimit -s unlimited'. This function should
// be replaced with something iterative.
static size_t
-mark (value obj, area *ptr, area *restore, area *fixups)
+_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));
// XXX This assertion might fail if someone tries to mark an object
// which is already ancient.
assert (Is_young (obj) || Is_in_heap (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)));
// 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)));
- size_t field_offset = mark (field, ptr, restore, fixups);
+ size_t field_offset = _mark (field, ptr, restore, fixups);
if (field_offset == -1) return -1; // Propagate out of memory errors.
// Since the recursive call to mark above can reallocate the
if (field_offset == -1) return -1; // Propagate out of memory errors.
// Since the recursive call to mark above can reallocate the
// Don't store absolute pointers yet because realloc will
// move the memory around. Store a fake pointer instead.
// Don't store absolute pointers yet because realloc will
// move the memory around. Store a fake pointer instead.
Field (obj_copy, i) = field_offset + sizeof (header_t);
size_t fixup = (void *)&Field(obj_copy, i) - ptr->ptr;
Field (obj_copy, i) = field_offset + sizeof (header_t);
size_t fixup = (void *)&Field(obj_copy, i) - ptr->ptr;
void *(*realloc)(void *data, void *ptr, size_t size),
void (*free)(void *data, void *ptr),
void *data)
void *(*realloc)(void *data, void *ptr, size_t size),
void (*free)(void *data, void *ptr),
void *data)
- if (mark (obj, &ptr, &restore, &fixups) == -1) {
+ if (_mark (obj, &ptr, &restore, &fixups) == -1) {
// Ran out of memory. Recover and throw an exception.
area_free (&fixups);
do_restore (&ptr, &restore);
// Ran out of memory. Recover and throw an exception.
area_free (&fixups);
do_restore (&ptr, &restore);
- void *ptr = do_mark (obj, my_realloc, my_free, 0);
+ void *ptr = mark (obj, my_realloc, my_free, 0);
-ancient_attach (value fdv)
+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)
if (old_obj != 0) mfree (md, old_obj);
mmalloc_setkey (md, key, 0);
if (old_obj != 0) mfree (md, old_obj);
mmalloc_setkey (md, key, 0);
- void *ptr = do_mark (obj, mrealloc, mfree, md);
+ void *ptr = mark (obj, mrealloc, mfree, md);