[MLton-commit] r4198
Matthew Fluet
MLton@mlton.org
Fri, 11 Nov 2005 13:42:11 -0800
Merge trunk revisions 4165:4197 into x86_64 branch
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/bin-io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/text-io.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
U mlton/branches/on-20050822-x86_64-branch/bin/mlton-script
A mlton/branches/on-20050822-x86_64-branch/bin/patch-mingw
U mlton/branches/on-20050822-x86_64-branch/bin/regression
U mlton/branches/on-20050822-x86_64-branch/bin/upgrade-basis
U mlton/branches/on-20050822-x86_64-branch/doc/changelog
U mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/Makefile
A mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/platform/memory.x86-mingw.mlb
U mlton/branches/on-20050822-x86_64-branch/mlton/Makefile
U mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/shrink2.fun
U mlton/branches/on-20050822-x86_64-branch/package/debian/changelog
U mlton/branches/on-20050822-x86_64-branch/package/mingw/mlton.bat
A mlton/branches/on-20050822-x86_64-branch/regression/time4.ok
A mlton/branches/on-20050822-x86_64-branch/regression/time4.sml
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/windows.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile 2005-11-11 21:42:01 UTC (rev 4198)
@@ -353,6 +353,9 @@
ifeq ($(TARGET_OS), darwin)
PREFIX = /usr/local
endif
+ifeq ($(TARGET_OS), mingw)
+PREFIX = /mingw
+endif
ifeq ($(TARGET_OS), solaris)
PREFIX = /usr/local
endif
@@ -391,7 +394,8 @@
sed "/^lib=/s;.*;lib='$(prefix)/$(ULIB)';" \
<$(SRC)/bin/mlton-script >$(TBIN)/mlton
chmod a+x $(TBIN)/mlton
- cd $(BIN) && $(CP) $(LEX) $(NLFFIGEN) $(PROF) $(YACC) $(TBIN)/
+ cd $(BIN) && $(CP) $(LEX)$(EXE) $(NLFFIGEN)$(EXE) \
+ $(PROF)$(EXE) $(YACC)$(EXE) $(TBIN)/
( cd $(SRC)/man && tar cf - $(MAN_PAGES)) | \
( cd $(TMAN)/ && tar xf - )
if $(GZIP_MAN); then \
@@ -401,9 +405,9 @@
cygwin|darwin|solaris) \
;; \
*) \
- for f in $(TLIB)/$(AOUT) $(TBIN)/$(LEX) \
- $(TBIN)/$(NLFFIGEN) $(TBIN)/$(PROF) \
- $(TBIN)/$(YACC); do \
+ for f in $(TLIB)/$(AOUT)$(EXE) $(TBIN)/$(LEX)$(EXE) \
+ $(TBIN)/$(NLFFIGEN)$(EXE) $(TBIN)/$(PROF)$(EXE) \
+ $(TBIN)/$(YACC)$(EXE); do \
strip --remove-section=.comment \
--remove-section=.note $$f; \
done \
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/io/imperative-io.fun 2005-11-11 21:42:01 UTC (rev 4198)
@@ -77,19 +77,37 @@
(* outstream *)
(* ------------------------------------------------- *)
-datatype outstream = Out of SIO.outstream ref
+(* The following :> hides the fact that Outstream.t is an eqtype. Doing it
+ * here is much easier than putting :> on the functor result.
+ *)
+structure Outstream:>
+ sig
+ type t
-fun output (Out os, v) = SIO.output (!os, v)
-fun output1 (Out os, v) = SIO.output1 (!os, v)
-fun outputSlice (Out os, v) = SIO.outputSlice (!os, v)
-fun flushOut (Out os) = SIO.flushOut (!os)
-fun closeOut (Out os) = SIO.closeOut (!os)
-fun mkOutstream os = Out (ref os)
-fun getOutstream (Out os) = !os
-fun setOutstream (Out os, os') = os := os'
-fun getPosOut (Out os) = SIO.getPosOut (!os)
-fun setPosOut (Out os, outPos) = os := SIO.setPosOut outPos
+ val get: t -> SIO.outstream
+ val make: SIO.outstream -> t
+ val set: t * SIO.outstream -> unit
+ end =
+ struct
+ datatype t = T of SIO.outstream ref
+ fun get (T r) = !r
+ fun set (T r, s) = r := s
+ fun make s = T (ref s)
+ end
+
+type outstream = Outstream.t
+fun output (os, v) = SIO.output (Outstream.get os, v)
+fun output1 (os, v) = SIO.output1 (Outstream.get os, v)
+fun outputSlice (os, v) = SIO.outputSlice (Outstream.get os, v)
+fun flushOut os = SIO.flushOut (Outstream.get os)
+fun closeOut os = SIO.closeOut (Outstream.get os)
+val mkOutstream = Outstream.make
+val getOutstream = Outstream.get
+val setOutstream = Outstream.set
+val getPosOut = SIO.getPosOut o Outstream.get
+fun setPosOut (os, outPos) = Outstream.set (os, SIO.setPosOut outPos)
+
fun newOut {appendMode, bufferMode, closeAtExit, fd, name} =
let
val writer = mkWriter {appendMode = appendMode,
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/top-level/basis.sig 2005-11-11 21:42:01 UTC (rev 4198)
@@ -622,6 +622,10 @@
sharing type Word64VectorSlice.vector = Word64Vector.vector
sharing type Word64Array2.elem = Word64.word
sharing type Word64Array2.vector = Word64Vector.vector
+ sharing type MLton.BinIO.instream = BinIO.instream
+ sharing type MLton.BinIO.outstream = BinIO.outstream
+ sharing type MLton.TextIO.instream = TextIO.instream
+ sharing type MLton.TextIO.outstream = TextIO.outstream
end
(* bool is already defined as bool and so cannot be shared.
* So, we where these to get the needed sharing.
@@ -696,6 +700,9 @@
where type Word8ArraySlice.vector_slice = Word8ArraySlice.vector_slice
where type Word8Vector.vector = Word8Vector.vector
+ where type 'a MLton.Thread.t = 'a MLton.Thread.t
+ where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
+
(* Types that must be exposed because constants denote them. *)
where type Int1.int = Int1.int
where type Int2.int = Int2.int
@@ -765,6 +772,3 @@
where type Word31.word = Word31.word
where type Word32.word = Word32.word
where type Word64.word = Word64.word
-
- where type 'a MLton.Thread.t = 'a MLton.Thread.t
- where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/bin-io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/bin-io.sig 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/bin-io.sig 2005-11-11 21:42:01 UTC (rev 4198)
@@ -5,7 +5,5 @@
* See the file MLton-LICENSE for details.
*)
-signature MLTON_BIN_IO =
- MLTON_IO
- where type instream = BinIO.instream
- where type outstream = BinIO.outstream
+signature MLTON_BIN_IO = MLTON_IO
+
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/text-io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/text-io.sig 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/text-io.sig 2005-11-11 21:42:01 UTC (rev 4198)
@@ -6,7 +6,4 @@
* See the file MLton-LICENSE for details.
*)
-signature MLTON_TEXT_IO =
- MLTON_IO
- where type instream = TextIO.instream
- where type outstream = TextIO.outstream
+signature MLTON_TEXT_IO = MLTON_IO
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/system/time.sml 2005-11-11 21:42:01 UTC (rev 4198)
@@ -92,6 +92,7 @@
val toString = fmt 3
(* Adapted from the ML Kit 4.1.4; basislib/Time.sml
+ * by mfluet@acm.org on 2005-11-10 based on
* by mfluet@acm.org on 2005-8-10 based on
* adaptations from the ML Kit 3 Version; basislib/Time.sml
* by sweeks@research.nj.nec.com on 1999-1-3.
@@ -103,10 +104,14 @@
| pow10 n = 10 * pow10 (n-1)
fun mkTime sign intv fracv decs =
let
- val nsec = (pow10 (10-decs) * fracv + 5) div 10
+ val nsec =
+ LargeInt.div (LargeInt.+ (LargeInt.* (Int.toLarge (pow10 (10 - decs)),
+ Int.toLarge fracv),
+ 5),
+ 10)
val t =
LargeInt.+ (LargeInt.* (Int.toLarge intv, ticksPerSecond),
- Int.toLarge nsec)
+ nsec)
val t = if sign then t else LargeInt.~ t
in
T t
@@ -139,6 +144,7 @@
fun int sign src =
case getc src of
NONE => NONE
+ | SOME (#".", rest) => frac sign 0 rest
| SOME (c, rest) =>
(case charToDigit c of
NONE => NONE
Modified: mlton/branches/on-20050822-x86_64-branch/bin/mlton-script
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/mlton-script 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/bin/mlton-script 2005-11-11 21:42:01 UTC (rev 4198)
@@ -6,11 +6,19 @@
dir=`dirname $0`
lib=`cd $dir/../lib && pwd`
+eval `$lib/platform`
gcc='gcc'
-mlton="$lib/mlton-compile"
+case "$HOST_OS" in
+mingw)
+ exe='.exe'
+;;
+*)
+ exe=''
+;;
+esac
+mlton="$lib/mlton-compile$exe"
world="$lib/world.mlton"
nj='sml'
-eval `$lib/platform`
# Try to use the SML/NJ .arch-n-opsys
if .arch-n-opsys >/dev/null 2>&1; then
eval `.arch-n-opsys`
Copied: mlton/branches/on-20050822-x86_64-branch/bin/patch-mingw (from rev 4197, mlton/trunk/bin/patch-mingw)
Modified: mlton/branches/on-20050822-x86_64-branch/bin/regression
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/regression 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/bin/regression 2005-11-11 21:42:01 UTC (rev 4198)
@@ -12,14 +12,14 @@
exit 1
}
-cross='no'
-fail='no'
-runOnly='no'
-short='no'
+cross='false'
+fail='false'
+runOnly='false'
+short='false'
while [ "$#" -gt 0 ]; do
case "$1" in
-cross)
- cross='yes'
+ cross='true'
shift
if [ "$#" = 0 ]; then
usage
@@ -28,11 +28,11 @@
shift
;;
-fail)
- fail='yes'
+ fail='true'
shift
;;
-run-only)
- runOnly='yes'
+ runOnly='true'
shift
if [ "$#" = 0 ]; then
usage
@@ -41,7 +41,7 @@
shift
;;
-short)
- short='yes'
+ short='true'
shift
;;
*)
@@ -57,7 +57,7 @@
lib="$src/build/lib"
mlton="$bin/mlton"
flags="-type-check true $flags"
-if [ $cross = 'yes' ]; then
+if $cross; then
flags="$flags -target $crossTarget -stop g"
fi
cont='callcc.sml callcc2.sml callcc3.sml once.sml'
@@ -80,7 +80,7 @@
cd $src/regression
-if [ "$fail" = 'yes' ]; then
+if $fail; then
for f in `ls fail/*.sml`; do
echo "testing $f"
( $mlton $flags -stop tc $f >/dev/null 2>&1 &&
@@ -90,6 +90,16 @@
exit 0
fi
+forMinGW='false'
+if [ `host-os` = mingw ]; then
+ forMinGW='true'
+fi
+case $crossTarget in
+*mingw)
+ forMinGW='true'
+;;
+esac
+
for f in `ls *.sml`; do
f=`basename $f .sml`
case `host-os` in
@@ -123,8 +133,7 @@
extraFlags=""
;;
esac
- case "$runOnly" in
- no)
+ if (! $runOnly); then
mlb="$f.mlb"
echo "\$(SML_LIB)/basis/basis.mlb
\$(SML_LIB)/basis/mlton.mlb
@@ -139,12 +148,10 @@
cmd="$mlton $flags $extraFlags -output $f $mlb"
eval $cmd
rm $mlb
- if [ "$?" -ne '0' ] ||
- [ "$cross" = 'no' -a ! -x "$f" ]; then
+ if [ "$?" -ne '0' ] || ((! $cross) && [ ! -x "$f" ]); then
compFail $f
fi
- ;;
- yes)
+ else
case $crossTarget in
*mingw)
libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
@@ -170,34 +177,29 @@
-L/usr/pkg/lib \
-L/usr/local/lib \
$files $libs
- ;;
- esac
- if [ ! -r $f.nonterm -a $cross = 'no' -a -x $f ]; then
+ fi
+ if [ ! -r $f.nonterm -a $cross = 'false' -a -x $f ]; then
nonZeroMsg='Nonzero exit status.'
- case $crossTarget in
- *mingw)
- nonZeroMsg="$nonZeroMsg"'\r'
- ;;
- esac
+ if $forMinGW; then
+ nonZeroMsg="$nonZeroMsg"'\r'
+ fi
( ./$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)
+ if $forMinGW; then
compare="$f.sed.ok"
- sed 's/$/\r/' <"$f.ok" >"$compare"
- ;;
- esac
+ /c/cygwin/bin/sed 's/$/\r/' <"$f.ok" >"$compare"
+ fi
if ! diff $compare $tmp; then
echo "difference with $flags"
fi
fi
fi
done
-if [ "$cross" = 'yes' -o "$runOnly" = 'yes' -o "$short" = 'yes' ]; then
+if $cross || $runOnly || $short; then
exit 0
fi
mmake clean >/dev/null
Modified: mlton/branches/on-20050822-x86_64-branch/bin/upgrade-basis
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/upgrade-basis 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/bin/upgrade-basis 2005-11-11 21:42:01 UTC (rev 4198)
@@ -11,12 +11,14 @@
name=`basename $0`
usage () {
- die "usage: $name <PATH>"
+ die "usage: $name <PATH> <ARCH> <OS>"
}
case "$#" in
-1)
+3)
PATH="$1"
+ ARCH="$2"
+ OS="$3"
;;
*)
usage
@@ -94,7 +96,7 @@
structure LargeWord = Word'
eval `$bin/platform`
-case $HOST_ARCH in
+case "$ARCH" in
alpha)
arch='Alpha'
;;
@@ -132,7 +134,7 @@
die "strange HOST_ARCH: $HOST_ARCH"
esac
-case $HOST_OS in
+case "$OS" in
cygwin)
os='Cygwin'
;;
Modified: mlton/branches/on-20050822-x86_64-branch/doc/changelog
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/changelog 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/doc/changelog 2005-11-11 21:42:01 UTC (rev 4198)
@@ -1,5 +1,11 @@
Here are the changes since version 20041109.
+* 2005-11-10
+ - Fixed two bugs in Time.scan. One would raise Time on a string with a
+ large fractional component. Thanks to Carsten Varming for the bug
+ report. The other failed to scan strings with an explicit sign
+ followed by a decimal point.
+
* 2005-11-03
- Removed MLton.GC.setRusage.
- Added MLton.Rusage.measureGC.
Modified: mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/Makefile 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/doc/examples/ffi/Makefile 2005-11-11 21:42:01 UTC (rev 4198)
@@ -8,7 +8,7 @@
PATH = ../../../build/bin:$(shell echo $$PATH)
-mlton = mlton -default-ann 'allowFFI true' -codegen c
+mlton = mlton -default-ann 'allowFFI true'
.PHONY: all
all: import import2 export iimport test_quot
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/platform/memory.x86-mingw.mlb (from rev 4197, mlton/trunk/lib/mlnlffi/memory/platform/memory.x86-mingw.mlb)
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/Makefile 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/Makefile 2005-11-11 21:42:01 UTC (rev 4198)
@@ -9,6 +9,7 @@
SRC = $(shell cd .. && pwd)
BUILD = $(SRC)/build
BIN = $(BUILD)/bin
+HOST_ARCH = $(shell $(SRC)/bin/host-arch)
HOST_OS = $(shell $(SRC)/bin/host-os)
LIB = $(BUILD)/lib
MLTON = mlton
@@ -85,7 +86,7 @@
#! Pass $(PATH) to upgrade-basis because it is run via #!/usr/bin/env
# bash, which resets the path.
$(UP):
- $(SRC)/bin/upgrade-basis "$(PATH)" >$(UP)
+ $(SRC)/bin/upgrade-basis "$(PATH)" "$(HOST_ARCH)" "$(HOST_OS)" >$(UP)
mlton.sml: $(SOURCES)
rm -f mlton.sml && mlton -stop sml mlton.cm && chmod -w mlton.sml
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2005-11-11 21:42:01 UTC (rev 4198)
@@ -901,6 +901,13 @@
(MLton.GC.pack ()
; compileCSO (List.concat [!outputs, csoFiles]))
end
+ fun showFiles (fs: File.t vector) =
+ Vector.foreach
+ (fs, fn f =>
+ print (concat [String.translate
+ (f, fn #"\\" => "/"
+ | c => str c),
+ "\n"]))
fun compileCM input =
let
val files = CM.cm {cmfile = input}
@@ -916,8 +923,7 @@
in
case stop of
Place.Files =>
- List.foreach
- (files, fn f => print (concat [f, "\n"]))
+ showFiles (Vector.fromList files)
| Place.SML => saveSML (maybeOut ".sml")
| _ =>
(if !keepSML
@@ -970,9 +976,8 @@
val _ =
case stop of
Place.Files =>
- Vector.foreach
- (Compile.sourceFilesMLB {input = file}, fn f =>
- print (concat [f, "\n"]))
+ showFiles
+ (Compile.sourceFilesMLB {input = file})
| Place.SML => saveSML (maybeOut ".sml")
| Place.TypeCheck =>
trace (Top, "Type Check SML")
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ssa/shrink2.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ssa/shrink2.fun 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ssa/shrink2.fun 2005-11-11 21:42:01 UTC (rev 4198)
@@ -1202,12 +1202,19 @@
| Object {args, con} =>
let
val args = varInfos args
+ val isMutable =
+ case Type.dest ty of
+ Type.Object {args, ...} => Prod.isMutable args
+ | _ => Error.bug "strange Object type"
in
- if isSome con
- then
- construct (Value.Object {args = args, con = con},
- fn () => Object {args = uses args,
- con = con})
+ (* It would be nice to improve this code to do
+ * reconstruction when isSome con, not just for
+ * tuples.
+ *)
+ if isMutable orelse isSome con then
+ construct (Value.Object {args = args, con = con},
+ fn () => Object {args = uses args,
+ con = con})
else tuple args
end
| PrimApp {args, prim} =>
Modified: mlton/branches/on-20050822-x86_64-branch/package/debian/changelog
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/debian/changelog 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/package/debian/changelog 2005-11-11 21:42:01 UTC (rev 4198)
@@ -1,3 +1,9 @@
+mlton (20051109-1) unstable; urgency=low
+
+ * new upstream version
+
+ -- Stephen Weeks <sweeks@sweeks.com> Wed, 09 Nov 2005 18:47:04 -0800
+
mlton (20051102-1) unstable; urgency=low
* new upstream version
Modified: mlton/branches/on-20050822-x86_64-branch/package/mingw/mlton.bat
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/mingw/mlton.bat 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/package/mingw/mlton.bat 2005-11-11 21:42:01 UTC (rev 4198)
@@ -1,13 +1,46 @@
-@echo off
-set lib=c:\MLton\lib
-set cc=c:\MinGW\bin\gcc.exe
-
-set world=%lib%\world.mlton
-set mlton=%lib%\mlton-compile.exe
-
-set ccopts=-I%lib%\include -O1 -fno-strict-aliasing -fomit-frame-pointer -w
-set ccopts=%ccopts% -fno-strength-reduce -fschedule-insns -fschedule-insns2
-set ccopts=%ccopts% -malign-functions=5 -malign-jumps=2 -malign-loops=2 -mtune=pentium4
-set linkopts=-L%lib%\lib -lgdtoa -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32
-
-%mlton% @MLton load-world %world% -- %lib% -cc %cc% -cc-opt "%ccopts%" -link-opt "%linkopts%" %1 %2 %3 %4 %5 %6 %7 %8 %9
+@echo off
+if "%CMDEXTVERSION%"=="" goto :downlevel
+
+rem %0 contains the name of this batch file, before the path was searched
+rem But we can use the %~dp0 call-parameter syntax to find out what drive and directory it lives on
+setlocal
+call :setdir %~dp0 "%*"
+
+if not exist %dir% (
+ echo MLton directory %dir% does not exist
+ goto :end
+)
+
+set lib=%dir%\lib\MLton
+if not exist %lib% (
+ echo MLton library directory %lib% does not exist
+ goto :end
+)
+
+set cc=%dir%\bin\gcc.exe
+if not exist %cc% (
+ echo GCC compiler %cc% does not exist
+ goto :end
+)
+
+set world=%lib%\world.mlton
+set mlton=%lib%\mlton-compile.exe
+
+set ccopts=-I%lib%\include -O1 -fno-strict-aliasing -fomit-frame-pointer -w
+set ccopts=%ccopts% -fno-strength-reduce -fschedule-insns -fschedule-insns2
+set ccopts=%ccopts% -malign-functions=5 -malign-jumps=2 -malign-loops=2
+set linkopts=-lgdtoa -lm
+set linkopts=%linkopts% -lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32
+
+%mlton% @MLton load-world %world% ram-slop 0.5 -- %lib% -cc %cc% -cc-opt "%ccopts%" -mlb-path-map %lib%\mlb-path-map -link-opt "%linkopts%" %*
+goto :eof
+
+:setdir
+set dir=%1%..\
+GOTO :eof
+
+:downlevel
+echo Batch file execution of MLton not supported without command extensions
+goto :end
+
+:end
Copied: mlton/branches/on-20050822-x86_64-branch/regression/time4.ok (from rev 4197, mlton/trunk/regression/time4.ok)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/time4.sml (from rev 4197, mlton/trunk/regression/time4.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/windows.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/windows.c 2005-11-11 20:28:50 UTC (rev 4197)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/windows.c 2005-11-11 21:42:01 UTC (rev 4198)
@@ -110,7 +110,10 @@
static inline void *Windows_mmapAnon (void *start, size_t length) {
void *res;
- res = VirtualAlloc ((LPVOID)start, length, MEM_COMMIT, PAGE_READWRITE);
+ /* Use "0" instead of "start" as the first argument to VirtualAlloc
+ * because it is more stable on MinGW (at least).
+ */
+ res = VirtualAlloc ((LPVOID)0/*start*/, length, MEM_COMMIT, PAGE_READWRITE);
if (NULL == res)
res = (void*)-1;
return res;