test_ancient.out1
test_ancient.out2
META
-ancient-*.tar.gz
\ No newline at end of file
+ancient-*.tar.gz
+test_ancient_shared.data
+test_ancient_shared.out1
+test_ancient_shared.out2
\ No newline at end of file
ancient.cmx: ancient.cmi
test_ancient.cmo: ancient.cmi
test_ancient.cmx: ancient.cmx
+test_ancient_shared.cmo: ancient.cmi
+test_ancient_shared.cmx: ancient.cmx
test_ancient_weblogs.cmo: ancient.cmi
test_ancient_weblogs.cmx: ancient.cmx
mmalloc/sbrk-sup.c
mmalloc/TODO
test_ancient.ml
+test_ancient_shared.ml
test_ancient_weblogs.ml
# Mark objects as 'ancient' so they are taken out of the OCaml heap.
-# $Id: Makefile,v 1.5 2006-09-27 15:36:18 rich Exp $
+# $Id: Makefile,v 1.6 2006-09-27 16:01:47 rich Exp $
include Makefile.config
OCAMLOPTLIBS := -linkpkg weblogs.cmxa
endif
-TARGETS := mmalloc ancient.cma ancient.cmxa META test_ancient.opt
+TARGETS := mmalloc ancient.cma ancient.cmxa META \
+ test_ancient.opt test_ancient_shared.opt
ifeq ($(TEST_WEBLOGS),1)
TARGETS += test_ancient_weblogs.opt
LIBRARY_PATH=.:$$LIBRARY_PATH \
ocamlfind ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $(OCAMLOPTLIBS) -o $@ $^
+test_ancient_shared.opt: ancient.cmxa test_ancient_shared.cmx
+ LIBRARY_PATH=.:$$LIBRARY_PATH \
+ ocamlfind ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $(OCAMLOPTLIBS) -o $@ $^
+
ifeq ($(TEST_WEBLOGS),1)
test_ancient_weblogs.opt: ancient.cmxa test_ancient_weblogs.cmx
LIBRARY_PATH=.:$$LIBRARY_PATH \
/* Mark objects as 'ancient' so they are taken out of the OCaml heap.
- * $Id: ancient_c.c,v 1.3 2006-09-27 15:36:18 rich Exp $
+ * $Id: ancient_c.c,v 1.4 2006-09-27 16:01:47 rich Exp $
*/
#include <string.h>
}
}
-static CAMLprim value
+static void *
do_mark (value obj,
void *(*realloc)(void *data, void *ptr, size_t size),
void (*free)(void *data, void *ptr),
void *data)
{
- CAMLparam1 (obj);
- CAMLlocal1 (proxy);
-
area ptr; // This will be the out of heap area.
area_init_custom (&ptr, realloc, free, data);
area restore; // Headers to be fixed up after.
do_fixups (&ptr, &fixups);
area_free (&fixups);
- // Replace obj with a proxy.
- proxy = caml_alloc (1, Abstract_tag);
- Field (proxy, 0) = (value) ptr.ptr;
-
- CAMLreturn (proxy);
+ return ptr.ptr;
}
static void *
CAMLparam1 (obj);
CAMLlocal1 (proxy);
- proxy = do_mark (obj, my_realloc, my_free, 0);
+ void *ptr = do_mark (obj, my_realloc, my_free, 0);
+
+ // Replace obj with a proxy.
+ proxy = caml_alloc (1, Abstract_tag);
+ Field (proxy, 0) = (value) ptr;
CAMLreturn (proxy);
}
CAMLparam2 (fdv, obj);
CAMLlocal1 (proxy);
- int fd = Int_val (fd);
+ int fd = Int_val (fdv);
void *md = mmalloc_attach (fd, 0);
if (md == 0) {
perror ("mmalloc_attach");
caml_failwith ("mmalloc_attach");
}
- proxy = do_mark (obj, mrealloc, mfree, md);
+ void *ptr = do_mark (obj, mrealloc, mfree, md);
// Save the address of the object within the mmalloc area. We need
// it when attaching.
- mmalloc_setkey (md, 0, (void *) Field (proxy, 0));
+ mmalloc_setkey (md, 0, ptr);
+
+ proxy = caml_alloc (2, Abstract_tag);
+ Field (proxy, 0) = (value) ptr;
+ Field (proxy, 1) = (value) md;
CAMLreturn (proxy);
}
CAMLparam1 (fdv);
CAMLlocal1 (proxy);
- int fd = Int_val (fd);
+ int fd = Int_val (fdv);
void *md = mmalloc_attach (fd, 0);
if (md == 0) {
perror ("mmalloc_attach");
CAMLparam1 (obj);
CAMLlocal1 (v);
- int size = Wosize_val (obj);
+ mlsize_t size = Wosize_val (obj);
if (size < 2) caml_failwith ("Ancient.detach: not an attached object");
v = Field (obj, 0);
--- /dev/null
+(* Very basic tests of Ancient module shared functionality.
+ * $Id: test_ancient_shared.ml,v 1.1 2006-09-27 16:01:47 rich Exp $
+ *)
+
+open Printf
+
+type item = {
+ name : string;
+ dob : string;
+ address : string;
+ phone : string option;
+ marital_status : marital_status;
+ id : int;
+}
+and marital_status = Single | Married | Divorced
+
+let gc_compact () =
+ eprintf "compacting ... %!";
+ Gc.compact ();
+ let stat = Gc.stat () in
+ let live_words = stat.Gc.live_words in
+ eprintf "live words = %d (%d MB)\n%!"
+ live_words (live_words * 8 / 1024 / 1024)
+
+let random_string () =
+ let n = 1 + Random.int 20 in
+ let str = String.create n in
+ for i = 0 to n-1 do
+ let c = 97 + Random.int 26 in
+ let c = Char.chr c in
+ str.[i] <- c
+ done;
+ str
+
+let random_string_option () =
+ if Random.int 3 = 1 then None else Some (random_string ())
+
+let random_marital_status () =
+ match Random.int 3 with
+ | 0 -> Single
+ | 1 -> Married
+ | _ -> Divorced
+
+let rec output_data chan data =
+ let n = Array.length data in
+ for i = 0 to n-1; do
+ output_item chan data.(i)
+ done
+
+and output_item chan item =
+ fprintf chan "id = %d\n%!" item.id;
+ fprintf chan "\tname = %s\n%!" item.name;
+ fprintf chan "\tdob = %s\n%!" item.dob;
+ fprintf chan "\taddress = %s\n%!" item.address;
+ fprintf chan "\tphone = %s\n%!"
+ (match item.phone with
+ | None -> "None"
+ | Some str -> "Some " ^ str);
+ fprintf chan "\tmarital_status = %s\n%!"
+ (string_of_marital_status item.marital_status)
+
+and string_of_marital_status status =
+ match status with
+ | Single -> "Single"
+ | Married -> "Married"
+ | Divorced -> "Divorced"
+
+let () =
+ match List.tl (Array.to_list Sys.argv) with
+ | ["read"; share_filename; print_filename] ->
+ (* Read data in filename and print. *)
+ let fd = Unix.openfile share_filename [Unix.O_RDWR] 0 in
+ let data : item array Ancient.ancient = Ancient.attach fd in
+
+ eprintf "After attaching %s ...\n" share_filename;
+ gc_compact ();
+
+ let chan = open_out print_filename in
+ output_data chan (Ancient.follow data);
+ close_out chan;
+
+ Ancient.detach data;
+ eprintf "After detaching ...\n";
+ gc_compact ()
+
+ | ["write"; share_filename; print_filename] ->
+ (* Generate random data and write to filename, also print it. *)
+ eprintf "Before allocating data on OCaml heap ...\n";
+ gc_compact ();
+ let data =
+ Array.init 100000 (
+ fun id ->
+ { id = id;
+ name = random_string ();
+ dob = random_string ();
+ address = random_string ();
+ phone = random_string_option ();
+ marital_status = random_marital_status () }
+ ) in
+ eprintf "After allocating data on OCaml heap ...\n";
+ gc_compact ();
+
+ let chan = open_out print_filename in
+ output_data chan data;
+ close_out chan;
+
+ let fd =
+ Unix.openfile share_filename
+ [Unix.O_CREAT;Unix.O_TRUNC;Unix.O_RDWR] 0o644 in
+
+ let data = Ancient.share fd data in
+ eprintf "After sharing data to %s ...\n" share_filename;
+ gc_compact ();
+
+ Ancient.detach data;
+ eprintf "After detaching ...\n";
+ gc_compact ()
+
+ | _ ->
+ failwith "test_ancient_shared"
+
+
git.annexia.org / ocaml-ancient.git / commitdiff