[MLton-commit] r4143
Matthew Fluet
MLton@mlton.org
Thu, 3 Nov 2005 16:12:54 -0800
Renamed gcState.rusageIsEnabled to gcSate.rusageMeasureGC.
Removed MLton.GC.setRusage.
Added MLton.Rusage.measureGC.
Implicitly enable gcState.rusageMeasureGC if MLton.Rusage.rusage is
used in the user program.
----------------------------------------------------------------------
U mlton/trunk/basis-library/misc/primitive.sml
U mlton/trunk/basis-library/mlton/gc.sig
U mlton/trunk/basis-library/mlton/rusage.sig
U mlton/trunk/basis-library/mlton/rusage.sml
U mlton/trunk/basis-library/system/timer.sml
U mlton/trunk/doc/changelog
U mlton/trunk/lib/mlton-stubs/gc.sig
U mlton/trunk/lib/mlton-stubs/mlton.sml
U mlton/trunk/lib/mlton-stubs/rusage.sig
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/runtime/basis/GC.c
U mlton/trunk/runtime/gc.c
U mlton/trunk/runtime/gc.h
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/misc/primitive.sml
===================================================================
--- mlton/trunk/basis-library/misc/primitive.sml 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/misc/primitive.sml 2005-11-04 00:12:48 UTC (rev 4143)
@@ -400,7 +400,7 @@
val setHashConsDuringGC =
_import "GC_setHashConsDuringGC": bool -> unit;
val setMessages = _import "GC_setMessages": bool -> unit;
- val setRusage = _import "GC_setRusage": bool -> unit;
+ val setRusageMeasureGC = _import "GC_setRusageMeasureGC": bool -> unit;
val setSummary = _import "GC_setSummary": bool -> unit;
val unpack = _import "MLton_GC_unpack": unit -> unit;
end
Modified: mlton/trunk/basis-library/mlton/gc.sig
===================================================================
--- mlton/trunk/basis-library/mlton/gc.sig 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/mlton/gc.sig 2005-11-04 00:12:48 UTC (rev 4143)
@@ -11,7 +11,6 @@
val collect: unit -> unit
val pack: unit -> unit
val setMessages: bool -> unit
- val setRusage: bool -> unit
val setSummary: bool -> unit
val unpack: unit -> unit
end
Modified: mlton/trunk/basis-library/mlton/rusage.sig
===================================================================
--- mlton/trunk/basis-library/mlton/rusage.sig 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/mlton/rusage.sig 2005-11-04 00:12:48 UTC (rev 4143)
@@ -11,7 +11,8 @@
type t = {utime: Time.time, (* user time *)
stime: Time.time (* system time *)
}
-
+
+ val measureGC: bool -> unit
val rusage: unit -> {children: t,
gc: t,
self: t}
Modified: mlton/trunk/basis-library/mlton/rusage.sml
===================================================================
--- mlton/trunk/basis-library/mlton/rusage.sml 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/mlton/rusage.sml 2005-11-04 00:12:48 UTC (rev 4143)
@@ -28,16 +28,23 @@
utime = toTime (utimeSec, utimeUsec)}
end
- fun rusage () =
- let
- val () = Prim.ru ()
- open Prim
+ val measureGC = Primitive.GC.setRusageMeasureGC
+
+ val rusage =
+ let
+ val () = measureGC 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/basis-library/system/timer.sml
===================================================================
--- mlton/trunk/basis-library/system/timer.sml 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/system/timer.sml 2005-11-04 00:12:48 UTC (rev 4143)
@@ -21,19 +21,14 @@
type cpu_timer = {gc: SysUsr.t, self: SysUsr.t}
- val startCPUTimer : unit -> cpu_timer =
- let
- val () = MLtonGC.setRusage true
+ fun startCPUTimer (): cpu_timer =
+ let
+ val {gc = {utime = gcu, stime = gcs, ...},
+ self = {utime = selfu, stime = selfs}, ...} =
+ MLtonRusage.rusage ()
in
- fn () =>
- let
- val {gc = {utime = gcu, stime = gcs, ...},
- self = {utime = selfu, stime = selfs}, ...} =
- MLtonRusage.rusage ()
- in
- {gc = SysUsr.T {sys = gcs, usr = gcu},
- self = SysUsr.T {sys = selfs, usr = selfu}}
- end
+ {gc = SysUsr.T {sys = gcs, usr = gcu},
+ self = SysUsr.T {sys = selfs, usr = selfu}}
end
fun checkCPUTimes {gc, self} =
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/doc/changelog 2005-11-04 00:12:48 UTC (rev 4143)
@@ -1,5 +1,9 @@
Here are the changes since version 20041109.
+* 2005-11-03
+ - Removed MLton.GC.setRusage.
+ - Added MLton.Rusage.measureGC.
+
* 2005-09-11
- Fixed bug in display of types with large numbers of type
variables, which could cause unhandled exception Chr.
Modified: mlton/trunk/lib/mlton-stubs/gc.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/gc.sig 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/lib/mlton-stubs/gc.sig 2005-11-04 00:12:48 UTC (rev 4143)
@@ -11,7 +11,6 @@
val collect: unit -> unit
val pack: unit -> unit
val setMessages: bool -> unit
- val setRusage: bool -> unit
val setSummary: bool -> unit
val unpack: unit -> unit
end
Modified: mlton/trunk/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs/mlton.sml 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/lib/mlton-stubs/mlton.sml 2005-11-04 00:12:48 UTC (rev 4143)
@@ -132,7 +132,6 @@
fun collect _ = ()
val pack = MLton.GC.pack
fun setMessages _ = ()
- fun setRusage _ = ()
fun setSummary _ = ()
fun time _ = Time.zeroTime
fun unpack _ = ()
@@ -409,6 +408,8 @@
struct
type t = {stime: Time.time, utime: Time.time}
+ fun measureGC _ = ()
+
(* Fake it with Posix.ProcEnv.times *)
fun rusage () =
let
Modified: mlton/trunk/lib/mlton-stubs/rusage.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/rusage.sig 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/lib/mlton-stubs/rusage.sig 2005-11-04 00:12:48 UTC (rev 4143)
@@ -12,6 +12,7 @@
stime: Time.time (* system time *)
}
+ val measureGC: bool -> unit
val rusage: unit -> {children: t,
gc: t,
self: t}
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/mlton/main/main.fun 2005-11-04 00:12:48 UTC (rev 4143)
@@ -517,7 +517,7 @@
| _ => Error.bug "incorrect args from shell script"
val _ = setTargetType ("self", usage)
val result = parse args
- val () = MLton.GC.setRusage (!verbosity <> Silent)
+ val () = MLton.Rusage.measureGC (!verbosity <> Silent)
val () =
if !showAnns then
(Layout.outputl (Control.Elaborate.document {expert = !expert},
Modified: mlton/trunk/runtime/basis/GC.c
===================================================================
--- mlton/trunk/runtime/basis/GC.c 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/runtime/basis/GC.c 2005-11-04 00:12:48 UTC (rev 4143)
@@ -16,8 +16,8 @@
gcState.summary = b;
}
-void GC_setRusage (Int b) {
- gcState.rusageIsEnabled = b;
+void GC_setRusageMeasureGC (Int b) {
+ gcState.rusageMeasureGC = b;
}
void MLton_GC_pack () {
Modified: mlton/trunk/runtime/gc.c
===================================================================
--- mlton/trunk/runtime/gc.c 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/runtime/gc.c 2005-11-04 00:12:48 UTC (rev 4143)
@@ -3023,7 +3023,7 @@
}
static inline bool needGCTime (GC_state s) {
- return DEBUG or s->summary or s->messages or s->rusageIsEnabled;
+ return DEBUG or s->summary or s->messages or s->rusageMeasureGC;
}
static void doGC (GC_state s,
@@ -4476,7 +4476,7 @@
s->oldGenArraySize = 0x100000;
s->pageSize = getpagesize ();
s->ramSlop = 0.5;
- s->rusageIsEnabled = FALSE;
+ s->rusageMeasureGC = FALSE;
s->savedThread = BOGUS_THREAD;
s->signalHandler = BOGUS_THREAD;
s->signalIsPending = FALSE;
Modified: mlton/trunk/runtime/gc.h
===================================================================
--- mlton/trunk/runtime/gc.h 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/runtime/gc.h 2005-11-04 00:12:48 UTC (rev 4143)
@@ -455,7 +455,7 @@
W32 ram; /* ramSlop * totalRam */
W32 (*returnAddressToFrameIndex) (W32 w);
float ramSlop;
- bool rusageIsEnabled;
+ bool rusageMeasureGC;
struct rusage ru_gc; /* total resource usage spent in gc */
struct rusage ru_gcCopy; /* resource usage in major copying gcs. */
struct rusage ru_gcMarkCompact; /* resource usage in mark-compact gcs. */