ancient-*.tar.gz
test_ancient_shared.data
test_ancient_shared.out1
-test_ancient_shared.out2
\ No newline at end of file
+test_ancient_shared.out2
+test_ancient_weblogs.data
\ No newline at end of file
# Mark objects as 'ancient' so they are taken out of the OCaml heap.
-# $Id: Makefile.config,v 1.2 2006-09-27 14:05:07 rich Exp $
+# $Id: Makefile.config,v 1.3 2006-09-27 18:39:44 rich Exp $
PACKAGE := ancient
-VERSION := 0.0.2
+VERSION := 0.0.3
ifeq ($(shell hostname),oirase)
TEST_WEBLOGS := 1
(* Mark objects as 'ancient' so they are taken out of the OCaml heap.
- * $Id: ancient.ml,v 1.2 2006-09-27 15:36:18 rich Exp $
+ * $Id: ancient.ml,v 1.3 2006-09-27 18:39:44 rich Exp $
*)
type 'a ancient
external delete : 'a ancient -> unit = "ancient_delete"
-external share : Unix.file_descr -> 'a -> 'a ancient = "ancient_share"
+type md
-external attach : Unix.file_descr -> 'a ancient = "ancient_attach"
+external attach : Unix.file_descr -> md = "ancient_attach"
-external detach : 'a ancient -> unit = "ancient_detach"
+external detach : md -> unit = "ancient_detach"
+
+external share : md -> int -> 'a -> 'a ancient = "ancient_share"
+
+external get : md -> int -> 'a ancient = "ancient_get"
(** Mark objects as 'ancient' so they are taken out of the OCaml heap.
- * $Id: ancient.mli,v 1.2 2006-09-27 15:36:18 rich Exp $
+ * $Id: ancient.mli,v 1.3 2006-09-27 18:39:44 rich Exp $
*)
type 'a ancient
(** {6 Shared memory mappings} *)
-val share : Unix.file_descr -> 'a -> 'a ancient
- (** [share fd obj] does the same as {!Ancient.mark} except
+type md
+ (** Memory descriptor handle. *)
+
+val attach : Unix.file_descr -> md
+ (** [attach fd] attaches to a new or existing file which may contain
+ * shared objects.
+ *
+ * Initially [fd] should be a read/writable, zero-length file
+ * (see {!Unix.openfile}). One or more objects can then be
+ * shared in this file using {!Unix.share}.
+ *)
+
+val detach : md -> unit
+ (** [detach md] detaches from an existing file, and closes it.
+ *)
+
+val share : md -> int -> 'a -> 'a ancient
+ (** [share md key obj] does the same as {!Ancient.mark} except
* that instead of copying the object into local memory, it
- * writes it into memory which is backed by the file [fd].
- * [fd] should be a writable, zero-length file (see
- * {!Unix.openfile}).
+ * writes it into memory which is backed by the attached file.
*
* Shared mappings created this way may be shared between
* other OCaml processes which can access the underlying
* file. See {!Ancient.attach}, {!Ancient.detach}.
*
+ * More than one object can be stored in a file. They are
+ * indexed using integers in the range [0..1023] (the limit
+ * is hard-coded in [mmalloc/mmprivate.h]). The [key] parameter
+ * controls which object is written/overwritten by [share].
+ * If you do not wish to use this feature, just pass [0]
+ * as the key.
+ *
* Do not call {!Ancient.delete} on a mapping created like this.
* Instead, call {!Ancient.detach} and, if necessary, delete the
* underlying file.
+ *
+ * Caution when sharing files/objects between processes:
+ * The underlying [mmalloc] library does not do any sort of
+ * locking, so all calls to [share] must ensure that they have
+ * exclusive access to the underlying file while in progress.
*)
-val attach : Unix.file_descr -> 'a ancient
- (** [attach fd] takes an existing file which was created by
- * {!Ancient.share} and accesses the object contained
- * in it.
+val get : md -> int -> 'a ancient
+ (** [get md key] returns the object indexed by [key] in the
+ * attached file.
*
- * You need to force the return type to be the correct type
- * for the object contained in the file. As with Marshal,
- * the type is not checked, and if it is wrong a segfault
- * is likely.
+ * The key is in the range [0..1023] (the limit is hard-coded in
+ * [mmalloc/mmprivate.h]).
*
- * Do not call {!Ancient.delete} on a mapping created like this.
- * Instead, call {!Ancient.detach} and, if necessary, delete the
- * underlying file.
- *)
-
-val detach : 'a ancient -> unit
- (** [detach obj] detaches from a shared mapping.
+ * 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.
*
- * @raise [Invalid_argument "detached"] if the object has been detached.
+ * @raises [Not_found] if no object is associated with the key.
*)
/* Mark objects as 'ancient' so they are taken out of the OCaml heap.
- * $Id: ancient_c.c,v 1.4 2006-09-27 16:01:47 rich Exp $
+ * $Id: ancient_c.c,v 1.5 2006-09-27 18:39:44 rich Exp $
*/
#include <string.h>
void *ptr = do_mark (obj, my_realloc, my_free, 0);
- // Replace obj with a proxy.
+ // Return the proxy.
proxy = caml_alloc (1, Abstract_tag);
Field (proxy, 0) = (value) ptr;
}
CAMLprim value
-ancient_share (value fdv, value obj)
+ancient_attach (value fdv)
{
- CAMLparam2 (fdv, obj);
- CAMLlocal1 (proxy);
+ CAMLparam1 (fdv);
+ CAMLlocal1 (mdv);
int fd = Int_val (fdv);
void *md = mmalloc_attach (fd, 0);
caml_failwith ("mmalloc_attach");
}
- void *ptr = do_mark (obj, mrealloc, mfree, md);
+ mdv = caml_alloc (1, Abstract_tag);
+ Field (mdv, 0) = (value) md;
- // Save the address of the object within the mmalloc area. We need
- // it when attaching.
- mmalloc_setkey (md, 0, ptr);
+ CAMLreturn (mdv);
+}
- proxy = caml_alloc (2, Abstract_tag);
- Field (proxy, 0) = (value) ptr;
- Field (proxy, 1) = (value) md;
+CAMLprim value
+ancient_detach (value mdv)
+{
+ CAMLparam1 (mdv);
- CAMLreturn (proxy);
+ void *md = (void *) Field (mdv, 0);
+
+ if (mmalloc_detach (md) != 0) {
+ perror ("mmalloc_detach");
+ caml_failwith ("mmalloc_detach");
+ }
+
+ CAMLreturn (Val_unit);
}
CAMLprim value
-ancient_attach (value fdv)
+ancient_share (value mdv, value keyv, value obj)
{
- CAMLparam1 (fdv);
+ CAMLparam3 (mdv, keyv, obj);
CAMLlocal1 (proxy);
- int fd = Int_val (fdv);
- void *md = mmalloc_attach (fd, 0);
- if (md == 0) {
- perror ("mmalloc_attach");
- caml_failwith ("mmalloc_attach");
- }
+ void *md = (void *) Field (mdv, 0);
+ int key = Int_val (keyv);
+
+ // Existing key exists? Free it.
+ void *old_obj = mmalloc_getkey (md, key);
+ if (old_obj != 0) mfree (md, old_obj);
+ mmalloc_setkey (md, key, 0);
+
+ void *ptr = do_mark (obj, mrealloc, mfree, md);
- proxy = caml_alloc (2, Abstract_tag);
- Field (proxy, 0) = (value) mmalloc_getkey (md, 0);
- Field (proxy, 1) = (value) md;
+ mmalloc_setkey (md, key, ptr);
+
+ // Return the proxy.
+ proxy = caml_alloc (1, Abstract_tag);
+ Field (proxy, 0) = (value) ptr;
CAMLreturn (proxy);
}
CAMLprim value
-ancient_detach (value obj)
+ancient_get (value mdv, value keyv)
{
- CAMLparam1 (obj);
- CAMLlocal1 (v);
-
- mlsize_t size = Wosize_val (obj);
- if (size < 2) caml_failwith ("Ancient.detach: not an attached object");
+ CAMLparam2 (mdv, keyv);
+ CAMLlocal1 (proxy);
- v = Field (obj, 0);
- if (Is_long (v)) caml_invalid_argument ("detached");
+ void *md = (void *) Field (mdv, 0);
+ int key = Int_val (keyv);
- void *md = (void *) Field (obj, 1);
- if (mmalloc_detach (md) != 0) {
- perror ("mmalloc_detach");
- caml_failwith ("mmalloc_detach");
- }
+ void *ptr = mmalloc_getkey (md, key);
+ if (!ptr) caml_raise_not_found ();
- // Replace the proxy (a pointer) with an int 0 so we know it's
- // been detached in future.
- Field (obj, 0) = Val_long (0);
+ // Return the proxy.
+ proxy = caml_alloc (1, Abstract_tag);
+ Field (proxy, 0) = (value) ptr;
- CAMLreturn (Val_unit);
+ CAMLreturn (proxy);
}
#define MMALLOC_MAGIC "mmalloc" /* Mapped file magic number */
#define MMALLOC_MAGIC_SIZE 8 /* Size of magic number buf */
#define MMALLOC_VERSION 1 /* Current mmalloc version */
-#define MMALLOC_KEYS 16 /* Keys for application use */
+#define MMALLOC_KEYS 1024 /* Keys for application use */
/* The allocator divides the heap into blocks of fixed size; large
requests receive one or more whole blocks, and small requests
(* Very basic tests of Ancient module shared functionality.
- * $Id: test_ancient_shared.ml,v 1.1 2006-09-27 16:01:47 rich Exp $
+ * $Id: test_ancient_shared.ml,v 1.2 2006-09-27 18:39:44 rich Exp $
*)
open Printf
| ["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
+ let md = Ancient.attach fd 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 data;
+ Ancient.detach md;
eprintf "After detaching ...\n";
gc_compact ()
let fd =
Unix.openfile share_filename
[Unix.O_CREAT;Unix.O_TRUNC;Unix.O_RDWR] 0o644 in
+ let md = Ancient.attach fd in
- let data = Ancient.share fd data in
+ ignore (Ancient.share md 0 data);
eprintf "After sharing data to %s ...\n" share_filename;
gc_compact ();
- Ancient.detach data;
+ Ancient.detach md;
eprintf "After detaching ...\n";
gc_compact ()
(* Load in large weblogs and see if they can still be used.
- * $Id: test_ancient_weblogs.ml,v 1.1 2006-09-27 14:05:07 rich Exp $
+ * $Id: test_ancient_weblogs.ml,v 1.2 2006-09-27 18:39:44 rich Exp $
*)
open Printf
files
+let md =
+ let fd =
+ Unix.openfile "test_ancient_weblogs.data"
+ [Unix.O_RDWR; Unix.O_CREAT; Unix.O_TRUNC] 0o644 in
+ Ancient.attach fd
+
(* Load each file into memory and make it ancient. *)
let () =
- let files =
- List.map (
- fun filename ->
- eprintf "Importing file %s\n%!" filename;
- let rows =
- let rows = Weblogs.import_file filename in
- Ancient.mark rows in
- gc_compact ();
- rows
- ) files in
+ List.iteri (
+ fun key filename ->
+ let () =
+ let basename = Filename.basename filename in
+ eprintf "Importing logfile %s\n%!" basename;
+ let rows = Weblogs.import_file filename in
+ ignore (Ancient.share md key rows) in
+ gc_compact ()
+ ) files;
+
+
- ignore (files)
+ Ancient.detach md
git.annexia.org / ocaml-ancient.git / commitdiff