/* Mark objects as 'ancient' so they are taken out of the OCaml heap.
- * $Id: ancient_c.c,v 1.6 2006-09-28 12:40:07 rich Exp $
+ * $Id: ancient_c.c,v 1.7 2006-10-06 12:25:20 rich Exp $
*/
#include <string.h>
CAMLextern char *caml_heap_start;
CAMLextern char *caml_heap_end;
CAMLextern page_table_entry *caml_page_table;
-extern asize_t caml_page_low, caml_page_high;
#define In_heap 1
#define Not_in_heap 0
// 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)
{
char *header = Hp_val (obj);
assert (Wosize_hp (header) > 0); // Always true? (XXX)
if (Is_block (field) &&
(Is_young (field) || Is_in_heap (field))) {
- 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
// Don't store absolute pointers yet because realloc will
// move the memory around. Store a fake pointer instead.
- // We'll fix up these fake pointers afterwards.
+ // We'll fix up these fake pointers afterwards in do_fixups.
Field (obj_copy, i) = field_offset + sizeof (header_t);
size_t fixup = (void *)&Field(obj_copy, i) - ptr->ptr;
}
static void *
-do_mark (value obj,
+mark (value obj,
void *(*realloc)(void *data, void *ptr, size_t size),
void (*free)(void *data, void *ptr),
void *data)
area fixups; // List of fake pointers to be fixed up.
area_init (&fixups);
- 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);
CAMLparam1 (obj);
CAMLlocal1 (proxy);
- void *ptr = do_mark (obj, my_realloc, my_free, 0);
+ void *ptr = mark (obj, my_realloc, my_free, 0);
// Return the proxy.
proxy = caml_alloc (1, Abstract_tag);
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);
mmalloc_setkey (md, key, ptr);
(* Load in large weblogs and see if they can still be used.
- * $Id: test_ancient_weblogs.ml,v 1.3 2006-09-28 12:40:07 rich Exp $
+ * $Id: test_ancient_weblogs.ml,v 1.4 2006-10-06 12:25:20 rich Exp $
*)
open Printf
files
+(*
(* XXX Linux/AMD64-specific hack to avoid bad mmap(2) allocation. *)
let baseaddr = Nativeint.of_string "0x440000000000"
gc_compact ()
) files;
+ Ancient.detach md
+*)
-
+let () =
+ let fd = Unix.openfile "test_ancient_weblogs.data" [Unix.O_RDWR] 0o644 in
+ let md = Ancient.attach fd 0n in
+
+ eprintf "Flattening ...\n%!";
+
+ (* Concatenate all the logs together. *)
+ let rows =
+ List.flatten (
+ List.mapi (
+ fun key _ ->
+ let rows : Weblogs.t Ancient.ancient = Ancient.get md key in
+ let rows = Ancient.follow rows in
+ rows
+ ) files
+ ) in
+
+ eprintf "After flattening: %!";
+ gc_compact ();
+
+ (* Detect visitors. Save to key 1023 in the file. The detect_visitors
+ * function sorts each visitor.
+ *)
+ let visitors = Weblogs.detect_visitors rows in
+ ignore (Ancient.share md 1023 visitors);
+
+ eprintf "After detecting visitors: %!";
+ gc_compact ();
Ancient.detach md