[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 () {