summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
2f2d5af)
of how much space is being used by each allocation.
(* 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.ml,v 1.5 2006-10-09 12:18:05 rich Exp $
+ * $Id: ancient.ml,v 1.6 2006-10-09 14:43:00 rich Exp $
-external mark : 'a -> 'a ancient = "ancient_mark"
+type info = {
+ i_size : int;
+}
+
+external mark_info : 'a -> 'a ancient * info = "ancient_mark_info"
+
+let mark obj = fst (mark_info obj)
external follow : 'a ancient -> 'a = "ancient_follow"
external follow : 'a ancient -> 'a = "ancient_follow"
external detach : md -> unit = "ancient_detach"
external detach : md -> unit = "ancient_detach"
-external share : md -> int -> 'a -> 'a ancient = "ancient_share"
+external share_info : md -> int -> 'a -> 'a ancient * info
+ = "ancient_share_info"
+
+let share md key obj = fst (share_info md key obj)
external get : md -> int -> 'a ancient = "ancient_get"
external get : md -> int -> 'a ancient = "ancient_get"
(** 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.6 2006-10-09 12:18:05 rich Exp $
+ * $Id: ancient.mli,v 1.7 2006-10-09 14:43:00 rich Exp $
+
+(** {6 Additional information} *)
+
+type info = {
+ i_size : int; (** Allocated size, bytes. *)
+}
+ (** Extra information fields. See {!Ancient.mark_info} and
+ * {!Ancient.share_info}.
+ *)
+
+val mark_info : 'a -> 'a ancient * info
+ (** Same as {!Ancient.mark}, but also returns some extra information. *)
+
+val share_info : md -> int -> 'a -> 'a ancient * info
+ (** Same as {!Ancient.share}, but also returns some extra information. *)
+
/* 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_c.c,v 1.8 2006-10-09 12:18:05 rich Exp $
+ * $Id: ancient_c.c,v 1.9 2006-10-09 14:43:00 rich Exp $
// what was in that field before.
// (3) We can overwrite the header with all 1's to indicate that
// we've visited (but see notes on 'static header_t visited' above).
// what was in that field before.
// (3) We can overwrite the header with all 1's to indicate that
// we've visited (but see notes on 'static header_t visited' above).
- // (4) All objects in OCaml are at least one word long (we hope!).
+ // (4) All objects in OCaml are at least one word long (XXX - actually
+ // this is not true).
struct restore_item restore_item;
restore_item.header = header;
restore_item.field_zero = Field (obj, 0);
struct restore_item restore_item;
restore_item.header = header;
restore_item.field_zero = Field (obj, 0);
static void *
mark (value obj,
static void *
mark (value obj,
- void *(*realloc)(void *data, void *ptr, size_t size),
- void (*free)(void *data, void *ptr),
- void *data)
+ void *(*realloc)(void *data, void *ptr, size_t size),
+ void (*free)(void *data, void *ptr),
+ void *data,
+ size_t *r_size)
{
area ptr; // This will be the out of heap area.
area_init_custom (&ptr, realloc, free, data);
{
area ptr; // This will be the out of heap area.
area_init_custom (&ptr, realloc, free, data);
do_fixups (&ptr, &fixups);
area_free (&fixups);
do_fixups (&ptr, &fixups);
area_free (&fixups);
+ if (r_size) *r_size = ptr.size;
-ancient_mark (value obj)
+ancient_mark_info (value obj)
+ CAMLlocal3 (proxy, info, rv);
- void *ptr = mark (obj, my_realloc, my_free, 0);
+ size_t size;
+ void *ptr = mark (obj, my_realloc, my_free, 0, &size);
proxy = caml_alloc (1, Abstract_tag);
Field (proxy, 0) = (value) ptr;
proxy = caml_alloc (1, Abstract_tag);
Field (proxy, 0) = (value) ptr;
+ // Make the info struct.
+ info = caml_alloc (1, 0);
+ Field (info, 0) = Val_long (size);
+
+ rv = caml_alloc (2, 0);
+ Field (rv, 0) = proxy;
+ Field (rv, 1) = info;
+
+ CAMLreturn (rv);
-ancient_share (value mdv, value keyv, value obj)
+ancient_share_info (value mdv, value keyv, value obj)
{
CAMLparam3 (mdv, keyv, obj);
{
CAMLparam3 (mdv, keyv, obj);
+ CAMLlocal3 (proxy, info, rv);
void *md = (void *) Field (mdv, 0);
int key = Int_val (keyv);
void *md = (void *) Field (mdv, 0);
int key = Int_val (keyv);
if (old_obj != 0) mfree (md, old_obj);
mmalloc_setkey (md, key, 0);
if (old_obj != 0) mfree (md, old_obj);
mmalloc_setkey (md, key, 0);
- void *ptr = mark (obj, mrealloc, mfree, md);
+ size_t size;
+ void *ptr = mark (obj, mrealloc, mfree, md, &size);
mmalloc_setkey (md, key, ptr);
mmalloc_setkey (md, key, ptr);
proxy = caml_alloc (1, Abstract_tag);
Field (proxy, 0) = (value) ptr;
proxy = caml_alloc (1, Abstract_tag);
Field (proxy, 0) = (value) ptr;
+ // Make the info struct.
+ info = caml_alloc (1, 0);
+ Field (info, 0) = Val_long (size);
+
+ rv = caml_alloc (2, 0);
+ Field (rv, 0) = proxy;
+ Field (rv, 1) = info;
+
+ CAMLreturn (rv);