Release notes and some test programs.
authorrich <rich>
Fri, 6 Oct 2006 15:03:47 +0000 (15:03 +0000)
committerrich <rich>
Fri, 6 Oct 2006 15:03:47 +0000 (15:03 +0000)
.cvsignore
.depend
Makefile
README.txt [new file with mode: 0644]
ancient.mli
test_ancient.ml [deleted file]
test_ancient_dict_read.ml [new file with mode: 0644]
test_ancient_dict_verify.ml [new file with mode: 0644]
test_ancient_dict_write.ml [new file with mode: 0644]
test_ancient_shared.ml [deleted file]

index 3d83ddb..9e75e4a 100644 (file)
@@ -4,11 +4,6 @@
 *.cma
 *.cmxa
 *.opt
 *.cma
 *.cmxa
 *.opt
-test_ancient.out1
-test_ancient.out2
 META
 ancient-*.tar.gz
 META
 ancient-*.tar.gz
-test_ancient_shared.data
-test_ancient_shared.out1
-test_ancient_shared.out2
-test_ancient_weblogs.data
\ No newline at end of file
+dictionary.data
diff --git a/.depend b/.depend
index 054af52..c46008f 100644 (file)
--- a/.depend
+++ b/.depend
@@ -1,6 +1,8 @@
 ancient.cmo: ancient.cmi 
 ancient.cmx: ancient.cmi 
 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_dict_read.cmo: ancient.cmi 
+test_ancient_dict_read.cmx: ancient.cmx 
+test_ancient_dict_verify.cmo: ancient.cmi 
+test_ancient_dict_verify.cmx: ancient.cmx 
+test_ancient_dict_write.cmo: ancient.cmi 
+test_ancient_dict_write.cmx: ancient.cmx 
index 538aee3..e51ff2f 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,5 +1,5 @@
 # Mark objects as 'ancient' so they are taken out of the OCaml heap.
 # Mark objects as 'ancient' so they are taken out of the OCaml heap.
-# $Id: Makefile,v 1.7 2006-10-06 12:26:31 rich Exp $
+# $Id: Makefile,v 1.8 2006-10-06 15:03:47 rich Exp $
 
 include Makefile.config
 
 
 include Makefile.config
 
@@ -7,17 +7,19 @@ CC    := gcc
 CFLAGS := -g -fPIC -Wall -Werror
 
 OCAMLCFLAGS    := -g
 CFLAGS := -g -fPIC -Wall -Werror
 
 OCAMLCFLAGS    := -g
-OCAMLCPACKAGES := 
-OCAMLCLIBS     := 
+OCAMLCPACKAGES := -package unix
+OCAMLCLIBS     := -linkpkg
 
 OCAMLOPTFLAGS  :=
 OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
 
 OCAMLOPTFLAGS  :=
 OCAMLOPTPACKAGES := $(OCAMLCPACKAGES)
-OCAMLOPTLIBS   := 
+OCAMLOPTLIBS   := -linkpkg
 
 OCAMLDOCFLAGS := -html -stars -sort $(OCAMLCPACKAGES)
 
 TARGETS                := mmalloc ancient.cma ancient.cmxa META \
 
 OCAMLDOCFLAGS := -html -stars -sort $(OCAMLCPACKAGES)
 
 TARGETS                := mmalloc ancient.cma ancient.cmxa META \
-                  test_ancient.opt test_ancient_shared.opt
+                  test_ancient_dict_write.opt \
+                  test_ancient_dict_verify.opt \
+                  test_ancient_dict_read.opt
 
 all:   $(TARGETS)
 
 
 all:   $(TARGETS)
 
@@ -27,11 +29,15 @@ ancient.cma: ancient.cmo ancient_c.o
 ancient.cmxa: ancient.cmx ancient_c.o
        ocamlmklib -o ancient -Lmmalloc -lmmalloc $^
 
 ancient.cmxa: ancient.cmx ancient_c.o
        ocamlmklib -o ancient -Lmmalloc -lmmalloc $^
 
-test_ancient.opt: ancient.cmxa test_ancient.cmx
+test_ancient_dict_write.opt: ancient.cmxa test_ancient_dict_write.cmx
        LIBRARY_PATH=.:$$LIBRARY_PATH \
        ocamlfind ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $(OCAMLOPTLIBS) -o $@ $^
 
        LIBRARY_PATH=.:$$LIBRARY_PATH \
        ocamlfind ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $(OCAMLOPTLIBS) -o $@ $^
 
-test_ancient_shared.opt: ancient.cmxa test_ancient_shared.cmx
+test_ancient_dict_verify.opt: ancient.cmxa test_ancient_dict_verify.cmx
+       LIBRARY_PATH=.:$$LIBRARY_PATH \
+       ocamlfind ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $(OCAMLOPTLIBS) -o $@ $^
+
+test_ancient_dict_read.opt: ancient.cmxa test_ancient_dict_read.cmx
        LIBRARY_PATH=.:$$LIBRARY_PATH \
        ocamlfind ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $(OCAMLOPTLIBS) -o $@ $^
 
        LIBRARY_PATH=.:$$LIBRARY_PATH \
        ocamlfind ocamlopt $(OCAMLOPTFLAGS) $(OCAMLOPTPACKAGES) $(OCAMLOPTLIBS) -o $@ $^
 
diff --git a/README.txt b/README.txt
new file mode 100644 (file)
index 0000000..d0abe58
--- /dev/null
@@ -0,0 +1,216 @@
+'Ancient' module for OCaml
+----------------------------------------------------------------------
+$Id: README.txt,v 1.1 2006-10-06 15:03:47 rich Exp $
+
+What does this module do?
+----------------------------------------------------------------------
+
+This module allows you to use in-memory data structures which are
+larger than available memory and so are kept in swap.  If you try this
+in normal OCaml code, you'll find that the machine quickly descends
+into thrashing as the garbage collector repeatedly iterates over
+swapped memory structures.  This module lets you break that
+limitation.  Of course the module doesn't work by magic :-) If your
+program tries to access these large structures, they still need to be
+swapped back in, but it is suitable for large, sparsely accessed
+structures.
+
+Secondly, this module allows you to share those structures between
+processes.  In this mode, the structures are backed by a disk file,
+and any process that has read/write access that disk file can map that
+file in and see the structures.
+
+To understand what this module really does, you need to know a little
+bit of background about the OCaml garbage collector (GC).  OCaml's GC
+has two heaps, called the minor and major heaps.  The minor heap is
+used for short-term storage of small objects which are usually created
+and then quickly become unreachable.  Any objects which persist longer
+(or objects which are very big to start with) get moved into the major
+heap.  Objects in the major heap are assumed to be around for some
+time, and the major heap is GC'd more slowly.
+
+This module adds a third heap, called the "ancient heap", which is
+never checked by the GC.  Objects must be moved into ancient manually,
+using a process called "marking".  Once an object is in the ancient
+heap, memory allocation is handled manually.  In particular objects in
+the ancient heap may need to be manually deallocated.  The ancient
+heap may either exist as ordinary memory, or may be backed by a file,
+which is how shared structures are possible.
+
+Structures which are moved into ancient must be treated as STRICTLY
+NON-MUTABLE.  If an ancient structure is changed in any way then it
+may cause a crash.
+
+There are some limitations which apply to ancient data structures.
+See the section "Shortcomings & bugs" below.
+
+This module is most useful on 64 bit architectures where large address
+spaces are the norm.  We have successfully used it with a 38 GB
+address space backed by a file and shared between processes.
+
+API
+----------------------------------------------------------------------
+
+Please see file ancient.mli .
+
+Compiling
+----------------------------------------------------------------------
+
+  cd mmalloc && ./configure
+  make
+
+Make sure you run this command before running any program which
+uses the Ancient module:
+
+  ulimit -s unlimited
+
+Example
+----------------------------------------------------------------------
+
+Run:
+
+  ulimit -s unlimited
+  wordsfile=/usr/share/dict/words
+  baseaddr=0x440000000000               # System specific - see below.
+  ./test_ancient_dict_write.opt $wordsfile dictionary.data $baseaddr
+  ./test_ancient_dict_verify.opt $wordsfile dictionary.data
+  ./test_ancient_dict_read.opt dictionary.data
+
+(You can run several instances of test_ancient_dict_read.opt on the
+same machine to demonstrate sharing).
+
+Shortcomings & bugs
+----------------------------------------------------------------------
+
+(0) Stack overflows are common when marking/sharing large structures
+because we use a recursive algorithm to visit the structures.  If you
+get random segfaults during marking/sharing, then try this before
+running your program:
+
+  ulimit -s unlimited
+
+(1) Ad-hoc polymorphic primitives (structural equality, marshalling
+and hashing) do not work on ancient data structures, meaning that you
+will need to provide your own comparison and hashing functions.  For
+more details see Xavier Leroy's response here:
+
+http://caml.inria.fr/pub/ml-archives/caml-list/2006/09/977818689f4ceb2178c592453df7a343.en.html
+
+(2) Ancient.attach suggests setting a baseaddr parameter for newly
+created files (it has no effect when attaching existing files).  We
+strongly recommend this because in our tests we found that mmap would
+locate the memory segment inappropriately -- the basic problem is that
+because the file starts off with zero length, mmap thinks it can place
+it anywhere in memory and often does not leave it room to grow upwards
+without overwriting later memory mappings.  Unfortunately this
+introduces an unwanted architecture dependency in all programs which
+use the Ancient module with shared files, and it also requires
+programmers to guess at a good base address which will be valid in the
+future.  There are no other good solutions we have found --
+preallocating the file is tricky with the current mmalloc code.
+
+(3) The current code requires you to first of all create the large
+data structures on the regular OCaml heap, then mark them as ancient,
+effectively copying them out of the OCaml heap, then garbage collect
+the (hopefully unreferenced) structures on the OCaml heap.  In other
+words, you need to have all the memory available as physical memory.
+The way to avoid this is to mark structures as ancient incrementally
+as they are created, or in chunks, whatever works for you.
+
+We typically use Ancient to deal with web server logfiles, and in this
+case loading one file of data into memory and marking it as ancient
+before moving on to the next file works for us.
+
+(4) Why do ancient structures need to be read-only / not mutated?  The
+reason is that you might create a new OCaml heap structure and point
+the ancient structure at this heap structure.  The heap structure has
+no apparent incoming pointers (the GC will not by its very nature
+check the ancient structure for pointers), and so the heap structure
+gets garbage collected.  At this point the ancient structure has a
+dangling pointer, which will usually result in some form of crash.
+Note that the restriction here is on creating pointers from ancient
+data to OCaml heap data.  In theory it should be possible to modify
+ancient data to point to other ancient data, but we have not tried
+this.
+
+(5) You can store more than just one compound object per backing file
+by supplying a key to Ancient.share and Ancient.get.  The keys are
+integers in the range [0..1023].  The upper limit is hard coded into
+the mmalloc library.  This hard coded upper limit is a bug which
+should be fixed.
+
+(6) [Advanced topic] The _mark function in ancient_c.c makes no
+attempt to arrange the data structures in memory / on disk in a way
+which optimises them for access.  The worst example is when you have
+an array of large structures, where only a few fields in the structure
+will be accessed.  Typically these will end up on disk as:
+
+  array of N pointers
+  structure 1
+  field A
+  field B
+    ...
+  field Z
+  structure 2
+  field A
+  field B
+    ...
+  field Z
+  structure 3
+  field A
+  field B
+    ...
+  field Z
+   ...
+   ...
+   ...
+  structure N
+  field A
+  field B
+    ...
+  field Z
+
+If you then iterate accessing only fields A, you end up swapping the
+whole lot back into memory.  A better arrangement would have been:
+
+  array of N pointers
+  structure 1
+  structure 2
+  structure 3
+    ...
+  structure N
+  field A from structure 1
+  field A from structure 2
+  field A from structure 3
+    ...
+  field A from structure N
+  field B from structure 1
+  field B from structure 2
+    etc.
+
+which avoids loading unused fields at all.  In some circumstances we
+have shown that this could make a huge difference to performance, but
+we are not sure how to implement this cleanly in the current library.
+
+Authors
+----------------------------------------------------------------------
+
+Primary code was written by Richard W.M. Jones <rich at annexia.org>
+with help from Markus Mottl, Martin Jambon, and invaluable advice from
+Xavier Leroy and Damien Doligez.
+
+mmalloc was written by Mike Haertel and Fred Fish.
+
+License
+----------------------------------------------------------------------
+
+The module is licensed under the LGPL + OCaml linking exception.  This
+module includes mmalloc which was originally distributed with gdb
+(although it has since been removed), and that code was distributed
+under the plain LGPL.
+
+Latest version
+----------------------------------------------------------------------
+
+The latest version can be found on the website:
+http://merjis.com/developers/ancient
index 191447e..6bf689f 100644 (file)
@@ -1,5 +1,5 @@
 (** Mark objects as 'ancient' so they are taken out of the OCaml heap.
 (** Mark objects as 'ancient' so they are taken out of the OCaml heap.
-  * $Id: ancient.mli,v 1.4 2006-09-28 12:40:07 rich Exp $
+  * $Id: ancient.mli,v 1.5 2006-10-06 15:03:47 rich Exp $
   *)
 
 type 'a ancient
   *)
 
 type 'a ancient
@@ -103,7 +103,8 @@ val get : md -> int -> 'a ancient
     * You need to annotate the returned object with the correct
     * type.  As with the Marshal module, there is no type checking,
     * and setting the wrong type will likely cause a segfault
     * You need to annotate the returned object with the correct
     * type.  As with the Marshal module, there is no type checking,
     * and setting the wrong type will likely cause a segfault
-    * or undefined behaviour.
+    * or undefined behaviour.  Note that the returned object has
+    * type [sometype ancient], not just [sometype].
     *
     * @raises [Not_found] if no object is associated with the key.
     *)
     *
     * @raises [Not_found] if no object is associated with the key.
     *)
diff --git a/test_ancient.ml b/test_ancient.ml
deleted file mode 100644 (file)
index 7d68961..0000000
+++ /dev/null
@@ -1,100 +0,0 @@
-(* Very basic tests of Ancient module.
- * $Id: test_ancient.ml,v 1.1 2006-09-27 12:07:07 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 () =
-  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 "test_ancient.out1" in
-  output_data chan data;
-  close_out chan;
-
-  let data = Ancient.mark data in
-  eprintf "After marking data as ancient ...\n";
-  gc_compact ();
-
-  let data = Ancient.follow data in
-  eprintf "Number of elements in array = %d\n" (Array.length data);
-
-  let chan = open_out "test_ancient.out2" in
-  output_data chan data;
-  close_out chan;
-
-  eprintf "After writing out ancient data ...\n";
-  gc_compact ()
diff --git a/test_ancient_dict_read.ml b/test_ancient_dict_read.ml
new file mode 100644 (file)
index 0000000..7269a1f
--- /dev/null
@@ -0,0 +1,67 @@
+(* Read shared dictionary.
+ * $Id: test_ancient_dict_read.ml,v 1.1 2006-10-06 15:03:47 rich Exp $
+ *)
+
+open Printf
+open Unix
+
+let argv = Array.to_list Sys.argv
+
+let datafile =
+  match argv with
+  | [_; datafile] ->
+      datafile
+  | _ ->
+      failwith (sprintf "usage: %s datafile"
+                 Sys.executable_name)
+
+let md =
+  let fd = openfile datafile [O_RDWR] 0o644 in
+  Ancient.attach fd 0n
+
+let arraysize = 256 (* one element for each character *)
+
+type t = Not_Found | Exists of t array | Not_Exists of t array;;
+let tree : t array Ancient.ancient = Ancient.get md 0
+let tree = Ancient.follow tree
+
+let word_exists word =
+  try
+    let tree = ref tree in
+    let len = String.length word in
+    for i = 0 to len-2; do
+      let c = word.[i] in
+      let c = Char.code c in
+      match (!tree).(c) with
+      | Not_Found -> raise Not_found
+      | Exists tree'
+      | Not_Exists tree' -> tree := tree'
+    done;
+
+    (* Final character. *)
+    let c = word.[len-1] in
+    let c = Char.code c in
+    match (!tree).(c) with
+    | Not_Found
+    | Not_Exists _ -> false
+    | Exists _ -> true
+  with
+    Not_found -> false
+
+let () =
+  let rec loop () =
+    printf "Enter a word to check (q = quit program): ";
+    let word = read_line () in
+    if word <> "q" then (
+      printf "'%s' exists? %B\n%!" word (word_exists word);
+      loop ()
+    )
+  in
+  loop ();
+
+  Ancient.detach md;
+
+  (* Garbage collect - good way to check we haven't broken anything. *)
+  Gc.compact ();
+
+  printf "Program finished.\n"
diff --git a/test_ancient_dict_verify.ml b/test_ancient_dict_verify.ml
new file mode 100644 (file)
index 0000000..1e534d5
--- /dev/null
@@ -0,0 +1,100 @@
+(* Verify shared dictionary.
+ * $Id: test_ancient_dict_verify.ml,v 1.1 2006-10-06 15:03:47 rich Exp $
+ *)
+
+open Printf
+open Unix
+
+let argv = Array.to_list Sys.argv
+
+let wordsfile, datafile =
+  match argv with
+  | [_; wordsfile; datafile] ->
+      wordsfile, datafile
+  | _ ->
+      failwith (sprintf "usage: %s wordsfile datafile"
+                 Sys.executable_name)
+
+let md =
+  let fd = openfile datafile [O_RDWR] 0o644 in
+  Ancient.attach fd 0n
+
+let arraysize = 256 (* one element for each character *)
+
+type t = Not_Found | Exists of t array | Not_Exists of t array;;
+let tree : t array Ancient.ancient = Ancient.get md 0
+let tree = Ancient.follow tree
+
+let word_exists word =
+  try
+    let tree = ref tree in
+    let len = String.length word in
+    for i = 0 to len-2; do
+      let c = word.[i] in
+      let c = Char.code c in
+      match (!tree).(c) with
+      | Not_Found -> raise Not_found
+      | Exists tree'
+      | Not_Exists tree' -> tree := tree'
+    done;
+
+    (* Final character. *)
+    let c = word.[len-1] in
+    let c = Char.code c in
+    match (!tree).(c) with
+    | Not_Found
+    | Not_Exists _ -> false
+    | Exists _ -> true
+  with
+    Not_found -> false
+
+let () =
+  (* Read in the words and keep in a local list. *)
+  let words = ref [] in
+  let chan = open_in wordsfile in
+  let rec loop () =
+    let word = input_line chan in
+    if word <> "" then words := word :: !words;
+    loop ()
+  in
+  (try loop () with End_of_file -> ());
+  close_in chan;
+  let words = List.rev !words in
+
+  (* Verify that the number of words in the tree is the same as the
+   * number of words in the words file.
+   *)
+  let nr_expected = List.length words in
+  let nr_actual =
+    let rec count tree =
+      let c = ref 0 in
+      for i = 0 to arraysize-1 do
+       match tree.(i) with
+       | Not_Found -> ()
+       | Exists tree ->
+           c := !c + 1 + count tree
+       | Not_Exists tree ->
+           c := !c + count tree
+      done;
+      !c
+    in
+    count tree in
+
+  if nr_expected <> nr_actual then
+    failwith (sprintf
+               "verify failed: expected %d words but counted %d in tree"
+               nr_expected nr_actual);
+
+  (* Check each word exists in the tree. *)
+  List.iter (
+    fun word ->
+      if not (word_exists word) then
+       failwith (sprintf "verify failed: word '%s' missing from tree" word)
+  ) words;
+
+  Ancient.detach md;
+
+  (* Garbage collect - good way to check we haven't broken anything. *)
+  Gc.compact ();
+
+  printf "Verification succeeded.\n"
diff --git a/test_ancient_dict_write.ml b/test_ancient_dict_write.ml
new file mode 100644 (file)
index 0000000..854fb53
--- /dev/null
@@ -0,0 +1,89 @@
+(* Create shared dictionary.
+ * $Id: test_ancient_dict_write.ml,v 1.1 2006-10-06 15:03:47 rich Exp $
+ *)
+
+open Printf
+open Unix
+
+let argv = Array.to_list Sys.argv
+
+let wordsfile, datafile, baseaddr =
+  match argv with
+  | [_; wordsfile; datafile; baseaddr] ->
+      let baseaddr = Nativeint.of_string baseaddr in
+      wordsfile, datafile, baseaddr
+  | _ ->
+      failwith (sprintf "usage: %s wordsfile datafile baseaddr"
+                 Sys.executable_name)
+
+let md =
+  let fd = openfile datafile [O_RDWR; O_TRUNC; O_CREAT] 0o644 in
+  Ancient.attach fd baseaddr
+
+(* Tree used to store the words.  This is stupid and inefficient
+ * but it is here to demonstrate the 'Ancient' module, not good use
+ * of trees.
+ *)
+
+let arraysize = 256 (* one element for each character *)
+
+type t = Not_Found | Exists of t array | Not_Exists of t array;;
+let tree : t array = Array.make arraysize Not_Found
+
+let add_to_tree word =
+  let len = String.length word in
+  if len > 0 then (
+    let tree = ref tree in
+    for i = 0 to len-2; do
+      let c = word.[i] in
+      let c = Char.code c in
+      match (!tree).(c) with
+      | Not_Found ->
+         (* Allocate more tree. *)
+         let tree' = Array.make arraysize Not_Found in
+         (!tree).(c) <- Not_Exists tree';
+         tree := tree'
+      | Exists tree'
+      | Not_Exists tree' ->
+         tree := tree'
+    done;
+
+    (* Final character. *)
+    let c = word.[len-1] in
+    let c = Char.code c in
+    match (!tree).(c) with
+    | Not_Found ->
+       (!tree).(c) <- Exists (Array.make arraysize Not_Found)
+    | Exists _ -> () (* same word added twice *)
+    | Not_Exists tree' ->
+       (!tree).(c) <- Exists tree'
+  )
+
+let () =
+  (* Read in the words and put them in the tree. *)
+  let chan = open_in wordsfile in
+  let count = ref 0 in
+  let rec loop () =
+    let word = input_line chan in
+    add_to_tree word;
+    incr count;
+    loop ()
+  in
+  (try loop () with End_of_file -> ());
+  close_in chan;
+
+  printf "Added %d words to the tree.\n" !count;
+
+  printf "Sharing tree in data file ...\n%!";
+  ignore (Ancient.share md 0 tree);
+
+  (* Perform a full GC and compact, which is a good way to see
+   * if we've trashed the OCaml heap in some way.
+   *)
+  Array.fill tree 0 arraysize Not_Found;
+  printf "Garbage collecting ...\n%!";
+  Gc.compact ();
+
+  printf "Detaching file and finishing.\n%!";
+
+  Ancient.detach md
diff --git a/test_ancient_shared.ml b/test_ancient_shared.ml
deleted file mode 100644 (file)
index 04b3f1b..0000000
+++ /dev/null
@@ -1,130 +0,0 @@
-(* Very basic tests of Ancient module shared functionality.
- * $Id: test_ancient_shared.ml,v 1.3 2006-09-28 12:40:07 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"
-
-(* XXX Linux/AMD64-specific hack to avoid bad mmap(2) allocation. *)
-let baseaddr = Nativeint.of_string "0x440000000000"
-
-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 md = Ancient.attach fd 0n in
-
-      eprintf "After attaching %s ...\n" share_filename;
-      gc_compact ();
-
-      let data : item array Ancient.ancient = Ancient.get md 0 in
-      eprintf "After getting ...\n";
-      gc_compact ();
-
-      let chan = open_out print_filename in
-      output_data chan (Ancient.follow data);
-      close_out chan;
-
-      Ancient.detach md;
-      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 md = Ancient.attach fd baseaddr in
-
-      ignore (Ancient.share md 0 data);
-      eprintf "After sharing data to %s ...\n" share_filename;
-      gc_compact ();
-
-      Ancient.detach md;
-      eprintf "After detaching ...\n";
-      gc_compact ()
-
-  | _ ->
-      failwith "test_ancient_shared"
-
-