Menu
▾
▴
mlton-commit — [MLton-commit] Code commits
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(56) |
Sep
(40) |
Oct
(30) |
Nov
(144) |
Dec
(23) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2006 |
Jan
(41) |
Feb
(29) |
Mar
(31) |
Apr
(39) |
May
(193) |
Jun
(45) |
Jul
(19) |
Aug
(3) |
Sep
(23) |
Oct
(83) |
Nov
(92) |
Dec
(123) |
| 2007 |
Jan
(90) |
Feb
(267) |
Mar
(120) |
Apr
(51) |
May
(40) |
Jun
(121) |
Jul
(109) |
Aug
(173) |
Sep
(77) |
Oct
(52) |
Nov
(121) |
Dec
(62) |
| 2008 |
Jan
(76) |
Feb
(53) |
Mar
(98) |
Apr
(87) |
May
(26) |
Jun
(27) |
Jul
(23) |
Aug
(136) |
Sep
(79) |
Oct
(68) |
Nov
(29) |
Dec
(14) |
| 2009 |
Jan
(7) |
Feb
(2) |
Mar
(11) |
Apr
(75) |
May
(1) |
Jun
(95) |
Jul
(19) |
Aug
(4) |
Sep
(8) |
Oct
(93) |
Nov
(43) |
Dec
(21) |
| 2010 |
Jan
(20) |
Feb
(23) |
Mar
(18) |
Apr
(6) |
May
(20) |
Jun
(23) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
(2) |
Feb
(6) |
Mar
(15) |
Apr
(5) |
May
(9) |
Jun
(14) |
Jul
(9) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(2) |
Jun
(17) |
Jul
(37) |
Aug
|
Sep
(1) |
Oct
(6) |
Nov
|
Dec
|
| 2013 |
Jan
|
Feb
|
Mar
(5) |
Apr
(2) |
May
(7) |
Jun
(11) |
Jul
(8) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
(2) |
Mar
(1) |
Apr
|
May
(1) |
Jun
(1) |
Jul
(7) |
Aug
(2) |
Sep
|
Oct
(5) |
Nov
(2) |
Dec
(4) |
| 2015 |
Jan
|
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(9) |
Jul
(1) |
Aug
|
Sep
|
Oct
(4) |
Nov
(1) |
Dec
|
| 2016 |
Jan
(2) |
Feb
(1) |
Mar
(1) |
Apr
(1) |
May
(1) |
Jun
(2) |
Jul
(1) |
Aug
|
Sep
(5) |
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
(1) |
Feb
(3) |
Mar
(3) |
Apr
(7) |
May
(2) |
Jun
(2) |
Jul
(5) |
Aug
(1) |
Sep
(2) |
Oct
(17) |
Nov
(4) |
Dec
(7) |
| 2018 |
Jan
(5) |
Feb
(14) |
Mar
(2) |
Apr
(5) |
May
(2) |
Jun
(5) |
Jul
|
Aug
(2) |
Sep
|
Oct
(3) |
Nov
(5) |
Dec
|
| 2019 |
Jan
(4) |
Feb
(2) |
Mar
(3) |
Apr
(1) |
May
(8) |
Jun
(14) |
Jul
(2) |
Aug
|
Sep
(2) |
Oct
(2) |
Nov
(15) |
Dec
(2) |
| 2020 |
Jan
(10) |
Feb
(3) |
Mar
(1) |
Apr
|
May
(9) |
Jun
(4) |
Jul
(16) |
Aug
(10) |
Sep
(4) |
Oct
(3) |
Nov
|
Dec
|
| 2021 |
Jan
(11) |
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
|
Oct
(6) |
Nov
(4) |
Dec
(4) |
| 2022 |
Jan
(4) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(6) |
Jun
(3) |
Jul
|
Aug
(1) |
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
(2) |
May
(5) |
Jun
(1) |
Jul
(4) |
Aug
(1) |
Sep
|
Oct
(1) |
Nov
(13) |
Dec
|
| 2024 |
Jan
(1) |
Feb
|
Mar
(5) |
Apr
|
May
(10) |
Jun
|
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
(1) |
Dec
(14) |
| 2025 |
Jan
(3) |
Feb
|
Mar
(1) |
Apr
|
May
(2) |
Jun
(3) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 16:04:38
|
Changed the handling of the -target command-line switch. Previously,
it had updated the align and codegen information when it was
encountered. This led to non-intuitive behavior when -target followed
either -align or -codegen, since it would override what they had
provided. This fix changes -target so that it doesn't override -align
or -codegen if they are set on the command line.
----------------------------------------------------------------------
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-05 00:01:55 UTC (rev 4159)
+++ mlton/trunk/mlton/main/main.fun 2005-11-05 00:04:36 UTC (rev 4160)
@@ -47,11 +47,13 @@
| Yes
end
-val buildConstants: bool ref = ref false
val asOpts: {opt: string, pred: OptPred.t} list ref = ref []
+val buildConstants: bool ref = ref false
val ccOpts: {opt: string, pred: OptPred.t} list ref = ref []
val coalesce: int option ref = ref NONE
val expert: bool ref = ref false
+val explicitAlign: Control.align option ref = ref NONE
+val explicitCodegen: Control.codegen option ref = ref NONE
val gcc: string ref = ref "<unset>"
val keepGenerated = ref false
val keepO = ref false
@@ -88,24 +90,6 @@
end
| _ => Error.bug (concat ["strange target mapping: ", line])))
-fun setTargetType (target: string, usage): unit =
- case List.peek (targetMap (), fn {target = t, ...} => t = target) of
- NONE => usage (concat ["invalid target: ", target])
- | SOME {arch, os, ...} =>
- let
- datatype z = datatype MLton.Platform.Arch.t
- open Control
- in
- targetArch := arch
- ; targetOS := os
- ; (case arch of
- Sparc => (align := Align8; codegen := CCodegen)
- | HPPA => (align := Align8; codegen := CCodegen)
- | X86 => codegen := Native
- | AMD64 => codegen := Native
- | _ => codegen := CCodegen)
- end
-
fun hasNative () =
let
datatype z = datatype Control.arch
@@ -142,12 +126,12 @@
| _ => " {4|8}",
"object alignment",
(SpaceString (fn s =>
- align
- := (case s of
- "4" => Align4
- | "8" => Align8
- | _ => usage (concat ["invalid -align flag: ",
- s]))))),
+ explicitAlign
+ := SOME (case s of
+ "4" => Align4
+ | "8" => Align8
+ | _ => usage (concat ["invalid -align flag: ",
+ s]))))),
(Normal, "as-opt", " <opt>", "pass option to assembler",
SpaceString (fn s =>
List.push (asOpts, {opt = s, pred = OptPred.Yes}))),
@@ -165,11 +149,13 @@
concat [" {", if hasNative () then "native|" else "", "bytecode|c}"],
"which code generator to use",
SpaceString (fn s =>
- case s of
- "bytecode" => codegen := Bytecode
- | "c" => codegen := CCodegen
- | "native" => codegen := Native
- | _ => usage (concat ["invalid -codegen flag: ", s]))),
+ explicitCodegen
+ := SOME (case s of
+ "bytecode" => Bytecode
+ | "c" => CCodegen
+ | "native" => Native
+ | _ => usage (concat
+ ["invalid -codegen flag: ", s])))),
(Normal, "const", " '<name> <value>'", "set compile-time constant",
SpaceString (fn s =>
case String.tokens (s, Char.isSpace) of
@@ -450,9 +436,12 @@
| x :: _ => concat [#target x, "|..."]),
"}"],
"platform that executable will run on",
- SpaceString (fn s =>
- (setTargetType (s, usage)
- ; target := (if s = "self" then Self else Cross s)))),
+ SpaceString
+ (fn t =>
+ (target := (if t = "self" then Self else Cross t);
+ case List.peek (targetMap (), fn {target = t', ...} => t = t') of
+ NONE => usage (concat ["invalid target: ", t])
+ | SOME {arch, os, ...} => (targetArch := arch; targetOS := os)))),
(Normal, "target-as-opt", " <target> <opt>", "target-dependent assembler option",
(SpaceString2
(fn (target, opt) =>
@@ -512,8 +501,19 @@
(libDir := OS.Path.mkCanonical lib
; args)
| _ => Error.bug "incorrect args from shell script"
- val _ = setTargetType ("self", usage)
val result = parse args
+ val targetArch = !targetArch
+ val () =
+ align := (case !explicitAlign of
+ NONE => (case targetArch of
+ Sparc => Align8
+ | HPPA => Align8
+ | _ => Align4)
+ | SOME a => a)
+ val () =
+ codegen := (case !explicitCodegen of
+ NONE => if hasNative () then Native else CCodegen
+ | SOME c => c)
val () = MLton.Rusage.measureGC (!verbosity <> Silent)
val () =
if !showAnns then
@@ -540,7 +540,6 @@
Cross s => s
| Self => "self"
val _ = libTargetDir := OS.Path.concat (!libDir, targetStr)
- val targetArch = !targetArch
val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
val targetOS = !targetOS
val () =
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 16:01:56
|
Took out the SML/NJ-version check. ---------------------------------------------------------------------- U mlton/trunk/mlton/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/mlton/Makefile =================================================================== --- mlton/trunk/mlton/Makefile 2005-11-04 22:09:10 UTC (rev 4158) +++ mlton/trunk/mlton/Makefile 2005-11-05 00:01:55 UTC (rev 4159) @@ -101,22 +101,14 @@ # Manager (CM) installed. You may need to replace the following with # 'sml-cm'. # -SMLNJ_VERSION = 110.4[59] SML = sml -.PHONY: check-nj-version -check-nj-version: - if ! echo | $(SML) | grep -q $(SMLNJ_VERSION); then \ - echo You must use SML/NJ $(SMLNJ_VERSION); \ - fi - .PHONY: def-use def-use: mlton -stop tc -show-def-use /tmp/z.def-use $(FILE) .PHONY: nj-mlton nj-mlton: $(SOURCES) - $(MAKE) check-nj-version ( \ echo 'SMLofNJ.Internals.GC.messages false;'; \ echo '#set CM.Control.verbose false;'; \ @@ -128,7 +120,6 @@ .PHONY: nj-mlton-dual nj-mlton-dual: $(SOURCES) - $(MAKE) check-nj-version ( \ echo 'SMLofNJ.Internals.GC.messages false;'; \ echo '#set CM.Control.verbose false;'; \ @@ -142,7 +133,6 @@ .PHONY: nj-mlton-quad nj-mlton-quad: $(SOURCES) - $(MAKE) check-nj-version ( \ echo 'SMLofNJ.Internals.GC.messages false;'; \ echo '#set CM.Control.verbose false;'; \ @@ -158,7 +148,6 @@ .PHONY: nj-whole nj-whole: $(SOURCES) - $(MAKE) check-nj-version ( \ echo 'SMLofNJ.Internals.GC.messages false;'; \ echo '#set CM.Control.verbose false;'; \ |
|
From: Stephen W. <sw...@ml...> - 2005-11-04 14:09:13
|
Compile MLton with warnUnused true. ---------------------------------------------------------------------- U mlton/trunk/mlton/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/mlton/Makefile =================================================================== --- mlton/trunk/mlton/Makefile 2005-11-04 22:08:41 UTC (rev 4157) +++ mlton/trunk/mlton/Makefile 2005-11-04 22:09:10 UTC (rev 4158) @@ -23,6 +23,7 @@ # We're compiling MLton with itself, so don't use any stubs. FILE = mlton.mlb FLAGS += -default-ann 'sequenceNonUnit warn' + FLAGS += -default-ann 'warnUnused true' else ifeq (cygwin, $(HOST_OS)) # The stubs don't work on Cygwin, since they define spawn in terms of |
|
From: Stephen W. <sw...@ml...> - 2005-11-04 14:08:43
|
Removed unused.
----------------------------------------------------------------------
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-04 22:03:15 UTC (rev 4156)
+++ mlton/trunk/mlton/main/main.fun 2005-11-04 22:08:41 UTC (rev 4157)
@@ -106,11 +106,6 @@
| _ => codegen := CCodegen)
end
-fun warnDeprecated (flag, use) =
- Out.output (Out.error,
- concat ["Warning: -", flag, " is deprecated. ",
- "Use ", use, ".\n"])
-
fun hasNative () =
let
datatype z = datatype Control.arch
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 14:03:16
|
Removed automatic SML-escaping of strings when laying them out. It's
now up to clients if they want the escaping. This fixed a
long-standing minor bug in MLton, in which error messages referring to
identifiers like \\ were displayed escaped (like \\\\). Now they are
displayed correctly.
----------------------------------------------------------------------
U mlton/trunk/lib/mlton/basic/string1.sml
----------------------------------------------------------------------
Modified: mlton/trunk/lib/mlton/basic/string1.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/string1.sml 2005-11-04 21:57:59 UTC (rev 4155)
+++ mlton/trunk/lib/mlton/basic/string1.sml 2005-11-04 22:03:15 UTC (rev 4156)
@@ -19,7 +19,7 @@
val last = String0.last
-val layout = Layout.str o escapeSML
+val layout = Layout.str
fun forall (s, f) =
let
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 13:58:01
|
Avoid spurious error due to unbound type variable in a type definition
in a signature.
----------------------------------------------------------------------
U mlton/trunk/mlton/elaborate/elaborate-sigexp.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/elaborate/elaborate-sigexp.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-sigexp.fun 2005-11-04 21:19:52 UTC (rev 4154)
+++ mlton/trunk/mlton/elaborate/elaborate-sigexp.fun 2005-11-04 21:57:59 UTC (rev 4155)
@@ -121,24 +121,33 @@
Vector.keepAll
(tyvars', fn a =>
not (Vector.exists (tyvars, fn a' => Tyvar.sameName (a, a'))))
- val _ =
- if 0 = Vector.length unbound
- then ()
+ val ty =
+ if 0 = Vector.length unbound then
+ ty
else
let
open Layout
+ val () =
+ Control.error (Tyvar.region (Vector.sub (tyvars', 0)),
+ seq [str (concat ["undefined type variable",
+ if Vector.length unbound > 1
+ then "s"
+ else "",
+ ": "]),
+ seq (separate
+ (Vector.toListMap (unbound,
+ Tyvar.layout),
+ ", "))],
+ empty)
+ fun var a =
+ if Vector.exists (unbound, fn a' => Tyvar.equals (a, a')) then
+ Type.bogus
+ else
+ Type.var a
in
- Control.error (Tyvar.region (Vector.sub (tyvars', 0)),
- seq [str (concat ["undefined type variable",
- if Vector.length unbound > 1
- then "s"
- else "",
- ": "]),
- seq (separate
- (Vector.toListMap (unbound,
- Tyvar.layout),
- ", "))],
- empty)
+ Type.hom (ty, {con = Type.con,
+ record = Type.record,
+ var = var})
end
(* Need to get the representatives that were chosen when elaborating the
* type.
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 13:19:53
|
Don't use MinGW's fpclassify, which is broken. ---------------------------------------------------------------------- U mlton/trunk/runtime/platform/mingw.h ---------------------------------------------------------------------- Modified: mlton/trunk/runtime/platform/mingw.h =================================================================== --- mlton/trunk/runtime/platform/mingw.h 2005-11-04 21:19:14 UTC (rev 4153) +++ mlton/trunk/runtime/platform/mingw.h 2005-11-04 21:19:52 UTC (rev 4154) @@ -15,7 +15,10 @@ #undef max #define HAS_FEROUND TRUE -#define HAS_FPCLASSIFY TRUE +// As of 20051104, MinGW has fpclassify, but it is broken. In particular, it +// classifies subnormals as normals. So, we disable it here, which causes the +// runtime to use our own version. +#define HAS_FPCLASSIFY FALSE #define HAS_PTRACE FALSE #define HAS_REMAP FALSE #define HAS_SIGALTSTACK FALSE |
|
From: Stephen W. <sw...@ml...> - 2005-11-04 13:19:16
|
Added more MinGW regression exceptions.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-04 20:49:46 UTC (rev 4152)
+++ mlton/trunk/bin/regression 2005-11-04 21:19:14 UTC (rev 4153)
@@ -104,7 +104,7 @@
case `host-os` in
mingw)
case "$f" in
- cmdline|command-line|filesys|mutex|prodcons|signals2)
+ cmdline|command-line|filesys|mutex|posix-exit|prodcons|signals2|timeout|unixpath)
continue
;;
esac
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 12:49:48
|
Moved hardwired reference to build/lib/mlb-path-map from the front end
SML code into bin/mlton-script.
----------------------------------------------------------------------
U mlton/trunk/bin/mlton-script
U mlton/trunk/mlton/front-end/mlb-front-end.fun
----------------------------------------------------------------------
Modified: mlton/trunk/bin/mlton-script
===================================================================
--- mlton/trunk/bin/mlton-script 2005-11-04 20:48:41 UTC (rev 4151)
+++ mlton/trunk/bin/mlton-script 2005-11-04 20:49:46 UTC (rev 4152)
@@ -68,6 +68,7 @@
-cc-opt "-I$lib/include" \
-cc-opt '-O1' \
-cc-opt '-fno-strict-aliasing -fomit-frame-pointer -w' \
+ -mlb-path-map "$lib/mlb-path-map" \
-target-as-opt amd64 \
'-m32
-mtune=opteron' \
Modified: mlton/trunk/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/trunk/mlton/front-end/mlb-front-end.fun 2005-11-04 20:48:41 UTC (rev 4151)
+++ mlton/trunk/mlton/front-end/mlb-front-end.fun 2005-11-04 20:49:46 UTC (rev 4152)
@@ -100,10 +100,7 @@
val pathMap =
List.rev
(List.concat
- [List.concat
- (List.map (concat [!Control.libDir, "/mlb-path-map"]
- :: (!Control.mlbPathMaps),
- make)),
+ [List.concat (List.map (!Control.mlbPathMaps, make)),
[{var = "LIB_MLTON_DIR",
path = !Control.libDir},
{var = "TARGET_ARCH",
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 12:48:42
|
Added some mingw exceptions and reorganized regression script.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-04 20:47:54 UTC (rev 4150)
+++ mlton/trunk/bin/regression 2005-11-04 20:48:41 UTC (rev 4151)
@@ -104,100 +104,98 @@
case `host-os` in
mingw)
case "$f" in
- mutex|prodcons|signals2)
+ cmdline|command-line|filesys|mutex|prodcons|signals2)
continue
;;
esac
esac
case "$f" in
serialize)
- echo "skipping $f"
+ continue
;;
+ esac
+ echo "testing $f"
+ case "$f" in
+ exnHistory*)
+ extraFlags="-const 'Exn.keepHistory true'"
+ ;;
*)
- echo "testing $f"
- case "$f" in
- exnHistory*)
- extraFlags="-const 'Exn.keepHistory true'"
+ extraFlags=""
+ ;;
+ esac
+ case "$runOnly" in
+ no)
+ mlb="$f.mlb"
+ echo "\$(SML_LIB)/basis/basis.mlb
+ \$(SML_LIB)/basis/mlton.mlb
+ \$(SML_LIB)/basis/sml-nj.mlb
+ ann
+ \"allowFFI true\"
+ \"allowOverload true\"
+ \"nonexhaustiveMatch ignore\"
+ \"redundantMatch ignore\"
+ in $f.sml
+ end" >$mlb
+ cmd="$mlton $flags $extraFlags -output $f $mlb"
+ eval $cmd
+ rm $mlb
+ if [ "$?" -ne '0' ] ||
+ [ "$cross" = 'no' -a ! -x "$f" ]; then
+ compFail $f
+ fi
+ ;;
+ yes)
+ case $crossTarget in
+ *mingw)
+ libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
;;
+ *solaris)
+ libs='-lnsl -lsocket -lrt'
+ ;;
*)
- extraFlags=""
+ libs=''
;;
esac
- case "$runOnly" in
- no)
- mlb="$f.mlb"
- echo "\$(SML_LIB)/basis/basis.mlb
- \$(SML_LIB)/basis/mlton.mlb
- \$(SML_LIB)/basis/sml-nj.mlb
- ann
- \"allowFFI true\"
- \"allowOverload true\"
- \"nonexhaustiveMatch ignore\"
- \"redundantMatch ignore\"
- in $f.sml
- end" >$mlb
- cmd="$mlton $flags $extraFlags -output $f $mlb"
- eval $cmd
- rm $mlb
- if [ "$?" -ne '0' ] ||
- [ "$cross" = 'no' -a ! -x "$f" ]; then
- compFail $f
- fi
+ libs="-lmlton -lgmp $libs -lgdtoa -lm"
+ # Must use $f.[0-9].[cS], not $f.*.[cS], because the
+ # latter will include other files, e.g. for finalize,
+ # it will also include finalize.2.
+ files="$f.[0-9].[cS]"
+ if [ 0 -ne `ls $f.[0-9][0-9].[cS] 2>/dev/null | wc -l` ]; then
+ files="$files $f.[0-9][0-9].[cS]"
+ fi
+ gcc -o $f -w -O1 \
+ -I "../build/lib/include" \
+ -L"../build/lib/$crossTarget" \
+ -L/usr/pkg/lib \
+ -L/usr/local/lib \
+ $files $libs
+ ;;
+ esac
+ if [ ! -r $f.nonterm -a $cross = 'no' -a -x $f ]; then
+ nonZeroMsg='Nonzero exit status.'
+ case $crossTarget in
+ *mingw)
+ nonZeroMsg="$nonZeroMsg"'\r'
;;
- yes)
- case $crossTarget in
- *mingw)
- libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
- ;;
- *solaris)
- libs='-lnsl -lsocket -lrt'
- ;;
- *)
- libs=''
- ;;
- esac
- libs="-lmlton -lgmp $libs -lgdtoa -lm"
- # Must use $f.[0-9].[cS], not $f.*.[cS], because the
- # latter will include other files, e.g. for finalize,
- # it will also include finalize.2.
- files="$f.[0-9].[cS]"
- if [ 0 -ne `ls $f.[0-9][0-9].[cS] 2>/dev/null | wc -l` ]; then
- files="$files $f.[0-9][0-9].[cS]"
- fi
- gcc -o $f -w -O1 \
- -I "../build/lib/include" \
- -L"../build/lib/$crossTarget" \
- -L/usr/pkg/lib \
- -L/usr/local/lib \
- $files $libs
- ;;
esac
- if [ ! -r $f.nonterm -a $cross = 'no' -a -x $f ]; then
- nonZeroMsg='Nonzero exit status.'
+ ( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1
+ if [ -r $f.ok ]; then
+ compare="$f.$HOST_ARCH-$HOST_OS.ok"
+ if [ ! -r $compare ]; then
+ compare="$f.ok"
+ fi
case $crossTarget in
*mingw)
- nonZeroMsg="$nonZeroMsg"'\r'
+ compare="$f.sed.ok"
+ sed 's/$/\r/' <"$f.ok" >"$compare"
;;
esac
- ( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1
- if [ -r $f.ok ]; then
- compare="$f.$HOST_ARCH-$HOST_OS.ok"
- if [ ! -r $compare ]; then
- compare="$f.ok"
- fi
- case $crossTarget in
- *mingw)
- compare="$f.sed.ok"
- sed 's/$/\r/' <"$f.ok" >"$compare"
- ;;
- esac
- if ! diff $compare $tmp; then
- echo "difference with $flags"
- fi
+ if ! diff $compare $tmp; then
+ echo "difference with $flags"
fi
fi
- ;;
- esac
+ fi
done
if [ "$cross" = 'yes' -o "$runOnly" = 'yes' -o "$short" = 'yes' ]; then
exit 0
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 12:47:57
|
Made clean script more robust.
----------------------------------------------------------------------
U mlton/trunk/bin/clean
----------------------------------------------------------------------
Modified: mlton/trunk/bin/clean
===================================================================
--- mlton/trunk/bin/clean 2005-11-04 19:52:16 UTC (rev 4149)
+++ mlton/trunk/bin/clean 2005-11-04 20:47:54 UTC (rev 4150)
@@ -23,14 +23,13 @@
fi
for f in `ls`; do
if [ -d $f ]; then
- cd $f;
- if [ -r Makefile ] &&
- grep $grepFlags '^clean:' Makefile ; then
- $bin/mmake clean
+ cd $f
+ if [ -r Makefile ]; then
+ $bin/mmake clean || doit
else
doit
- fi &&
- cd ..;
+ fi
+ cd ..
fi
done
}
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 11:52:19
|
Progress towards a MinGW package. Includes Wesley's patch from a
couple of weeks back, except for all the slash<->backslash changes in
Makefiles. I guess those should be kept as a separate patch, perhaps
in package/mingw/, that can be applied to switch to Makefiles usable
on MinGW.
----------------------------------------------------------------------
U mlton/trunk/Makefile
U mlton/trunk/bin/add-cross
U mlton/trunk/mlton/Makefile
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/runtime/platform/mingw.c
U mlton/trunk/runtime/platform/mingw.h
----------------------------------------------------------------------
Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/Makefile 2005-11-04 19:52:16 UTC (rev 4149)
@@ -19,6 +19,11 @@
RUN = $(SRC)/runtime
MLTON = $(BIN)/mlton
AOUT = mlton-compile
+ifeq (mingw, $(TARGET_OS))
+EXE = .exe
+else
+EXE =
+endif
MLBPATHMAP = $(LIB)/mlb-path-map
TARGETMAP = $(LIB)/target-map
SPEC = package/rpm/mlton.spec
@@ -46,7 +51,7 @@
# stubs. Remove $(AOUT) so that the $(MAKE) compiler below will
# remake MLton.
ifeq (other, $(shell if [ ! -x $(BIN)/mlton ]; then echo other; fi))
- rm -f $(COMP)/$(AOUT)
+ rm -f $(COMP)/$(AOUT)$(EXE)
endif
$(MAKE) script mlbpathmap targetmap constants compiler world libraries tools
@echo 'Build of MLton succeeded.'
@@ -92,7 +97,7 @@
.PHONY: compiler
compiler:
$(MAKE) -C $(COMP)
- $(CP) $(COMP)/$(AOUT) $(LIB)/
+ $(CP) $(COMP)/$(AOUT)$(EXE) $(LIB)/
.PHONY: constants
constants:
@@ -300,7 +305,11 @@
$(MAKE) -C $(NLFFIGEN)
$(MAKE) -C $(PROF)
$(MAKE) -C $(YACC)
- $(CP) $(LEX)/$(LEX) $(NLFFIGEN)/$(NLFFIGEN) $(PROF)/$(PROF) $(YACC)/$(YACC) $(BIN)/
+ $(CP) $(LEX)/$(LEX)$(EXE) \
+ $(NLFFIGEN)/$(NLFFIGEN)$(EXE) \
+ $(PROF)/$(PROF)$(EXE) \
+ $(YACC)/$(YACC)$(EXE) \
+ $(BIN)/
.PHONY: version
version:
@@ -321,7 +330,7 @@
world-no-check:
@echo 'Making world.'
$(MAKE) basis-no-check
- $(LIB)/$(AOUT) @MLton -- $(LIB)/world
+ $(LIB)/$(AOUT)$(EXE) @MLton -- $(LIB)/world
.PHONY: world
world:
Modified: mlton/trunk/bin/add-cross
===================================================================
--- mlton/trunk/bin/add-cross 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/bin/add-cross 2005-11-04 19:52:16 UTC (rev 4149)
@@ -89,8 +89,19 @@
mmake TARGET=$crossTarget TARGET_ARCH=$crossArch TARGET_OS=$crossOS \
mlbpathmap targetmap )
+case "$crossOS" in
+mingw)
+ suf='.exe'
+;;
+*)
+ suf=''
+;;
+esac
case "$crossOS" in
+mingw)
+ libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
+;;
solaris)
libs='-lrt -lnsl -lsocket'
;;
@@ -103,5 +114,5 @@
ssh $machine "cd $tmp/runtime &&
cat >$exe.c &&
gcc -I. -o $exe $exe.c libmlton.a -lgmp -lm $libs"
-ssh $machine "$tmp/runtime/$exe" >"$lib/$crossTarget/constants"
+ssh $machine "$tmp/runtime/$exe$suf" >"$lib/$crossTarget/constants"
ssh $machine "rm -rf $tmp"
Modified: mlton/trunk/mlton/Makefile
===================================================================
--- mlton/trunk/mlton/Makefile 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/mlton/Makefile 2005-11-04 19:52:16 UTC (rev 4149)
@@ -9,6 +9,7 @@
SRC = $(shell cd .. && pwd)
BUILD = $(SRC)/build
BIN = $(BUILD)/bin
+HOST_OS = $(shell $(SRC)/bin/host-os)
LIB = $(BUILD)/lib
MLTON = mlton
TARGET = self
@@ -23,16 +24,21 @@
FILE = mlton.mlb
FLAGS += -default-ann 'sequenceNonUnit warn'
else
-ifeq (cygwin, $(shell $(SRC)/bin/host-os))
+ifeq (cygwin, $(HOST_OS))
# The stubs don't work on Cygwin, since they define spawn in terms of
# fork, and fork doesn't work on Cygwin. So, make without the stubs.
FILE = mlton.cm
else
+ifeq (mingw, $(HOST_OS))
+ # Ditto for MinGW.
+ FILE = mlton.cm
+else
# We're compiling MLton with an older version of itself, so use the stubs for
# the MLton structure.
FILE = mlton-stubs.cm
endif
endif
+endif
ifeq (new,$(shell PATH=$(BIN):$$PATH; mlton -target self >/dev/null 2>&1 && echo new))
FLAGS += -target $(TARGET)
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/mlton/main/main.fun 2005-11-04 19:52:16 UTC (rev 4149)
@@ -69,7 +69,9 @@
Promise.lazy
(fn () =>
List.map
- (File.lines (concat [!Control.libDir, "/target-map"]), fn line =>
+ (File.lines (OS.Path.joinDirFile {dir = !Control.libDir,
+ file = "target-map"}),
+ fn line =>
case String.tokens (line, Char.isSpace) of
[target, arch, os] =>
let
@@ -542,7 +544,7 @@
case target of
Cross s => s
| Self => "self"
- val _ = libTargetDir := concat [!libDir, "/", targetStr]
+ val _ = libTargetDir := OS.Path.concat (!libDir, targetStr)
val targetArch = !targetArch
val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
val targetOS = !targetOS
@@ -712,7 +714,7 @@
fun temp (suf: string): File.t =
let
val (f, out) =
- File.temp {prefix = concat [tmpDir, "/file"],
+ File.temp {prefix = OS.Path.concat (tmpDir, "file"),
suffix = suf}
val _ = Out.close out
val _ = List.push (tempFiles, f)
Modified: mlton/trunk/runtime/platform/mingw.c
===================================================================
--- mlton/trunk/runtime/platform/mingw.c 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/runtime/platform/mingw.c 2005-11-04 19:52:16 UTC (rev 4149)
@@ -489,6 +489,13 @@
die ("kill not implemented");
}
+int nanosleep (const struct timespec *req, struct timespec *rem) {
+ Sleep (req->tv_sec * 1000 + (req->tv_nsec + 999) / 1000);
+ rem->tv_nsec = 0;
+ rem->tv_sec = 0;
+ return 0;
+}
+
int pause (void) {
die ("pause not implemented");
}
Modified: mlton/trunk/runtime/platform/mingw.h
===================================================================
--- mlton/trunk/runtime/platform/mingw.h 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/runtime/platform/mingw.h 2005-11-04 19:52:16 UTC (rev 4149)
@@ -302,6 +302,11 @@
pid_t fork (void);
int kill (pid_t pid, int sig);
int pause (void);
+struct timespec {
+ time_t tv_sec;
+ long tv_nsec;
+};
+int nanosleep (const struct timespec *req, struct timespec *rem);
unsigned int sleep (unsigned int seconds);
pid_t wait (int *status);
pid_t waitpid (pid_t pid, int *status, int options);
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 09:45:18
|
Put darwin package in /usr/local, not /usr. ---------------------------------------------------------------------- U mlton/trunk/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/Makefile =================================================================== --- mlton/trunk/Makefile 2005-11-04 05:17:15 UTC (rev 4147) +++ mlton/trunk/Makefile 2005-11-04 17:45:17 UTC (rev 4148) @@ -337,6 +337,9 @@ # puts them. DESTDIR = $(CURDIR)/install PREFIX = /usr +ifeq ($(TARGET_OS), darwin) +PREFIX = /usr/local +endif ifeq ($(TARGET_OS), solaris) PREFIX = /usr/local endif |
|
From: Stephen W. <sw...@ml...> - 2005-11-03 21:17:17
|
Only allow the fpclassify (feround) #ifdef's if not HAS_FPCLASSIFY (HAS_FEROUND). ---------------------------------------------------------------------- U mlton/trunk/runtime/platform.h ---------------------------------------------------------------------- Modified: mlton/trunk/runtime/platform.h =================================================================== --- mlton/trunk/runtime/platform.h 2005-11-04 05:15:34 UTC (rev 4146) +++ mlton/trunk/runtime/platform.h 2005-11-04 05:17:15 UTC (rev 4147) @@ -166,6 +166,7 @@ #define EXECVE execve #endif +#if not HAS_FEROUND #ifndef FE_TONEAREST #define FE_TONEAREST 0 #endif @@ -178,8 +179,9 @@ #ifndef FE_TOWARDZERO #define FE_TOWARDZERO 3 #endif +#endif - +#if not HAS_FPCLASSIFY #ifndef FP_INFINITE #define FP_INFINITE 1 #endif @@ -195,6 +197,7 @@ #ifndef FP_ZERO #define FP_ZERO 2 #endif +#endif /* If HAS_TIME_PROFILING, then you must define these. */ void *getTextStart (); |
|
From: Stephen W. <sw...@ml...> - 2005-11-03 21:15:35
|
For some stupid reason 'ls' on Darwin returns zero exit status when
there are no files matching a pattern, unlike every other system, so I
switched to a different method.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-04 03:52:55 UTC (rev 4145)
+++ mlton/trunk/bin/regression 2005-11-04 05:15:34 UTC (rev 4146)
@@ -161,7 +161,7 @@
# latter will include other files, e.g. for finalize,
# it will also include finalize.2.
files="$f.[0-9].[cS]"
- if ls $f.[0-9][0-9].[cS] >/dev/null 2>&1; then
+ if [ 0 -ne `ls $f.[0-9][0-9].[cS] 2>/dev/null | wc -l` ]; then
files="$files $f.[0-9][0-9].[cS]"
fi
gcc -o $f -w -O1 \
|
|
From: Matthew F. <fl...@ml...> - 2005-11-03 19:53:16
|
Yet more cleanup
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/switch-thread.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/switch-thread.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-11-04 03:52:55 UTC (rev 4145)
@@ -88,6 +88,7 @@
copy-thread.c \
current.c \
dfs-mark.c \
+ done.c \
enter_leave.c \
foreach.c \
forward.c \
@@ -95,30 +96,33 @@
garbage-collection.c \
gc_state.c \
generational.c \
+ handler.c \
hash-cons.c \
heap.c \
heap_predicates.c \
+ init-world.c \
+ init.c \
invariant.c \
mark-compact.c \
model.c \
model_predicates.c \
new-object.c \
+ object-size.c \
object.c \
- object-size.c \
pack.c \
pointer.c \
pointer_predicates.c \
+ profiling.c \
share.c \
+ signals.c \
size.c \
stack.c \
stack_predicates.c \
+ switch-thread.c \
thread.c \
translate.c \
weak.c \
world.c \
- profiling.c \
- init.c \
- done.c \
assumptions.c \
gc_suffix.c
@@ -138,38 +142,41 @@
stack.h \
thread.h \
weak.h \
+ int-inf.h \
object-size.h \
- int-inf.h \
+ generational.h \
heap.h \
- major.h \
- generational.h \
current.h \
foreach.h \
- statistics.h \
+ translate.h \
sysvals.h \
- ratios.h \
controls.h \
+ major.h \
+ statistics.h \
forward.h \
cheney-copy.h \
hash-cons.h \
- profiling.h \
- signals.h \
- world.h \
- init.h \
- gc_state.h \
- translate.h \
+ dfs-mark.h \
+ mark-compact.h \
+ invariant.h \
atomic.h \
- invariant.h \
enter_leave.h \
- dfs-mark.h \
- mark-compact.h \
+ signals.h \
+ handler.h \
+ switch-thread.h \
+ garbage-collection.h \
new-object.h \
- garbage-collection.h \
array-allocate.h \
+ profiling.h \
+ init-world.h \
+ world.h \
+ init.h \
+ done.h \
copy-thread.h \
pack.h \
share.h \
size.h \
+ gc_state.h \
gc_suffix.h
all: libgc.o libgc-gdb.o
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-04 03:52:55 UTC (rev 4145)
@@ -18,3 +18,5 @@
* the "skipObjects" loop in forwardInterGenerationalObjptrs appears to
be unnecessary.
* Why do {load,save}Globals differ in the representation of the file?
+* Why does hash-table use malloc/free while generational maps use mmap/munmap?
+
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -42,9 +42,11 @@
/*uintToCommaString*/(arraySize),
/*uintToCommaString*/(ensureBytesFree));
if (arraySize >= s->controls.oldGenArraySize) {
- enter (s);
- doGC (s, arraySize, ensureBytesFree, FALSE, TRUE);
- leave (s);
+ if (not hasHeapBytesFree (s, arraySize, ensureBytesFree)) {
+ enter (s);
+ performGC (s, arraySize, ensureBytesFree, FALSE, TRUE);
+ leave (s);
+ }
frontier = s->heap.start + s->heap.oldGenSize;
last = frontier + arraySize;
s->heap.oldGenSize += arraySize;
@@ -53,9 +55,9 @@
size_t bytesRequested;
bytesRequested = arraySize + ensureBytesFree;
- if (bytesRequested > (size_t)(s->limitPlusSlop - s->frontier)) {
+ if (not hasHeapBytesFree (s, 0, bytesRequested)) {
enter (s);
- doGC (s, 0, bytesRequested, FALSE, TRUE);
+ performGC (s, 0, bytesRequested, FALSE, TRUE);
leave (s);
}
frontier = s->frontier;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -42,3 +42,27 @@
GC_arrayCounter getArrayCounter (pointer a) {
return *(getArrayCounterp (a));
}
+
+pointer indexArrayAtPointerIndex (GC_state s, pointer a,
+ GC_arrayCounter arrayIndex,
+ uint32_t pointerIndex) {
+ GC_header header;
+ uint16_t numNonObjptrs;
+ uint16_t numObjptrs;
+ GC_objectTypeTag tag;
+
+ header = getHeader (a);
+ splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ assert (tag == ARRAY_TAG);
+
+ size_t nonObjptrBytesPerElement =
+ sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
+ size_t bytesPerElement =
+ nonObjptrBytesPerElement
+ + (numObjptrs * OBJPTR_SIZE);
+
+ return a
+ + arrayIndex * bytesPerElement
+ + nonObjptrBytesPerElement
+ + pointerIndex * OBJPTR_SIZE;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -32,3 +32,6 @@
GC_arrayLength getArrayLength (pointer a);
GC_arrayCounter* getArrayCounterp (pointer a);
GC_arrayCounter getArrayCounter (pointer a);
+pointer indexArrayAtPointerIndex (GC_state s, pointer a,
+ GC_arrayCounter arrayIndex,
+ uint32_t pointerIndex);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -103,7 +103,7 @@
if (DEBUG_GENERATIONAL)
fprintf (stderr, "minorGC nursery = "FMTPTR" frontier = "FMTPTR"\n",
(uintptr_t)s->heap.nursery, (uintptr_t)s->frontier);
- assert (invariant (s));
+ assert (invariantForGC (s));
bytesAllocated = s->frontier - s->heap.nursery;
if (bytesAllocated == 0)
return;
@@ -122,7 +122,7 @@
fprintf (stderr, "toStart = "FMTPTR"\n", (uintptr_t)s->forwardState.toStart);
assert (isAlignedFrontier (s, s->forwardState.toStart));
s->forwardState.toLimit = s->forwardState.toStart + bytesAllocated;
- assert (invariant (s));
+ assert (invariantForGC (s));
s->cumulativeStatistics.numMinorGCs++;
s->lastMajorStatistics.numMinorGCs++;
s->forwardState.back = s->forwardState.toStart;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -14,5 +14,6 @@
return
DEBUG
or s->controls.summary
- or s->controls.messages;
+ or s->controls.messages
+ or s->controls.rusageMeasureGC;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,6 +6,32 @@
* See the file MLton-LICENSE for details.
*/
+struct GC_ratios {
+ /* Minimum live ratio to use copying GC. */
+ float copy;
+ /* Only use generational GC with copying collection if the ratio of
+ * heap size to live data size is below copyGenerational.
+ */
+ float copyGenerational;
+ float grow;
+ float hashCons;
+ /* Desired ratio of heap size to live data. */
+ float live;
+ /* Minimum live ratio to us mark-compact GC. */
+ float markCompact;
+ /* Only use generational GC with mark-compact collection if the
+ * ratio of heap size to live data size is below
+ * markCompactGenerational.
+ */
+ float markCompactGenerational;
+ /* As long as the ratio of bytes live to nursery size is greater
+ * than nurseryRatio, use minor GCs.
+ */
+ float nursery;
+ float ramSlop;
+ float threadShrink;
+};
+
struct GC_controls {
size_t fixedHeap; /* If 0, then no fixed heap. */
size_t maxHeap; /* if zero, then unlimited, else limit total heap */
@@ -14,6 +40,7 @@
bool messages; /* Print a message at the start and end of each gc. */
size_t oldGenArraySize; /* Arrays larger are allocated in old gen, if possible. */
struct GC_ratios ratios;
+ bool rusageMeasureGC;
bool summary; /* Print a summary of gc info when program exits. */
};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,24 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-GC_thread newThread (GC_state s, size_t reserved) {
- GC_stack stack;
- GC_thread thread;
-
- ensureFree (s, sizeofStackWithHeaderAligned (s, reserved) + sizeofThread (s));
- stack = newStack (s, reserved, FALSE);
- thread = (GC_thread) newObject (s, GC_THREAD_HEADER,
- sizeofThread (s),
- FALSE);
- thread->bytesNeeded = 0;
- thread->exnStack = BOGUS_EXN_STACK;
- thread->stack = pointerToObjptr((pointer)stack, s->heap.start);
- if (DEBUG_THREADS)
- fprintf (stderr, FMTPTR" = newThreadOfSize (%zu)\n",
- (uintptr_t)thread, reserved);;
- return thread;
-}
-
GC_thread copyThread (GC_state s, GC_thread from, size_t size) {
GC_thread to;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,7 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-GC_thread newThread (GC_state s, size_t stackSize);
GC_thread copyThread (GC_state s, GC_thread from, size_t size);
void GC_copyCurrentThread (GC_state s);
pointer GC_copyThread (GC_state s, pointer p);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -10,46 +10,22 @@
/* Depth-first Marking */
/* ---------------------------------------------------------------- */
-bool isMarked (pointer p) {
+bool isPointerMarked (pointer p) {
return MARK_MASK & getHeader (p);
}
-bool isMarkedMode (GC_markMode m, pointer p) {
+bool isPointerMarkedByMode (pointer p, GC_markMode m) {
switch (m) {
case MARK_MODE:
- return isMarked (p);
+ return isPointerMarked (p);
case UNMARK_MODE:
- return not isMarked (p);
+ return not isPointerMarked (p);
default:
die ("bad mark mode %u", m);
}
}
-pointer arrayIndexAtPointer (GC_state s, pointer a,
- GC_arrayCounter arrayIndex,
- uint32_t pointerIndex) {
- GC_header header;
- uint16_t numNonObjptrs;
- uint16_t numObjptrs;
- GC_objectTypeTag tag;
-
- header = getHeader (a);
- splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
- assert (tag == ARRAY_TAG);
-
- size_t nonObjptrBytesPerElement =
- sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
- size_t bytesPerElement =
- nonObjptrBytesPerElement
- + (numObjptrs * OBJPTR_SIZE);
-
- return a
- + arrayIndex * bytesPerElement
- + nonObjptrBytesPerElement
- + pointerIndex * OBJPTR_SIZE;
-}
-
-/* dfsMark (s, r, m, shc)
+/* dfsMarkByMode (s, r, m, shc)
*
* Sets all the mark bits in the object graph pointed to by r.
*
@@ -60,8 +36,8 @@
*
* It returns the total size in bytes of the objects marked.
*/
-size_t dfsMark (GC_state s, pointer root,
- GC_markMode mode, bool shouldHashCons) {
+size_t dfsMarkByMode (GC_state s, pointer root,
+ GC_markMode mode, bool shouldHashCons) {
GC_header mark; /* Used to set or clear the mark bit. */
size_t size; /* Total number of bytes marked. */
pointer cur; /* The current object being marked. */
@@ -82,7 +58,7 @@
GC_frameLayout frameLayout;
GC_frameOffsets frameOffsets;
- if (isMarkedMode (mode, root))
+ if (isPointerMarkedByMode (root, mode))
/* Object has already been marked. */
return 0;
mark = (MARK_MODE == mode) ? MARK_MASK : 0;
@@ -107,7 +83,7 @@
" prev = "FMTPTR" todo = "FMTPTR"\n",
(uintptr_t)cur, (uintptr_t)next,
(uintptr_t)prev, (uintptr_t)todo);
- assert (not isMarkedMode (mode, next));
+ assert (not isPointerMarkedByMode (next, mode));
assert (nextHeaderp == getHeaderp (next));
assert (nextHeader == getHeader (next));
// assert (*(pointer*) todo == next);
@@ -128,7 +104,7 @@
* headerp points to the header of cur.
* header is the header of cur.
*/
- assert (not isMarkedMode (mode, cur));
+ assert (not isPointerMarkedByMode (cur, mode));
assert (header == getHeader (cur));
assert (headerp == getHeaderp (cur));
header ^= MARK_MASK;
@@ -215,14 +191,14 @@
arrayIndex, index);
assert (arrayIndex < getArrayLength (cur));
assert (index < numObjptrs);
- assert (todo == arrayIndexAtPointer (s, cur, arrayIndex, index));
+ assert (todo == indexArrayAtPointerIndex (s, cur, arrayIndex, index));
// next = *(pointer*)todo;
next = fetchObjptrToPointer (todo, s->heap.start);
if (not (isPointer(next))) {
markNextInArray:
assert (arrayIndex < getArrayLength (cur));
assert (index < numObjptrs);
- assert (todo == arrayIndexAtPointer (s, cur, arrayIndex, index));
+ assert (todo == indexArrayAtPointerIndex (s, cur, arrayIndex, index));
todo += OBJPTR_SIZE;
index++;
if (index < numObjptrs)
@@ -305,7 +281,7 @@
if (DEBUG_MARK_COMPACT)
fprintf (stderr, "return cur = "FMTPTR" prev = "FMTPTR"\n",
(uintptr_t)cur, (uintptr_t)prev);
- assert (isMarkedMode (mode, cur));
+ assert (isPointerMarkedByMode (cur, mode));
if (NULL == prev)
return size;
next = cur;
@@ -356,23 +332,23 @@
assert (FALSE);
}
-void dfsMarkTrue (GC_state s, objptr *opp) {
+void dfsMarkWithHashCons (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- dfsMark (s, p, MARK_MODE, TRUE);
+ dfsMarkByMode (s, p, MARK_MODE, TRUE);
}
-void dfsMarkFalse (GC_state s, objptr *opp) {
+void dfsMarkWithoutHashCons (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- dfsMark (s, p, MARK_MODE, FALSE);
+ dfsMarkByMode (s, p, MARK_MODE, FALSE);
}
void dfsUnmark (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- dfsMark (s, p, UNMARK_MODE, FALSE);
+ dfsMarkByMode (s, p, UNMARK_MODE, FALSE);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -11,14 +11,10 @@
UNMARK_MODE,
} GC_markMode;
-bool isMarked (pointer p);
-bool isMarkedMode (GC_markMode m, pointer p);
-pointer arrayIndexAtPointer (GC_state s,
- pointer a,
- GC_arrayCounter arrayIndex,
- uint32_t pointerIndex);
-size_t dfsMark (GC_state s, pointer root,
- GC_markMode mode, bool shouldHashCons);
-void dfsMarkTrue (GC_state s, objptr *opp);
-void dfsMarkFalse (GC_state s, objptr *opp);
+bool isPointerMarked (pointer p);
+bool isPointerMarkedByMode (pointer p, GC_markMode m);
+size_t dfsMarkByMode (GC_state s, pointer root,
+ GC_markMode mode, bool shouldHashCons);
+void dfsMarkWithHashCons (GC_state s, objptr *opp);
+void dfsMarkWithoutHashCons (GC_state s, objptr *opp);
void dfsUnmark (GC_state s, objptr *opp);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,9 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+void GC_done (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -20,7 +20,7 @@
if (DEBUG)
displayGCState (s, stderr);
beginAtomic (s);
- assert (invariant (s));
+ assert (invariantForGC (s));
if (DEBUG)
fprintf (stderr, "enter ok\n");
}
@@ -31,7 +31,7 @@
/* The mutator frontier invariant may not hold
* for functions that don't ensureBytesFree.
*/
- assert (mutatorInvariant (s, FALSE, TRUE));
+ assert (invariantForMutator (s, FALSE, TRUE));
endAtomic (s);
if (DEBUG)
fprintf (stderr, "leave ok\n");
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -47,6 +47,21 @@
assert (s->heap.oldGenSize + bytesRequested <= s->heap.size);
}
+void growStackCurrent (GC_state s) {
+ size_t size;
+ GC_stack stack;
+
+ size = sizeofStackGrow (s, getStackCurrent(s));
+ if (DEBUG_STACKS or s->controls.messages)
+ fprintf (stderr, "Growing stack to size %zu.\n",
+ /*uintToCommaString*/(sizeofStackWithHeaderAligned (s, size)));
+ assert (hasHeapBytesFree (s, sizeofStackWithHeaderAligned (s, size), 0));
+ stack = newStack (s, size, TRUE);
+ copyStack (s, getStackCurrent(s), stack);
+ getThreadCurrent(s)->stack = pointerToObjptr ((pointer)stack, s->heap.start);
+ markCard (s, objptrToPointer (getThreadCurrentObjptr(s), s->heap.start));
+}
+
void enterGC (GC_state s) {
if (s->profiling.isOn) {
/* We don't need to profileEnter for count profiling because it
@@ -69,11 +84,11 @@
s->amInGC = FALSE;
}
-void doGC (GC_state s,
- size_t oldGenBytesRequested,
- size_t nurseryBytesRequested,
- bool forceMajor,
- bool mayResize) {
+void performGC (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested,
+ bool forceMajor,
+ bool mayResize) {
uintmax_t gcTime;
bool stackTopOk;
size_t stackBytesRequested;
@@ -85,11 +100,11 @@
fprintf (stderr, "Starting gc. Request %zu nursery bytes and %zu old gen bytes.\n",
/*uintToCommaString*/(nurseryBytesRequested),
/*uintToCommaString*/(oldGenBytesRequested));
- assert (invariant (s));
+ assert (invariantForGC (s));
if (needGCTime (s))
startTiming (&ru_start);
minorGC (s);
- stackTopOk = mutatorStackInvariant (s);
+ stackTopOk = invariantForMutatorStack (s);
stackBytesRequested =
stackTopOk
? 0
@@ -106,7 +121,7 @@
assert (hasHeapBytesFree (s, oldGenBytesRequested + stackBytesRequested,
nurseryBytesRequested));
unless (stackTopOk)
- growStack (s);
+ growStackCurrent (s);
setGCStateCurrentThreadAndStack (s);
if (needGCTime (s)) {
gcTime = stopTiming (&ru_start, &s->cumulativeStatistics.ru_gc);
@@ -134,133 +149,33 @@
if (DEBUG)
displayGCState (s, stderr);
assert (hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
- assert (invariant (s));
+ assert (invariantForGC (s));
leaveGC (s);
}
-void ensureMutatorInvariant (GC_state s, bool force) {
+void ensureInvariantForMutator (GC_state s, bool force) {
if (force
- or not (mutatorFrontierInvariant(s))
- or not (mutatorStackInvariant(s))) {
+ or not (invariantForMutatorFrontier(s))
+ or not (invariantForMutatorStack(s))) {
/* This GC will grow the stack, if necessary. */
- doGC (s, 0, getThreadCurrent(s)->bytesNeeded, force, TRUE);
+ performGC (s, 0, getThreadCurrent(s)->bytesNeeded, force, TRUE);
}
- assert (mutatorFrontierInvariant(s));
- assert (mutatorStackInvariant(s));
+ assert (invariantForMutatorFrontier(s));
+ assert (invariantForMutatorStack(s));
}
-/* ensureFree (s, b) ensures that upon return
- * b <= s->limitPlusSlop - s->frontier
+/* ensureHasHeapBytesFree (s, oldGen, nursery)
*/
-void ensureFree (GC_state s, size_t bytesRequested) {
+void ensureHasHeapBytesFree (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested) {
+ assert (s->heap.nursery <= s->limitPlusSlop);
assert (s->frontier <= s->limitPlusSlop);
- if (bytesRequested > (size_t)(s->limitPlusSlop - s->frontier))
- doGC (s, 0, bytesRequested, FALSE, TRUE);
- assert (bytesRequested <= (size_t)(s->limitPlusSlop - s->frontier));
+ if (not hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested))
+ performGC (s, oldGenBytesRequested, nurseryBytesRequested, FALSE, TRUE);
+ assert (hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
}
-void switchToThread (GC_state s, objptr op) {
- if (DEBUG_THREADS) {
- GC_thread thread;
- GC_stack stack;
-
- thread = (GC_thread)(objptrToPointer (op, s->heap.start));
- stack = (GC_stack)(objptrToPointer (thread->stack, s->heap.start));
-
- fprintf (stderr, "switchToThread ("FMTOBJPTR") used = %zu reserved = %zu\n",
- op, stack->used, stack->reserved);
- }
- s->currentThread = op;
- setGCStateCurrentThreadAndStack (s);
-}
-
-/* GC_startHandler does not do an enter()/leave(), even though it is
- * exported. The basis library uses it via _import, not _prim, and so
- * does not treat it as a runtime call -- so the invariant in enter
- * would fail miserably. It is OK because GC_startHandler must be
- * called from within a critical section.
- *
- * Don't make it inline, because it is also called in basis/Thread.c,
- * and when compiling with COMPILE_FAST, they may appear out of order.
- */
-void GC_startHandler (GC_state s) {
- /* Switch to the signal handler thread. */
- if (DEBUG_SIGNALS) {
- fprintf (stderr, "GC_startHandler\n");
- }
- assert (s->atomicState == 1);
- assert (s->signalsInfo.signalIsPending);
- s->signalsInfo.signalIsPending = FALSE;
- s->signalsInfo.amInSignalHandler = TRUE;
- s->savedThread = s->currentThread;
- /* Set s->atomicState to 2 when switching to the signal handler
- * thread; leaving the runtime will decrement s->atomicState to 1,
- * the signal handler will then run atomically and will finish by
- * switching to the thread to continue with, which will decrement
- * s->atomicState to 0.
- */
- s->atomicState = 2;
-}
-
-void GC_finishHandler (GC_state s) {
- if (DEBUG_SIGNALS)
- fprintf (stderr, "GC_finishHandler ()\n");
- assert (s->atomicState == 1);
- s->signalsInfo.amInSignalHandler = FALSE;
-}
-
-void maybeSwitchToHandler (GC_state s) {
- if (s->atomicState == 1
- and s->signalsInfo.signalIsPending) {
- GC_startHandler (s);
- switchToThread (s, s->signalHandlerThread);
- }
-}
-
-void GC_switchToThread (GC_state s, GC_thread t, size_t ensureBytesFree) {
- if (DEBUG_THREADS)
- fprintf (stderr, "GC_switchToThread ("FMTPTR", %zu)\n",
- (uintptr_t)t, ensureBytesFree);
- if (FALSE) {
- /* This branch is slower than the else branch, especially
- * when debugging is turned on, because it does an invariant
- * check on every thread switch.
- * So, we'll stick with the else branch for now.
- */
- enter (s);
- getThreadCurrent(s)->bytesNeeded = ensureBytesFree;
- switchToThread (s, pointerToObjptr((pointer)t, s->heap.start));
- s->atomicState--;
- maybeSwitchToHandler (s);
- ensureMutatorInvariant (s, FALSE);
- assert (mutatorFrontierInvariant(s));
- assert (mutatorStackInvariant(s));
- leave (s);
- } else {
- /* BEGIN: enter(s); */
- getStackCurrent(s)->used = sizeofGCStateCurrentStackUsed (s);
- getThreadCurrent(s)->exnStack = s->exnStack;
- beginAtomic (s);
- /* END: enter(s); */
- getThreadCurrent(s)->bytesNeeded = ensureBytesFree;
- switchToThread (s, pointerToObjptr((pointer)t, s->heap.start));
- s->atomicState--;
- maybeSwitchToHandler (s);
- /* BEGIN: ensureMutatorInvariant */
- if (not (mutatorFrontierInvariant(s))
- or not (mutatorStackInvariant(s))) {
- /* This GC will grow the stack, if necessary. */
- doGC (s, 0, getThreadCurrent(s)->bytesNeeded, FALSE, TRUE);
- }
- /* END: ensureMutatorInvariant */
- /* BEGIN: leave(s); */
- endAtomic (s);
- /* END: leave(s); */
- }
- assert (mutatorFrontierInvariant(s));
- assert (mutatorStackInvariant(s));
-}
-
void GC_gc (GC_state s, size_t bytesRequested, bool force,
char *file, int line) {
if (DEBUG or s->controls.messages)
@@ -272,9 +187,9 @@
if (0 == bytesRequested)
bytesRequested = GC_HEAP_LIMIT_SLOP;
getThreadCurrent(s)->bytesNeeded = bytesRequested;
- maybeSwitchToHandler (s);
- ensureMutatorInvariant (s, force);
- assert (mutatorFrontierInvariant(s));
- assert (mutatorStackInvariant(s));
+ switchToHandlerThreadIfNonAtomicAndSignalPending (s);
+ ensureInvariantForMutator (s, force);
+ assert (invariantForMutatorFrontier(s));
+ assert (invariantForMutatorStack(s));
leave (s);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -8,19 +8,17 @@
void minorGC (GC_state s);
void majorGC (GC_state s, size_t bytesRequested, bool mayResize);
+void growStackCurrent (GC_state s);
void enterGC (GC_state s);
void leaveGC (GC_state s);
-void doGC (GC_state s,
- size_t oldGenBytesRequested,
- size_t nurseryBytesRequested,
- bool forceMajor,
- bool mayResize);
-void ensureMutatorInvariant (GC_state s, bool force);
-void ensureFree (GC_state s, size_t bytesRequested);
-void switchToThread (GC_state s, objptr op);
-void GC_startHandler (GC_state s);
-void GC_finishHandler (GC_state s);
-void maybeSwitchToHandler (GC_state s);
-void GC_switchToThread (GC_state s, GC_thread t, size_t ensureBytesFree);
+void performGC (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested,
+ bool forceMajor,
+ bool mayResize);
+void ensureInvariantForMutator (GC_state s, bool force);
+void ensureHasHeapBytesFree (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested);
void GC_gc (GC_state s, size_t bytesRequested, bool force,
char *file, int line);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.c (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,68 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+/* GC_startHandler does not do an enter()/leave(), even though it is
+ * exported. The basis library uses it via _import, not _prim, and so
+ * does not treat it as a runtime call -- so the invariant in enter
+ * would fail miserably. It is OK because GC_startHandler must be
+ * called from within a critical section.
+ *
+ * Don't make it inline, because it is also called in basis/Thread.c,
+ * and when compiling with COMPILE_FAST, they may appear out of order.
+ */
+void GC_startHandler (GC_state s) {
+ /* Switch to the signal handler thread. */
+ if (DEBUG_SIGNALS) {
+ fprintf (stderr, "GC_startHandler\n");
+ }
+ assert (s->atomicState == 1);
+ assert (s->signalsInfo.signalIsPending);
+ s->signalsInfo.signalIsPending = FALSE;
+ s->signalsInfo.amInSignalHandler = TRUE;
+ s->savedThread = s->currentThread;
+ /* Set s->atomicState to 2 when switching to the signal handler
+ * thread; leaving the runtime will decrement s->atomicState to 1,
+ * the signal handler will then run atomically and will finish by
+ * switching to the thread to continue with, which will decrement
+ * s->atomicState to 0.
+ */
+ s->atomicState = 2;
+}
+
+void GC_finishHandler (GC_state s) {
+ if (DEBUG_SIGNALS)
+ fprintf (stderr, "GC_finishHandler ()\n");
+ assert (s->atomicState == 1);
+ s->signalsInfo.amInSignalHandler = FALSE;
+}
+
+void switchToHandlerThreadIfNonAtomicAndSignalPending (GC_state s) {
+ if (s->atomicState == 1
+ and s->signalsInfo.signalIsPending) {
+ GC_startHandler (s);
+ switchToThread (s, s->signalHandlerThread);
+ }
+}
+
+/* GC_handler sets s->limit = 0 so that the next limit check will
+ * fail. Signals need to be blocked during the handler (i.e. it
+ * should run atomically) because sigaddset does both a read and a
+ * write of s->signalsInfo.signalsPending. The signals are blocked
+ * by Posix_Signal_handle (see Posix/Signal/Signal.c).
+ */
+void GC_handler (GC_state s, int signum) {
+ if (DEBUG_SIGNALS)
+ fprintf (stderr, "GC_handler signum = %d\n", signum);
+ assert (sigismember (&s->signalsInfo.signalsHandled, signum));
+ if (s->atomicState == 0)
+ s->limit = 0;
+ s->signalsInfo.signalIsPending = TRUE;
+ sigaddset (&s->signalsInfo.signalsPending, signum);
+ if (DEBUG_SIGNALS)
+ fprintf (stderr, "GC_handler done\n");
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,12 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+void GC_startHandler (GC_state s);
+void GC_finishHandler (GC_state s);
+void switchToHandlerThreadIfNonAtomicAndSignalPending (GC_state s);
+void GC_handler (GC_state s, int signum);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,200 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+/* ---------------------------------------------------------------- */
+/* Initialization */
+/* ---------------------------------------------------------------- */
+
+
+size_t sizeofInitialBytesLive (GC_state s) {
+ uint32_t i;
+ size_t numBytes;
+ size_t total;
+
+ total = 0;
+ for (i = 0; i < s->intInfInitsLength; ++i) {
+ numBytes =
+ sizeof(uint32_t) // for the sign
+ + strlen (s->intInfInits[i].mlstr);
+ total += align (GC_ARRAY_HEADER_SIZE
+ + numBytes,
+ s->alignment);
+ }
+ for (i = 0; i < s->vectorInitsLength; ++i) {
+ numBytes =
+ s->vectorInits[i].bytesPerElement
+ * s->vectorInits[i].numElements;
+ total += align (GC_ARRAY_HEADER_SIZE
+ + ((0 == numBytes)
+ ? OBJPTR_SIZE
+ : numBytes),
+ s->alignment);
+ }
+ return total;
+}
+
+void initIntInfs (GC_state s) {
+ struct GC_intInfInit *inits;
+ pointer frontier;
+ char *str;
+ size_t slen, llen;
+ mp_size_t alen;
+ uint32_t i, j;
+ bool neg, hex;
+ GC_intInf bp;
+ unsigned char *cp;
+
+ assert (isAlignedFrontier (s, s->frontier));
+ frontier = s->frontier;
+ for (i= 0; i < s->intInfInitsLength; i++) {
+ inits = &s->intInfInits[i];
+ str = inits->mlstr;
+ assert (inits->globalIndex < s->globalsLength);
+ neg = *str == '~';
+ if (neg)
+ str++;
+ slen = strlen (str);
+ hex = str[0] == '0' && str[1] == 'x';
+ if (hex) {
+ str += 2;
+ slen -= 2;
+ llen = (slen + 7) / 8;
+ } else
+ llen = (slen + 8) / 9;
+ assert (slen > 0);
+ bp = (GC_intInf)frontier;
+ cp = (unsigned char *)&bp->limbs[llen];
+
+ for (j = 0; j != slen; j++)
+ if ('0' <= str[j] && str[j] <= '9')
+ cp[j] = str[j] - '0' + 0;
+ else if ('a' <= str[j] && str[j] <= 'f')
+ cp[j] = str[j] - 'a' + 0xa;
+ else {
+ assert('A' <= str[j] && str[j] <= 'F');
+ cp[j] = str[j] - 'A' + 0xA;
+ }
+ alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, hex ? 0x10 : 10);
+ assert ((size_t)alen <= llen);
+ if (alen <= 1) {
+ uint32_t val, ans;
+
+ if (alen == 0)
+ val = 0;
+ else
+ val = bp->limbs[0];
+ if (neg) {
+ /*
+ * We only fit if val in [1, 2^30].
+ */
+ ans = - val;
+ val = val - 1;
+ } else
+ /*
+ * We only fit if val in [0, 2^30 - 1].
+ */
+ ans = val;
+ if (val < (uint32_t)1<<30) {
+ s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
+ continue;
+ }
+ }
+ s->globals[inits->globalIndex] = pointerToObjptr((pointer)(&bp->isneg), s->heap.start);
+ bp->counter = 0;
+ bp->length = alen + 1;
+ bp->header = buildHeaderFromTypeIndex (WORD32_VECTOR_TYPE_INDEX);
+ bp->isneg = neg;
+ frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
+ }
+ assert (isAlignedFrontier (s, frontier));
+ GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
+ s->frontier = frontier;
+ s->cumulativeStatistics.bytesAllocated += frontier - s->frontier;
+}
+
+void initVectors (GC_state s) {
+ struct GC_vectorInit *inits;
+ pointer frontier;
+ uint32_t i;
+
+ assert (isAlignedFrontier (s, s->frontier));
+ inits = s->vectorInits;
+ frontier = s->frontier;
+ for (i = 0; i < s->vectorInitsLength; i++) {
+ size_t bytesPerElement;
+ size_t dataBytes;
+ size_t objectSize;
+ uint32_t typeIndex;
+
+ bytesPerElement = inits[i].bytesPerElement;
+ dataBytes = bytesPerElement * inits[i].numElements;
+ objectSize = align (GC_ARRAY_HEADER_SIZE
+ + ((0 == dataBytes)
+ ? POINTER_SIZE
+ : dataBytes),
+ s->alignment);
+ assert (objectSize <= (size_t)(s->heap.start + s->heap.size - frontier));
+ *((GC_arrayCounter*)(frontier)) = 0;
+ frontier = frontier + GC_ARRAY_COUNTER_SIZE;
+ *((GC_arrayLength*)(frontier)) = inits[i].numElements;
+ frontier = frontier + GC_ARRAY_LENGTH_SIZE;
+ switch (bytesPerElement) {
+ case 1:
+ typeIndex = WORD8_VECTOR_TYPE_INDEX;
+ break;
+ case 2:
+ typeIndex = WORD16_VECTOR_TYPE_INDEX;
+ break;
+ case 4:
+ typeIndex = WORD32_VECTOR_TYPE_INDEX;
+ break;
+ default:
+ die ("unknown bytes per element in vectorInit: %zu",
+ bytesPerElement);
+ }
+ *((GC_header*)(frontier)) = buildHeaderFromTypeIndex (typeIndex);
+ frontier = frontier + GC_HEADER_SIZE;
+ s->globals[inits[i].globalIndex] = pointerToObjptr(frontier, s->heap.start);
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "allocated vector at "FMTPTR"\n",
+ (uintptr_t)(s->globals[inits[i].globalIndex]));
+ GC_memcpy (inits[i].bytes, frontier, dataBytes);
+ frontier += objectSize - GC_ARRAY_HEADER_SIZE;
+ }
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "frontier after string allocation is "FMTPTR"\n",
+ (uintptr_t)frontier);
+ GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
+ s->cumulativeStatistics.bytesAllocated += (size_t)(frontier - s->frontier);
+ assert (isAlignedFrontier (s, frontier));
+ s->frontier = frontier;
+}
+
+void initWorld (GC_state s) {
+ uint32_t i;
+ pointer start;
+ GC_thread thread;
+
+ for (i = 0; i < s->globalsLength; ++i)
+ s->globals[i] = BOGUS_OBJPTR;
+ s->lastMajorStatistics.bytesLive = sizeofInitialBytesLive (s);
+ createHeap (s, &s->heap,
+ sizeofHeapDesired (s, s->lastMajorStatistics.bytesLive, 0),
+ s->lastMajorStatistics.bytesLive);
+ createCardMapAndCrossMap (s);
+ start = alignFrontier (s, s->heap.start);
+ s->frontier = start;
+ initIntInfs (s);
+ initVectors (s);
+ assert ((size_t)(s->frontier - start) <= s->lastMajorStatistics.bytesLive);
+ s->heap.oldGenSize = s->frontier - s->heap.start;
+ setGCStateCurrentHeap (s, 0, 0);
+ thread = newThread (s, sizeofStackInitial (s));
+ switchToThread (s, pointerToObjptr((pointer)thread, s->heap.start));
+}
+
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,36 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+/* GC_init uses the array of struct intInfInits in s at program start
+ * to allocate intInfs.
+ * The globalIndex'th entry of the globals array in s is set to the
+ * IntInf.int whose value corresponds to the mlstr string.
+ *
+ * The strings pointed to by the mlstr fields consist of
+ * an optional ~
+ * either one or more of [0-9] or
+ * 0x followed by one or more of [0-9a-fA-F]
+ * a trailing EOS
+ */
+struct GC_intInfInit {
+ uint32_t globalIndex;
+ char *mlstr;
+};
+
+/* GC_init allocates a collection of arrays/vectors in the heap. */
+struct GC_vectorInit {
+ pointer bytes;
+ size_t bytesPerElement;
+ uint32_t globalIndex;
+ GC_arrayLength numElements;
+};
+
+size_t sizeofInitialBytesLive (GC_state s);
+void initIntInfs (GC_state s);
+void initVectors (GC_state s);
+void initWorld (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -10,19 +10,6 @@
/* Initialization */
/* ---------------------------------------------------------------- */
-static void initSignalStack (GC_state s) {
-#if HAS_SIGALTSTACK
- static stack_t altstack;
- size_t ss_size = align (SIGSTKSZ, s->sysvals.pageSize);
- size_t psize = s->sysvals.pageSize;
- void *ss_sp = GC_mmap_safe_protect (NULL, 2 * ss_size, psize, psize);
- altstack.ss_sp = (unsigned char*)ss_sp + ss_size;
- altstack.ss_size = ss_size;
- altstack.ss_flags = 0;
- sigaltstack (&altstack, NULL);
-#endif
-}
-
#if FALSE
static bool stringToBool (char *s) {
if (0 == strcmp (s, "false"))
@@ -77,200 +64,14 @@
die ("Invalid @MLton memory amount: %s.", s);
}
-static void setInitialBytesLive (GC_state s) {
- uint32_t i;
- size_t numBytes;
-
- s->lastMajorStatistics.bytesLive = 0;
- for (i = 0; i < s->intInfInitsLength; ++i) {
- numBytes =
- sizeof(uint32_t) // for the sign
- + strlen (s->intInfInits[i].mlstr);
- s->lastMajorStatistics.bytesLive +=
- align (GC_ARRAY_HEADER_SIZE + numBytes,
- s->alignment);
- }
- for (i = 0; i < s->vectorInitsLength; ++i) {
- numBytes =
- s->vectorInits[i].bytesPerElement
- * s->vectorInits[i].numElements;
- s->lastMajorStatistics.bytesLive +=
- align (GC_ARRAY_HEADER_SIZE
- + ((0 == numBytes)
- ? OBJPTR_SIZE
- : numBytes),
- s->alignment);
- }
-}
-
-static void initIntInfs (GC_state s) {
- struct GC_intInfInit *inits;
- pointer frontier;
- char *str;
- size_t slen, llen;
- mp_size_t alen;
- uint32_t i, j;
- bool neg, hex;
- GC_intInf bp;
- unsigned char *cp;
-
- assert (isAlignedFrontier (s, s->frontier));
- frontier = s->frontier;
- for (i= 0; i < s->intInfInitsLength; i++) {
- inits = &s->intInfInits[i];
- str = inits->mlstr;
- assert (inits->globalIndex < s->globalsLength);
- neg = *str == '~';
- if (neg)
- str++;
- slen = strlen (str);
- hex = str[0] == '0' && str[1] == 'x';
- if (hex) {
- str += 2;
- slen -= 2;
- llen = (slen + 7) / 8;
- } else
- llen = (slen + 8) / 9;
- assert (slen > 0);
- bp = (GC_intInf)frontier;
- cp = (unsigned char *)&bp->limbs[llen];
-
- for (j = 0; j != slen; j++)
- if ('0' <= str[j] && str[j] <= '9')
- cp[j] = str[j] - '0' + 0;
- else if ('a' <= str[j] && str[j] <= 'f')
- cp[j] = str[j] - 'a' + 0xa;
- else {
- assert('A' <= str[j] && str[j] <= 'F');
- cp[j] = str[j] - 'A' + 0xA;
- }
- alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, hex ? 0x10 : 10);
- assert ((size_t)alen <= llen);
- if (alen <= 1) {
- uint32_t val, ans;
-
- if (alen == 0)
- val = 0;
- else
- val = bp->limbs[0];
- if (neg) {
- /*
- * We only fit if val in [1, 2^30].
- */
- ans = - val;
- val = val - 1;
- } else
- /*
- * We only fit if val in [0, 2^30 - 1].
- */
- ans = val;
- if (val < (uint32_t)1<<30) {
- s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
- continue;
- }
- }
- s->globals[inits->globalIndex] = pointerToObjptr((pointer)(&bp->isneg), s->heap.start);
- bp->counter = 0;
- bp->length = alen + 1;
- bp->header = buildHeaderFromTypeIndex (WORD32_VECTOR_TYPE_INDEX);
- bp->isneg = neg;
- frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
- }
- assert (isAlignedFrontier (s, frontier));
- GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
- s->frontier = frontier;
- s->cumulativeStatistics.bytesAllocated += frontier - s->frontier;
-}
-
-static void initVectors (GC_state s) {
- struct GC_vectorInit *inits;
- pointer frontier;
- uint32_t i;
-
- assert (isAlignedFrontier (s, s->frontier));
- inits = s->vectorInits;
- frontier = s->frontier;
- for (i = 0; i < s->vectorInitsLength; i++) {
- size_t bytesPerElement;
- size_t dataBytes;
- size_t objectSize;
- uint32_t typeIndex;
-
- bytesPerElement = inits[i].bytesPerElement;
- dataBytes = bytesPerElement * inits[i].numElements;
- objectSize = align (GC_ARRAY_HEADER_SIZE
- + ((0 == dataBytes)
- ? POINTER_SIZE
- : dataBytes),
- s->alignment);
- assert (objectSize <= (size_t)(s->heap.start + s->heap.size - frontier));
- *((GC_arrayCounter*)(frontier)) = 0;
- frontier = frontier + GC_ARRAY_COUNTER_SIZE;
- *((GC_arrayLength*)(frontier)) = inits[i].numElements;
- frontier = frontier + GC_ARRAY_LENGTH_SIZE;
- switch (bytesPerElement) {
- case 1:
- typeIndex = WORD8_VECTOR_TYPE_INDEX;
- break;
- case 2:
- typeIndex = WORD16_VECTOR_TYPE_INDEX;
- break;
- case 4:
- typeIndex = WORD32_VECTOR_TYPE_INDEX;
- break;
- default:
- die ("unknown bytes per element in vectorInit: %zu",
- bytesPerElement);
- }
- *((GC_header*)(frontier)) = buildHeaderFromTypeIndex (typeIndex);
- frontier = frontier + GC_HEADER_SIZE;
- s->globals[inits[i].globalIndex] = pointerToObjptr(frontier, s->heap.start);
- if (DEBUG_DETAILED)
- fprintf (stderr, "allocated vector at "FMTPTR"\n",
- (uintptr_t)(s->globals[inits[i].globalIndex]));
- GC_memcpy (inits[i].bytes, frontier, dataBytes);
- frontier += objectSize - GC_ARRAY_HEADER_SIZE;
- }
- if (DEBUG_DETAILED)
- fprintf (stderr, "frontier after string allocation is "FMTPTR"\n",
- (uintptr_t)frontier);
- GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
- s->cumulativeStatistics.bytesAllocated += (size_t)(frontier - s->frontier);
- assert (isAlignedFrontier (s, frontier));
- s->frontier = frontier;
-}
-
-static void newWorld (GC_state s) {
- uint32_t i;
- pointer start;
- GC_thread thread;
-
- for (i = 0; i < s->globalsLength; ++i)
- s->globals[i] = BOGUS_OBJPTR;
- setInitialBytesLive (s);
- createHeap (s, &s->heap,
- sizeofHeapDesired (s, s->lastMajorStatistics.bytesLive, 0),
- s->lastMajorStatistics.bytesLive);
- createCardMapAndCrossMap (s);
- start = alignFrontier (s, s->heap.start);
- s->frontier = start;
- initIntInfs (s);
- initVectors (s);
- assert ((size_t)(s->frontier - start) <= s->lastMajorStatistics.bytesLive);
- s->heap.oldGenSize = s->frontier - s->heap.start;
- setGCStateCurrentHeap (s, 0, 0);
- thread = newThread (s, sizeofStackInitial (s));
- switchToThread (s, pointerToObjptr((pointer)thread, s->heap.start));
-}
-
/* ---------------------------------------------------------------- */
/* GC_init */
/* ---------------------------------------------------------------- */
bool MLton_Platform_CygwinUseMmap;
-static int processAtMLton (GC_state s, int argc, char **argv,
- char **worldFile) {
+int processAtMLton (GC_state s, int argc, char **argv,
+ char **worldFile) {
int i;
i = 1;
@@ -479,7 +280,7 @@
s->signalsInfo.signalIsPending = FALSE;
sigemptyset (&s->signalsInfo.signalsHandled);
sigemptyset (&s->signalsInfo.signalsPending);
- s->startTime = currentTime ();
+ s->startTime = getCurrentTime ();
// s->sysvals.availRam = ;
// s->sysvals.totalRam = ;
// s->sysvals.pageSize = ;
@@ -497,7 +298,6 @@
unless (s->controls.ratios.markCompact <= s->controls.ratios.copy
and s->controls.ratios.copy <= s->controls.ratios.live)
die ("Ratios must satisfy mark-compact-ratio <= copy-ratio <= live-ratio");
- // s->totalRam = totalRam (s);
/* We align s->ram by pageSize so that we can test whether or not we
* we are using mark-compact by comparing heap size to ram size. If
* we didn't round, the size might be slightly off.
@@ -524,36 +324,18 @@
* command-line arguments, because those may just be doing a show
* prof, in which case we don't want to initialize the atExit.
*/
- if (PROFILE_NONE == s->profiling.kind)
- s->profiling.isOn = FALSE;
- else {
- s->profiling.isOn = TRUE;
- assert (s->profiling.frameSourcesLength == s->frameLayoutsLength);
- switch (s->profiling.kind) {
- case PROFILE_ALLOC:
- case PROFILE_COUNT:
- s->profiling.data = GC_profileNew (s);
- break;
- case PROFILE_NONE:
- die ("impossible PROFILE_NONE");
- case PROFILE_TIME:
- profileTimeInit (s);
- break;
- }
- profileEndState = s;
- atexit (profileEnd);
- }
+ initProfiling (s);
if (s->amOriginal) {
- newWorld (s);
+ initWorld (s);
/* The mutator stack invariant doesn't hold,
* because the mutator has yet to run.
*/
- assert (mutatorInvariant (s, TRUE, FALSE));
+ assert (invariantForMutator (s, TRUE, FALSE));
} else {
loadWorldFromFileName (s, worldFile);
if (s->profiling.isOn and s->profiling.stack)
foreachStackFrame (s, enterFrame);
- assert (mutatorInvariant (s, TRUE, TRUE));
+ assert (invariantForMutator (s, TRUE, TRUE));
}
s->amInGC = FALSE;
return res;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,27 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-
-/* GC_init uses the array of struct intInfInits in s at program start
- * to allocate intInfs.
- * The globalIndex'th entry of the globals array in s is set to the
- * IntInf.int whose value corresponds to the mlstr string.
- *
- * The strings pointed to by the mlstr fields consist of
- * an optional ~
- * either one or more of [0-9] or
- * 0x followed by one or more of [0-9a-fA-F]
- * a trailing EOS
- */
-struct GC_intInfInit {
- uint32_t globalIndex;
- char *mlstr;
-};
-
-/* GC_init allocates a collection of arrays/vectors in the heap. */
-struct GC_vectorInit {
- pointer bytes;
- size_t bytesPerElement;
- uint32_t globalIndex;
- GC_arrayLength numElements;
-};
+int processAtMLton (GC_state s, int argc,
+ char **argv, char **worldFile);
+int GC_init (GC_state s, int argc, char **argv);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -14,9 +14,9 @@
(uintptr_t)opp, *opp);
}
-bool invariant (GC_state s) {
+bool invariantForGC (GC_state s) {
if (DEBUG)
- fprintf (stderr, "invariant\n");
+ fprintf (stderr, "invariantForGC\n");
/* Frame layouts */
for (unsigned int i = 0; i < s->frameLayoutsLength; ++i) {
GC_frameLayout layout;
@@ -54,16 +54,16 @@
assert (s->secondaryHeap.start == NULL
or s->heap.size == s->secondaryHeap.size);
/* Check that all pointers are into from space. */
- foreachGlobalObjptr (s, assertObjptrIsInFromSpace);
+ foreachGlobalObjptr (s, assertIsObjptrInFromSpace);
pointer back = s->heap.start + s->heap.oldGenSize;
if (DEBUG_DETAILED)
fprintf (stderr, "Checking old generation.\n");
foreachObjptrInRange (s, alignFrontier (s, s->heap.start), &back,
- assertObjptrIsInFromSpace, FALSE);
+ assertIsObjptrInFromSpace, FALSE);
if (DEBUG_DETAILED)
fprintf (stderr, "Checking nursery.\n");
foreachObjptrInRange (s, s->heap.nursery, &s->frontier,
- assertObjptrIsInFromSpace, FALSE);
+ assertIsObjptrInFromSpace, FALSE);
/* Current thread. */
GC_stack stack = getStackCurrent(s);
assert (isAlignedStackReserved (s, stack->reserved));
@@ -74,29 +74,29 @@
assert (stack->used == sizeofGCStateCurrentStackUsed (s));
assert (stack->used <= stack->reserved);
if (DEBUG)
- fprintf (stderr, "invariant passed\n");
+ fprintf (stderr, "invariantForGC passed\n");
return TRUE;
}
-bool mutatorFrontierInvariant (GC_state s) {
+bool invariantForMutatorFrontier (GC_state s) {
GC_thread thread = getThreadCurrent(s);
return (thread->bytesNeeded
<= (size_t)(s->limitPlusSlop - s->frontier));
}
-bool mutatorStackInvariant (GC_state s) {
+bool invariantForMutatorStack (GC_state s) {
GC_stack stack = getStackCurrent(s);
return (getStackTop (s, stack)
<= getStackLimit (s, stack) + getStackTopFrameSize (s, stack));
}
-bool mutatorInvariant (GC_state s, bool frontier, bool stack) {
+bool invariantForMutator (GC_state s, bool frontier, bool stack) {
if (DEBUG)
displayGCState (s, stderr);
if (frontier)
- assert (mutatorFrontierInvariant(s));
+ assert (invariantForMutatorFrontier(s));
if (stack)
- assert (mutatorStackInvariant(s));
- assert (invariant (s));
+ assert (invariantForMutatorStack(s));
+ assert (invariantForGC (s));
return TRUE;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,8 +6,8 @@
* See the file MLton-LICENSE for details.
*/
-void assertObjptrIsInFromSpace (GC_state s, objptr *opp);
-bool invariant (GC_state s);
-bool mutatorFrontierInvariant (GC_state s);
-bool mutatorStackInvariant (GC_state s);
-bool mutatorInvariant (GC_state s, bool frontier, bool stack);
+void assertIsObjptrInFromSpace (GC_state s, objptr *opp);
+bool invariantForGC (GC_state s);
+bool invariantForMutatorFrontier (GC_state s);
+bool invariantForMutatorStack (GC_state s);
+bool invariantForMutator (GC_state s, bool frontier, bool stack);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -12,8 +12,11 @@
/* An object pointer might be larger than a header.
*/
-void threadInternalCopy (pointer dst, pointer src) {
- size_t count = (OBJPTR_SIZE - GC_HEADER_SIZE) / GC_HEADER_SIZE;
+void copyForThreadInternal (pointer dst, pointer src) {
+ size_t count;
+
+ assert (0 == (OBJPTR_SIZE % GC_HEADER_SIZE));
+ count = (OBJPTR_SIZE - GC_HEADER_SIZE) / GC_HEADER_SIZE;
src = src + GC_HEADER_SIZE * count;
for (size_t i = 0; i <= count; i++) {
@@ -35,14 +38,14 @@
"threadInternal opp = "FMTPTR" p = "FMTPTR" header = "FMTHDR"\n",
(uintptr_t)opp, (uintptr_t)p, getHeader (p));
headerp = getHeaderp (p);
- threadInternalCopy ((pointer)(opp), (pointer)(headerp));
- threadInternalCopy ((pointer)(headerp), (pointer)(&opop));
+ copyForThreadInternal ((pointer)(opp), (pointer)(headerp));
+ copyForThreadInternal ((pointer)(headerp), (pointer)(&opop));
}
-/* If p is weak, the object pointer was valid, and points to an unmarked object,
- * then clear the o...
[truncated message content] |
|
From: Stephen W. <sw...@ml...> - 2005-11-03 17:38:09
|
Added library for Solaris.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/trunk/bin/regression 2005-11-04 01:38:08 UTC (rev 4144)
@@ -150,7 +150,7 @@
libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
;;
*solaris)
- libs='-lnsl -lsocket'
+ libs='-lnsl -lsocket -lrt'
;;
*)
libs=''
|
|
From: Matthew F. <fl...@ml...> - 2005-11-03 16:12:57
|
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. */
|
|
From: Stephen W. <sw...@ml...> - 2005-11-03 15:53:07
|
Eliminated -fcall-used-g[57], which cause segfaults on Solaris 10.
----------------------------------------------------------------------
U mlton/trunk/bin/mlton-script
U mlton/trunk/runtime/Makefile
----------------------------------------------------------------------
Modified: mlton/trunk/bin/mlton-script
===================================================================
--- mlton/trunk/bin/mlton-script 2005-11-03 18:29:18 UTC (rev 4141)
+++ mlton/trunk/bin/mlton-script 2005-11-03 23:53:05 UTC (rev 4142)
@@ -77,8 +77,6 @@
-target-cc-opt darwin '-I/sw/include' \
-target-cc-opt solaris \
'-Wa,-xarch=v8plusa
- -fcall-used-g5
- -fcall-used-g7
-mcpu=ultrasparc' \
-target-cc-opt sparc '-mcpu=v8 -m32' \
-target-cc-opt x86 \
Modified: mlton/trunk/runtime/Makefile
===================================================================
--- mlton/trunk/runtime/Makefile 2005-11-03 18:29:18 UTC (rev 4141)
+++ mlton/trunk/runtime/Makefile 2005-11-03 23:53:05 UTC (rev 4142)
@@ -32,7 +32,7 @@
endif
ifeq ($(TARGET_OS), solaris)
-FLAGS += -Wa,-xarch=v8plusa -fcall-used-g5 -fcall-used-g7 -funroll-all-loops -mcpu=ultrasparc
+FLAGS += -Wa,-xarch=v8plusa -funroll-all-loops -mcpu=ultrasparc
endif
ifeq ($(TARGET), self)
|
|
From: Stephen W. <sw...@ml...> - 2005-11-03 10:29:24
|
Used #ifndef to protect some #defines. This is necessary on some platforms, like Solaris 10, that define fpclassify and associated constants, but where we say that HAS_FPCLASSIFY = FALSE (because Solaris 8 doesn't have fpclassify). We really should use autoconf. ---------------------------------------------------------------------- U mlton/trunk/runtime/platform.h ---------------------------------------------------------------------- Modified: mlton/trunk/runtime/platform.h =================================================================== --- mlton/trunk/runtime/platform.h 2005-11-03 18:21:46 UTC (rev 4140) +++ mlton/trunk/runtime/platform.h 2005-11-03 18:29:18 UTC (rev 4141) @@ -166,18 +166,33 @@ #define EXECVE execve #endif -#if not HAS_FEROUND +#ifndef FE_TONEAREST #define FE_TONEAREST 0 +#endif +#ifndef FE_DOWNWARD #define FE_DOWNWARD 1 +#endif +#ifndef FE_UPWARD #define FE_UPWARD 2 +#endif +#ifndef FE_TOWARDZERO #define FE_TOWARDZERO 3 #endif -#if not HAS_FPCLASSIFY + +#ifndef FP_INFINITE #define FP_INFINITE 1 +#endif +#ifndef FP_NAN #define FP_NAN 0 +#endif +#ifndef FP_NORMAL #define FP_NORMAL 4 +#endif +#ifndef FP_SUBNORMAL #define FP_SUBNORMAL 3 +#endif +#ifndef FP_ZERO #define FP_ZERO 2 #endif |
|
From: Stephen W. <sw...@ml...> - 2005-11-03 10:21:47
|
Made Debian package. ---------------------------------------------------------------------- U mlton/trunk/package/debian/changelog ---------------------------------------------------------------------- Modified: mlton/trunk/package/debian/changelog =================================================================== --- mlton/trunk/package/debian/changelog 2005-11-03 13:19:23 UTC (rev 4139) +++ mlton/trunk/package/debian/changelog 2005-11-03 18:21:46 UTC (rev 4140) @@ -1,3 +1,9 @@ +mlton (20051102-1) unstable; urgency=low + + * new upstream version + + -- Stephen Weeks <sw...@sw...> Wed, 02 Nov 2005 18:45:50 -0800 + mlton (20050930-1) unstable; urgency=low * Fixed postinst problem. closes: #329692 |
|
From: Matthew F. <fl...@ml...> - 2005-11-03 05:19:27
|
Moved implicit enabling of gcState.isRusageEnabled from MLton.Rusage to Timer
----------------------------------------------------------------------
U mlton/trunk/basis-library/mlton/rusage.sml
U mlton/trunk/basis-library/system/timer.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/mlton/rusage.sml
===================================================================
--- mlton/trunk/basis-library/mlton/rusage.sml 2005-11-03 07:46:08 UTC (rev 4138)
+++ mlton/trunk/basis-library/mlton/rusage.sml 2005-11-03 13:19:23 UTC (rev 4139)
@@ -28,20 +28,16 @@
utime = toTime (utimeSec, utimeUsec)}
end
- val rusage =
- let val () = MLtonGC.setRusage true
+ fun rusage () =
+ let
+ val () = Prim.ru ()
+ open Prim
in
- 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
+ {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
Modified: mlton/trunk/basis-library/system/timer.sml
===================================================================
--- mlton/trunk/basis-library/system/timer.sml 2005-11-03 07:46:08 UTC (rev 4138)
+++ mlton/trunk/basis-library/system/timer.sml 2005-11-03 13:19:23 UTC (rev 4139)
@@ -21,14 +21,19 @@
type cpu_timer = {gc: SysUsr.t, self: SysUsr.t}
- fun startCPUTimer (): cpu_timer =
- let
- val {gc = {utime = gcu, stime = gcs, ...},
- self = {utime = selfu, stime = selfs}, ...} =
- MLtonRusage.rusage ()
+ val startCPUTimer : unit -> cpu_timer =
+ let
+ val () = MLtonGC.setRusage true
in
- {gc = SysUsr.T {sys = gcs, usr = gcu},
- self = SysUsr.T {sys = selfs, usr = selfu}}
+ 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
end
fun checkCPUTimes {gc, self} =
|
|
From: Stephen W. <sw...@ml...> - 2005-11-02 23:46:10
|
Added MLNLFFI platform memory files. ---------------------------------------------------------------------- A mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-freebsd.mlb A mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-netbsd.mlb A mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-openbsd.mlb ---------------------------------------------------------------------- Added: mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-freebsd.mlb =================================================================== --- mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-freebsd.mlb 2005-11-03 05:34:32 UTC (rev 4137) +++ mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-freebsd.mlb 2005-11-03 07:46:08 UTC (rev 4138) @@ -0,0 +1 @@ +../memory.32bit-unix.mlb Added: mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-netbsd.mlb =================================================================== --- mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-netbsd.mlb 2005-11-03 05:34:32 UTC (rev 4137) +++ mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-netbsd.mlb 2005-11-03 07:46:08 UTC (rev 4138) @@ -0,0 +1 @@ +../memory.32bit-unix.mlb Added: mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-openbsd.mlb =================================================================== --- mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-openbsd.mlb 2005-11-03 05:34:32 UTC (rev 4137) +++ mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-openbsd.mlb 2005-11-03 07:46:08 UTC (rev 4138) @@ -0,0 +1 @@ +../memory.32bit-unix.mlb |
|
From: Stephen W. <sw...@ml...> - 2005-11-02 21:34:33
|
Added MLNLFFI sparc-solaris platform. ---------------------------------------------------------------------- A mlton/trunk/lib/mlnlffi/memory/platform/memory.sparc-solaris.mlb ---------------------------------------------------------------------- Added: mlton/trunk/lib/mlnlffi/memory/platform/memory.sparc-solaris.mlb =================================================================== --- mlton/trunk/lib/mlnlffi/memory/platform/memory.sparc-solaris.mlb 2005-11-03 04:24:09 UTC (rev 4136) +++ mlton/trunk/lib/mlnlffi/memory/platform/memory.sparc-solaris.mlb 2005-11-03 05:34:32 UTC (rev 4137) @@ -0,0 +1 @@ +../memory.32bit-unix.mlb |
|
From: Stephen W. <sw...@ml...> - 2005-11-02 20:24:14
|
Fixed for RPM packaging. ---------------------------------------------------------------------- U mlton/trunk/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/Makefile =================================================================== --- mlton/trunk/Makefile 2005-11-03 03:51:11 UTC (rev 4135) +++ mlton/trunk/Makefile 2005-11-03 04:24:09 UTC (rev 4136) @@ -21,7 +21,7 @@ AOUT = mlton-compile MLBPATHMAP = $(LIB)/mlb-path-map TARGETMAP = $(LIB)/target-map -SPEC = $(SRC)/package/rpm/mlton.spec +SPEC = package/rpm/mlton.spec LEX = mllex PROF = mlprof YACC = mlyacc @@ -259,7 +259,7 @@ rm -rf $(SOURCEDIR) mkdir -p $(SOURCEDIR) ( cd $(SRC) && tar -cpf - . ) | ( cd $(SOURCEDIR) && tar -xpf - ) - $(CP) $(SOURCEDIR)/doc/mlton.spec $(TOPDIR)/SPECS/mlton.spec + $(CP) $(SOURCEDIR)/$(SPEC) $(TOPDIR)/SPECS/mlton.spec ( cd $(TOPDIR)/SOURCES && tar -cpf - mlton-$(VERSION) ) \ | $(GZIP) >$(SOURCEDIR).tgz rm -rf $(SOURCEDIR) @@ -307,7 +307,7 @@ @echo 'Instantiating version numbers.' for f in \ package/debian/changelog \ - package/rpm/mlton.spec \ + $(SPEC) \ package/freebsd/Makefile \ mlton/control/control-flags.sml; \ do \ |
