[MLton-commit] r4134: fixed fix to getrusage bug
Matthew Fluet
MLton@mlton.org
Wed, 2 Nov 2005 19:41:44 -0800
MAIL fixed fix to getrusage bug
In Revision 3995:
Added
val MLton.GC.setRusage: bool -> unit
This sets a flag in the GC state that controls whether rusage
information is gathered for each collection. The default is FALSE,
which is different than earlier behavior, but probably makes sense
because the getrusage calls at each GC can be costly, because
MLton.Rusage.rusage is not so used, and because it's easy to enable
the old behavior by calling MLton.GC.setRusage false.
However, this function was never used in the basis library. In
particular, we never enabled rusage when MLton.Rusage.rusage was used.
This further meant that Timer.getGCTime would _always_ return zero,
unless the user happened to run with gc-summary or gc-messages (or
used the corresponding MLton.GC functions).
----------------------------------------------------------------------
U mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb
U mlton/trunk/basis-library/mlton/rusage.sml
U mlton/trunk/runtime/basis/GC.c
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb 2005-11-03 02:56:30 UTC (rev 4133)
+++ mlton/trunk/basis-library/libs/basis-extra/basis-extra.mlb 2005-11-03 03:41:35 UTC (rev 4134)
@@ -166,6 +166,8 @@
../../mlton/signal.sml
../../mlton/process.sig
../../mlton/process.sml
+ ../../mlton/gc.sig
+ ../../mlton/gc.sml
../../mlton/rusage.sig
../../mlton/rusage.sml
@@ -214,8 +216,6 @@
in
../../mlton/ffi.sml
end
- ../../mlton/gc.sig
- ../../mlton/gc.sml
../../mlton/int-inf.sig
../../mlton/platform.sig
../../mlton/platform.sml
Modified: mlton/trunk/basis-library/mlton/rusage.sml
===================================================================
--- mlton/trunk/basis-library/mlton/rusage.sml 2005-11-03 02:56:30 UTC (rev 4133)
+++ mlton/trunk/basis-library/mlton/rusage.sml 2005-11-03 03:41:35 UTC (rev 4134)
@@ -28,16 +28,20 @@
utime = toTime (utimeSec, utimeUsec)}
end
- fun rusage () =
- let
- val () = Prim.ru ()
- open Prim
+ val rusage =
+ let val () = MLtonGC.setRusage true
in
- {children = collect (children_utime_sec, children_utime_usec,
- children_stime_sec, children_stime_usec),
- gc = collect (gc_utime_sec, gc_utime_usec,
- gc_stime_sec, gc_stime_usec),
- self = collect (self_utime_sec, self_utime_usec,
- self_stime_sec, self_stime_usec)}
+ fn () =>
+ let
+ val () = Prim.ru ()
+ open Prim
+ in
+ {children = collect (children_utime_sec, children_utime_usec,
+ children_stime_sec, children_stime_usec),
+ gc = collect (gc_utime_sec, gc_utime_usec,
+ gc_stime_sec, gc_stime_usec),
+ self = collect (self_utime_sec, self_utime_usec,
+ self_stime_sec, self_stime_usec)}
+ end
end
end
Modified: mlton/trunk/runtime/basis/GC.c
===================================================================
--- mlton/trunk/runtime/basis/GC.c 2005-11-03 02:56:30 UTC (rev 4133)
+++ mlton/trunk/runtime/basis/GC.c 2005-11-03 03:41:35 UTC (rev 4134)
@@ -16,8 +16,8 @@
gcState.summary = b;
}
-void GC_setRusage () {
- gcState.rusageIsEnabled = TRUE;
+void GC_setRusage (Int b) {
+ gcState.rusageIsEnabled = b;
}
void MLton_GC_pack () {