-(* 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 $
- *)
+(* Mark objects as 'ancient' so they are taken out of the OCaml heap. *)
type 'a ancient
-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 is_ancient : 'a -> bool = "ancient_is_ancient"
+external address_of : 'a -> nativeint = "ancient_address_of"
+
type md
external attach : Unix.file_descr -> nativeint -> md = "ancient_attach"
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"
-external get : md -> int -> 'a ancient = "ancient_get"
+let share md key obj = fst (share_info md key obj)
-let max_key = 1023 (* MMALLOC_KEYS-1. See mmprivate.h *)
+external get : md -> int -> 'a ancient = "ancient_get"