Menu
▾
▴
mlton-commit — [MLton-commit] Code commits
You can subscribe to this list here.
| 2005 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(56) |
Sep
(40) |
Oct
(30) |
Nov
(144) |
Dec
(23) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2006 |
Jan
(41) |
Feb
(29) |
Mar
(31) |
Apr
(39) |
May
(193) |
Jun
(45) |
Jul
(19) |
Aug
(3) |
Sep
(23) |
Oct
(83) |
Nov
(92) |
Dec
(123) |
| 2007 |
Jan
(90) |
Feb
(267) |
Mar
(120) |
Apr
(51) |
May
(40) |
Jun
(121) |
Jul
(109) |
Aug
(173) |
Sep
(77) |
Oct
(52) |
Nov
(121) |
Dec
(62) |
| 2008 |
Jan
(76) |
Feb
(53) |
Mar
(98) |
Apr
(87) |
May
(26) |
Jun
(27) |
Jul
(23) |
Aug
(136) |
Sep
(79) |
Oct
(68) |
Nov
(29) |
Dec
(14) |
| 2009 |
Jan
(7) |
Feb
(2) |
Mar
(11) |
Apr
(75) |
May
(1) |
Jun
(95) |
Jul
(19) |
Aug
(4) |
Sep
(8) |
Oct
(93) |
Nov
(43) |
Dec
(21) |
| 2010 |
Jan
(20) |
Feb
(23) |
Mar
(18) |
Apr
(6) |
May
(20) |
Jun
(23) |
Jul
(1) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2011 |
Jan
(2) |
Feb
(6) |
Mar
(15) |
Apr
(5) |
May
(9) |
Jun
(14) |
Jul
(9) |
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(2) |
Jun
(17) |
Jul
(37) |
Aug
|
Sep
(1) |
Oct
(6) |
Nov
|
Dec
|
| 2013 |
Jan
|
Feb
|
Mar
(5) |
Apr
(2) |
May
(7) |
Jun
(11) |
Jul
(8) |
Aug
|
Sep
(1) |
Oct
(2) |
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
(2) |
Mar
(1) |
Apr
|
May
(1) |
Jun
(1) |
Jul
(7) |
Aug
(2) |
Sep
|
Oct
(5) |
Nov
(2) |
Dec
(4) |
| 2015 |
Jan
|
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(9) |
Jul
(1) |
Aug
|
Sep
|
Oct
(4) |
Nov
(1) |
Dec
|
| 2016 |
Jan
(2) |
Feb
(1) |
Mar
(1) |
Apr
(1) |
May
(1) |
Jun
(2) |
Jul
(1) |
Aug
|
Sep
(5) |
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
(1) |
Feb
(3) |
Mar
(3) |
Apr
(7) |
May
(2) |
Jun
(2) |
Jul
(5) |
Aug
(1) |
Sep
(2) |
Oct
(17) |
Nov
(4) |
Dec
(7) |
| 2018 |
Jan
(5) |
Feb
(14) |
Mar
(2) |
Apr
(5) |
May
(2) |
Jun
(5) |
Jul
|
Aug
(2) |
Sep
|
Oct
(3) |
Nov
(5) |
Dec
|
| 2019 |
Jan
(4) |
Feb
(2) |
Mar
(3) |
Apr
(1) |
May
(8) |
Jun
(14) |
Jul
(2) |
Aug
|
Sep
(2) |
Oct
(2) |
Nov
(15) |
Dec
(2) |
| 2020 |
Jan
(10) |
Feb
(3) |
Mar
(1) |
Apr
|
May
(9) |
Jun
(4) |
Jul
(16) |
Aug
(10) |
Sep
(4) |
Oct
(3) |
Nov
|
Dec
|
| 2021 |
Jan
(11) |
Feb
(2) |
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
|
Oct
(6) |
Nov
(4) |
Dec
(4) |
| 2022 |
Jan
(4) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(6) |
Jun
(3) |
Jul
|
Aug
(1) |
Sep
|
Oct
|
Nov
(1) |
Dec
|
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
(2) |
May
(5) |
Jun
(1) |
Jul
(4) |
Aug
(1) |
Sep
|
Oct
(1) |
Nov
(13) |
Dec
|
| 2024 |
Jan
(1) |
Feb
|
Mar
(5) |
Apr
|
May
(10) |
Jun
|
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
(1) |
Dec
(14) |
| 2025 |
Jan
(3) |
Feb
|
Mar
(1) |
Apr
|
May
(2) |
Jun
(3) |
Jul
|
Aug
|
Sep
(2) |
Oct
(3) |
Nov
|
Dec
|
|
From: Matthew F. <fl...@ml...> - 2005-11-06 13:27:33
|
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 (bl...@re...)
*)
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-x8...
[truncated message content] |
|
From: Matthew F. <fl...@ml...> - 2005-11-06 13:12:48
|
Need to setTargetType to "self" for non x86-linux platforms.
----------------------------------------------------------------------
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-06 20:04:36 UTC (rev 4163)
+++ mlton/trunk/mlton/main/main.fun 2005-11-06 21:12:46 UTC (rev 4164)
@@ -90,6 +90,17 @@
end
| _ => Error.bug (concat ["strange target mapping: ", line])))
+fun setTargetType (target: string, usage): unit =
+ case List.peek (targetMap (), fn {target = t, ...} => target = t) of
+ NONE => usage (concat ["invalid target: ", target])
+ | SOME {arch, os, ...} =>
+ let
+ open Control
+ in
+ targetArch := arch
+ ; targetOS := os
+ end
+
fun hasNative () =
let
datatype z = datatype Control.arch
@@ -439,9 +450,7 @@
SpaceString
(fn t =>
(target := (if t = "self" then Self else Cross t);
- case List.peek (targetMap (), fn {target = t', ...} => t = t') of
- NONE => usage (concat ["invalid target: ", t])
- | SOME {arch, os, ...} => (targetArch := arch; targetOS := os)))),
+ setTargetType (t, usage)))),
(Normal, "target-as-opt", " <target> <opt>", "target-dependent assembler option",
(SpaceString2
(fn (target, opt) =>
@@ -501,6 +510,7 @@
(libDir := OS.Path.mkCanonical lib
; args)
| _ => Error.bug "incorrect args from shell script"
+ val () = setTargetType ("self", usage)
val result = parse args
val targetArch = !targetArch
val () =
|
|
From: Matthew F. <fl...@ml...> - 2005-11-06 12:04:37
|
Wrong path to clean ---------------------------------------------------------------------- U mlton/trunk/mlyacc/doc/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/mlyacc/doc/Makefile =================================================================== --- mlton/trunk/mlyacc/doc/Makefile 2005-11-06 18:39:37 UTC (rev 4162) +++ mlton/trunk/mlyacc/doc/Makefile 2005-11-06 20:04:36 UTC (rev 4163) @@ -26,4 +26,4 @@ .PHONY: clean clean: - ../bin/clean + ../../bin/clean |
|
From: Matthew F. <fl...@ml...> - 2005-11-06 10:39:38
|
Makefile clean target ---------------------------------------------------------------------- U mlton/trunk/mlyacc/doc/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/mlyacc/doc/Makefile =================================================================== --- mlton/trunk/mlyacc/doc/Makefile 2005-11-06 17:12:54 UTC (rev 4161) +++ mlton/trunk/mlyacc/doc/Makefile 2005-11-06 18:39:37 UTC (rev 4162) @@ -23,3 +23,7 @@ mlyacc.ps: mlyacc.dvi dvips -o mlyacc.ps mlyacc.dvi + +.PHONY: clean +clean: + ../bin/clean |
|
From: Matthew F. <fl...@ml...> - 2005-11-06 09:13:48
|
More cleanup
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/call-stack.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/call-stack.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_predicates.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-11-06 17:12:54 UTC (rev 4161)
@@ -83,6 +83,7 @@
array-allocate.c \
array.c \
atomic.c \
+ call-stack.c \
cheney-copy.c \
controls.c \
copy-thread.c \
@@ -109,6 +110,7 @@
new-object.c \
object-size.c \
object.c \
+ object_predicates.c \
pack.c \
pointer.c \
pointer_predicates.c \
@@ -116,6 +118,7 @@
share.c \
signals.c \
size.c \
+ sources.c \
stack.c \
stack_predicates.c \
switch-thread.c \
@@ -167,6 +170,8 @@
garbage-collection.h \
new-object.h \
array-allocate.h \
+ sources.h \
+ call-stack.h \
profiling.h \
init-world.h \
world.h \
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-06 17:12:54 UTC (rev 4161)
@@ -1,6 +1,7 @@
* reorder ZZZ_TYPE_INDEX
* eliminate STRING_TYPE_INDEX, STRING_TYPE_HEADER in favor of WORD8.
+* reorder SOURCE_SEQ_UNKNOWN
* fix semantics of numNonPointers for normal objects to mean bytes of
non-pointer data, rather than number of 32-bit words of
non-pointer data. Rename to sizeNonPointers.
@@ -19,4 +20,4 @@
be unnecessary.
* Why do {load,save}Globals differ in the representation of the file?
* Why does hash-table use malloc/free while generational maps use mmap/munmap?
-
+* The succssor field of GC_source appears to be unused.
\ No newline at end of file
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/align.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -47,38 +47,3 @@
static inline size_t pad (GC_state s, size_t bytes, size_t extra) {
return align (bytes + extra, s->alignment) - extra;
}
-
-#if ASSERT
-static inline bool isAlignedFrontier (GC_state s, pointer p) {
- return isAligned ((size_t)p + GC_NORMAL_HEADER_SIZE,
- s->alignment);
-}
-#endif
-
-static inline pointer alignFrontier (GC_state s, pointer p) {
- size_t res;
-
- res = pad (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
- if (DEBUG_STACKS)
- fprintf (stderr, FMTPTR" = stackReserved ("FMTPTR")\n",
- (uintptr_t)p, (uintptr_t)res);
- assert (isAlignedFrontier (s, (pointer)res));
- return (pointer)res;
-}
-
-#if ASSERT
-static inline bool isAlignedStackReserved (GC_state s, size_t reserved) {
- return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved,
- s->alignment);
-}
-#endif
-
-static inline size_t alignStackReserved (GC_state s, size_t reserved) {
- size_t res;
-
- res = pad (s, reserved, GC_STACK_HEADER_SIZE + sizeof (struct GC_stack));
- if (DEBUG_STACKS)
- fprintf (stderr, "%zu = alignStackReserved (%zu)\n", res, reserved);
- assert (isAlignedStackReserved (s, res));
- return res;
-}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -62,7 +62,7 @@
}
frontier = s->frontier;
last = frontier + arraySize;
- assert (isAlignedFrontier (s, last));
+ assert (isFrontierAligned (s, last));
s->frontier = last;
}
*((GC_arrayCounter*)(frontier)) = 0;
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/call-stack.c (from rev 4158, mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c 2005-11-04 22:09:10 UTC (rev 4158)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/call-stack.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -0,0 +1,47 @@
+/* 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.
+ */
+
+static void numStackFramesAux (GC_state s,
+ __attribute__ ((unused)) GC_frameIndex i) {
+ s->callStackState.numStackFrames++;
+}
+
+uint32_t GC_numStackFrames (GC_state s) {
+ s->callStackState.numStackFrames = 0;
+ foreachStackFrame (s, numStackFramesAux);
+ if (DEBUG_CALL_STACK)
+ fprintf (stderr, "%"PRIu32" = GC_numStackFrames\n",
+ s->callStackState.numStackFrames);
+ return s->callStackState.numStackFrames;
+}
+
+static void callStackAux (GC_state s,
+ GC_frameIndex i) {
+ if (DEBUG_CALL_STACK)
+ fprintf (stderr, "callStackAux ("FMTFI")\n", i);
+ s->callStackState.callStack[s->callStackState.numStackFrames] = i;
+ s->callStackState.numStackFrames++;
+}
+
+void GC_callStack (GC_state s, pointer p) {
+ if (DEBUG_CALL_STACK)
+ fprintf (stderr, "GC_callStack\n");
+ s->callStackState.numStackFrames = 0;
+ s->callStackState.callStack = (uint32_t*)p;
+ foreachStackFrame (s, callStackAux);
+}
+
+uint32_t* GC_frameIndexSourceSeq (GC_state s, GC_frameIndex frameIndex) {
+ uint32_t *res;
+
+ res = s->sourceMaps.sourceSeqs[s->sourceMaps.frameSources[frameIndex]];
+ if (DEBUG_CALL_STACK)
+ fprintf (stderr, FMTPTR" = GC_frameIndexSourceSeq ("FMTFI")\n",
+ (uintptr_t)res, frameIndex);
+ return res;
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/call-stack.h (from rev 4158, mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-11-04 22:09:10 UTC (rev 4158)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/call-stack.h 2005-11-06 17:12:54 UTC (rev 4161)
@@ -0,0 +1,16 @@
+/* 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.
+ */
+
+struct GC_callStackState {
+ uint32_t numStackFrames;
+ uint32_t *callStack;
+};
+
+uint32_t GC_numStackFrames (GC_state s);
+void GC_callStack (GC_state s, pointer p);
+uint32_t* GC_frameIndexSourceSeq (GC_state s, GC_frameIndex frameIndex);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -120,7 +120,7 @@
s->forwardState.toStart = s->heap.start + s->heap.oldGenSize;
if (DEBUG_GENERATIONAL)
fprintf (stderr, "toStart = "FMTPTR"\n", (uintptr_t)s->forwardState.toStart);
- assert (isAlignedFrontier (s, s->forwardState.toStart));
+ assert (isFrontierAligned (s, s->forwardState.toStart));
s->forwardState.toLimit = s->forwardState.toStart + bytesAllocated;
assert (invariantForGC (s));
s->cumulativeStatistics.numMinorGCs++;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/debug.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -24,6 +24,7 @@
DEBUG_SHARE = FALSE,
DEBUG_SIGNALS = FALSE,
DEBUG_SIZE = FALSE,
+ DEBUG_SOURCES = FALSE,
DEBUG_STACKS = FALSE,
DEBUG_THREADS = FALSE,
DEBUG_WEAK = FALSE,
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/foreach.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -178,7 +178,7 @@
GC_foreachObjptrFun f, bool skipWeaks) {
pointer b;
- assert (isAlignedFrontier (s, front));
+ assert (isFrontierAligned (s, front));
if (DEBUG_DETAILED)
fprintf (stderr,
"foreachObjptrInRange front = "FMTPTR" *back = "FMTPTR"\n",
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/forward.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -71,7 +71,7 @@
*/
if (stack->used <= stack->reserved / 4) {
size_t new =
- alignStackReserved
+ alignStackReserved
(s, max (stack->reserved / 2,
sizeofStackMinimumReserved (s, stack)));
/* It's possible that new > stack->reserved if the stack
@@ -180,7 +180,7 @@
cardStart = oldGenStart;
checkAll:
assert (cardIndex <= maxCardIndex);
- assert (isAlignedFrontier (s, objectStart));
+ assert (isFrontierAligned (s, objectStart));
if (cardIndex == maxCardIndex)
goto done;
checkCard:
@@ -198,7 +198,7 @@
cardIndex, (uintptr_t)objectStart);
lastObject = objectStart;
skipObjects:
- assert (isAlignedFrontier (s, objectStart));
+ assert (isFrontierAligned (s, objectStart));
size = sizeofObject (s, advanceToObjectData (s, objectStart));
if (objectStart + size < cardStart) {
objectStart += size;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -55,7 +55,7 @@
/*uintToCommaString*/(oldGenBytesRequested),
/*uintToCommaString*/(nurseryBytesRequested));
h = &s->heap;
- assert (isAlignedFrontier (s, h->start + h->oldGenSize + oldGenBytesRequested));
+ assert (isFrontierAligned (s, h->start + h->oldGenSize + oldGenBytesRequested));
nurserySize = h->size - h->oldGenSize - oldGenBytesRequested;
s->limitPlusSlop = h->start + h->size;
s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP;
@@ -106,6 +106,6 @@
s->heap.nursery = alignFrontier (s, s->limitPlusSlop - nurserySize);
s->frontier = s->heap.nursery;
assert (nurseryBytesRequested <= (size_t)(s->limitPlusSlop - s->frontier));
- assert (isAlignedFrontier (s, s->heap.nursery));
+ assert (isFrontierAligned (s, s->heap.nursery));
assert (hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/gc_state.h 2005-11-06 17:12:54 UTC (rev 4161)
@@ -11,9 +11,10 @@
bool amInGC;
bool amOriginal;
char **atMLtons; /* Initial @MLton args, processed before command line. */
- int32_t atMLtonsLength;
+ uint32_t atMLtonsLength;
uint32_t atomicState;
objptr callFromCHandlerThread; /* Handler for exported C calls (in heap). */
+ struct GC_callStackState callStackState;
bool canMinor; /* TRUE iff there is space for a minor gc. */
struct GC_controls controls;
struct GC_cumulativeStatistics cumulativeStatistics;
@@ -49,6 +50,7 @@
struct GC_heap secondaryHeap; /* Used for major copying collection. */
objptr signalHandlerThread; /* Handler for signals (in heap). */
struct GC_signalsInfo signalsInfo;
+ struct GC_sourceMaps sourceMaps;
pointer stackBottom; /* Bottom of stack in current thread. */
pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
pointer stackTop; /* Top of stack in current thread. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -49,7 +49,7 @@
GC_intInf bp;
unsigned char *cp;
- assert (isAlignedFrontier (s, s->frontier));
+ assert (isFrontierAligned (s, s->frontier));
frontier = s->frontier;
for (i= 0; i < s->intInfInitsLength; i++) {
inits = &s->intInfInits[i];
@@ -111,7 +111,7 @@
bp->isneg = neg;
frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
}
- assert (isAlignedFrontier (s, frontier));
+ assert (isFrontierAligned (s, frontier));
GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
s->frontier = frontier;
s->cumulativeStatistics.bytesAllocated += frontier - s->frontier;
@@ -122,7 +122,7 @@
pointer frontier;
uint32_t i;
- assert (isAlignedFrontier (s, s->frontier));
+ assert (isFrontierAligned (s, s->frontier));
inits = s->vectorInits;
frontier = s->frontier;
for (i = 0; i < s->vectorInitsLength; i++) {
@@ -171,7 +171,7 @@
(uintptr_t)frontier);
GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
s->cumulativeStatistics.bytesAllocated += (size_t)(frontier - s->frontier);
- assert (isAlignedFrontier (s, frontier));
+ assert (isFrontierAligned (s, frontier));
s->frontier = frontier;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -184,8 +184,8 @@
if (i == argc)
die ("@MLton ram-slop missing argument.");
s->controls.ratios.ramSlop = stringToFloat (argv[i++]);
- } else if (0 == strcmp (arg, "show-prof")) {
- showProf (s);
+ } else if (0 == strcmp (arg, "show-sources")) {
+ showSources (s);
exit (0);
} else if (0 == strcmp (arg, "stop")) {
i++;
@@ -308,21 +308,24 @@
fprintf (stderr, "total RAM = %zu RAM = %zu\n",
/*uintToCommaString*/(s->sysvals.totalRam),
/*uintToCommaString*/(s->sysvals.ram));
- if (DEBUG_PROFILE) {
+ if (DEBUG_SOURCES or DEBUG_PROFILE) {
uint32_t i;
- for (i = 0; i < s->profiling.frameSourcesLength; i++) {
+ for (i = 0; i < s->sourceMaps.frameSourcesLength; i++) {
uint32_t j;
uint32_t *sourceSeq;
fprintf (stderr, "%"PRIu32"\n", i);
- sourceSeq = s->profiling.sourceSeqs[s->profiling.frameSources[i]];
+ sourceSeq = s->sourceMaps.sourceSeqs[s->sourceMaps.frameSources[i]];
for (j = 1; j <= sourceSeq[0]; j++)
fprintf (stderr, "\t%s\n",
- s->profiling.sourceNames[s->profiling.sources[sourceSeq[j]].nameIndex]);
+ s->sourceMaps.sourceNames[
+ s->sourceMaps.sources[sourceSeq[j]].sourceNameIndex
+ ]);
}
}
/* Initialize profiling. This must occur after processing
- * command-line arguments, because those may just be doing a show
- * prof, in which case we don't want to initialize the atExit.
+ * command-line arguments, because those may just be doing a
+ * show-sources, in which case we don't want to initialize the
+ * atExit.
*/
initProfiling (s);
if (s->amOriginal) {
@@ -334,7 +337,7 @@
} else {
loadWorldFromFileName (s, worldFile);
if (s->profiling.isOn and s->profiling.stack)
- foreachStackFrame (s, enterFrame);
+ foreachStackFrame (s, enterFrameForProfiling);
assert (invariantForMutator (s, TRUE, TRUE));
}
s->amInGC = FALSE;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -41,9 +41,9 @@
}
assert (isAligned (s->heap.size, s->sysvals.pageSize));
assert (isAligned ((size_t)s->heap.start, CARD_SIZE));
- assert (isAlignedFrontier (s, s->heap.start + s->heap.oldGenSize));
- assert (isAlignedFrontier (s, s->heap.nursery));
- assert (isAlignedFrontier (s, s->frontier));
+ assert (isFrontierAligned (s, s->heap.start + s->heap.oldGenSize));
+ assert (isFrontierAligned (s, s->heap.nursery));
+ assert (isFrontierAligned (s, s->frontier));
assert (s->heap.nursery <= s->frontier);
unless (0 == s->heap.size) {
assert (s->heap.nursery <= s->frontier);
@@ -66,7 +66,7 @@
assertIsObjptrInFromSpace, FALSE);
/* Current thread. */
GC_stack stack = getStackCurrent(s);
- assert (isAlignedStackReserved (s, stack->reserved));
+ assert (isStackReservedAligned (s, stack->reserved));
assert (s->stackBottom == getStackBottom (s, stack));
assert (s->stackTop == getStackTop (s, stack));
assert (s->stackLimit == getStackLimit (s, stack));
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -86,6 +86,17 @@
*numObjptrsRet = numObjptrs;
}
+pointer alignFrontier (GC_state s, pointer p) {
+ size_t res;
+
+ res = pad (s, (size_t)p, GC_NORMAL_HEADER_SIZE);
+ if (DEBUG_STACKS)
+ fprintf (stderr, FMTPTR" = alignFrontier ("FMTPTR")\n",
+ (uintptr_t)p, (uintptr_t)res);
+ assert (isFrontierAligned (s, (pointer)res));
+ return (pointer)res;
+}
+
/* advanceToObjectData (s, p)
*
* If p points at the beginning of an object, then advanceToObjectData
@@ -95,7 +106,7 @@
GC_header header;
pointer res;
- assert (isAlignedFrontier (s, p));
+ assert (isFrontierAligned (s, p));
header = *(GC_header*)p;
if (0 == header)
/* Looking at the counter word in an array. */
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object.h 2005-11-06 17:12:54 UTC (rev 4161)
@@ -120,4 +120,9 @@
void splitHeader (GC_state s, GC_header header,
GC_objectTypeTag *tagRet, bool *hasIdentityRet,
uint16_t *numNonObjptrsRet, uint16_t *numObjptrsRet);
+
+bool isFrontierAligned (GC_state s, pointer p);
+pointer alignFrontier (GC_state s, pointer p);
+
pointer advanceToObjectData (GC_state s, pointer p);
+
Added: mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_predicates.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_predicates.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/object_predicates.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -0,0 +1,15 @@
+/* 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.
+ */
+
+#if ASSERT
+bool isFrontierAligned (GC_state s, pointer p) {
+ return isAligned ((size_t)p + GC_NORMAL_HEADER_SIZE,
+ s->alignment);
+}
+#endif
+
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -6,140 +6,54 @@
* See the file MLton-LICENSE for details.
*/
-#define SOURCES_INDEX_UNKNOWN 0
-#define SOURCES_INDEX_GC 1
-#define SOURCE_SEQ_GC 1
-#define SOURCE_SEQ_UNKNOWN 0
-
-static uint32_t numStackFrames;
-static uint32_t *callStack;
-
-static void fillCallStack (__attribute__ ((unused))GC_state s,
- GC_frameIndex i) {
- if (DEBUG_CALL_STACK)
- fprintf (stderr, "fillCallStack ("FMTFI")\n", i);
- callStack[numStackFrames] = i;
- numStackFrames++;
+GC_profileMasterIndex sourceIndexToProfileMasterIndex (GC_state s,
+ GC_sourceIndex i) {
+ return s->sourceMaps.sources[i].sourceNameIndex + s->sourceMaps.sourcesLength;
}
-void GC_callStack (GC_state s, pointer p) {
- if (DEBUG_CALL_STACK)
- fprintf (stderr, "GC_callStack\n");
- numStackFrames = 0;
- callStack = (uint32_t*)p;
- foreachStackFrame (s, fillCallStack);
+GC_sourceNameIndex profileMasterIndexToSourceNameIndex (GC_state s,
+ GC_profileMasterIndex i) {
+ assert (i >= s->sourceMaps.sourcesLength);
+ return i - s->sourceMaps.sourcesLength;
}
-static void incNumStackFrames (__attribute__ ((unused)) GC_state s,
- __attribute__ ((unused)) GC_frameIndex i) {
- numStackFrames++;
+GC_profileStack getProfileStackInfo (GC_state s, GC_profileMasterIndex i) {
+ assert (s->profiling.data != NULL);
+ return &(s->profiling.data->stack[i]);
}
-uint32_t GC_numStackFrames (GC_state s) {
- numStackFrames = 0;
- foreachStackFrame (s, incNumStackFrames);
- if (DEBUG_CALL_STACK)
- fprintf (stderr, "%"PRIu32" = GC_numStackFrames\n", numStackFrames);
- return numStackFrames;
-}
-static inline uint32_t topFrameSourceSeqIndex (GC_state s, GC_stack stack) {
- return s->profiling.frameSources[getStackTopFrameIndex (s, stack)];
-}
+static int profileDepth = 0;
-uint32_t* GC_frameIndexSourceSeq (GC_state s, GC_frameIndex frameIndex) {
- uint32_t *res;
-
- res = s->profiling.sourceSeqs[s->profiling.frameSources[frameIndex]];
- if (DEBUG_CALL_STACK)
- fprintf (stderr, FMTPTR" = GC_frameIndexSourceSeq ("FMTFI")\n",
- (uintptr_t)res, frameIndex);
- return res;
+static void profileIndent (void) {
+ int i;
+
+ for (i = 0; i < profileDepth; ++i)
+ fprintf (stderr, " ");
}
-inline char* GC_sourceName (GC_state s, uint32_t i) {
- if (i < s->profiling.sourcesLength)
- return s->profiling.sourceNames[s->profiling.sources[i].nameIndex];
- else
- return s->profiling.sourceNames[i - s->profiling.sourcesLength];
-}
-static inline GC_profileStack profileStackInfo (GC_state s, uint32_t i) {
- assert (s->profiling.data != NULL);
- return &(s->profiling.data->stack[i]);
-}
-
-static inline uint32_t profileMaster (GC_state s, uint32_t i) {
- return s->profiling.sources[i].nameIndex + s->profiling.sourcesLength;
-}
-
-static inline void removeFromStack (GC_state s, uint32_t i) {
+void addToStackForProfiling (GC_state s, GC_profileMasterIndex i) {
GC_profileData p;
GC_profileStack ps;
- uintmax_t totalInc;
p = s->profiling.data;
- ps = profileStackInfo (s, i);
- totalInc = p->total - ps->lastTotal;
+ ps = getProfileStackInfo (s, i);
if (DEBUG_PROFILE)
- fprintf (stderr, "removing %s from stack ticksInc = %"PRIuMAX" ticksInGCInc = %"PRIuMAX"\n",
- GC_sourceName (s, i), totalInc,
- p->totalGC - ps->lastTotalGC);
- ps->ticks += totalInc;
- ps->ticksInGC += p->totalGC - ps->lastTotalGC;
+ fprintf (stderr, "adding %s to stack lastTotal = %"PRIuMAX" lastTotalGC = %"PRIuMAX"\n",
+ GC_sourceName (s, i),
+ p->total,
+ p->totalGC);
+ ps->lastTotal = p->total;
+ ps->lastTotalGC = p->totalGC;
}
-static void setProfTimer (long usec) {
- struct itimerval iv;
-
- iv.it_interval.tv_sec = 0;
- iv.it_interval.tv_usec = usec;
- iv.it_value.tv_sec = 0;
- iv.it_value.tv_usec = usec;
- unless (0 == setitimer (ITIMER_PROF, &iv, NULL))
- die ("setProfTimer failed");
-}
-
-void GC_profileDone (GC_state s) {
+void enterSourceForProfiling (GC_state s, GC_profileMasterIndex i) {
GC_profileData p;
- uint32_t sourceIndex;
-
- if (DEBUG_PROFILE)
- fprintf (stderr, "GC_profileDone ()\n");
- assert (s->profiling.isOn);
- if (PROFILE_TIME == s->profiling.kind)
- setProfTimer (0);
- s->profiling.isOn = FALSE;
- p = s->profiling.data;
- if (s->profiling.stack) {
- for (sourceIndex = 0;
- sourceIndex < s->profiling.sourcesLength + s->profiling.sourceNamesLength;
- sourceIndex++) {
- if (p->stack[sourceIndex].numOccurrences > 0) {
- if (DEBUG_PROFILE)
- fprintf (stderr, "done leaving %s\n",
- GC_sourceName (s, sourceIndex));
- removeFromStack (s, sourceIndex);
- }
- }
- }
-}
-
-static int profileDepth = 0;
-
-static void profileIndent (void) {
- int i;
-
- for (i = 0; i < profileDepth; ++i)
- fprintf (stderr, " ");
-}
-
-static inline void profileEnterSource (GC_state s, uint32_t i) {
- GC_profileData p;
GC_profileStack ps;
p = s->profiling.data;
- ps = profileStackInfo (s, i);
+ ps = getProfileStackInfo (s, i);
if (0 == ps->numOccurrences) {
ps->lastTotal = p->total;
ps->lastTotalGC = p->totalGC;
@@ -147,18 +61,18 @@
ps->numOccurrences++;
}
-static void profileEnter (GC_state s, uint32_t sourceSeqIndex) {
+void enterForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex) {
uint32_t i;
GC_profileData p;
- uint32_t sourceIndex;
+ GC_sourceIndex sourceIndex;
uint32_t *sourceSeq;
if (DEBUG_PROFILE)
- fprintf (stderr, "profileEnter (%"PRIu32")\n", sourceSeqIndex);
+ fprintf (stderr, "enterForProfiling ("FMTSSI")\n", sourceSeqIndex);
assert (s->profiling.stack);
- assert (sourceSeqIndex < s->profiling.sourceSeqsLength);
+ assert (sourceSeqIndex < s->sourceMaps.sourceSeqsLength);
p = s->profiling.data;
- sourceSeq = s->profiling.sourceSeqs[sourceSeqIndex];
+ sourceSeq = s->sourceMaps.sourceSeqs[sourceSeqIndex];
for (i = 1; i <= sourceSeq[0]; i++) {
sourceIndex = sourceSeq[i];
if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
@@ -167,41 +81,58 @@
GC_sourceName (s, sourceIndex));
profileDepth++;
}
- profileEnterSource (s, sourceIndex);
- profileEnterSource (s, profileMaster (s, sourceIndex));
+ enterSourceForProfiling (s, (GC_profileMasterIndex)sourceIndex);
+ enterSourceForProfiling (s, sourceIndexToProfileMasterIndex (s, sourceIndex));
}
}
-static void enterFrame (GC_state s, uint32_t i) {
- profileEnter (s, s->profiling.frameSources[i]);
+void enterFrameForProfiling (GC_state s, GC_frameIndex i) {
+ enterForProfiling (s, s->sourceMaps.frameSources[i]);
}
-static inline void profileLeaveSource (GC_state s, uint32_t i) {
+void GC_profileEnter (GC_state s) {
+ enterForProfiling (s, getStackTopFrameSourceSeqIndex (s, getStackCurrent (s)));
+}
+
+void removeFromStackForProfiling (GC_state s, GC_profileMasterIndex i) {
GC_profileData p;
GC_profileStack ps;
+ p = s->profiling.data;
+ ps = getProfileStackInfo (s, i);
if (DEBUG_PROFILE)
- fprintf (stderr, "profileLeaveSource (%"PRIu32")\n", i);
+ fprintf (stderr, "removing %s from stack ticksInc = %"PRIuMAX" ticksGCInc = %"PRIuMAX"\n",
+ GC_sourceName (s, i),
+ p->total - ps->lastTotal,
+ p->totalGC - ps->lastTotalGC);
+ ps->ticks += p->total - ps->lastTotal;
+ ps->ticksGC += p->totalGC - ps->lastTotalGC;
+}
+
+void leaveSourceForProfiling (GC_state s, GC_profileMasterIndex i) {
+ GC_profileData p;
+ GC_profileStack ps;
+
p = s->profiling.data;
- ps = profileStackInfo (s, i);
+ ps = getProfileStackInfo (s, i);
assert (ps->numOccurrences > 0);
ps->numOccurrences--;
if (0 == ps->numOccurrences)
- removeFromStack (s, i);
+ removeFromStackForProfiling (s, i);
}
-static void profileLeave (GC_state s, uint32_t sourceSeqIndex) {
+void leaveForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex) {
int32_t i;
GC_profileData p;
- uint32_t sourceIndex;
+ GC_sourceIndex sourceIndex;
uint32_t *sourceSeq;
if (DEBUG_PROFILE)
- fprintf (stderr, "profileLeave (%"PRIu32")\n", sourceSeqIndex);
+ fprintf (stderr, "profileLeave ("FMTSSI")\n", sourceSeqIndex);
assert (s->profiling.stack);
- assert (sourceSeqIndex < s->profiling.sourceSeqsLength);
+ assert (sourceSeqIndex < s->sourceMaps.sourceSeqsLength);
p = s->profiling.data;
- sourceSeq = s->profiling.sourceSeqs[sourceSeqIndex];
+ sourceSeq = s->sourceMaps.sourceSeqs[sourceSeqIndex];
for (i = sourceSeq[0]; i > 0; i--) {
sourceIndex = sourceSeq[i];
if (DEBUG_ENTER_LEAVE or DEBUG_PROFILE) {
@@ -210,100 +141,81 @@
fprintf (stderr, "leaving %s)\n",
GC_sourceName (s, sourceIndex));
}
- profileLeaveSource (s, sourceIndex);
- profileLeaveSource (s, profileMaster (s, sourceIndex));
+ leaveSourceForProfiling (s, (GC_profileMasterIndex)sourceIndex);
+ leaveSourceForProfiling (s, sourceIndexToProfileMasterIndex (s, sourceIndex));
}
}
-static inline void profileInc (GC_state s, size_t amount, uint32_t sourceSeqIndex) {
+void leaveFrameForProfiling (GC_state s, GC_frameIndex i) {
+ leaveForProfiling (s, s->sourceMaps.frameSources[i]);
+}
+
+void GC_profileLeave (GC_state s) {
+ leaveForProfiling (s, getStackTopFrameSourceSeqIndex (s, getStackCurrent (s)));
+}
+
+
+void profileInc (GC_state s, size_t amount, GC_sourceSeqIndex sourceSeqIndex) {
uint32_t *sourceSeq;
- uint32_t topSourceIndex;
+ GC_sourceIndex topSourceIndex;
if (DEBUG_PROFILE)
- fprintf (stderr, "profileInc (%zu, %"PRIu32")\n",
+ fprintf (stderr, "profileInc (%zu, "FMTSSI")\n",
amount, sourceSeqIndex);
- assert (sourceSeqIndex < s->profiling.sourceSeqsLength);
- sourceSeq = s->profiling.sourceSeqs[sourceSeqIndex];
- topSourceIndex = sourceSeq[0] > 0 ? sourceSeq[sourceSeq[0]] : SOURCES_INDEX_UNKNOWN;
+ assert (sourceSeqIndex < s->sourceMaps.sourceSeqsLength);
+ sourceSeq = s->sourceMaps.sourceSeqs[sourceSeqIndex];
+ topSourceIndex =
+ sourceSeq[0] > 0
+ ? sourceSeq[sourceSeq[0]]
+ : SOURCES_INDEX_UNKNOWN;
if (DEBUG_PROFILE) {
profileIndent ();
fprintf (stderr, "bumping %s by %zu\n",
GC_sourceName (s, topSourceIndex), amount);
}
s->profiling.data->countTop[topSourceIndex] += amount;
- s->profiling.data->countTop[profileMaster (s, topSourceIndex)] += amount;
+ s->profiling.data->countTop[sourceIndexToProfileMasterIndex (s, topSourceIndex)] += amount;
if (s->profiling.stack)
- profileEnter (s, sourceSeqIndex);
+ enterForProfiling (s, sourceSeqIndex);
if (SOURCES_INDEX_GC == topSourceIndex)
s->profiling.data->totalGC += amount;
else
s->profiling.data->total += amount;
if (s->profiling.stack)
- profileLeave (s, sourceSeqIndex);
+ leaveForProfiling (s, sourceSeqIndex);
}
-void GC_profileEnter (GC_state s) {
- profileEnter (s, topFrameSourceSeqIndex (s, getStackCurrent (s)));
-}
-
-void GC_profileLeave (GC_state s) {
- profileLeave (s, topFrameSourceSeqIndex (s, getStackCurrent (s)));
-}
-
void GC_profileInc (GC_state s, size_t amount) {
if (DEBUG_PROFILE)
fprintf (stderr, "GC_profileInc (%zu)\n", amount);
profileInc (s, amount,
- s->amInGC
- ? SOURCE_SEQ_GC
- : topFrameSourceSeqIndex (s, getStackCurrent (s)));
+ s->amInGC
+ ? SOURCE_SEQ_GC
+ : getStackTopFrameSourceSeqIndex (s, getStackCurrent (s)));
}
void GC_profileAllocInc (GC_state s, size_t amount) {
if (s->profiling.isOn and (PROFILE_ALLOC == s->profiling.kind)) {
if (DEBUG_PROFILE)
- fprintf (stderr, "GC_profileAllocInc (%u)\n", (uint)amount);
+ fprintf (stderr, "GC_profileAllocInc (%zu)\n", amount);
GC_profileInc (s, amount);
}
}
-static void showProf (GC_state s) {
- uint32_t i;
- uint32_t j;
-
- fprintf (stdout, "0x%08"PRIx32"\n", s->magic);
- fprintf (stdout, "%"PRIu32"\n", s->profiling.sourceNamesLength);
- for (i = 0; i < s->profiling.sourceNamesLength; i++)
- fprintf (stdout, "%s\n", s->profiling.sourceNames[i]);
- fprintf (stdout, "%"PRIu32"\n", s->profiling.sourcesLength);
- for (i = 0; i < s->profiling.sourcesLength; i++)
- fprintf (stdout, "%"PRIu32" %"PRIu32"\n",
- s->profiling.sources[i].nameIndex,
- s->profiling.sources[i].successorsIndex);
- fprintf (stdout, "%"PRIu32"\n", s->profiling.sourceSeqsLength);
- for (i = 0; i < s->profiling.sourceSeqsLength; i++) {
- uint32_t *sourceSeq;
-
- sourceSeq = s->profiling.sourceSeqs[i];
- for (j = 1; j <= sourceSeq[0]; j++)
- fprintf (stdout, "%"PRIu32" ", sourceSeq[j]);
- fprintf (stdout, "\n");
- }
-}
GC_profileData GC_profileNew (GC_state s) {
GC_profileData p;
- uint32_t size;
+ uint32_t profileMasterLength;
p = (GC_profileData)(malloc_safe (sizeof(*p)));
p->total = 0;
p->totalGC = 0;
- size = s->profiling.sourcesLength + s->profiling.sourceNamesLength;
- p->countTop = (uintmax_t*)(calloc_safe(size, sizeof(*(p->countTop))));
+ profileMasterLength = s->sourceMaps.sourcesLength + s->sourceMaps.sourceNamesLength;
+ p->countTop = (uintmax_t*)(calloc_safe(profileMasterLength, sizeof(*(p->countTop))));
if (s->profiling.stack)
- p->stack =
+ p->stack =
(struct GC_profileStack *)
- (calloc_safe(size, sizeof(*(p->stack))));
+ (calloc_safe(profileMasterLength, sizeof(*(p->stack))));
if (DEBUG_PROFILE)
fprintf (stderr, FMTPTR" = GC_profileNew ()\n", (uintptr_t)p);
return p;
@@ -316,7 +228,8 @@
free (p);
}
-static void profileWriteCount (GC_state s, GC_profileData p, int fd, uint32_t i) {
+static void writeProfileCount (GC_state s, int fd,
+ GC_profileData p, GC_profileMasterIndex i) {
writeUintmaxU (fd, p->countTop[i]);
if (s->profiling.stack) {
GC_profileStack ps;
@@ -325,13 +238,12 @@
writeString (fd, " ");
writeUintmaxU (fd, ps->ticks);
writeString (fd, " ");
- writeUintmaxU (fd, ps->ticksInGC);
+ writeUintmaxU (fd, ps->ticksGC);
}
writeNewline (fd);
}
void GC_profileWrite (GC_state s, GC_profileData p, int fd) {
- uint32_t i;
char* kind;
if (DEBUG_PROFILE)
@@ -360,37 +272,51 @@
writeString (fd, " ");
writeUintmaxU (fd, p->totalGC);
writeNewline (fd);
- writeUint32U (fd, s->profiling.sourcesLength);
+ writeUint32U (fd, s->sourceMaps.sourcesLength);
writeNewline (fd);
- for (i = 0; i < s->profiling.sourcesLength; i++)
- profileWriteCount (s, p, fd, i);
- writeUint32U (fd, s->profiling.sourceNamesLength);
+ for (GC_sourceIndex i = 0; i < s->sourceMaps.sourcesLength; i++)
+ writeProfileCount (s, fd, p,
+ (GC_profileMasterIndex)i);
+ writeUint32U (fd, s->sourceMaps.sourceNamesLength);
writeNewline (fd);
- for (i = 0; i < s->profiling.sourceNamesLength; i++)
- profileWriteCount (s, p, fd, i + s->profiling.sourcesLength);
+ for (GC_sourceNameIndex i = 0; i < s->sourceMaps.sourceNamesLength; i++)
+ writeProfileCount (s, fd, p,
+ (GC_profileMasterIndex)(i + s->sourceMaps.sourcesLength));
}
+
+void setProfTimer (long usec) {
+ struct itimerval iv;
+
+ iv.it_interval.tv_sec = 0;
+ iv.it_interval.tv_usec = usec;
+ iv.it_value.tv_sec = 0;
+ iv.it_value.tv_usec = usec;
+ unless (0 == setitimer (ITIMER_PROF, &iv, NULL))
+ die ("setProfTimer: setitimer failed");
+}
+
#if not HAS_TIME_PROFILING
/* No time profiling on this platform. There is a check in
* mlton/main/main.fun to make sure that time profiling is never
* turned on.
*/
-static void profileTimeInit (GC_state s) __attribute__ ((noreturn));
-static void profileTimeInit (GC_state s) {
+void initProfilingTime (GC_state s) __attribute__ ((noreturn));
+void initProfilingTime (__attribute__ ((unused)) GC_state s) {
die ("no time profiling");
}
#else
-static GC_state catcherState;
+static GC_state handleSigProfState;
void GC_handleSigProf (pointer pc) {
GC_frameIndex frameIndex;
GC_state s;
- uint32_t sourceSeqIndex;
+ GC_sourceSeqIndex sourceSeqIndex;
- s = catcherState;
+ s = handleSigProfState;
if (DEBUG_PROFILE)
fprintf (stderr, "GC_handleSigProf ("FMTPTR")\n", (uintptr_t)pc);
if (s->amInGC)
@@ -398,10 +324,10 @@
else {
frameIndex = getStackTopFrameIndex (s, getStackCurrent (s));
if (C_FRAME == s->frameLayouts[frameIndex].kind)
- sourceSeqIndex = s->profiling.frameSources[frameIndex];
+ sourceSeqIndex = s->sourceMaps.frameSources[frameIndex];
else {
- if (s->profiling.textStart <= pc and pc < s->profiling.textEnd)
- sourceSeqIndex = s->profiling.textSources [pc - s->profiling.textStart];
+ if (s->sourceMaps.textStart <= pc and pc < s->sourceMaps.textEnd)
+ sourceSeqIndex = s->sourceMaps.textSources [pc - s->sourceMaps.textStart];
else {
if (DEBUG_PROFILE)
fprintf (stderr, "pc out of bounds\n");
@@ -412,69 +338,12 @@
profileInc (s, 1, sourceSeqIndex);
}
-static int compareSourceLabels (const void *v1, const void *v2) {
- uintptr_t ui1;
- uintptr_t ui2;
-
- ui1 = (uintptr_t)v1;
- ui2 = (uintptr_t)v2;
-
- if (ui1 < ui2)
- return -1;
- else if (ui1 == ui2)
- return 0;
- else /* if (ui1 > ui2) */
- return 1;
-}
-
-static void profileTimeInit (GC_state s) {
- uint32_t i;
- pointer p;
+static void initProfilingTime (GC_state s) {
struct sigaction sa;
uint32_t sourceSeqsIndex;
s->profiling.data = GC_profileNew (s);
- /* Sort sourceLabels by address. */
- qsort (s->profiling.sourceLabels,
- s->profiling.sourceLabelsLength,
- sizeof (*s->profiling.sourceLabels),
- compareSourceLabels);
- if (0 == s->profiling.sourceLabels[s->profiling.sourceLabelsLength - 1].label)
- die ("Max profile label is 0 -- something is wrong.");
- if (DEBUG_PROFILE)
- for (i = 0; i < s->profiling.sourceLabelsLength; i++)
- fprintf (stderr, FMTPTR" %"PRIu32"\n",
- (uintptr_t)s->profiling.sourceLabels[i].label,
- s->profiling.sourceLabels[i].sourceSeqsIndex);
- if (ASSERT)
- for (i = 1; i < s->profiling.sourceLabelsLength; i++)
- assert (s->profiling.sourceLabels[i-1].label
- <= s->profiling.sourceLabels[i].label);
- /* Initialize s->textSources. */
- s->profiling.textEnd = (pointer)(getTextEnd());
- s->profiling.textStart = (pointer)(getTextStart());
- if (ASSERT)
- for (i = 0; i < s->profiling.sourceLabelsLength; i++) {
- pointer label;
-
- label = s->profiling.sourceLabels[i].label;
- assert (0 == label
- or (s->profiling.textStart <= label
- and label < s->profiling.textEnd));
- }
- s->profiling.textSources =
- (uint32_t*)
- (calloc_safe((size_t)(s->profiling.textEnd - s->profiling.textStart),
- sizeof(*(s->profiling.textSources))));
- p = s->profiling.textStart;
- sourceSeqsIndex = SOURCE_SEQ_UNKNOWN;
- for (i = 0; i < s->profiling.sourceLabelsLength; i++) {
- for ( ; p < s->profiling.sourceLabels[i].label; p++)
- s->profiling.textSources[p - s->profiling.textStart] = sourceSeqsIndex;
- sourceSeqsIndex = s->profiling.sourceLabels[i].sourceSeqsIndex;
- }
- for ( ; p < s->profiling.textEnd; p++)
- s->profiling.textSources[p - s->profiling.textStart] = sourceSeqsIndex;
+ initTextSources (s);
/*
* Install catcher, which handles SIGPROF and calls MLton_Profile_inc.
*
@@ -488,31 +357,31 @@
* in order to have profiling cover as much as possible, you want it
* to occur right after the sigaltstack() call.
*/
- catcherState = s;
+ handleSigProfState = s;
sigemptyset (&sa.sa_mask);
setSigProfHandler (&sa);
unless (sigaction (SIGPROF, &sa, NULL) == 0)
- diee ("sigaction() failed");
+ diee ("initProfilingTime: sigaction failed");
/* Start the SIGPROF timer. */
setProfTimer (10000);
}
#endif
-/* profileEnd is for writing out an mlmon.out file even if the C code
+/* atexitForProfiling is for writing out an mlmon.out file even if the C code
* terminates abnormally, e.g. due to running out of memory. It will
* only run if the usual SML profile atExit cleanup code did not
* manage to run.
*/
-static GC_state profileEndState;
+static GC_state atexitForProfilingState;
-static void profileEnd (void) {
+static void atexitForProfiling (void) {
int fd;
GC_state s;
if (DEBUG_PROFILE)
- fprintf (stderr, "profileEnd ()\n");
- s = profileEndState;
+ fprintf (stderr, "atexitForProfiling ()\n");
+ s = atexitForProfilingState;
if (s->profiling.isOn) {
fd = creat ("mlmon.out", 0666);
if (fd < 0)
@@ -526,7 +395,7 @@
s->profiling.isOn = FALSE;
else {
s->profiling.isOn = TRUE;
- assert (s->profiling.frameSourcesLength == s->frameLayoutsLength);
+ assert (s->sourceMaps.frameSourcesLength == s->frameLayoutsLength);
switch (s->profiling.kind) {
case PROFILE_ALLOC:
case PROFILE_COUNT:
@@ -535,10 +404,40 @@
case PROFILE_NONE:
die ("impossible PROFILE_NONE");
case PROFILE_TIME:
- profileTimeInit (s);
+ initProfilingTime (s);
break;
}
- profileEndState = s;
- atexit (profileEnd);
+ atexitForProfilingState = s;
+ atexit (atexitForProfiling);
}
}
+
+void GC_profileDone (GC_state s) {
+ GC_profileData p;
+ GC_profileMasterIndex profileMasterIndex;
+
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "GC_profileDone ()\n");
+ assert (s->profiling.isOn);
+ if (PROFILE_TIME == s->profiling.kind)
+ setProfTimer (0);
+ s->profiling.isOn = FALSE;
+ p = s->profiling.data;
+ if (s->profiling.stack) {
+ uint32_t profileMasterLength =
+ s->sourceMaps.sourcesLength + s->sourceMaps.sourceNamesLength;
+ for (profileMasterIndex = 0;
+ profileMasterIndex < profileMasterLength;
+ profileMasterIndex++) {
+ if (p->stack[profileMasterIndex].numOccurrences > 0) {
+ if (DEBUG_PROFILE)
+ fprintf (stderr, "done leaving %s\n",
+ (profileMasterIndex < s->sourceMaps.sourcesLength)
+ ? GC_sourceName (s, (GC_sourceIndex)profileMasterIndex)
+ : s->sourceMaps.sourceNames[
+ profileMasterIndexToSourceNameIndex (s, profileMasterIndex)]);
+ removeFromStackForProfiling (s, profileMasterIndex);
+ }
+ }
+ }
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-11-06 17:12:54 UTC (rev 4161)
@@ -13,24 +13,14 @@
PROFILE_TIME,
} GC_profileKind;
-typedef struct GC_source {
- uint32_t nameIndex;
- uint32_t successorsIndex;
-} *GC_source;
-
-typedef struct GC_sourceLabel {
- pointer label;
- uint32_t sourceSeqsIndex;
-} *GC_sourceLabel;
-
/* If profileStack, then there is one struct GC_profileStack for each
* function.
*/
typedef struct GC_profileStack {
/* ticks counts ticks while the function was on the stack. */
uintmax_t ticks;
- /* ticksInGC counts ticks in GC while the function was on the stack. */
- uintmax_t ticksInGC;
+ /* ticksGC counts ticks in GC while the function was on the stack. */
+ uintmax_t ticksGC;
/* lastTotal is the value of total when the oldest occurrence of f
* on the stack was pushed, i.e., the most recent time that
* numTimesOnStack changed from 0 to 1. lastTotal is used to
@@ -46,11 +36,13 @@
uintmax_t numOccurrences;
} *GC_profileStack;
+typedef uint32_t GC_profileMasterIndex;
+
/* GC_profileData is used for both time and allocation profiling.
* In the comments below, "ticks" mean clock ticks with time profiling and
* bytes allocated with allocation profiling.
*
- * All of the arrays in GC_profileData are of length sourcesSize + sourceNamesSize.
+ * All of the arrays in GC_profileData are of length sourcesLength + sourceNamesLength.
* The first sourceLength entries are for handling the duplicate copies of
* functions, and the next sourceNamesLength entries are for the master versions.
*/
@@ -71,45 +63,29 @@
struct GC_profiling {
GC_profileData data;
- /* frameSources is an array of cardinality frameLayoutsLength that
- * for each stack frame, gives an index into sourceSeqs of the
- * sequence of source functions corresponding to the frame.
- */
- uint32_t *frameSources;
- uint32_t frameSourcesLength;
bool isOn;
GC_profileKind kind;
- struct GC_sourceLabel *sourceLabels;
- uint32_t sourceLabelsLength;
- char **sourceNames;
- uint32_t sourceNamesLength;
- /* Each entry in sourceSeqs is a vector, whose first element is a
- * length, and subsequent elements index into sources.
- */
- uint32_t **sourceSeqs;
- uint32_t sourceSeqsLength;
- /* sources is an array of cardinality sourcesLength. Each entry
- * specifies an index into sourceNames and an index into sourceSeqs,
- * giving the name of the function and the successors, respectively.
- */
- struct GC_source *sources;
- uint32_t sourcesLength;
bool stack;
- pointer textEnd;
- /* An array of indices, one entry for each address in the text
- * segment, giving and index into sourceSeqs.
- */
- uint32_t *textSources;
- pointer textStart;
};
-static void showProf (GC_state s);
-void initProfiling (GC_state s);
-static void enterFrame (GC_state s, uint32_t i);
+void enterSourceForProfiling (GC_state s, GC_profileMasterIndex i);
+void enterForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex);
+void enterFrameForProfiling (GC_state s, GC_frameIndex i);
+void GC_profileEnter (GC_state s);
+void leaveSourceForProfiling (GC_state s, GC_profileMasterIndex i);
+void leaveForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex);
+void leaveFrameForProfiling (GC_state s, GC_frameIndex i);
+void GC_profileLeave (GC_state s);
-void GC_profileAllocInc (GC_state s, size_t bytes);
+void GC_profileInc (GC_state s, size_t amount);
+void GC_profileAllocInc (GC_state s, size_t amount);
-void GC_profileEnter (GC_state s);
+GC_profileData GC_profileNew (GC_state s);
+void GC_profileFree (GC_state s, GC_profileData p);
+void GC_profileWrite (GC_state s, GC_profileData p, int fd);
-void GC_profileLeave (GC_state s);
+void GC_handleSigProf (pointer pc);
+void initProfiling (GC_state s);
+void GC_profileDone (GC_state s);
+
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -6,12 +6,14 @@
* See the file MLton-LICENSE for details.
*/
-/* ---------------------------------------------------------------- */
-/* Initialization */
-/* ---------------------------------------------------------------- */
+#if not HAS_SIGALTSTACK
+void initSignalStack (__attribute__ ((unused)) GC_state s) {
+}
+
+#else
+
void initSignalStack (GC_state s) {
-#if HAS_SIGALTSTACK
static stack_t altstack;
size_t ss_size = align (SIGSTKSZ, s->sysvals.pageSize);
size_t psize = s->sysvals.pageSize;
@@ -20,5 +22,6 @@
altstack.ss_size = ss_size;
altstack.ss_flags = 0;
sigaltstack (&altstack, NULL);
+}
+
#endif
-}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.c (from rev 4158, mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c 2005-11-04 22:09:10 UTC (rev 4158)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -0,0 +1,110 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+GC_sourceSeqIndex getStackTopFrameSourceSeqIndex (GC_state s, GC_stack stack) {
+ return s->sourceMaps.frameSources[getStackTopFrameIndex (s, stack)];
+}
+
+char* GC_sourceName (GC_state s, GC_sourceIndex i) {
+ assert (i < s->sourceMaps.sourcesLength);
+ return s->sourceMaps.sourceNames[s->sourceMaps.sources[i].sourceNameIndex];
+}
+
+static int compareSourceLabels (const void *v1, const void *v2) {
+ uintptr_t ui1;
+ uintptr_t ui2;
+
+ ui1 = (uintptr_t)v1;
+ ui2 = (uintptr_t)v2;
+
+ if (ui1 < ui2)
+ return -1;
+ else if (ui1 == ui2)
+ return 0;
+ else /* if (ui1 > ui2) */
+ return 1;
+}
+
+void sortSourceLabels (GC_state s) {
+ GC_sourceLabelIndex i;
+
+ /* Sort sourceLabels by address. */
+ qsort (s->sourceMaps.sourceLabels,
+ s->sourceMaps.sourceLabelsLength,
+ sizeof (*s->sourceMaps.sourceLabels),
+ compareSourceLabels);
+ if (0 == s->sourceMaps.sourceLabels[s->sourceMaps.sourceLabelsLength - 1].label)
+ die ("Max profile label is 0 -- something is wrong.");
+ if (DEBUG_SOURCES)
+ for (i = 0; i < s->sourceMaps.sourceLabelsLength; i++)
+ fprintf (stderr, FMTPTR" %"PRIu32"\n",
+ (uintptr_t)s->sourceMaps.sourceLabels[i].label,
+ s->sourceMaps.sourceLabels[i].sourceSeqIndex);
+ if (ASSERT)
+ for (i = 1; i < s->sourceMaps.sourceLabelsLength; i++)
+ assert (s->sourceMaps.sourceLabels[i-1].label
+ <= s->sourceMaps.sourceLabels[i].label);
+}
+
+void initTextSources (GC_state s) {
+ GC_sourceLabelIndex i;
+ pointer p;
+ GC_sourceSeqIndex sourceSeqIndex;
+
+ sortSourceLabels (s);
+ /* Initialize s->sourceMaps.textSources. */
+ s->sourceMaps.textEnd = (pointer)(getTextEnd());
+ s->sourceMaps.textStart = (pointer)(getTextStart());
+ if (ASSERT)
+ for (i = 0; i < s->sourceMaps.sourceLabelsLength; i++) {
+ pointer label;
+
+ label = s->sourceMaps.sourceLabels[i].label;
+ assert (0 == label
+ or (s->sourceMaps.textStart <= label
+ and label < s->sourceMaps.textEnd));
+ }
+ s->sourceMaps.textSources =
+ (uint32_t*)
+ (calloc_safe((size_t)(s->sourceMaps.textEnd - s->sourceMaps.textStart),
+ sizeof(*(s->sourceMaps.textSources))));
+ p = s->sourceMaps.textStart;
+ sourceSeqIndex = SOURCE_SEQ_UNKNOWN;
+ for (i = 0; i < s->sourceMaps.sourceLabelsLength; i++) {
+ for ( ; p < s->sourceMaps.sourceLabels[i].label; p++)
+ s->sourceMaps.textSources[p - s->sourceMaps.textStart] = sourceSeqIndex;
+ sourceSeqIndex = s->sourceMaps.sourceLabels[i].sourceSeqIndex;
+ }
+ for ( ; p < s->sourceMaps.textEnd; p++)
+ s->sourceMaps.textSources[p - s->sourceMaps.textStart] = sourceSeqIndex;
+}
+
+
+void showSources (GC_state s) {
+ uint32_t i;
+ uint32_t j;
+
+ fprintf (stdout, "0x%08"PRIx32"\n", s->magic);
+ fprintf (stdout, "%"PRIu32"\n", s->sourceMaps.sourceNamesLength);
+ for (i = 0; i < s->sourceMaps.sourceNamesLength; i++)
+ fprintf (stdout, "%s\n", s->sourceMaps.sourceNames[i]);
+ fprintf (stdout, "%"PRIu32"\n", s->sourceMaps.sourcesLength);
+ for (i = 0; i < s->sourceMaps.sourcesLength; i++)
+ fprintf (stdout, "%"PRIu32" %"PRIu32"\n",
+ s->sourceMaps.sources[i].sourceNameIndex,
+ s->sourceMaps.sources[i].successorSourceSeqIndex);
+ fprintf (stdout, "%"PRIu32"\n", s->sourceMaps.sourceSeqsLength);
+ for (i = 0; i < s->sourceMaps.sourceSeqsLength; i++) {
+ uint32_t *sourceSeq;
+
+ sourceSeq = s->sourceMaps.sourceSeqs[i];
+ for (j = 1; j <= sourceSeq[0]; j++)
+ fprintf (stdout, "%"PRIu32" ", sourceSeq[j]);
+ fprintf (stdout, "\n");
+ }
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.h (from rev 4158, mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h 2005-11-04 22:09:10 UTC (rev 4158)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/sources.h 2005-11-06 17:12:54 UTC (rev 4161)
@@ -0,0 +1,77 @@
+/* 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.
+ */
+
+typedef uint32_t GC_sourceNameIndex;
+#define PRISNI PRIu32
+#define FMTSNI "%"PRISNI
+
+typedef uint32_t GC_sourceLabelIndex;
+#define PRISLI PRIu32
+#define FMTSLI "%"PRISLI
+
+typedef uint32_t GC_sourceIndex;
+#define PRISI PRIu32
+#define FMTSI "%"PRISI
+
+#define SOURCES_INDEX_UNKNOWN 0
+#define SOURCES_INDEX_GC 1
+
+typedef uint32_t GC_sourceSeqIndex;
+#define PRISSI PRIu32
+#define FMTSSI "%"PRISSI
+
+#define SOURCE_SEQ_GC 1
+#define SOURCE_SEQ_UNKNOWN 0
+
+typedef struct GC_source {
+ GC_sourceNameIndex sourceNameIndex;
+ GC_sourceSeqIndex successorSourceSeqIndex;
+} *GC_source;
+
+typedef struct GC_sourceLabel {
+ pointer label;
+ GC_sourceSeqIndex sourceSeqIndex;
+} *GC_sourceLabel;
+
+struct GC_sourceMaps {
+ /* frameSources is an array of cardinality frameLayoutsLength that
+ * for each stack frame, gives an index into sourceSeqs of the
+ * sequence of source functions corresponding to the frame.
+ */
+ GC_sourceSeqIndex *frameSources;
+ uint32_t frameSourcesLength;
+ struct GC_sourceLabel *sourceLabels;
+ uint32_t sourceLabelsLength;
+ char **sourceNames;
+ uint32_t sourceNamesLength;
+ /* Each entry in sourceSeqs is a vector, whose first element is a
+ * length, and subsequent elements index into sources.
+ */
+ uint32_t **sourceSeqs;
+ uint32_t sourceSeqsLength;
+ /* sources is an array of cardinality sourcesLength. Each entry
+ * specifies an index into sourceNames and an index into sourceSeqs,
+ * giving the name of the function and the successors, respectively.
+ */
+ struct GC_source *sources;
+ uint32_t sourcesLength;
+ pointer textEnd;
+ /* An array of indices, one entry for each address in the text
+ * segment, giving and index into sourceSeqs.
+ */
+ GC_sourceSeqIndex *textSources;
+ pointer textStart;
+};
+
+GC_sourceSeqIndex getStackTopFrameSourceSeqIndex (GC_state s, GC_stack stack);
+char* GC_sourceName (GC_state s, GC_sourceIndex i);
+
+void sortSourceLabels (GC_state s);
+void initTextSources (GC_state s);
+
+void showSources (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -86,6 +86,16 @@
return res;
}
+size_t alignStackReserved (GC_state s, size_t reserved) {
+ size_t res;
+
+ res = pad (s, reserved, GC_STACK_HEADER_SIZE + sizeof (struct GC_stack));
+ if (DEBUG_STACKS)
+ fprintf (stderr, "%zu = alignStackReserved (%zu)\n", res, reserved);
+ assert (isStackReservedAligned (s, res));
+ return res;
+}
+
size_t sizeofStackWithHeaderAligned (GC_state s, size_t reserved) {
size_t res;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack.h 2005-11-06 17:12:54 UTC (rev 4161)
@@ -50,6 +50,7 @@
#define GC_STACK_HEADER_SIZE GC_HEADER_SIZE
bool isStackEmpty (GC_stack stack);
+bool isStackReservedAligned (GC_state s, size_t reserved);
void displayStack (GC_state s, GC_stack stack, FILE *stream);
size_t sizeofStackSlop (GC_state s);
@@ -64,6 +65,7 @@
uint16_t getStackTopFrameSize (GC_state s, GC_stack stack);
size_t sizeofStackMinimumReserved (GC_state s, GC_stack stack);
+size_t alignStackReserved (GC_state s, size_t reserved);
size_t sizeofStackWithHeaderAligned (GC_state s, size_t reserved);
size_t sizeofStackGrow (GC_state s, GC_stack stack);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c 2005-11-05 00:04:36 UTC (rev 4160)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/stack_predicates.c 2005-11-06 17:12:54 UTC (rev 4161)
@@ -9,3 +9,11 @@
bool isStackEmpty (GC_stack stack) {
return 0 == stack->used;
}
+
+#if ASSERT
+bool isStackReservedAligned (GC_state s, size_t reserved) {
+ return isAligned (GC_STACK_HEADER_SIZE + sizeof (struct GC_stack) + reserved,
+ s->alignment);
+}
+#endif
+
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 16:04:38
|
Changed the handling of the -target command-line switch. Previously,
it had updated the align and codegen information when it was
encountered. This led to non-intuitive behavior when -target followed
either -align or -codegen, since it would override what they had
provided. This fix changes -target so that it doesn't override -align
or -codegen if they are set on the command line.
----------------------------------------------------------------------
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-05 00:01:55 UTC (rev 4159)
+++ mlton/trunk/mlton/main/main.fun 2005-11-05 00:04:36 UTC (rev 4160)
@@ -47,11 +47,13 @@
| Yes
end
-val buildConstants: bool ref = ref false
val asOpts: {opt: string, pred: OptPred.t} list ref = ref []
+val buildConstants: bool ref = ref false
val ccOpts: {opt: string, pred: OptPred.t} list ref = ref []
val coalesce: int option ref = ref NONE
val expert: bool ref = ref false
+val explicitAlign: Control.align option ref = ref NONE
+val explicitCodegen: Control.codegen option ref = ref NONE
val gcc: string ref = ref "<unset>"
val keepGenerated = ref false
val keepO = ref false
@@ -88,24 +90,6 @@
end
| _ => Error.bug (concat ["strange target mapping: ", line])))
-fun setTargetType (target: string, usage): unit =
- case List.peek (targetMap (), fn {target = t, ...} => t = target) of
- NONE => usage (concat ["invalid target: ", target])
- | SOME {arch, os, ...} =>
- let
- datatype z = datatype MLton.Platform.Arch.t
- open Control
- in
- targetArch := arch
- ; targetOS := os
- ; (case arch of
- Sparc => (align := Align8; codegen := CCodegen)
- | HPPA => (align := Align8; codegen := CCodegen)
- | X86 => codegen := Native
- | AMD64 => codegen := Native
- | _ => codegen := CCodegen)
- end
-
fun hasNative () =
let
datatype z = datatype Control.arch
@@ -142,12 +126,12 @@
| _ => " {4|8}",
"object alignment",
(SpaceString (fn s =>
- align
- := (case s of
- "4" => Align4
- | "8" => Align8
- | _ => usage (concat ["invalid -align flag: ",
- s]))))),
+ explicitAlign
+ := SOME (case s of
+ "4" => Align4
+ | "8" => Align8
+ | _ => usage (concat ["invalid -align flag: ",
+ s]))))),
(Normal, "as-opt", " <opt>", "pass option to assembler",
SpaceString (fn s =>
List.push (asOpts, {opt = s, pred = OptPred.Yes}))),
@@ -165,11 +149,13 @@
concat [" {", if hasNative () then "native|" else "", "bytecode|c}"],
"which code generator to use",
SpaceString (fn s =>
- case s of
- "bytecode" => codegen := Bytecode
- | "c" => codegen := CCodegen
- | "native" => codegen := Native
- | _ => usage (concat ["invalid -codegen flag: ", s]))),
+ explicitCodegen
+ := SOME (case s of
+ "bytecode" => Bytecode
+ | "c" => CCodegen
+ | "native" => Native
+ | _ => usage (concat
+ ["invalid -codegen flag: ", s])))),
(Normal, "const", " '<name> <value>'", "set compile-time constant",
SpaceString (fn s =>
case String.tokens (s, Char.isSpace) of
@@ -450,9 +436,12 @@
| x :: _ => concat [#target x, "|..."]),
"}"],
"platform that executable will run on",
- SpaceString (fn s =>
- (setTargetType (s, usage)
- ; target := (if s = "self" then Self else Cross s)))),
+ SpaceString
+ (fn t =>
+ (target := (if t = "self" then Self else Cross t);
+ case List.peek (targetMap (), fn {target = t', ...} => t = t') of
+ NONE => usage (concat ["invalid target: ", t])
+ | SOME {arch, os, ...} => (targetArch := arch; targetOS := os)))),
(Normal, "target-as-opt", " <target> <opt>", "target-dependent assembler option",
(SpaceString2
(fn (target, opt) =>
@@ -512,8 +501,19 @@
(libDir := OS.Path.mkCanonical lib
; args)
| _ => Error.bug "incorrect args from shell script"
- val _ = setTargetType ("self", usage)
val result = parse args
+ val targetArch = !targetArch
+ val () =
+ align := (case !explicitAlign of
+ NONE => (case targetArch of
+ Sparc => Align8
+ | HPPA => Align8
+ | _ => Align4)
+ | SOME a => a)
+ val () =
+ codegen := (case !explicitCodegen of
+ NONE => if hasNative () then Native else CCodegen
+ | SOME c => c)
val () = MLton.Rusage.measureGC (!verbosity <> Silent)
val () =
if !showAnns then
@@ -540,7 +540,6 @@
Cross s => s
| Self => "self"
val _ = libTargetDir := OS.Path.concat (!libDir, targetStr)
- val targetArch = !targetArch
val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
val targetOS = !targetOS
val () =
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 16:01:56
|
Took out the SML/NJ-version check. ---------------------------------------------------------------------- U mlton/trunk/mlton/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/mlton/Makefile =================================================================== --- mlton/trunk/mlton/Makefile 2005-11-04 22:09:10 UTC (rev 4158) +++ mlton/trunk/mlton/Makefile 2005-11-05 00:01:55 UTC (rev 4159) @@ -101,22 +101,14 @@ # Manager (CM) installed. You may need to replace the following with # 'sml-cm'. # -SMLNJ_VERSION = 110.4[59] SML = sml -.PHONY: check-nj-version -check-nj-version: - if ! echo | $(SML) | grep -q $(SMLNJ_VERSION); then \ - echo You must use SML/NJ $(SMLNJ_VERSION); \ - fi - .PHONY: def-use def-use: mlton -stop tc -show-def-use /tmp/z.def-use $(FILE) .PHONY: nj-mlton nj-mlton: $(SOURCES) - $(MAKE) check-nj-version ( \ echo 'SMLofNJ.Internals.GC.messages false;'; \ echo '#set CM.Control.verbose false;'; \ @@ -128,7 +120,6 @@ .PHONY: nj-mlton-dual nj-mlton-dual: $(SOURCES) - $(MAKE) check-nj-version ( \ echo 'SMLofNJ.Internals.GC.messages false;'; \ echo '#set CM.Control.verbose false;'; \ @@ -142,7 +133,6 @@ .PHONY: nj-mlton-quad nj-mlton-quad: $(SOURCES) - $(MAKE) check-nj-version ( \ echo 'SMLofNJ.Internals.GC.messages false;'; \ echo '#set CM.Control.verbose false;'; \ @@ -158,7 +148,6 @@ .PHONY: nj-whole nj-whole: $(SOURCES) - $(MAKE) check-nj-version ( \ echo 'SMLofNJ.Internals.GC.messages false;'; \ echo '#set CM.Control.verbose false;'; \ |
|
From: Stephen W. <sw...@ml...> - 2005-11-04 14:09:13
|
Compile MLton with warnUnused true. ---------------------------------------------------------------------- U mlton/trunk/mlton/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/mlton/Makefile =================================================================== --- mlton/trunk/mlton/Makefile 2005-11-04 22:08:41 UTC (rev 4157) +++ mlton/trunk/mlton/Makefile 2005-11-04 22:09:10 UTC (rev 4158) @@ -23,6 +23,7 @@ # We're compiling MLton with itself, so don't use any stubs. FILE = mlton.mlb FLAGS += -default-ann 'sequenceNonUnit warn' + FLAGS += -default-ann 'warnUnused true' else ifeq (cygwin, $(HOST_OS)) # The stubs don't work on Cygwin, since they define spawn in terms of |
|
From: Stephen W. <sw...@ml...> - 2005-11-04 14:08:43
|
Removed unused.
----------------------------------------------------------------------
U mlton/trunk/mlton/main/main.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-04 22:03:15 UTC (rev 4156)
+++ mlton/trunk/mlton/main/main.fun 2005-11-04 22:08:41 UTC (rev 4157)
@@ -106,11 +106,6 @@
| _ => codegen := CCodegen)
end
-fun warnDeprecated (flag, use) =
- Out.output (Out.error,
- concat ["Warning: -", flag, " is deprecated. ",
- "Use ", use, ".\n"])
-
fun hasNative () =
let
datatype z = datatype Control.arch
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 14:03:16
|
Removed automatic SML-escaping of strings when laying them out. It's
now up to clients if they want the escaping. This fixed a
long-standing minor bug in MLton, in which error messages referring to
identifiers like \\ were displayed escaped (like \\\\). Now they are
displayed correctly.
----------------------------------------------------------------------
U mlton/trunk/lib/mlton/basic/string1.sml
----------------------------------------------------------------------
Modified: mlton/trunk/lib/mlton/basic/string1.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/string1.sml 2005-11-04 21:57:59 UTC (rev 4155)
+++ mlton/trunk/lib/mlton/basic/string1.sml 2005-11-04 22:03:15 UTC (rev 4156)
@@ -19,7 +19,7 @@
val last = String0.last
-val layout = Layout.str o escapeSML
+val layout = Layout.str
fun forall (s, f) =
let
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 13:58:01
|
Avoid spurious error due to unbound type variable in a type definition
in a signature.
----------------------------------------------------------------------
U mlton/trunk/mlton/elaborate/elaborate-sigexp.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/elaborate/elaborate-sigexp.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-sigexp.fun 2005-11-04 21:19:52 UTC (rev 4154)
+++ mlton/trunk/mlton/elaborate/elaborate-sigexp.fun 2005-11-04 21:57:59 UTC (rev 4155)
@@ -121,24 +121,33 @@
Vector.keepAll
(tyvars', fn a =>
not (Vector.exists (tyvars, fn a' => Tyvar.sameName (a, a'))))
- val _ =
- if 0 = Vector.length unbound
- then ()
+ val ty =
+ if 0 = Vector.length unbound then
+ ty
else
let
open Layout
+ val () =
+ Control.error (Tyvar.region (Vector.sub (tyvars', 0)),
+ seq [str (concat ["undefined type variable",
+ if Vector.length unbound > 1
+ then "s"
+ else "",
+ ": "]),
+ seq (separate
+ (Vector.toListMap (unbound,
+ Tyvar.layout),
+ ", "))],
+ empty)
+ fun var a =
+ if Vector.exists (unbound, fn a' => Tyvar.equals (a, a')) then
+ Type.bogus
+ else
+ Type.var a
in
- Control.error (Tyvar.region (Vector.sub (tyvars', 0)),
- seq [str (concat ["undefined type variable",
- if Vector.length unbound > 1
- then "s"
- else "",
- ": "]),
- seq (separate
- (Vector.toListMap (unbound,
- Tyvar.layout),
- ", "))],
- empty)
+ Type.hom (ty, {con = Type.con,
+ record = Type.record,
+ var = var})
end
(* Need to get the representatives that were chosen when elaborating the
* type.
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 13:19:53
|
Don't use MinGW's fpclassify, which is broken. ---------------------------------------------------------------------- U mlton/trunk/runtime/platform/mingw.h ---------------------------------------------------------------------- Modified: mlton/trunk/runtime/platform/mingw.h =================================================================== --- mlton/trunk/runtime/platform/mingw.h 2005-11-04 21:19:14 UTC (rev 4153) +++ mlton/trunk/runtime/platform/mingw.h 2005-11-04 21:19:52 UTC (rev 4154) @@ -15,7 +15,10 @@ #undef max #define HAS_FEROUND TRUE -#define HAS_FPCLASSIFY TRUE +// As of 20051104, MinGW has fpclassify, but it is broken. In particular, it +// classifies subnormals as normals. So, we disable it here, which causes the +// runtime to use our own version. +#define HAS_FPCLASSIFY FALSE #define HAS_PTRACE FALSE #define HAS_REMAP FALSE #define HAS_SIGALTSTACK FALSE |
|
From: Stephen W. <sw...@ml...> - 2005-11-04 13:19:16
|
Added more MinGW regression exceptions.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-04 20:49:46 UTC (rev 4152)
+++ mlton/trunk/bin/regression 2005-11-04 21:19:14 UTC (rev 4153)
@@ -104,7 +104,7 @@
case `host-os` in
mingw)
case "$f" in
- cmdline|command-line|filesys|mutex|prodcons|signals2)
+ cmdline|command-line|filesys|mutex|posix-exit|prodcons|signals2|timeout|unixpath)
continue
;;
esac
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 12:49:48
|
Moved hardwired reference to build/lib/mlb-path-map from the front end
SML code into bin/mlton-script.
----------------------------------------------------------------------
U mlton/trunk/bin/mlton-script
U mlton/trunk/mlton/front-end/mlb-front-end.fun
----------------------------------------------------------------------
Modified: mlton/trunk/bin/mlton-script
===================================================================
--- mlton/trunk/bin/mlton-script 2005-11-04 20:48:41 UTC (rev 4151)
+++ mlton/trunk/bin/mlton-script 2005-11-04 20:49:46 UTC (rev 4152)
@@ -68,6 +68,7 @@
-cc-opt "-I$lib/include" \
-cc-opt '-O1' \
-cc-opt '-fno-strict-aliasing -fomit-frame-pointer -w' \
+ -mlb-path-map "$lib/mlb-path-map" \
-target-as-opt amd64 \
'-m32
-mtune=opteron' \
Modified: mlton/trunk/mlton/front-end/mlb-front-end.fun
===================================================================
--- mlton/trunk/mlton/front-end/mlb-front-end.fun 2005-11-04 20:48:41 UTC (rev 4151)
+++ mlton/trunk/mlton/front-end/mlb-front-end.fun 2005-11-04 20:49:46 UTC (rev 4152)
@@ -100,10 +100,7 @@
val pathMap =
List.rev
(List.concat
- [List.concat
- (List.map (concat [!Control.libDir, "/mlb-path-map"]
- :: (!Control.mlbPathMaps),
- make)),
+ [List.concat (List.map (!Control.mlbPathMaps, make)),
[{var = "LIB_MLTON_DIR",
path = !Control.libDir},
{var = "TARGET_ARCH",
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 12:48:42
|
Added some mingw exceptions and reorganized regression script.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-04 20:47:54 UTC (rev 4150)
+++ mlton/trunk/bin/regression 2005-11-04 20:48:41 UTC (rev 4151)
@@ -104,100 +104,98 @@
case `host-os` in
mingw)
case "$f" in
- mutex|prodcons|signals2)
+ cmdline|command-line|filesys|mutex|prodcons|signals2)
continue
;;
esac
esac
case "$f" in
serialize)
- echo "skipping $f"
+ continue
;;
+ esac
+ echo "testing $f"
+ case "$f" in
+ exnHistory*)
+ extraFlags="-const 'Exn.keepHistory true'"
+ ;;
*)
- echo "testing $f"
- case "$f" in
- exnHistory*)
- extraFlags="-const 'Exn.keepHistory true'"
+ extraFlags=""
+ ;;
+ esac
+ case "$runOnly" in
+ no)
+ mlb="$f.mlb"
+ echo "\$(SML_LIB)/basis/basis.mlb
+ \$(SML_LIB)/basis/mlton.mlb
+ \$(SML_LIB)/basis/sml-nj.mlb
+ ann
+ \"allowFFI true\"
+ \"allowOverload true\"
+ \"nonexhaustiveMatch ignore\"
+ \"redundantMatch ignore\"
+ in $f.sml
+ end" >$mlb
+ cmd="$mlton $flags $extraFlags -output $f $mlb"
+ eval $cmd
+ rm $mlb
+ if [ "$?" -ne '0' ] ||
+ [ "$cross" = 'no' -a ! -x "$f" ]; then
+ compFail $f
+ fi
+ ;;
+ yes)
+ case $crossTarget in
+ *mingw)
+ libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
;;
+ *solaris)
+ libs='-lnsl -lsocket -lrt'
+ ;;
*)
- extraFlags=""
+ libs=''
;;
esac
- case "$runOnly" in
- no)
- mlb="$f.mlb"
- echo "\$(SML_LIB)/basis/basis.mlb
- \$(SML_LIB)/basis/mlton.mlb
- \$(SML_LIB)/basis/sml-nj.mlb
- ann
- \"allowFFI true\"
- \"allowOverload true\"
- \"nonexhaustiveMatch ignore\"
- \"redundantMatch ignore\"
- in $f.sml
- end" >$mlb
- cmd="$mlton $flags $extraFlags -output $f $mlb"
- eval $cmd
- rm $mlb
- if [ "$?" -ne '0' ] ||
- [ "$cross" = 'no' -a ! -x "$f" ]; then
- compFail $f
- fi
+ libs="-lmlton -lgmp $libs -lgdtoa -lm"
+ # Must use $f.[0-9].[cS], not $f.*.[cS], because the
+ # latter will include other files, e.g. for finalize,
+ # it will also include finalize.2.
+ files="$f.[0-9].[cS]"
+ if [ 0 -ne `ls $f.[0-9][0-9].[cS] 2>/dev/null | wc -l` ]; then
+ files="$files $f.[0-9][0-9].[cS]"
+ fi
+ gcc -o $f -w -O1 \
+ -I "../build/lib/include" \
+ -L"../build/lib/$crossTarget" \
+ -L/usr/pkg/lib \
+ -L/usr/local/lib \
+ $files $libs
+ ;;
+ esac
+ if [ ! -r $f.nonterm -a $cross = 'no' -a -x $f ]; then
+ nonZeroMsg='Nonzero exit status.'
+ case $crossTarget in
+ *mingw)
+ nonZeroMsg="$nonZeroMsg"'\r'
;;
- yes)
- case $crossTarget in
- *mingw)
- libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
- ;;
- *solaris)
- libs='-lnsl -lsocket -lrt'
- ;;
- *)
- libs=''
- ;;
- esac
- libs="-lmlton -lgmp $libs -lgdtoa -lm"
- # Must use $f.[0-9].[cS], not $f.*.[cS], because the
- # latter will include other files, e.g. for finalize,
- # it will also include finalize.2.
- files="$f.[0-9].[cS]"
- if [ 0 -ne `ls $f.[0-9][0-9].[cS] 2>/dev/null | wc -l` ]; then
- files="$files $f.[0-9][0-9].[cS]"
- fi
- gcc -o $f -w -O1 \
- -I "../build/lib/include" \
- -L"../build/lib/$crossTarget" \
- -L/usr/pkg/lib \
- -L/usr/local/lib \
- $files $libs
- ;;
esac
- if [ ! -r $f.nonterm -a $cross = 'no' -a -x $f ]; then
- nonZeroMsg='Nonzero exit status.'
+ ( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1
+ if [ -r $f.ok ]; then
+ compare="$f.$HOST_ARCH-$HOST_OS.ok"
+ if [ ! -r $compare ]; then
+ compare="$f.ok"
+ fi
case $crossTarget in
*mingw)
- nonZeroMsg="$nonZeroMsg"'\r'
+ compare="$f.sed.ok"
+ sed 's/$/\r/' <"$f.ok" >"$compare"
;;
esac
- ( ./$f || echo -e "$nonZeroMsg" ) >$tmp 2>&1
- if [ -r $f.ok ]; then
- compare="$f.$HOST_ARCH-$HOST_OS.ok"
- if [ ! -r $compare ]; then
- compare="$f.ok"
- fi
- case $crossTarget in
- *mingw)
- compare="$f.sed.ok"
- sed 's/$/\r/' <"$f.ok" >"$compare"
- ;;
- esac
- if ! diff $compare $tmp; then
- echo "difference with $flags"
- fi
+ if ! diff $compare $tmp; then
+ echo "difference with $flags"
fi
fi
- ;;
- esac
+ fi
done
if [ "$cross" = 'yes' -o "$runOnly" = 'yes' -o "$short" = 'yes' ]; then
exit 0
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 12:47:57
|
Made clean script more robust.
----------------------------------------------------------------------
U mlton/trunk/bin/clean
----------------------------------------------------------------------
Modified: mlton/trunk/bin/clean
===================================================================
--- mlton/trunk/bin/clean 2005-11-04 19:52:16 UTC (rev 4149)
+++ mlton/trunk/bin/clean 2005-11-04 20:47:54 UTC (rev 4150)
@@ -23,14 +23,13 @@
fi
for f in `ls`; do
if [ -d $f ]; then
- cd $f;
- if [ -r Makefile ] &&
- grep $grepFlags '^clean:' Makefile ; then
- $bin/mmake clean
+ cd $f
+ if [ -r Makefile ]; then
+ $bin/mmake clean || doit
else
doit
- fi &&
- cd ..;
+ fi
+ cd ..
fi
done
}
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 11:52:19
|
Progress towards a MinGW package. Includes Wesley's patch from a
couple of weeks back, except for all the slash<->backslash changes in
Makefiles. I guess those should be kept as a separate patch, perhaps
in package/mingw/, that can be applied to switch to Makefiles usable
on MinGW.
----------------------------------------------------------------------
U mlton/trunk/Makefile
U mlton/trunk/bin/add-cross
U mlton/trunk/mlton/Makefile
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/runtime/platform/mingw.c
U mlton/trunk/runtime/platform/mingw.h
----------------------------------------------------------------------
Modified: mlton/trunk/Makefile
===================================================================
--- mlton/trunk/Makefile 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/Makefile 2005-11-04 19:52:16 UTC (rev 4149)
@@ -19,6 +19,11 @@
RUN = $(SRC)/runtime
MLTON = $(BIN)/mlton
AOUT = mlton-compile
+ifeq (mingw, $(TARGET_OS))
+EXE = .exe
+else
+EXE =
+endif
MLBPATHMAP = $(LIB)/mlb-path-map
TARGETMAP = $(LIB)/target-map
SPEC = package/rpm/mlton.spec
@@ -46,7 +51,7 @@
# stubs. Remove $(AOUT) so that the $(MAKE) compiler below will
# remake MLton.
ifeq (other, $(shell if [ ! -x $(BIN)/mlton ]; then echo other; fi))
- rm -f $(COMP)/$(AOUT)
+ rm -f $(COMP)/$(AOUT)$(EXE)
endif
$(MAKE) script mlbpathmap targetmap constants compiler world libraries tools
@echo 'Build of MLton succeeded.'
@@ -92,7 +97,7 @@
.PHONY: compiler
compiler:
$(MAKE) -C $(COMP)
- $(CP) $(COMP)/$(AOUT) $(LIB)/
+ $(CP) $(COMP)/$(AOUT)$(EXE) $(LIB)/
.PHONY: constants
constants:
@@ -300,7 +305,11 @@
$(MAKE) -C $(NLFFIGEN)
$(MAKE) -C $(PROF)
$(MAKE) -C $(YACC)
- $(CP) $(LEX)/$(LEX) $(NLFFIGEN)/$(NLFFIGEN) $(PROF)/$(PROF) $(YACC)/$(YACC) $(BIN)/
+ $(CP) $(LEX)/$(LEX)$(EXE) \
+ $(NLFFIGEN)/$(NLFFIGEN)$(EXE) \
+ $(PROF)/$(PROF)$(EXE) \
+ $(YACC)/$(YACC)$(EXE) \
+ $(BIN)/
.PHONY: version
version:
@@ -321,7 +330,7 @@
world-no-check:
@echo 'Making world.'
$(MAKE) basis-no-check
- $(LIB)/$(AOUT) @MLton -- $(LIB)/world
+ $(LIB)/$(AOUT)$(EXE) @MLton -- $(LIB)/world
.PHONY: world
world:
Modified: mlton/trunk/bin/add-cross
===================================================================
--- mlton/trunk/bin/add-cross 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/bin/add-cross 2005-11-04 19:52:16 UTC (rev 4149)
@@ -89,8 +89,19 @@
mmake TARGET=$crossTarget TARGET_ARCH=$crossArch TARGET_OS=$crossOS \
mlbpathmap targetmap )
+case "$crossOS" in
+mingw)
+ suf='.exe'
+;;
+*)
+ suf=''
+;;
+esac
case "$crossOS" in
+mingw)
+ libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
+;;
solaris)
libs='-lrt -lnsl -lsocket'
;;
@@ -103,5 +114,5 @@
ssh $machine "cd $tmp/runtime &&
cat >$exe.c &&
gcc -I. -o $exe $exe.c libmlton.a -lgmp -lm $libs"
-ssh $machine "$tmp/runtime/$exe" >"$lib/$crossTarget/constants"
+ssh $machine "$tmp/runtime/$exe$suf" >"$lib/$crossTarget/constants"
ssh $machine "rm -rf $tmp"
Modified: mlton/trunk/mlton/Makefile
===================================================================
--- mlton/trunk/mlton/Makefile 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/mlton/Makefile 2005-11-04 19:52:16 UTC (rev 4149)
@@ -9,6 +9,7 @@
SRC = $(shell cd .. && pwd)
BUILD = $(SRC)/build
BIN = $(BUILD)/bin
+HOST_OS = $(shell $(SRC)/bin/host-os)
LIB = $(BUILD)/lib
MLTON = mlton
TARGET = self
@@ -23,16 +24,21 @@
FILE = mlton.mlb
FLAGS += -default-ann 'sequenceNonUnit warn'
else
-ifeq (cygwin, $(shell $(SRC)/bin/host-os))
+ifeq (cygwin, $(HOST_OS))
# The stubs don't work on Cygwin, since they define spawn in terms of
# fork, and fork doesn't work on Cygwin. So, make without the stubs.
FILE = mlton.cm
else
+ifeq (mingw, $(HOST_OS))
+ # Ditto for MinGW.
+ FILE = mlton.cm
+else
# We're compiling MLton with an older version of itself, so use the stubs for
# the MLton structure.
FILE = mlton-stubs.cm
endif
endif
+endif
ifeq (new,$(shell PATH=$(BIN):$$PATH; mlton -target self >/dev/null 2>&1 && echo new))
FLAGS += -target $(TARGET)
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/mlton/main/main.fun 2005-11-04 19:52:16 UTC (rev 4149)
@@ -69,7 +69,9 @@
Promise.lazy
(fn () =>
List.map
- (File.lines (concat [!Control.libDir, "/target-map"]), fn line =>
+ (File.lines (OS.Path.joinDirFile {dir = !Control.libDir,
+ file = "target-map"}),
+ fn line =>
case String.tokens (line, Char.isSpace) of
[target, arch, os] =>
let
@@ -542,7 +544,7 @@
case target of
Cross s => s
| Self => "self"
- val _ = libTargetDir := concat [!libDir, "/", targetStr]
+ val _ = libTargetDir := OS.Path.concat (!libDir, targetStr)
val targetArch = !targetArch
val archStr = String.toLower (MLton.Platform.Arch.toString targetArch)
val targetOS = !targetOS
@@ -712,7 +714,7 @@
fun temp (suf: string): File.t =
let
val (f, out) =
- File.temp {prefix = concat [tmpDir, "/file"],
+ File.temp {prefix = OS.Path.concat (tmpDir, "file"),
suffix = suf}
val _ = Out.close out
val _ = List.push (tempFiles, f)
Modified: mlton/trunk/runtime/platform/mingw.c
===================================================================
--- mlton/trunk/runtime/platform/mingw.c 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/runtime/platform/mingw.c 2005-11-04 19:52:16 UTC (rev 4149)
@@ -489,6 +489,13 @@
die ("kill not implemented");
}
+int nanosleep (const struct timespec *req, struct timespec *rem) {
+ Sleep (req->tv_sec * 1000 + (req->tv_nsec + 999) / 1000);
+ rem->tv_nsec = 0;
+ rem->tv_sec = 0;
+ return 0;
+}
+
int pause (void) {
die ("pause not implemented");
}
Modified: mlton/trunk/runtime/platform/mingw.h
===================================================================
--- mlton/trunk/runtime/platform/mingw.h 2005-11-04 17:45:17 UTC (rev 4148)
+++ mlton/trunk/runtime/platform/mingw.h 2005-11-04 19:52:16 UTC (rev 4149)
@@ -302,6 +302,11 @@
pid_t fork (void);
int kill (pid_t pid, int sig);
int pause (void);
+struct timespec {
+ time_t tv_sec;
+ long tv_nsec;
+};
+int nanosleep (const struct timespec *req, struct timespec *rem);
unsigned int sleep (unsigned int seconds);
pid_t wait (int *status);
pid_t waitpid (pid_t pid, int *status, int options);
|
|
From: Stephen W. <sw...@ml...> - 2005-11-04 09:45:18
|
Put darwin package in /usr/local, not /usr. ---------------------------------------------------------------------- U mlton/trunk/Makefile ---------------------------------------------------------------------- Modified: mlton/trunk/Makefile =================================================================== --- mlton/trunk/Makefile 2005-11-04 05:17:15 UTC (rev 4147) +++ mlton/trunk/Makefile 2005-11-04 17:45:17 UTC (rev 4148) @@ -337,6 +337,9 @@ # puts them. DESTDIR = $(CURDIR)/install PREFIX = /usr +ifeq ($(TARGET_OS), darwin) +PREFIX = /usr/local +endif ifeq ($(TARGET_OS), solaris) PREFIX = /usr/local endif |
|
From: Stephen W. <sw...@ml...> - 2005-11-03 21:17:17
|
Only allow the fpclassify (feround) #ifdef's if not HAS_FPCLASSIFY (HAS_FEROUND). ---------------------------------------------------------------------- U mlton/trunk/runtime/platform.h ---------------------------------------------------------------------- Modified: mlton/trunk/runtime/platform.h =================================================================== --- mlton/trunk/runtime/platform.h 2005-11-04 05:15:34 UTC (rev 4146) +++ mlton/trunk/runtime/platform.h 2005-11-04 05:17:15 UTC (rev 4147) @@ -166,6 +166,7 @@ #define EXECVE execve #endif +#if not HAS_FEROUND #ifndef FE_TONEAREST #define FE_TONEAREST 0 #endif @@ -178,8 +179,9 @@ #ifndef FE_TOWARDZERO #define FE_TOWARDZERO 3 #endif +#endif - +#if not HAS_FPCLASSIFY #ifndef FP_INFINITE #define FP_INFINITE 1 #endif @@ -195,6 +197,7 @@ #ifndef FP_ZERO #define FP_ZERO 2 #endif +#endif /* If HAS_TIME_PROFILING, then you must define these. */ void *getTextStart (); |
|
From: Stephen W. <sw...@ml...> - 2005-11-03 21:15:35
|
For some stupid reason 'ls' on Darwin returns zero exit status when
there are no files matching a pattern, unlike every other system, so I
switched to a different method.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-04 03:52:55 UTC (rev 4145)
+++ mlton/trunk/bin/regression 2005-11-04 05:15:34 UTC (rev 4146)
@@ -161,7 +161,7 @@
# latter will include other files, e.g. for finalize,
# it will also include finalize.2.
files="$f.[0-9].[cS]"
- if ls $f.[0-9][0-9].[cS] >/dev/null 2>&1; then
+ if [ 0 -ne `ls $f.[0-9][0-9].[cS] 2>/dev/null | wc -l` ]; then
files="$files $f.[0-9][0-9].[cS]"
fi
gcc -o $f -w -O1 \
|
|
From: Matthew F. <fl...@ml...> - 2005-11-03 19:53:16
|
Yet more cleanup
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/new-object.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/pack.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/profiling.h
D mlton/branches/on-20050822-x86_64-branch/runtime/gc/ratios.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/rusage.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/share.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/signals.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/size.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/switch-thread.c
A mlton/branches/on-20050822-x86_64-branch/runtime/gc/switch-thread.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/thread.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.c
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/weak.h
U mlton/branches/on-20050822-x86_64-branch/runtime/gc/world.c
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/Makefile 2005-11-04 03:52:55 UTC (rev 4145)
@@ -88,6 +88,7 @@
copy-thread.c \
current.c \
dfs-mark.c \
+ done.c \
enter_leave.c \
foreach.c \
forward.c \
@@ -95,30 +96,33 @@
garbage-collection.c \
gc_state.c \
generational.c \
+ handler.c \
hash-cons.c \
heap.c \
heap_predicates.c \
+ init-world.c \
+ init.c \
invariant.c \
mark-compact.c \
model.c \
model_predicates.c \
new-object.c \
+ object-size.c \
object.c \
- object-size.c \
pack.c \
pointer.c \
pointer_predicates.c \
+ profiling.c \
share.c \
+ signals.c \
size.c \
stack.c \
stack_predicates.c \
+ switch-thread.c \
thread.c \
translate.c \
weak.c \
world.c \
- profiling.c \
- init.c \
- done.c \
assumptions.c \
gc_suffix.c
@@ -138,38 +142,41 @@
stack.h \
thread.h \
weak.h \
+ int-inf.h \
object-size.h \
- int-inf.h \
+ generational.h \
heap.h \
- major.h \
- generational.h \
current.h \
foreach.h \
- statistics.h \
+ translate.h \
sysvals.h \
- ratios.h \
controls.h \
+ major.h \
+ statistics.h \
forward.h \
cheney-copy.h \
hash-cons.h \
- profiling.h \
- signals.h \
- world.h \
- init.h \
- gc_state.h \
- translate.h \
+ dfs-mark.h \
+ mark-compact.h \
+ invariant.h \
atomic.h \
- invariant.h \
enter_leave.h \
- dfs-mark.h \
- mark-compact.h \
+ signals.h \
+ handler.h \
+ switch-thread.h \
+ garbage-collection.h \
new-object.h \
- garbage-collection.h \
array-allocate.h \
+ profiling.h \
+ init-world.h \
+ world.h \
+ init.h \
+ done.h \
copy-thread.h \
pack.h \
share.h \
size.h \
+ gc_state.h \
gc_suffix.h
all: libgc.o libgc-gdb.o
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/TODO 2005-11-04 03:52:55 UTC (rev 4145)
@@ -18,3 +18,5 @@
* the "skipObjects" loop in forwardInterGenerationalObjptrs appears to
be unnecessary.
* Why do {load,save}Globals differ in the representation of the file?
+* Why does hash-table use malloc/free while generational maps use mmap/munmap?
+
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array-allocate.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -42,9 +42,11 @@
/*uintToCommaString*/(arraySize),
/*uintToCommaString*/(ensureBytesFree));
if (arraySize >= s->controls.oldGenArraySize) {
- enter (s);
- doGC (s, arraySize, ensureBytesFree, FALSE, TRUE);
- leave (s);
+ if (not hasHeapBytesFree (s, arraySize, ensureBytesFree)) {
+ enter (s);
+ performGC (s, arraySize, ensureBytesFree, FALSE, TRUE);
+ leave (s);
+ }
frontier = s->heap.start + s->heap.oldGenSize;
last = frontier + arraySize;
s->heap.oldGenSize += arraySize;
@@ -53,9 +55,9 @@
size_t bytesRequested;
bytesRequested = arraySize + ensureBytesFree;
- if (bytesRequested > (size_t)(s->limitPlusSlop - s->frontier)) {
+ if (not hasHeapBytesFree (s, 0, bytesRequested)) {
enter (s);
- doGC (s, 0, bytesRequested, FALSE, TRUE);
+ performGC (s, 0, bytesRequested, FALSE, TRUE);
leave (s);
}
frontier = s->frontier;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -42,3 +42,27 @@
GC_arrayCounter getArrayCounter (pointer a) {
return *(getArrayCounterp (a));
}
+
+pointer indexArrayAtPointerIndex (GC_state s, pointer a,
+ GC_arrayCounter arrayIndex,
+ uint32_t pointerIndex) {
+ GC_header header;
+ uint16_t numNonObjptrs;
+ uint16_t numObjptrs;
+ GC_objectTypeTag tag;
+
+ header = getHeader (a);
+ splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
+ assert (tag == ARRAY_TAG);
+
+ size_t nonObjptrBytesPerElement =
+ sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
+ size_t bytesPerElement =
+ nonObjptrBytesPerElement
+ + (numObjptrs * OBJPTR_SIZE);
+
+ return a
+ + arrayIndex * bytesPerElement
+ + nonObjptrBytesPerElement
+ + pointerIndex * OBJPTR_SIZE;
+}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/array.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -32,3 +32,6 @@
GC_arrayLength getArrayLength (pointer a);
GC_arrayCounter* getArrayCounterp (pointer a);
GC_arrayCounter getArrayCounter (pointer a);
+pointer indexArrayAtPointerIndex (GC_state s, pointer a,
+ GC_arrayCounter arrayIndex,
+ uint32_t pointerIndex);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/cheney-copy.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -103,7 +103,7 @@
if (DEBUG_GENERATIONAL)
fprintf (stderr, "minorGC nursery = "FMTPTR" frontier = "FMTPTR"\n",
(uintptr_t)s->heap.nursery, (uintptr_t)s->frontier);
- assert (invariant (s));
+ assert (invariantForGC (s));
bytesAllocated = s->frontier - s->heap.nursery;
if (bytesAllocated == 0)
return;
@@ -122,7 +122,7 @@
fprintf (stderr, "toStart = "FMTPTR"\n", (uintptr_t)s->forwardState.toStart);
assert (isAlignedFrontier (s, s->forwardState.toStart));
s->forwardState.toLimit = s->forwardState.toStart + bytesAllocated;
- assert (invariant (s));
+ assert (invariantForGC (s));
s->cumulativeStatistics.numMinorGCs++;
s->lastMajorStatistics.numMinorGCs++;
s->forwardState.back = s->forwardState.toStart;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -14,5 +14,6 @@
return
DEBUG
or s->controls.summary
- or s->controls.messages;
+ or s->controls.messages
+ or s->controls.rusageMeasureGC;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/controls.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,6 +6,32 @@
* See the file MLton-LICENSE for details.
*/
+struct GC_ratios {
+ /* Minimum live ratio to use copying GC. */
+ float copy;
+ /* Only use generational GC with copying collection if the ratio of
+ * heap size to live data size is below copyGenerational.
+ */
+ float copyGenerational;
+ float grow;
+ float hashCons;
+ /* Desired ratio of heap size to live data. */
+ float live;
+ /* Minimum live ratio to us mark-compact GC. */
+ float markCompact;
+ /* Only use generational GC with mark-compact collection if the
+ * ratio of heap size to live data size is below
+ * markCompactGenerational.
+ */
+ float markCompactGenerational;
+ /* As long as the ratio of bytes live to nursery size is greater
+ * than nurseryRatio, use minor GCs.
+ */
+ float nursery;
+ float ramSlop;
+ float threadShrink;
+};
+
struct GC_controls {
size_t fixedHeap; /* If 0, then no fixed heap. */
size_t maxHeap; /* if zero, then unlimited, else limit total heap */
@@ -14,6 +40,7 @@
bool messages; /* Print a message at the start and end of each gc. */
size_t oldGenArraySize; /* Arrays larger are allocated in old gen, if possible. */
struct GC_ratios ratios;
+ bool rusageMeasureGC;
bool summary; /* Print a summary of gc info when program exits. */
};
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,24 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-GC_thread newThread (GC_state s, size_t reserved) {
- GC_stack stack;
- GC_thread thread;
-
- ensureFree (s, sizeofStackWithHeaderAligned (s, reserved) + sizeofThread (s));
- stack = newStack (s, reserved, FALSE);
- thread = (GC_thread) newObject (s, GC_THREAD_HEADER,
- sizeofThread (s),
- FALSE);
- thread->bytesNeeded = 0;
- thread->exnStack = BOGUS_EXN_STACK;
- thread->stack = pointerToObjptr((pointer)stack, s->heap.start);
- if (DEBUG_THREADS)
- fprintf (stderr, FMTPTR" = newThreadOfSize (%zu)\n",
- (uintptr_t)thread, reserved);;
- return thread;
-}
-
GC_thread copyThread (GC_state s, GC_thread from, size_t size) {
GC_thread to;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/copy-thread.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,7 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-GC_thread newThread (GC_state s, size_t stackSize);
GC_thread copyThread (GC_state s, GC_thread from, size_t size);
void GC_copyCurrentThread (GC_state s);
pointer GC_copyThread (GC_state s, pointer p);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -10,46 +10,22 @@
/* Depth-first Marking */
/* ---------------------------------------------------------------- */
-bool isMarked (pointer p) {
+bool isPointerMarked (pointer p) {
return MARK_MASK & getHeader (p);
}
-bool isMarkedMode (GC_markMode m, pointer p) {
+bool isPointerMarkedByMode (pointer p, GC_markMode m) {
switch (m) {
case MARK_MODE:
- return isMarked (p);
+ return isPointerMarked (p);
case UNMARK_MODE:
- return not isMarked (p);
+ return not isPointerMarked (p);
default:
die ("bad mark mode %u", m);
}
}
-pointer arrayIndexAtPointer (GC_state s, pointer a,
- GC_arrayCounter arrayIndex,
- uint32_t pointerIndex) {
- GC_header header;
- uint16_t numNonObjptrs;
- uint16_t numObjptrs;
- GC_objectTypeTag tag;
-
- header = getHeader (a);
- splitHeader(s, header, &tag, NULL, &numNonObjptrs, &numObjptrs);
- assert (tag == ARRAY_TAG);
-
- size_t nonObjptrBytesPerElement =
- sizeofNumNonObjptrs (ARRAY_TAG, numNonObjptrs);
- size_t bytesPerElement =
- nonObjptrBytesPerElement
- + (numObjptrs * OBJPTR_SIZE);
-
- return a
- + arrayIndex * bytesPerElement
- + nonObjptrBytesPerElement
- + pointerIndex * OBJPTR_SIZE;
-}
-
-/* dfsMark (s, r, m, shc)
+/* dfsMarkByMode (s, r, m, shc)
*
* Sets all the mark bits in the object graph pointed to by r.
*
@@ -60,8 +36,8 @@
*
* It returns the total size in bytes of the objects marked.
*/
-size_t dfsMark (GC_state s, pointer root,
- GC_markMode mode, bool shouldHashCons) {
+size_t dfsMarkByMode (GC_state s, pointer root,
+ GC_markMode mode, bool shouldHashCons) {
GC_header mark; /* Used to set or clear the mark bit. */
size_t size; /* Total number of bytes marked. */
pointer cur; /* The current object being marked. */
@@ -82,7 +58,7 @@
GC_frameLayout frameLayout;
GC_frameOffsets frameOffsets;
- if (isMarkedMode (mode, root))
+ if (isPointerMarkedByMode (root, mode))
/* Object has already been marked. */
return 0;
mark = (MARK_MODE == mode) ? MARK_MASK : 0;
@@ -107,7 +83,7 @@
" prev = "FMTPTR" todo = "FMTPTR"\n",
(uintptr_t)cur, (uintptr_t)next,
(uintptr_t)prev, (uintptr_t)todo);
- assert (not isMarkedMode (mode, next));
+ assert (not isPointerMarkedByMode (next, mode));
assert (nextHeaderp == getHeaderp (next));
assert (nextHeader == getHeader (next));
// assert (*(pointer*) todo == next);
@@ -128,7 +104,7 @@
* headerp points to the header of cur.
* header is the header of cur.
*/
- assert (not isMarkedMode (mode, cur));
+ assert (not isPointerMarkedByMode (cur, mode));
assert (header == getHeader (cur));
assert (headerp == getHeaderp (cur));
header ^= MARK_MASK;
@@ -215,14 +191,14 @@
arrayIndex, index);
assert (arrayIndex < getArrayLength (cur));
assert (index < numObjptrs);
- assert (todo == arrayIndexAtPointer (s, cur, arrayIndex, index));
+ assert (todo == indexArrayAtPointerIndex (s, cur, arrayIndex, index));
// next = *(pointer*)todo;
next = fetchObjptrToPointer (todo, s->heap.start);
if (not (isPointer(next))) {
markNextInArray:
assert (arrayIndex < getArrayLength (cur));
assert (index < numObjptrs);
- assert (todo == arrayIndexAtPointer (s, cur, arrayIndex, index));
+ assert (todo == indexArrayAtPointerIndex (s, cur, arrayIndex, index));
todo += OBJPTR_SIZE;
index++;
if (index < numObjptrs)
@@ -305,7 +281,7 @@
if (DEBUG_MARK_COMPACT)
fprintf (stderr, "return cur = "FMTPTR" prev = "FMTPTR"\n",
(uintptr_t)cur, (uintptr_t)prev);
- assert (isMarkedMode (mode, cur));
+ assert (isPointerMarkedByMode (cur, mode));
if (NULL == prev)
return size;
next = cur;
@@ -356,23 +332,23 @@
assert (FALSE);
}
-void dfsMarkTrue (GC_state s, objptr *opp) {
+void dfsMarkWithHashCons (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- dfsMark (s, p, MARK_MODE, TRUE);
+ dfsMarkByMode (s, p, MARK_MODE, TRUE);
}
-void dfsMarkFalse (GC_state s, objptr *opp) {
+void dfsMarkWithoutHashCons (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- dfsMark (s, p, MARK_MODE, FALSE);
+ dfsMarkByMode (s, p, MARK_MODE, FALSE);
}
void dfsUnmark (GC_state s, objptr *opp) {
pointer p;
p = objptrToPointer (*opp, s->heap.start);
- dfsMark (s, p, UNMARK_MODE, FALSE);
+ dfsMarkByMode (s, p, UNMARK_MODE, FALSE);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/dfs-mark.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -11,14 +11,10 @@
UNMARK_MODE,
} GC_markMode;
-bool isMarked (pointer p);
-bool isMarkedMode (GC_markMode m, pointer p);
-pointer arrayIndexAtPointer (GC_state s,
- pointer a,
- GC_arrayCounter arrayIndex,
- uint32_t pointerIndex);
-size_t dfsMark (GC_state s, pointer root,
- GC_markMode mode, bool shouldHashCons);
-void dfsMarkTrue (GC_state s, objptr *opp);
-void dfsMarkFalse (GC_state s, objptr *opp);
+bool isPointerMarked (pointer p);
+bool isPointerMarkedByMode (pointer p, GC_markMode m);
+size_t dfsMarkByMode (GC_state s, pointer root,
+ GC_markMode mode, bool shouldHashCons);
+void dfsMarkWithHashCons (GC_state s, objptr *opp);
+void dfsMarkWithoutHashCons (GC_state s, objptr *opp);
void dfsUnmark (GC_state s, objptr *opp);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.c 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/done.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,9 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+void GC_done (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/enter_leave.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -20,7 +20,7 @@
if (DEBUG)
displayGCState (s, stderr);
beginAtomic (s);
- assert (invariant (s));
+ assert (invariantForGC (s));
if (DEBUG)
fprintf (stderr, "enter ok\n");
}
@@ -31,7 +31,7 @@
/* The mutator frontier invariant may not hold
* for functions that don't ensureBytesFree.
*/
- assert (mutatorInvariant (s, FALSE, TRUE));
+ assert (invariantForMutator (s, FALSE, TRUE));
endAtomic (s);
if (DEBUG)
fprintf (stderr, "leave ok\n");
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -47,6 +47,21 @@
assert (s->heap.oldGenSize + bytesRequested <= s->heap.size);
}
+void growStackCurrent (GC_state s) {
+ size_t size;
+ GC_stack stack;
+
+ size = sizeofStackGrow (s, getStackCurrent(s));
+ if (DEBUG_STACKS or s->controls.messages)
+ fprintf (stderr, "Growing stack to size %zu.\n",
+ /*uintToCommaString*/(sizeofStackWithHeaderAligned (s, size)));
+ assert (hasHeapBytesFree (s, sizeofStackWithHeaderAligned (s, size), 0));
+ stack = newStack (s, size, TRUE);
+ copyStack (s, getStackCurrent(s), stack);
+ getThreadCurrent(s)->stack = pointerToObjptr ((pointer)stack, s->heap.start);
+ markCard (s, objptrToPointer (getThreadCurrentObjptr(s), s->heap.start));
+}
+
void enterGC (GC_state s) {
if (s->profiling.isOn) {
/* We don't need to profileEnter for count profiling because it
@@ -69,11 +84,11 @@
s->amInGC = FALSE;
}
-void doGC (GC_state s,
- size_t oldGenBytesRequested,
- size_t nurseryBytesRequested,
- bool forceMajor,
- bool mayResize) {
+void performGC (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested,
+ bool forceMajor,
+ bool mayResize) {
uintmax_t gcTime;
bool stackTopOk;
size_t stackBytesRequested;
@@ -85,11 +100,11 @@
fprintf (stderr, "Starting gc. Request %zu nursery bytes and %zu old gen bytes.\n",
/*uintToCommaString*/(nurseryBytesRequested),
/*uintToCommaString*/(oldGenBytesRequested));
- assert (invariant (s));
+ assert (invariantForGC (s));
if (needGCTime (s))
startTiming (&ru_start);
minorGC (s);
- stackTopOk = mutatorStackInvariant (s);
+ stackTopOk = invariantForMutatorStack (s);
stackBytesRequested =
stackTopOk
? 0
@@ -106,7 +121,7 @@
assert (hasHeapBytesFree (s, oldGenBytesRequested + stackBytesRequested,
nurseryBytesRequested));
unless (stackTopOk)
- growStack (s);
+ growStackCurrent (s);
setGCStateCurrentThreadAndStack (s);
if (needGCTime (s)) {
gcTime = stopTiming (&ru_start, &s->cumulativeStatistics.ru_gc);
@@ -134,133 +149,33 @@
if (DEBUG)
displayGCState (s, stderr);
assert (hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
- assert (invariant (s));
+ assert (invariantForGC (s));
leaveGC (s);
}
-void ensureMutatorInvariant (GC_state s, bool force) {
+void ensureInvariantForMutator (GC_state s, bool force) {
if (force
- or not (mutatorFrontierInvariant(s))
- or not (mutatorStackInvariant(s))) {
+ or not (invariantForMutatorFrontier(s))
+ or not (invariantForMutatorStack(s))) {
/* This GC will grow the stack, if necessary. */
- doGC (s, 0, getThreadCurrent(s)->bytesNeeded, force, TRUE);
+ performGC (s, 0, getThreadCurrent(s)->bytesNeeded, force, TRUE);
}
- assert (mutatorFrontierInvariant(s));
- assert (mutatorStackInvariant(s));
+ assert (invariantForMutatorFrontier(s));
+ assert (invariantForMutatorStack(s));
}
-/* ensureFree (s, b) ensures that upon return
- * b <= s->limitPlusSlop - s->frontier
+/* ensureHasHeapBytesFree (s, oldGen, nursery)
*/
-void ensureFree (GC_state s, size_t bytesRequested) {
+void ensureHasHeapBytesFree (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested) {
+ assert (s->heap.nursery <= s->limitPlusSlop);
assert (s->frontier <= s->limitPlusSlop);
- if (bytesRequested > (size_t)(s->limitPlusSlop - s->frontier))
- doGC (s, 0, bytesRequested, FALSE, TRUE);
- assert (bytesRequested <= (size_t)(s->limitPlusSlop - s->frontier));
+ if (not hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested))
+ performGC (s, oldGenBytesRequested, nurseryBytesRequested, FALSE, TRUE);
+ assert (hasHeapBytesFree (s, oldGenBytesRequested, nurseryBytesRequested));
}
-void switchToThread (GC_state s, objptr op) {
- if (DEBUG_THREADS) {
- GC_thread thread;
- GC_stack stack;
-
- thread = (GC_thread)(objptrToPointer (op, s->heap.start));
- stack = (GC_stack)(objptrToPointer (thread->stack, s->heap.start));
-
- fprintf (stderr, "switchToThread ("FMTOBJPTR") used = %zu reserved = %zu\n",
- op, stack->used, stack->reserved);
- }
- s->currentThread = op;
- setGCStateCurrentThreadAndStack (s);
-}
-
-/* GC_startHandler does not do an enter()/leave(), even though it is
- * exported. The basis library uses it via _import, not _prim, and so
- * does not treat it as a runtime call -- so the invariant in enter
- * would fail miserably. It is OK because GC_startHandler must be
- * called from within a critical section.
- *
- * Don't make it inline, because it is also called in basis/Thread.c,
- * and when compiling with COMPILE_FAST, they may appear out of order.
- */
-void GC_startHandler (GC_state s) {
- /* Switch to the signal handler thread. */
- if (DEBUG_SIGNALS) {
- fprintf (stderr, "GC_startHandler\n");
- }
- assert (s->atomicState == 1);
- assert (s->signalsInfo.signalIsPending);
- s->signalsInfo.signalIsPending = FALSE;
- s->signalsInfo.amInSignalHandler = TRUE;
- s->savedThread = s->currentThread;
- /* Set s->atomicState to 2 when switching to the signal handler
- * thread; leaving the runtime will decrement s->atomicState to 1,
- * the signal handler will then run atomically and will finish by
- * switching to the thread to continue with, which will decrement
- * s->atomicState to 0.
- */
- s->atomicState = 2;
-}
-
-void GC_finishHandler (GC_state s) {
- if (DEBUG_SIGNALS)
- fprintf (stderr, "GC_finishHandler ()\n");
- assert (s->atomicState == 1);
- s->signalsInfo.amInSignalHandler = FALSE;
-}
-
-void maybeSwitchToHandler (GC_state s) {
- if (s->atomicState == 1
- and s->signalsInfo.signalIsPending) {
- GC_startHandler (s);
- switchToThread (s, s->signalHandlerThread);
- }
-}
-
-void GC_switchToThread (GC_state s, GC_thread t, size_t ensureBytesFree) {
- if (DEBUG_THREADS)
- fprintf (stderr, "GC_switchToThread ("FMTPTR", %zu)\n",
- (uintptr_t)t, ensureBytesFree);
- if (FALSE) {
- /* This branch is slower than the else branch, especially
- * when debugging is turned on, because it does an invariant
- * check on every thread switch.
- * So, we'll stick with the else branch for now.
- */
- enter (s);
- getThreadCurrent(s)->bytesNeeded = ensureBytesFree;
- switchToThread (s, pointerToObjptr((pointer)t, s->heap.start));
- s->atomicState--;
- maybeSwitchToHandler (s);
- ensureMutatorInvariant (s, FALSE);
- assert (mutatorFrontierInvariant(s));
- assert (mutatorStackInvariant(s));
- leave (s);
- } else {
- /* BEGIN: enter(s); */
- getStackCurrent(s)->used = sizeofGCStateCurrentStackUsed (s);
- getThreadCurrent(s)->exnStack = s->exnStack;
- beginAtomic (s);
- /* END: enter(s); */
- getThreadCurrent(s)->bytesNeeded = ensureBytesFree;
- switchToThread (s, pointerToObjptr((pointer)t, s->heap.start));
- s->atomicState--;
- maybeSwitchToHandler (s);
- /* BEGIN: ensureMutatorInvariant */
- if (not (mutatorFrontierInvariant(s))
- or not (mutatorStackInvariant(s))) {
- /* This GC will grow the stack, if necessary. */
- doGC (s, 0, getThreadCurrent(s)->bytesNeeded, FALSE, TRUE);
- }
- /* END: ensureMutatorInvariant */
- /* BEGIN: leave(s); */
- endAtomic (s);
- /* END: leave(s); */
- }
- assert (mutatorFrontierInvariant(s));
- assert (mutatorStackInvariant(s));
-}
-
void GC_gc (GC_state s, size_t bytesRequested, bool force,
char *file, int line) {
if (DEBUG or s->controls.messages)
@@ -272,9 +187,9 @@
if (0 == bytesRequested)
bytesRequested = GC_HEAP_LIMIT_SLOP;
getThreadCurrent(s)->bytesNeeded = bytesRequested;
- maybeSwitchToHandler (s);
- ensureMutatorInvariant (s, force);
- assert (mutatorFrontierInvariant(s));
- assert (mutatorStackInvariant(s));
+ switchToHandlerThreadIfNonAtomicAndSignalPending (s);
+ ensureInvariantForMutator (s, force);
+ assert (invariantForMutatorFrontier(s));
+ assert (invariantForMutatorStack(s));
leave (s);
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -8,19 +8,17 @@
void minorGC (GC_state s);
void majorGC (GC_state s, size_t bytesRequested, bool mayResize);
+void growStackCurrent (GC_state s);
void enterGC (GC_state s);
void leaveGC (GC_state s);
-void doGC (GC_state s,
- size_t oldGenBytesRequested,
- size_t nurseryBytesRequested,
- bool forceMajor,
- bool mayResize);
-void ensureMutatorInvariant (GC_state s, bool force);
-void ensureFree (GC_state s, size_t bytesRequested);
-void switchToThread (GC_state s, objptr op);
-void GC_startHandler (GC_state s);
-void GC_finishHandler (GC_state s);
-void maybeSwitchToHandler (GC_state s);
-void GC_switchToThread (GC_state s, GC_thread t, size_t ensureBytesFree);
+void performGC (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested,
+ bool forceMajor,
+ bool mayResize);
+void ensureInvariantForMutator (GC_state s, bool force);
+void ensureHasHeapBytesFree (GC_state s,
+ size_t oldGenBytesRequested,
+ size_t nurseryBytesRequested);
void GC_gc (GC_state s, size_t bytesRequested, bool force,
char *file, int line);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.c (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.c 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,68 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+/* GC_startHandler does not do an enter()/leave(), even though it is
+ * exported. The basis library uses it via _import, not _prim, and so
+ * does not treat it as a runtime call -- so the invariant in enter
+ * would fail miserably. It is OK because GC_startHandler must be
+ * called from within a critical section.
+ *
+ * Don't make it inline, because it is also called in basis/Thread.c,
+ * and when compiling with COMPILE_FAST, they may appear out of order.
+ */
+void GC_startHandler (GC_state s) {
+ /* Switch to the signal handler thread. */
+ if (DEBUG_SIGNALS) {
+ fprintf (stderr, "GC_startHandler\n");
+ }
+ assert (s->atomicState == 1);
+ assert (s->signalsInfo.signalIsPending);
+ s->signalsInfo.signalIsPending = FALSE;
+ s->signalsInfo.amInSignalHandler = TRUE;
+ s->savedThread = s->currentThread;
+ /* Set s->atomicState to 2 when switching to the signal handler
+ * thread; leaving the runtime will decrement s->atomicState to 1,
+ * the signal handler will then run atomically and will finish by
+ * switching to the thread to continue with, which will decrement
+ * s->atomicState to 0.
+ */
+ s->atomicState = 2;
+}
+
+void GC_finishHandler (GC_state s) {
+ if (DEBUG_SIGNALS)
+ fprintf (stderr, "GC_finishHandler ()\n");
+ assert (s->atomicState == 1);
+ s->signalsInfo.amInSignalHandler = FALSE;
+}
+
+void switchToHandlerThreadIfNonAtomicAndSignalPending (GC_state s) {
+ if (s->atomicState == 1
+ and s->signalsInfo.signalIsPending) {
+ GC_startHandler (s);
+ switchToThread (s, s->signalHandlerThread);
+ }
+}
+
+/* GC_handler sets s->limit = 0 so that the next limit check will
+ * fail. Signals need to be blocked during the handler (i.e. it
+ * should run atomically) because sigaddset does both a read and a
+ * write of s->signalsInfo.signalsPending. The signals are blocked
+ * by Posix_Signal_handle (see Posix/Signal/Signal.c).
+ */
+void GC_handler (GC_state s, int signum) {
+ if (DEBUG_SIGNALS)
+ fprintf (stderr, "GC_handler signum = %d\n", signum);
+ assert (sigismember (&s->signalsInfo.signalsHandled, signum));
+ if (s->atomicState == 0)
+ s->limit = 0;
+ s->signalsInfo.signalIsPending = TRUE;
+ sigaddset (&s->signalsInfo.signalsPending, signum);
+ if (DEBUG_SIGNALS)
+ fprintf (stderr, "GC_handler done\n");
+}
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/garbage-collection.h 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/handler.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,12 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+void GC_startHandler (GC_state s);
+void GC_finishHandler (GC_state s);
+void switchToHandlerThreadIfNonAtomicAndSignalPending (GC_state s);
+void GC_handler (GC_state s, int signum);
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,200 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+/* ---------------------------------------------------------------- */
+/* Initialization */
+/* ---------------------------------------------------------------- */
+
+
+size_t sizeofInitialBytesLive (GC_state s) {
+ uint32_t i;
+ size_t numBytes;
+ size_t total;
+
+ total = 0;
+ for (i = 0; i < s->intInfInitsLength; ++i) {
+ numBytes =
+ sizeof(uint32_t) // for the sign
+ + strlen (s->intInfInits[i].mlstr);
+ total += align (GC_ARRAY_HEADER_SIZE
+ + numBytes,
+ s->alignment);
+ }
+ for (i = 0; i < s->vectorInitsLength; ++i) {
+ numBytes =
+ s->vectorInits[i].bytesPerElement
+ * s->vectorInits[i].numElements;
+ total += align (GC_ARRAY_HEADER_SIZE
+ + ((0 == numBytes)
+ ? OBJPTR_SIZE
+ : numBytes),
+ s->alignment);
+ }
+ return total;
+}
+
+void initIntInfs (GC_state s) {
+ struct GC_intInfInit *inits;
+ pointer frontier;
+ char *str;
+ size_t slen, llen;
+ mp_size_t alen;
+ uint32_t i, j;
+ bool neg, hex;
+ GC_intInf bp;
+ unsigned char *cp;
+
+ assert (isAlignedFrontier (s, s->frontier));
+ frontier = s->frontier;
+ for (i= 0; i < s->intInfInitsLength; i++) {
+ inits = &s->intInfInits[i];
+ str = inits->mlstr;
+ assert (inits->globalIndex < s->globalsLength);
+ neg = *str == '~';
+ if (neg)
+ str++;
+ slen = strlen (str);
+ hex = str[0] == '0' && str[1] == 'x';
+ if (hex) {
+ str += 2;
+ slen -= 2;
+ llen = (slen + 7) / 8;
+ } else
+ llen = (slen + 8) / 9;
+ assert (slen > 0);
+ bp = (GC_intInf)frontier;
+ cp = (unsigned char *)&bp->limbs[llen];
+
+ for (j = 0; j != slen; j++)
+ if ('0' <= str[j] && str[j] <= '9')
+ cp[j] = str[j] - '0' + 0;
+ else if ('a' <= str[j] && str[j] <= 'f')
+ cp[j] = str[j] - 'a' + 0xa;
+ else {
+ assert('A' <= str[j] && str[j] <= 'F');
+ cp[j] = str[j] - 'A' + 0xA;
+ }
+ alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, hex ? 0x10 : 10);
+ assert ((size_t)alen <= llen);
+ if (alen <= 1) {
+ uint32_t val, ans;
+
+ if (alen == 0)
+ val = 0;
+ else
+ val = bp->limbs[0];
+ if (neg) {
+ /*
+ * We only fit if val in [1, 2^30].
+ */
+ ans = - val;
+ val = val - 1;
+ } else
+ /*
+ * We only fit if val in [0, 2^30 - 1].
+ */
+ ans = val;
+ if (val < (uint32_t)1<<30) {
+ s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
+ continue;
+ }
+ }
+ s->globals[inits->globalIndex] = pointerToObjptr((pointer)(&bp->isneg), s->heap.start);
+ bp->counter = 0;
+ bp->length = alen + 1;
+ bp->header = buildHeaderFromTypeIndex (WORD32_VECTOR_TYPE_INDEX);
+ bp->isneg = neg;
+ frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
+ }
+ assert (isAlignedFrontier (s, frontier));
+ GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
+ s->frontier = frontier;
+ s->cumulativeStatistics.bytesAllocated += frontier - s->frontier;
+}
+
+void initVectors (GC_state s) {
+ struct GC_vectorInit *inits;
+ pointer frontier;
+ uint32_t i;
+
+ assert (isAlignedFrontier (s, s->frontier));
+ inits = s->vectorInits;
+ frontier = s->frontier;
+ for (i = 0; i < s->vectorInitsLength; i++) {
+ size_t bytesPerElement;
+ size_t dataBytes;
+ size_t objectSize;
+ uint32_t typeIndex;
+
+ bytesPerElement = inits[i].bytesPerElement;
+ dataBytes = bytesPerElement * inits[i].numElements;
+ objectSize = align (GC_ARRAY_HEADER_SIZE
+ + ((0 == dataBytes)
+ ? POINTER_SIZE
+ : dataBytes),
+ s->alignment);
+ assert (objectSize <= (size_t)(s->heap.start + s->heap.size - frontier));
+ *((GC_arrayCounter*)(frontier)) = 0;
+ frontier = frontier + GC_ARRAY_COUNTER_SIZE;
+ *((GC_arrayLength*)(frontier)) = inits[i].numElements;
+ frontier = frontier + GC_ARRAY_LENGTH_SIZE;
+ switch (bytesPerElement) {
+ case 1:
+ typeIndex = WORD8_VECTOR_TYPE_INDEX;
+ break;
+ case 2:
+ typeIndex = WORD16_VECTOR_TYPE_INDEX;
+ break;
+ case 4:
+ typeIndex = WORD32_VECTOR_TYPE_INDEX;
+ break;
+ default:
+ die ("unknown bytes per element in vectorInit: %zu",
+ bytesPerElement);
+ }
+ *((GC_header*)(frontier)) = buildHeaderFromTypeIndex (typeIndex);
+ frontier = frontier + GC_HEADER_SIZE;
+ s->globals[inits[i].globalIndex] = pointerToObjptr(frontier, s->heap.start);
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "allocated vector at "FMTPTR"\n",
+ (uintptr_t)(s->globals[inits[i].globalIndex]));
+ GC_memcpy (inits[i].bytes, frontier, dataBytes);
+ frontier += objectSize - GC_ARRAY_HEADER_SIZE;
+ }
+ if (DEBUG_DETAILED)
+ fprintf (stderr, "frontier after string allocation is "FMTPTR"\n",
+ (uintptr_t)frontier);
+ GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
+ s->cumulativeStatistics.bytesAllocated += (size_t)(frontier - s->frontier);
+ assert (isAlignedFrontier (s, frontier));
+ s->frontier = frontier;
+}
+
+void initWorld (GC_state s) {
+ uint32_t i;
+ pointer start;
+ GC_thread thread;
+
+ for (i = 0; i < s->globalsLength; ++i)
+ s->globals[i] = BOGUS_OBJPTR;
+ s->lastMajorStatistics.bytesLive = sizeofInitialBytesLive (s);
+ createHeap (s, &s->heap,
+ sizeofHeapDesired (s, s->lastMajorStatistics.bytesLive, 0),
+ s->lastMajorStatistics.bytesLive);
+ createCardMapAndCrossMap (s);
+ start = alignFrontier (s, s->heap.start);
+ s->frontier = start;
+ initIntInfs (s);
+ initVectors (s);
+ assert ((size_t)(s->frontier - start) <= s->lastMajorStatistics.bytesLive);
+ s->heap.oldGenSize = s->frontier - s->heap.start;
+ setGCStateCurrentHeap (s, 0, 0);
+ thread = newThread (s, sizeofStackInitial (s));
+ switchToThread (s, pointerToObjptr((pointer)thread, s->heap.start));
+}
+
Copied: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h (from rev 4143, mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h)
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init-world.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -0,0 +1,36 @@
+/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ */
+
+/* GC_init uses the array of struct intInfInits in s at program start
+ * to allocate intInfs.
+ * The globalIndex'th entry of the globals array in s is set to the
+ * IntInf.int whose value corresponds to the mlstr string.
+ *
+ * The strings pointed to by the mlstr fields consist of
+ * an optional ~
+ * either one or more of [0-9] or
+ * 0x followed by one or more of [0-9a-fA-F]
+ * a trailing EOS
+ */
+struct GC_intInfInit {
+ uint32_t globalIndex;
+ char *mlstr;
+};
+
+/* GC_init allocates a collection of arrays/vectors in the heap. */
+struct GC_vectorInit {
+ pointer bytes;
+ size_t bytesPerElement;
+ uint32_t globalIndex;
+ GC_arrayLength numElements;
+};
+
+size_t sizeofInitialBytesLive (GC_state s);
+void initIntInfs (GC_state s);
+void initVectors (GC_state s);
+void initWorld (GC_state s);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -10,19 +10,6 @@
/* Initialization */
/* ---------------------------------------------------------------- */
-static void initSignalStack (GC_state s) {
-#if HAS_SIGALTSTACK
- static stack_t altstack;
- size_t ss_size = align (SIGSTKSZ, s->sysvals.pageSize);
- size_t psize = s->sysvals.pageSize;
- void *ss_sp = GC_mmap_safe_protect (NULL, 2 * ss_size, psize, psize);
- altstack.ss_sp = (unsigned char*)ss_sp + ss_size;
- altstack.ss_size = ss_size;
- altstack.ss_flags = 0;
- sigaltstack (&altstack, NULL);
-#endif
-}
-
#if FALSE
static bool stringToBool (char *s) {
if (0 == strcmp (s, "false"))
@@ -77,200 +64,14 @@
die ("Invalid @MLton memory amount: %s.", s);
}
-static void setInitialBytesLive (GC_state s) {
- uint32_t i;
- size_t numBytes;
-
- s->lastMajorStatistics.bytesLive = 0;
- for (i = 0; i < s->intInfInitsLength; ++i) {
- numBytes =
- sizeof(uint32_t) // for the sign
- + strlen (s->intInfInits[i].mlstr);
- s->lastMajorStatistics.bytesLive +=
- align (GC_ARRAY_HEADER_SIZE + numBytes,
- s->alignment);
- }
- for (i = 0; i < s->vectorInitsLength; ++i) {
- numBytes =
- s->vectorInits[i].bytesPerElement
- * s->vectorInits[i].numElements;
- s->lastMajorStatistics.bytesLive +=
- align (GC_ARRAY_HEADER_SIZE
- + ((0 == numBytes)
- ? OBJPTR_SIZE
- : numBytes),
- s->alignment);
- }
-}
-
-static void initIntInfs (GC_state s) {
- struct GC_intInfInit *inits;
- pointer frontier;
- char *str;
- size_t slen, llen;
- mp_size_t alen;
- uint32_t i, j;
- bool neg, hex;
- GC_intInf bp;
- unsigned char *cp;
-
- assert (isAlignedFrontier (s, s->frontier));
- frontier = s->frontier;
- for (i= 0; i < s->intInfInitsLength; i++) {
- inits = &s->intInfInits[i];
- str = inits->mlstr;
- assert (inits->globalIndex < s->globalsLength);
- neg = *str == '~';
- if (neg)
- str++;
- slen = strlen (str);
- hex = str[0] == '0' && str[1] == 'x';
- if (hex) {
- str += 2;
- slen -= 2;
- llen = (slen + 7) / 8;
- } else
- llen = (slen + 8) / 9;
- assert (slen > 0);
- bp = (GC_intInf)frontier;
- cp = (unsigned char *)&bp->limbs[llen];
-
- for (j = 0; j != slen; j++)
- if ('0' <= str[j] && str[j] <= '9')
- cp[j] = str[j] - '0' + 0;
- else if ('a' <= str[j] && str[j] <= 'f')
- cp[j] = str[j] - 'a' + 0xa;
- else {
- assert('A' <= str[j] && str[j] <= 'F');
- cp[j] = str[j] - 'A' + 0xA;
- }
- alen = mpn_set_str ((mp_limb_t*)(bp->limbs), cp, slen, hex ? 0x10 : 10);
- assert ((size_t)alen <= llen);
- if (alen <= 1) {
- uint32_t val, ans;
-
- if (alen == 0)
- val = 0;
- else
- val = bp->limbs[0];
- if (neg) {
- /*
- * We only fit if val in [1, 2^30].
- */
- ans = - val;
- val = val - 1;
- } else
- /*
- * We only fit if val in [0, 2^30 - 1].
- */
- ans = val;
- if (val < (uint32_t)1<<30) {
- s->globals[inits->globalIndex] = (objptr)(ans<<1 | 1);
- continue;
- }
- }
- s->globals[inits->globalIndex] = pointerToObjptr((pointer)(&bp->isneg), s->heap.start);
- bp->counter = 0;
- bp->length = alen + 1;
- bp->header = buildHeaderFromTypeIndex (WORD32_VECTOR_TYPE_INDEX);
- bp->isneg = neg;
- frontier = alignFrontier (s, (pointer)&bp->limbs[alen]);
- }
- assert (isAlignedFrontier (s, frontier));
- GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
- s->frontier = frontier;
- s->cumulativeStatistics.bytesAllocated += frontier - s->frontier;
-}
-
-static void initVectors (GC_state s) {
- struct GC_vectorInit *inits;
- pointer frontier;
- uint32_t i;
-
- assert (isAlignedFrontier (s, s->frontier));
- inits = s->vectorInits;
- frontier = s->frontier;
- for (i = 0; i < s->vectorInitsLength; i++) {
- size_t bytesPerElement;
- size_t dataBytes;
- size_t objectSize;
- uint32_t typeIndex;
-
- bytesPerElement = inits[i].bytesPerElement;
- dataBytes = bytesPerElement * inits[i].numElements;
- objectSize = align (GC_ARRAY_HEADER_SIZE
- + ((0 == dataBytes)
- ? POINTER_SIZE
- : dataBytes),
- s->alignment);
- assert (objectSize <= (size_t)(s->heap.start + s->heap.size - frontier));
- *((GC_arrayCounter*)(frontier)) = 0;
- frontier = frontier + GC_ARRAY_COUNTER_SIZE;
- *((GC_arrayLength*)(frontier)) = inits[i].numElements;
- frontier = frontier + GC_ARRAY_LENGTH_SIZE;
- switch (bytesPerElement) {
- case 1:
- typeIndex = WORD8_VECTOR_TYPE_INDEX;
- break;
- case 2:
- typeIndex = WORD16_VECTOR_TYPE_INDEX;
- break;
- case 4:
- typeIndex = WORD32_VECTOR_TYPE_INDEX;
- break;
- default:
- die ("unknown bytes per element in vectorInit: %zu",
- bytesPerElement);
- }
- *((GC_header*)(frontier)) = buildHeaderFromTypeIndex (typeIndex);
- frontier = frontier + GC_HEADER_SIZE;
- s->globals[inits[i].globalIndex] = pointerToObjptr(frontier, s->heap.start);
- if (DEBUG_DETAILED)
- fprintf (stderr, "allocated vector at "FMTPTR"\n",
- (uintptr_t)(s->globals[inits[i].globalIndex]));
- GC_memcpy (inits[i].bytes, frontier, dataBytes);
- frontier += objectSize - GC_ARRAY_HEADER_SIZE;
- }
- if (DEBUG_DETAILED)
- fprintf (stderr, "frontier after string allocation is "FMTPTR"\n",
- (uintptr_t)frontier);
- GC_profileAllocInc (s, (size_t)(frontier - s->frontier));
- s->cumulativeStatistics.bytesAllocated += (size_t)(frontier - s->frontier);
- assert (isAlignedFrontier (s, frontier));
- s->frontier = frontier;
-}
-
-static void newWorld (GC_state s) {
- uint32_t i;
- pointer start;
- GC_thread thread;
-
- for (i = 0; i < s->globalsLength; ++i)
- s->globals[i] = BOGUS_OBJPTR;
- setInitialBytesLive (s);
- createHeap (s, &s->heap,
- sizeofHeapDesired (s, s->lastMajorStatistics.bytesLive, 0),
- s->lastMajorStatistics.bytesLive);
- createCardMapAndCrossMap (s);
- start = alignFrontier (s, s->heap.start);
- s->frontier = start;
- initIntInfs (s);
- initVectors (s);
- assert ((size_t)(s->frontier - start) <= s->lastMajorStatistics.bytesLive);
- s->heap.oldGenSize = s->frontier - s->heap.start;
- setGCStateCurrentHeap (s, 0, 0);
- thread = newThread (s, sizeofStackInitial (s));
- switchToThread (s, pointerToObjptr((pointer)thread, s->heap.start));
-}
-
/* ---------------------------------------------------------------- */
/* GC_init */
/* ---------------------------------------------------------------- */
bool MLton_Platform_CygwinUseMmap;
-static int processAtMLton (GC_state s, int argc, char **argv,
- char **worldFile) {
+int processAtMLton (GC_state s, int argc, char **argv,
+ char **worldFile) {
int i;
i = 1;
@@ -479,7 +280,7 @@
s->signalsInfo.signalIsPending = FALSE;
sigemptyset (&s->signalsInfo.signalsHandled);
sigemptyset (&s->signalsInfo.signalsPending);
- s->startTime = currentTime ();
+ s->startTime = getCurrentTime ();
// s->sysvals.availRam = ;
// s->sysvals.totalRam = ;
// s->sysvals.pageSize = ;
@@ -497,7 +298,6 @@
unless (s->controls.ratios.markCompact <= s->controls.ratios.copy
and s->controls.ratios.copy <= s->controls.ratios.live)
die ("Ratios must satisfy mark-compact-ratio <= copy-ratio <= live-ratio");
- // s->totalRam = totalRam (s);
/* We align s->ram by pageSize so that we can test whether or not we
* we are using mark-compact by comparing heap size to ram size. If
* we didn't round, the size might be slightly off.
@@ -524,36 +324,18 @@
* command-line arguments, because those may just be doing a show
* prof, in which case we don't want to initialize the atExit.
*/
- if (PROFILE_NONE == s->profiling.kind)
- s->profiling.isOn = FALSE;
- else {
- s->profiling.isOn = TRUE;
- assert (s->profiling.frameSourcesLength == s->frameLayoutsLength);
- switch (s->profiling.kind) {
- case PROFILE_ALLOC:
- case PROFILE_COUNT:
- s->profiling.data = GC_profileNew (s);
- break;
- case PROFILE_NONE:
- die ("impossible PROFILE_NONE");
- case PROFILE_TIME:
- profileTimeInit (s);
- break;
- }
- profileEndState = s;
- atexit (profileEnd);
- }
+ initProfiling (s);
if (s->amOriginal) {
- newWorld (s);
+ initWorld (s);
/* The mutator stack invariant doesn't hold,
* because the mutator has yet to run.
*/
- assert (mutatorInvariant (s, TRUE, FALSE));
+ assert (invariantForMutator (s, TRUE, FALSE));
} else {
loadWorldFromFileName (s, worldFile);
if (s->profiling.isOn and s->profiling.stack)
foreachStackFrame (s, enterFrame);
- assert (mutatorInvariant (s, TRUE, TRUE));
+ assert (invariantForMutator (s, TRUE, TRUE));
}
s->amInGC = FALSE;
return res;
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/init.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,27 +6,6 @@
* See the file MLton-LICENSE for details.
*/
-
-/* GC_init uses the array of struct intInfInits in s at program start
- * to allocate intInfs.
- * The globalIndex'th entry of the globals array in s is set to the
- * IntInf.int whose value corresponds to the mlstr string.
- *
- * The strings pointed to by the mlstr fields consist of
- * an optional ~
- * either one or more of [0-9] or
- * 0x followed by one or more of [0-9a-fA-F]
- * a trailing EOS
- */
-struct GC_intInfInit {
- uint32_t globalIndex;
- char *mlstr;
-};
-
-/* GC_init allocates a collection of arrays/vectors in the heap. */
-struct GC_vectorInit {
- pointer bytes;
- size_t bytesPerElement;
- uint32_t globalIndex;
- GC_arrayLength numElements;
-};
+int processAtMLton (GC_state s, int argc,
+ char **argv, char **worldFile);
+int GC_init (GC_state s, int argc, char **argv);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -14,9 +14,9 @@
(uintptr_t)opp, *opp);
}
-bool invariant (GC_state s) {
+bool invariantForGC (GC_state s) {
if (DEBUG)
- fprintf (stderr, "invariant\n");
+ fprintf (stderr, "invariantForGC\n");
/* Frame layouts */
for (unsigned int i = 0; i < s->frameLayoutsLength; ++i) {
GC_frameLayout layout;
@@ -54,16 +54,16 @@
assert (s->secondaryHeap.start == NULL
or s->heap.size == s->secondaryHeap.size);
/* Check that all pointers are into from space. */
- foreachGlobalObjptr (s, assertObjptrIsInFromSpace);
+ foreachGlobalObjptr (s, assertIsObjptrInFromSpace);
pointer back = s->heap.start + s->heap.oldGenSize;
if (DEBUG_DETAILED)
fprintf (stderr, "Checking old generation.\n");
foreachObjptrInRange (s, alignFrontier (s, s->heap.start), &back,
- assertObjptrIsInFromSpace, FALSE);
+ assertIsObjptrInFromSpace, FALSE);
if (DEBUG_DETAILED)
fprintf (stderr, "Checking nursery.\n");
foreachObjptrInRange (s, s->heap.nursery, &s->frontier,
- assertObjptrIsInFromSpace, FALSE);
+ assertIsObjptrInFromSpace, FALSE);
/* Current thread. */
GC_stack stack = getStackCurrent(s);
assert (isAlignedStackReserved (s, stack->reserved));
@@ -74,29 +74,29 @@
assert (stack->used == sizeofGCStateCurrentStackUsed (s));
assert (stack->used <= stack->reserved);
if (DEBUG)
- fprintf (stderr, "invariant passed\n");
+ fprintf (stderr, "invariantForGC passed\n");
return TRUE;
}
-bool mutatorFrontierInvariant (GC_state s) {
+bool invariantForMutatorFrontier (GC_state s) {
GC_thread thread = getThreadCurrent(s);
return (thread->bytesNeeded
<= (size_t)(s->limitPlusSlop - s->frontier));
}
-bool mutatorStackInvariant (GC_state s) {
+bool invariantForMutatorStack (GC_state s) {
GC_stack stack = getStackCurrent(s);
return (getStackTop (s, stack)
<= getStackLimit (s, stack) + getStackTopFrameSize (s, stack));
}
-bool mutatorInvariant (GC_state s, bool frontier, bool stack) {
+bool invariantForMutator (GC_state s, bool frontier, bool stack) {
if (DEBUG)
displayGCState (s, stderr);
if (frontier)
- assert (mutatorFrontierInvariant(s));
+ assert (invariantForMutatorFrontier(s));
if (stack)
- assert (mutatorStackInvariant(s));
- assert (invariant (s));
+ assert (invariantForMutatorStack(s));
+ assert (invariantForGC (s));
return TRUE;
}
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/invariant.h 2005-11-04 03:52:55 UTC (rev 4145)
@@ -6,8 +6,8 @@
* See the file MLton-LICENSE for details.
*/
-void assertObjptrIsInFromSpace (GC_state s, objptr *opp);
-bool invariant (GC_state s);
-bool mutatorFrontierInvariant (GC_state s);
-bool mutatorStackInvariant (GC_state s);
-bool mutatorInvariant (GC_state s, bool frontier, bool stack);
+void assertIsObjptrInFromSpace (GC_state s, objptr *opp);
+bool invariantForGC (GC_state s);
+bool invariantForMutatorFrontier (GC_state s);
+bool invariantForMutatorStack (GC_state s);
+bool invariantForMutator (GC_state s, bool frontier, bool stack);
Modified: mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-11-04 01:38:08 UTC (rev 4144)
+++ mlton/branches/on-20050822-x86_64-branch/runtime/gc/mark-compact.c 2005-11-04 03:52:55 UTC (rev 4145)
@@ -12,8 +12,11 @@
/* An object pointer might be larger than a header.
*/
-void threadInternalCopy (pointer dst, pointer src) {
- size_t count = (OBJPTR_SIZE - GC_HEADER_SIZE) / GC_HEADER_SIZE;
+void copyForThreadInternal (pointer dst, pointer src) {
+ size_t count;
+
+ assert (0 == (OBJPTR_SIZE % GC_HEADER_SIZE));
+ count = (OBJPTR_SIZE - GC_HEADER_SIZE) / GC_HEADER_SIZE;
src = src + GC_HEADER_SIZE * count;
for (size_t i = 0; i <= count; i++) {
@@ -35,14 +38,14 @@
"threadInternal opp = "FMTPTR" p = "FMTPTR" header = "FMTHDR"\n",
(uintptr_t)opp, (uintptr_t)p, getHeader (p));
headerp = getHeaderp (p);
- threadInternalCopy ((pointer)(opp), (pointer)(headerp));
- threadInternalCopy ((pointer)(headerp), (pointer)(&opop));
+ copyForThreadInternal ((pointer)(opp), (pointer)(headerp));
+ copyForThreadInternal ((pointer)(headerp), (pointer)(&opop));
}
-/* If p is weak, the object pointer was valid, and points to an unmarked object,
- * then clear the o...
[truncated message content] |
|
From: Stephen W. <sw...@ml...> - 2005-11-03 17:38:09
|
Added library for Solaris.
----------------------------------------------------------------------
U mlton/trunk/bin/regression
----------------------------------------------------------------------
Modified: mlton/trunk/bin/regression
===================================================================
--- mlton/trunk/bin/regression 2005-11-04 00:12:48 UTC (rev 4143)
+++ mlton/trunk/bin/regression 2005-11-04 01:38:08 UTC (rev 4144)
@@ -150,7 +150,7 @@
libs='-lws2_32 -lkernel32 -lpsapi -lnetapi32'
;;
*solaris)
- libs='-lnsl -lsocket'
+ libs='-lnsl -lsocket -lrt'
;;
*)
libs=''
|
|
From: Matthew F. <fl...@ml...> - 2005-11-03 16:12:57
|
Renamed gcState.rusageIsEnabled to gcSate.rusageMeasureGC.
Removed MLton.GC.setRusage.
Added MLton.Rusage.measureGC.
Implicitly enable gcState.rusageMeasureGC if MLton.Rusage.rusage is
used in the user program.
----------------------------------------------------------------------
U mlton/trunk/basis-library/misc/primitive.sml
U mlton/trunk/basis-library/mlton/gc.sig
U mlton/trunk/basis-library/mlton/rusage.sig
U mlton/trunk/basis-library/mlton/rusage.sml
U mlton/trunk/basis-library/system/timer.sml
U mlton/trunk/doc/changelog
U mlton/trunk/lib/mlton-stubs/gc.sig
U mlton/trunk/lib/mlton-stubs/mlton.sml
U mlton/trunk/lib/mlton-stubs/rusage.sig
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/runtime/basis/GC.c
U mlton/trunk/runtime/gc.c
U mlton/trunk/runtime/gc.h
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/misc/primitive.sml
===================================================================
--- mlton/trunk/basis-library/misc/primitive.sml 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/misc/primitive.sml 2005-11-04 00:12:48 UTC (rev 4143)
@@ -400,7 +400,7 @@
val setHashConsDuringGC =
_import "GC_setHashConsDuringGC": bool -> unit;
val setMessages = _import "GC_setMessages": bool -> unit;
- val setRusage = _import "GC_setRusage": bool -> unit;
+ val setRusageMeasureGC = _import "GC_setRusageMeasureGC": bool -> unit;
val setSummary = _import "GC_setSummary": bool -> unit;
val unpack = _import "MLton_GC_unpack": unit -> unit;
end
Modified: mlton/trunk/basis-library/mlton/gc.sig
===================================================================
--- mlton/trunk/basis-library/mlton/gc.sig 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/mlton/gc.sig 2005-11-04 00:12:48 UTC (rev 4143)
@@ -11,7 +11,6 @@
val collect: unit -> unit
val pack: unit -> unit
val setMessages: bool -> unit
- val setRusage: bool -> unit
val setSummary: bool -> unit
val unpack: unit -> unit
end
Modified: mlton/trunk/basis-library/mlton/rusage.sig
===================================================================
--- mlton/trunk/basis-library/mlton/rusage.sig 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/mlton/rusage.sig 2005-11-04 00:12:48 UTC (rev 4143)
@@ -11,7 +11,8 @@
type t = {utime: Time.time, (* user time *)
stime: Time.time (* system time *)
}
-
+
+ val measureGC: bool -> unit
val rusage: unit -> {children: t,
gc: t,
self: t}
Modified: mlton/trunk/basis-library/mlton/rusage.sml
===================================================================
--- mlton/trunk/basis-library/mlton/rusage.sml 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/mlton/rusage.sml 2005-11-04 00:12:48 UTC (rev 4143)
@@ -28,16 +28,23 @@
utime = toTime (utimeSec, utimeUsec)}
end
- fun rusage () =
- let
- val () = Prim.ru ()
- open Prim
+ val measureGC = Primitive.GC.setRusageMeasureGC
+
+ val rusage =
+ let
+ val () = measureGC true
in
- {children = collect (children_utime_sec, children_utime_usec,
- children_stime_sec, children_stime_usec),
- gc = collect (gc_utime_sec, gc_utime_usec,
- gc_stime_sec, gc_stime_usec),
- self = collect (self_utime_sec, self_utime_usec,
- self_stime_sec, self_stime_usec)}
+ fn () =>
+ let
+ val () = Prim.ru ()
+ open Prim
+ in
+ {children = collect (children_utime_sec, children_utime_usec,
+ children_stime_sec, children_stime_usec),
+ gc = collect (gc_utime_sec, gc_utime_usec,
+ gc_stime_sec, gc_stime_usec),
+ self = collect (self_utime_sec, self_utime_usec,
+ self_stime_sec, self_stime_usec)}
+ end
end
end
Modified: mlton/trunk/basis-library/system/timer.sml
===================================================================
--- mlton/trunk/basis-library/system/timer.sml 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/basis-library/system/timer.sml 2005-11-04 00:12:48 UTC (rev 4143)
@@ -21,19 +21,14 @@
type cpu_timer = {gc: SysUsr.t, self: SysUsr.t}
- val startCPUTimer : unit -> cpu_timer =
- let
- val () = MLtonGC.setRusage true
+ fun startCPUTimer (): cpu_timer =
+ let
+ val {gc = {utime = gcu, stime = gcs, ...},
+ self = {utime = selfu, stime = selfs}, ...} =
+ MLtonRusage.rusage ()
in
- fn () =>
- let
- val {gc = {utime = gcu, stime = gcs, ...},
- self = {utime = selfu, stime = selfs}, ...} =
- MLtonRusage.rusage ()
- in
- {gc = SysUsr.T {sys = gcs, usr = gcu},
- self = SysUsr.T {sys = selfs, usr = selfu}}
- end
+ {gc = SysUsr.T {sys = gcs, usr = gcu},
+ self = SysUsr.T {sys = selfs, usr = selfu}}
end
fun checkCPUTimes {gc, self} =
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/doc/changelog 2005-11-04 00:12:48 UTC (rev 4143)
@@ -1,5 +1,9 @@
Here are the changes since version 20041109.
+* 2005-11-03
+ - Removed MLton.GC.setRusage.
+ - Added MLton.Rusage.measureGC.
+
* 2005-09-11
- Fixed bug in display of types with large numbers of type
variables, which could cause unhandled exception Chr.
Modified: mlton/trunk/lib/mlton-stubs/gc.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/gc.sig 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/lib/mlton-stubs/gc.sig 2005-11-04 00:12:48 UTC (rev 4143)
@@ -11,7 +11,6 @@
val collect: unit -> unit
val pack: unit -> unit
val setMessages: bool -> unit
- val setRusage: bool -> unit
val setSummary: bool -> unit
val unpack: unit -> unit
end
Modified: mlton/trunk/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs/mlton.sml 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/lib/mlton-stubs/mlton.sml 2005-11-04 00:12:48 UTC (rev 4143)
@@ -132,7 +132,6 @@
fun collect _ = ()
val pack = MLton.GC.pack
fun setMessages _ = ()
- fun setRusage _ = ()
fun setSummary _ = ()
fun time _ = Time.zeroTime
fun unpack _ = ()
@@ -409,6 +408,8 @@
struct
type t = {stime: Time.time, utime: Time.time}
+ fun measureGC _ = ()
+
(* Fake it with Posix.ProcEnv.times *)
fun rusage () =
let
Modified: mlton/trunk/lib/mlton-stubs/rusage.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/rusage.sig 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/lib/mlton-stubs/rusage.sig 2005-11-04 00:12:48 UTC (rev 4143)
@@ -12,6 +12,7 @@
stime: Time.time (* system time *)
}
+ val measureGC: bool -> unit
val rusage: unit -> {children: t,
gc: t,
self: t}
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/mlton/main/main.fun 2005-11-04 00:12:48 UTC (rev 4143)
@@ -517,7 +517,7 @@
| _ => Error.bug "incorrect args from shell script"
val _ = setTargetType ("self", usage)
val result = parse args
- val () = MLton.GC.setRusage (!verbosity <> Silent)
+ val () = MLton.Rusage.measureGC (!verbosity <> Silent)
val () =
if !showAnns then
(Layout.outputl (Control.Elaborate.document {expert = !expert},
Modified: mlton/trunk/runtime/basis/GC.c
===================================================================
--- mlton/trunk/runtime/basis/GC.c 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/runtime/basis/GC.c 2005-11-04 00:12:48 UTC (rev 4143)
@@ -16,8 +16,8 @@
gcState.summary = b;
}
-void GC_setRusage (Int b) {
- gcState.rusageIsEnabled = b;
+void GC_setRusageMeasureGC (Int b) {
+ gcState.rusageMeasureGC = b;
}
void MLton_GC_pack () {
Modified: mlton/trunk/runtime/gc.c
===================================================================
--- mlton/trunk/runtime/gc.c 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/runtime/gc.c 2005-11-04 00:12:48 UTC (rev 4143)
@@ -3023,7 +3023,7 @@
}
static inline bool needGCTime (GC_state s) {
- return DEBUG or s->summary or s->messages or s->rusageIsEnabled;
+ return DEBUG or s->summary or s->messages or s->rusageMeasureGC;
}
static void doGC (GC_state s,
@@ -4476,7 +4476,7 @@
s->oldGenArraySize = 0x100000;
s->pageSize = getpagesize ();
s->ramSlop = 0.5;
- s->rusageIsEnabled = FALSE;
+ s->rusageMeasureGC = FALSE;
s->savedThread = BOGUS_THREAD;
s->signalHandler = BOGUS_THREAD;
s->signalIsPending = FALSE;
Modified: mlton/trunk/runtime/gc.h
===================================================================
--- mlton/trunk/runtime/gc.h 2005-11-03 23:53:05 UTC (rev 4142)
+++ mlton/trunk/runtime/gc.h 2005-11-04 00:12:48 UTC (rev 4143)
@@ -455,7 +455,7 @@
W32 ram; /* ramSlop * totalRam */
W32 (*returnAddressToFrameIndex) (W32 w);
float ramSlop;
- bool rusageIsEnabled;
+ bool rusageMeasureGC;
struct rusage ru_gc; /* total resource usage spent in gc */
struct rusage ru_gcCopy; /* resource usage in major copying gcs. */
struct rusage ru_gcMarkCompact; /* resource usage in mark-compact gcs. */
|
|
From: Stephen W. <sw...@ml...> - 2005-11-03 15:53:07
|
Eliminated -fcall-used-g[57], which cause segfaults on Solaris 10.
----------------------------------------------------------------------
U mlton/trunk/bin/mlton-script
U mlton/trunk/runtime/Makefile
----------------------------------------------------------------------
Modified: mlton/trunk/bin/mlton-script
===================================================================
--- mlton/trunk/bin/mlton-script 2005-11-03 18:29:18 UTC (rev 4141)
+++ mlton/trunk/bin/mlton-script 2005-11-03 23:53:05 UTC (rev 4142)
@@ -77,8 +77,6 @@
-target-cc-opt darwin '-I/sw/include' \
-target-cc-opt solaris \
'-Wa,-xarch=v8plusa
- -fcall-used-g5
- -fcall-used-g7
-mcpu=ultrasparc' \
-target-cc-opt sparc '-mcpu=v8 -m32' \
-target-cc-opt x86 \
Modified: mlton/trunk/runtime/Makefile
===================================================================
--- mlton/trunk/runtime/Makefile 2005-11-03 18:29:18 UTC (rev 4141)
+++ mlton/trunk/runtime/Makefile 2005-11-03 23:53:05 UTC (rev 4142)
@@ -32,7 +32,7 @@
endif
ifeq ($(TARGET_OS), solaris)
-FLAGS += -Wa,-xarch=v8plusa -fcall-used-g5 -fcall-used-g7 -funroll-all-loops -mcpu=ultrasparc
+FLAGS += -Wa,-xarch=v8plusa -funroll-all-loops -mcpu=ultrasparc
endif
ifeq ($(TARGET), self)
|
|
From: Stephen W. <sw...@ml...> - 2005-11-03 10:29:24
|
Used #ifndef to protect some #defines. This is necessary on some platforms, like Solaris 10, that define fpclassify and associated constants, but where we say that HAS_FPCLASSIFY = FALSE (because Solaris 8 doesn't have fpclassify). We really should use autoconf. ---------------------------------------------------------------------- U mlton/trunk/runtime/platform.h ---------------------------------------------------------------------- Modified: mlton/trunk/runtime/platform.h =================================================================== --- mlton/trunk/runtime/platform.h 2005-11-03 18:21:46 UTC (rev 4140) +++ mlton/trunk/runtime/platform.h 2005-11-03 18:29:18 UTC (rev 4141) @@ -166,18 +166,33 @@ #define EXECVE execve #endif -#if not HAS_FEROUND +#ifndef FE_TONEAREST #define FE_TONEAREST 0 +#endif +#ifndef FE_DOWNWARD #define FE_DOWNWARD 1 +#endif +#ifndef FE_UPWARD #define FE_UPWARD 2 +#endif +#ifndef FE_TOWARDZERO #define FE_TOWARDZERO 3 #endif -#if not HAS_FPCLASSIFY + +#ifndef FP_INFINITE #define FP_INFINITE 1 +#endif +#ifndef FP_NAN #define FP_NAN 0 +#endif +#ifndef FP_NORMAL #define FP_NORMAL 4 +#endif +#ifndef FP_SUBNORMAL #define FP_SUBNORMAL 3 +#endif +#ifndef FP_ZERO #define FP_ZERO 2 #endif |
