[MLton-commit] r4165
Matthew Fluet
MLton@mlton.org
Sun, 6 Nov 2005 13:27:25 -0800
Merge trunk revisions 4025:4164 into x86_64 branch
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exn.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig
U mlton/branches/on-20050822-x86_64-branch/benchmark/Makefile
U mlton/branches/on-20050822-x86_64-branch/bin/add-cross
U mlton/branches/on-20050822-x86_64-branch/bin/clean
A mlton/branches/on-20050822-x86_64-branch/bin/grab-wiki
A mlton/branches/on-20050822-x86_64-branch/bin/make-pdf-guide
U mlton/branches/on-20050822-x86_64-branch/bin/mlton-script
U mlton/branches/on-20050822-x86_64-branch/bin/regression
U mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c
U mlton/branches/on-20050822-x86_64-branch/doc/README
U mlton/branches/on-20050822-x86_64-branch/doc/changelog
A mlton/branches/on-20050822-x86_64-branch/doc/guide/
U mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-gen.el
U mlton/branches/on-20050822-x86_64-branch/ide/emacs/mlton.el
U mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/c.mlb
A mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.mlb
D mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.x86-unix.mlb
A mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.32bit-unix.mlb
A mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.mlb
D mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.x86-unix.mlb
A mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/platform/
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/quick-sort.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/quick-sort.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string1.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/gc.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/itimer.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/random.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/rlimit.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/rusage.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/signal.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/socket.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/syslog.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/word.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLUT.sml
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLUT_c.c
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLU_c.c
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/GL_c.c
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/Makefile
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/atom.sml
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/hello.sml
A mlton/branches/on-20050822-x86_64-branch/lib/opengl/platform.h
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/points.sml
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/shortest.sml
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/solar.sml
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/spin_cube.sml
U mlton/branches/on-20050822-x86_64-branch/lib/opengl/triangle.sml
A mlton/branches/on-20050822-x86_64-branch/man/mlnlffigen.1
U mlton/branches/on-20050822-x86_64-branch/man/mlton.1
U mlton/branches/on-20050822-x86_64-branch/mllex/Makefile
U mlton/branches/on-20050822-x86_64-branch/mlnlffigen/Makefile
U mlton/branches/on-20050822-x86_64-branch/mlnlffigen/gen.sml
U mlton/branches/on-20050822-x86_64-branch/mlprof/Makefile
U mlton/branches/on-20050822-x86_64-branch/mlton/Makefile
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/allocate-registers.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/backend.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
U mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/control/source.sml
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-sigexp.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun
U mlton/branches/on-20050822-x86_64-branch/mlyacc/Makefile
U mlton/branches/on-20050822-x86_64-branch/mlyacc/doc/Makefile
U mlton/branches/on-20050822-x86_64-branch/package/debian/changelog
U mlton/branches/on-20050822-x86_64-branch/package/debian/control
A mlton/branches/on-20050822-x86_64-branch/package/debian/mlton.doc-base
U mlton/branches/on-20050822-x86_64-branch/package/debian/rules
A mlton/branches/on-20050822-x86_64-branch/package/mingw/
A mlton/branches/on-20050822-x86_64-branch/regression/filesys.x86-cygwin.ok
A mlton/branches/on-20050822-x86_64-branch/regression/finalize.3.ok
A mlton/branches/on-20050822-x86_64-branch/regression/finalize.3.sml
A mlton/branches/on-20050822-x86_64-branch/regression/finalize.4.ok
A mlton/branches/on-20050822-x86_64-branch/regression/finalize.4.sml
A mlton/branches/on-20050822-x86_64-branch/regression/finalize.5.ok
A mlton/branches/on-20050822-x86_64-branch/regression/finalize.5.sml
U mlton/branches/on-20050822-x86_64-branch/regression/flexrecord.sml
A mlton/branches/on-20050822-x86_64-branch/regression/unixpath.x86-cygwin.ok
U mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc.h
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.c
U mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.h
U mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -19,9 +19,14 @@
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 = $(SRC)/package/rpm/mlton.spec
+SPEC = package/rpm/mlton.spec
LEX = mllex
PROF = mlprof
YACC = mlyacc
@@ -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:
@@ -105,7 +110,7 @@
DEBSRC = mlton-$(VERSION).orig
.PHONY: deb
deb:
- $(MAKE) clean clean-svn version deb-change
+ $(MAKE) clean clean-svn version
mv package/debian .
tar -cpf - . | \
( cd .. && mkdir $(DEBSRC) && cd $(DEBSRC) && tar -xpf - )
@@ -159,33 +164,26 @@
# vvvv do not change make to $(MAKE)
cd $(BSDSRC)/freebsd && make build-package
+LIBRARIES = ckit-lib cml mlnlffi-lib mlyacc-lib smlnj-lib
+
.PHONY: libraries-no-check
libraries-no-check:
mkdir -p $(LIB)/sml
- cd $(LIB)/sml && rm -rf mlyacc-lib
- $(CP) $(SRC)/lib/mlyacc/. $(LIB)/sml/mlyacc-lib
- find $(LIB)/sml/mlyacc -type d -name .svn | xargs rm -rf
- find $(LIB)/sml/mlyacc -type f -name .ignore | xargs rm -rf
- cd $(LIB)/sml && rm -rf cml
+ cd $(LIB)/sml && rm -rf $(LIBRARIES)
+ $(MAKE) -C $(SRC)/lib/ckit-lib
+ $(MAKE) -C $(SRC)/lib/smlnj-lib
$(CP) $(SRC)/lib/cml/. $(LIB)/sml/cml
- find $(LIB)/sml/cml -type d -name .svn | xargs rm -rf
- find $(LIB)/sml/cml -type f -name .ignore | xargs rm -rf
- cd $(LIB)/sml && rm -rf smlnj-lib
- $(MAKE) -C $(SRC)/lib/smlnj-lib
- $(CP) $(SRC)/lib/smlnj-lib/smlnj-lib/. $(LIB)/sml/smlnj-lib
- cd $(LIB)/sml && rm -rf ckit-lib
- $(MAKE) -C $(SRC)/lib/ckit-lib
$(CP) $(SRC)/lib/ckit-lib/ckit/. $(LIB)/sml/ckit-lib
- cd $(LIB)/sml && rm -rf mlnlffi-lib
$(CP) $(SRC)/lib/mlnlffi/. $(LIB)/sml/mlnlffi-lib
- find $(LIB)/sml/mlnlffi-lib -type d -name .svn | xargs rm -rf
- find $(LIB)/sml/mlnlffi-lib -type f -name .ignore | xargs rm -rf
+ $(CP) $(SRC)/lib/mlyacc/. $(LIB)/sml/mlyacc-lib
+ $(CP) $(SRC)/lib/smlnj-lib/smlnj-lib/. $(LIB)/sml/smlnj-lib
+ find $(LIB)/sml -type d -name .svn | xargs rm -rf
+ find $(LIB)/sml -type f -name .ignore | xargs rm -rf
-
.PHONY: libraries
libraries:
$(MAKE) libraries-no-check
- for f in mlyacc-lib cml smlnj-lib ckit-lib mlnlffi-lib; do \
+ for f in $(LIBRARIES); do \
echo "Type checking $$f library."; \
$(MLTON) -disable-ann deadCode \
-stop tc \
@@ -266,7 +264,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)
@@ -289,9 +287,7 @@
.PHONY: script
script:
- @echo 'Setting lib in mlton script.'
- sed "/^lib=/s;'.*';\"\`dirname \$$0\`/../lib\";" \
- <bin/mlton-script >$(MLTON)
+ $(CP) bin/mlton-script $(MLTON)
chmod a+x $(MLTON)
$(CP) $(SRC)/bin/platform $(LIB)
@@ -309,16 +305,20 @@
$(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:
@echo 'Instantiating version numbers.'
for f in \
package/debian/changelog \
- package/rpm/mlton.spec \
+ $(SPEC) \
package/freebsd/Makefile \
- mlton/control/control.sml; \
+ mlton/control/control-flags.sml; \
do \
sed "s/\(.*\)MLTONVERSION\(.*\)/\1$(VERSION)\2/" <$$f >z && \
mv z $$f; \
@@ -330,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:
@@ -346,6 +346,9 @@
# puts them.
DESTDIR = $(CURDIR)/install
PREFIX = /usr
+ifeq ($(TARGET_OS), darwin)
+PREFIX = /usr/local
+endif
ifeq ($(TARGET_OS), solaris)
PREFIX = /usr/local
endif
@@ -369,27 +372,33 @@
.PHONY: install
install: install-docs install-no-docs
+MAN_PAGES = \
+ mllex.1 \
+ mlnlffigen.1 \
+ mlprof.1 \
+ mlton.1 \
+ mlyacc.1
+
.PHONY: install-no-docs
install-no-docs:
mkdir -p $(TLIB) $(TBIN) $(TMAN)
$(CP) $(LIB)/. $(TLIB)/
rm -f $(TLIB)/self/libmlton-gdb.a
- sed "/^lib=/s;'.*';'$(prefix)/$(ULIB)';" \
+ sed "/^lib=/s;.*;lib='$(prefix)/$(ULIB)';" \
<$(SRC)/bin/mlton-script >$(TBIN)/mlton
chmod a+x $(TBIN)/mlton
- $(CP) $(BIN)/$(LEX) $(BIN)/$(PROF) $(BIN)/$(YACC) $(TBIN)/
- ( cd $(SRC)/man && tar cf - mllex.1 mlprof.1 mlton.1 mlyacc.1 ) | \
+ cd $(BIN) && $(CP) $(LEX) $(NLFFIGEN) $(PROF) $(YACC) $(TBIN)/
+ ( cd $(SRC)/man && tar cf - $(MAN_PAGES)) | \
( cd $(TMAN)/ && tar xf - )
if $(GZIP_MAN); then \
- cd $(TMAN) && $(GZIP) mllex.1 mlprof.1 mlton.1 \
- mlyacc.1; \
+ cd $(TMAN) && $(GZIP) $(MAN_PAGES); \
fi
case "$(TARGET_OS)" in \
- darwin|solaris) \
+ cygwin|darwin|solaris) \
;; \
*) \
- for f in $(TLIB)/$(AOUT) \
- $(TBIN)/$(LEX) $(TBIN)/$(PROF) \
+ for f in $(TLIB)/$(AOUT) $(TBIN)/$(LEX) \
+ $(TBIN)/$(NLFFIGEN) $(TBIN)/$(PROF) \
$(TBIN)/$(YACC); do \
strip --remove-section=.comment \
--remove-section=.note $$f; \
@@ -399,15 +408,14 @@
.PHONY: install-docs
install-docs:
mkdir -p $(TDOC)
- ( \
- cd $(SRC)/doc && \
- $(CP) changelog examples license README $(TDOC)/ \
+ ( \
+ cd $(SRC)/doc && \
+ $(CP) changelog examples guide license README $(TDOC)/ \
)
- ( \
- cd $(SRC)/util && \
- $(CP) cmcat cm2mlb $(TDOC)/ \
+ ( \
+ cd $(SRC)/util && \
+ $(CP) cmcat cm2mlb $(TDOC)/ \
)
- rm -rf $(TDOC)/user-guide
for f in callcc command-line hello-world same-fringe signals \
size taut thread1 thread2 thread-switch timeout \
; do \
@@ -428,7 +436,8 @@
$(CP) $(SRC)/debian/copyright $(SRC)/debian/README.Debian $(TDOC)/
$(CP) $(SRC)/debian/changelog $(TDOC)/changelog.Debian
mkdir -p $(TDOCBASE)
- for f in mllex mlyacc; do \
+ for f in mllex mlton mlyacc; do \
$(CP) $(SRC)/debian/$$f.doc-base $(TDOCBASE)/$$f; \
done
cd $(TDOC)/ && $(GZIP) changelog changelog.Debian
+ chown -R root.root $(TDOC)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2005-11-06 21:26:45 UTC (rev 4165)
@@ -166,6 +166,8 @@
../../mlton/signal.sml
../../mlton/process.sig
../../mlton/process.sml
+ ../../mlton/gc.sig
+ ../../mlton/gc.sml
../../mlton/rusage.sig
../../mlton/rusage.sml
@@ -214,8 +216,6 @@
in
../../mlton/ffi.sml
end
- ../../mlton/gc.sig
- ../../mlton/gc.sml
../../mlton/int-inf.sig
../../mlton/platform.sig
../../mlton/platform.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/misc/primitive.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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
@@ -1350,7 +1350,7 @@
val modf = _import "Real64_modf": real * real ref -> real;
val nextAfter = _import "Real64_nextAfter": real * real -> real;
val round = _prim "Real64_round": real -> real;
- val signBit = _import "Real64_signBit": real -> bool;
+ val signBit = _import "Real64_signBit": real -> int;
val strto = _import "Real64_strto": NullString.t -> real;
val toInt = _prim "Real64_toWordS32": real -> int;
val ~ = _prim "Real64_neg": real -> real;
@@ -1423,7 +1423,7 @@
val minNormalPos = #1 _symbol "Real32_minNormalPos": real GetSet.t; ()
val minPos = #1 _symbol "Real32_minPos": real GetSet.t; ()
val modf = _import "Real32_modf": real * real ref -> real;
- val signBit = _import "Real32_signBit": real -> bool;
+ val signBit = _import "Real32_signBit": real -> int;
val strto = _import "Real32_strto": NullString.t -> real;
val toInt = _prim "Real32_toWordS32": real -> int;
val ~ = _prim "Real32_neg": real -> real;
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exn.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exn.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/exn.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -14,19 +14,31 @@
val addExnMessager = General.addExnMessager
val history: t -> string list =
- if keepHistory
- then (setInitExtra (NONE: extra)
- ; setExtendExtra (fn e =>
- case e of
- NONE => SOME (MLtonCallStack.current ())
- | SOME _ => e)
- ; fn e => (case extra e of
- NONE => []
- | SOME cs =>
- (* The tl gets rid of the anonymous function
- * passed to setExtendExtra above.
- *)
- tl (MLtonCallStack.toStrings cs)))
+ if keepHistory then
+ (setInitExtra (NONE: extra)
+ ; setExtendExtra (fn e =>
+ case e of
+ NONE => SOME (MLtonCallStack.current ())
+ | SOME _ => e)
+ ; (fn e =>
+ case extra e of
+ NONE => []
+ | SOME cs =>
+ let
+ (* Gets rid of the anonymous function passed to
+ * setExtendExtra above.
+ *)
+ fun loop xs =
+ case xs of
+ [] => []
+ | x :: xs =>
+ if String.isPrefix "MLtonExn.fn " x then
+ xs
+ else
+ loop xs
+ in
+ loop (MLtonCallStack.toStrings cs)
+ end))
else fn _ => []
local
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/gc.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/rusage.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/posix/stub-mingw.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -73,6 +73,7 @@
val getppid = stub ("getppid", getppid)
val getuid = stub ("getuid", getuid)
val setgid = stub ("setgid", setgid)
+ val setgroups = stub ("stegroups", setgroups)
val setpgid = stub ("setpgid", setpgid)
val setsid = stub ("setsid", setsid)
val setuid = stub ("setuid", setuid)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -48,7 +48,7 @@
val minPos = minPos
val precision = precision
val radix = radix
- val signBit = signBit
+ val signBit = fn r => signBit r <> 0
val toLarge = toLarge
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -41,7 +41,7 @@
val nextAfterUp: real -> real
val precision: int
val radix: int
- val signBit: real -> bool
+ val signBit: real -> int
val strto: NullString.t -> real
val toInt: real -> int
val toLarge: real -> LargeReal.real
Modified: mlton/branches/on-20050822-x86_64-branch/benchmark/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/benchmark/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/benchmark/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -23,7 +23,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
$(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
mlton -stop sml $(NAME).cm
Modified: mlton/branches/on-20050822-x86_64-branch/bin/add-cross
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/add-cross 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/bin/add-cross 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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/branches/on-20050822-x86_64-branch/bin/clean
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/clean 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/bin/clean 2005-11-06 21:26:45 UTC (rev 4165)
@@ -17,20 +17,19 @@
ignore='.ignore'
doit () {
- rm -rf '.#'* .*~ *~ *.a *.o .cm core mlmon.out
+ rm -rf '.#'* .*~ *~ *.a *.o .cm core mlmon.out svn-commit.*
if [ -r $ignore ]; then
for f in `cat $ignore`; do rm -rf $f; done
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
}
Copied: mlton/branches/on-20050822-x86_64-branch/bin/grab-wiki (from rev 4164, mlton/trunk/bin/grab-wiki)
Copied: mlton/branches/on-20050822-x86_64-branch/bin/make-pdf-guide (from rev 4164, mlton/trunk/bin/make-pdf-guide)
Modified: mlton/branches/on-20050822-x86_64-branch/bin/mlton-script
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/mlton-script 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/bin/mlton-script 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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' \
@@ -77,10 +78,8 @@
-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 '-mv8 -m32' \
+ -target-cc-opt sparc '-mcpu=v8 -m32' \
-target-cc-opt x86 \
'-fno-strength-reduce
-fschedule-insns
Modified: mlton/branches/on-20050822-x86_64-branch/bin/regression
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bin/regression 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/bin/regression 2005-11-06 21:26:45 UTC (rev 4165)
@@ -54,6 +54,7 @@
dir=`dirname $0`
src=`cd $dir/.. && pwd`
bin="$src/build/bin"
+lib="$src/build/lib"
mlton="$bin/mlton"
flags="-type-check true $flags"
if [ $cross = 'yes' ]; then
@@ -68,6 +69,8 @@
tmp=/tmp/z.regression.$$
PATH=$bin:$src/bin/.:$PATH
+eval `$lib/platform`
+
compFail () {
echo "compilation of $f failed with $flags"
}
@@ -101,99 +104,98 @@
case `host-os` in
mingw)
case "$f" in
- mutex|prodcons|signals2)
+ cmdline|command-line|filesys|mutex|posix-exit|prodcons|signals2|timeout|unixpath)
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'
- ;;
- *)
- 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 ls $f.[0-9][0-9].[cS] >/dev/null 2>&1; then
- files="$files $f.[0-9][0-9].[cS]"
+ 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
- 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'
+ compare="$f.sed.ok"
+ sed 's/$/\r/' <"$f.ok" >"$compare"
;;
esac
- ( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1
- if [ -r $f.ok ]; then
- case $crossTarget in
- *mingw)
- compare="$f.sed.ok"
- sed 's/$/\r/' <"$f.ok" >"$compare"
- ;;
- *)
- compare="$f.ok"
- ;;
- 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
@@ -204,7 +206,7 @@
f=`basename $f .sml`
tmpf=/tmp/$f.$$
case "$f" in
- fxp)
+ fxp|hamlet)
echo "skipping $f"
;;
*)
Modified: mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/bytecode/interpret.c 2005-11-06 21:26:45 UTC (rev 4165)
@@ -6,7 +6,6 @@
*/
#include "platform.h"
-#include <stdint.h>
#include "interpret.h"
#include "c-chunk.h" // c-chunk.h must come before opcode.h because it
// redefines some opcode symbols
Modified: mlton/branches/on-20050822-x86_64-branch/doc/README
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/README 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/doc/README 2005-11-06 21:26:45 UTC (rev 4165)
@@ -2,8 +2,9 @@
programming language. MLton has the following features.
+ Runs on a variety of platforms.
- o X86: Linux, Cygwin/Windows, FreeBSD, and NetBSD.
- o Sparc: Solaris.
+ o PowerPC: Debian, Mac OSX
+ o X86: Linux, Cygwin/Windows, FreeBSD, NetBSD, OpenBSD
+ o Sparc: Debian, Solaris.
+ Generates standalone executables with excellent running times.
+ Supports the full SML 97 language.
+ A complete basis library matching the latest specification.
@@ -34,8 +35,8 @@
cm2mlb/ a utility for producing ML Basis programs in SML/NJ
cmcat/ a utility for producing whole programs in SML/NJ
examples/ example SML programs
+ guide/ MLton guide
license/ license information
mllex.ps.gz user guide for mllex lexer generator
mlyacc.ps.gz user guide for mlyacc parser generator
- user-guide/ html user guide
- user-guide.ps.gz user guide for MLton
+
Modified: mlton/branches/on-20050822-x86_64-branch/doc/changelog
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/changelog 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/doc/changelog 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,29 @@
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.
+
+* 2005-09-08
+ - Fixed bug in type inference of flexible records that would show up
+ as "Type error: variable applied to wrong number of type args"
+
+* 2005-09-06
+ - Fixed bug in Real.signBit, which had assumed that the underlying
+ C signbit returned 0 or 1, when in fact any nonzero value is
+ allowed to indicate the signbit is set.
+
+* 2005-09-05
+ - Added -mlb-path-map switch.
+
+* 2005-08-25
+ - Fixed bug in MLton.Finalizable.touch, which was not keeping alive
+ finalizable values in all cases.
+
* 2005-08-18
- Added SML/NJ Library and CKit Library from SML/NJ 110.55 to
standard distribution.
Copied: mlton/branches/on-20050822-x86_64-branch/doc/guide (from rev 4164, mlton/trunk/doc/guide)
Modified: mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-gen.el
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-gen.el 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/ide/emacs/esml-gen.el 2005-11-06 21:26:45 UTC (rev 4165)
@@ -33,7 +33,7 @@
2.4 of the Definition.")
(defconst esml-sml-alphanumeric-chars
- "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789'_"
+ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'_"
"A string of all Standard ML alphanumeric characters as defined in
section 2.4 of the Definition.")
Modified: mlton/branches/on-20050822-x86_64-branch/ide/emacs/mlton.el
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/ide/emacs/mlton.el 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/ide/emacs/mlton.el 2005-11-06 21:26:45 UTC (rev 4165)
@@ -10,6 +10,7 @@
;; markers so that file edits don't interfere with locating subsequent errros.
(setq mlton-command "mlton")
+(setq mlton-flags "")
(setq mlton-main-file "mlton-main-file undefined")
(setq mlton-output-buffer "*mlton-output*")
(setq mlton-errors nil)
@@ -95,6 +96,7 @@
(kill-buffer mlton-output-buffer))
(find-file mlton-main-file)
(shell-command (concat mlton-command
+ " " mlton-flags " "
" -stop tc "
(file-name-nondirectory mlton-main-file))
mlton-output-buffer)
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/c.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/c.mlb 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/c.mlb 2005-11-06 21:26:45 UTC (rev 4165)
@@ -15,7 +15,7 @@
* author: Matthias Blume (blume@research.bell-labs.com)
*)
local
- internals/c-int.$(TARGET_ARCH)-$(TARGET_OS).mlb
+ internals/c-int.mlb
in
structure Tag
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.mlb (from rev 4164, mlton/trunk/lib/mlnlffi/internals/c-int.mlb)
Deleted: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.x86-unix.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.x86-unix.mlb 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/internals/c-int.x86-unix.mlb 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,35 +0,0 @@
-local
- $(MLTON_ROOT)/basis/basis.mlb
-
- ../memory/memory.x86-unix.mlb
-
- ../c.sig
- ../c-debug.sig
- c-int.sig
- c-int.sml
- c.sml
- c-debug.sml
-
- ../zstring.sig
- zstring.sml
- tag.sml
-in
- structure Tag
-
- structure MLRep
- signature C
- structure C
- signature C_INT
- structure C_Int
- signature C_DEBUG
- structure C_Debug
-
- signature ZSTRING
- structure ZString
-
- signature DYN_LINKAGE
- structure DynLinkage
-
- signature CMEMORY
- structure CMemory
-end
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.32bit-unix.mlb (from rev 4164, mlton/trunk/lib/mlnlffi/memory/memory.32bit-unix.mlb)
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.mlb (from rev 4164, mlton/trunk/lib/mlnlffi/memory/memory.mlb)
Deleted: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.x86-unix.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.x86-unix.mlb 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/memory.x86-unix.mlb 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,25 +0,0 @@
-local
- $(MLTON_ROOT)/basis/basis.mlb
- $(MLTON_ROOT)/basis/mlton.mlb
-
- linkage.sig
- ann "allowFFI true" in
- linkage-libdl.sml
- end
- bitop-fn.sml
- mlrep-i8i16i32i32i64f32f64.sml
- memaccess.sig
- memaccess-a4c1s2i4l4ll8f4d8.sml
- memalloc.sig
- ann "allowFFI true" in
- memalloc-a4-unix.sml
- end
- memory.sig
- memory.sml
-in
- signature CMEMORY
- structure CMemory
- signature DYN_LINKAGE
- structure DynLinkage
- structure MLRep
-end
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlnlffi/memory/platform (from rev 4164, mlton/trunk/lib/mlnlffi/memory/platform)
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/quick-sort.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/quick-sort.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/quick-sort.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -12,7 +12,7 @@
* This is necessary to handle duplicate elements.
*)
(* sortArray mutates the array it is passed and returns the same array *)
- val sortArray: 'a array * ('a * 'a -> bool) -> 'a array
+ val sortArray: 'a array * ('a * 'a -> bool) -> unit
val sortList: 'a list * ('a * 'a -> bool) -> 'a list
val sortVector: 'a vector * ('a * 'a -> bool) -> 'a vector
end
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/quick-sort.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/quick-sort.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/quick-sort.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -21,9 +21,9 @@
* Then, it does an insertion sort over the whole array to fix up the unsorted
* segments.
*)
-fun 'a sortArray (a: 'a array, op <= : 'a * 'a -> bool): 'a array =
+fun 'a sortArray (a: 'a array, op <= : 'a * 'a -> bool): unit =
if 0 = Array.length a
- then a
+ then ()
else
let
fun x i = sub (a, i)
@@ -41,7 +41,7 @@
then ()
else
let
- val _ = swap (l, randInt (l, u))
+ val () = swap (l, randInt (l, u))
val t = x l
(* Partition based on page 115. *)
fun loop (i, j) =
@@ -86,16 +86,23 @@
else (i, xi))
val last = length a - 1
val () = swap (m, last)
- val _ = qsort (0, last - 1)
- val _ = InsertionSort.sort (a, op <=)
+ val () = qsort (0, last - 1)
+ val () = InsertionSort.sort (a, op <=)
in
- a
+ ()
end
-fun sortList (l, f) =
- Array.toList (sortArray (Array.fromList l, f))
-
-fun sortVector (v, f) =
- Array.toVector (sortArray (Array.fromVector v, f))
+local
+ fun make (from, to) (l, f) =
+ let
+ val a = from l
+ val () = sortArray (a, f)
+ in
+ to a
+ end
+in
+ val sortList = fn z => make (Array.fromList, Array.toList) z
+ val sortVector = fn z => make (Array.fromVector, Array.toVector) z
+end
end
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string1.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string1.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string1.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -19,7 +19,7 @@
val last = String0.last
-val layout = Layout.str o escapeSML
+val layout = Layout.str
fun forall (s, f) =
let
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/gc.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/gc.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/gc.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/itimer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/itimer.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/itimer.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -278,6 +278,7 @@
structure ProcEnv =
struct
fun setenv _ = raise Fail "setenv"
+ fun setgroups _ = raise Fail "setgroups"
end
structure Process =
@@ -407,6 +408,8 @@
struct
type t = {stime: Time.time, utime: Time.time}
+ fun measureGC _ = ()
+
(* Fake it with Posix.ProcEnv.times *)
fun rusage () =
let
@@ -478,6 +481,11 @@
type t = word
end
+ structure Ctl =
+ struct
+ fun getERROR _ = NONE
+ end
+
structure Host =
struct
type t = {name: string}
@@ -495,6 +503,7 @@
fun accept _ = raise Fail "Socket.accept"
fun connect _ = raise Fail "Socket.connect"
+ fun fdToSock _ = raise Fail "Socket.fdToSock"
fun listen _ = raise Fail "Socket.listen"
fun listenAt _ = raise Fail "Socket.listenAt"
fun shutdownRead _ = raise Fail "Socket.shutdownWrite"
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/random.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/random.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/random.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/rlimit.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/rlimit.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/rlimit.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/rusage.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/rusage.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/rusage.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
@@ -11,6 +12,7 @@
stime: Time.time (* system time *)
}
+ val measureGC: bool -> unit
val rusage: unit -> {children: t,
gc: t,
self: t}
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/signal.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/signal.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/signal.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/socket.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/socket.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
@@ -15,6 +16,13 @@
type t = word
end
+ structure Ctl:
+ sig
+ val getERROR:
+ ('af, 'sock_type) Socket.sock
+ -> (string * Posix.Error.syserror option) option
+ end
+
structure Host:
sig
type t = {name: string}
@@ -36,4 +44,6 @@
val listenAt: Port.t -> t
val shutdownRead: TextIO.instream -> unit
val shutdownWrite: TextIO.outstream -> unit
+
+ val fdToSock: Posix.FileSys.file_desc -> ('af, 'sock_type) Socket.sock
end
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/syslog.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/syslog.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/syslog.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/word.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/word.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/word.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* 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.
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm 2005-11-06 21:26:45 UTC (rev 4165)
@@ -53,6 +53,7 @@
structure RealVector
structure SML90
structure SMLofNJ
+structure Socket
structure String
structure StringCvt
structure Substring
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLUT.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLUT.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLUT.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -243,35 +243,35 @@
(* Create Menu callback *)
- val gCreateMenuFA = _export "glutCreateMenuArgument": int -> unit;
+ val gCreateMenuFA = _export "glutCreateMenuArgument": (int -> unit) -> unit;
val callGCreateMenuF = _import "callGlutCreateMenu": unit -> int;
(* Display function callback *)
- val gDisplayFA = _export "glutDisplayFuncArgument": unit -> unit;
+ val gDisplayFA = _export "glutDisplayFuncArgument": (unit -> unit) -> unit;
val callGDisplayF = _import "callGlutDisplayFunc": unit -> unit;
(* Idle function callback *)
- val gIdleFA = _export "glutIdleFuncArgument": unit -> unit;
+ val gIdleFA = _export "glutIdleFuncArgument": (unit -> unit) -> unit;
val callGIdleF = _import "callGlutIdleFunc": unit -> unit;
(* Reshape function callback *)
- val gReshapeFA = _export "glutReshapeFuncArgument": int * int -> unit;
+ val gReshapeFA = _export "glutReshapeFuncArgument": (int * int -> unit) -> unit;
val callGReshapeF = _import "callGlutReshapeFunc": unit -> unit;
(* Keyboard function callback *)
- val gKbdFA = _export "glutKeyboardFuncArgument": char * int * int -> unit;
+ val gKbdFA = _export "glutKeyboardFuncArgument": (char * int * int -> unit) -> unit;
val callGKbdF = _import "callGlutKeyboardFunc": unit -> unit;
(* Mouse function callback *)
- val gMouseFA = _export "glutMouseFuncArgument": GLenum * GLenum * int * int -> unit;
+ val gMouseFA = _export "glutMouseFuncArgument": (GLenum * GLenum * int * int -> unit) -> unit;
val callGMouseF = _import "callGlutMouseFunc": unit -> unit;
(* Special function callback *)
- val gSpecFA = _export "glutSpecialFuncArgument": int * int * int -> unit;
+ val gSpecFA = _export "glutSpecialFuncArgument": (int * int * int -> unit) -> unit;
val callGSpecF = _import "callGlutSpecialFunc": unit -> unit;
(* Visibility function callback *)
- val gVisibilityFA = _export "glutVisibilityFuncArgument": Word32.word -> unit;
+ val gVisibilityFA = _export "glutVisibilityFuncArgument": (Word32.word -> unit) -> unit;
val callGVisibilityF = _import "callGlutVisibilityFunc": unit -> unit;
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLUT_c.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLUT_c.c 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLUT_c.c 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,6 +1,5 @@
/* Glut-export.c */
-#include <GL/gl.h>
-#include <GL/glut.h>
+#include "platform.h"
#include "GLUT_h.h"
int callGlutCreateMenu ()
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLU_c.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLU_c.c 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/GLU_c.c 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,5 @@
/* GLU-export.c */
-#include <GL/glu.h>
+#include "platform.h"
#include "GLU_h.h"
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/GL_c.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/GL_c.c 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/GL_c.c 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,5 +1,5 @@
/* Gl-export.c */
-#include <GL/gl.h>
+#include "platform.h"
#include "GL_h.h"
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,8 +1,8 @@
mlton = mlton
MLTON_FLAGS = \
- -default-ann 'allowExport true' \
- -default-ann 'allowImport true' \
+ -default-ann 'allowFFI true' \
-target-link-opt cygwin '-L/lib/w32api -lglut32 -lglu32 -lopengl32' \
+ -target-link-opt darwin '-framework GLUT -framework OpenGL -framework Foundation' \
-target-link-opt linux '-lglut -lGLU -lGL'
GL_OBJS = GL_c.o GLUT_c.o
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/atom.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/atom.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/atom.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -43,7 +43,7 @@
fun initialise () =
(
- glutInit;
+ glutInit();
glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGBA);
glutInitWindowPosition 100 100;
glutInitWindowSize 250 250;
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/hello.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/hello.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/hello.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -64,7 +64,7 @@
fun main () =
(
- glutInit;
+ glutInit();
glutInitDisplayMode (GLUT_SINGLE + GLUT_RGB);
glutInitWindowSize 200 200;
glutCreateWindow "Font Test";
Copied: mlton/branches/on-20050822-x86_64-branch/lib/opengl/platform.h (from rev 4164, mlton/trunk/lib/opengl/platform.h)
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/points.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/points.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/points.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -86,6 +86,7 @@
fun main () =
(
+ glutInit();
glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGBA);
glutInitWindowSize 400 400;
glutCreateWindow "Animating rectangle";
@@ -101,4 +102,4 @@
val _ = main();
-
\ No newline at end of file
+
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/shortest.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/shortest.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/shortest.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -9,7 +9,7 @@
fun main () =
(
- glutInit;
+ glutInit();
glutCreateWindow "Short Test";
glutDisplayFunc display;
print("Click the close icon to close the window.");
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/solar.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/solar.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/solar.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -29,7 +29,7 @@
fun initialise () =
(
- glutInit;
+ glutInit();
glutInitDisplayMode (GLUT_DOUBLE + GLUT_RGB);
glutInitWindowSize 200 200;
glutCreateWindow "Solar";
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/spin_cube.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/spin_cube.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/spin_cube.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -42,7 +42,7 @@
fun initialise () =
(
- glutInit;
+ glutInit();
glutInitDisplayMode (GLUT_DOUBLE+GLUT_RGB);
glutInitWindowSize 400 400;
glutCreateWindow "Spinning Cube";
Modified: mlton/branches/on-20050822-x86_64-branch/lib/opengl/triangle.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/opengl/triangle.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/lib/opengl/triangle.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -43,6 +43,7 @@
fun initialise () =
(
+ glutInit ();
glutInitDisplayMode(GLUT_DOUBLE + GLUT_RGBA);
glutInitWindowPosition 100 100;
glutInitWindowSize 250 250;
@@ -201,4 +202,4 @@
val _ = main();
-
\ No newline at end of file
+
Copied: mlton/branches/on-20050822-x86_64-branch/man/mlnlffigen.1 (from rev 4164, mlton/trunk/man/mlnlffigen.1)
Modified: mlton/branches/on-20050822-x86_64-branch/man/mlton.1
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/man/mlton.1 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/man/mlton.1 2005-11-06 21:26:45 UTC (rev 4165)
@@ -129,6 +129,12 @@
syntax, e.g., \fB-link-opt '-Wl,--export-dynamic'\fP.
.TP
+\fB-mlb-path-map \fIfile\fR
+Use file as an MLB path map to define additional MLB path variables.
+Multiple uses of \fB-mlb-path-map\fP are allowed, with variable
+definitions in later path maps taking precendence over earlier ones.
+
+.TP
\fB-output \fIfile\fR
Specify the name of the final output file.
The default name is the input file name with its suffix removed and an
Modified: mlton/branches/on-20050822-x86_64-branch/mllex/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mllex/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mllex/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -21,7 +21,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
$(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
mlton -stop sml $(NAME).cm
Modified: mlton/branches/on-20050822-x86_64-branch/mlnlffigen/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlnlffigen/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlnlffigen/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -20,7 +20,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
.PHONY: clean
clean:
Modified: mlton/branches/on-20050822-x86_64-branch/mlnlffigen/gen.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlnlffigen/gen.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlnlffigen/gen.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1475,7 +1475,7 @@
line "local ann \"allowFFI true\" in";
VBox 4;
app line ["$(SML_LIB)/basis/basis.mlb",
- "$(SML_LIB)/mlnlffi-lib/internals/c-int."^targetName^".mlb"];
+ "$(SML_LIB)/mlnlffi-lib/internals/c-int.mlb"];
app line (rev extramembers);
app line (rev (!files));
endBox ();
Modified: mlton/branches/on-20050822-x86_64-branch/mlprof/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlprof/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlprof/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -21,7 +21,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
$(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
mlton -stop sml $(NAME).cm
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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
@@ -22,17 +23,23 @@
# 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, $(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)
@@ -74,7 +81,6 @@
$(MAKE) $(UP)
@echo 'Compiling mlton (takes a while)'
mlton $(FLAGS) $(FILE)
- size $(AOUT)
#! Pass $(PATH) to upgrade-basis because it is run via #!/usr/bin/env
# bash, which resets the path.
@@ -95,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;'; \
@@ -122,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;'; \
@@ -136,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;'; \
@@ -152,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;'; \
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/allocate-registers.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/allocate-registers.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/allocate-registers.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -80,13 +80,19 @@
end
fun new (alloc): t =
- T (Array.toList
- (QuickSort.sortArray
- (Array.fromListMap (alloc, fn StackOffset.T {offset, ty} =>
- {offset = offset,
- size = Type.bytes ty}),
- fn (r, r') => Bytes.<= (#offset r, #offset r'))))
+ let
+ val a =
+ Array.fromListMap (alloc, fn StackOffset.T {offset, ty} =>
+ {offset = offset,
+ size = Type.bytes ty})
+ val () =
+ QuickSort.sortArray
+ (a, fn (r, r') => Bytes.<= (#offset r, #offset r'))
+ in
+ T (Array.toList a)
+ end
+
fun get (T alloc, ty) =
let
val slotSize = Type.bytes ty
@@ -205,10 +211,9 @@
(compress
{next = 0,
alloc =
- Array.toList
- (QuickSort.sortArray
- (Array.fromList rs, fn (r, r') =>
- Register.index r <= Register.index r'))})))
+ QuickSort.sortList
+ (rs, fn (r, r') =>
+ Register.index r <= Register.index r')})))
end
fun get (T f, ty: Type.t) =
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/backend.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/backend.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/backend.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -156,7 +156,7 @@
Regexp.Compiled.matchesAll (re, name))
then program
else pass (name, doit, program)
- val program = pass ("ToRssa", SsaToRssa.convert, (program, codegen))
+ val program = pass ("toRssa", SsaToRssa.convert, (program, codegen))
fun rssaSimplify program =
let
val program =
@@ -531,11 +531,18 @@
header = header,
size = size}
| PrimApp {dst, prim, args} =>
- Vector.new1
- (M.Statement.PrimApp
- {args = translateOperands args,
- dst = Option.map (dst, varOperand o #1),
- prim = prim})
+ let
+ datatype z = datatype Prim.Name.t
+ in
+ case Prim.name prim of
+ MLton_touch => Vector.new0 ()
+ | _ =>
+ Vector.new1
+ (M.Statement.PrimApp
+ {args = translateOperands args,
+ dst = Option.map (dst, varOperand o #1),
+ prim = prim})
+ end
| ProfileLabel s => Vector.new1 (M.Statement.ProfileLabel s)
| SetExnStackLocal =>
(* ExnStack = stackTop + (offset + WORD_SIZE) - StackBottom; *)
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/machine.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1141,10 +1141,9 @@
then offset :: liveOffsets
else liveOffsets
| _ => raise No)
- val liveOffsets =
- Vector.fromArray
- (QuickSort.sortArray
- (Array.fromList liveOffsets, Bytes.<=))
+ val liveOffsets = Array.fromList liveOffsets
+ val () = QuickSort.sortArray (liveOffsets, Bytes.<=)
+ val liveOffsets = Vector.fromArray liveOffsets
val liveOffsets' =
Vector.sub (frameOffsets, frameOffsetsIndex)
handle Subscript => raise No
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/backend/ssa-to-rssa.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1189,7 +1189,18 @@
| MLton_size =>
simpleCCall
(CFunction.size (Operand.ty (a 0)))
- | MLton_touch => none ()
+ | MLton_touch =>
+ let
+ val a = arg 0
+ val args =
+ if isSome (toRtype (varType a))
+ then Vector.new1 (varOp a)
+ else Vector.new0 ()
+ in
+ add (PrimApp {args = args,
+ dst = NONE,
+ prim = prim})
+ end
| Pointer_getPointer => pointerGet ()
| Pointer_getReal _ => pointerGet ()
| Pointer_getWord _ => pointerGet ()
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/codegen/c-codegen/c-codegen.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -529,12 +529,9 @@
layedOut = ref false,
status = ref None})
end))
- val entryLabels =
- Vector.map
- (Vector.fromArray
- (QuickSort.sortArray
- (Array.fromList (!entryLabels), fn ((_, i), (_, i')) => i <= i')),
- #1)
+ val a = Array.fromList (!entryLabels)
+ val () = QuickSort.sortArray (a, fn ((_, i), (_, i')) => i <= i')
+ val entryLabels = Vector.map (Vector.fromArray a, #1)
val labelChunk = #chunkLabel o labelInfo
val {get = chunkLabelIndex: ChunkLabel.t -> int, ...} =
Property.getSet (ChunkLabel.plist,
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sig 2005-11-06 21:26:45 UTC (rev 4165)
@@ -186,6 +186,8 @@
val maxFunctionSize: int ref
+ val mlbPathMaps: string list ref
+
structure Native:
sig
(* whether or not to use comments in native codegen *)
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/control-flags.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -705,6 +705,10 @@
val maxFunctionSize = control {name = "max function size",
default = 10000,
toString = Int.toString}
+
+val mlbPathMaps = control {name = "mlb path maps",
+ default = [],
+ toString = List.toString (fn s => s)}
structure Native =
struct
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/control/source.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/control/source.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/control/source.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -29,7 +29,12 @@
fun new file = T {file = ref file,
lineNum = ref 1,
- lineStart = ref 1}
+ (* mllex file positions start at zero, while we report errors
+ * starting in column 1, so we need to pretend the first line
+ * starts at position ~1, which will translate position 0 to
+ * column 1.
+ *)
+ lineStart = ref ~1}
fun newline (T {lineStart, lineNum, ...}, n) =
(Int.inc lineNum
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-env.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -876,20 +876,20 @@
", "))),
str " "]
val t =
- case TypeStr.node s of
- TypeStr.Datatype _ => "datatype"
- | _ =>
- if isWhere
- then "type"
- else
- let
- datatype z = datatype AdmitsEquality.t
- in
- case TypeStr.admitsEquality s of
- Always => "eqtype"
- | Never => "type"
- | Sometimes => "eqtype"
- end
+ if isWhere then
+ "type"
+ else
+ (case TypeStr.node s of
+ TypeStr.Datatype _ => "datatype"
+ | _ =>
+ let
+ datatype z = datatype AdmitsEquality.t
+ in
+ case TypeStr.admitsEquality s of
+ Always => "eqtype"
+ | Never => "type"
+ | Sometimes => "eqtype"
+ end)
val def = seq [str t, str " ", args, name, str " = "]
val res =
case TypeStr.node s of
@@ -1181,10 +1181,10 @@
uses = uses}
end)
val _ = current := old
- val a =
+ val a = Array.fromList elts
+ val () =
QuickSort.sortArray
- (Array.fromList elts,
- fn ({domain = d, ...}, {domain = d', ...}) =>
+ (a, fn ({domain = d, ...}, {domain = d', ...}) =>
Symbol.<= (toSymbol d, toSymbol d'))
in
Info.T a
@@ -1383,12 +1383,17 @@
types = doit types,
vals = doit vals})
fun ('a, 'b) finish (r, toSymbol: 'a -> Symbol.t) =
- QuickSort.sortArray
- (Array.fromList (!r),
- fn ({domain = d, time = t, ...}: ('a, 'b) Values.value,
- {domain = d', time = t',...}: ('a, 'b) Values.value) =>
- le ({domain = toSymbol d, time = t},
- {domain = toSymbol d', time = t'}))
+ let
+ val a = Array.fromList (!r)
+ val () =
+ QuickSort.sortArray
+ (a, fn ({domain = d, time = t, ...}: ('a, 'b) Values.value,
+ {domain = d', time = t',...}: ('a, 'b) Values.value) =>
+ le ({domain = toSymbol d, time = t},
+ {domain = toSymbol d', time = t'}))
+ in
+ a
+ end
in
{bass = finish (bass, Basid.toSymbol),
fcts = finish (fcts, Fctid.toSymbol),
@@ -2668,18 +2673,26 @@
Datatype {cons = sigCons, ...} =>
(case TypeStr.node structStr of
Datatype {cons = structCons, ...} =>
- (checkCons (structCons, sigCons, strids, name)
- ; (structStr, false))
- | _ => (sigStr, true))
- | Scheme s => (checkScheme s; (sigStr, false))
- | Tycon c => (checkScheme (tyconScheme c); (sigStr, false))
+ (fn () =>
+ (checkCons (structCons, sigCons, strids,
+ name)
+ ; structStr),
+ false)
+ | _ => (fn () => sigStr, true))
+ | Scheme s =>
+ (fn () => (checkScheme s; sigStr),
+ false)
+ | Tycon c =>
+ (fn () => (checkScheme (tyconScheme c); sigStr),
+ false)
in
- if not (isPlausible (structStr, strids, name,
- TypeStr.admitsEquality sigStr,
- TypeStr.kind sigStr,
- consMismatch))
- then sigStr
- else return
+ if isPlausible (structStr, strids, name,
+ TypeStr.admitsEquality sigStr,
+ TypeStr.kind sigStr,
+ consMismatch) then
+ return ()
+ else
+ sigStr
end
fun map (structInfo: ('a, 'b) Info.t,
sigArray: ('a * 'c) array,
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-sigexp.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-sigexp.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/elaborate-sigexp.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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.
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/elaborate/type-env.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -644,7 +644,13 @@
val n = !r
val l =
simple
- (str (concat ["'", Char.toString (Char.fromInt n)]))
+ (str (concat
+ ["'",
+ if n > Char.toInt #"z" then
+ concat ["a",
+ Int.toString (n - Char.toInt #"z")]
+ else
+ Char.toString (Char.fromInt n )]))
val _ = r := 1 + n
in
l
@@ -1301,10 +1307,14 @@
val unit = con (unit, Tycon.tuple, Vector.new0 ())
val unknown = unit
fun sortFields (fields: (Field.t * 'a) list) =
- Array.toVector
- (QuickSort.sortArray
- (Array.fromList fields, fn ((f, _), (f', _)) =>
- Field.<= (f, f')))
+ let
+ val a = Array.fromList fields
+ val () =
+ QuickSort.sortArray (a, fn ((f, _), (f', _)) =>
+ Field.<= (f, f'))
+ in
+ Array.toVector a
+ end
fun unsorted (t, fields: (Field.t * 'a) list) =
let
val v = sortFields fields
@@ -1484,42 +1494,46 @@
(List.fold
(flexes, Vector.toList types,
fn ({fields, spine, ...}, ac) =>
- Exn.withEscape (fn escape =>
let
- val flex =
- case List.peek (flexInsts,
- fn {spine = spine', ...} =>
- Spine.equals (spine, spine')) of
- NONE => escape ac (* Error.bug "missing flexInst" *)
- | SOME {flex, ...} => flex
- fun peekFields (fields, f) =
- Option.map
- (List.peek (fields, fn (f', _) =>
- Field.equals (f, f')),
- #2)
- val peek =
- case Type.toType flex of
- FlexRecord {fields, ...} =>
- (fn f => peekFields (fields, f))
- | GenFlexRecord {extra, fields, ...} =>
- (fn f =>
- case peekFields (fields, f) of
- NONE =>
- Option.map
- (List.peek
- (extra (), fn {field, ...} =>
- Field.equals (f, field)),
- Type.var o #tyvar)
- | SOME t => SOME t)
- | Record r => (fn f => Srecord.peek (r, f))
- | _ => Error.bug "TypeEnv.instantiate': General:strange flexInst"
+ fun done peek =
+ Spine.foldOverNew
+ (spine, fields, ac, fn (f, ac) =>
+ (case peek f of
+ NONE => Type.unit
+ | SOME t => t) :: ac)
in
- Spine.foldOverNew
- (spine, fields, ac, fn (f, ac) =>
- (case peek f of
- NONE => Type.unit
- | SOME t => t) :: ac)
- end)))
+ case List.peek (flexInsts,
+ fn {spine = spine', ...} =>
+ Spine.equals (spine, spine')) of
+ NONE => done (fn _ => NONE)
+ | SOME {flex, ...} =>
+ let
+ fun peekFields (fields, f) =
+ Option.map
+ (List.peek (fields, fn (f', _) =>
+ Field.equals (f, f')),
+ #2)
+ in
+ done
+ (case Type.toType flex of
+ FlexRecord {fields, ...} =>
+ (fn f => peekFields (fields, f))
+ | GenFlexRecord {extra, fields, ...} =>
+ (fn f =>
+ case peekFields (fields, f) of
+ NONE =>
+ Option.map
+ (List.peek
+ (extra (),
+ fn {field, ...} =>
+ Field.equals (f, field)),
+ Type.var o #tyvar)
+ | SOME t => SOME t)
+ | Record r =>
+ (fn f => Srecord.peek (r, f))
+ | _ => Error.bug "TypeEnv.instantiate': General:strange flexInst")
+ end
+ end))
in
{args = args,
instance = ty}
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/front-end/mlb-front-end.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -85,32 +85,30 @@
HashSet.new {hash = String.hash o #1}
local
fun make (file: File.t) =
- if File.canRead file
- then
- List.keepAllMap
- (File.lines file, fn line =>
- if String.forall (line, Char.isSpace)
- then NONE
- else
- case String.tokens (line, Char.isSpace) of
- [var, path] => SOME {var = var, path = path}
- | _ => Error.bug (concat ["strange mlb path mapping: ",
- file, ":: ", line]))
- else []
+ if not (File.canRead file) then
+ Error.bug (concat ["can't read MLB path map file: ", file])
+ else
+ List.keepAllMap
+ (File.lines file, fn line =>
+ if String.forall (line, Char.isSpace)
+ then NONE
+ else
+ case String.tokens (line, Char.isSpace) of
+ [var, path] => SOME {var = var, path = path}
+ | _ => Error.bug (concat ["strange mlb path mapping: ",
+ file, ":: ", line]))
val pathMap =
- (List.rev o List.concat)
- [make (concat [!Control.libDir, "/mlb-path-map"]),
- case OS.Process.getEnv "HOME" of
- NONE => []
- | SOME path => make (concat [path, "/.mlton/mlb-path-map"]),
- [{var = "LIB_MLTON_DIR",
- path = !Control.libDir},
- {var = "TARGET_ARCH",
- path = (String.toLower o MLton.Platform.Arch.toString)
- (!Control.targetArch)},
- {var = "TARGET_OS",
- path = (String.toLower o MLton.Platform.OS.toString)
- (!Control.targetOS)}]]
+ List.rev
+ (List.concat
+ [List.concat (List.map (!Control.mlbPathMaps, make)),
+ [{var = "LIB_MLTON_DIR",
+ path = !Control.libDir},
+ {var = "TARGET_ARCH",
+ path = String.toLower (MLton.Platform.Arch.toString
+ (!Control.targetArch))},
+ {var = "TARGET_OS",
+ path = String.toLower (MLton.Platform.OS.toString
+ (!Control.targetOS))}]])
fun peekPathMap var' =
case List.peek (pathMap, fn {var,...} =>
var = var') of
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-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/main/main.fun 2005-11-06 21:26:45 UTC (rev 4165)
@@ -47,11 +47,13 @@
| Yes
end
+val asOpts: {opt: string, pred: OptPred.t} list ref = ref []
val buildConstants: bool ref = ref false
-val asOpts: {opt: string, pred: OptPred.t} list ref = ref []
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
@@ -69,7 +71,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
@@ -87,27 +91,16 @@
| _ => Error.bug (concat ["strange target mapping: ", line])))
fun setTargetType (target: string, usage): unit =
- case List.peek (targetMap (), fn {target = t, ...} => t = target) of
+ case List.peek (targetMap (), fn {target = t, ...} => target = t) of
NONE => usage (concat ["invalid target: ", target])
| SOME {arch, os, ...} =>
- let
- datatype z = datatype MLton.Platform.Arch.t
+ let
open Control
in
targetArch := arch
; targetOS := os
- ; (case arch of
- Sparc => (align := Align8; codegen := CCodegen)
- | X86 => codegen := Native
- | AMD64 => codegen := Native
- | _ => 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
@@ -121,6 +114,16 @@
fun makeOptions {usage} =
let
val usage = fn s => (ignore (usage s); raise Fail "unreachable")
+ fun reportAnnotation (s, flag, e) =
+ case e of
+ Control.Elaborate.Bad =>
+ usage (concat ["invalid -", flag, " flag: ", s])
+ | Control.Elaborate.Deprecated ids =>
+ Out.output
+ (Out.error,
+ concat ["Warning: ", "deprecated annotation: ", s, ". Use ",
+ List.toString Control.Elaborate.Id.name ids, ".\n"])
+ | Control.Elaborate.Good () => ()
open Control Popt
fun push r = SpaceString (fn s => List.push (r, s))
datatype z = datatype MLton.Platform.Arch.t
@@ -134,12 +137,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}))),
@@ -157,11 +160,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
@@ -174,18 +179,14 @@
boolRef contifyIntoMain),
(Expert, "debug", " {false|true}", "produce executable with debug info",
boolRef debug),
- (Normal, "default-ann", " <ann>", "set annotation default for mlb files",
- SpaceString
- (fn s =>
- (case Control.Elaborate.processDefault s of
- Control.Elaborate.Bad =>
- usage (concat ["invalid -default-ann flag: ", s])
- | Control.Elaborate.Deprecated ids =>
- Out.output
- (Out.error,
- concat ["Warning: ", "deprecated annotation: ", s, ", use ",
- List.toString Control.Elaborate.Id.name ids, "."])
- | Control.Elaborate.Good () => ()))),
+ let
+ val flag = "default-ann"
+ in
+ (Normal, flag, " <ann>", "set annotation default for mlb files",
+ SpaceString
+ (fn s => reportAnnotation (s, flag,
+ Control.Elaborate.processDefault s)))
+ end,
(Expert, "diag-pass", " <pass>", "keep diagnostic info for pass",
SpaceString
(fn s =>
@@ -196,18 +197,15 @@
; List.push (keepPasses, re)
end
| NONE => usage (concat ["invalid -diag-pass flag: ", s])))),
- (Normal, "disable-ann", " <ann>", "disable annotation in mlb files",
- SpaceString
- (fn s =>
- (case Control.Elaborate.processEnabled (s, false) of
- Control.Elaborate.Bad =>
- usage (concat ["invalid -disable-ann flag: ", s])
- | Control.Elaborate.Deprecated ids =>
- Out.output
- (Out.error,
- concat ["Warning: ", "deprecated annotation: ", s, ", use ",
- List.toString Control.Elaborate.Id.name ids, "."])
- | Control.Elaborate.Good () => ()))),
+ let
+ val flag = "disable-ann"
+ in
+ (Normal, flag, " <ann>", "disable annotation in mlb files",
+ SpaceString
+ (fn s =>
+ reportAnnotation (s, flag,
+ Control.Elaborate.processEnabled (s, false))))
+ end,
(Expert, "drop-pass", " <pass>", "omit optimization pass",
SpaceString
(fn s => (case Regexp.fromString s of
@@ -215,18 +213,15 @@
in List.push (dropPasses, re)
end
| NONE => usage (concat ["invalid -drop-pass flag: ", s])))),
- (Expert, "enable-ann", " <ann>", "globally enable annotation",
- SpaceString
- (fn s =>
- (case Control.Elaborate.processEnabled (s, true) of
- Control.Elaborate.Bad =>
- usage (concat ["invalid -enable-ann flag: ", s])
- | Control.Elaborate.Deprecated ids =>
- Out.output
- (Out.error,
- concat ["Warning: ", "deprecated annotation: ", s, ", use ",
- List.toString Control.Elaborate.Id.name ids, "."])
- | Control.Elaborate.Good () => ()))),
+ let
+ val flag = "enable-ann"
+ in
+ (Expert, flag, " <ann>", "globally enable annotation",
+ SpaceString
+ (fn s =>
+ reportAnnotation (s, flag,
+ Control.Elaborate.processEnabled (s, true))))
+ end,
(Expert, "error-threshhold", " 20", "error threshhold",
intRef errorThreshhold),
(Expert, "expert", " {false|true}", "enable expert status",
@@ -281,6 +276,8 @@
boolRef markCards),
(Expert, "max-function-size", " <n>", "max function size (blocks)",
intRef maxFunctionSize),
+ (Normal, "mlb-path-map", " <file>", "additional MLB path map",
+ SpaceString (fn s => mlbPathMaps := !mlbPathMaps @ [s])),
(Expert, "native-commented", " <n>", "level of comments (0)",
intRef Native.commented),
(Expert, "native-copy-prop", " {true|false}",
@@ -450,9 +447,10 @@
| 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);
+ setTargetType (t, usage)))),
(Normal, "target-as-opt", " <target> <opt>", "target-dependent assembler option",
(SpaceString2
(fn (target, opt) =>
@@ -475,7 +473,7 @@
"0" => Silent
| "1" => Top
| "2" => Pass
- | "3" => Detail
+ | "3" => Detail
| _ => usage (concat ["invalid -verbose arg: ", s])))),
(Expert, "warn-ann", " {true|false}",
"unrecognized annotation warnings",
@@ -512,9 +510,22 @@
(libDir := OS.Path.mkCanonical lib
; args)
| _ => Error.bug "incorrect args from shell script"
- val _ = setTargetType ("self", usage)
+ 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
(Layout.outputl (Control.Elaborate.document {expert = !expert},
Out.standard)
@@ -538,8 +549,7 @@
case target of
Cross s => s
| Self => "self"
- val _ = libTargetDir := concat [!libDir, "/", targetStr]
- val targetArch = !targetArch
+ val _ = libTargetDir := OS.Path.concat (!libDir, targetStr)
val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
val targetOS = !targetOS
val () =
@@ -708,7 +718,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/branches/on-20050822-x86_64-branch/mlyacc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlyacc/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlyacc/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -21,7 +21,6 @@
$(NAME): $(NAME).mlb $(shell PATH=$(BIN):$$PATH && $(MLTON) -stop f $(NAME).mlb)
@echo 'Compiling $(NAME)'
$(MLTON) $(FLAGS) $(NAME).mlb
- size $(NAME)
$(NAME).sml: $(NAME).cm $(shell $(MLTON) -stop f $(NAME).cm)
mlton -stop sml $(NAME).cm
Modified: mlton/branches/on-20050822-x86_64-branch/mlyacc/doc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlyacc/doc/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/mlyacc/doc/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -23,3 +23,7 @@
mlyacc.ps: mlyacc.dvi
dvips -o mlyacc.ps mlyacc.dvi
+
+.PHONY: clean
+clean:
+ ../../bin/clean
Modified: mlton/branches/on-20050822-x86_64-branch/package/debian/changelog
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/debian/changelog 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/package/debian/changelog 2005-11-06 21:26:45 UTC (rev 4165)
@@ -1,3 +1,63 @@
+mlton (20051102-1) unstable; urgency=low
+
+ * new upstream version
+
+ -- Stephen Weeks <sweeks@sweeks.com> Wed, 02 Nov 2005 18:45:50 -0800
+
+mlton (20050930-1) unstable; urgency=low
+
+ * Fixed postinst problem. closes: #329692
+
+ -- Stephen Weeks <sweeks@sweeks.com> Fri, 30 Sep 2005 09:19:50 -0700
+
+mlton (20050906-1) unstable; urgency=low
+
+ * Replaces -mv8 with -mcpu=v8 for Sparc.
+
+ -- Stephen Weeks <sweeks@sweeks.com> Tue, 06 Sep 2005 14:57:46 -0700
+
+mlton (20050901-1) unstable; urgency=low
+
+ * remaking package, linking normally with libgmp. Thus, the package
+ will depend on libgmp3c2, but that is OK for unstable.
+ * Fixed postinst script. closes: #325850
+
+ -- Stephen Weeks <sweeks@sweeks.com> Thu, 01 Sep 2005 00:20:20 -0700
+
+mlton (20050826-1) unstable; urgency=low
+
+ * new upstream version
+ * Fixed broken $lib in mlton script. The previous package didn't
+ work at all.
+
+ -- Stephen Weeks <sweeks@sweeks.com> Thu, 25 Aug 2005 13:33:41 -0700
+
+mlton (20050825-1) unstable; urgency=low
+
+ * new upstream version
+ * don't build statically, just link statically with libgmp.a
+
+ -- Stephen Weeks <sweeks@sweeks.com> Thu, 25 Aug 2005 06:14:06 -0700
+
+mlton (20050824-1) unstable; urgency=low
+
+ * new upstream version
+ * built statically, closes: #324859
+
+ -- Stephen Weeks <sweeks@sweeks.com> Wed, 24 Aug 2005 15:13:19 -0700
+
+mlton (20050823-1) unstable; urgency=low
+
+ * new upstream version
+
+ -- Stephen Weeks <sweeks@sweeks.com> Tue, 23 Aug 2005 14:56:59 -0700
+
+mlton (20050822-1) unstable; urgency=low
+
+ * new upstream version
+
+ -- Stephen Weeks <sweeks@sweeks.com> Mon, 22 Aug 2005 17:13:09 -0700
+
mlton (20041109-1) unstable; urgency=low
* new upstream version
Modified: mlton/branches/on-20050822-x86_64-branch/package/debian/control
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/debian/control 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/package/debian/control 2005-11-06 21:26:45 UTC (rev 4165)
@@ -2,18 +2,18 @@
Section: devel
Priority: optional
Maintainer: Stephen Weeks <sweeks@sweeks.com>
-Build-Depends: hevea, mlton (>= 20020410.1), libgmp3-dev (>= 4.0.1), tetex-bin, tetex-extra, time
-Standards-Version: 3.6.1
+Build-Depends: mlton (>= 20041109-1), libgmp3-dev (>= 4.0.1), tetex-bin, tetex-extra, time
+Standards-Version: 3.6.2
Package: mlton
Architecture: hppa i386 powerpc sparc
Depends: ${shlibs:Depends}, gcc, libgmp3-dev (>= 4.0.1)
Description: Optimizing compiler for Standard ML
- MLton (www.mlton.org) is a whole-program
- optimizing compiler for Standard ML. MLton
- generates standalone executables with excellent
- runtime performance, is SML 97 compliant, and
- has a complete basis library. MLton has
- source-level profiling, a fast C FFI, an
- interface to the GNU multiprecision library,
- and lots of useful libraries.
+ MLton (mlton.org) is a whole-program optimizing
+ compiler for Standard ML. MLton generates
+ standalone executables with excellent runtime
+ performance, is SML 97 compliant, and has a
+ complete basis library. MLton has source-level
+ profiling, a fast C FFI, an interface to the GNU
+ multiprecision library, and lots of useful
+ libraries.
Copied: mlton/branches/on-20050822-x86_64-branch/package/debian/mlton.doc-base (from rev 4164, mlton/trunk/package/debian/mlton.doc-base)
Modified: mlton/branches/on-20050822-x86_64-branch/package/debian/rules
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/package/debian/rules 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/package/debian/rules 2005-11-06 21:26:45 UTC (rev 4165)
@@ -35,12 +35,14 @@
binary-arch: build install
# dh_installdeb
mkdir -p $(BUILDDIR)/DEBIAN
- for f in postinst prerm; do \
- $(CP) debian/mlton.$$f $(BUILDDIR)/DEBIAN/$$f; \
+ for f in postinst prerm; do \
+ $(CP) debian/mlton.$$f $(BUILDDIR)/DEBIAN/$$f; \
+ chown root.root $(BUILDDIR)/DEBIAN/$$f; \
done
# dh_shlibdeps
dpkg-shlibdeps \
-e$(BUILDDIR)/usr/bin/mllex \
+ -e$(BUILDDIR)/usr/bin/mlnlffigen \
-e$(BUILDDIR)/usr/bin/mlprof \
-e$(BUILDDIR)/usr/bin/mlyacc \
-e$(BUILDDIR)/usr/lib/mlton/mlton-compile
Copied: mlton/branches/on-20050822-x86_64-branch/package/mingw (from rev 4164, mlton/trunk/package/mingw)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/filesys.x86-cygwin.ok (from rev 4164, mlton/trunk/regression/filesys.x86-cygwin.ok)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/finalize.3.ok (from rev 4164, mlton/trunk/regression/finalize.3.ok)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/finalize.3.sml (from rev 4164, mlton/trunk/regression/finalize.3.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/finalize.4.ok (from rev 4164, mlton/trunk/regression/finalize.4.ok)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/finalize.4.sml (from rev 4164, mlton/trunk/regression/finalize.4.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/finalize.5.ok (from rev 4164, mlton/trunk/regression/finalize.5.ok)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/finalize.5.sml (from rev 4164, mlton/trunk/regression/finalize.5.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/regression/flexrecord.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/regression/flexrecord.sml 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/regression/flexrecord.sml 2005-11-06 21:26:45 UTC (rev 4165)
@@ -93,3 +93,9 @@
()
end
(* flexrecord8 *)
+
+(* flexrecord9 *)
+val g = fn {...} => ()
+and h = fn () => ()
+val () = (h (); g {a = 13})
+(* flexrecord9 *)
Copied: mlton/branches/on-20050822-x86_64-branch/regression/unixpath.x86-cygwin.ok (from rev 4164, mlton/trunk/regression/unixpath.x86-cygwin.ok)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/Makefile 2005-11-06 21:26:45 UTC (rev 4165)
@@ -28,11 +28,11 @@
endif
ifeq ($(TARGET_ARCH), sparc)
-FLAGS += -mv8 -m32
+FLAGS += -mcpu=v8 -m32
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)
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/basis/GC.c 2005-11-06 21:26:45 UTC (rev 4165)
@@ -16,8 +16,8 @@
gcState.summary = b;
}
-void GC_setRusage () {
- gcState.rusageIsEnabled = TRUE;
+void GC_setRusageMeasureGC (Int b) {
+ gcState.rusageMeasureGC = b;
}
void MLton_GC_pack () {
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.c 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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,
@@ -4430,7 +4430,7 @@
s->alignment));
assert (isAligned (GC_NORMAL_HEADER_SIZE + sizeof (struct GC_weak),
s->alignment));
- MLton_Platform_CygwinUseMmap = FALSE;
+ MLton_Platform_CygwinUseMmap = TRUE;
s->amInGC = TRUE;
s->amInMinorGC = FALSE;
s->bytesAllocated = 0;
@@ -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/branches/on-20050822-x86_64-branch/runtime/gc.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc.h 2005-11-06 21:26:45 UTC (rev 4165)
@@ -47,8 +47,8 @@
* of all nonpointer data followed by all pointer data.
*
* 19 bits means that there are only 2^19 different different object layouts,
- * which appears to be plenty, since there were < 128 different types required
- * for a self-compile.
+ * which appears to be plenty, since there were < 10,000 different types
+ * required for a self-compile.
*/
/* Sizes are (almost) always measured in bytes. */
@@ -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. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.c 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.c 2005-11-06 21:26:45 UTC (rev 4165)
@@ -341,6 +341,11 @@
int setgid (gid_t gid) {
die ("setgid not implemented");
}
+
+int setgroups (size_t size, gid_t *list) {
+ die ("setgroups not implemented");
+}
+
int setpgid (pid_t pid, pid_t pgid) {
die ("setpgid not implemented");
}
@@ -484,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/branches/on-20050822-x86_64-branch/runtime/platform/mingw.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.h 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform/mingw.h 2005-11-06 21:26:45 UTC (rev 4165)
@@ -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
@@ -262,6 +265,7 @@
uid_t getuid (void);
int setenv (const char *name, const char *value, int overwrite);
int setgid (gid_t gid);
+int setgroups (size_t size, gid_t *list);
int setpgid (pid_t pid, pid_t pgid);
pid_t setsid (void);
int setuid (uid_t uid);
@@ -301,6 +305,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);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/platform.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2005-11-06 21:12:46 UTC (rev 4164)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/platform.h 2005-11-06 21:26:45 UTC (rev 4165)
@@ -167,19 +167,37 @@
#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
+#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
+#endif
/* If HAS_TIME_PROFILING, then you must define these. */
void *getTextStart ();