From b4b703850fca0adaab90de6fb2fa03525bc55457 Mon Sep 17 00:00:00 2001 From: rich Date: Wed, 27 Sep 2006 16:01:47 +0000 Subject: [PATCH] Testing the shared functionality. --- .cvsignore | 5 +- .depend | 2 + MANIFEST | 1 + Makefile | 9 +++- ancient_c.c | 33 ++++++------- test_ancient_shared.ml | 122 +++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 153 insertions(+), 19 deletions(-) create mode 100644 test_ancient_shared.ml diff --git a/.cvsignore b/.cvsignore index d3c78b6..dd782b9 100644 --- a/.cvsignore +++ b/.cvsignore @@ -7,4 +7,7 @@ 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 diff --git a/.depend b/.depend index 47db211..7901315 100644 --- a/.depend +++ b/.depend @@ -2,5 +2,7 @@ ancient.cmo: ancient.cmi 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 diff --git a/MANIFEST b/MANIFEST index 2ae48c3..a5bbdbe 100644 --- a/MANIFEST +++ b/MANIFEST @@ -36,4 +36,5 @@ mmalloc/mvalloc.c mmalloc/sbrk-sup.c mmalloc/TODO test_ancient.ml +test_ancient_shared.ml test_ancient_weblogs.ml diff --git a/Makefile b/Makefile index f029f43..3619f01 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ # 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 @@ -24,7 +24,8 @@ OCAMLOPTPACKAGES := $(OCAMLCPACKAGES) 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 @@ -42,6 +43,10 @@ test_ancient.opt: ancient.cmxa test_ancient.cmx 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 \ diff --git a/ancient_c.c b/ancient_c.c index fb69881..eb4908e 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.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 @@ -259,15 +259,12 @@ do_fixups (area *ptr, area *fixups) } } -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. @@ -294,11 +291,7 @@ do_mark (value obj, 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 * @@ -319,7 +312,11 @@ ancient_mark (value obj) 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); } @@ -363,18 +360,22 @@ ancient_share (value fdv, value obj) 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); } @@ -385,7 +386,7 @@ ancient_attach (value fdv) 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"); @@ -405,7 +406,7 @@ ancient_detach (value obj) 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); diff --git a/test_ancient_shared.ml b/test_ancient_shared.ml new file mode 100644 index 0000000..7be9712 --- /dev/null +++ b/test_ancient_shared.ml @@ -0,0 +1,122 @@ +(* 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" + + -- 1.8.3.1