[MLton-devel] Re: [MLton-user] ffi pointer lifetime
Stephen Weeks
MLton@mlton.org
Wed, 14 May 2003 16:18:22 -0700
> Note, however, that finalization won't help in Vesa's case, since his
> values are Word32.word. (Or, rather, he will see the finalization code
> run after the next garbage collection and the C-side datastructures will
> be free-ed too early.)
Agreed. This is bad.
> In any event, I think this will be the common case: C-functions that
> yield (malloc-ed) pointers which want to be finalized by calling a
> free function. We should have a model of the "right way" to do this
> and add it to the user's guide.
Agreed. Or even better, put it in MLton.Finalize.
> Here's the best I could come up with for C-side malloc/free:
...
> Note that "uses" of C-ptrs (with the exception of listFree) are
> Word32.word refs -- this ensures that the ref cell that is being tracked
> by finalization is kept all the way until it is actually used.
Agreed, but it's messy to make the user manage the refs.
> One problem with the above is that finalization is "slow", in the sense
> that because the ptrs list is kept in the closure of the finalization
> function; therefore, we only free one cons-cell per GC. I haven't been
> able to come up with a better scheme.
One cons-cell perf GC is unnaceptable.
I propose the following solution to the problems of keeping the
Word32.word alive as long as it is needed and to tracking dependencies
between C structs.
------------------------------------------------------------
signature FINALIZABLE =
sig
type 'a t
(* finalize (v, f) will run f () when the value in v is no longer used. *)
val finalize: 'a t * ('a -> unit) -> unit
(* finalizeBefore (a, b) requires a to be finalized before b. *)
val finalizeBefore: 'a t * 'b t -> unit
(* new x creates a new finalizable value. The finalizers will be run
* after the last call to withValue.
*)
val new: 'a -> 'a t
(* withValue (v, f) returns the result of applying f to the value of v
* and ensures that v's finalizers will not run until f completes.
*)
val withValue: 'a t * ('a -> 'b) -> 'b
end
------------------------------------------------------------
FINALIZABLE is a different approach from the current approach in that
it does not allow finalizers to be attached to values of arbitrary
type. Instead, it only allows finalizers to be attached to the new
Finalizable.t type. We control the representation of Finalizable.t
and can make it work with words. Finalizable also has a
critical-section-like facility, withValue, that is the only way to get
at the value. This allows us to get out, say, a word, and be sure
that in the context of the withValue that the finalizer will not be
run. Finalizable also has a facility for declaring dependencies
between finalizeable values. The only caveat is that cyclic
dependencies will prevent the finalizer from running.
With FINALIZABLE, implementing your example of C cons cells is easy,
and doesn't require using any word refs.
------------------------------------------------------------
signature CLIST =
sig
type t
val cons: int * t -> t
val sing: int -> t
val sum: t -> int
end
functor CList (structure F: FINALIZABLE
structure Prim:
sig
val cons: int * Word32.word -> Word32.word
val free: Word32.word -> unit
val sing: int -> Word32.word
val sum: Word32.word -> int
end): CLIST =
struct
type t = Word32.word F.t
fun cons (n: int, l: t) =
F.withValue
(l, fn w' =>
let
val c = F.new (Prim.cons (n, w'))
val _ = F.finalize (c, Prim.free)
val _ = F.finalizeBefore (c, l)
in
c
end)
fun sing n =
let
val c = F.new (Prim.sing n)
val _ = F.finalize (c, Prim.free)
in
c
end
fun sum c = F.withValue (c, Prim.sum)
end
------------------------------------------------------------
Here's the test program you wanted to run.
------------------------------------------------------------
functor Test (structure CList: CLIST
structure MLton: sig
structure GC:
sig
val collect: unit -> unit
end
end) =
struct
fun f n =
if n = 1
then ()
else
let
val a = Array.tabulate (n, fn i => i)
val _ = Array.sub (a, 0) + Array.sub (a, 1)
in
f (n - 1)
end
val l = CList.sing 2
val l = CList.cons (2,l)
val l = CList.cons (2,l)
val l = CList.cons (2,l)
val l = CList.cons (2,l)
val l = CList.cons (2,l)
val l = CList.cons (2,l)
val _ = MLton.GC.collect ()
val _ = f 100
val _ = print (concat ["listSum(l) = ",
Int.toString (CList.sum l),
"\n"])
val _ = MLton.GC.collect ()
val _ = f 100
end
------------------------------------------------------------
Here's a C implementation of the cons primitives, with some extra
print statements to see what's going on.
------------------------------------------------------------
/* cons.c */
#include <stdio.h>
typedef unsigned int uint;
typedef struct Cons {
struct Cons *next;
int value;
} *Cons;
Cons listCons (int n, Cons c) {
Cons res;
res = (Cons) malloc (sizeof(*res));
fprintf (stderr, "0x%08x = listCons (%d)\n", (uint)res, n);
res->next = c;
res->value = n;
return res;
}
Cons listSing (int n) {
Cons res;
res = (Cons) malloc (sizeof(*res));
fprintf (stderr, "0x%08x = listSing (%d)\n", (uint)res, n);
res->next = NULL;
res->value = n;
return res;
}
void listFree (Cons p) {
fprintf (stderr, "listFree (0x%08x)\n", (uint)p);
free (p);
}
int listSum (Cons c) {
int res;
fprintf (stderr, "listSum\n");
res = 0;
for (; c != NULL; c = c->next)
res += c->value;
return res;
}
------------------------------------------------------------
With the implementation of FINALIZEABLE (coming soon :-), running the
test program produces the following as output
------------------------------------------------------------
0x0805e5f0 = listSing (2)
0x0805e600 = listCons (2)
0x0805e610 = listCons (2)
0x0805e620 = listCons (2)
0x0805e630 = listCons (2)
0x0805e640 = listCons (2)
0x0805e650 = listCons (2)
listSum
listSum(l) = 14
listFree (0x0805e650)
listFree (0x0805e640)
listFree (0x0805e630)
listFree (0x0805e620)
listFree (0x0805e610)
listFree (0x0805e600)
listFree (0x0805e5f0)
------------------------------------------------------------
Notice how the cons cells are freed in order from the front of the
list to the back of the list, in accordance with the F.finalizeBefore
calls.
Now, for the implementation of FINALIZABLE, in terms of the current,
simpler, FINALIZE, and a new primitive, touch, which is guaranteed to
keep a value alive (we will need to add this primitive to MLton).
------------------------------------------------------------
functor Finalizable
(structure Finalize:
sig
val finalize: 'a * (unit -> unit) -> unit
end
structure Prim:
sig
val touch: 'a ref -> unit
end): FINALIZABLE =
struct
datatype 'a t = T of {afters: (unit -> unit) list ref,
finalizers: ('a -> unit) list ref,
refCount: int ref,
value: 'a ref}
fun withValue (T {value, ...}, f) =
DynamicWind.wind (fn () => f (!value),
fn () => Prim.touch value)
fun finalize (T {finalizers, ...}, f) = List.push (finalizers, f)
(* dec is careful to keep "value" out of the closure. *)
fun dec (T {afters, finalizers, refCount, value}) =
let
val v = !value
in
fn () =>
let
val n = !refCount
in
if n > 0
then refCount := n - 1
else (List.foreach (!finalizers, fn f => f v)
; List.foreach (!afters, fn f => f ()))
end
end
fun new v =
let
val afters = ref []
val finalizers = ref []
val refCount = ref 0
val value = ref v
val f = T {afters = afters,
finalizers = finalizers,
refCount = refCount,
value = value}
val _ = Finalize.finalize (value, dec f)
in
f
end
fun finalizeBefore (T {afters, ...}, f as T {refCount, ...}) =
(refCount := 1 + !refCount
; List.push (afters, dec f))
end
------------------------------------------------------------
With all that in place, here is enough to run the test program,
including a hack to implement touch.
------------------------------------------------------------
structure DependentFinalize =
DependentFinalize (structure Finalize = MLton.Finalize
structure Prim =
struct
fun touch (r: 'a ref) =
if r = ref (!r)
then print "bug\n"
else ()
end)
structure CList =
CList (structure F = DependentFinalize
structure Prim =
struct
val cons = _ffi "listCons": int * Word32.word -> Word32.word;
val free = _ffi "listFree": Word32.word -> unit;
val sing = _ffi "listSing": int -> Word32.word;
val sum = _ffi "listSum": Word32.word -> int;
end)
structure S = Test (structure CList = CList
structure MLton = MLton)
------------------------------------------------------------
It's also interesting to run the test program with gc-messages and
with DEBUG_WEAK turned on. This shows when the weaks go, and how the
finalizeBefore is keeping the cons cells alive.
------------------------------------------------------------
total RAM = 526,761,984 total swap = 1,076,051,968 RAM = 421,412,864
Created heap of size 8,192 at 0x4001a000.
z.0.S 7096: GC_gc
Starting gc. Request 512 nursery bytes and 0 old gen bytes.
Growing stack to size 276.
Finished gc.
time: 0 ms
old gen size: 1,448 bytes (17.7%)
z.0.S 3760: GC_gc
Starting gc. Request 512 nursery bytes and 0 old gen bytes.
Growing stack to size 284.
Finished gc.
time: 0 ms
old gen size: 6,424 bytes (78.4%)
0x0805e5f0 = listSing (2)
0x4001b970 = GC_weakNew (0x00000061, 0x4001b954)
0x0805e600 = listCons (2)
0x4001b9d4 = GC_weakNew (0x00000061, 0x4001b9b8)
0x0805e610 = listCons (2)
0x4001ba60 = GC_weakNew (0x00000061, 0x4001ba44)
0x0805e620 = listCons (2)
0x4001baec = GC_weakNew (0x00000061, 0x4001bad0)
0x0805e630 = listCons (2)
0x4001bb78 = GC_weakNew (0x00000061, 0x4001bb5c)
0x0805e640 = listCons (2)
0x4001bc04 = GC_weakNew (0x00000061, 0x4001bbe8)
0x0805e650 = listCons (2)
0x4001bc90 = GC_weakNew (0x00000061, 0x4001bc74)
z.0.S 7892: GC_gc
Starting gc. Request 512 nursery bytes and 0 old gen bytes.
Created heap of size 12,288 at 0x4001e000.
Major copying GC.
fromSpace = 0x4001a000 of size 8,192
toSpace = 0x4001e000 of size 12,288
forwarding weak 0x4001f6f4 linking
forwarding weak 0x4001f750 linking
forwarding weak 0x4001f7b8 linking
forwarding weak 0x4001f834 linking
forwarding weak 0x4001f8b0 linking
forwarding weak 0x4001f92c linking
forwarding weak 0x4001f99c linking
updateWeaks w = 0x4001f99c cleared
updateWeaks w = 0x4001f92c cleared
updateWeaks w = 0x4001f8b0 cleared
updateWeaks w = 0x4001f834 cleared
updateWeaks w = 0x4001f7b8 cleared
updateWeaks w = 0x4001f750 cleared
updateWeaks w = 0x4001f6f4 forwarded
Major copying GC done.
Releasing heap at 0x4001a000 of size 8,192.
Finished gc.
time: 0 ms
old gen size: 6,680 bytes (10.9%)
z.0.S 5222: GC_gc
Starting gc. Request 512 nursery bytes and 0 old gen bytes.
Growing stack to size 284.
Finished gc.
time: 0 ms
old gen size: 6,964 bytes (11.3%)
z.0.S 5267: GC_gc
TRUE = GC_weakCanGet (0x4001f6f4)
FALSE = GC_weakCanGet (0x4001f750)
z.0.S 4733: GC_gc
Starting gc. Request 512 nursery bytes and 0 old gen bytes.
Growing stack to size 356.
Finished gc.
time: 0 ms
old gen size: 7,348 bytes (12.0%)
FALSE = GC_weakCanGet (0x4001f7b8)
FALSE = GC_weakCanGet (0x4001f834)
FALSE = GC_weakCanGet (0x4001f8b0)
FALSE = GC_weakCanGet (0x4001f92c)
FALSE = GC_weakCanGet (0x4001f99c)
listSum
listSum(l) = 14
z.0.S 8963: GC_gc
Starting gc. Request 512 nursery bytes and 0 old gen bytes.
Created heap of size 61,440 at 0x40054000.
Major copying GC.
fromSpace = 0x4001e000 of size 61,440
toSpace = 0x40054000 of size 61,440
forwarding weak 0x400546a0 linking
updateWeaks w = 0x400546a0 cleared
Major copying GC done.
Finished gc.
time: 0 ms
old gen size: 6,300 bytes (10.3%)
z.0.S 5222: GC_gc
Starting gc. Request 512 nursery bytes and 0 old gen bytes.
Growing stack to size 284.
Finished gc.
time: 0 ms
old gen size: 6,584 bytes (10.7%)
z.0.S 5267: GC_gc
FALSE = GC_weakCanGet (0x400546a0)
z.0.S 4733: GC_gc
Starting gc. Request 512 nursery bytes and 0 old gen bytes.
Growing stack to size 356.
Finished gc.
time: 0 ms
old gen size: 6,956 bytes (11.3%)
listFree (0x0805e650)
listFree (0x0805e640)
listFree (0x0805e630)
listFree (0x0805e620)
listFree (0x0805e610)
listFree (0x0805e600)
listFree (0x0805e5f0)
Releasing heap at 0x40054000 of size 61,440.
Releasing heap at 0x4001e000 of size 61,440.
------------------------------------------------------------
That's it. Let me know what you think, and if it makes sense to
eliminate MLton.Finalize and put this stuff in as MLton.Finalizable.
-------------------------------------------------------
Enterprise Linux Forum Conference & Expo, June 4-6, 2003, Santa Clara
The only event dedicated to issues related to Linux enterprise solutions
www.enterpriselinuxforum.com
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel