Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-17 10:27:41 +00:00
Code Issues Projects Releases Packages Wiki Activity

Catch-up merge from master sources @186077 to branch/2014-03-30/addrset.

Browse source 
Copied from Perforce
 Change: 186081
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Gareth Rees 2014-05-13 16:21:39 +01:00
commit 34cc9d49e4
235 changed files with 2099 additions and 1258 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
mps/Makefile.in
View file

@ -1,7 +1,7 @@
# Makefile.in -- source for autoconf Makefile
#
# $Id$
# Copyright (C) 2012-2013 Ravenbrook Limited. See end of file for license.
# Copyright (C) 2012-2014 Ravenbrook Limited. See end of file for license.
#
# YOU DON'T NEED AUTOCONF TO BUILD THE MPS
# This is just here for people who want or expect a configure script.
@ -13,11 +13,14 @@ INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
MAKE=@MAKE@
MPS_TARGET_NAME=@MPS_TARGET_NAME@
MPS_OS_NAME=@MPS_OS_NAME@
MPS_ARCH_NAME=@MPS_ARCH_NAME@
MPS_BUILD_NAME=@MPS_BUILD_NAME@
MPS_TARGET_NAME=$(MPS_OS_NAME)$(MPS_ARCH_NAME)$(MPS_BUILD_NAME)
EXTRA_TARGETS=@EXTRA_TARGETS@
prefix=$(DESTDIR)@prefix@
TARGET_OPTS=-C code -f $(MPS_TARGET_NAME).gmk EXTRA_TARGETS="$(EXTRA_TARGETS)"
XCODEBUILD=xcodebuild -project code/mps.xcodeproj
XCODEBUILD=xcrun xcodebuild -project code/mps.xcodeproj
all: @BUILD_TARGET@
@ -31,7 +34,7 @@ install-make-build: make-install-dirs build-via-make
$(INSTALL_DATA) code/mps*.h $(prefix)/include/
$(INSTALL_DATA) code/$(MPS_TARGET_NAME)/cool/mps.a $(prefix)/lib/libmps-debug.a
$(INSTALL_DATA) code/$(MPS_TARGET_NAME)/hot/mps.a $(prefix)/lib/libmps.a
$(INSTALL_PROGRAM) $(addprefix code/$(MPS_TARGET_NAME)/hot/Release/,$(EXTRA_TARGETS)) $(prefix)/bin
$(INSTALL_PROGRAM) $(addprefix code/$(MPS_TARGET_NAME)/hot/,$(EXTRA_TARGETS)) $(prefix)/bin
build-via-xcode:
$(XCODEBUILD) -config Debug
@ -67,12 +70,13 @@ make-install-dirs:
install: @INSTALL_TARGET@
test-make-build: @BUILD_TARGET@
$(MAKE) $(TARGET_OPTS) VARIETY=cool testrun
$(MAKE) $(TARGET_OPTS) VARIETY=hot testrun
test-make-build:
$(MAKE) $(TARGET_OPTS) testci
$(MAKE) -C code -f anan$(MPS_BUILD_NAME).gmk VARIETY=cool clean testansi
$(MAKE) -C code -f anan$(MPS_BUILD_NAME).gmk VARIETY=cool CFLAGS="-DCONFIG_POLL_NONE" clean testpoll
test-xcode-build:
$(XCODEBUILD) -config Debug -target testrun
$(XCODEBUILD) -config Release -target testrun
$(XCODEBUILD) -config Debug -target testci
$(XCODEBUILD) -config Release -target testci
test: @TEST_TARGET@

7
mps/code/airtest.c
View file

@ -50,14 +50,14 @@ static void test_air(int interior, int stack)
}
mps_message_type_enable(scheme_arena, mps_message_type_finalization());
for (j = 0; j < OBJ_COUNT; ++j) {
obj_t n = scheme_make_integer((long)j);
obj_t obj = scheme_make_vector(OBJ_LEN, n);
obj_t n = scheme_make_integer(obj_ap, (long)j);
obj_t obj = scheme_make_vector(obj_ap, OBJ_LEN, n);
mps_addr_t ref = obj;
mps_finalize(scheme_arena, &ref);
s[j] = obj->vector.vector;
}
for (i = 1; i < OBJ_LEN; ++i) {
obj_t n = scheme_make_integer((long)i);
obj_t n = scheme_make_integer(obj_ap, (long)i);
mps_message_t msg;
for (j = 0; j + 1 < OBJ_COUNT; ++j) {
*++s[j] = n;
@ -112,7 +112,6 @@ static void test_main(void *marker, int interior, int stack)
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, obj_chain);
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, obj_fmt);
MPS_ARGS_ADD(args, MPS_KEY_INTERIOR, interior);
MPS_ARGS_DONE(args);
die(mps_pool_create_k(&obj_pool, scheme_arena, mps_class_amc(), args),
"mps_pool_create_k");
} MPS_ARGS_END(args);

2
mps/code/amcss.c
View file

@ -275,6 +275,7 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
}
(void)mps_commit(busy_ap, busy_init, 64);
mps_arena_park(arena);
mps_ap_destroy(busy_ap);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
@ -282,6 +283,7 @@ static void test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
mps_pool_destroy(pool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_arena_release(arena);
}
int main(int argc, char *argv[])

2
mps/code/amcsshe.c
View file

@ -225,6 +225,7 @@ static void *test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
}
(void)mps_commit(busy_ap, busy_init, 64);
mps_arena_park(arena);
mps_ap_destroy(busy_ap);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
@ -233,6 +234,7 @@ static void *test(mps_arena_t arena, mps_class_t pool_class, size_t roots_count)
mps_pool_destroy(pool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_arena_release(arena);
return NULL;
}

39
mps/code/amcssth.c
View file

@ -149,17 +149,6 @@ static void init(void)
}
/* finish -- finish roots and chain */
static void finish(void)
{
mps_root_destroy(exactRoot);
mps_root_destroy(ambigRoot);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
}
/* churn -- create an object and install into roots */
static void churn(mps_ap_t ap, size_t roots_count)
@ -218,7 +207,7 @@ static void *kid_thread(void *arg)
/* test -- the body of the test */
static void *test_pool(mps_class_t pool_class, size_t roots_count, int mode)
static void test_pool(mps_pool_t pool, size_t roots_count, int mode)
{
size_t i;
mps_word_t collections, rampSwitch;
@ -226,14 +215,10 @@ static void *test_pool(mps_class_t pool_class, size_t roots_count, int mode)
int ramping;
mps_ap_t ap, busy_ap;
mps_addr_t busy_init;
mps_pool_t pool;
testthr_t kids[10];
closure_s cl;
int walked = FALSE, ramped = FALSE;
die(mps_pool_create(&pool, arena, pool_class, format, chain),
"pool_create(amc)");
cl.pool = pool;
cl.roots_count = roots_count;
@ -323,16 +308,13 @@ static void *test_pool(mps_class_t pool_class, size_t roots_count, int mode)
for (i = 0; i < sizeof(kids)/sizeof(kids[0]); ++i)
testthr_join(&kids[i], NULL);
mps_pool_destroy(pool);
return NULL;
}
static void test_arena(int mode)
{
mps_thr_t thread;
mps_root_t reg_root;
mps_pool_t amc_pool, amcz_pool;
void *marker = &marker;
die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
@ -345,12 +327,23 @@ static void test_arena(int mode)
die(mps_root_create_reg(&reg_root, arena, mps_rank_ambig(), 0, thread,
mps_stack_scan_ambig, marker, 0), "root_create");
test_pool(mps_class_amc(), exactRootsCOUNT, mode);
test_pool(mps_class_amcz(), 0, mode);
die(mps_pool_create(&amc_pool, arena, mps_class_amc(), format, chain),
"pool_create(amc)");
die(mps_pool_create(&amcz_pool, arena, mps_class_amcz(), format, chain),
"pool_create(amcz)");
test_pool(amc_pool, exactRootsCOUNT, mode);
test_pool(amcz_pool, 0, mode);
mps_arena_park(arena);
mps_pool_destroy(amc_pool);
mps_pool_destroy(amcz_pool);
mps_root_destroy(reg_root);
mps_thread_dereg(thread);
finish();
mps_root_destroy(exactRoot);
mps_root_destroy(ambigRoot);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
report(arena);
mps_arena_destroy(arena);
}

90
mps/code/amsss.c
View file

@ -27,7 +27,7 @@
#define totalSizeSTEP 200 * (size_t)1024
/* objNULL needs to be odd so that it's ignored in exactRoots. */
#define objNULL ((mps_addr_t)MPS_WORD_CONST(0xDECEA5ED))
#define testArenaSIZE ((size_t)16<<20)
#define testArenaSIZE ((size_t)1<<20)
#define initTestFREQ 3000
#define splatTestFREQ 6000
static mps_gen_param_s testChain[1] = { { 160, 0.90 } };
@ -107,7 +107,8 @@ static mps_addr_t make(void)
static mps_pool_debug_option_s freecheckOptions =
{ NULL, 0, (const void *)"Dead", 4 };
static void *test(void *arg, size_t haveAmbigous)
static void test_pool(mps_class_t pool_class, mps_arg_s args[],
mps_bool_t haveAmbiguous)
{
mps_pool_t pool;
mps_root_t exactRoot, ambigRoot = NULL;
@ -116,14 +117,13 @@ static void *test(void *arg, size_t haveAmbigous)
mps_ap_t busy_ap;
mps_addr_t busy_init;
pool = (mps_pool_t)arg;
die(mps_pool_create_k(&pool, arena, pool_class, args), "pool_create");
die(mps_ap_create(&ap, pool, mps_rank_exact()), "BufferCreate");
die(mps_ap_create(&busy_ap, pool, mps_rank_exact()), "BufferCreate 2");
for(i = 0; i < exactRootsCOUNT; ++i)
exactRoots[i] = objNULL;
if (haveAmbigous)
if (haveAmbiguous)
for(i = 0; i < ambigRootsCOUNT; ++i)
ambigRoots[i] = rnd_addr();
@ -132,7 +132,7 @@ static void *test(void *arg, size_t haveAmbigous)
&exactRoots[0], exactRootsCOUNT,
(mps_word_t)1),
"root_create_table(exact)");
if (haveAmbigous)
if (haveAmbiguous)
die(mps_root_create_table(&ambigRoot, arena,
mps_rank_ambig(), (mps_rm_t)0,
&ambigRoots[0], ambigRootsCOUNT),
@ -154,7 +154,7 @@ static void *test(void *arg, size_t haveAmbigous)
}
r = (size_t)rnd();
if (!haveAmbigous || (r & 1)) {
if (!haveAmbiguous || (r & 1)) {
i = (r >> 1) % exactRootsCOUNT;
if (exactRoots[i] != objNULL)
cdie(dylan_check(exactRoots[i]), "dying root check");
@ -187,81 +187,51 @@ static void *test(void *arg, size_t haveAmbigous)
mps_ap_destroy(busy_ap);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
if (haveAmbigous)
if (haveAmbiguous)
mps_root_destroy(ambigRoot);
return NULL;
mps_pool_destroy(pool);
}
int main(int argc, char *argv[])
{
int i;
mps_thr_t thread;
mps_fmt_t format;
mps_chain_t chain;
mps_pool_t pool;
void *r;
testlib_init(argc, argv);
die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
"arena_create");
die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "commit_limit_set");
mps_message_type_enable(arena, mps_message_type_gc_start());
mps_message_type_enable(arena, mps_message_type_gc());
die(mps_thread_reg(&thread, arena), "thread_reg");
die(mps_fmt_create_A(&format, arena, dylan_fmt_A()), "fmt_create");
die(mps_chain_create(&chain, arena, 1, testChain), "chain_create");
/* TODO: Add tests using the arena default chain. */
printf("\n\n****************************** Testing AMS Debug\n");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
MPS_ARGS_ADD(args, MPS_KEY_AMS_SUPPORT_AMBIGUOUS, FALSE);
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, &freecheckOptions);
die(mps_pool_create_k(&pool, arena, mps_class_ams_debug(), args),
"pool_create(ams_debug,share)");
} MPS_ARGS_END(args);
mps_tramp(&r, test, pool, 0);
mps_pool_destroy(pool);
printf("\n\n****************************** Testing AMS Debug\n");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
MPS_ARGS_ADD(args, MPS_KEY_AMS_SUPPORT_AMBIGUOUS, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, &freecheckOptions);
die(mps_pool_create_k(&pool, arena, mps_class_ams_debug(), args),
"pool_create(ams_debug,ambig)");
} MPS_ARGS_END(args);
mps_tramp(&r, test, pool, 1);
mps_pool_destroy(pool);
printf("\n\n****************************** Testing AMS\n");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
MPS_ARGS_ADD(args, MPS_KEY_AMS_SUPPORT_AMBIGUOUS, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, &freecheckOptions);
die(mps_pool_create_k(&pool, arena, mps_class_ams(), args),
"pool_create(ams,ambig)");
} MPS_ARGS_END(args);
mps_tramp(&r, test, pool, 1);
mps_pool_destroy(pool);
printf("\n\n****************************** Testing AMS\n");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
MPS_ARGS_ADD(args, MPS_KEY_AMS_SUPPORT_AMBIGUOUS, FALSE);
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, &freecheckOptions);
die(mps_pool_create_k(&pool, arena, mps_class_ams(), args),
"pool_create(ams,share)");
} MPS_ARGS_END(args);
mps_tramp(&r, test, pool, 0);
mps_pool_destroy(pool);
for (i = 0; i < 8; i++) {
int debug = i % 2;
int ownChain = (i / 2) % 2;
int ambig = (i / 4) % 2;
printf("\n\n*** AMS%s with %sCHAIN and %sSUPPORT_AMBIGUOUS\n",
debug ? " Debug" : "",
ownChain ? "" : "!",
ambig ? "" : "!");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
if (ownChain)
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
MPS_ARGS_ADD(args, MPS_KEY_AMS_SUPPORT_AMBIGUOUS, ambig);
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, &freecheckOptions);
test_pool(debug ? mps_class_ams_debug() : mps_class_ams(), args, ambig);
} MPS_ARGS_END(args);
}
mps_arena_park(arena);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_thread_dereg(thread);

2
mps/code/amssshe.c
View file

@ -139,6 +139,7 @@ static void *test(void *arg, size_t s)
}
(void)mps_commit(busy_ap, busy_init, 64);
mps_arena_park(arena);
mps_ap_destroy(busy_ap);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
@ -146,6 +147,7 @@ static void *test(void *arg, size_t s)
mps_pool_destroy(pool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_arena_release(arena);
return NULL;
}

66
mps/code/anangc.gmk Normal file
View file

@ -0,0 +1,66 @@
# -*- makefile -*-
#
# anangc.gmk: BUILD FOR ANSI/ANSI/GCC PLATFORM
#
# $Id$
# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
PFM = anangc
MPMPF = \
lockan.c \
prmcan.c \
protan.c \
span.c \
ssan.c \
than.c \
vman.c
LIBS = -lm -lpthread
include gc.gmk
CFLAGSCOMPILER += -DCONFIG_PF_ANSI -DCONFIG_THREAD_SINGLE
include comm.gmk
# C. COPYRIGHT AND LICENSE
#
# Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# 3. Redistributions in any form must be accompanied by information on how
# to obtain complete source code for this software and any accompanying
# software that uses this software. The source code must either be
# included in the distribution or be available for no more than the cost
# of distribution plus a nominal fee, and must be freely redistributable
# under reasonable conditions. For an executable file, complete source
# code means the source code for all modules it contains. It does not
# include source code for modules or files that typically accompany the
# major components of the operating system on which the executable file
# runs.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
# PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
# COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

66
mps/code/ananll.gmk Normal file
View file

@ -0,0 +1,66 @@
# -*- makefile -*-
#
# ananll.gmk: BUILD FOR ANSI/ANSI/Clang PLATFORM
#
# $Id$
# Copyright (c) 2014 Ravenbrook Limited. See end of file for license.
PFM = ananll
MPMPF = \
lockan.c \
prmcan.c \
protan.c \
span.c \
ssan.c \
than.c \
vman.c
LIBS = -lm -lpthread
include ll.gmk
CFLAGSCOMPILER += -DCONFIG_PF_ANSI -DCONFIG_THREAD_SINGLE
include comm.gmk
# C. COPYRIGHT AND LICENSE
#
# Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# 3. Redistributions in any form must be accompanied by information on how
# to obtain complete source code for this software and any accompanying
# software that uses this software. The source code must either be
# included in the distribution or be available for no more than the cost
# of distribution plus a nominal fee, and must be freely redistributable
# under reasonable conditions. For an executable file, complete source
# code means the source code for all modules it contains. It does not
# include source code for modules or files that typically accompany the
# major components of the operating system on which the executable file
# runs.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
# PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
# COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

184
mps/code/ananmv.nmk Normal file
View file

@ -0,0 +1,184 @@
# ananmv.nmk: ANSI/ANSI/MICROSOFT VISUAL C/C++ NMAKE FILE -*- makefile -*-
#
# $Id$
# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
PFM = ananmv
PFMDEFS = /DCONFIG_PF_ANSI /DCONFIG_THREAD_SINGLE
!INCLUDE commpre.nmk
!INCLUDE mv.nmk
# MPM sources: core plus platform-specific.
MPM = $(MPMCOMMON) \
<lockan> \
<prmcan> \
<protan> \
<span> \
<ssan> \
<than> \
<vman>
# Source to object file mappings and CFLAGS amalgamation
#
# %%VARIETY %%PART: When adding a new variety or part, add new macros which
# expand to the files included in the part for each variety
#
# %%VARIETY: When adding a new variety, add a CFLAGS macro which expands to
# the flags that that variety should use when compiling C. And a LINKFLAGS
# macro which expands to the flags that the variety should use when building
# executables. And a LIBFLAGS macro which expands to the flags that the
# variety should use when building libraries
!IF "$(VARIETY)" == "hot"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFHOT) $(CFLAGSCOMMONPOST)
CFLAGSSQL=$(CFLAGSSQLPRE) $(CFHOT) $(CFLAGSSQLPOST)
LINKFLAGS=$(LINKFLAGSCOMMON) $(LFHOT)
LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSHOT)
MPMOBJ0 = $(MPM:<=ananmv\hot\)
PLINTHOBJ0 = $(PLINTH:<=ananmv\hot\)
AMSOBJ0 = $(AMS:<=ananmv\hot\)
AMCOBJ0 = $(AMC:<=ananmv\hot\)
AWLOBJ0 = $(AWL:<=ananmv\hot\)
LOOBJ0 = $(LO:<=ananmv\hot\)
SNCOBJ0 = $(SNC:<=ananmv\hot\)
MVFFOBJ0 = $(MVFF:<=ananmv\hot\)
DWOBJ0 = $(DW:<=ananmv\hot\)
FMTTESTOBJ0 = $(FMTTEST:<=ananmv\hot\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=ananmv\hot\)
POOLNOBJ0 = $(POOLN:<=ananmv\hot\)
TESTLIBOBJ0 = $(TESTLIB:<=ananmv\hot\)
TESTTHROBJ0 = $(TESTTHR:<=ananmv\hot\)
!ELSEIF "$(VARIETY)" == "cool"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFCOOL) $(CFLAGSCOMMONPOST)
CFLAGSSQL=$(CFLAGSSQLPRE) $(CFCOOL) $(CFLAGSSQLPOST)
LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCOOL)
LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCOOL)
MPMOBJ0 = $(MPM:<=ananmv\cool\)
PLINTHOBJ0 = $(PLINTH:<=ananmv\cool\)
AMSOBJ0 = $(AMS:<=ananmv\cool\)
AMCOBJ0 = $(AMC:<=ananmv\cool\)
AWLOBJ0 = $(AWL:<=ananmv\cool\)
LOOBJ0 = $(LO:<=ananmv\cool\)
SNCOBJ0 = $(SNC:<=ananmv\cool\)
MVFFOBJ0 = $(MVFF:<=ananmv\cool\)
DWOBJ0 = $(DW:<=ananmv\cool\)
FMTTESTOBJ0 = $(FMTTEST:<=ananmv\cool\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=ananmv\cool\)
POOLNOBJ0 = $(POOLN:<=ananmv\cool\)
TESTLIBOBJ0 = $(TESTLIB:<=ananmv\cool\)
TESTTHROBJ0 = $(TESTTHR:<=ananmv\cool\)
!ELSEIF "$(VARIETY)" == "rash"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFRASH) $(CFLAGSCOMMONPOST)
CFLAGSSQL=$(CFLAGSSQLPRE) $(CFRASH) $(CFLAGSSQLPOST)
LINKFLAGS=$(LINKFLAGSCOMMON) $(LFRASH)
LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSRASH)
MPMOBJ0 = $(MPM:<=ananmv\rash\)
PLINTHOBJ0 = $(PLINTH:<=ananmv\rash\)
AMSOBJ0 = $(AMS:<=ananmv\rash\)
AMCOBJ0 = $(AMC:<=ananmv\rash\)
AWLOBJ0 = $(AWL:<=ananmv\rash\)
LOOBJ0 = $(LO:<=ananmv\rash\)
SNCOBJ0 = $(SNC:<=ananmv\rash\)
MVFFOBJ0 = $(MVFF:<=ananmv\rash\)
DWOBJ0 = $(DW:<=ananmv\rash\)
FMTTESTOBJ0 = $(FMTTEST:<=ananmv\rash\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=ananmv\rash\)
POOLNOBJ0 = $(POOLN:<=ananmv\rash\)
TESTLIBOBJ0 = $(TESTLIB:<=ananmv\rash\)
TESTTHROBJ0 = $(TESTTHR:<=ananmv\rash\)
#!ELSEIF "$(VARIETY)" == "cv"
#CFLAGS=$(CFLAGSCOMMON) $(CFCV)
#LINKFLAGS=$(LINKFLAGSCOMMON) $(LFCV)
#LIBFLAGS=$(LIBFLAGSCOMMON) $(LIBFLAGSCV)
#MPMOBJ0 = $(MPM:<=ananmv\cv\)
#MPMOBJ = $(MPMOBJ0:>=.obj)
#PLINTHOBJ0 = $(PLINTH:<=ananmv\cv\)
#PLINTHOBJ = $(PLINTHOBJ0:>=.obj)
#AMSOBJ0 = $(AMS:<=ananmv\cv\)
#AMSOBJ = $(AMSOBJ0:>=.obj)
#AMCOBJ0 = $(AMC:<=ananmv\cv\)
#AMCOBJ = $(AMCOBJ0:>=.obj)
#AWLOBJ0 = $(AWL:<=ananmv\cv\)
#AWLOBJ = $(AWLOBJ0:>=.obj)
#LOOBJ0 = $(LO:<=ananmv\cv\)
#LOOBJ = $(LOOBJ0:>=.obj)
#SNCOBJ0 = $(SNC:<=ananmv\cv\)
#SNCOBJ = $(SNCOBJ0:>=.obj)
#DWOBJ0 = $(DW:<=ananmv\cv\)
#DWOBJ = $(DWOBJ0:>=.obj)
#POOLNOBJ0 = $(POOLN:<=ananmv\cv\)
#POOLNOBJ = $(POOLNOBJ0:>=.obj)
#TESTLIBOBJ0 = $(TESTLIB:<=ananmv\cv\)
#TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
#TESTTHROBJ0 = $(TESTTHR:<=ananmv\cv\)
#TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!ENDIF
# %%PART: When adding a new part, add new macros which expand to the object
# files included in the part
MPMOBJ = $(MPMOBJ0:>=.obj)
PLINTHOBJ = $(PLINTHOBJ0:>=.obj)
AMSOBJ = $(AMSOBJ0:>=.obj)
AMCOBJ = $(AMCOBJ0:>=.obj)
AWLOBJ = $(AWLOBJ0:>=.obj)
LOOBJ = $(LOOBJ0:>=.obj)
SNCOBJ = $(SNCOBJ0:>=.obj)
MVFFOBJ = $(MVFFOBJ0:>=.obj)
DWOBJ = $(DWOBJ0:>=.obj)
FMTTESTOBJ = $(FMTTESTOBJ0:>=.obj)
FMTSCHEMEOBJ = $(FMTSCHEMEOBJ0:>=.obj)
POOLNOBJ = $(POOLNOBJ0:>=.obj)
TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!INCLUDE commpost.nmk
# C. COPYRIGHT AND LICENSE
#
# Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# 3. Redistributions in any form must be accompanied by information on how
# to obtain complete source code for this software and any accompanying
# software that uses this software. The source code must either be
# included in the distribution or be available for no more than the cost
# of distribution plus a nominal fee, and must be freely redistributable
# under reasonable conditions. For an executable file, complete source
# code means the source code for all modules it contains. It does not
# include source code for modules or files that typically accompany the
# major components of the operating system on which the executable file
# runs.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
# PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
# COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

2
mps/code/arenacl.c
View file

@ -61,6 +61,7 @@ typedef struct ClientChunkStruct {
/* ClientChunkCheck -- check the consistency of a client chunk */
ATTRIBUTE_UNUSED
static Bool ClientChunkCheck(ClientChunk clChunk)
{
Chunk chunk;
@ -77,6 +78,7 @@ static Bool ClientChunkCheck(ClientChunk clChunk)
/* ClientArenaCheck -- check the consistency of a client arena */
ATTRIBUTE_UNUSED
static Bool ClientArenaCheck(ClientArena clientArena)
{
CHECKS(ClientArena, clientArena);

2
mps/code/arenavm.c
View file

@ -93,6 +93,7 @@ static void VMCompact(Arena arena, Trace trace);
/* VMChunkCheck -- check the consistency of a VM chunk */
ATTRIBUTE_UNUSED
static Bool VMChunkCheck(VMChunk vmchunk)
{
Chunk chunk;
@ -152,6 +153,7 @@ static Bool VMChunkCheck(VMChunk vmchunk)
/* VMArenaCheck -- check the consistency of an arena structure */
ATTRIBUTE_UNUSED
static Bool VMArenaCheck(VMArena vmArena)
{
Arena arena;

1
mps/code/arg.c
View file

@ -159,6 +159,7 @@ Bool ArgPick(ArgStruct *argOut, ArgList args, Key key) {
return FALSE;
found:
AVERT(Arg, &args[i]);
*argOut = args[i];
for(;;) {
args[i] = args[i + 1];

3
mps/code/awlut.c
View file

@ -275,9 +275,6 @@ static void *setup(void *v, size_t s)
die(mps_fmt_create_A(&dylanweakfmt, arena, dylan_fmt_A_weak()),
"Format Create (weak)\n");
MPS_ARGS_BEGIN(args) {
/* Ask the leafpool to allocate in the nursery, as we're using it to test
weaknesss and want things to die in it promptly. */
MPS_ARGS_ADD(args, MPS_KEY_GEN, 0);
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, dylanfmt);
die(mps_pool_create_k(&leafpool, arena, mps_class_lo(), args),
"Leaf Pool Create\n");

3
mps/code/awluthe.c
View file

@ -277,9 +277,6 @@ static void *setup(void *v, size_t s)
die(EnsureHeaderFormat(&dylanfmt, arena), "EnsureHeaderFormat");
die(EnsureHeaderWeakFormat(&dylanweakfmt, arena), "EnsureHeaderWeakFormat");
MPS_ARGS_BEGIN(args) {
/* Ask the leafpool to allocate in the nursery, as we're using it to test
weaknesss and want things to die in it promptly. */
MPS_ARGS_ADD(args, MPS_KEY_GEN, 0);
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, dylanfmt);
die(mps_pool_create_k(&leafpool, arena, mps_class_lo(), args),
"Leaf Pool Create\n");

7
mps/code/buffer.c
View file

@ -994,6 +994,7 @@ AllocPattern AllocPatternRampCollectAll(void)
return &AllocPatternRampCollectAllStruct;
}
ATTRIBUTE_UNUSED
static Bool AllocPatternCheck(AllocPattern pattern)
{
CHECKL(pattern == &AllocPatternRampCollectAllStruct
@ -1075,7 +1076,7 @@ static Res bufferTrivInit(Buffer buffer, Pool pool, ArgList args)
AVERT(Buffer, buffer);
AVERT(Pool, pool);
UNUSED(args);
EVENT3(BufferInit, buffer, pool, BOOL(buffer->isMutator));
EVENT3(BufferInit, buffer, pool, BOOLOF(buffer->isMutator));
return ResOK;
}
@ -1288,7 +1289,7 @@ static Res segBufInit(Buffer buffer, Pool pool, ArgList args)
segbuf->rankSet = RankSetEMPTY;
AVERT(SegBuf, segbuf);
EVENT3(BufferInitSeg, buffer, pool, BOOL(buffer->isMutator));
EVENT3(BufferInitSeg, buffer, pool, BOOLOF(buffer->isMutator));
return ResOK;
}
@ -1515,7 +1516,7 @@ static Res rankBufInit(Buffer buffer, Pool pool, ArgList args)
BufferSetRankSet(buffer, RankSetSingle(rank));
/* There's nothing to check that the superclass doesn't, so no AVERT. */
EVENT4(BufferInitRank, buffer, pool, BOOL(buffer->isMutator), rank);
EVENT4(BufferInitRank, buffer, pool, BOOLOF(buffer->isMutator), rank);
return ResOK;
}

15
mps/code/cbs.c
View file

@ -59,6 +59,7 @@ Bool CBSCheck(CBS cbs)
}
ATTRIBUTE_UNUSED
static Bool CBSBlockCheck(CBSBlock block)
{
UNUSED(block); /* Required because there is no signature */
@ -208,7 +209,6 @@ static void cbsUpdateZonedNode(SplayTree splay, Tree tree)
* See <design/land/#function.init>.
*/
ARG_DEFINE_KEY(cbs_extend_by, Size);
ARG_DEFINE_KEY(cbs_block_pool, Pool);
static Res cbsInitComm(Land land, ArgList args, SplayUpdateNodeMethod update,
@ -216,8 +216,6 @@ static Res cbsInitComm(Land land, ArgList args, SplayUpdateNodeMethod update,
{
CBS cbs;
LandClass super;
Size extendBy = CBS_EXTEND_BY_DEFAULT;
Bool extendSelf = TRUE;
ArgStruct arg;
Res res;
Pool blockPool = NULL;
@ -230,10 +228,6 @@ static Res cbsInitComm(Land land, ArgList args, SplayUpdateNodeMethod update,
if (ArgPick(&arg, args, CBSBlockPool))
blockPool = arg.val.pool;
if (ArgPick(&arg, args, MPS_KEY_CBS_EXTEND_BY))
extendBy = arg.val.size;
if (ArgPick(&arg, args, MFSExtendSelf))
extendSelf = arg.val.b;
cbs = cbsOfLand(land);
SplayTreeInit(cbsSplay(cbs), cbsCompare, cbsKey, update);
@ -244,8 +238,6 @@ static Res cbsInitComm(Land land, ArgList args, SplayUpdateNodeMethod update,
} else {
MPS_ARGS_BEGIN(pcArgs) {
MPS_ARGS_ADD(pcArgs, MPS_KEY_MFS_UNIT_SIZE, blockStructSize);
MPS_ARGS_ADD(pcArgs, MPS_KEY_EXTEND_BY, extendBy);
MPS_ARGS_ADD(pcArgs, MFSExtendSelf, extendSelf);
res = PoolCreate(&cbs->blockPool, LandArena(land), PoolClassMFS(), pcArgs);
} MPS_ARGS_END(pcArgs);
if (res != ResOK)
@ -837,6 +829,8 @@ static void cbsFindDeleteRange(Range rangeReturn, Range oldRangeReturn,
deleted from one end of the block, so cbsDelete did not
need to allocate a new block. */
AVER(res == ResOK);
} else {
RangeCopy(oldRangeReturn, rangeReturn);
}
}
@ -979,6 +973,7 @@ static Bool cbsFindLargest(Range rangeReturn, Range oldRangeReturn,
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
AVER(size > 0);
AVERT(FindDelete, findDelete);
if (!SplayTreeIsEmpty(cbsSplay(cbs))) {
@ -998,7 +993,7 @@ static Bool cbsFindLargest(Range rangeReturn, Range oldRangeReturn,
RangeInit(&range, CBSBlockBase(block), CBSBlockLimit(block));
AVER(RangeSize(&range) >= maxSize);
cbsFindDeleteRange(rangeReturn, oldRangeReturn, land, &range,
maxSize, findDelete);
size, findDelete);
}
}

1
mps/code/chain.h
View file

@ -81,7 +81,6 @@ extern Bool ChainCheck(Chain chain);
extern double ChainDeferral(Chain chain);
extern Res ChainCondemnAuto(double *mortalityReturn, Chain chain, Trace trace);
extern Res ChainCondemnAll(Chain chain, Trace trace);
extern void ChainStartGC(Chain chain, Trace trace);
extern void ChainEndGC(Chain chain, Trace trace);
extern size_t ChainGens(Chain chain);

1
mps/code/clock.h
View file

@ -7,7 +7,6 @@
#ifndef clock_h
#define clock_h
#include <limits.h>
#include "mpmtypes.h" /* for Word */

73
mps/code/comm.gmk
View file

@ -15,8 +15,8 @@
# Assumes the following variables and definitions:
# EXTRA_TARGETS a list of extra targets to build
# CFLAGSCOMPILER a list of flags for all compilations
# CFLAGSSTRICT a list of flags for almost all compilations
# CFLAGSLAX a list of flags for compilations which can't be as
# CFLAGSCOMPILERSTRICT a list of flags for almost all compilations
# CFLAGSCOMPILERLAX a list of flags for compilations which can't be as
# strict (e.g. because they have to include a third-
# party header file that isn't -ansi -pedantic).
# CFLAGSDEBUG a list of flags for compilations with maximum debug
@ -108,7 +108,7 @@ endif
# These flags are included in all compilations.
# Avoid using PFMDEFS in platform makefiles, as they prevent the MPS being
# built with a simple command like "cc -c mps.c".
CFLAGSCOMMON = $(PFMDEFS) $(CFLAGSCOMPILER) $(CFLAGSCOMPILERSTRICT)
CFLAGSCOMMONSTRICT = $(PFMDEFS) $(CFLAGSCOMPILER) $(CFLAGSCOMPILERSTRICT)
CFLAGSCOMMONLAX = $(PFMDEFS) $(CFLAGSCOMPILER) $(CFLAGSCOMPILERLAX)
# %%VARIETY: When adding a new variety, define a macro containing the set
@ -119,20 +119,17 @@ CFRASH = -DCONFIG_VAR_RASH -DNDEBUG $(CFLAGSOPT)
CFHOT = -DCONFIG_VAR_HOT -DNDEBUG $(CFLAGSOPT)
CFCOOL = -DCONFIG_VAR_COOL $(CFLAGSDEBUG)
# Bind CFLAGS to the appropriate set of flags for the variety.
# %%VARIETY: When adding a new variety, add a test for the variety and set
# CFLAGS here.
# Bind CFLAGSVARIETY to the appropriate set of flags for the variety.
# %%VARIETY: When adding a new variety, add a test for the variety and
# set CFLAGSVARIETY here.
ifeq ($(VARIETY),rash)
CFLAGS=$(CFLAGSCOMMON) $(CFRASH)
CFLAGSLAX=$(CFLAGSCOMMONLAX) $(CFRASH)
CFLAGSVARIETY=$(CFRASH)
else
ifeq ($(VARIETY),hot)
CFLAGS=$(CFLAGSCOMMON) $(CFHOT)
CFLAGSLAX=$(CFLAGSCOMMONLAX) $(CFHOT)
CFLAGSVARIETY=$(CFHOT)
else
ifeq ($(VARIETY),cool)
CFLAGS=$(CFLAGSCOMMON) $(CFCOOL)
CFLAGSLAX=$(CFLAGSCOMMONLAX) $(CFCOOL)
CFLAGSVARIETY=$(CFCOOL)
else
ifneq ($(VARIETY),)
$(error Variety "$(VARIETY)" not recognized: must be rash/hot/cool)
@ -141,7 +138,8 @@ endif
endif
endif
CFLAGSSTRICT=$(CFLAGSCOMMONSTRICT) $(CFLAGSVARIETY) $(CFLAGS)
CFLAGSLAX=$(CFLAGSCOMMONLAX) $(CFLAGSVARIETY) $(CFLAGS)
ARFLAGS=rc$(ARFLAGSPFM)
@ -158,7 +156,8 @@ SNC = poolsnc.c
POOLN = pooln.c
MV2 = poolmv2.c
MVFF = poolmvff.c
TESTLIB = testlib.c testthrix.c
TESTLIB = testlib.c
TESTTHR = testthrix.c
FMTDY = fmtdy.c fmtno.c
FMTDYTST = fmtdy.c fmtno.c fmtdytst.c
FMTHETST = fmthe.c fmtdy.c fmtno.c fmtdytst.c
@ -245,6 +244,8 @@ MVFFDEP = $(MVFF:%.c=$(PFM)/$(VARIETY)/%.d)
TESTLIBOBJ = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.o)
TESTLIBDEP = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.d)
TESTTHROBJ = $(TESTTHR:%.c=$(PFM)/$(VARIETY)/%.o)
TESTTHRDEP = $(TESTTHR:%.c=$(PFM)/$(VARIETY)/%.d)
FMTDYOBJ = $(FMTDY:%.c=$(PFM)/$(VARIETY)/%.o)
FMTDYDEP = $(FMTDY:%.c=$(PFM)/$(VARIETY)/%.d)
FMTDYTSTOBJ = $(FMTDYTST:%.c=$(PFM)/$(VARIETY)/%.o)
@ -318,7 +319,7 @@ TEST_TARGETS=\
UNBUILDABLE_TARGETS=\
replay # depends on the EPVM pool
ALL_TARGETS=$(LIB_TARGETS) $(TEST_TARGETS) $(EXTRA_TARGETS) testrun
ALL_TARGETS=$(LIB_TARGETS) $(TEST_TARGETS) $(EXTRA_TARGETS)
# == Pseudo-targets ==
@ -326,16 +327,24 @@ ALL_TARGETS=$(LIB_TARGETS) $(TEST_TARGETS) $(EXTRA_TARGETS) testrun
all: $(ALL_TARGETS)
# Run the automated tests.
# == Automated test suites ==
#
# testrun = "smoke test", fast enough to run before every commit
# testci = continuous integration tests, must be known good
# testall = all test cases, for ensuring quality of a release
# testansi = tests that run on the generic ("ANSI") platform
# testpoll = tests that run on the generic platform with CONFIG_POLL_NONE
$(PFM)/$(VARIETY)/testrun: $(TEST_TARGETS)
../tool/testrun.sh "$(PFM)/$(VARIETY)"
TEST_SUITES=testrun testci testall testansi testpoll
$(addprefix $(PFM)/$(VARIETY)/,$(TEST_SUITES)): $(TEST_TARGETS)
../tool/testrun.sh "$(PFM)/$(VARIETY)" "$(notdir $@)"
# These convenience targets allow one to type "make foo" to build target
# foo in selected varieties (or none, for the latter rule).
$(ALL_TARGETS): phony
$(ALL_TARGETS) $(TEST_SUITES): phony
ifdef VARIETY
$(MAKE) -f $(PFM).gmk TARGET=$@ variety
else
@ -434,7 +443,7 @@ $(PFM)/$(VARIETY)/amcsshe: $(PFM)/$(VARIETY)/amcsshe.o \
$(FMTHETSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/amcssth: $(PFM)/$(VARIETY)/amcssth.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/amsss: $(PFM)/$(VARIETY)/amsss.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@ -455,7 +464,7 @@ $(PFM)/$(VARIETY)/awluthe: $(PFM)/$(VARIETY)/awluthe.o \
$(FMTHETSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/awlutth: $(PFM)/$(VARIETY)/awlutth.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/btcv: $(PFM)/$(VARIETY)/btcv.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@ -464,7 +473,7 @@ $(PFM)/$(VARIETY)/bttest: $(PFM)/$(VARIETY)/bttest.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/djbench: $(PFM)/$(VARIETY)/djbench.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(TESTLIBOBJ) $(TESTTHROBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/exposet0: $(PFM)/$(VARIETY)/exposet0.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@ -482,7 +491,7 @@ $(PFM)/$(VARIETY)/fotest: $(PFM)/$(VARIETY)/fotest.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/gcbench: $(PFM)/$(VARIETY)/gcbench.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/landtest: $(PFM)/$(VARIETY)/landtest.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@ -494,7 +503,7 @@ $(PFM)/$(VARIETY)/lockcov: $(PFM)/$(VARIETY)/lockcov.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/lockut: $(PFM)/$(VARIETY)/lockut.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(TESTLIBOBJ) $(TESTTHROBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/locusss: $(PFM)/$(VARIETY)/locusss.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@ -569,11 +578,11 @@ endif
# Object files
define run-cc
define run-cc-strict
$(ECHO) "$(PFM): $@"
mkdir -p $(PFM)
mkdir -p $(PFM)/$(VARIETY)
$(CC) $(CFLAGS) -c -o $@ $<
$(CC) $(CFLAGSSTRICT) -c -o $@ $<
endef
define run-cc-lax
@ -585,16 +594,16 @@ endef
# .rule.c-to-o:
$(PFM)/$(VARIETY)/%.o: %.c
$(run-cc)
$(run-cc-strict)
$(PFM)/$(VARIETY)/eventsql.o: eventsql.c
$(run-cc-lax)
$(PFM)/$(VARIETY)/%.o: %.s
$(run-cc)
$(run-cc-strict)
$(PFM)/$(VARIETY)/%.o: %.S
$(run-cc)
$(run-cc-strict)
# Dependencies
#
@ -654,7 +663,7 @@ endif
$(PFM)/$(VARIETY)/%.a:
$(ECHO) "$(PFM): $@"
rm -f $@
$(CC) $(CFLAGS) -c -o $(PFM)/$(VARIETY)/version.o version.c
$(CC) $(CFLAGSSTRICT) -c -o $(PFM)/$(VARIETY)/version.o version.c
$(AR) $(ARFLAGS) $@ $^ $(PFM)/$(VARIETY)/version.o
$(RANLIB) $@
@ -662,11 +671,11 @@ $(PFM)/$(VARIETY)/%.a:
$(PFM)/$(VARIETY)/%:
$(ECHO) "$(PFM): $@"
$(CC) $(CFLAGS) $(LINKFLAGS) -o $@ $^ $(LIBS)
$(CC) $(CFLAGSSTRICT) $(LINKFLAGS) -o $@ $^ $(LIBS)
$(PFM)/$(VARIETY)/mpseventsql:
$(ECHO) "$(PFM): $@"
$(CC) $(CFLAGS) $(LINKFLAGS) -o $@ $^ $(LIBS) -lsqlite3
$(CC) $(CFLAGSLAX) $(LINKFLAGS) -o $@ $^ $(LIBS) -lsqlite3
# Special targets for development

20
mps/code/commpost.nmk
View file

@ -53,15 +53,15 @@ variety: $(PFM)\$(VARIETY)\$(TARGET)
!ENDIF
!ENDIF
# testrun
# testrun testci testall testansi testpoll
# Runs automated test cases.
testrun: $(TEST_TARGETS)
testrun testci testall testansi testpoll: $(TEST_TARGETS)
!IFDEF VARIETY
..\tool\testrun.bat $(PFM) $(VARIETY)
..\tool\testrun.bat $(PFM) $(VARIETY) $@
!ELSE
$(MAKE) /nologo /f $(PFM).nmk VARIETY=cool testrun
$(MAKE) /nologo /f $(PFM).nmk VARIETY=hot testrun
$(MAKE) /nologo /f $(PFM).nmk VARIETY=cool $@
$(MAKE) /nologo /f $(PFM).nmk VARIETY=hot $@
!ENDIF
@ -124,7 +124,7 @@ $(PFM)\$(VARIETY)\amcsshe.exe: $(PFM)\$(VARIETY)\amcsshe.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\amcssth.exe: $(PFM)\$(VARIETY)\amcssth.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ)
$(PFM)\$(VARIETY)\amsss.exe: $(PFM)\$(VARIETY)\amsss.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
@ -148,7 +148,7 @@ $(PFM)\$(VARIETY)\awluthe.exe: $(PFM)\$(VARIETY)\awluthe.obj \
$(PFM)\$(VARIETY)\awlutth.exe: $(PFM)\$(VARIETY)\awlutth.obj \
$(FMTTESTOBJ) \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ) $(TESTTHROBJ)
$(PFM)\$(VARIETY)\btcv.exe: $(PFM)\$(VARIETY)\btcv.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
@ -160,7 +160,7 @@ $(PFM)\$(VARIETY)\cvmicv.exe: $(PFM)\$(VARIETY)\cvmicv.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\djbench.exe: $(PFM)\$(VARIETY)\djbench.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ) $(TESTTHROBJ)
$(PFM)\$(VARIETY)\exposet0.exe: $(PFM)\$(VARIETY)\exposet0.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
@ -178,7 +178,7 @@ $(PFM)\$(VARIETY)\fotest.exe: $(PFM)\$(VARIETY)\fotest.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\gcbench.exe: $(PFM)\$(VARIETY)\gcbench.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ)
$(PFM)\$(VARIETY)\landtest.exe: $(PFM)\$(VARIETY)\landtest.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
@ -190,7 +190,7 @@ $(PFM)\$(VARIETY)\lockcov.exe: $(PFM)\$(VARIETY)\lockcov.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\lockut.exe: $(PFM)\$(VARIETY)\lockut.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ) $(TESTTHROBJ)
$(PFM)\$(VARIETY)\locusss.exe: $(PFM)\$(VARIETY)\locusss.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)

12
mps/code/commpre.nmk
View file

@ -32,6 +32,7 @@
# FMTTEST as above for the "fmttest" part
# FMTSCHEME as above for the "fmtscheme" part
# TESTLIB as above for the "testlib" part
# TESTTHR as above for the "testthr" part
# NOISY if defined, causes command to be emitted
#
#
@ -136,13 +137,11 @@ MPMCOMMON=\
<global> \
<land> \
<ld> \
<lockw3> \
<locus> \
<message> \
<meter> \
<mpm> \
<mpsi> \
<mpsiw3> \
<nailboard> \
<pool> \
<poolabs> \
@ -151,7 +150,6 @@ MPMCOMMON=\
<poolmv2> \
<poolmv> \
<protocol> \
<protw3> \
<range> \
<ref> \
<reserv> \
@ -164,12 +162,10 @@ MPMCOMMON=\
<splay> \
<ss> \
<table> \
<thw3> \
<trace> \
<traceanc> \
<tract> \
<tree> \
<vmw3> \
<walk>
PLINTH = <mpsliban> <mpsioan>
AMC = <poolamc>
@ -182,7 +178,8 @@ SNC = <poolsnc>
DW = <fmtdy> <fmtno>
FMTTEST = <fmthe> <fmtdy> <fmtno> <fmtdytst>
FMTSCHEME = <fmtscheme>
TESTLIB = <testlib> <testthrw3> <getoptl>
TESTLIB = <testlib> <getoptl>
TESTTHR = <testthrw3>
# CHECK PARAMETERS
@ -230,6 +227,9 @@ TESTLIB = <testlib> <testthrw3> <getoptl>
!IFNDEF TESTLIB
!ERROR commpre.nmk: TESTLIB not defined
!ENDIF
!IFNDEF TESTTHR
!ERROR commpre.nmk: TESTTHR not defined
!ENDIF
# DECLARATIONS

82
mps/code/config.h
View file

@ -147,11 +147,60 @@
* cc -O2 -c -DCONFIG_PLINTH_NONE mps.c
*/
#if defined(CONFIG_PLINTH_NONE)
#if !defined(CONFIG_PLINTH_NONE)
#define PLINTH
#else
#define PLINTH_NONE
#endif
/* CONFIG_PF_ANSI -- use the ANSI platform
*
* This symbol tells mps.c to exclude the sources for the
* auto-detected platform, and use the generic ("ANSI") platform
* instead.
*/
#if defined(CONFIG_PF_ANSI)
#define PLATFORM_ANSI
#endif
/* CONFIG_THREAD_SINGLE -- support single-threaded execution only
*
* This symbol causes the MPS to be built for single-threaded
* execution only, where locks are not needed and so lock operations
* can be defined as no-ops by lock.h.
*/
#if !defined(CONFIG_THREAD_SINGLE)
#define LOCK
#else
#define LOCK_NONE
#endif
/* CONFIG_POLL_NONE -- no support for polling
*
* This symbol causes the MPS to built without support for polling.
* This means that garbage collections will only happen if requested
* explicitly via mps_arena_collect() or mps_arena_step(), but it also
* means that protection is not needed, and so shield operations can
* be replaced with no-ops in mpm.h.
*/
#if !defined(CONFIG_POLL_NONE)
#define REMEMBERED_SET
#define SHIELD
#else
#if !defined(CONFIG_THREAD_SINGLE)
#error "CONFIG_POLL_NONE without CONFIG_THREAD_SINGLE"
#endif
#define REMEMBERED_SET_NONE
#define SHIELD_NONE
#endif
#define MPS_VARIETY_STRING \
MPS_ASSERT_STRING "." MPS_LOG_STRING "." MPS_STATS_STRING
@ -241,6 +290,15 @@
#define ATTRIBUTE_NORETURN
#endif
/* Attribute for functions that may be unused in some build configurations.
* GCC: <http://gcc.gnu.org/onlinedocs/gcc/Function-Attributes.html>
*/
#if defined(MPS_BUILD_GC) || defined(MPS_BUILD_LL)
#define ATTRIBUTE_UNUSED __attribute__((__unused__))
#else
#define ATTRIBUTE_UNUSED
#endif
/* EPVMDefaultSubsequentSegSIZE is a default for the alignment of
* subsequent segments (non-initial at each save level) in EPVM. See
@ -255,11 +313,6 @@
#define BUFFER_RANK_DEFAULT (mps_rank_exact())
/* CBS Configuration -- see <code/cbs.c> */
#define CBS_EXTEND_BY_DEFAULT ((Size)4096)
/* Format defaults: see <code/format.c> */
#define FMT_ALIGN_DEFAULT ((Align)MPS_PF_ALIGN)
@ -281,7 +334,7 @@
/* Pool AMS Configuration -- see <code/poolams.c> */
#define AMS_SUPPORT_AMBIGUOUS_DEFAULT FALSE
#define AMS_SUPPORT_AMBIGUOUS_DEFAULT TRUE
#define AMS_GEN_DEFAULT 0
@ -372,7 +425,9 @@
/* Stack configuration */
/* Currently StackProbe has a useful implementation only on Windows. */
#if defined(MPS_OS_W3) && defined(MPS_ARCH_I3)
#if defined(PLATFORM_ANSI)
#define StackProbeDEPTH ((Size)0)
#elif defined(MPS_OS_W3) && defined(MPS_ARCH_I3)
#define StackProbeDEPTH ((Size)500)
#elif defined(MPS_OS_W3) && defined(MPS_ARCH_I6)
#define StackProbeDEPTH ((Size)500)
@ -401,6 +456,7 @@
*
* Source Symbols Header Feature
* =========== ========================= ============= ====================
* eventtxt.c setenv <stdlib.h> _GNU_SOURCE
* lockli.c pthread_mutexattr_settype <pthread.h> _XOPEN_SOURCE >= 500
* prmci3li.c REG_EAX etc. <ucontext.h> _GNU_SOURCE
* prmci6li.c REG_RAX etc. <ucontext.h> _GNU_SOURCE
@ -419,9 +475,14 @@
#if defined(MPS_OS_LI)
#if defined(_XOPEN_SOURCE) && _XOPEN_SOURCE < 500
#undef _XOPEN_SOURCE
#endif
#if !defined(_XOPEN_SOURCE)
#define _XOPEN_SOURCE 500
#endif
#ifndef _GNU_SOURCE
#if !defined(_GNU_SOURCE)
#define _GNU_SOURCE
#endif
@ -547,9 +608,6 @@
#define MPS_PROD_STRING "mps"
#define MPS_PROD_MPS
#define THREAD_MULTI
#define PROTECTION
#define PROD_CHECKLEVEL_INITIAL CheckLevelSHALLOW
/* TODO: This should be proportional to the memory usage of the MPS, not
a constant. That will require design, and then some interface and

95
mps/code/eventrep.c
View file

@ -143,37 +143,6 @@ static void error(const char *format, ...)
MPS_BEGIN if (!(cond)) error("line %d " #cond, __LINE__); MPS_END
#ifdef MPS_PROD_EPCORE
/* ensurePSFormat -- return the PS format, creating it, if necessary */
static mps_fmt_t psFormat = NULL;
static void ensurePSFormat(mps_fmt_t *fmtOut, mps_arena_t arena)
{
mps_res_t eres;
if (psFormat == NULL) {
eres = mps_fmt_create_A(&psFormat, arena, ps_fmt_A());
verifyMPS(eres);
}
*fmtOut = psFormat;
}
/* finishPSFormat -- finish the PS format, if necessary */
static void finishPSFormat(void)
{
if (psFormat != NULL)
mps_fmt_destroy(psFormat);
}
#endif
/* objectTableCreate -- create an objectTable */
static objectTable objectTableCreate(poolSupport support)
@ -418,10 +387,6 @@ void EventReplay(Event event, Word etime)
case EventArenaDestroy: { /* arena */
found = TableLookup(&entry, arenaTable, (Word)event->p.p0);
verify(found);
#ifdef MPS_PROD_EPCORE
/* @@@@ assuming there's only one arena at a time */
finishPSFormat();
#endif
mps_arena_destroy((mps_arena_t)entry);
ires = TableRemove(arenaTable, (Word)event->pw.p0);
verify(ires == ResOK);
@ -456,30 +421,6 @@ void EventReplay(Event event, Word etime)
/* all internal only */
++discardedEvents;
} break;
#ifdef MPS_PROD_EPCORE
case EventPoolInitEPVM: {
/* pool, arena, format, maxSaveLevel, saveLevel */
mps_arena_t arena;
mps_fmt_t format;
found = TableLookup(&entry, arenaTable, (Word)event->pppuu.p1);
verify(found);
arena = (mps_arena_t)entry;
ensurePSFormat(&format, arena); /* We know what the format is. */
poolRecreate(event->pppuu.p0, event->pppuu.p1,
mps_class_epvm(), supportNothing, 2, format,
(mps_epvm_save_level_t)event->pppuu.u3,
(mps_epvm_save_level_t)event->pppuu.u4);
} break;
case EventPoolInitEPDL: {
/* pool, arena, isEPDL, extendBy, avgSize, align */
poolRecreate(event->ppuwww.p0, event->ppuwww.p1,
event->ppuwww.u2 ? mps_class_epdl() : mps_class_epdr(),
event->ppuwww.u2 ? supportTruncate : supportFree, 0,
(size_t)event->ppuwww.w3, (size_t)event->ppuwww.w4,
(size_t)event->ppuwww.w5);
} break;
#endif
case EventPoolFinish: { /* pool */
found = TableLookup(&entry, poolTable, (Word)event->p.p0);
if (found) {
@ -542,22 +483,6 @@ void EventReplay(Event event, Word etime)
++discardedEvents;
}
} break;
#ifdef MPS_PROD_EPCORE
case EventBufferInitEPVM: { /* buffer, pool, isObj */
found = TableLookup(&entry, poolTable, (Word)event->ppu.p1);
if (found) {
poolRep rep = (poolRep)entry;
if(rep->bufferClassLevel == 2) { /* see .bufclass */
apRecreate(event->ppu.p0, event->ppu.p1, (mps_bool_t)event->ppu.u2);
} else {
++discardedEvents;
}
} else {
++discardedEvents;
}
} break;
#endif
case EventBufferFinish: { /* buffer */
found = TableLookup(&entry, apTable, (Word)event->p.p0);
if (found) {
@ -620,26 +545,6 @@ void EventReplay(Event event, Word etime)
++discardedEvents;
}
} break;
#ifdef MPS_PROD_EPCORE
case EventPoolPush: { /* pool */
found = TableLookup(&entry, poolTable, (Word)event->p.p0);
if (found) {
poolRep rep = (poolRep)entry;
/* It must be EPVM. */
mps_epvm_save(rep->pool);
}
} break;
case EventPoolPop: { /* pool, level */
found = TableLookup(&entry, poolTable, (Word)event->pu.p0);
if (found) {
poolRep rep = (poolRep)entry;
/* It must be EPVM. */
mps_epvm_restore(rep->pool, (mps_epvm_save_level_t)event->pu.u1);
}
} break;
#endif
case EventCommitLimitSet: { /* arena, limit, succeeded */
found = TableLookup(&entry, arenaTable, (Word)event->pwu.p0);
verify(found);

16
mps/code/eventtxt.c
View file

@ -29,20 +29,21 @@
* $Id$
*/
#include "check.h"
#include "config.h"
#include "eventcom.h"
#include "eventdef.h"
#include "mps.h"
#include "mpsavm.h"
#include "mpscmvff.h"
#include "check.h"
#include "config.h"
#include "eventdef.h"
#include "eventcom.h"
#include "table.h"
#include "testlib.h" /* for ulongest_t and associated print formats */
#include <assert.h>
#include <errno.h>
#include <stdio.h>
#include <stdlib.h> /* exit, EXIT_FAILURE, EXIT_SUCCESS */
#include <string.h> /* strcpy, strlen */
#include <string.h> /* strcpy, strerror, strlen */
static const char *prog; /* program name */
static const char *logFileName = NULL;
@ -571,6 +572,11 @@ int main(int argc, char *argv[])
everror("unable to open %s", logFileName);
}
/* Ensure no telemetry output. */
res = setenv("MPS_TELEMETRY_CONTROL", "0", 1);
if (res != 0)
everror("failed to set MPS_TELEMETRY_CONTROL: %s", strerror(errno));
res = mps_arena_create_k(&arena, mps_arena_class_vm(), mps_args_none);
if (res != MPS_RES_OK)
everror("failed to create arena: %d", res);

3
mps/code/exposet0.c
View file

@ -222,6 +222,7 @@ static void *test(void *arg, size_t s)
}
(void)mps_commit(busy_ap, busy_init, 64);
mps_arena_park(arena);
mps_ap_destroy(busy_ap);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
@ -244,7 +245,7 @@ int main(int argc, char *argv[])
die(mps_arena_create(&arena, mps_arena_class_vm(), 2*testArenaSIZE),
"arena_create");
mps_message_type_enable(arena, mps_message_type_gc());
die(mps_arena_commit_limit_set(arena, testArenaSIZE), "set limit");
die(mps_arena_commit_limit_set(arena, 2*testArenaSIZE), "set limit");
die(mps_thread_reg(&thread, arena), "thread_reg");
mps_tramp(&r, test, arena, 0);
mps_thread_dereg(thread);

1
mps/code/expt825.c
View file

@ -250,6 +250,7 @@ static void *test(void *arg, size_t s)
(ulongest_t)object_count);
}
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_root_destroy(mps_root);
mps_pool_destroy(amc);

1
mps/code/finalcv.c
View file

@ -199,6 +199,7 @@ static void *test(void *arg, size_t s)
/* @@@@ <design/poolmrg/#test.promise.ut.nofinal.check> missing */
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_root_destroy(mps_root[1]);
mps_root_destroy(mps_root[0]);

105
mps/code/finaltest.c
View file

@ -6,6 +6,20 @@
*
* DESIGN
*
* .mode: This test has two modes.
*
* .mode.park: In this mode, we use the arena's default generation
* chain, leave the arena parked and call mps_arena_collect. This
* tests that the default generation chain works and that all segments
* get condemned via TraceStartCollectAll. (See job003771 item 4.)
*
* .mode.poll: In this mode, we use our own generation chain (with
* small generations), allocate into generation 1, unclamp the arena,
* and provoke collection by allocating. This tests that custom
* generation chains work, and that segments get condemned via
* TracePoll even if there is no allocation into generation 0 of the
* chain. (See job003771 item 5.)
*
* DEPENDENCIES
*
* This test uses the dylan object format, but the reliance on this
@ -16,6 +30,7 @@
* This code was created by first copying <code/finalcv.c>
*/
#include "mpm.h"
#include "testlib.h"
#include "mpslib.h"
#include "mps.h"
@ -30,10 +45,15 @@
#include <stdio.h> /* fflush, printf, stdout */
enum {
ModePARK, /* .mode.park */
ModePOLL /* .mode.poll */
};
#define testArenaSIZE ((size_t)16<<20)
#define rootCOUNT 20
#define maxtreeDEPTH 10
#define maxtreeDEPTH 9
#define collectionCOUNT 10
@ -126,17 +146,21 @@ static mps_addr_t test_awl_find_dependent(mps_addr_t addr)
static void *root[rootCOUNT];
static void test_trees(const char *name, mps_arena_t arena, mps_ap_t ap,
static void test_trees(int mode, const char *name, mps_arena_t arena,
mps_ap_t ap,
mps_word_t (*make)(mps_word_t, mps_ap_t),
void (*reg)(mps_word_t, mps_arena_t))
{
size_t collections = 0;
size_t finals = 0;
size_t i;
int object_alloc;
object_count = 0;
printf("Making some %s finalized trees of objects.\n", name);
mps_arena_park(arena);
/* make some trees */
for(i = 0; i < rootCOUNT; ++i) {
root[i] = (void *)(*make)(maxtreeDEPTH, ap);
@ -151,10 +175,23 @@ static void test_trees(const char *name, mps_arena_t arena, mps_ap_t ap,
while (finals < object_count && collections < collectionCOUNT) {
mps_word_t final_this_time = 0;
printf("Collecting...");
(void)fflush(stdout);
die(mps_arena_collect(arena), "collect");
printf(" Done.\n");
switch (mode) {
default:
case ModePARK:
printf("Collecting...");
(void)fflush(stdout);
die(mps_arena_collect(arena), "collect");
printf(" Done.\n");
break;
case ModePOLL:
mps_arena_release(arena);
printf("Allocating...");
(void)fflush(stdout);
object_alloc = 0;
while (object_alloc < 1000 && !mps_message_poll(arena))
(void)DYLAN_INT(object_alloc++);
break;
}
++ collections;
while (mps_message_poll(arena)) {
mps_message_t message;
@ -170,10 +207,14 @@ static void test_trees(const char *name, mps_arena_t arena, mps_ap_t ap,
" of %"PRIuLONGEST"\n", (ulongest_t)final_this_time,
(ulongest_t)finals, (ulongest_t)object_count);
}
cdie(finals == object_count, "Not all objects were finalized.");
if (finals != object_count)
error("Not all objects were finalized for %s in mode %s.",
BufferOfAP(ap)->pool->class->name,
mode == ModePOLL ? "POLL" : "PARK");
}
static void *test(mps_arena_t arena, mps_class_t pool_class)
static void test_pool(int mode, mps_arena_t arena, mps_chain_t chain,
mps_class_t pool_class)
{
mps_ap_t ap;
mps_fmt_t fmt;
@ -182,10 +223,13 @@ static void *test(mps_arena_t arena, mps_class_t pool_class)
die(mps_fmt_create_A(&fmt, arena, dylan_fmt_A()), "fmt_create\n");
MPS_ARGS_BEGIN(args) {
/* Allocate into generation 0 so that they get finalized quickly. */
MPS_ARGS_ADD(args, MPS_KEY_GEN, 0);
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, fmt);
MPS_ARGS_ADD(args, MPS_KEY_AWL_FIND_DEPENDENT, test_awl_find_dependent);
if (mode == ModePOLL) {
MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
MPS_ARGS_ADD(args, MPS_KEY_GEN, 1);
}
if (pool_class == mps_class_awl())
MPS_ARGS_ADD(args, MPS_KEY_AWL_FIND_DEPENDENT, test_awl_find_dependent);
die(mps_pool_create_k(&pool, arena, pool_class, args),
"pool_create\n");
} MPS_ARGS_END(args);
@ -194,19 +238,25 @@ static void *test(mps_arena_t arena, mps_class_t pool_class)
"root_create\n");
die(mps_ap_create(&ap, pool, mps_rank_exact()), "ap_create\n");
mps_message_type_enable(arena, mps_message_type_finalization());
mps_arena_park(arena);
test_trees("numbered", arena, ap, make_numbered_tree, register_numbered_tree);
test_trees("indirect", arena, ap, make_indirect_tree, register_indirect_tree);
test_trees(mode, "numbered", arena, ap, make_numbered_tree,
register_numbered_tree);
test_trees(mode, "indirect", arena, ap, make_indirect_tree,
register_indirect_tree);
mps_ap_destroy(ap);
mps_root_destroy(mps_root);
mps_pool_destroy(pool);
mps_fmt_destroy(fmt);
}
return NULL;
static void test_mode(int mode, mps_arena_t arena, mps_chain_t chain)
{
test_pool(mode, arena, chain, mps_class_amc());
test_pool(mode, arena, chain, mps_class_amcz());
test_pool(mode, arena, chain, mps_class_ams());
/* test_pool(mode, arena, chain, mps_class_lo()); TODO: job003773 */
/* test_pool(mode, arena, chain, mps_class_awl()); TODO: job003772 */
}
@ -214,19 +264,28 @@ int main(int argc, char *argv[])
{
mps_arena_t arena;
mps_thr_t thread;
mps_chain_t chain;
mps_gen_param_s params[2];
size_t gens = 2;
size_t i;
testlib_init(argc, argv);
die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
"arena_create\n");
mps_message_type_enable(arena, mps_message_type_finalization());
die(mps_thread_reg(&thread, arena), "thread_reg\n");
for (i = 0; i < gens; ++i) {
params[i].mps_capacity = 1;
params[i].mps_mortality = 0.5;
}
die(mps_chain_create(&chain, arena, gens, params), "chain_create\n");
test(arena, mps_class_amc());
test(arena, mps_class_amcz());
test(arena, mps_class_ams());
test(arena, mps_class_awl());
/* TODO: test(arena, mps_class_lo()); */
test_mode(ModePOLL, arena, chain);
test_mode(ModePARK, arena, NULL);
mps_arena_park(arena);
mps_chain_destroy(chain);
mps_thread_dereg(thread);
mps_arena_destroy(arena);

69
mps/code/fmtscheme.c
View file

@ -44,86 +44,86 @@ obj_t scheme_make_bool(int condition)
return condition ? obj_true : obj_false;
}
obj_t scheme_make_pair(obj_t car, obj_t cdr)
obj_t scheme_make_pair(mps_ap_t ap, obj_t car, obj_t cdr)
{
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(sizeof(pair_s));
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_pair");
obj = addr;
obj->pair.type = TYPE_PAIR;
CAR(obj) = car;
CDR(obj) = cdr;
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_integer(long integer)
obj_t scheme_make_integer(mps_ap_t ap, long integer)
{
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(sizeof(integer_s));
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_integer");
obj = addr;
obj->integer.type = TYPE_INTEGER;
obj->integer.integer = integer;
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_symbol(size_t length, char string[])
obj_t scheme_make_symbol(mps_ap_t ap, size_t length, char string[])
{
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(offsetof(symbol_s, string) + length+1);
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_symbol");
obj = addr;
obj->symbol.type = TYPE_SYMBOL;
obj->symbol.length = length;
memcpy(obj->symbol.string, string, length+1);
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_string(size_t length, char string[])
obj_t scheme_make_string(mps_ap_t ap, size_t length, char string[])
{
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(offsetof(string_s, string) + length+1);
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_string");
obj = addr;
obj->string.type = TYPE_STRING;
obj->string.length = length;
if (string) memcpy(obj->string.string, string, length+1);
else memset(obj->string.string, 0, length+1);
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_special(char *string)
obj_t scheme_make_special(mps_ap_t ap, char *string)
{
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(sizeof(special_s));
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_special");
obj = addr;
obj->special.type = TYPE_SPECIAL;
obj->special.name = string;
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_operator(char *name,
obj_t scheme_make_operator(mps_ap_t ap, char *name,
entry_t entry, obj_t arguments,
obj_t body, obj_t env, obj_t op_env)
{
@ -131,7 +131,7 @@ obj_t scheme_make_operator(char *name,
mps_addr_t addr;
size_t size = ALIGN_OBJ(sizeof(operator_s));
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_operator");
obj = addr;
obj->operator.type = TYPE_OPERATOR;
@ -141,70 +141,70 @@ obj_t scheme_make_operator(char *name,
obj->operator.body = body;
obj->operator.env = env;
obj->operator.op_env = op_env;
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_port(obj_t name, FILE *stream)
obj_t scheme_make_port(mps_ap_t ap, obj_t name, FILE *stream)
{
mps_addr_t port_ref;
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(sizeof(port_s));
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_port");
obj = addr;
obj->port.type = TYPE_PORT;
obj->port.name = name;
obj->port.stream = stream;
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
port_ref = obj;
mps_finalize(scheme_arena, &port_ref);
return obj;
}
obj_t scheme_make_character(char c)
obj_t scheme_make_character(mps_ap_t ap, char c)
{
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(sizeof(character_s));
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_character");
obj = addr;
obj->character.type = TYPE_CHARACTER;
obj->character.c = c;
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_vector(size_t length, obj_t fill)
obj_t scheme_make_vector(mps_ap_t ap, size_t length, obj_t fill)
{
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(offsetof(vector_s, vector) + length * sizeof(obj_t));
do {
size_t i;
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_vector");
obj = addr;
obj->vector.type = TYPE_VECTOR;
obj->vector.length = length;
for(i = 0; i < length; ++i)
obj->vector.vector[i] = fill;
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_buckets(size_t length)
obj_t scheme_make_buckets(mps_ap_t ap, size_t length)
{
obj_t obj;
mps_addr_t addr;
size_t size = ALIGN_OBJ(offsetof(buckets_s, bucket) + length * sizeof(obj->buckets.bucket[0]));
do {
size_t i;
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_buckets");
obj = addr;
obj->buckets.type = TYPE_BUCKETS;
@ -215,27 +215,27 @@ obj_t scheme_make_buckets(size_t length)
obj->buckets.bucket[i].key = NULL;
obj->buckets.bucket[i].value = NULL;
}
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
return obj;
}
obj_t scheme_make_table(size_t length, hash_t hashf, cmp_t cmpf)
obj_t scheme_make_table(mps_ap_t ap, size_t length, hash_t hashf, cmp_t cmpf)
{
obj_t obj;
mps_addr_t addr;
size_t l, size = ALIGN_OBJ(sizeof(table_s));
do {
mps_res_t res = mps_reserve(&addr, obj_ap, size);
mps_res_t res = mps_reserve(&addr, ap, size);
if (res != MPS_RES_OK) error("out of memory in make_table");
obj = addr;
obj->table.type = TYPE_TABLE;
obj->table.buckets = NULL;
} while(!mps_commit(obj_ap, addr, size));
} while(!mps_commit(ap, addr, size));
obj->table.hash = hashf;
obj->table.cmp = cmpf;
/* round up to next power of 2 */
for(l = 1; l < length; l *= 2);
obj->table.buckets = scheme_make_buckets(l);
obj->table.buckets = scheme_make_buckets(ap, l);
mps_ld_reset(&obj->table.ld, scheme_arena);
return obj;
}
@ -452,7 +452,6 @@ void scheme_fmt(mps_fmt_t *fmt)
MPS_ARGS_ADD(args, MPS_KEY_FMT_FWD, obj_fwd);
MPS_ARGS_ADD(args, MPS_KEY_FMT_ISFWD, obj_isfwd);
MPS_ARGS_ADD(args, MPS_KEY_FMT_PAD, obj_pad);
MPS_ARGS_DONE(args);
res = mps_fmt_create_k(fmt, scheme_arena, args);
} MPS_ARGS_END(args);
if (res != MPS_RES_OK) error("Couldn't create obj format");

26
mps/code/fmtscheme.h
View file

@ -168,18 +168,20 @@ typedef union obj_u {
extern obj_t scheme_make_bool(int condition);
extern obj_t scheme_make_pair(obj_t car, obj_t cdr);
extern obj_t scheme_make_integer(long integer);
extern obj_t scheme_make_symbol(size_t length, char string[]);
extern obj_t scheme_make_string(size_t length, char string[]);
extern obj_t scheme_make_special(char *string);
extern obj_t scheme_make_operator(char *name, entry_t entry, obj_t arguments,
obj_t body, obj_t env, obj_t op_env);
extern obj_t scheme_make_port(obj_t name, FILE *stream);
extern obj_t scheme_make_character(char c);
extern obj_t scheme_make_vector(size_t length, obj_t fill);
extern obj_t scheme_make_buckets(size_t length);
extern obj_t scheme_make_table(size_t length, hash_t hashf, cmp_t cmpf);
extern obj_t scheme_make_pair(mps_ap_t ap, obj_t car, obj_t cdr);
extern obj_t scheme_make_integer(mps_ap_t ap, long integer);
extern obj_t scheme_make_symbol(mps_ap_t ap, size_t length, char string[]);
extern obj_t scheme_make_string(mps_ap_t ap, size_t length, char string[]);
extern obj_t scheme_make_special(mps_ap_t ap, char *string);
extern obj_t scheme_make_operator(mps_ap_t ap, char *name, entry_t entry,
obj_t arguments, obj_t body, obj_t env,
obj_t op_env);
extern obj_t scheme_make_port(mps_ap_t ap, obj_t name, FILE *stream);
extern obj_t scheme_make_character(mps_ap_t ap, char c);
extern obj_t scheme_make_vector(mps_ap_t ap, size_t length, obj_t fill);
extern obj_t scheme_make_buckets(mps_ap_t ap, size_t length);
extern obj_t scheme_make_table(mps_ap_t ap, size_t length, hash_t hashf,
cmp_t cmpf);
extern void scheme_fmt(mps_fmt_t *fmt);
extern mps_arena_t scheme_arena;

5
mps/code/freelist.c
View file

@ -1,7 +1,7 @@
/* freelist.c: FREE LIST ALLOCATOR IMPLEMENTATION
*
* $Id$
* Copyright (c) 2013 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2013-2014 Ravenbrook Limited. See end of file for license.
*
* .sources: <design/freelist/>.
*/
@ -93,6 +93,7 @@ static Addr FreelistBlockLimit(Freelist fl, FreelistBlock block)
/* FreelistBlockCheck -- check a block. */
ATTRIBUTE_UNUSED
static Bool FreelistBlockCheck(FreelistBlock block)
{
CHECKL(block != NULL);
@ -776,7 +777,7 @@ DEFINE_LAND_CLASS(FreelistLandClass, class)
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2013 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2013-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

2
mps/code/gc.gmk
View file

@ -41,7 +41,7 @@ CFLAGSCOMPILERLAX :=
# If interrupted, this is liable to leave a zero-length file behind.
define gendep
$(SHELL) -ec "$(CC) $(CFLAGS) -MM $< | \
$(SHELL) -ec "$(CC) $(CFLAGSSTRICT) -MM $< | \
sed '/:/s!$*.o!$(@D)/& $(@D)/$*.d!' > $@"
[ -s $@ ] || rm -f $@
endef

1
mps/code/gcbench.c
View file

@ -243,6 +243,7 @@ static void arena_setup(gcthread_fn_t fn,
RESMUST(mps_pool_create_k(&pool, arena, pool_class, args));
} MPS_ARGS_END(args);
watch(fn, name);
mps_arena_park(arena);
mps_pool_destroy(pool);
mps_fmt_destroy(format);
if (ngen > 0)

48
mps/code/global.c
View file

@ -37,10 +37,6 @@ static Bool arenaRingInit = FALSE;
static RingStruct arenaRing; /* <design/arena/#static.ring> */
static Serial arenaSerial; /* <design/arena/#static.serial> */
/* forward declarations */
void arenaEnterLock(Arena, int);
void arenaLeaveLock(Arena, int);
/* arenaClaimRingLock, arenaReleaseRingLock -- lock/release the arena ring
*
@ -431,6 +427,10 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
AVERT(Globals, arenaGlobals);
/* Park the arena before destroying the default chain, to ensure
* that there are no traces using that chain. */
ArenaPark(arenaGlobals);
arena = GlobalsArena(arenaGlobals);
arenaDenounce(arena);
@ -520,26 +520,15 @@ Ring GlobalsRememberedSummaryRing(Globals global)
/* ArenaEnter -- enter the state where you can look at the arena */
/* TODO: The THREAD_SINGLE and PROTECTION_NONE build configs aren't regularly
tested, though they might well be useful for embedded custom targets.
Should test them. RB 2012-09-03 */
#if defined(THREAD_SINGLE) && defined(PROTECTION_NONE)
void (ArenaEnter)(Arena arena)
{
/* Don't need to lock, just check. */
AVERT(Arena, arena);
ArenaEnter(arena);
}
#else
void ArenaEnter(Arena arena)
{
arenaEnterLock(arena, 0);
}
#endif
/* The recursive argument specifies whether to claim the lock
recursively or not. */
void arenaEnterLock(Arena arena, int recursive)
void ArenaEnterLock(Arena arena, Bool recursive)
{
Lock lock;
@ -574,25 +563,18 @@ void arenaEnterLock(Arena arena, int recursive)
void ArenaEnterRecursive(Arena arena)
{
arenaEnterLock(arena, 1);
ArenaEnterLock(arena, TRUE);
}
/* ArenaLeave -- leave the state where you can look at MPM data structures */
#if defined(THREAD_SINGLE) && defined(PROTECTION_NONE)
void (ArenaLeave)(Arena arena)
{
/* Don't need to lock, just check. */
AVERT(Arena, arena);
ArenaLeave(arena);
}
#else
void ArenaLeave(Arena arena)
{
arenaLeaveLock(arena, 0);
}
#endif
void arenaLeaveLock(Arena arena, int recursive)
void ArenaLeaveLock(Arena arena, Bool recursive)
{
Lock lock;
@ -616,7 +598,7 @@ void arenaLeaveLock(Arena arena, int recursive)
void ArenaLeaveRecursive(Arena arena)
{
arenaLeaveLock(arena, 1);
ArenaLeaveLock(arena, TRUE);
}
/* mps_exception_info -- pointer to exception info
@ -717,14 +699,7 @@ Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context)
* series of manual steps for looking around. This might be worthwhile
* if we introduce background activities other than tracing. */
#ifdef MPS_PROD_EPCORE
void (ArenaPoll)(Globals globals)
{
/* Don't poll, just check. */
AVERT(Globals, globals);
}
#else
void ArenaPoll(Globals globals)
{
Arena arena;
Clock start;
@ -779,7 +754,6 @@ void ArenaPoll(Globals globals)
globals->insidePoll = FALSE;
}
#endif
/* Work out whether we have enough time here to collect the world,
* and whether much time has passed since the last time we did that
@ -1140,7 +1114,7 @@ void ArenaSetEmergency(Arena arena, Bool emergency)
AVERT(Arena, arena);
AVERT(Bool, emergency);
EVENT2(ArenaSetEmergency, arena, BOOL(emergency));
EVENT2(ArenaSetEmergency, arena, BOOLOF(emergency));
arena->emergency = emergency;
}

4
mps/code/ll.gmk
View file

@ -10,7 +10,7 @@
# common makefile fragment (<code/comm.gmk>) requires.
CC = clang
CFLAGSDEBUG = -O -g3
CFLAGSDEBUG = -O0 -g3
CFLAGSOPT = -O2 -g3
CFLAGSCOMPILER := \
-pedantic \
@ -46,7 +46,7 @@ CFLAGSCOMPILERLAX :=
# If interrupted, this is liable to leave a zero-length file behind.
define gendep
$(SHELL) -ec "$(CC) $(CFLAGS) -MM $< | \
$(SHELL) -ec "$(CC) $(CFLAGSSTRICT) -MM $< | \
sed '/:/s!$*.o!$(@D)/& $(@D)/$*.d!' > $@"
[ -s $@ ] || rm -f $@
endef

17
mps/code/lock.h
View file

@ -85,9 +85,6 @@
#define LockSig ((Sig)0x51970CC9) /* SIGnature LOCK */
#if defined(THREAD_MULTI)
/* LockSize -- Return the size of a LockStruct
*
* Supports allocation of locks.
@ -198,9 +195,9 @@ extern void LockClaimGlobal(void);
extern void LockReleaseGlobal(void);
#elif defined(THREAD_SINGLE)
#if defined(LOCK)
/* Nothing to do: functions declared in all lock configurations. */
#elif defined(LOCK_NONE)
#define LockSize() MPS_PF_ALIGN
#define LockInit(lock) UNUSED(lock)
#define LockFinish(lock) UNUSED(lock)
@ -213,13 +210,9 @@ extern void LockReleaseGlobal(void);
#define LockReleaseGlobalRecursive()
#define LockClaimGlobal()
#define LockReleaseGlobal()
#else
#error "No threading defined."
#endif
#error "No lock configuration."
#endif /* LOCK */
#endif /* lock_h */

24
mps/code/lockix.c
View file

@ -58,7 +58,7 @@ typedef struct LockStruct {
/* LockSize -- size of a LockStruct */
size_t LockSize(void)
size_t (LockSize)(void)
{
return sizeof(LockStruct);
}
@ -66,7 +66,7 @@ size_t LockSize(void)
/* LockCheck -- check a lock */
Bool LockCheck(Lock lock)
Bool (LockCheck)(Lock lock)
{
CHECKS(Lock, lock);
/* While claims can't be very large, I don't dare to put a limit on it. */
@ -77,7 +77,7 @@ Bool LockCheck(Lock lock)
/* LockInit -- initialize a lock */
void LockInit(Lock lock)
void (LockInit)(Lock lock)
{
pthread_mutexattr_t attr;
int res;
@ -99,7 +99,7 @@ void LockInit(Lock lock)
/* LockFinish -- finish a lock */
void LockFinish(Lock lock)
void (LockFinish)(Lock lock)
{
int res;
@ -114,7 +114,7 @@ void LockFinish(Lock lock)
/* LockClaim -- claim a lock (non-recursive) */
void LockClaim(Lock lock)
void (LockClaim)(Lock lock)
{
int res;
@ -133,7 +133,7 @@ void LockClaim(Lock lock)
/* LockReleaseMPM -- release a lock (non-recursive) */
void LockReleaseMPM(Lock lock)
void (LockReleaseMPM)(Lock lock)
{
int res;
@ -148,7 +148,7 @@ void LockReleaseMPM(Lock lock)
/* LockClaimRecursive -- claim a lock (recursive) */
void LockClaimRecursive(Lock lock)
void (LockClaimRecursive)(Lock lock)
{
int res;
@ -168,7 +168,7 @@ void LockClaimRecursive(Lock lock)
/* LockReleaseRecursive -- release a lock (recursive) */
void LockReleaseRecursive(Lock lock)
void (LockReleaseRecursive)(Lock lock)
{
int res;
@ -203,7 +203,7 @@ static void globalLockInit(void)
/* LockClaimGlobalRecursive -- claim the global recursive lock */
void LockClaimGlobalRecursive(void)
void (LockClaimGlobalRecursive)(void)
{
int res;
@ -216,7 +216,7 @@ void LockClaimGlobalRecursive(void)
/* LockReleaseGlobalRecursive -- release the global recursive lock */
void LockReleaseGlobalRecursive(void)
void (LockReleaseGlobalRecursive)(void)
{
LockReleaseRecursive(globalRecLock);
}
@ -224,7 +224,7 @@ void LockReleaseGlobalRecursive(void)
/* LockClaimGlobal -- claim the global non-recursive lock */
void LockClaimGlobal(void)
void (LockClaimGlobal)(void)
{
int res;
@ -237,7 +237,7 @@ void LockClaimGlobal(void)
/* LockReleaseGlobal -- release the global non-recursive lock */
void LockReleaseGlobal(void)
void (LockReleaseGlobal)(void)
{
LockReleaseMPM(globalLock);
}

24
mps/code/lockli.c
View file

@ -72,7 +72,7 @@ typedef struct LockStruct {
/* LockSize -- size of a LockStruct */
size_t LockSize(void)
size_t (LockSize)(void)
{
return sizeof(LockStruct);
}
@ -80,7 +80,7 @@ size_t LockSize(void)
/* LockCheck -- check a lock */
Bool LockCheck(Lock lock)
Bool (LockCheck)(Lock lock)
{
CHECKS(Lock, lock);
/* While claims can't be very large, I don't dare to put a limit on it. */
@ -91,7 +91,7 @@ Bool LockCheck(Lock lock)
/* LockInit -- initialize a lock */
void LockInit(Lock lock)
void (LockInit)(Lock lock)
{
pthread_mutexattr_t attr;
int res;
@ -113,7 +113,7 @@ void LockInit(Lock lock)
/* LockFinish -- finish a lock */
void LockFinish(Lock lock)
void (LockFinish)(Lock lock)
{
int res;
@ -128,7 +128,7 @@ void LockFinish(Lock lock)
/* LockClaim -- claim a lock (non-recursive) */
void LockClaim(Lock lock)
void (LockClaim)(Lock lock)
{
int res;
@ -147,7 +147,7 @@ void LockClaim(Lock lock)
/* LockReleaseMPM -- release a lock (non-recursive) */
void LockReleaseMPM(Lock lock)
void (LockReleaseMPM)(Lock lock)
{
int res;
@ -162,7 +162,7 @@ void LockReleaseMPM(Lock lock)
/* LockClaimRecursive -- claim a lock (recursive) */
void LockClaimRecursive(Lock lock)
void (LockClaimRecursive)(Lock lock)
{
int res;
@ -182,7 +182,7 @@ void LockClaimRecursive(Lock lock)
/* LockReleaseRecursive -- release a lock (recursive) */
void LockReleaseRecursive(Lock lock)
void (LockReleaseRecursive)(Lock lock)
{
int res;
@ -217,7 +217,7 @@ static void globalLockInit(void)
/* LockClaimGlobalRecursive -- claim the global recursive lock */
void LockClaimGlobalRecursive(void)
void (LockClaimGlobalRecursive)(void)
{
int res;
@ -230,7 +230,7 @@ void LockClaimGlobalRecursive(void)
/* LockReleaseGlobalRecursive -- release the global recursive lock */
void LockReleaseGlobalRecursive(void)
void (LockReleaseGlobalRecursive)(void)
{
LockReleaseRecursive(globalRecLock);
}
@ -238,7 +238,7 @@ void LockReleaseGlobalRecursive(void)
/* LockClaimGlobal -- claim the global non-recursive lock */
void LockClaimGlobal(void)
void (LockClaimGlobal)(void)
{
int res;
@ -251,7 +251,7 @@ void LockClaimGlobal(void)
/* LockReleaseGlobal -- release the global non-recursive lock */
void LockReleaseGlobal(void)
void (LockReleaseGlobal)(void)
{
LockReleaseMPM(globalLock);
}

24
mps/code/lockw3.c
View file

@ -40,18 +40,18 @@ typedef struct LockStruct {
} LockStruct;
size_t LockSize(void)
size_t (LockSize)(void)
{
return sizeof(LockStruct);
}
Bool LockCheck(Lock lock)
Bool (LockCheck)(Lock lock)
{
CHECKS(Lock, lock);
return TRUE;
}
void LockInit(Lock lock)
void (LockInit)(Lock lock)
{
AVER(lock != NULL);
lock->claims = 0;
@ -60,7 +60,7 @@ void LockInit(Lock lock)
AVERT(Lock, lock);
}
void LockFinish(Lock lock)
void (LockFinish)(Lock lock)
{
AVERT(Lock, lock);
/* Lock should not be finished while held */
@ -69,7 +69,7 @@ void LockFinish(Lock lock)
lock->sig = SigInvalid;
}
void LockClaim(Lock lock)
void (LockClaim)(Lock lock)
{
AVERT(Lock, lock);
EnterCriticalSection(&lock->cs);
@ -79,7 +79,7 @@ void LockClaim(Lock lock)
lock->claims = 1;
}
void LockReleaseMPM(Lock lock)
void (LockReleaseMPM)(Lock lock)
{
AVERT(Lock, lock);
AVER(lock->claims == 1); /* The lock should only be held once */
@ -87,7 +87,7 @@ void LockReleaseMPM(Lock lock)
LeaveCriticalSection(&lock->cs);
}
void LockClaimRecursive(Lock lock)
void (LockClaimRecursive)(Lock lock)
{
AVERT(Lock, lock);
EnterCriticalSection(&lock->cs);
@ -95,7 +95,7 @@ void LockClaimRecursive(Lock lock)
AVER(lock->claims > 0);
}
void LockReleaseRecursive(Lock lock)
void (LockReleaseRecursive)(Lock lock)
{
AVERT(Lock, lock);
AVER(lock->claims > 0);
@ -129,27 +129,27 @@ static void lockEnsureGlobalLock(void)
}
}
void LockClaimGlobalRecursive(void)
void (LockClaimGlobalRecursive)(void)
{
lockEnsureGlobalLock();
AVER(globalLockInit);
LockClaimRecursive(globalRecLock);
}
void LockReleaseGlobalRecursive(void)
void (LockReleaseGlobalRecursive)(void)
{
AVER(globalLockInit);
LockReleaseRecursive(globalRecLock);
}
void LockClaimGlobal(void)
void (LockClaimGlobal)(void)
{
lockEnsureGlobalLock();
AVER(globalLockInit);
LockClaim(globalLock);
}
void LockReleaseGlobal(void)
void (LockReleaseGlobal)(void)
{
AVER(globalLockInit);
LockReleaseMPM(globalLock);

103
mps/code/locus.c
View file

@ -80,6 +80,7 @@ void SegPrefExpress(SegPref pref, SegPrefKind kind, void *p)
/* GenDescCheck -- check a GenDesc */
ATTRIBUTE_UNUSED
static Bool GenDescCheck(GenDesc gen)
{
CHECKS(GenDesc, gen);
@ -211,6 +212,7 @@ void ChainDestroy(Chain chain)
size_t i;
AVERT(Chain, chain);
AVER(chain->activeTraces == TraceSetEMPTY);
arena = chain->arena; genCount = chain->genCount;
RingRemove(&chain->chainRing);
@ -287,13 +289,21 @@ Res ChainAlloc(Seg *segReturn, Chain chain, Serial genNr, SegClass class,
double ChainDeferral(Chain chain)
{
double time = DBL_MAX;
size_t i;
AVERT(Chain, chain);
if (chain->activeTraces != TraceSetEMPTY)
return DBL_MAX;
else
return chain->gens[0].capacity * 1024.0
- (double)GenDescNewSize(&chain->gens[0]);
if (chain->activeTraces == TraceSetEMPTY) {
for (i = 0; i < chain->genCount; ++i) {
double genTime = chain->gens[i].capacity * 1024.0
- (double)GenDescNewSize(&chain->gens[i]);
if (genTime < time)
time = genTime;
}
}
return time;
}
@ -306,7 +316,7 @@ double ChainDeferral(Chain chain)
Res ChainCondemnAuto(double *mortalityReturn, Chain chain, Trace trace)
{
Res res;
Serial topCondemnedGenSerial, currGenSerial;
size_t topCondemnedGen, i;
GenDesc gen;
ZoneSet condemnedSet = ZoneSetEMPTY;
Size condemnedSize = 0, survivorSize = 0, genNewSize, genTotalSize;
@ -314,33 +324,39 @@ Res ChainCondemnAuto(double *mortalityReturn, Chain chain, Trace trace)
AVERT(Chain, chain);
AVERT(Trace, trace);
/* Find lowest gen within its capacity, set topCondemnedGenSerial to the */
/* preceeding one. */
currGenSerial = 0;
gen = &chain->gens[0];
AVERT(GenDesc, gen);
genNewSize = GenDescNewSize(gen);
do { /* At this point, we've decided to collect currGenSerial. */
topCondemnedGenSerial = currGenSerial;
/* Find the highest generation that's over capacity. We will condemn
* this and all lower generations in the chain. */
topCondemnedGen = chain->genCount;
for (;;) {
/* It's an error to call this function unless some generation is
* over capacity as reported by ChainDeferral. */
AVER(topCondemnedGen > 0);
if (topCondemnedGen == 0)
return ResFAIL;
-- topCondemnedGen;
gen = &chain->gens[topCondemnedGen];
AVERT(GenDesc, gen);
genNewSize = GenDescNewSize(gen);
if (genNewSize >= gen->capacity * (Size)1024)
break;
}
/* At this point, we've decided to condemn topCondemnedGen and all
* lower generations. */
for (i = 0; i <= topCondemnedGen; ++i) {
gen = &chain->gens[i];
AVERT(GenDesc, gen);
condemnedSet = ZoneSetUnion(condemnedSet, gen->zones);
genTotalSize = GenDescTotalSize(gen);
genNewSize = GenDescNewSize(gen);
condemnedSize += genTotalSize;
survivorSize += (Size)(genNewSize * (1.0 - gen->mortality))
/* predict survivors will survive again */
+ (genTotalSize - genNewSize);
/* is there another one to consider? */
currGenSerial += 1;
if (currGenSerial >= chain->genCount)
break; /* reached the top */
gen = &chain->gens[currGenSerial];
AVERT(GenDesc, gen);
genNewSize = GenDescNewSize(gen);
} while (genNewSize >= gen->capacity * (Size)1024);
}
AVER(condemnedSet != ZoneSetEMPTY || condemnedSize == 0);
EVENT3(ChainCondemnAuto, chain, topCondemnedGenSerial, chain->genCount);
UNUSED(topCondemnedGenSerial); /* only used for EVENT */
EVENT3(ChainCondemnAuto, chain, topCondemnedGen, chain->genCount);
/* Condemn everything in these zones. */
if (condemnedSet != ZoneSetEMPTY) {
@ -354,41 +370,6 @@ Res ChainCondemnAuto(double *mortalityReturn, Chain chain, Trace trace)
}
/* ChainCondemnAll -- condemn everything in the chain */
Res ChainCondemnAll(Chain chain, Trace trace)
{
Ring node, nextNode;
Bool haveWhiteSegs = FALSE;
Res res;
/* Condemn every segment in every pool using this chain. */
/* Finds the pools by iterating over the PoolGens in gen 0. */
RING_FOR(node, &chain->gens[0].locusRing, nextNode) {
PoolGen nursery = RING_ELT(PoolGen, genRing, node);
Pool pool = nursery->pool;
Ring segNode, nextSegNode;
AVERT(Pool, pool);
AVER(PoolHasAttr(pool, AttrGC));
RING_FOR(segNode, PoolSegRing(pool), nextSegNode) {
Seg seg = SegOfPoolRing(segNode);
res = TraceAddWhite(trace, seg);
if (res != ResOK)
goto failBegin;
haveWhiteSegs = TRUE;
}
}
return ResOK;
failBegin:
AVER(!haveWhiteSegs); /* Would leave white sets inconsistent. */
return res;
}
/* ChainStartGC -- called to notify start of GC for this chain */
void ChainStartGC(Chain chain, Trace trace)
@ -416,9 +397,11 @@ void ChainEndGC(Chain chain, Trace trace)
Res PoolGenInit(PoolGen gen, Chain chain, Serial nr, Pool pool)
{
/* Can't check gen, because it's not been initialized. */
AVER(gen != NULL);
AVERT(Chain, chain);
AVER(nr <= chain->genCount);
AVERT(Pool, pool);
AVER(PoolHasAttr(pool, AttrGC));
gen->nr = nr;
gen->pool = pool;

4
mps/code/misc.h
View file

@ -13,8 +13,6 @@
#ifndef misc_h
#define misc_h
#include <stddef.h>
typedef int Bool; /* <design/type/#bool> */
enum BoolEnum {
@ -178,7 +176,7 @@ typedef const struct SrcIdStruct {
*/
#define BITFIELD(type, value, width) ((type)value & (((type)1 << (width)) - 1))
#define BOOL(v) BITFIELD(unsigned, (v), 1)
#define BOOLOF(v) BITFIELD(unsigned, (v), 1)
/* Bit Sets -- sets of integers in [0,N-1].

33
mps/code/mpm.h
View file

@ -519,24 +519,27 @@ extern Ring GlobalsRememberedSummaryRing(Globals);
#define ArenaGreyRing(arena, rank) (&(arena)->greyRing[rank])
#define ArenaPoolRing(arena) (&ArenaGlobals(arena)->poolRing)
extern void ArenaEnterLock(Arena arena, Bool recursive);
extern void ArenaLeaveLock(Arena arena, Bool recursive);
extern void (ArenaEnter)(Arena arena);
extern void (ArenaLeave)(Arena arena);
extern void (ArenaPoll)(Globals globals);
#if defined(THREAD_SINGLE) && defined(PROTECTION_NONE)
#if defined(SHIELD)
#define ArenaEnter(arena) ArenaEnterLock(arena, FALSE)
#define ArenaLeave(arena) ArenaLeaveLock(arena, FALSE)
#elif defined(SHIELD_NONE)
#define ArenaEnter(arena) UNUSED(arena)
#define ArenaLeave(arena) UNUSED(arena)
#endif
#define ArenaLeave(arena) AVER(arena->busyTraces == TraceSetEMPTY)
#define ArenaPoll(globals) UNUSED(globals)
#else
#error "No shield configuration."
#endif /* SHIELD */
extern void ArenaEnterRecursive(Arena arena);
extern void ArenaLeaveRecursive(Arena arena);
extern void (ArenaPoll)(Globals globals);
#ifdef MPS_PROD_EPCORE
#define ArenaPoll(globals) UNUSED(globals)
#endif
/* .nogc.why: ScriptWorks doesn't use MM-provided incremental GC, so */
/* doesn't need to poll when allocating. */
extern Bool (ArenaStep)(Globals globals, double interval, double multiplier);
extern void ArenaClamp(Globals globals);
extern void ArenaRelease(Globals globals);
@ -893,7 +896,9 @@ extern void (ShieldSuspend)(Arena arena);
extern void (ShieldResume)(Arena arena);
extern void (ShieldFlush)(Arena arena);
#if defined(THREAD_SINGLE) && defined(PROTECTION_NONE)
#if defined(SHIELD)
/* Nothing to do: functions declared in all shield configurations. */
#elif defined(SHIELD_NONE)
#define ShieldRaise(arena, seg, mode) \
BEGIN UNUSED(arena); UNUSED(seg); UNUSED(mode); END
#define ShieldLower(arena, seg, mode) \
@ -907,7 +912,9 @@ extern void (ShieldFlush)(Arena arena);
#define ShieldSuspend(arena) BEGIN UNUSED(arena); END
#define ShieldResume(arena) BEGIN UNUSED(arena); END
#define ShieldFlush(arena) BEGIN UNUSED(arena); END
#endif
#else
#error "No shield configuration."
#endif /* SHIELD */
/* Protection Interface
@ -922,8 +929,6 @@ extern void (ShieldFlush)(Arena arena);
extern void ProtSetup(void);
extern void ProtSet(Addr base, Addr limit, AccessSet mode);
extern void ProtTramp(void **resultReturn, void *(*f)(void *, size_t),
void *p, size_t s);
extern void ProtSync(Arena arena);
extern Bool ProtCanStepInstruction(MutatorFaultContext context);
extern Res ProtStepInstruction(MutatorFaultContext context);

16
mps/code/mps.c
View file

@ -93,14 +93,26 @@
/* ANSI Plinth */
#if !defined(PLINTH_NONE) /* see CONFIG_PLINTH_NONE in config.h */
#if defined(PLINTH) /* see CONFIG_PLINTH_NONE in config.h */
#include "mpsliban.c"
#include "mpsioan.c"
#endif
/* Generic ("ANSI") platform */
#if defined(PLATFORM_ANSI)
#include "lockan.c" /* generic locks */
#include "than.c" /* generic threads manager */
#include "vman.c" /* malloc-based pseudo memory mapping */
#include "protan.c" /* generic memory protection */
#include "prmcan.c" /* generic protection mutator context */
#include "span.c" /* generic stack probe */
#include "ssan.c" /* generic stack scanner */
/* Mac OS X on 32-bit Intel built with Clang or GCC */
#if defined(MPS_PF_XCI3LL) || defined(MPS_PF_XCI3GC)
#elif defined(MPS_PF_XCI3LL) || defined(MPS_PF_XCI3GC)
#include "lockix.c" /* Posix locks */
#include "thxc.c" /* OS X Mach threading */

22
mps/code/mps.h
View file

@ -1,7 +1,7 @@
/* mps.h: RAVENBROOK MEMORY POOL SYSTEM C INTERFACE
*
* $Id$
* Copyright (c) 2001-2013 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
* Portions copyright (c) 2002 Global Graphics Software.
*
* THIS HEADER IS NOT DOCUMENTATION.
@ -188,9 +188,6 @@ extern const struct mps_key_s _mps_key_max_size;
extern const struct mps_key_s _mps_key_align;
#define MPS_KEY_ALIGN (&_mps_key_align)
#define MPS_KEY_ALIGN_FIELD align
extern const struct mps_key_s _mps_key_cbs_extend_by;
#define MPS_KEY_CBS_EXTEND_BY (&_mps_key_cbs_extend_by)
#define MPS_KEY_CBS_EXTEND_BY_FIELD size
extern const struct mps_key_s _mps_key_interior;
#define MPS_KEY_INTERIOR (&_mps_key_interior)
#define MPS_KEY_INTERIOR_FIELD b
@ -227,20 +224,22 @@ extern const struct mps_key_s _mps_key_fmt_class;
/* Maximum length of a keyword argument list. */
#define MPS_ARGS_MAX 32
extern void _mps_args_set_key(mps_arg_s args[MPS_ARGS_MAX], unsigned i,
mps_key_t key);
#define MPS_ARGS_BEGIN(_var) \
MPS_BEGIN \
mps_arg_s _var[MPS_ARGS_MAX]; \
unsigned _var##_i = 0; \
_var[_var##_i].key = MPS_KEY_ARGS_END; \
_mps_args_set_key(_var, _var##_i, MPS_KEY_ARGS_END); \
MPS_BEGIN
#define MPS_ARGS_ADD_FIELD(_var, _key, _field, _val) \
MPS_BEGIN \
/* TODO: AVER(_var##_i + 1 < MPS_ARGS_MAX); */ \
_var[_var##_i].key = (_key); \
_mps_args_set_key(_var, _var##_i, _key); \
_var[_var##_i].val._field = (_val); \
++_var##_i; \
_var[_var##_i].key = MPS_KEY_ARGS_END; \
_mps_args_set_key(_var, _var##_i, MPS_KEY_ARGS_END); \
MPS_END
#define MPS_ARGS_ADD(_var, _key, _val) \
@ -248,9 +247,8 @@ extern const struct mps_key_s _mps_key_fmt_class;
#define MPS_ARGS_DONE(_var) \
MPS_BEGIN \
/* TODO: AVER(_var##_i < MPS_ARGS_MAX); */ \
_var[_var##_i].key = MPS_KEY_ARGS_END; \
/* TODO: _var##_i = MPS_ARGS_MAX; */ \
_mps_args_set_key(_var, _var##_i, MPS_KEY_ARGS_END); \
_var##_i = MPS_ARGS_MAX; \
MPS_END
#define MPS_ARGS_END(_var) \
@ -812,7 +810,7 @@ extern mps_res_t _mps_fix2(mps_ss_t, mps_addr_t *);
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2013 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

76
mps/code/mps.xcodeproj/project.pbxproj
View file

@ -2654,7 +2654,7 @@
22FACEE118880983000FDBC1 /* PBXTargetDependency */,
);
name = airtest;
productName = mv2test;
productName = airtest;
productReference = 22FACEED18880983000FDBC1 /* airtest */;
productType = "com.apple.product-type.tool";
};
@ -4332,42 +4332,42 @@
2231BB5618CA97D8002D6322 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locbwcss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
2231BB5718CA97D8002D6322 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locbwcss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
2231BB5818CA97D8002D6322 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locbwcss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
2231BB6418CA97DC002D6322 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locusss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
2231BB6518CA97DC002D6322 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locusss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
2231BB6618CA97DC002D6322 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locusss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -4431,7 +4431,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = "scheme-advanced";
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@ -4439,7 +4439,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = "scheme-advanced";
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@ -4447,41 +4447,35 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = "scheme-advanced";
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
22C2ACA118BE3FEC006B3677 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = mv2test;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
22C2ACAC18BE400A006B3677 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = YES;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES;
PRODUCT_NAME = nailboardtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
22C2ACAD18BE400A006B3677 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = NO;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = NO;
PRODUCT_NAME = nailboardtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
22C2ACAE18BE400A006B3677 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = NO;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = NO;
PRODUCT_NAME = nailboardtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -4502,21 +4496,21 @@
22F846BA18F437B900982BA7 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = lockut;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
22F846BB18F437B900982BA7 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = lockut;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
22F846BC18F437B900982BA7 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = lockut;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -4537,30 +4531,17 @@
22FACEEA18880983000FDBC1 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = YES;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES;
PRODUCT_NAME = airtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
22FACEEB18880983000FDBC1 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = NO;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = NO;
PRODUCT_NAME = airtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
22FACEEC18880983000FDBC1 /* WE */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = NO;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = NO;
PRODUCT_NAME = airtest;
};
name = WE;
};
2D07B9751636FC9900DB751B /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
@ -4636,7 +4617,6 @@
3104AFF3156D37A0000A585A /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
@ -4644,7 +4624,6 @@
3104AFF4156D37A0000A585A /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
@ -4933,7 +4912,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = djbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@ -4941,7 +4920,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = djbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@ -5001,7 +4980,6 @@
318DA8D51892C0D00089718C /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
@ -5010,7 +4988,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@ -5295,7 +5272,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = djbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -5494,7 +5471,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@ -5504,7 +5480,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@ -5544,7 +5519,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = gcbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@ -5552,7 +5527,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = gcbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@ -5560,7 +5535,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = gcbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -5682,7 +5657,6 @@
buildConfigurations = (
22FACEEA18880983000FDBC1 /* Debug */,
22FACEEB18880983000FDBC1 /* Release */,
22FACEEC18880983000FDBC1 /* WE */,
22C2ACA118BE3FEC006B3677 /* RASH */,
);
defaultConfigurationIsVisible = 0;

21
mps/code/mpsi.c
View file

@ -65,6 +65,7 @@ SRCID(mpsi, "$Id$");
* .check.enum.cast: enum comparisons have to be cast to avoid a warning
* from the SunPro C compiler. See builder.sc.warn.enum. */
ATTRIBUTE_UNUSED
static Bool mpsi_check(void)
{
CHECKL(COMPATTYPE(mps_res_t, Res));
@ -1380,7 +1381,7 @@ void (mps_tramp)(void **r_o,
AVER(FUNCHECK(f));
/* Can't check p and s as they are interpreted by the client */
ProtTramp(r_o, f, p, s);
*r_o = (*f)(p, s);
}
@ -1928,6 +1929,24 @@ void mps_chain_destroy(mps_chain_t chain)
}
/* _mps_args_set_key -- set the key for a keyword argument
*
* This sets the key for the i'th keyword argument in the array args,
* with bounds checking on i. It is used by the MPS_ARGS_BEGIN,
* MPS_ARGS_ADD, and MPS_ARGS_DONE macros in mps.h.
*
* We implement this in a function here, rather than in a macro in
* mps.h, so that we can use AVER to do the bounds checking.
*/
void _mps_args_set_key(mps_arg_s args[MPS_ARGS_MAX], unsigned i,
mps_key_t key)
{
AVER(i < MPS_ARGS_MAX);
args[i].key = key;
}
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.

5
mps/code/mpsicv.c
View file

@ -21,7 +21,7 @@
#define exactRootsCOUNT 49
#define ambigRootsCOUNT 49
#define OBJECTS 200000
#define OBJECTS 100000
#define patternFREQ 100
/* objNULL needs to be odd so that it's ignored in exactRoots. */
@ -552,6 +552,8 @@ static void *test(void *arg, size_t s)
mps_free(mv, alloced_obj, 32);
alloc_v_test(mv);
mps_arena_park(arena);
mps_pool_destroy(mv);
mps_ap_destroy(ap);
mps_root_destroy(fmtRoot);
@ -589,7 +591,6 @@ int main(int argc, char *argv[])
marker, (size_t)0),
"root_create_reg");
(mps_tramp)(&r, test, arena, 0); /* non-inlined trampoline */
mps_tramp(&r, test, arena, 0);
mps_root_destroy(reg_root);
mps_thread_dereg(thread);

16
mps/code/mpsliban.c
View file

@ -61,13 +61,19 @@ int mps_lib_fputs(const char *s, mps_lib_FILE *stream)
}
static void mps_lib_assert_fail_default(const char *file,
unsigned line,
static void mps_lib_assert_fail_default(const char *file, unsigned line,
const char *condition)
{
(void)fflush(stdout); /* synchronize */
(void)fprintf(stderr, "%s:%u: MPS ASSERTION FAILED: %s\n", file, line, condition);
(void)fflush(stderr); /* make sure the message is output */
/* Synchronize with stdout. */
(void)fflush(stdout);
(void)fprintf(stderr,
"The MPS detected a problem!\n"
"%s:%u: MPS ASSERTION FAILED: %s\n"
"See the \"Assertions\" section in the reference manual:\n"
"http://ravenbrook.com/project/mps/master/manual/html/topic/error.html#assertions\n",
file, line, condition);
/* Ensure the message is output even if stderr is buffered. */
(void)fflush(stderr);
ASSERT_ABORT(); /* see config.h */
}

19
mps/code/poolamc.c
View file

@ -96,6 +96,7 @@ typedef struct amcSegStruct {
#define amcSeg2Seg(amcseg) ((Seg)(amcseg))
ATTRIBUTE_UNUSED
static Bool amcSegCheck(amcSeg amcseg)
{
CHECKS(amcSeg, amcseg);
@ -475,6 +476,7 @@ typedef struct AMCStruct { /* <design/poolamc/#struct> */
/* amcGenCheck -- check consistency of a generation structure */
ATTRIBUTE_UNUSED
static Bool amcGenCheck(amcGen gen)
{
Arena arena;
@ -524,6 +526,7 @@ typedef struct amcBufStruct {
/* amcBufCheck -- check consistency of an amcBuf */
ATTRIBUTE_UNUSED
static Bool amcBufCheck(amcBuf amcbuf)
{
CHECKS(amcBuf, amcbuf);
@ -1719,10 +1722,13 @@ static Res AMCFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
/* Since we're moving an object from one segment to another, */
/* union the greyness and the summaries together. */
grey = SegGrey(seg);
if(SegRankSet(seg) != RankSetEMPTY) /* not for AMCZ */
if(SegRankSet(seg) != RankSetEMPTY) { /* not for AMCZ */
grey = TraceSetUnion(grey, ss->traces);
SegSetSummary(toSeg, RefSetUnion(SegSummary(toSeg), SegSummary(seg)));
} else {
AVER(SegRankSet(toSeg) == RankSetEMPTY);
}
SegSetGrey(toSeg, TraceSetUnion(SegGrey(toSeg), grey));
SegSetSummary(toSeg, RefSetUnion(SegSummary(toSeg), SegSummary(seg)));
/* <design/trace/#fix.copy> */
(void)AddrCopy(newRef, ref, length); /* .exposed.seg */
@ -1867,10 +1873,13 @@ static Res AMCHeaderFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
/* Since we're moving an object from one segment to another, */
/* union the greyness and the summaries together. */
grey = SegGrey(seg);
if(SegRankSet(seg) != RankSetEMPTY) /* not for AMCZ */
if(SegRankSet(seg) != RankSetEMPTY) { /* not for AMCZ */
grey = TraceSetUnion(grey, ss->traces);
SegSetSummary(toSeg, RefSetUnion(SegSummary(toSeg), SegSummary(seg)));
} else {
AVER(SegRankSet(toSeg) == RankSetEMPTY);
}
SegSetGrey(toSeg, TraceSetUnion(SegGrey(toSeg), grey));
SegSetSummary(toSeg, RefSetUnion(SegSummary(toSeg), SegSummary(seg)));
/* <design/trace/#fix.copy> */
(void)AddrCopy(newBase, AddrSub(ref, headerSize), length); /* .exposed.seg */
@ -2445,6 +2454,8 @@ void mps_amc_apply(mps_pool_t mps_pool,
*
* See <design/poolamc/#check>.
*/
ATTRIBUTE_UNUSED
static Bool AMCCheck(AMC amc)
{
CHECKS(AMC, amc);

25
mps/code/poolams.c
View file

@ -172,9 +172,14 @@ static Res amsCreateTables(AMS ams, BT *allocReturn,
goto failWhite;
}
/* Invalidate the colour tables in checking varieties. */
AVER((BTResRange(nongreyTable, 0, length), TRUE));
AVER((BTSetRange(nonwhiteTable, 0, length), TRUE));
#if defined(AVER_AND_CHECK_ALL)
/* Invalidate the colour tables in checking varieties. The algorithm
* is designed not to depend on the initial values of these tables,
* so by invalidating them we get some checking of this.
*/
BTResRange(nongreyTable, 0, length);
BTSetRange(nonwhiteTable, 0, length);
#endif
*allocReturn = allocTable;
*nongreyReturn = nongreyTable;
@ -1032,7 +1037,19 @@ static void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
AVER(limitIndex <= amsseg->firstFree);
if (limitIndex == amsseg->firstFree) /* is it at the end? */ {
amsseg->firstFree = initIndex;
} else if (!ams->shareAllocTable || !amsseg->colourTablesInUse) {
} else if (ams->shareAllocTable && amsseg->colourTablesInUse) {
/* The nonwhiteTable is shared with allocTable and in use, so we
* mustn't start using allocTable. In this case we know: 1. the
* segment has been condemned (because colour tables are turned
* on in AMSCondemn); 2. the segment has not yet been reclaimed
* (because colour tables are turned off in AMSReclaim); 3. the
* unused portion of the buffer is black (see AMSCondemn). So we
* need to whiten the unused portion of the buffer. The
* allocTable will be turned back on (if necessary) in
* AMSReclaim, when we know that the nonwhite grains are exactly
* the allocated grains.
*/
} else {
/* start using allocTable */
amsseg->allocTableInUse = TRUE;
BTSetRange(amsseg->allocTable, 0, amsseg->firstFree);

2
mps/code/poolawl.c
View file

@ -131,6 +131,7 @@ typedef struct AWLSegStruct {
extern SegClass AWLSegClassGet(void);
ATTRIBUTE_UNUSED
static Bool AWLSegCheck(AWLSeg awlseg)
{
CHECKS(AWLSeg, awlseg);
@ -1299,6 +1300,7 @@ mps_class_t mps_class_awl(void)
/* AWLCheck -- check an AWL pool */
ATTRIBUTE_UNUSED
static Bool AWLCheck(AWL awl)
{
CHECKS(AWL, awl);

3
mps/code/poollo.c
View file

@ -79,6 +79,7 @@ DEFINE_SEG_CLASS(LOSegClass, class)
/* LOSegCheck -- check an LO segment */
ATTRIBUTE_UNUSED
static Bool LOSegCheck(LOSeg loseg)
{
CHECKS(LOSeg, loseg);
@ -184,6 +185,7 @@ static void loSegFinish(Seg seg)
}
ATTRIBUTE_UNUSED
static Count loSegBits(LOSeg loseg)
{
LO lo;
@ -805,6 +807,7 @@ mps_class_t mps_class_lo(void)
/* LOCheck -- check an LO pool */
ATTRIBUTE_UNUSED
static Bool LOCheck(LO lo)
{
CHECKS(LO, lo);

12
mps/code/poolmfs.c
View file

@ -57,18 +57,8 @@ typedef struct MFSHeaderStruct {
} HeaderStruct, *Header;
#define UNIT_MIN sizeof(HeaderStruct)
MFSInfo MFSGetInfo(void)
{
static const struct MFSInfoStruct info =
{
/* unitSizeMin */ UNIT_MIN
};
return &info;
}
Pool (MFSPool)(MFS mfs)
{
@ -136,7 +126,7 @@ static Res MFSInit(Pool pool, ArgList args)
mfs->sig = MFSSig;
AVERT(MFS, mfs);
EVENT5(PoolInitMFS, pool, arena, extendBy, BOOL(extendSelf), unitSize);
EVENT5(PoolInitMFS, pool, arena, extendBy, BOOLOF(extendSelf), unitSize);
return ResOK;
}

12
mps/code/poolmfs.h
View file

@ -2,7 +2,7 @@
*
* $Id$
*
* Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*
* The MFS pool is used to manage small fixed-size chunks of memory. It
* stores control structures in the memory it manages, rather than to one
@ -39,14 +39,6 @@ extern Bool MFSCheck(MFS mfs);
extern Pool (MFSPool)(MFS mfs);
typedef const struct MFSInfoStruct *MFSInfo;
struct MFSInfoStruct {
Size unitSizeMin; /* minimum unit size */
};
extern MFSInfo MFSGetInfo(void);
extern const struct mps_key_s _mps_key_MFSExtendSelf;
#define MFSExtendSelf (&_mps_key_MFSExtendSelf)
#define MFSExtendSelf_FIELD b
@ -63,7 +55,7 @@ extern void MFSFinishTracts(Pool pool, MFSTractVisitor visitor,
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

4
mps/code/poolmrg.c
View file

@ -125,6 +125,7 @@ typedef struct MRGStruct {
/* MRGCheck -- check an MRG pool */
ATTRIBUTE_UNUSED
static Bool MRGCheck(MRG mrg)
{
CHECKS(MRG, mrg);
@ -178,6 +179,8 @@ extern SegClass MRGRefSegClassGet(void);
* field will be NULL. This will be initialized when the reference
* segment is initialized. See <design/poolmrg/#mrgseg.link.refseg>.
*/
ATTRIBUTE_UNUSED
static Bool MRGLinkSegCheck(MRGLinkSeg linkseg)
{
Seg seg;
@ -193,6 +196,7 @@ static Bool MRGLinkSegCheck(MRGLinkSeg linkseg)
return TRUE;
}
ATTRIBUTE_UNUSED
static Bool MRGRefSegCheck(MRGRefSeg refseg)
{
Seg seg;

27
mps/code/poolmv.c
View file

@ -72,6 +72,7 @@ typedef struct MVBlockStruct {
/* MVBlockCheck -- check the consistency of a block structure */
ATTRIBUTE_UNUSED
static Bool MVBlockCheck(MVBlock block)
{
AVER(block != NULL);
@ -130,11 +131,10 @@ typedef struct MVSpanStruct {
/* MVSpanCheck -- check the consistency of a span structure */
ATTRIBUTE_UNUSED
static Bool MVSpanCheck(MVSpan span)
{
Addr addr, base, limit;
Arena arena;
Tract tract;
Addr base, limit;
CHECKS(MVSpan, span);
@ -170,13 +170,22 @@ static Bool MVSpanCheck(MVSpan span)
CHECKL(span->largest == SpanSize(span)+1);
}
/* Each tract of the span must refer to the span */
arena = PoolArena(TractPool(span->tract));
TRACT_FOR(tract, addr, arena, base, limit) {
CHECKD_NOSIG(Tract, tract);
CHECKL(TractP(tract) == (void *)span);
/* Note that even if the CHECKs are compiled away there is still a
* significant cost in looping over the tracts, hence this guard. */
#if defined(AVER_AND_CHECK_ALL)
{
Addr addr;
Arena arena;
Tract tract;
/* Each tract of the span must refer to the span */
arena = PoolArena(TractPool(span->tract));
TRACT_FOR(tract, addr, arena, base, limit) {
CHECKD_NOSIG(Tract, tract);
CHECKL(TractP(tract) == (void *)span);
}
CHECKL(addr == limit);
}
CHECKL(addr == limit);
#endif
return TRUE;
}

1
mps/code/poolmv2.c
View file

@ -377,6 +377,7 @@ static Res MVTInit(Pool pool, ArgList args)
/* MVTCheck -- validate an MVT Pool */
ATTRIBUTE_UNUSED
static Bool MVTCheck(MVT mvt)
{
CHECKS(MVT, mvt);

3
mps/code/poolmvff.c
View file

@ -525,7 +525,7 @@ static Res MVFFInit(Pool pool, ArgList args)
mvff->sig = MVFFSig;
AVERT(MVFF, mvff);
EVENT8(PoolInitMVFF, pool, arena, extendBy, avgSize, align,
BOOL(slotHigh), BOOL(arenaHigh), BOOL(firstFit));
BOOLOF(slotHigh), BOOLOF(arenaHigh), BOOLOF(firstFit));
return ResOK;
failFailoverInit:
@ -714,6 +714,7 @@ size_t mps_mvff_size(mps_pool_t mps_pool)
/* MVFFCheck -- check the consistency of an MVFF structure */
ATTRIBUTE_UNUSED
static Bool MVFFCheck(MVFF mvff)
{
CHECKS(MVFF, mvff);

3
mps/code/poolsnc.c
View file

@ -84,6 +84,7 @@ typedef struct SNCBufStruct {
/* SNCBufCheck -- check consistency of an SNCBuf */
ATTRIBUTE_UNUSED
static Bool SNCBufCheck(SNCBuf sncbuf)
{
SegBuf segbuf;
@ -214,6 +215,7 @@ typedef struct SNCSegStruct {
#define sncSegSetNext(seg, nextseg) \
((void)(SegSNCSeg(seg)->next = SegSNCSeg(nextseg)))
ATTRIBUTE_UNUSED
static Bool SNCSegCheck(SNCSeg sncseg)
{
CHECKS(SNCSeg, sncseg);
@ -696,6 +698,7 @@ mps_class_t mps_class_snc(void)
/* SNCCheck -- Check an SNC pool */
ATTRIBUTE_UNUSED
static Bool SNCCheck(SNC snc)
{
CHECKS(SNC, snc);

21
mps/code/protan.c
View file

@ -1,7 +1,7 @@
/* protan.c: ANSI MEMORY PROTECTION
*
* $Id$
* Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*
*
* DESIGN
@ -50,37 +50,22 @@ void ProtSync(Arena arena)
synced = TRUE;
if (SegFirst(&seg, arena)) {
Addr base;
do {
base = SegBase(seg);
if (SegPM(seg) != AccessSetEMPTY) { /* <design/protan/#fun.sync.seg> */
ShieldEnter(arena);
TraceSegAccess(arena, seg, SegPM(seg));
ShieldLeave(arena);
synced = FALSE;
}
} while(SegNext(&seg, arena, base));
} while(SegNext(&seg, arena, seg));
}
} while(!synced);
}
/* ProtTramp -- protection trampoline */
void ProtTramp(void **rReturn, void *(*f)(void *, size_t),
void *p, size_t s)
{
AVER(rReturn != NULL);
AVER(FUNCHECK(f));
/* Can't check p and s as they are interpreted by the client */
*(rReturn) = (*(f))(p, s);
}
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

26
mps/code/protix.c
View file

@ -1,7 +1,7 @@
/* protix.c: PROTECTION FOR UNIX
*
* $Id$
* Copyright (c) 2001,2007 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*
* Somewhat generic across different Unix systems. Shared between
* Darwin (OS X), FreeBSD, and Linux.
@ -44,9 +44,6 @@
#if !defined(MPS_OS_LI) && !defined(MPS_OS_FR) && !defined(MPS_OS_XC)
#error "protix.c is Unix-specific, currently for MPS_OS_LI FR XC"
#endif
#ifndef PROTECTION
#error "protix.c implements protection, but PROTECTION is not set"
#endif
#include <limits.h>
#include <stddef.h>
@ -114,28 +111,9 @@ void ProtSync(Arena arena)
}
/* ProtTramp -- protection trampoline
*
* The protection trampoline is trivial under Unix, as there is
* nothing that needs to be done in the dynamic context of the mutator in
* order to catch faults. (Contrast this with Win32 Structured Exception
* Handling.)
*/
void ProtTramp(void **resultReturn, void *(*f)(void *, size_t),
void *p, size_t s)
{
AVER(resultReturn != NULL);
AVER(FUNCHECK(f));
/* Can't check p and s as they are interpreted by the client */
*resultReturn = (*f)(p, s);
}
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2007 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

3
mps/code/protli.c
View file

@ -16,9 +16,6 @@
#ifndef MPS_OS_LI
#error "protli.c is Linux-specific, but MPS_OS_LI is not set"
#endif
#ifndef PROTECTION
#error "protli.c implements protection, but PROTECTION is not set"
#endif
#include <limits.h>
#include <stddef.h>

3
mps/code/protsgix.c
View file

@ -24,9 +24,6 @@
#if defined(MPS_OS_XC) && defined(MPS_ARCH_PP)
#error "protsgix.c does not work on Darwin on PowerPC. Use protxcpp.c"
#endif
#ifndef PROTECTION
#error "protsgix.c implements protection, but PROTECTION is not set"
#endif
#include <signal.h> /* for many functions */
#include <sys/types.h> /* for getpid */

25
mps/code/protw3.c
View file

@ -1,7 +1,7 @@
/* protw3.c: PROTECTION FOR WIN32
*
* $Id$
* Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*/
#include "mpm.h"
@ -12,9 +12,6 @@
#ifndef MPS_OS_W3
#error "protw3.c is Win32-specific, but MPS_OS_W3 is not set"
#endif
#ifndef PROTECTION
#error "protw3.c implements protection, but PROTECTION is not set"
#endif
#include "mpswin.h"
@ -131,27 +128,9 @@ void ProtSync(Arena arena)
}
/* ProtTramp -- wrap a mutator thread in a Structured Exception Handler filter
*
* This was the method by which we installed an exception handler on Windows
* prior to MPS 1.111. Now we are using Vectored Exception Handlers, so this
* is deprecated and just calls through to the mutator function.
*/
void ProtTramp(void **resultReturn, void *(*f)(void *, size_t),
void *p, size_t s)
{
AVER(resultReturn != NULL);
AVER(FUNCHECK(f));
/* Can't check p and s as they are interpreted by the client */
*resultReturn = f(p, s);
}
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

3
mps/code/protxc.c
View file

@ -76,9 +76,6 @@
#if !defined(MPS_OS_XC)
#error "protxc.c is OS X specific"
#endif
#if !defined(PROTECTION)
#error "protxc.c implements protection, but PROTECTION is not defined"
#endif
SRCID(protxc, "$Id$");

3
mps/code/qs.c
View file

@ -367,6 +367,7 @@ static void *go(void *p, size_t s)
qsort(list, listl, sizeof(mps_word_t), &compare);
validate();
mps_arena_park(arena);
mps_root_destroy(regroot);
mps_root_destroy(actroot);
mps_ap_destroy(ap);
@ -374,6 +375,7 @@ static void *go(void *p, size_t s)
mps_pool_destroy(mpool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_arena_release(arena);
return NULL;
}
@ -527,6 +529,7 @@ int main(int argc, char *argv[])
die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
"mps_arena_create");
mps_tramp(&r, &go, NULL, 0);
mps_arena_destroy(arena);

1
mps/code/reserv.c
View file

@ -107,6 +107,7 @@ Bool ReservoirCheck(Reservoir reservoir)
/* reservoirIsConsistent -- returns FALSE if the reservoir is corrupt */
ATTRIBUTE_UNUSED
static Bool reservoirIsConsistent(Reservoir reservoir)
{
Size alignment, size = 0;

1
mps/code/sac.c
View file

@ -32,6 +32,7 @@ static Bool sacFreeListBlockCheck(SACFreeListBlock fb)
return TRUE;
}
ATTRIBUTE_UNUSED
static Bool SACCheck(SAC sac)
{
Index i, j;

37
mps/code/seg.c
View file

@ -309,9 +309,12 @@ void SegSetSummary(Seg seg, RefSet summary)
AVERT(Seg, seg);
AVER(summary == RefSetEMPTY || SegRankSet(seg) != RankSetEMPTY);
#ifdef PROTECTION_NONE
#if defined(REMEMBERED_SET_NONE)
/* Without protection, we can't maintain the remembered set because
there are writes we don't know about. */
summary = RefSetUNIV;
#endif
if (summary != SegSummary(seg))
seg->class->setSummary(seg, summary);
}
@ -324,11 +327,12 @@ void SegSetRankAndSummary(Seg seg, RankSet rankSet, RefSet summary)
AVERT(Seg, seg);
AVERT(RankSet, rankSet);
#ifdef PROTECTION_NONE
#if defined(REMEMBERED_SET_NONE)
if (rankSet != RankSetEMPTY) {
summary = RefSetUNIV;
}
#endif
seg->class->setRankSummary(seg, rankSet, summary);
}
@ -593,7 +597,7 @@ Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi,
if (ResOK != res)
goto failMerge;
EVENT3(SegMerge, segLo, segHi, BOOL(withReservoirPermit));
EVENT3(SegMerge, segLo, segHi, BOOLOF(withReservoirPermit));
/* Deallocate segHi object */
ControlFree(arena, segHi, class->size);
AVERT(Seg, segLo);
@ -678,10 +682,8 @@ Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at,
Bool SegCheck(Seg seg)
{
Tract tract;
Arena arena;
Pool pool;
Addr addr;
Size align;
CHECKS(Seg, seg);
@ -700,16 +702,25 @@ Bool SegCheck(Seg seg)
CHECKL(AddrIsAligned(seg->limit, align));
CHECKL(seg->limit > TractBase(seg->firstTract));
/* Each tract of the segment must agree about white traces */
TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, seg->limit) {
Seg trseg = NULL; /* suppress compiler warning */
/* Each tract of the segment must agree about white traces. Note
* that even if the CHECKs are compiled away there is still a
* significant cost in looping over the tracts, hence the guard. See
* job003778. */
#if defined(AVER_AND_CHECK_ALL)
{
Tract tract;
Addr addr;
TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, seg->limit) {
Seg trseg = NULL; /* suppress compiler warning */
CHECKD_NOSIG(Tract, tract);
CHECKL(TRACT_SEG(&trseg, tract) && (trseg == seg));
CHECKL(TractWhite(tract) == seg->white);
CHECKL(TractPool(tract) == pool);
CHECKD_NOSIG(Tract, tract);
CHECKL(TRACT_SEG(&trseg, tract) && (trseg == seg));
CHECKL(TractWhite(tract) == seg->white);
CHECKL(TractPool(tract) == pool);
}
CHECKL(addr == seg->limit);
}
CHECKL(addr == seg->limit);
#endif /* AVER_AND_CHECK_ALL */
/* The segment must belong to some pool, so it should be on a */
/* pool's segment ring. (Actually, this isn't true just after */

4
mps/code/segsmss.c
View file

@ -59,6 +59,7 @@ typedef struct AMSTStruct *AMST;
/* AMSTCheck -- the check method for an AMST */
ATTRIBUTE_UNUSED
static Bool AMSTCheck(AMST amst)
{
CHECKS(AMST, amst);
@ -96,6 +97,7 @@ typedef struct AMSTSegStruct {
/* AMSTSegCheck -- check the AMST segment */
ATTRIBUTE_UNUSED
static Bool AMSTSegCheck(AMSTSeg amstseg)
{
CHECKS(AMSTSeg, amstseg);
@ -834,6 +836,8 @@ static void *test(void *arg, size_t s)
}
(void)mps_commit(busy_ap, busy_init, 64);
mps_arena_park(arena);
mps_ap_destroy(busy_ap);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);

25
mps/code/ssan.c
View file

@ -3,10 +3,16 @@
* $Id$
* Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
*
* This module provides zero functionality. It exists to feed the
* linker (prevent linker errors).
* This module makes a best effort to scan the stack and fix the
* registers which may contain roots, using only the features of the
* Standard C library.
*
* .assume.setjmp: The implementation assumes that setjmp stores all
* the registers that need to be scanned in the jmp_buf.
*/
#include <setjmp.h>
#include "mpmtypes.h"
#include "misc.h"
#include "ss.h"
@ -17,8 +23,19 @@ SRCID(ssan, "$Id$");
Res StackScan(ScanState ss, Addr *stackBot)
{
UNUSED(ss); UNUSED(stackBot);
return ResUNIMPL;
jmp_buf jb;
void *stackTop = &jb;
/* .assume.stack: This implementation assumes that the stack grows
* downwards, so that the address of the jmp_buf is the limit of the
* part of the stack that needs to be scanned. (StackScanInner makes
* the same assumption.)
*/
AVER(stackTop < (void *)stackBot);
(void)setjmp(jb);
return StackScanInner(ss, stackBot, stackTop, sizeof jb / sizeof(Addr*));
}

2
mps/code/steptest.c
View file

@ -478,6 +478,8 @@ static void *test(void *arg, size_t s)
printf(" %"PRIuLONGEST" clock reads; ", (ulongest_t)clock_reads);
print_time("", total_clock_time / clock_reads, " per read;");
print_time(" recently measured as ", clock_time, ").\n");
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
mps_root_destroy(ambigRoot);

16
mps/code/testlib.h
View file

@ -68,6 +68,22 @@
#endif
/* setenv -- set environment variable
*
* Windows lacks setenv(), but _putenv_s() has similar functionality.
* <http://msdn.microsoft.com/en-us/library/eyw7eyfw.aspx>
*
* This macro version may evaluate the name argument twice.
*/
#if defined(MPS_OS_W3)
#define setenv(name, value, overwrite) \
(((overwrite) || !getenv(name)) ? _putenv_s(name, value) : 0)
#endif
/* ulongest_t -- longest unsigned integer type
*
* Define a longest unsigned integer type for testing, scanning, and

52
mps/code/trace.c
View file

@ -390,6 +390,7 @@ Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet)
Seg seg;
Arena arena;
Res res;
Bool haveWhiteSegs = FALSE;
AVERT(Trace, trace);
AVER(condemnedSet != ZoneSetEMPTY);
@ -415,7 +416,8 @@ Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet)
{
res = TraceAddWhite(trace, seg);
if(res != ResOK)
return res;
goto failBegin;
haveWhiteSegs = TRUE;
}
} while (SegNext(&seg, arena, seg));
}
@ -426,6 +428,10 @@ Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet)
AVER(ZoneSetSuper(condemnedSet, trace->white));
return ResOK;
failBegin:
AVER(!haveWhiteSegs); /* See .whiten.fail. */
return res;
}
@ -1503,21 +1509,31 @@ static Res traceCondemnAll(Trace trace)
{
Res res;
Arena arena;
Ring chainNode, nextChainNode;
Ring poolNode, nextPoolNode, chainNode, nextChainNode;
Bool haveWhiteSegs = FALSE;
arena = trace->arena;
AVERT(Arena, arena);
/* Condemn all the chains. */
RING_FOR(chainNode, &arena->chainRing, nextChainNode) {
Chain chain = RING_ELT(Chain, chainRing, chainNode);
AVERT(Chain, chain);
res = ChainCondemnAll(chain, trace);
if(res != ResOK)
goto failBegin;
haveWhiteSegs = TRUE;
/* Condemn all segments in pools with the GC attribute. */
RING_FOR(poolNode, &ArenaGlobals(arena)->poolRing, nextPoolNode) {
Pool pool = RING_ELT(Pool, arenaRing, poolNode);
AVERT(Pool, pool);
if (PoolHasAttr(pool, AttrGC)) {
Ring segNode, nextSegNode;
RING_FOR(segNode, PoolSegRing(pool), nextSegNode) {
Seg seg = SegOfPoolRing(segNode);
AVERT(Seg, seg);
res = TraceAddWhite(trace, seg);
if (res != ResOK)
goto failBegin;
haveWhiteSegs = TRUE;
}
}
}
/* Notify all the chains. */
RING_FOR(chainNode, &arena->chainRing, nextChainNode) {
Chain chain = RING_ELT(Chain, chainRing, chainNode);
@ -1527,7 +1543,14 @@ static Res traceCondemnAll(Trace trace)
return ResOK;
failBegin:
AVER(!haveWhiteSegs); /* Would leave white sets inconsistent. */
/* .whiten.fail: If we successfully whitened one or more segments,
* but failed to whiten them all, then the white sets would now be
* inconsistent. This can't happen in practice (at time of writing)
* because all PoolWhiten methods always succeed. If we ever have a
* pool class that fails to whiten a segment, then this assertion
* will be triggered. In that case, we'll have to recover here by
* blackening the segments again. */
AVER(!haveWhiteSegs);
return res;
}
@ -1570,7 +1593,7 @@ static void TraceStartPoolGen(Chain chain, GenDesc desc, Bool top, Index i)
Ring n, nn;
RING_FOR(n, &desc->locusRing, nn) {
PoolGen gen = RING_ELT(PoolGen, genRing, n);
EVENT11(TraceStartPoolGen, chain, BOOL(top), i, desc,
EVENT11(TraceStartPoolGen, chain, BOOLOF(top), i, desc,
desc->capacity, desc->mortality, desc->zones,
gen->pool, gen->nr, gen->totalSize,
gen->newSizeAtCreate);
@ -1715,7 +1738,10 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
void TraceQuantum(Trace trace)
{
Size pollEnd;
Arena arena = trace->arena;
Arena arena;
AVERT(Trace, trace);
arena = trace->arena;
pollEnd = traceWorkClock(trace) + trace->rate;
do {

2
mps/code/traceanc.c
View file

@ -560,7 +560,7 @@ void ArenaRelease(Globals globals)
AVERT(Globals, globals);
arenaForgetProtection(globals);
globals->clamped = FALSE;
(void)TracePoll(globals);
ArenaPoll(globals);
}

3
mps/code/vman.c
View file

@ -63,11 +63,12 @@ Res VMParamFromArgs(void *params, size_t paramSize, ArgList args)
/* VMCreate -- reserve some virtual address space, and create a VM structure */
Res VMCreate(VM *vmReturn, Size size)
Res VMCreate(VM *vmReturn, Size size, void *params)
{
VM vm;
AVER(vmReturn != NULL);
AVER(params != NULL);
/* Note that because we add VMANPageALIGNMENT rather than */
/* VMANPageALIGNMENT-1 we are not in danger of overflowing */

19
mps/code/w3i3mv.nmk
View file

@ -11,8 +11,17 @@ PFMDEFS = /DCONFIG_PF_STRING="w3i3mv" /DCONFIG_PF_W3I3MV /DWIN32 /D_WINDOWS
!INCLUDE mv.nmk
# MPM sources: core plus platform-specific.
MPM = $(MPMCOMMON) <proti3> <prmci3w3> <spw3i3> <ssw3i3mv> <thw3i3>
MPM = $(MPMCOMMON) \
<lockw3> \
<mpsiw3> \
<prmci3w3> \
<proti3> \
<protw3> \
<spw3i3> \
<ssw3i3mv> \
<thw3> \
<thw3i3> \
<vmw3>
# Source to object file mappings and CFLAGS amalgamation
@ -44,6 +53,7 @@ FMTTESTOBJ0 = $(FMTTEST:<=w3i3mv\hot\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=w3i3mv\hot\)
POOLNOBJ0 = $(POOLN:<=w3i3mv\hot\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\hot\)
TESTTHROBJ0 = $(TESTTHR:<=w3i3mv\hot\)
!ELSEIF "$(VARIETY)" == "cool"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFCOOL) $(CFLAGSCOMMONPOST)
@ -63,6 +73,7 @@ FMTTESTOBJ0 = $(FMTTEST:<=w3i3mv\cool\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=w3i3mv\cool\)
POOLNOBJ0 = $(POOLN:<=w3i3mv\cool\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\cool\)
TESTTHROBJ0 = $(TESTTHR:<=w3i3mv\cool\)
!ELSEIF "$(VARIETY)" == "rash"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFRASH) $(CFLAGSCOMMONPOST)
@ -82,6 +93,7 @@ FMTTESTOBJ0 = $(FMTTEST:<=w3i3mv\rash\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=w3i3mv\rash\)
POOLNOBJ0 = $(POOLN:<=w3i3mv\rash\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\rash\)
TESTTHROBJ0 = $(TESTTHR:<=w3i3mv\rash\)
#!ELSEIF "$(VARIETY)" == "cv"
#CFLAGS=$(CFLAGSCOMMON) $(CFCV)
@ -107,6 +119,8 @@ TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\rash\)
#POOLNOBJ = $(POOLNOBJ0:>=.obj)
#TESTLIBOBJ0 = $(TESTLIB:<=w3i3mv\cv\)
#TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
#TESTTHROBJ0 = $(TESTTHR:<=w3i3mv\cv\)
#TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!ENDIF
@ -126,6 +140,7 @@ FMTTESTOBJ = $(FMTTESTOBJ0:>=.obj)
FMTSCHEMEOBJ = $(FMTSCHEMEOBJ0:>=.obj)
POOLNOBJ = $(POOLNOBJ0:>=.obj)
TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!INCLUDE commpost.nmk

19
mps/code/w3i3pc.nmk
View file

@ -11,8 +11,17 @@ PFMDEFS = /DCONFIG_PF_STRING="w3i3pc" /DCONFIG_PF_W3I3PC /DWIN32 /D_WINDOWS
!INCLUDE pc.nmk
# MPM sources: core plus platform-specific.
MPM = $(MPMCOMMON) <proti3> <prmci3w3> <spw3i3> <ssw3i3pc> <thw3i3>
MPM = $(MPMCOMMON) \
<lockw3> \
<mpsiw3> \
<prmci3w3> \
<proti3> \
<protw3> \
<spw3i3> \
<ssw3i3pc> \
<thw3> \
<thw3i3> \
<vmw3>
# Source to object file mappings and CFLAGS amalgamation
@ -43,6 +52,7 @@ DWOBJ0 = $(DW:<=w3i3pc\hot\)
FMTTESTOBJ0 = $(FMTTEST:<=w3i3pc\hot\)
POOLNOBJ0 = $(POOLN:<=w3i3pc\hot\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i3pc\hot\)
TESTTHROBJ0 = $(TESTTHR:<=w3i3pc\hot\)
!ELSEIF "$(VARIETY)" == "cool"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFCOOL) $(CFLAGSCOMMONPOST)
@ -61,6 +71,7 @@ DWOBJ0 = $(DW:<=w3i3pc\cool\)
FMTTESTOBJ0 = $(FMTTEST:<=w3i3pc\cool\)
POOLNOBJ0 = $(POOLN:<=w3i3pc\cool\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i3pc\cool\)
TESTTHROBJ0 = $(TESTTHR:<=w3i3pc\cool\)
!ELSEIF "$(VARIETY)" == "rash"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFRASH) $(CFLAGSCOMMONPOST)
@ -79,6 +90,7 @@ DWOBJ0 = $(DW:<=w3i3pc\rash\)
FMTTESTOBJ0 = $(FMTTEST:<=w3i3pc\rash\)
POOLNOBJ0 = $(POOLN:<=w3i3pc\rash\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i3pc\rash\)
TESTTHROBJ0 = $(TESTTHR:<=w3i3pc\rash\)
#!ELSEIF "$(VARIETY)" == "cv"
#CFLAGS=$(CFLAGSCOMMON) $(CFCV)
@ -104,6 +116,8 @@ TESTLIBOBJ0 = $(TESTLIB:<=w3i3pc\rash\)
#POOLNOBJ = $(POOLNOBJ0:>=.obj)
#TESTLIBOBJ0 = $(TESTLIB:<=w3i3pc\cv\)
#TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
#TESTTHROBJ0 = $(TESTTHR:<=w3i3pc\cv\)
#TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!ENDIF
@ -122,6 +136,7 @@ DWOBJ = $(DWOBJ0:>=.obj)
FMTTESTOBJ = $(FMTTESTOBJ0:>=.obj)
POOLNOBJ = $(POOLNOBJ0:>=.obj)
TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!INCLUDE commpost.nmk

28
mps/code/w3i6mv.nmk
View file

@ -1,18 +1,28 @@
# w3i6mv.nmk: WINDOWS (x86-64) NMAKE FILE -*- makefile -*-
#
# $Id$
# Copyright (c) 2001-2013 Ravenbrook Limited. See end of file for license.
# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
PFM = w3i6mv
PFMDEFS = /DCONFIG_PF_STRING="w3i6mv" /DCONFIG_PF_W3I6MV /DWIN32 /D_WINDOWS
MASM = ml64
# MPM sources: core plus platform-specific.
MPM = $(MPMCOMMON) <proti6> <prmci6w3> <spw3i6> <ssw3i6mv> <thw3i6>
!INCLUDE commpre.nmk
!INCLUDE mv.nmk
# MPM sources: core plus platform-specific.
MPM = $(MPMCOMMON) \
<lockw3> \
<mpsiw3> \
<prmci6w3> \
<proti6> \
<protw3> \
<spw3i6> \
<ssw3i6mv> \
<thw3> \
<thw3i6> \
<vmw3>
# Source to object file mappings and CFLAGS amalgamation
@ -44,6 +54,7 @@ FMTTESTOBJ0 = $(FMTTEST:<=w3i6mv\hot\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=w3i6mv\hot\)
POOLNOBJ0 = $(POOLN:<=w3i6mv\hot\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i6mv\hot\)
TESTTHROBJ0 = $(TESTTHR:<=w3i6mv\hot\)
!ELSEIF "$(VARIETY)" == "cool"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFCOOL) $(CFLAGSCOMMONPOST)
@ -63,6 +74,7 @@ FMTTESTOBJ0 = $(FMTTEST:<=w3i6mv\cool\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=w3i6mv\cool\)
POOLNOBJ0 = $(POOLN:<=w3i6mv\cool\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i6mv\cool\)
TESTTHROBJ0 = $(TESTTHR:<=w3i6mv\cool\)
!ELSEIF "$(VARIETY)" == "rash"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFRASH) $(CFLAGSCOMMONPOST)
@ -82,6 +94,7 @@ FMTTESTOBJ0 = $(FMTTEST:<=w3i6mv\rash\)
FMTSCHEMEOBJ0 = $(FMTSCHEME:<=w3i6mv\rash\)
POOLNOBJ0 = $(POOLN:<=w3i6mv\rash\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i6mv\rash\)
TESTTHROBJ0 = $(TESTTHR:<=w3i6mv\rash\)
#!ELSEIF "$(VARIETY)" == "cv"
#CFLAGS=$(CFLAGSCOMMON) $(CFCV)
@ -107,6 +120,8 @@ TESTLIBOBJ0 = $(TESTLIB:<=w3i6mv\rash\)
#POOLNOBJ = $(POOLNOBJ0:>=.obj)
#TESTLIBOBJ0 = $(TESTLIB:<=w3i6mv\cv\)
#TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
#TESTTHROBJ0 = $(TESTTHR:<=w3i6mv\cv\)
#TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!ENDIF
@ -126,6 +141,7 @@ FMTTESTOBJ = $(FMTTESTOBJ0:>=.obj)
FMTSCHEMEOBJ = $(FMTSCHEMEOBJ0:>=.obj)
POOLNOBJ = $(POOLNOBJ0:>=.obj)
TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!INCLUDE commpost.nmk
@ -133,7 +149,7 @@ TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
# C. COPYRIGHT AND LICENSE
#
# Copyright (C) 2001-2013 Ravenbrook Limited <http://www.ravenbrook.com/>.
# Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

19
mps/code/w3i6pc.nmk
View file

@ -15,8 +15,17 @@ PFMDEFS = /DCONFIG_PF_STRING="w3i6pc" /DCONFIG_PF_W3I6PC /DWIN32 /D_WINDOWS
CFLAGSCOMMONPRE = $(CFLAGSCOMMONPRE) /Tamd64-coff
# MPM sources: core plus platform-specific.
MPM = $(MPMCOMMON) <proti6> <prmci6w3> <spw3i6> <ssw3i6pc> <thw3i6>
MPM = $(MPMCOMMON) \
<lockw3> \
<mpsiw3> \
<prmci6w3> \
<proti6> \
<protw3> \
<spw3i6> \
<ssw3i6pc> \
<thw3> \
<thw3i6> \
<vmw3>
# Source to object file mappings and CFLAGS amalgamation
@ -47,6 +56,7 @@ DWOBJ0 = $(DW:<=w3i6pc\hot\)
FMTTESTOBJ0 = $(FMTTEST:<=w3i6pc\hot\)
POOLNOBJ0 = $(POOLN:<=w3i6pc\hot\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i6pc\hot\)
TESTTHROBJ0 = $(TESTTHR:<=w3i6pc\hot\)
!ELSEIF "$(VARIETY)" == "cool"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFCOOL) $(CFLAGSCOMMONPOST)
@ -65,6 +75,7 @@ DWOBJ0 = $(DW:<=w3i6pc\cool\)
FMTTESTOBJ0 = $(FMTTEST:<=w3i6pc\cool\)
POOLNOBJ0 = $(POOLN:<=w3i6pc\cool\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i6pc\cool\)
TESTTHROBJ0 = $(TESTTHR:<=w3i6pc\cool\)
!ELSEIF "$(VARIETY)" == "rash"
CFLAGS=$(CFLAGSCOMMONPRE) $(CFRASH) $(CFLAGSCOMMONPOST)
@ -83,6 +94,7 @@ DWOBJ0 = $(DW:<=w3i6pc\rash\)
FMTTESTOBJ0 = $(FMTTEST:<=w3i6pc\rash\)
POOLNOBJ0 = $(POOLN:<=w3i6pc\rash\)
TESTLIBOBJ0 = $(TESTLIB:<=w3i6pc\rash\)
TESTTHROBJ0 = $(TESTTHR:<=w3i6pc\rash\)
#!ELSEIF "$(VARIETY)" == "cv"
#CFLAGS=$(CFLAGSCOMMON) $(CFCV)
@ -108,6 +120,8 @@ TESTLIBOBJ0 = $(TESTLIB:<=w3i6pc\rash\)
#POOLNOBJ = $(POOLNOBJ0:>=.obj)
#TESTLIBOBJ0 = $(TESTLIB:<=w3i6pc\cv\)
#TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
#TESTTHROBJ0 = $(TESTTHR:<=w3i6pc\cv\)
#TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!ENDIF
@ -126,6 +140,7 @@ DWOBJ = $(DWOBJ0:>=.obj)
FMTTESTOBJ = $(FMTTESTOBJ0:>=.obj)
POOLNOBJ = $(POOLNOBJ0:>=.obj)
TESTLIBOBJ = $(TESTLIBOBJ0:>=.obj)
TESTTHROBJ = $(TESTTHROBJ0:>=.obj)
!INCLUDE commpost.nmk

2
mps/code/walk.c
View file

@ -26,6 +26,7 @@ typedef struct FormattedObjectsStepClosureStruct {
} FormattedObjectsStepClosureStruct;
ATTRIBUTE_UNUSED
static Bool FormattedObjectsStepClosureCheck(FormattedObjectsStepClosure c)
{
CHECKS(FormattedObjectsStepClosure, c);
@ -164,6 +165,7 @@ typedef struct rootsStepClosureStruct {
/* rootsStepClosureCheck -- check a rootsStepClosure */
ATTRIBUTE_UNUSED
static Bool rootsStepClosureCheck(rootsStepClosure rsc)
{
CHECKS(rootsStepClosure, rsc);

3
mps/code/walkt0.c
View file

@ -191,11 +191,14 @@ static void *test(mps_arena_t arena, mps_class_t pool_class)
/* Note: stepper finds more than we expect, due to pad objects */
/* printf("stepper found %ld objs\n", sd->count); */
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_root_destroy(exactRoot);
mps_pool_destroy(pool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
mps_arena_release(arena);
return NULL;
}

1
mps/code/zcoll.c
View file

@ -774,6 +774,7 @@ static void *testscriptB(void *arg, size_t s)
testscriptC(arena, ap, script);
printf(" Destroy roots, pools, arena etc.\n\n");
mps_arena_park(arena);
mps_root_destroy(root_stackreg);
mps_ap_destroy(ap);
mps_root_destroy(root_table_Exact);

1
mps/code/zmess.c
View file

@ -381,6 +381,7 @@ static void *testscriptB(void *arg, size_t s)
testscriptC(arena, script);
mps_arena_park(arena);
mps_ap_destroy(ap);
mps_root_destroy(root_table);
mps_pool_destroy(amc);

52
mps/configure vendored
View file

@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for Memory Pool System Kit release/1.113.0.
# Generated by GNU Autoconf 2.69 for Memory Pool System Kit release/1.114.0.
#
# Report bugs to <mps-questions@ravenbrook.com>.
#
@ -580,8 +580,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='Memory Pool System Kit'
PACKAGE_TARNAME='mps-kit'
PACKAGE_VERSION='release/1.113.0'
PACKAGE_STRING='Memory Pool System Kit release/1.113.0'
PACKAGE_VERSION='release/1.114.0'
PACKAGE_STRING='Memory Pool System Kit release/1.114.0'
PACKAGE_BUGREPORT='mps-questions@ravenbrook.com'
PACKAGE_URL='http://www.ravenbrook.com/project/mps/'
@ -629,7 +629,9 @@ TEST_TARGET
INSTALL_TARGET
CLEAN_TARGET
BUILD_TARGET
MPS_TARGET_NAME
MPS_BUILD_NAME
MPS_ARCH_NAME
MPS_OS_NAME
MAKE
host_os
host_vendor
@ -1243,7 +1245,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
\`configure' configures Memory Pool System Kit release/1.113.0 to adapt to many kinds of systems.
\`configure' configures Memory Pool System Kit release/1.114.0 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@ -1308,7 +1310,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
short | recursive ) echo "Configuration of Memory Pool System Kit release/1.113.0:";;
short | recursive ) echo "Configuration of Memory Pool System Kit release/1.114.0:";;
esac
cat <<\_ACEOF
@ -1389,7 +1391,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
Memory Pool System Kit configure release/1.113.0
Memory Pool System Kit configure release/1.114.0
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
@ -1691,7 +1693,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by Memory Pool System Kit $as_me release/1.113.0, which was
It was created by Memory Pool System Kit $as_me release/1.114.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@ -3455,25 +3457,33 @@ case $host/$CLANG in
i*86-*-linux*/no)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: Linux x86" >&5
$as_echo "Linux x86" >&6; }
MPS_TARGET_NAME=lii3gc
MPS_OS_NAME=li
MPS_ARCH_NAME=i3
MPS_BUILD_NAME=gc
PFMCFLAGS="$CFLAGS_GC"
;;
x86_64-*-linux*/no)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: Linux x86_64" >&5
$as_echo "Linux x86_64" >&6; }
MPS_TARGET_NAME=lii6gc
MPS_OS_NAME=li
MPS_ARCH_NAME=i6
MPS_BUILD_NAME=gc
PFMCFLAGS="$CFLAGS_GC"
;;
x86_64-*-linux*/yes)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: Linux x86_64" >&5
$as_echo "Linux x86_64" >&6; }
MPS_TARGET_NAME=lii6ll
MPS_OS_NAME=li
MPS_ARCH_NAME=i6
MPS_BUILD_NAME=ll
PFMCFLAGS="$CFLAGS_LL"
;;
i*86-*-darwin*/*)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: Mac OS X x86" >&5
$as_echo "Mac OS X x86" >&6; }
MPS_TARGET_NAME=xci3ll
MPS_OS_NAME=xc
MPS_ARCH_NAME=i3
MPS_BUILD_NAME=ll
BUILD_TARGET=build-via-xcode
CLEAN_TARGET=clean-xcode-build
INSTALL_TARGET=install-xcode-build
@ -3483,7 +3493,9 @@ $as_echo "Mac OS X x86" >&6; }
x86_64-apple-darwin*/*)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: Mac OS X x86_64" >&5
$as_echo "Mac OS X x86_64" >&6; }
MPS_TARGET_NAME=xci6ll
MPS_OS_NAME=xc
MPS_ARCH_NAME=i6
MPS_BUILD_NAME=ll
BUILD_TARGET=build-via-xcode
CLEAN_TARGET=clean-xcode-build
INSTALL_TARGET=install-xcode-build
@ -3493,7 +3505,9 @@ $as_echo "Mac OS X x86_64" >&6; }
i*86-*-freebsd*/no)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: FreeBSD x86" >&5
$as_echo "FreeBSD x86" >&6; }
MPS_TARGET_NAME=fri3gc
MPS_OS_NAME=fr
MPS_ARCH_NAME=i3
MPS_BUILD_NAME=gc
# Need /usr/local/include in order to find sqlite3.h
CFLAGS="-I/usr/local/include"
CPP="$CC -I/usr/local/include -E"
@ -3502,7 +3516,9 @@ $as_echo "FreeBSD x86" >&6; }
amd64-*-freebsd*/no | x86_64-*-freebsd*/no)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: FreeBSD x86_64" >&5
$as_echo "FreeBSD x86_64" >&6; }
MPS_TARGET_NAME=fri6gc
MPS_OS_NAME=fr
MPS_ARCH_NAME=i6
MPS_BUILD_NAME=gc
# Need /usr/local/include in order to find sqlite3.h
CFLAGS="-I/usr/local/include"
CPP="$CC -I/usr/local/include -E"
@ -3581,6 +3597,8 @@ CFLAGS="$CFLAGS $PFMCFLAGS"
ac_config_files="$ac_config_files Makefile example/scheme/Makefile"
@ -4126,7 +4144,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by Memory Pool System Kit $as_me release/1.113.0, which was
This file was extended by Memory Pool System Kit $as_me release/1.114.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@ -4180,7 +4198,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
Memory Pool System Kit config.status release/1.113.0
Memory Pool System Kit config.status release/1.114.0
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"

32
mps/configure.ac
View file

@ -47,22 +47,30 @@ TEST_TARGET=test-make-build
case $host/$CLANG in
i*86-*-linux*/no)
AC_MSG_RESULT([Linux x86])
MPS_TARGET_NAME=lii3gc
MPS_OS_NAME=li
MPS_ARCH_NAME=i3
MPS_BUILD_NAME=gc
PFMCFLAGS="$CFLAGS_GC"
;;
x86_64-*-linux*/no)
AC_MSG_RESULT([Linux x86_64])
MPS_TARGET_NAME=lii6gc
MPS_OS_NAME=li
MPS_ARCH_NAME=i6
MPS_BUILD_NAME=gc
PFMCFLAGS="$CFLAGS_GC"
;;
x86_64-*-linux*/yes)
AC_MSG_RESULT([Linux x86_64])
MPS_TARGET_NAME=lii6ll
MPS_OS_NAME=li
MPS_ARCH_NAME=i6
MPS_BUILD_NAME=ll
PFMCFLAGS="$CFLAGS_LL"
;;
i*86-*-darwin*/*)
AC_MSG_RESULT([Mac OS X x86])
MPS_TARGET_NAME=xci3ll
MPS_OS_NAME=xc
MPS_ARCH_NAME=i3
MPS_BUILD_NAME=ll
BUILD_TARGET=build-via-xcode
CLEAN_TARGET=clean-xcode-build
INSTALL_TARGET=install-xcode-build
@ -71,7 +79,9 @@ case $host/$CLANG in
;;
x86_64-apple-darwin*/*)
AC_MSG_RESULT([Mac OS X x86_64])
MPS_TARGET_NAME=xci6ll
MPS_OS_NAME=xc
MPS_ARCH_NAME=i6
MPS_BUILD_NAME=ll
BUILD_TARGET=build-via-xcode
CLEAN_TARGET=clean-xcode-build
INSTALL_TARGET=install-xcode-build
@ -80,7 +90,9 @@ case $host/$CLANG in
;;
i*86-*-freebsd*/no)
AC_MSG_RESULT([FreeBSD x86])
MPS_TARGET_NAME=fri3gc
MPS_OS_NAME=fr
MPS_ARCH_NAME=i3
MPS_BUILD_NAME=gc
# Need /usr/local/include in order to find sqlite3.h
CFLAGS="-I/usr/local/include"
CPP="$CC -I/usr/local/include -E"
@ -88,7 +100,9 @@ case $host/$CLANG in
;;
amd64-*-freebsd*/no | x86_64-*-freebsd*/no)
AC_MSG_RESULT([FreeBSD x86_64])
MPS_TARGET_NAME=fri6gc
MPS_OS_NAME=fr
MPS_ARCH_NAME=i6
MPS_BUILD_NAME=gc
# Need /usr/local/include in order to find sqlite3.h
CFLAGS="-I/usr/local/include"
CPP="$CC -I/usr/local/include -E"
@ -111,7 +125,9 @@ AC_CHECK_HEADER([sqlite3.h], [EXTRA_TARGETS="$EXTRA_TARGETS mpseventsql"])
# those flags.
CFLAGS="$CFLAGS $PFMCFLAGS"
AC_SUBST(MPS_TARGET_NAME)
AC_SUBST(MPS_OS_NAME)
AC_SUBST(MPS_ARCH_NAME)
AC_SUBST(MPS_BUILD_NAME)
AC_SUBST(BUILD_TARGET)
AC_SUBST(CLEAN_TARGET)
AC_SUBST(INSTALL_TARGET)

37
mps/design/config.txt
View file

@ -97,6 +97,10 @@ as a dimension of configuration since `.req.prod`_ has been retired.
_`.def.target`: The *target* is the result of the build.
_`.def.option`: An *option* is a feature of the MPS that is not
selected via the *platform* and *variety*. See `.opt`_.
Overview
--------
@ -150,7 +154,7 @@ _`.build.cc`: A consequence of this approach is that it should always
be possible to build a complete target with a single UNIX command line
calling the compiler driver (usually "cc" or "gcc"), for example::
cc -o main -DCONFIG_VAR_DF foo.c bar.c baz.s -lz
cc -o main -DCONFIG_VAR_COOL foo.c bar.c baz.s -lz
_`.build.defs`: The "defs" are the set of preprocessor macros which are to be
predefined when compiling the module sources::
@ -319,12 +323,14 @@ _`.pf.form`: This file consists of sets of directives of the form::
#elif <conjunction of builder predefinitions>
#define MPS_PF_<platform code>
#define MPS_PF_STRING "<platform code>"
#define MPS_OS_<operating system code>
#define MPS_ARCH_<architecture code>
#define MPS_BUILD_<builder code>
#define MPS_T_WORD <word type>
#define MPS_T_ULONGEST <longest unsigned integer type>
#define MPS_WORD_SHIFT <word shift>
#define MPS_WORD_WIDTH <word width in bits>
#define MPS_WORD_SHIFT <log to the base 2 of word width>
#define MPS_PF_ALIGN <minimum alignment>
_`.pf.detect`: The conjunction of builder predefinitions is a constant
@ -513,6 +519,33 @@ For example, this sort of thing::
This violates `.no-spaghetti`_.
Configuration options
---------------------
_`.opt`: Options select features of the MPS that are not selected by the *platform* and the *variety*.
_`.opt.support`: The features selected by options are not supported or
documented in the public interface. This is to keep the complexity of
the MPS manageable: at present the number of supported configuration
is *platforms* × *varieties* (at time of writing, 9 × 3 = 27). Each
supported option would double (or worse) the number of supported
configurations.
_`.opt.ansi`: ``CONFIG_PF_ANSI`` tells ``mps.c`` to exclude the
sources for the auto-detected platform, and use the generic ("ANSI")
platform instead.
_`.opt.thread`: ``CONFIG_THREAD_SINGLE`` causes the MPS to be built
for single-threaded execution only, where locks are not needed and so
lock operations can be defined as no-ops by ``lock.h``.
_`.opt.poll`: ``CONFIG_POLL_NONE`` causes the MPS to be built without
support for polling. This means that garbage collections will only
happen if requested explicitly via ``mps_arena_collect()`` or
``mps_arena_step()``, but it also means that protection is not needed,
and so shield operations can be replaced with no-ops in ``mpm.h``.
To document
-----------
- What about constants in config.h?

4
mps/design/prot.txt
View file

@ -47,10 +47,6 @@ forbidden. A request to forbid read accesses (that is, ``AccessREAD``
is set) may also forbid write accesses, but read accesses will not be
forbidden unless ``AccessREAD`` is set.
``void ProtTramp(void **resultReturn, void *(*f)(void *, size_t), void *p, size_t s)``
_`.if.tramp`: [undocumented]
``void ProtSync(Space space)``
_`.if.sync`: ``ProtSync()`` is called to ensure that the actual

5
mps/design/protli.txt
View file

@ -88,11 +88,6 @@ underlying object).
_`.fun.sync`: ``ProtSync()`` does nothing in this implementation as
``ProtSet()`` sets the protection without any delay.
_`.fun.tramp`: The protection trampoline, ``ProtTramp()``, is trivial
under Linux, as there is nothing that needs to be done in the dynamic
context of the mutator in order to catch faults. (Contrast this with
Win32 Structured Exception Handling.)
Threads
-------

5
mps/design/protsu.txt
View file

@ -110,11 +110,6 @@ access that is compatible with the access of the underlying object).
_`.fun.sync`: ``ProtSync()``. This does nothing in this implementation
as ProtSet sets the protection without any delay.
_`.fun.tramp`: ``ProtTramp()``. The protection trampoline is trivial
under SunOS, as there is nothing that needs to be done in the dynamic
context of the mutator in order to catch faults. (Contrast this with
Win32 Structured Exception Handling.)
Document History
----------------

2
mps/design/range.txt
View file

@ -51,7 +51,7 @@ between ``base`` (inclusive) and ``limit`` (exclusive). It must be the
case that ``base <= limit``. If ``base == limit`` then the range is
empty.
``void RangeInitCopy(Range dest, Range src)``
``void RangeCopy(Range dest, Range src)``
Initialize ``dest`` to be a copy of ``src``.

45
mps/design/type.txt
View file

@ -151,6 +151,14 @@ compared ``w3i3mv\hi\amcss.exe`` running with and without the macro
for ``BoolCheck`` on the PC Aaron. "With" ran in 97.7% of the time
(averaged over 3 runs).
_`.bool.bitfield`: When a Boolean needs to be stored in a bitfield,
the type of the bitfield must be ``unsigned:1``, not ``Bool:1``.
(That's because the two values of the type ``Bool:1`` are ``0`` and
``-1``, which means that assigning ``TRUE`` would require a sign
conversion.) To avoid warnings about loss of data from GCC with the
``-Wconversion`` option, ``misc.h`` provides the ``BOOLOF`` macro for
coercing a value to an unsigned single-bit field.
``typedef unsigned BufferMode``
@ -235,7 +243,8 @@ objects.
``typedef Size Epoch``
_`.epoch`: An ``Epoch`` is a count of the number of flips that have
occurred. It is used in the implementation of location dependencies.
occurred, in which objects may have moved. It is used in the
implementation of location dependencies.
``Epoch`` is converted to ``mps_word_t`` in the MPS C Interface, as a
field of ``mps_ld_s``.
@ -351,7 +360,7 @@ references must be scanned in order to respect the properties of
references of the ranks. Therefore they are declared explicitly with
their integer values.
.. note:: Could ``Rank`` be a ``short``?
.. note:: Could ``Rank`` be an ``unsigned short`` or ``unsigned char``?
.. note::
@ -459,30 +468,35 @@ create a valid registered constant root that contains any references.
become invalid; but you can't add them afterwards because the root is
supposed to be constant.)
_`.rootmode.conv.c`: ``RootMode`` is converted to ``mps_rm_t`` in the MPS C
Interface.
_`.rootmode.conv.c`: ``RootMode`` is converted to ``mps_rm_t`` in the
MPS C Interface.
``typedef int RootVar``
_`.rootvar`: The type ``RootVar`` is the type of the
discriminator for the union within ``RootStruct``.
_`.rootvar`: The type ``RootVar`` is the type of the discriminator for
the union within ``RootStruct``.
``typedef int SegPrefKind``
_`.segprefkind`: The type ``SegPrefKind`` expresses a preference about
where the arena should place a segment. It takes one of the following
_`.segprefkind`: The type ``SegPrefKind`` expresses a preference for
addresses within an address space. It takes one of the following
values:
================== ====================================================
Kind Description
================== ====================================================
``SegPrefHigh`` Place the segment high in the address space.
``SegPrefLow`` Place the segment low in the address space.
``SegPrefZoneSet`` Place the segment in specified zones.
``SegPrefHigh`` Prefer high addresses.
``SegPrefLow`` Prefer low addresses.
``SegPrefZoneSet`` Prefer addresses in specified zones.
================== ====================================================
.. note::
The name is misleading as this is used to refer to address
preferences in general, not just addresses of segments.
``typedef unsigned Serial``
@ -490,9 +504,8 @@ _`.serial`: A ``Serial`` is a number which is assigned to a structure
when it is initialized. The serial number is taken from a field in the
parent structure, which is incremented. Thus, every instance of a
structure has a unique "name" which is a path of structures from the
global root. For example::
space[3].pool[5].buffer[2]
global root. For example, "the third arena's fifth pool's second
buffer".
Why? Consistency checking, debugging, and logging. Not well thought
out.
@ -509,6 +522,8 @@ right-hand operand of the ``<<`` or ``>>`` operators) is intended, to
make the code clear. It should also be used for structure fields which
have this use.
.. note:: Could ``Shift`` be an ``unsigned short`` or ``unsigned char``?
``typedef unsigned long Sig``
@ -640,7 +655,7 @@ _`.word.ops`: ``WordIsAligned()``, ``WordAlignUp()``,
``typedef Word ZoneSet``
_`.zoneset`: ``ZoneSet`` is a conservative approximation to a set of
zone. See design.mps.refset_.
zones. See design.mps.refset_.
Abstract types

9
mps/manual/source/extensions/mps/designs.py
View file

@ -22,10 +22,11 @@
Arena Attr Bool BootBlock BT Buffer BufferMode Byte Chain Chunk
Clock Compare Count Epoch FindDelete Format FrameState Fun Globals
Index Land LD Lock Message MessageType MutatorFaultContext Page
Pointer Pool PThreadext Range Rank RankSet Ref Res Reservoir Ring
Root RootMode RootVar ScanState Seg SegBuf SegPref SegPrefKind
Serial Shift Sig Size Space SplayNode SplayTree StackContext
Thread Trace TraceId TraceSet ULongest VM Word ZoneSet
Pointer Pool PThreadext Range Rank RankSet Ref RefSet Res
Reservoir Ring Root RootMode RootVar ScanState Seg SegBuf SegPref
SegPrefKind Serial Shift Sig Size Space SplayNode SplayTree
StackContext Thread Trace TraceId TraceSet TraceStartWhy
TraceState ULongest VM Word ZoneSet
'''

7
mps/manual/source/guide/debug.rst
View file

@ -86,10 +86,11 @@ General debugging advice
handle SIGSEGV pass nostop noprint
On OS X barrier hits do not use signals and so do not enter the debugger.
On these operating systems, you can add this commands to your
``.gdbinit`` if you always want them to be run.
(On these operating systems, you can add these commands to your
``.gdbinit`` if you always want them to be run.)
On OS X barrier hits do not use signals and so do not enter the
debugger.
.. index::

28
mps/manual/source/guide/lang.rst
View file

@ -748,7 +748,7 @@ And third, the global symbol table::
static size_t symtab_size;
You tell the MPS how to scan these by writing root scanning functions
of type :c:type:`mps_reg_scan_t`. These functions are similar to the
of type :c:type:`mps_root_scan_t`. These functions are similar to the
:ref:`scan method <guide-lang-scan>` in an :term:`object format`,
described above.
@ -823,7 +823,7 @@ after the rehash has completed, de-registering the old root by calling
:c:func:`mps_root_destroy`.
It would be possible to write a root scanning function of type
:c:type:`mps_reg_scan_t`, as described above, to fix the references in
:c:type:`mps_root_scan_t`, as described above, to fix the references in
the global symbol table, but the case of a table of references is
sufficiently common that the MPS provides a convenient (and optimized)
function, :c:func:`mps_root_create_table`, for registering it::
@ -1142,28 +1142,28 @@ tracking down the causes, appear in the chapter :ref:`guide-debug`.
Tidying up
----------
When your program is done with the MPS, it's good practice to
:term:`park <parked state>` the arena (by calling
:c:func:`mps_arena_park`) and then tear down all the MPS data
structures. This causes the MPS to check the consistency of its data
structures and report any problems it detects. It also causes the MPS
to flush its :term:`telemetry stream`.
When your program is done with the MPS, you should :term:`park <parked
state>` the arena (by calling :c:func:`mps_arena_park`) to ensure that
no incremental garbage collection is in progress, and then tear down
all the MPS data structures. This causes the MPS to check the
consistency of its data structures and report any problems it detects.
It also causes the MPS to flush its :term:`telemetry stream`.
MPS data structures must be destroyed or deregistered in the reverse
order to that in which they were registered or created. So you must
destroy all :term:`allocation points` created in a
:term:`pool` before destroying the pool; destroy all :term:`roots` and pools, and deregister all :term:`threads`, that
were created in an :term:`arena` before destroying the arena, and so
on.
destroy all :term:`allocation points` created in a :term:`pool` before
destroying the pool; destroy all :term:`roots` and pools, and
deregister all :term:`threads`, that were created in an :term:`arena`
before destroying the arena, and so on.
For example::
mps_arena_park(arena); /* ensure no collection is running */
mps_ap_destroy(obj_ap); /* destroy ap before pool */
mps_pool_destroy(obj_pool); /* destroy pool before fmt */
mps_fmt_destroy(obj_fmt); /* destroy fmt before arena */
mps_root_destroy(reg_root); /* destroy root before arena */
mps_root_destroy(reg_root); /* destroy root before thread */
mps_thread_dereg(thread); /* deregister thread before arena */
mps_fmt_destroy(obj_fmt); /* destroy fmt before arena */
mps_arena_destroy(arena); /* last of all */

12
mps/manual/source/pool/ams.rst
View file

@ -55,10 +55,11 @@ AMS properties
never promoted out of the generation in which they are allocated.
* Blocks may contain :term:`exact references` to blocks in the same or
other pools, or :term:`ambiguous references` (if the
other pools, or :term:`ambiguous references` (unless the
:c:macro:`MPS_KEY_AMS_SUPPORT_AMBIGUOUS` keyword argument is set to
true when creating the pool). Blocks may not contain :term:`weak
references (1)`, and may not use :term:`remote references`.
``FALSE`` when creating the pool). Blocks may not contain
:term:`weak references (1)`, and may not use :term:`remote
references`.
* Allocations may be variable in size.
@ -126,14 +127,13 @@ AMS interface
blocks remain in this generation and are not promoted.
* :c:macro:`MPS_KEY_AMS_SUPPORT_AMBIGUOUS` (type
:c:type:`mps_bool_t`, default false) specifies whether references
may be ambiguous.
:c:type:`mps_bool_t`, default ``TRUE``) specifies whether
references to blocks in the pool may be ambiguous.
For example::
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, fmt);
MPS_ARGS_ADD(args, MPS_KEY_AMS_SUPPORT_AMBIGUOUS, 1);
res = mps_pool_create_k(&pool, arena, mps_class_ams(), args);
} MPS_ARGS_END(args);

6
mps/manual/source/pool/awl.rst
View file

@ -283,9 +283,9 @@ the format of objects allocated in it:
"Aligned pointer" means a word whose numeric value (that is, its
value when treated as an unsigned integer) is a multiple of the size
of a pointer. For you're using a 32-bit architecture, that means
that an aligned pointer is a multiple of 4 and its bottom two bits
are both zero.
of a pointer. If you're using a 64-bit architecture, that means that
an aligned pointer is a multiple of 8 and its bottom three bits are
zero.
The bottom line is that references from an object in an AWL pool
must be untagged and aligned, and integers must be tagged with a

26
mps/manual/source/release.rst
View file

@ -26,6 +26,20 @@ New features
:c:macro:`MPS_KEY_INTERIOR` keyword argument to ``FALSE`` when
calling :c:func:`mps_pool_create_k`.
#. The logic for deciding which generations should be collected has
changed. Now, a chain may be scheduled for collection if the new
size of *any* of its generations exceeds its capacity, and when a
chain is collected, all generations are collected up to, and
including, the highest generation whose new size exceeds its
capacity. This ensures that all generations are collected reliably
on chains where there is no allocation into the nursery generation.
See :ref:`topic-collection-schedule`.
(Previously, only the nursery generation in each chain
was considered, and a chain was collected up to, but not including,
the lowest generation whose new size was within its capacity.)
Interface changes
.................
@ -35,6 +49,11 @@ Interface changes
:c:func:`mps_arena_create_k` when creating a virtual memory arena.
See :c:func:`mps_arena_class_vm`.
#. The keyword argument :c:macro:`MPS_KEY_AMS_SUPPORT_AMBIGUOUS` now
defaults to ``TRUE`` in order to better support the general case:
the value ``FALSE`` is appropriate only when you know that all
references are exact. See :ref:`pool-ams`.
Other changes
.............
@ -64,6 +83,13 @@ Other changes
.. _job003756: https://www.ravenbrook.com/project/mps/issue/job003756/
#. :ref:`pool-ams` pools get reliably collected, even in the case
where an AMS pool is the only pool on its generation chain and is
allocating into some generation other than the nursery. See
job003771_.
.. _job003771: https://www.ravenbrook.com/project/mps/issue/job003771/
.. _release-notes-1.113:

72
mps/manual/source/topic/arena.rst
View file

@ -396,8 +396,8 @@ Arena properties
(over-)estimate the size of the heap.
If you want to know how much memory the MPS is using then you're
probably interested in the value ``mps_arena_committed() -
mps_arena_spare_committed()``.
probably interested in the value :c:func:`mps_arena_committed()` −
:c:func:`mps_arena_spare_committed`.
The amount of committed memory can be limited with the function
:c:func:`mps_arena_commit_limit`.
@ -457,7 +457,7 @@ Arena properties
Non-virtual-memory arena classes (for example, a :term:`client
arena`) do not have spare committed memory. For these arenas, this
function functions sets a value but has no other effect.
function sets a value but has no other effect.
Initially the spare commit limit is a configuration-dependent
value. The value of the limit can be retrieved by the function
@ -506,7 +506,7 @@ An arena is always in one of three states.
In the *unclamped state*, garbage collection may take place,
objects may move in memory, references may be updated,
:term:`location dependencies` may become stale, virtual memory may
be requested from or return to the operating system, and other
be requested from or returned to the operating system, and other
kinds of background activity may occur. This is the normal state.
#. .. index::
@ -531,19 +531,19 @@ An arena is always in one of three states.
Here's a summary:
======================================== ================================== ============================= ===========================
State unclamped clamped parked
======================================== ================================== ============================= ===========================
Collections may be running? yes yes no
New collections may start? yes no no
Objects may move? yes no no
Location dependencies may become stale? yes no no
Memory may be returned to the OS? yes no no
Functions that leave arena in this state :c:func:`mps_arena_create`, :c:func:`mps_arena_clamp`, :c:func:`mps_arena_park`,
:c:func:`mps_arena_release`, :c:func:`mps_arena_step` :c:func:`mps_arena_collect`
:c:func:`mps_arena_start_collect`,
:c:func:`mps_arena_step`
======================================== ================================== ============================= ===========================
============================================ ================================== ============================= ===========================
State unclamped clamped parked
============================================ ================================== ============================= ===========================
Collections may be running? yes yes no
New collections may start? yes no no
Objects may move? yes no no
Location dependencies may become stale? yes no no
Memory may be returned to the OS? yes no no
Functions that leave the arena in this state :c:func:`mps_arena_create`, :c:func:`mps_arena_clamp`, :c:func:`mps_arena_park`,
:c:func:`mps_arena_release`, :c:func:`mps_arena_step` :c:func:`mps_arena_collect`
:c:func:`mps_arena_start_collect`,
:c:func:`mps_arena_step`
============================================ ================================== ============================= ===========================
The clamped and parked states are important when introspecting and
debugging. If you are examining the contents of the heap, you don't
@ -556,7 +556,7 @@ before inspecting memory, and::
(gdb) print mps_arena_release(arena)
afterward.
afterwards.
The results of introspection functions like
:c:func:`mps_arena_has_addr` only remain valid while the arena remains
@ -692,24 +692,7 @@ provides a function, :c:func:`mps_arena_step`, for making use of idle
time to make memory management progress.
Here's an example illustrating the use of this function in a program's
event loop. When the program is idle (there are no client actions to
perform), it requests that the MPS spend up to 10 milliseconds on
incremental work, by calling ``mps_arena_step(arena, 0.010,
0.0)``. When this returns false to indicate that there is no more work
to do, the program blocks on the client for two seconds: if this times
out, it predicts that the user will remain idle for at least a further
second, so it calls ``mps_arena_step(arena, 0.010, 100.0)`` to tell
that it's a good time to start a collection taking up to 10 ms × 100
= 1 second, but not to pause for more than 10 ms.
The program remains responsive: the MPS doesn't take control for more
than a few milliseconds at a time (at most 10). But at the same time,
major collection work can get done at times when the program would
otherwise be idle. Of course the numbers here are only for
illustration and should be chosen based on the requirements of the
application.
::
event loop. ::
for (;;) { /* event loop */
for (;;) {
@ -729,6 +712,23 @@ application.
}
}
When the program is idle (there are no client actions to perform), it
requests that the MPS spend up to 10 milliseconds on incremental work,
by calling ``mps_arena_step(arena, 0.010, 0.0)``. When this returns
false to indicate that there is no more work to do, the program blocks
on the client for two seconds: if this times out, it predicts that the
user will remain idle for at least a further second, so it calls
``mps_arena_step(arena, 0.010, 100.0)`` to tell that it's a good time
to start a collection taking up to 10 ms × 100 = 1 second, but not to
pause for more than 10 ms.
The program remains responsive: the MPS doesn't take control for more
than a few milliseconds at a time (at most 10). But at the same time,
major collection work can get done at times when the program would
otherwise be idle. Of course the numbers here are only for
illustration; they should be chosen based on the requirements of the
application.
.. c:function:: mps_bool_t mps_arena_step(mps_arena_t arena, double interval, double multiplier)

Some files were not shown because too many files have changed in this diff Show more