diff --git a/mps/.p4ignore b/mps/.p4ignore
index fb2e5c024e5..25cd419ae6d 100644
--- a/mps/.p4ignore
+++ b/mps/.p4ignore
@@ -16,5 +16,8 @@ TAGS
*.dSYM
code/*/*/*.d
*.pyc
+test/obj
test/test/log
test/test/obj
+....gcda
+....gcno
\ No newline at end of file
diff --git a/mps/.travis.yml b/mps/.travis.yml
index 07a0dd66528..bc1dfd5bfb1 100644
--- a/mps/.travis.yml
+++ b/mps/.travis.yml
@@ -9,3 +9,5 @@ notifications:
email:
- mps-travis@ravenbrook.com
irc: "irc.freenode.net#memorypoolsystem"
+script:
+ - ./configure --prefix=$PWD/prefix && make install && make test
diff --git a/mps/Makefile.in b/mps/Makefile.in
index 2d558588673..1495a0fc313 100644
--- a/mps/Makefile.in
+++ b/mps/Makefile.in
@@ -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,15 +34,15 @@ 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 Release
$(XCODEBUILD) -config Debug
+ $(XCODEBUILD) -config Release
clean-xcode-build:
- $(XCODEBUILD) -config Release clean
$(XCODEBUILD) -config Debug clean
+ $(XCODEBUILD) -config Release clean
install-xcode-build: make-install-dirs build-via-xcode
$(INSTALL_DATA) code/mps*.h $(prefix)/include/
@@ -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 Release -target testrun
- $(XCODEBUILD) -config Debug -target testrun
+ $(XCODEBUILD) -config Debug -target testci
+ $(XCODEBUILD) -config Release -target testci
test: @TEST_TARGET@
diff --git a/mps/code/abq.c b/mps/code/abq.c
index b915bb42c9b..22286354c77 100644
--- a/mps/code/abq.c
+++ b/mps/code/abq.c
@@ -1,7 +1,7 @@
/* abq.c: QUEUE IMPLEMENTATION
*
* $Id$
- * Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*
* .purpose: A fixed-length FIFO queue.
*
@@ -185,18 +185,10 @@ Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE *strea
if(res != ResOK)
return res;
- res = METER_WRITE(abq->push, stream);
- if(res != ResOK)
- return res;
- res = METER_WRITE(abq->pop, stream);
- if(res != ResOK)
- return res;
- res = METER_WRITE(abq->peek, stream);
- if(res != ResOK)
- return res;
- res = METER_WRITE(abq->delete, stream);
- if(res != ResOK)
- return res;
+ METER_WRITE(abq->push, stream);
+ METER_WRITE(abq->pop, stream);
+ METER_WRITE(abq->peek, stream);
+ METER_WRITE(abq->delete, stream);
res = WriteF(stream, "}\n", NULL);
if(res != ResOK)
@@ -311,7 +303,7 @@ static void *ABQElement(ABQ abq, Index index) {
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2002 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/abqtest.c b/mps/code/abqtest.c
index 49d285c761f..9aad3351cb6 100644
--- a/mps/code/abqtest.c
+++ b/mps/code/abqtest.c
@@ -7,16 +7,16 @@
#include "abq.h"
#include "mps.h"
#include "mpsavm.h"
+#include "mpscmfs.h"
#include "mpstd.h"
#include "testlib.h"
-#include /* free, malloc */
#include /* printf */
SRCID(abqtest, "$Id$");
-
+static mps_pool_t pool;
static ABQStruct abq; /* the ABQ which we will use */
static Size abqSize; /* the size of the current ABQ */
@@ -51,9 +51,12 @@ static TestBlock testBlocks = NULL;
static TestBlock CreateTestBlock(unsigned no)
{
- TestBlock b = malloc(sizeof(TestBlockStruct));
- cdie(b != NULL, "malloc");
+ TestBlock b;
+ mps_addr_t p;
+ die(mps_alloc(&p, pool, sizeof(TestBlockStruct)), "alloc");
+
+ b = p;
b->next = testBlocks;
b->id = no;
b->base = 0;
@@ -79,7 +82,7 @@ static void DestroyTestBlock(TestBlock b)
}
}
- free(b);
+ mps_free(pool, b, sizeof(TestBlockStruct));
}
typedef struct TestClosureStruct *TestClosure;
@@ -93,6 +96,7 @@ static Bool TestDeleteCallback(Bool *deleteReturn, void *element,
{
TestBlock *a = (TestBlock *)element;
TestClosure cl = (TestClosure)closureP;
+ AVER(closureS == UNUSED_SIZE);
UNUSED(closureS);
if (*a == cl->b) {
*deleteReturn = TRUE;
@@ -141,15 +145,12 @@ static void step(void)
cdie(b != NULL, "found to delete");
cl.b = b;
cl.res = ResFAIL;
- ABQIterate(&abq, TestDeleteCallback, &cl, 0);
+ ABQIterate(&abq, TestDeleteCallback, &cl, UNUSED_SIZE);
cdie(cl.res == ResOK, "ABQIterate");
}
}
}
-
-#define testArenaSIZE (((size_t)4)<<20)
-
extern int main(int argc, char *argv[])
{
mps_arena_t arena;
@@ -159,9 +160,14 @@ extern int main(int argc, char *argv[])
abqSize = 0;
- die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
+ die(mps_arena_create_k(&arena, mps_arena_class_vm(), mps_args_none),
"mps_arena_create");
+ MPS_ARGS_BEGIN(args) {
+ MPS_ARGS_ADD(args, MPS_KEY_MFS_UNIT_SIZE, sizeof(TestBlockStruct));
+ die(mps_pool_create_k(&pool, arena, mps_class_mfs(), args), "pool_create");
+ } MPS_ARGS_END(args);
+
die(ABQInit((Arena)arena, &abq, NULL, ABQ_SIZE, sizeof(TestBlock)),
"ABQInit");
diff --git a/mps/code/airtest.c b/mps/code/airtest.c
index 31932bb4286..a4537a390db 100644
--- a/mps/code/airtest.c
+++ b/mps/code/airtest.c
@@ -35,7 +35,7 @@
#include "fmtscheme.h"
#define OBJ_LEN (1u << 4)
-#define OBJ_COUNT 1
+#define OBJ_COUNT 10
static void test_air(int interior, int stack)
{
@@ -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;
@@ -90,20 +90,15 @@ static mps_gen_param_s obj_gen_params[] = {
{ 170, 0.45 }
};
-static void test_main(int interior, int stack)
+static void test_main(void *marker, int interior, int stack)
{
mps_res_t res;
mps_chain_t obj_chain;
mps_fmt_t obj_fmt;
mps_thr_t thread;
mps_root_t reg_root = NULL;
- void *marker = ▮
- MPS_ARGS_BEGIN(args) {
- MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, 1 << 20);
- MPS_ARGS_DONE(args);
- res = mps_arena_create_k(&scheme_arena, mps_arena_class_vm(), args);
- } MPS_ARGS_END(args);
+ res = mps_arena_create_k(&scheme_arena, mps_arena_class_vm(), mps_args_none);
if (res != MPS_RES_OK) error("Couldn't create arena");
res = mps_chain_create(&obj_chain, scheme_arena,
@@ -117,7 +112,6 @@ static void test_main(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);
@@ -149,12 +143,14 @@ static void test_main(int interior, int stack)
int main(int argc, char *argv[])
{
+ void *marker = ▮
+
testlib_init(argc, argv);
- test_main(TRUE, TRUE);
- test_main(TRUE, FALSE);
- /* not test_main(FALSE, TRUE) -- see .fail.lii6ll. */
- test_main(FALSE, FALSE);
+ test_main(marker, TRUE, TRUE);
+ test_main(marker, TRUE, FALSE);
+ /* not test_main(marker, FALSE, TRUE) -- see .fail.lii6ll. */
+ test_main(marker, FALSE, FALSE);
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
return 0;
diff --git a/mps/code/amcss.c b/mps/code/amcss.c
index 20f4dae3740..20e86f80897 100644
--- a/mps/code/amcss.c
+++ b/mps/code/amcss.c
@@ -78,19 +78,6 @@ static void report(mps_arena_t arena)
printf(" not_condemned %"PRIuLONGEST"\n", (ulongest_t)not_condemned);
printf(" clock: %"PRIuLONGEST"\n", (ulongest_t)mps_message_clock(arena, message));
printf("}\n");
-
- if(condemned > (gen1SIZE + gen2SIZE + (size_t)128) * 1024) {
- /* When condemned size is larger than could happen in a gen 2
- * collection (discounting ramps, natch), guess that was a dynamic
- * collection, and reset the commit limit, so it doesn't run out.
- *
- * GDR 2013-03-12: Fiddling with the commit limit was causing
- * the test to fail sometimes (see job003440), so I've commented
- * out this feature.
- */
- /* die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "set limit"); */
- }
-
} else {
cdie(0, "unknown message type");
break;
@@ -98,8 +85,6 @@ static void report(mps_arena_t arena)
mps_message_discard(arena, message);
}
-
- return;
}
@@ -290,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);
@@ -297,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[])
@@ -310,11 +297,7 @@ int main(int argc, char *argv[])
"arena_create");
mps_message_type_enable(arena, mps_message_type_gc());
mps_message_type_enable(arena, mps_message_type_gc_start());
- /* GDR 2013-03-12: Fiddling with the commit limit was causing
- * the test to fail sometimes (see job003440), so I've commented
- * out this feature.
- */
- /*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");
test(arena, mps_class_amc(), exactRootsCOUNT);
test(arena, mps_class_amcz(), 0);
diff --git a/mps/code/amcsshe.c b/mps/code/amcsshe.c
index 11a5950f497..cd19b4219e6 100644
--- a/mps/code/amcsshe.c
+++ b/mps/code/amcsshe.c
@@ -91,18 +91,6 @@ static void report(mps_arena_t arena)
printf("not_condemned %"PRIuLONGEST"\n", (ulongest_t)not_condemned);
mps_message_discard(arena, message);
-
- if (condemned > (gen1SIZE + gen2SIZE + (size_t)128) * 1024) {
- /* When condemned size is larger than could happen in a gen 2
- * collection (discounting ramps, natch), guess that was a dynamic
- * collection, and reset the commit limit, so it doesn't run out.
- *
- * GDR 2013-03-07: Fiddling with the commit limit was causing
- * the test to fail sometimes (see job003432), so I've commented
- * out this feature.
- */
- /*die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "set limit");*/
- }
}
}
@@ -237,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);
@@ -245,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;
}
@@ -257,14 +247,10 @@ int main(int argc, char *argv[])
testlib_init(argc, argv);
- die(mps_arena_create(&arena, mps_arena_class_vm(), 3*testArenaSIZE),
+ die(mps_arena_create(&arena, mps_arena_class_vm(), 2*testArenaSIZE),
"arena_create\n");
mps_message_type_enable(arena, mps_message_type_gc());
- /* GDR 2013-03-07: Fiddling with the commit limit was causing
- * the test to fail sometimes (see job003432), so I've commented
- * out this feature.
- */
- /*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");
test(arena, mps_class_amc(), exactRootsCOUNT);
test(arena, mps_class_amcz(), 0);
diff --git a/mps/code/amcssth.c b/mps/code/amcssth.c
index 79eff570b0b..7c7bbf2ecb1 100644
--- a/mps/code/amcssth.c
+++ b/mps/code/amcssth.c
@@ -4,11 +4,20 @@
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
* Portions copyright (c) 2002 Global Graphics Software.
*
- * .posix: This is Posix only.
+ * .mode: This test case has two modes:
+ *
+ * .mode.walk: In this mode, the main thread parks the arena half way
+ * through the test case and runs mps_arena_formatted_objects_walk().
+ * This checks that walking works while the other threads continue to
+ * allocate in the background.
+ *
+ * .mode.commit: In this mode, the arena's commit limit is set. This
+ * checks that the MPS can make progress inside a tight limit in the
+ * presence of allocation on multiple threads. But this is
+ * incompatible with .mode.walk: if the arena is parked, then the
+ * arena has no chance to make progress.
*/
-#define _POSIX_C_SOURCE 199309L
-
#include "fmtdy.h"
#include "fmtdytst.h"
#include "testlib.h"
@@ -19,6 +28,11 @@
#include /* fflush, printf, putchar */
+enum {
+ ModeWALK = 0, /* .mode.walk */
+ ModeCOMMIT = 1 /* .mode.commit */
+};
+
/* These values have been tuned in the hope of getting one dynamic collection. */
#define testArenaSIZE ((size_t)1000*1024)
@@ -65,21 +79,15 @@ static void report(mps_arena_t arena)
printf("not_condemned %"PRIuLONGEST"\n", (ulongest_t)not_condemned);
mps_message_discard(arena, message);
-
- if (condemned > (gen1SIZE + gen2SIZE + (size_t)128) * 1024)
- /* When condemned size is larger than could happen in a gen 2
- * collection (discounting ramps, natch), guess that was a dynamic
- * collection, and reset the commit limit, so it doesn't run out. */
- die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "set limit");
}
}
-mps_arena_t arena;
-mps_fmt_t format;
-mps_chain_t chain;
-mps_root_t exactRoot, ambigRoot;
-unsigned long objs = 0;
+static mps_arena_t arena;
+static mps_fmt_t format;
+static mps_chain_t chain;
+static mps_root_t exactRoot, ambigRoot;
+static unsigned long objs = 0;
/* make -- create one new object */
@@ -141,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)
@@ -210,7 +207,7 @@ static void *kid_thread(void *arg)
/* test -- the body of the test */
-static void *test(mps_class_t pool_class, size_t roots_count)
+static void test_pool(mps_pool_t pool, size_t roots_count, int mode)
{
size_t i;
mps_word_t collections, rampSwitch;
@@ -218,12 +215,9 @@ static void *test(mps_class_t pool_class, size_t roots_count)
int ramping;
mps_ap_t ap, busy_ap;
mps_addr_t busy_init;
- mps_pool_t pool;
testthr_t kids[10];
closure_s cl;
-
- die(mps_pool_create(&pool, arena, pool_class, format, chain),
- "pool_create(amc)");
+ int walked = FALSE, ramped = FALSE;
cl.pool = pool;
cl.roots_count = roots_count;
@@ -243,28 +237,30 @@ static void *test(mps_class_t pool_class, size_t roots_count)
die(mps_ap_alloc_pattern_begin(busy_ap, ramp), "pattern begin (busy_ap)");
ramping = 1;
while (collections < collectionsCOUNT) {
- unsigned long c;
+ mps_word_t c;
size_t r;
c = mps_collections(arena);
if (collections != c) {
collections = c;
- printf("\nCollection %lu started, %lu objects.\n", c, objs);
+ printf("\nCollection %lu started, %lu objects, committed=%lu.\n",
+ (unsigned long)c, objs, (unsigned long)mps_arena_committed(arena));
report(arena);
for (i = 0; i < exactRootsCOUNT; ++i)
cdie(exactRoots[i] == objNULL || dylan_check(exactRoots[i]),
"all roots check");
- if (collections == collectionsCOUNT / 2) {
+ if (mode == ModeWALK && collections >= collectionsCOUNT / 2 && !walked) {
unsigned long object_count = 0;
mps_arena_park(arena);
mps_arena_formatted_objects_walk(arena, test_stepper, &object_count, 0);
mps_arena_release(arena);
printf("stepped on %lu objects.\n", object_count);
+ walked = TRUE;
}
- if (collections == rampSwitch) {
+ if (collections >= rampSwitch && !ramped) {
int begin_ramp = !ramping
|| /* Every other time, switch back immediately. */ (collections & 1);
@@ -289,6 +285,7 @@ static void *test(mps_class_t pool_class, size_t roots_count)
ramping = 1;
}
}
+ ramped = TRUE;
}
churn(ap, roots_count);
@@ -311,37 +308,51 @@ static void *test(mps_class_t pool_class, size_t roots_count)
for (i = 0; i < sizeof(kids)/sizeof(kids[0]); ++i)
testthr_join(&kids[i], NULL);
-
- mps_pool_destroy(pool);
-
- return NULL;
}
-int main(int argc, char *argv[])
+static void test_arena(int mode)
{
mps_thr_t thread;
mps_root_t reg_root;
+ mps_pool_t amc_pool, amcz_pool;
void *marker = ▮
- testlib_init(argc, argv);
-
die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
"arena_create");
+ if (mode == ModeCOMMIT)
+ die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "set limit");
mps_message_type_enable(arena, mps_message_type_gc());
init();
die(mps_thread_reg(&thread, arena), "thread_reg");
die(mps_root_create_reg(®_root, arena, mps_rank_ambig(), 0, thread,
- mps_stack_scan_ambig, marker, 0), "root_create");
+ mps_stack_scan_ambig, marker, 0), "root_create");
- test(mps_class_amc(), exactRootsCOUNT);
- test(mps_class_amcz(), 0);
+ 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);
+}
+
+int main(int argc, char *argv[])
+{
+ testlib_init(argc, argv);
+ test_arena(ModeWALK);
+ test_arena(ModeCOMMIT);
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
return 0;
diff --git a/mps/code/amsss.c b/mps/code/amsss.c
index dafa0297d9e..0ed1ca966d8 100644
--- a/mps/code/amsss.c
+++ b/mps/code/amsss.c
@@ -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, "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);
diff --git a/mps/code/amssshe.c b/mps/code/amssshe.c
index ce5dd4800c8..206e7c29ffe 100644
--- a/mps/code/amssshe.c
+++ b/mps/code/amssshe.c
@@ -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;
}
diff --git a/mps/code/anangc.gmk b/mps/code/anangc.gmk
new file mode 100644
index 00000000000..f0a7d2ff515
--- /dev/null
+++ b/mps/code/anangc.gmk
@@ -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 .
+# 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.
diff --git a/mps/code/ananll.gmk b/mps/code/ananll.gmk
new file mode 100644
index 00000000000..cc95645f212
--- /dev/null
+++ b/mps/code/ananll.gmk
@@ -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 .
+# 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.
diff --git a/mps/code/ananmv.nmk b/mps/code/ananmv.nmk
new file mode 100644
index 00000000000..ea68b19ee68
--- /dev/null
+++ b/mps/code/ananmv.nmk
@@ -0,0 +1,129 @@
+# 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
+
+# MPM platform-specific sources.
+MPMPF = \
+ \
+ \
+ \
+ \
+ \
+ \
+
+
+!INCLUDE commpre.nmk
+!INCLUDE mv.nmk
+
+
+# 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\)
+FMTDYOBJ0 = $(FMTDY:<=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\)
+FMTDYOBJ0 = $(FMTDY:<=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\)
+FMTDYOBJ0 = $(FMTDY:<=ananmv\rash\)
+FMTTESTOBJ0 = $(FMTTEST:<=ananmv\rash\)
+FMTSCHEMEOBJ0 = $(FMTSCHEME:<=ananmv\rash\)
+POOLNOBJ0 = $(POOLN:<=ananmv\rash\)
+TESTLIBOBJ0 = $(TESTLIB:<=ananmv\rash\)
+TESTTHROBJ0 = $(TESTTHR:<=ananmv\rash\)
+
+!ENDIF
+
+# %%PART: When adding a new part, add new macros which expand to the object
+# files included in the part
+
+MPMOBJ = $(MPMOBJ0:>=.obj)
+FMTDYOBJ = $(FMTDYOBJ0:>=.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 .
+# 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.
diff --git a/mps/code/arena.c b/mps/code/arena.c
index 30f7687ce81..d270adf7499 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -19,7 +19,7 @@ SRCID(arena, "$Id$");
#define ArenaControlPool(arena) MV2Pool(&(arena)->controlPoolStruct)
#define ArenaCBSBlockPool(arena) (&(arena)->freeCBSBlockPoolStruct.poolStruct)
-#define ArenaFreeCBS(arena) (&(arena)->freeCBSStruct)
+#define ArenaFreeLand(arena) (&(arena)->freeLandStruct.landStruct)
/* Forward declarations */
@@ -153,9 +153,9 @@ Bool ArenaCheck(Arena arena)
CHECKL(LocusCheck(arena));
- CHECKL(BoolCheck(arena->hasFreeCBS));
- if (arena->hasFreeCBS)
- CHECKD(CBS, ArenaFreeCBS(arena));
+ CHECKL(BoolCheck(arena->hasFreeLand));
+ if (arena->hasFreeLand)
+ CHECKD(Land, ArenaFreeLand(arena));
CHECKL(BoolCheck(arena->zoned));
@@ -200,7 +200,7 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args)
arena->poolReady = FALSE; /* */
arena->lastTract = NULL;
arena->lastTractBase = NULL;
- arena->hasFreeCBS = FALSE;
+ arena->hasFreeLand = FALSE;
arena->freeZones = ZoneSetUNIV;
arena->zoned = zoned;
@@ -216,14 +216,15 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args)
goto failGlobalsInit;
arena->sig = ArenaSig;
+ AVERT(Arena, arena);
/* Initialise a pool to hold the arena's CBS blocks. This pool can't be
allowed to extend itself using ArenaAlloc because it is used during
ArenaAlloc, so MFSExtendSelf is set to FALSE. Failures to extend are
- handled where the CBS is used. */
+ handled where the Land is used. */
MPS_ARGS_BEGIN(piArgs) {
- MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSBlockStruct));
+ MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSZonedBlockStruct));
MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, arena->alignment);
MPS_ARGS_ADD(piArgs, MFSExtendSelf, FALSE);
res = PoolInit(ArenaCBSBlockPool(arena), arena, PoolClassMFS(), piArgs);
@@ -232,17 +233,17 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args)
if (res != ResOK)
goto failMFSInit;
- /* Initialise the freeCBS. */
- MPS_ARGS_BEGIN(cbsiArgs) {
- MPS_ARGS_ADD(cbsiArgs, CBSBlockPool, ArenaCBSBlockPool(arena));
- res = CBSInit(ArenaFreeCBS(arena), arena, arena, alignment,
- /* fastFind */ TRUE, arena->zoned, cbsiArgs);
- } MPS_ARGS_END(cbsiArgs);
+ /* Initialise the freeLand. */
+ MPS_ARGS_BEGIN(liArgs) {
+ MPS_ARGS_ADD(liArgs, CBSBlockPool, ArenaCBSBlockPool(arena));
+ res = LandInit(ArenaFreeLand(arena), CBSZonedLandClassGet(), arena,
+ alignment, arena, liArgs);
+ } MPS_ARGS_END(liArgs);
AVER(res == ResOK); /* no allocation, no failure expected */
if (res != ResOK)
- goto failCBSInit;
- /* Note that although freeCBS is initialised, it doesn't have any memory
- for its blocks, so hasFreeCBS remains FALSE until later. */
+ goto failLandInit;
+ /* Note that although freeLand is initialised, it doesn't have any memory
+ for its blocks, so hasFreeLand remains FALSE until later. */
/* initialize the reservoir, */
res = ReservoirInit(&arena->reservoirStruct, arena);
@@ -253,8 +254,8 @@ Res ArenaInit(Arena arena, ArenaClass class, Align alignment, ArgList args)
return ResOK;
failReservoirInit:
- CBSFinish(ArenaFreeCBS(arena));
-failCBSInit:
+ LandFinish(ArenaFreeLand(arena));
+failLandInit:
PoolFinish(ArenaCBSBlockPool(arena));
failMFSInit:
GlobalsFinish(ArenaGlobals(arena));
@@ -304,15 +305,15 @@ Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
goto failStripeSize;
}
- /* With the primary chunk initialised we can add page memory to the freeCBS
+ /* With the primary chunk initialised we can add page memory to the freeLand
that describes the free address space in the primary chunk. */
- arena->hasFreeCBS = TRUE;
- res = ArenaFreeCBSInsert(arena,
- PageIndexBase(arena->primary,
- arena->primary->allocBase),
- arena->primary->limit);
+ arena->hasFreeLand = TRUE;
+ res = ArenaFreeLandInsert(arena,
+ PageIndexBase(arena->primary,
+ arena->primary->allocBase),
+ arena->primary->limit);
if (res != ResOK)
- goto failPrimaryCBS;
+ goto failPrimaryLand;
res = ControlInit(arena);
if (res != ResOK)
@@ -329,7 +330,7 @@ Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
failGlobalsCompleteCreate:
ControlFinish(arena);
failControlInit:
-failPrimaryCBS:
+failPrimaryLand:
failStripeSize:
(*class->finish)(arena);
failInit:
@@ -359,6 +360,8 @@ static void arenaMFSPageFreeVisitor(Pool pool, Addr base, Size size,
void *closureP, Size closureS)
{
AVERT(Pool, pool);
+ AVER(closureP == UNUSED_POINTER);
+ AVER(closureS == UNUSED_SIZE);
UNUSED(closureP);
UNUSED(closureS);
UNUSED(size);
@@ -378,16 +381,16 @@ void ArenaDestroy(Arena arena)
arena->poolReady = FALSE;
ControlFinish(arena);
- /* We must tear down the freeCBS before the chunks, because pages
+ /* We must tear down the freeLand before the chunks, because pages
containing CBS blocks might be allocated in those chunks. */
- AVER(arena->hasFreeCBS);
- arena->hasFreeCBS = FALSE;
- CBSFinish(ArenaFreeCBS(arena));
+ AVER(arena->hasFreeLand);
+ arena->hasFreeLand = FALSE;
+ LandFinish(ArenaFreeLand(arena));
/* The CBS block pool can't free its own memory via ArenaFree because
- that would use the ZonedCBS. */
- MFSFinishTracts(ArenaCBSBlockPool(arena),
- arenaMFSPageFreeVisitor, NULL, 0);
+ that would use the freeLand. */
+ MFSFinishTracts(ArenaCBSBlockPool(arena), arenaMFSPageFreeVisitor,
+ UNUSED_POINTER, UNUSED_SIZE);
PoolFinish(ArenaCBSBlockPool(arena));
/* Call class-specific finishing. This will call ArenaFinish. */
@@ -601,9 +604,10 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream)
/* arenaAllocPage -- allocate one page from the arena
*
- * This is a primitive allocator used to allocate pages for the arena CBS.
- * It is called rarely and can use a simple search. It may not use the
- * CBS or any pool, because it is used as part of the bootstrap.
+ * This is a primitive allocator used to allocate pages for the arena
+ * Land. It is called rarely and can use a simple search. It may not
+ * use the Land or any pool, because it is used as part of the
+ * bootstrap.
*/
static Res arenaAllocPageInChunk(Addr *baseReturn, Chunk chunk, Pool pool)
@@ -685,7 +689,7 @@ static Res arenaExtendCBSBlockPool(Range pageRangeReturn, Arena arena)
return ResOK;
}
-/* arenaExcludePage -- exclude CBS block pool's page from CBSs
+/* arenaExcludePage -- exclude CBS block pool's page from free land
*
* Exclude the page we specially allocated for the CBS block pool
* so that it doesn't get reallocated.
@@ -696,20 +700,20 @@ static void arenaExcludePage(Arena arena, Range pageRange)
RangeStruct oldRange;
Res res;
- res = CBSDelete(&oldRange, ArenaFreeCBS(arena), pageRange);
- AVER(res == ResOK); /* we just gave memory to the CBSs */
+ res = LandDelete(&oldRange, ArenaFreeLand(arena), pageRange);
+ AVER(res == ResOK); /* we just gave memory to the Land */
}
-/* arenaCBSInsert -- add a block to an arena CBS, extending pool if necessary
+/* arenaLandInsert -- add range to arena's land, maybe extending block pool
*
- * The arena's CBSs can't get memory in the usual way because they are used
- * in the basic allocator, so we allocate pages specially.
+ * The arena's land can't get memory in the usual way because it is
+ * used in the basic allocator, so we allocate pages specially.
*
* Only fails if it can't get a page for the block pool.
*/
-static Res arenaCBSInsert(Range rangeReturn, Arena arena, Range range)
+static Res arenaLandInsert(Range rangeReturn, Arena arena, Range range)
{
Res res;
@@ -717,17 +721,17 @@ static Res arenaCBSInsert(Range rangeReturn, Arena arena, Range range)
AVERT(Arena, arena);
AVERT(Range, range);
- res = CBSInsert(rangeReturn, ArenaFreeCBS(arena), range);
+ res = LandInsert(rangeReturn, ArenaFreeLand(arena), range);
- if (res == ResLIMIT) { /* freeCBS MFS pool ran out of blocks */
+ if (res == ResLIMIT) { /* CBS block pool ran out of blocks */
RangeStruct pageRange;
res = arenaExtendCBSBlockPool(&pageRange, arena);
if (res != ResOK)
return res;
/* .insert.exclude: Must insert before exclude so that we can
bootstrap when the zoned CBS is empty. */
- res = CBSInsert(rangeReturn, ArenaFreeCBS(arena), range);
- AVER(res == ResOK); /* we just gave memory to the CBSs */
+ res = LandInsert(rangeReturn, ArenaFreeLand(arena), range);
+ AVER(res == ResOK); /* we just gave memory to the CBS block pool */
arenaExcludePage(arena, &pageRange);
}
@@ -735,16 +739,16 @@ static Res arenaCBSInsert(Range rangeReturn, Arena arena, Range range)
}
-/* ArenaFreeCBSInsert -- add a block to arena CBS, maybe stealing memory
+/* ArenaFreeLandInsert -- add range to arena's land, maybe stealing memory
*
- * See arenaCBSInsert. This function may only be applied to mapped pages
- * and may steal them to store CBS nodes if it's unable to allocate
- * space for CBS nodes.
+ * See arenaLandInsert. This function may only be applied to mapped
+ * pages and may steal them to store Land nodes if it's unable to
+ * allocate space for CBS blocks.
*
* IMPORTANT: May update rangeIO.
*/
-static void arenaCBSInsertSteal(Range rangeReturn, Arena arena, Range rangeIO)
+static void arenaLandInsertSteal(Range rangeReturn, Arena arena, Range rangeIO)
{
Res res;
@@ -752,7 +756,7 @@ static void arenaCBSInsertSteal(Range rangeReturn, Arena arena, Range rangeIO)
AVERT(Arena, arena);
AVERT(Range, rangeIO);
- res = arenaCBSInsert(rangeReturn, arena, rangeIO);
+ res = arenaLandInsert(rangeReturn, arena, rangeIO);
if (res != ResOK) {
Addr pageBase;
@@ -773,22 +777,22 @@ static void arenaCBSInsertSteal(Range rangeReturn, Arena arena, Range rangeIO)
MFSExtend(ArenaCBSBlockPool(arena), pageBase, ArenaAlign(arena));
/* Try again. */
- res = CBSInsert(rangeReturn, ArenaFreeCBS(arena), rangeIO);
- AVER(res == ResOK); /* we just gave memory to the CBS */
+ res = LandInsert(rangeReturn, ArenaFreeLand(arena), rangeIO);
+ AVER(res == ResOK); /* we just gave memory to the CBS block pool */
}
- AVER(res == ResOK); /* not expecting other kinds of error from the CBS */
+ AVER(res == ResOK); /* not expecting other kinds of error from the Land */
}
-/* ArenaFreeCBSInsert -- add block to free CBS, extending pool if necessary
+/* ArenaFreeLandInsert -- add range to arena's land, maybe extending block pool
*
* The inserted block of address space may not abut any existing block.
* This restriction ensures that we don't coalesce chunks and allocate
* object across the boundary, preventing chunk deletion.
*/
-Res ArenaFreeCBSInsert(Arena arena, Addr base, Addr limit)
+Res ArenaFreeLandInsert(Arena arena, Addr base, Addr limit)
{
RangeStruct range, oldRange;
Res res;
@@ -796,7 +800,7 @@ Res ArenaFreeCBSInsert(Arena arena, Addr base, Addr limit)
AVERT(Arena, arena);
RangeInit(&range, base, limit);
- res = arenaCBSInsert(&oldRange, arena, &range);
+ res = arenaLandInsert(&oldRange, arena, &range);
if (res != ResOK)
return res;
@@ -809,7 +813,7 @@ Res ArenaFreeCBSInsert(Arena arena, Addr base, Addr limit)
}
-/* ArenaFreeCBSDelete -- remove a block from free CBS, extending pool if necessary
+/* ArenaFreeLandDelete -- remove range from arena's land, maybe extending block pool
*
* This is called from ChunkFinish in order to remove address space from
* the arena.
@@ -820,13 +824,13 @@ Res ArenaFreeCBSInsert(Arena arena, Addr base, Addr limit)
* so we can't test that path.
*/
-void ArenaFreeCBSDelete(Arena arena, Addr base, Addr limit)
+void ArenaFreeLandDelete(Arena arena, Addr base, Addr limit)
{
RangeStruct range, oldRange;
Res res;
RangeInit(&range, base, limit);
- res = CBSDelete(&oldRange, ArenaFreeCBS(arena), &range);
+ res = LandDelete(&oldRange, ArenaFreeLand(arena), &range);
/* Shouldn't be any other kind of failure because we were only deleting
a non-coalesced block. See .chunk.no-coalesce and
@@ -835,13 +839,13 @@ void ArenaFreeCBSDelete(Arena arena, Addr base, Addr limit)
}
-static Res arenaAllocFromCBS(Tract *tractReturn, ZoneSet zones, Bool high,
+static Res arenaAllocFromLand(Tract *tractReturn, ZoneSet zones, Bool high,
Size size, Pool pool)
{
Arena arena;
RangeStruct range, oldRange;
Chunk chunk;
- Bool b;
+ Bool found, b;
Index baseIndex;
Count pages;
Res res;
@@ -858,8 +862,8 @@ static Res arenaAllocFromCBS(Tract *tractReturn, ZoneSet zones, Bool high,
/* Step 1. Find a range of address space. */
- res = CBSFindInZones(&range, &oldRange, ArenaFreeCBS(arena),
- size, zones, high);
+ res = LandFindInZones(&found, &range, &oldRange, ArenaFreeLand(arena),
+ size, zones, high);
if (res == ResLIMIT) { /* found block, but couldn't store info */
RangeStruct pageRange;
@@ -867,17 +871,17 @@ static Res arenaAllocFromCBS(Tract *tractReturn, ZoneSet zones, Bool high,
if (res != ResOK) /* disastrously short on memory */
return res;
arenaExcludePage(arena, &pageRange);
- res = CBSFindInZones(&range, &oldRange, ArenaFreeCBS(arena),
- size, zones, high);
+ res = LandFindInZones(&found, &range, &oldRange, ArenaFreeLand(arena),
+ size, zones, high);
AVER(res != ResLIMIT);
}
- if (res == ResFAIL) /* out of address space */
- return ResRESOURCE;
-
AVER(res == ResOK); /* unexpected error from ZoneCBS */
if (res != ResOK) /* defensive return */
return res;
+
+ if (!found) /* out of address space */
+ return ResRESOURCE;
/* Step 2. Make memory available in the address space range. */
@@ -901,7 +905,7 @@ static Res arenaAllocFromCBS(Tract *tractReturn, ZoneSet zones, Bool high,
failMark:
{
- Res insertRes = arenaCBSInsert(&oldRange, arena, &range);
+ Res insertRes = arenaLandInsert(&oldRange, arena, &range);
AVER(insertRes == ResOK); /* We only just deleted it. */
/* If the insert does fail, we lose some address space permanently. */
}
@@ -942,10 +946,10 @@ static Res arenaAllocPolicy(Tract *tractReturn, Arena arena, SegPref pref,
}
}
- /* Plan A: allocate from the free CBS in the requested zones */
+ /* Plan A: allocate from the free Land in the requested zones */
zones = ZoneSetDiff(pref->zones, pref->avoid);
if (zones != ZoneSetEMPTY) {
- res = arenaAllocFromCBS(&tract, zones, pref->high, size, pool);
+ res = arenaAllocFromLand(&tract, zones, pref->high, size, pool);
if (res == ResOK)
goto found;
}
@@ -957,7 +961,7 @@ static Res arenaAllocPolicy(Tract *tractReturn, Arena arena, SegPref pref,
See also job003384. */
moreZones = ZoneSetUnion(pref->zones, ZoneSetDiff(arena->freeZones, pref->avoid));
if (moreZones != zones) {
- res = arenaAllocFromCBS(&tract, moreZones, pref->high, size, pool);
+ res = arenaAllocFromLand(&tract, moreZones, pref->high, size, pool);
if (res == ResOK)
goto found;
}
@@ -968,13 +972,13 @@ static Res arenaAllocPolicy(Tract *tractReturn, Arena arena, SegPref pref,
if (res != ResOK)
return res;
if (zones != ZoneSetEMPTY) {
- res = arenaAllocFromCBS(&tract, zones, pref->high, size, pool);
+ res = arenaAllocFromLand(&tract, zones, pref->high, size, pool);
if (res == ResOK)
goto found;
}
if (moreZones != zones) {
zones = ZoneSetUnion(zones, ZoneSetDiff(arena->freeZones, pref->avoid));
- res = arenaAllocFromCBS(&tract, moreZones, pref->high, size, pool);
+ res = arenaAllocFromLand(&tract, moreZones, pref->high, size, pool);
if (res == ResOK)
goto found;
}
@@ -986,7 +990,7 @@ static Res arenaAllocPolicy(Tract *tractReturn, Arena arena, SegPref pref,
/* TODO: log an event for this */
evenMoreZones = ZoneSetDiff(ZoneSetUNIV, pref->avoid);
if (evenMoreZones != moreZones) {
- res = arenaAllocFromCBS(&tract, evenMoreZones, pref->high, size, pool);
+ res = arenaAllocFromLand(&tract, evenMoreZones, pref->high, size, pool);
if (res == ResOK)
goto found;
}
@@ -995,7 +999,7 @@ static Res arenaAllocPolicy(Tract *tractReturn, Arena arena, SegPref pref,
common ambiguous bit patterns pin them down, causing the zone check
to give even more false positives permanently, and possibly retaining
garbage indefinitely. */
- res = arenaAllocFromCBS(&tract, ZoneSetUNIV, pref->high, size, pool);
+ res = arenaAllocFromLand(&tract, ZoneSetUNIV, pref->high, size, pool);
if (res == ResOK)
goto found;
@@ -1113,7 +1117,7 @@ void ArenaFree(Addr base, Size size, Pool pool)
RangeInit(&range, base, limit);
- arenaCBSInsertSteal(&oldRange, arena, &range); /* may update range */
+ arenaLandInsertSteal(&oldRange, arena, &range); /* may update range */
(*arena->class->free)(RangeBase(&range), RangeSize(&range), pool);
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index 3d07f529779..1a0fcf3c6e3 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -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);
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index 1bcc6272f35..f878092bd01 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -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;
@@ -480,7 +482,7 @@ ARG_DEFINE_KEY(arena_contracted, Fun);
static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
{
- Size userSize; /* size requested by user */
+ Size userSize = VM_ARENA_SIZE_DEFAULT; /* size requested by user */
Size chunkSize; /* size actually created */
Size vmArenaSize; /* aligned size of VMArenaStruct */
Res res;
@@ -495,8 +497,8 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
AVER(class == VMArenaClassGet());
AVERT(ArgList, args);
- ArgRequire(&arg, args, MPS_KEY_ARENA_SIZE);
- userSize = arg.val.size;
+ if (ArgPick(&arg, args, MPS_KEY_ARENA_SIZE))
+ userSize = arg.val.size;
AVER(userSize > 0);
@@ -593,6 +595,8 @@ static void VMArenaFinish(Arena arena)
AVERT(VMArena, vmArena);
arenaVM = vmArena->vm;
+ EVENT1(ArenaDestroy, vmArena);
+
/* destroy all chunks, including the primary */
arena->primary = NULL;
RING_FOR(node, &arena->chunkRing, next) {
@@ -612,7 +616,6 @@ static void VMArenaFinish(Arena arena)
VMUnmap(arenaVM, VMBase(arenaVM), VMLimit(arenaVM));
VMDestroy(arenaVM);
- EVENT1(ArenaDestroy, vmArena);
}
diff --git a/mps/code/arg.c b/mps/code/arg.c
index e3fea68754d..784a7e57f30 100644
--- a/mps/code/arg.c
+++ b/mps/code/arg.c
@@ -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];
diff --git a/mps/code/arg.h b/mps/code/arg.h
index dd458efe7b7..bb184dddad9 100644
--- a/mps/code/arg.h
+++ b/mps/code/arg.h
@@ -1,7 +1,7 @@
/* arg.h: Keyword argument lists
*
* $Id$
- * Copyright (c) 2013 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2013-2014 Ravenbrook Limited. See end of file for license.
*
* .source: See .
*/
@@ -28,6 +28,7 @@ typedef struct mps_key_s {
} KeyStruct;
#define ARG_DEFINE_KEY(id, type) \
+ extern const KeyStruct _mps_key_##id; \
const KeyStruct _mps_key_##id = {KeySig, #id, ArgCheck##type}
#define argsNone mps_args_none
@@ -62,7 +63,7 @@ extern Bool ArgCheckPool(Arg arg);
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2013 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/awlut.c b/mps/code/awlut.c
index c62153ed44c..464a2dba91f 100644
--- a/mps/code/awlut.c
+++ b/mps/code/awlut.c
@@ -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");
diff --git a/mps/code/awluthe.c b/mps/code/awluthe.c
index d3b2d572319..6ea468977f1 100644
--- a/mps/code/awluthe.c
+++ b/mps/code/awluthe.c
@@ -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");
diff --git a/mps/code/boot.c b/mps/code/boot.c
index eff8409fc1e..af365d3b4f1 100644
--- a/mps/code/boot.c
+++ b/mps/code/boot.c
@@ -30,7 +30,7 @@ Bool BootBlockCheck(BootBlock boot)
CHECKL(boot->limit != NULL);
CHECKL(boot->base <= boot->alloc);
CHECKL(boot->alloc <= boot->limit);
- CHECKL(boot->alloc < boot->limit);
+ CHECKL(boot->base < boot->limit);
return TRUE;
}
diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index baa553a19a2..a6cb2bee187 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -980,20 +980,21 @@ Bool BufferIsTrappedByMutator(Buffer buffer)
*
* Just represent the two patterns by two different pointers to dummies. */
-AllocPatternStruct AllocPatternRampStruct = {'\0'};
+static AllocPatternStruct AllocPatternRampStruct = {'\0'};
AllocPattern AllocPatternRamp(void)
{
return &AllocPatternRampStruct;
}
-AllocPatternStruct AllocPatternRampCollectAllStruct = {'\0'};
+static AllocPatternStruct AllocPatternRampCollectAllStruct = {'\0'};
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, 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, 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, buffer->isMutator, rank);
+ EVENT4(BufferInitRank, buffer, pool, BOOLOF(buffer->isMutator), rank);
return ResOK;
}
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 176a15fef16..6f0350d0519 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -26,63 +26,42 @@ SRCID(cbs, "$Id$");
#define CBSBlockSize(block) AddrOffset((block)->base, (block)->limit)
+#define cbsLand(cbs) (&((cbs)->landStruct))
+#define cbsOfLand(land) PARENT(CBSStruct, landStruct, land)
#define cbsSplay(cbs) (&((cbs)->splayTreeStruct))
#define cbsOfSplay(_splay) PARENT(CBSStruct, splayTreeStruct, _splay)
#define cbsBlockTree(block) (&((block)->treeStruct))
#define cbsBlockOfTree(_tree) TREE_ELT(CBSBlock, treeStruct, _tree)
+#define cbsFastBlockOfTree(_tree) \
+ PARENT(CBSFastBlockStruct, cbsBlockStruct, cbsBlockOfTree(_tree))
+#define cbsZonedBlockOfTree(_tree) \
+ PARENT(CBSZonedBlockStruct, cbsFastBlockStruct, cbsFastBlockOfTree(_tree))
#define cbsBlockKey(block) (&((block)->base))
#define cbsBlockPool(cbs) RVALUE((cbs)->blockPool)
-/* cbsEnter, cbsLeave -- Avoid re-entrance
- *
- * .enter-leave: The callbacks are restricted in what they may call.
- * These functions enforce this.
- *
- * .enter-leave.simple: Simple queries may be called from callbacks.
- */
-
-static void cbsEnter(CBS cbs)
-{
- /* Don't need to check as always called from interface function. */
- AVER(!cbs->inCBS);
- cbs->inCBS = TRUE;
- return;
-}
-
-static void cbsLeave(CBS cbs)
-{
- /* Don't need to check as always called from interface function. */
- AVER(cbs->inCBS);
- cbs->inCBS = FALSE;
- return;
-}
-
-
/* CBSCheck -- Check CBS */
Bool CBSCheck(CBS cbs)
{
/* See .enter-leave.simple. */
+ Land land;
CHECKS(CBS, cbs);
- CHECKL(cbs != NULL);
+ land = cbsLand(cbs);
+ CHECKD(Land, land);
CHECKD(SplayTree, cbsSplay(cbs));
- /* nothing to check about treeSize */
CHECKD(Pool, cbs->blockPool);
- CHECKU(Arena, cbs->arena);
- CHECKL(BoolCheck(cbs->fastFind));
- CHECKL(BoolCheck(cbs->inCBS));
CHECKL(BoolCheck(cbs->ownPool));
- CHECKL(BoolCheck(cbs->zoned));
- /* No MeterCheck */
+ CHECKL(SizeIsAligned(cbs->size, LandAlignment(land)));
+ CHECKL((cbs->size == 0) == (cbs->treeSize == 0));
return TRUE;
}
+ATTRIBUTE_UNUSED
static Bool CBSBlockCheck(CBSBlock block)
{
- /* See .enter-leave.simple. */
UNUSED(block); /* Required because there is no signature */
CHECKL(block != NULL);
/* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
@@ -139,7 +118,7 @@ static Bool cbsTestNode(SplayTree splay, Tree tree,
AVERT(Tree, tree);
AVER(closureP == NULL);
AVER(size > 0);
- AVER(cbsOfSplay(splay)->fastFind);
+ AVER(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass));
block = cbsBlockOfTree(tree);
@@ -149,51 +128,45 @@ static Bool cbsTestNode(SplayTree splay, Tree tree,
static Bool cbsTestTree(SplayTree splay, Tree tree,
void *closureP, Size size)
{
- CBSBlock block;
+ CBSFastBlock block;
AVERT(SplayTree, splay);
AVERT(Tree, tree);
-#if 0
AVER(closureP == NULL);
AVER(size > 0);
-#endif
- UNUSED(closureP);
- UNUSED(size);
- AVER(cbsOfSplay(splay)->fastFind);
+ AVER(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass));
- block = cbsBlockOfTree(tree);
+ block = cbsFastBlockOfTree(tree);
return block->maxSize >= size;
}
-/* cbsUpdateNode -- update size info after restructuring */
+/* cbsUpdateFastNode -- update size info after restructuring */
-static void cbsUpdateNode(SplayTree splay, Tree tree)
+static void cbsUpdateFastNode(SplayTree splay, Tree tree)
{
Size maxSize;
- CBSBlock block;
AVERT_CRITICAL(SplayTree, splay);
AVERT_CRITICAL(Tree, tree);
- AVER_CRITICAL(cbsOfSplay(splay)->fastFind);
+ AVER_CRITICAL(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSFastLandClass));
- block = cbsBlockOfTree(tree);
- maxSize = CBSBlockSize(block);
+ maxSize = CBSBlockSize(cbsBlockOfTree(tree));
if (TreeHasLeft(tree)) {
- Size size = cbsBlockOfTree(TreeLeft(tree))->maxSize;
+ Size size = cbsFastBlockOfTree(TreeLeft(tree))->maxSize;
if (size > maxSize)
maxSize = size;
}
if (TreeHasRight(tree)) {
- Size size = cbsBlockOfTree(TreeRight(tree))->maxSize;
+ Size size = cbsFastBlockOfTree(TreeRight(tree))->maxSize;
if (size > maxSize)
maxSize = size;
}
- block->maxSize = maxSize;
+ cbsFastBlockOfTree(tree)->maxSize = maxSize;
}
@@ -202,69 +175,57 @@ static void cbsUpdateNode(SplayTree splay, Tree tree)
static void cbsUpdateZonedNode(SplayTree splay, Tree tree)
{
ZoneSet zones;
+ CBSZonedBlock zonedBlock;
CBSBlock block;
Arena arena;
AVERT_CRITICAL(SplayTree, splay);
AVERT_CRITICAL(Tree, tree);
- AVER_CRITICAL(cbsOfSplay(splay)->fastFind);
- AVER_CRITICAL(cbsOfSplay(splay)->zoned);
+ AVER_CRITICAL(IsLandSubclass(cbsLand(cbsOfSplay(splay)), CBSZonedLandClass));
- cbsUpdateNode(splay, tree);
+ cbsUpdateFastNode(splay, tree);
- block = cbsBlockOfTree(tree);
- arena = cbsOfSplay(splay)->arena;
+ zonedBlock = cbsZonedBlockOfTree(tree);
+ block = &zonedBlock->cbsFastBlockStruct.cbsBlockStruct;
+ arena = LandArena(cbsLand(cbsOfSplay(splay)));
zones = ZoneSetOfRange(arena, CBSBlockBase(block), CBSBlockLimit(block));
if (TreeHasLeft(tree))
- zones = ZoneSetUnion(zones, cbsBlockOfTree(TreeLeft(tree))->zones);
+ zones = ZoneSetUnion(zones, cbsZonedBlockOfTree(TreeLeft(tree))->zones);
if (TreeHasRight(tree))
- zones = ZoneSetUnion(zones, cbsBlockOfTree(TreeRight(tree))->zones);
+ zones = ZoneSetUnion(zones, cbsZonedBlockOfTree(TreeRight(tree))->zones);
- block->zones = zones;
+ zonedBlock->zones = zones;
}
-/* CBSInit -- Initialise a CBS structure
+/* cbsInit -- Initialise a CBS structure
*
- * See .
+ * See .
*/
-ARG_DEFINE_KEY(cbs_extend_by, Size);
ARG_DEFINE_KEY(cbs_block_pool, Pool);
-Res CBSInit(CBS cbs, Arena arena, void *owner, Align alignment,
- Bool fastFind, Bool zoned, ArgList args)
+static Res cbsInitComm(Land land, ArgList args, SplayUpdateNodeMethod update,
+ Size blockStructSize)
{
- Size extendBy = CBS_EXTEND_BY_DEFAULT;
- Bool extendSelf = TRUE;
+ CBS cbs;
+ LandClass super;
ArgStruct arg;
Res res;
Pool blockPool = NULL;
- SplayUpdateNodeMethod update;
- AVERT(Arena, arena);
- AVER(cbs != NULL);
- AVERT(Align, alignment);
- AVERT(Bool, fastFind);
- AVERT(Bool, zoned);
+ AVERT(Land, land);
+ super = LAND_SUPERCLASS(CBSLandClass);
+ res = (*super->init)(land, args);
+ if (res != ResOK)
+ return res;
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;
-
- update = SplayTrivUpdate;
- if (fastFind)
- update = cbsUpdateNode;
- if (zoned) {
- AVER(fastFind);
- update = cbsUpdateZonedNode;
- }
+ cbs = cbsOfLand(land);
SplayTreeInit(cbsSplay(cbs), cbsCompare, cbsKey, update);
if (blockPool != NULL) {
@@ -272,43 +233,57 @@ Res CBSInit(CBS cbs, Arena arena, void *owner, Align alignment,
cbs->ownPool = FALSE;
} else {
MPS_ARGS_BEGIN(pcArgs) {
- MPS_ARGS_ADD(pcArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSBlockStruct));
- MPS_ARGS_ADD(pcArgs, MPS_KEY_EXTEND_BY, extendBy);
- MPS_ARGS_ADD(pcArgs, MFSExtendSelf, extendSelf);
- res = PoolCreate(&cbs->blockPool, arena, PoolClassMFS(), pcArgs);
+ MPS_ARGS_ADD(pcArgs, MPS_KEY_MFS_UNIT_SIZE, blockStructSize);
+ res = PoolCreate(&cbs->blockPool, LandArena(land), PoolClassMFS(), pcArgs);
} MPS_ARGS_END(pcArgs);
if (res != ResOK)
return res;
cbs->ownPool = TRUE;
}
cbs->treeSize = 0;
+ cbs->size = 0;
- cbs->arena = arena;
- cbs->fastFind = fastFind;
- cbs->zoned = zoned;
- cbs->alignment = alignment;
- cbs->inCBS = TRUE;
+ cbs->blockStructSize = blockStructSize;
METER_INIT(cbs->treeSearch, "size of tree", (void *)cbs);
cbs->sig = CBSSig;
AVERT(CBS, cbs);
- EVENT2(CBSInit, cbs, owner);
- cbsLeave(cbs);
return ResOK;
}
+static Res cbsInit(Land land, ArgList args)
+{
+ return cbsInitComm(land, args, SplayTrivUpdate,
+ sizeof(CBSBlockStruct));
+}
-/* CBSFinish -- Finish a CBS structure
+static Res cbsInitFast(Land land, ArgList args)
+{
+ return cbsInitComm(land, args, cbsUpdateFastNode,
+ sizeof(CBSFastBlockStruct));
+}
+
+static Res cbsInitZoned(Land land, ArgList args)
+{
+ return cbsInitComm(land, args, cbsUpdateZonedNode,
+ sizeof(CBSZonedBlockStruct));
+}
+
+
+/* cbsFinish -- Finish a CBS structure
*
- * See .
+ * See .
*/
-void CBSFinish(CBS cbs)
+static void cbsFinish(Land land)
{
+ CBS cbs;
+
+ AVERT(Land, land);
+ cbs = cbsOfLand(land);
AVERT(CBS, cbs);
- cbsEnter(cbs);
METER_EMIT(&cbs->treeSearch);
@@ -320,6 +295,23 @@ void CBSFinish(CBS cbs)
}
+/* cbsSize -- total size of ranges in CBS
+ *
+ * See .
+ */
+
+static Size cbsSize(Land land)
+{
+ CBS cbs;
+
+ AVERT(Land, land);
+ cbs = cbsOfLand(land);
+ AVERT(CBS, cbs);
+
+ return cbs->size;
+}
+
+
/* Node change operators
*
* These four functions are called whenever blocks are created,
@@ -330,19 +322,23 @@ void CBSFinish(CBS cbs)
static void cbsBlockDelete(CBS cbs, CBSBlock block)
{
Bool b;
+ Size size;
AVERT(CBS, cbs);
AVERT(CBSBlock, block);
+ size = CBSBlockSize(block);
METER_ACC(cbs->treeSearch, cbs->treeSize);
b = SplayTreeDelete(cbsSplay(cbs), cbsBlockTree(block));
AVER(b); /* expect block to be in the tree */
STATISTIC(--cbs->treeSize);
+ AVER(cbs->size >= size);
+ cbs->size -= size;
/* make invalid */
block->limit = block->base;
- PoolFree(cbsBlockPool(cbs), (Addr)block, sizeof(CBSBlockStruct));
+ PoolFree(cbsBlockPool(cbs), (Addr)block, cbs->blockStructSize);
}
static void cbsBlockShrunk(CBS cbs, CBSBlock block, Size oldSize)
@@ -354,11 +350,10 @@ static void cbsBlockShrunk(CBS cbs, CBSBlock block, Size oldSize)
newSize = CBSBlockSize(block);
AVER(oldSize > newSize);
+ AVER(cbs->size >= oldSize - newSize);
- if (cbs->fastFind) {
- SplayNodeRefresh(cbsSplay(cbs), cbsBlockTree(block));
- AVER(CBSBlockSize(block) <= block->maxSize);
- }
+ SplayNodeRefresh(cbsSplay(cbs), cbsBlockTree(block));
+ cbs->size -= oldSize - newSize;
}
static void cbsBlockGrew(CBS cbs, CBSBlock block, Size oldSize)
@@ -371,10 +366,8 @@ static void cbsBlockGrew(CBS cbs, CBSBlock block, Size oldSize)
newSize = CBSBlockSize(block);
AVER(oldSize < newSize);
- if (cbs->fastFind) {
- SplayNodeRefresh(cbsSplay(cbs), cbsBlockTree(block));
- AVER(CBSBlockSize(block) <= block->maxSize);
- }
+ SplayNodeRefresh(cbsSplay(cbs), cbsBlockTree(block));
+ cbs->size += newSize - oldSize;
}
/* cbsBlockAlloc -- allocate a new block and set its base and limit,
@@ -390,7 +383,7 @@ static Res cbsBlockAlloc(CBSBlock *blockReturn, CBS cbs, Range range)
AVERT(CBS, cbs);
AVERT(Range, range);
- res = PoolAlloc(&p, cbsBlockPool(cbs), sizeof(CBSBlockStruct),
+ res = PoolAlloc(&p, cbsBlockPool(cbs), cbs->blockStructSize,
/* withReservoirPermit */ FALSE);
if (res != ResOK)
goto failPoolAlloc;
@@ -399,7 +392,8 @@ static Res cbsBlockAlloc(CBSBlock *blockReturn, CBS cbs, Range range)
TreeInit(cbsBlockTree(block));
block->base = RangeBase(range);
block->limit = RangeLimit(range);
- block->maxSize = CBSBlockSize(block);
+
+ SplayNodeInit(cbsSplay(cbs), cbsBlockTree(block));
AVERT(CBSBlock, block);
*blockReturn = block;
@@ -423,13 +417,21 @@ static void cbsBlockInsert(CBS cbs, CBSBlock block)
b = SplayTreeInsert(cbsSplay(cbs), cbsBlockTree(block));
AVER(b);
STATISTIC(++cbs->treeSize);
+ cbs->size += CBSBlockSize(block);
}
-/* cbsInsertIntoTree -- Insert a range into the tree */
+/* cbsInsert -- Insert a range into the CBS
+ *
+ * See .
+ *
+ * .insert.alloc: Will only allocate a block if the range does not
+ * abut an existing range.
+ */
-static Res cbsInsertIntoTree(Range rangeReturn, CBS cbs, Range range)
+static Res cbsInsert(Range rangeReturn, Land land, Range range)
{
+ CBS cbs;
Bool b;
Res res;
Addr base, limit, newBase, newLimit;
@@ -439,10 +441,11 @@ static Res cbsInsertIntoTree(Range rangeReturn, CBS cbs, Range range)
Size oldSize;
AVER(rangeReturn != NULL);
- AVERT(CBS, cbs);
+ AVERT(Land, land);
AVERT(Range, range);
- AVER(RangeIsAligned(range, cbs->alignment));
+ AVER(RangeIsAligned(range, LandAlignment(land)));
+ cbs = cbsOfLand(land);
base = RangeBase(range);
limit = RangeLimit(range);
@@ -523,46 +526,28 @@ static Res cbsInsertIntoTree(Range rangeReturn, CBS cbs, Range range)
}
-/* CBSInsert -- Insert a range into the CBS
+/* cbsDelete -- Remove a range from a CBS
*
- * See .
+ * See .
*
- * .insert.alloc: Will only allocate a block if the range does not
- * abut an existing range.
+ * .delete.alloc: Will only allocate a block if the range splits
+ * an existing range.
*/
-Res CBSInsert(Range rangeReturn, CBS cbs, Range range)
-{
- Res res;
-
- AVERT(CBS, cbs);
- cbsEnter(cbs);
-
- AVER(rangeReturn != NULL);
- AVERT(Range, range);
- AVER(RangeIsAligned(range, cbs->alignment));
-
- res = cbsInsertIntoTree(rangeReturn, cbs, range);
-
- cbsLeave(cbs);
- return res;
-}
-
-
-/* cbsDeleteFromTree -- delete blocks from the tree */
-
-static Res cbsDeleteFromTree(Range rangeReturn, CBS cbs, Range range)
+static Res cbsDelete(Range rangeReturn, Land land, Range range)
{
+ CBS cbs;
Res res;
CBSBlock cbsBlock;
Tree tree;
Addr base, limit, oldBase, oldLimit;
Size oldSize;
+ AVERT(Land, land);
+ cbs = cbsOfLand(land);
AVER(rangeReturn != NULL);
- AVERT(CBS, cbs);
AVERT(Range, range);
- AVER(RangeIsAligned(range, cbs->alignment));
+ AVER(RangeIsAligned(range, LandAlignment(land)));
base = RangeBase(range);
limit = RangeLimit(range);
@@ -627,32 +612,6 @@ static Res cbsDeleteFromTree(Range rangeReturn, CBS cbs, Range range)
}
-/* CBSDelete -- Remove a range from a CBS
- *
- * See .
- *
- * .delete.alloc: Will only allocate a block if the range splits
- * an existing range.
- */
-
-Res CBSDelete(Range rangeReturn, CBS cbs, Range range)
-{
- Res res;
-
- AVERT(CBS, cbs);
- cbsEnter(cbs);
-
- AVER(rangeReturn != NULL);
- AVERT(Range, range);
- AVER(RangeIsAligned(range, cbs->alignment));
-
- res = cbsDeleteFromTree(rangeReturn, cbs, range);
-
- cbsLeave(cbs);
- return res;
-}
-
-
static Res cbsBlockDescribe(CBSBlock block, mps_lib_FILE *stream)
{
Res res;
@@ -661,11 +620,9 @@ static Res cbsBlockDescribe(CBSBlock block, mps_lib_FILE *stream)
return ResFAIL;
res = WriteF(stream,
- "[$P,$P) {$U, $B}",
+ "[$P,$P)",
(WriteFP)block->base,
(WriteFP)block->limit,
- (WriteFU)block->maxSize,
- (WriteFB)block->zones,
NULL);
return res;
}
@@ -683,25 +640,74 @@ static Res cbsSplayNodeDescribe(Tree tree, mps_lib_FILE *stream)
return res;
}
+static Res cbsFastBlockDescribe(CBSFastBlock block, mps_lib_FILE *stream)
+{
+ Res res;
-/* CBSIterate -- iterate over all blocks in CBS
+ if (stream == NULL)
+ return ResFAIL;
+
+ res = WriteF(stream,
+ "[$P,$P) {$U}",
+ (WriteFP)block->cbsBlockStruct.base,
+ (WriteFP)block->cbsBlockStruct.limit,
+ (WriteFU)block->maxSize,
+ NULL);
+ return res;
+}
+
+static Res cbsFastSplayNodeDescribe(Tree tree, mps_lib_FILE *stream)
+{
+ Res res;
+
+ if (tree == TreeEMPTY)
+ return ResFAIL;
+ if (stream == NULL)
+ return ResFAIL;
+
+ res = cbsFastBlockDescribe(cbsFastBlockOfTree(tree), stream);
+ return res;
+}
+
+static Res cbsZonedBlockDescribe(CBSZonedBlock block, mps_lib_FILE *stream)
+{
+ Res res;
+
+ if (stream == NULL)
+ return ResFAIL;
+
+ res = WriteF(stream,
+ "[$P,$P) {$U, $B}",
+ (WriteFP)block->cbsFastBlockStruct.cbsBlockStruct.base,
+ (WriteFP)block->cbsFastBlockStruct.cbsBlockStruct.limit,
+ (WriteFU)block->cbsFastBlockStruct.maxSize,
+ (WriteFB)block->zones,
+ NULL);
+ return res;
+}
+
+static Res cbsZonedSplayNodeDescribe(Tree tree, mps_lib_FILE *stream)
+{
+ Res res;
+
+ if (tree == TreeEMPTY)
+ return ResFAIL;
+ if (stream == NULL)
+ return ResFAIL;
+
+ res = cbsZonedBlockDescribe(cbsZonedBlockOfTree(tree), stream);
+ return res;
+}
+
+
+/* cbsIterate -- iterate over all blocks in CBS
*
- * Applies a visitor to all isolated contiguous ranges in a CBS.
- * It receives a pointer, ``Size`` closure pair to pass on to the
- * visitor function, and an visitor function to invoke on every range
- * in address order. If the visitor returns ``FALSE``, then the iteration
- * is terminated.
- *
- * The visitor function may not modify the CBS during the iteration.
- * This is because CBSIterate uses TreeTraverse, which does not permit
- * modification, for speed and to avoid perturbing the splay tree balance.
- *
- * See .
+ * See .
*/
typedef struct CBSIterateClosure {
- CBS cbs;
- CBSVisitor iterate;
+ Land land;
+ LandVisitor visitor;
void *closureP;
Size closureS;
} CBSIterateClosure;
@@ -711,26 +717,32 @@ static Bool cbsIterateVisit(Tree tree, void *closureP, Size closureS)
CBSIterateClosure *closure = closureP;
RangeStruct range;
CBSBlock cbsBlock;
- CBS cbs = closure->cbs;
+ Land land = closure->land;
+ CBS cbs = cbsOfLand(land);
+ Bool cont = TRUE;
+ AVER(closureS == UNUSED_SIZE);
UNUSED(closureS);
cbsBlock = cbsBlockOfTree(tree);
RangeInit(&range, CBSBlockBase(cbsBlock), CBSBlockLimit(cbsBlock));
- if (!closure->iterate(cbs, &range, closure->closureP, closure->closureS))
+ cont = (*closure->visitor)(land, &range, closure->closureP, closure->closureS);
+ if (!cont)
return FALSE;
METER_ACC(cbs->treeSearch, cbs->treeSize);
return TRUE;
}
-void CBSIterate(CBS cbs, CBSVisitor visitor,
- void *closureP, Size closureS)
+static Bool cbsIterate(Land land, LandVisitor visitor,
+ void *closureP, Size closureS)
{
+ CBS cbs;
SplayTree splay;
CBSIterateClosure closure;
+ AVERT(Land, land);
+ cbs = cbsOfLand(land);
AVERT(CBS, cbs);
- cbsEnter(cbs);
AVER(FUNCHECK(visitor));
splay = cbsSplay(cbs);
@@ -738,36 +750,19 @@ void CBSIterate(CBS cbs, CBSVisitor visitor,
/* searches and meter it. */
METER_ACC(cbs->treeSearch, cbs->treeSize);
- closure.cbs = cbs;
- closure.iterate = visitor;
+ closure.land = land;
+ closure.visitor = visitor;
closure.closureP = closureP;
closure.closureS = closureS;
- (void)TreeTraverse(SplayTreeRoot(splay), splay->compare, splay->nodeKey,
- cbsIterateVisit, &closure, 0);
-
- cbsLeave(cbs);
- return;
-}
-
-
-/* FindDeleteCheck -- check method for a FindDelete value */
-
-Bool FindDeleteCheck(FindDelete findDelete)
-{
- CHECKL(findDelete == FindDeleteNONE
- || findDelete == FindDeleteLOW
- || findDelete == FindDeleteHIGH
- || findDelete == FindDeleteENTIRE);
- UNUSED(findDelete); /* */
-
- return TRUE;
+ return TreeTraverse(SplayTreeRoot(splay), splay->compare, splay->nodeKey,
+ cbsIterateVisit, &closure, UNUSED_SIZE);
}
/* cbsFindDeleteRange -- delete appropriate range of block found */
static void cbsFindDeleteRange(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Range range, Size size,
+ Land land, Range range, Size size,
FindDelete findDelete)
{
Bool callDelete = TRUE;
@@ -775,11 +770,11 @@ static void cbsFindDeleteRange(Range rangeReturn, Range oldRangeReturn,
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(CBS, cbs);
+ AVERT(Land, land);
AVERT(Range, range);
- AVER(RangeIsAligned(range, cbs->alignment));
+ AVER(RangeIsAligned(range, LandAlignment(land)));
AVER(size > 0);
- AVER(SizeIsAligned(size, cbs->alignment));
+ AVER(SizeIsAligned(size, LandAlignment(land)));
AVER(RangeSize(range) >= size);
AVERT(FindDelete, findDelete);
@@ -813,32 +808,36 @@ static void cbsFindDeleteRange(Range rangeReturn, Range oldRangeReturn,
if (callDelete) {
Res res;
- res = cbsDeleteFromTree(oldRangeReturn, cbs, rangeReturn);
+ res = cbsDelete(oldRangeReturn, land, rangeReturn);
/* Can't have run out of memory, because all our callers pass in
blocks that were just found in the tree, and we only
- deleted from one end of the block, so cbsDeleteFromTree did not
+ deleted from one end of the block, so cbsDelete did not
need to allocate a new block. */
AVER(res == ResOK);
+ } else {
+ RangeCopy(oldRangeReturn, rangeReturn);
}
}
/* CBSFindFirst -- find the first block of at least the given size */
-Bool CBSFindFirst(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size, FindDelete findDelete)
+static Bool cbsFindFirst(Range rangeReturn, Range oldRangeReturn,
+ Land land, Size size, FindDelete findDelete)
{
+ CBS cbs;
Bool found;
Tree tree;
+ AVERT(Land, land);
+ cbs = cbsOfLand(land);
AVERT(CBS, cbs);
- cbsEnter(cbs);
+ AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass));
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
AVER(size > 0);
- AVER(SizeIsAligned(size, cbs->alignment));
- AVER(cbs->fastFind);
+ AVER(SizeIsAligned(size, LandAlignment(land)));
AVERT(FindDelete, findDelete);
METER_ACC(cbs->treeSearch, cbs->treeSize);
@@ -851,16 +850,17 @@ Bool CBSFindFirst(Range rangeReturn, Range oldRangeReturn,
AVER(CBSBlockSize(block) >= size);
RangeInit(&range, CBSBlockBase(block), CBSBlockLimit(block));
AVER(RangeSize(&range) >= size);
- cbsFindDeleteRange(rangeReturn, oldRangeReturn, cbs, &range,
+ cbsFindDeleteRange(rangeReturn, oldRangeReturn, land, &range,
size, findDelete);
}
- cbsLeave(cbs);
return found;
}
-/* CBSFindFirstInZones -- find the first block of at least the given size
- that lies entirely within a zone set */
+/* cbsFindInZones -- find a block of at least the given size that lies
+ * entirely within a zone set. (The first such block, if high is
+ * FALSE, or the last, if high is TRUE.)
+ */
typedef struct cbsTestNodeInZonesClosureStruct {
Size size;
@@ -872,15 +872,15 @@ typedef struct cbsTestNodeInZonesClosureStruct {
} cbsTestNodeInZonesClosureStruct, *cbsTestNodeInZonesClosure;
static Bool cbsTestNodeInZones(SplayTree splay, Tree tree,
- void *closureP, Size closureSize)
+ void *closureP, Size closureS)
{
CBSBlock block = cbsBlockOfTree(tree);
cbsTestNodeInZonesClosure closure = closureP;
RangeInZoneSet search;
UNUSED(splay);
- AVER(closureSize == sizeof(cbsTestNodeInZonesClosureStruct));
- UNUSED(closureSize);
+ AVER(closureS == UNUSED_SIZE);
+ UNUSED(closureS);
search = closure->high ? RangeInZoneSetLast : RangeInZoneSetFirst;
@@ -890,104 +890,39 @@ static Bool cbsTestNodeInZones(SplayTree splay, Tree tree,
}
static Bool cbsTestTreeInZones(SplayTree splay, Tree tree,
- void *closureP, Size closureSize)
+ void *closureP, Size closureS)
{
- CBSBlock block = cbsBlockOfTree(tree);
+ CBSFastBlock fastBlock = cbsFastBlockOfTree(tree);
+ CBSZonedBlock zonedBlock = cbsZonedBlockOfTree(tree);
cbsTestNodeInZonesClosure closure = closureP;
UNUSED(splay);
- AVER(closureSize == sizeof(cbsTestNodeInZonesClosureStruct));
- UNUSED(closureSize);
+ AVER(closureS == UNUSED_SIZE);
+ UNUSED(closureS);
- return block->maxSize >= closure->size &&
- ZoneSetInter(block->zones, closure->zoneSet) != ZoneSetEMPTY;
-}
-
-Res CBSFindInZones(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size,
- ZoneSet zoneSet, Bool high)
-{
- Tree tree;
- cbsTestNodeInZonesClosureStruct closure;
- Res res;
- CBSFindMethod cbsFind;
- SplayFindMethod splayFind;
-
- AVER(rangeReturn != NULL);
- AVER(oldRangeReturn != NULL);
- AVERT(CBS, cbs);
- /* AVERT(ZoneSet, zoneSet); */
- AVERT(Bool, high);
-
- cbsFind = high ? CBSFindLast : CBSFindFirst;
- splayFind = high ? SplayFindLast : SplayFindFirst;
-
- if (zoneSet == ZoneSetEMPTY)
- return ResFAIL;
- if (zoneSet == ZoneSetUNIV) {
- FindDelete fd = high ? FindDeleteHIGH : FindDeleteLOW;
- if (cbsFind(rangeReturn, oldRangeReturn, cbs, size, fd))
- return ResOK;
- else
- return ResFAIL;
- }
- if (ZoneSetIsSingle(zoneSet) && size > ArenaStripeSize(cbs->arena))
- return ResFAIL;
-
- /* It would be nice if there were a neat way to eliminate all runs of
- zones in zoneSet too small for size.*/
-
- cbsEnter(cbs);
-
- closure.arena = cbs->arena;
- closure.zoneSet = zoneSet;
- closure.size = size;
- closure.high = high;
- if (splayFind(&tree, cbsSplay(cbs),
- cbsTestNodeInZones,
- cbsTestTreeInZones,
- &closure, sizeof(closure))) {
- CBSBlock block = cbsBlockOfTree(tree);
- RangeStruct rangeStruct, oldRangeStruct;
-
- AVER(CBSBlockBase(block) <= closure.base);
- AVER(AddrOffset(closure.base, closure.limit) >= size);
- AVER(ZoneSetSub(ZoneSetOfRange(cbs->arena, closure.base, closure.limit), zoneSet));
- AVER(closure.limit <= CBSBlockLimit(block));
-
- if (!high)
- RangeInit(&rangeStruct, closure.base, AddrAdd(closure.base, size));
- else
- RangeInit(&rangeStruct, AddrSub(closure.limit, size), closure.limit);
- res = cbsDeleteFromTree(&oldRangeStruct, cbs, &rangeStruct);
- if (res == ResOK) { /* enough memory to split block */
- RangeCopy(rangeReturn, &rangeStruct);
- RangeCopy(oldRangeReturn, &oldRangeStruct);
- }
- } else
- res = ResFAIL;
-
- cbsLeave(cbs);
- return res;
+ return fastBlock->maxSize >= closure->size
+ && ZoneSetInter(zonedBlock->zones, closure->zoneSet) != ZoneSetEMPTY;
}
-/* CBSFindLast -- find the last block of at least the given size */
+/* cbsFindLast -- find the last block of at least the given size */
-Bool CBSFindLast(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size, FindDelete findDelete)
+static Bool cbsFindLast(Range rangeReturn, Range oldRangeReturn,
+ Land land, Size size, FindDelete findDelete)
{
+ CBS cbs;
Bool found;
Tree tree;
+ AVERT(Land, land);
+ cbs = cbsOfLand(land);
AVERT(CBS, cbs);
- cbsEnter(cbs);
+ AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass));
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
AVER(size > 0);
- AVER(SizeIsAligned(size, cbs->alignment));
- AVER(cbs->fastFind);
+ AVER(SizeIsAligned(size, LandAlignment(land)));
AVERT(FindDelete, findDelete);
METER_ACC(cbs->treeSearch, cbs->treeSize);
@@ -1000,38 +935,40 @@ Bool CBSFindLast(Range rangeReturn, Range oldRangeReturn,
AVER(CBSBlockSize(block) >= size);
RangeInit(&range, CBSBlockBase(block), CBSBlockLimit(block));
AVER(RangeSize(&range) >= size);
- cbsFindDeleteRange(rangeReturn, oldRangeReturn, cbs, &range,
+ cbsFindDeleteRange(rangeReturn, oldRangeReturn, land, &range,
size, findDelete);
}
- cbsLeave(cbs);
return found;
}
-/* CBSFindLargest -- find the largest block in the CBS */
+/* cbsFindLargest -- find the largest block in the CBS */
-Bool CBSFindLargest(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size, FindDelete findDelete)
+static Bool cbsFindLargest(Range rangeReturn, Range oldRangeReturn,
+ Land land, Size size, FindDelete findDelete)
{
+ CBS cbs;
Bool found = FALSE;
+ AVERT(Land, land);
+ cbs = cbsOfLand(land);
AVERT(CBS, cbs);
- cbsEnter(cbs);
+ AVER(IsLandSubclass(cbsLand(cbs), CBSFastLandClass));
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVER(cbs->fastFind);
+ AVER(size > 0);
AVERT(FindDelete, findDelete);
if (!SplayTreeIsEmpty(cbsSplay(cbs))) {
RangeStruct range;
- CBSBlock block;
Tree tree = TreeEMPTY; /* suppress "may be used uninitialized" */
Size maxSize;
- maxSize = cbsBlockOfTree(SplayTreeRoot(cbsSplay(cbs)))->maxSize;
+ maxSize = cbsFastBlockOfTree(SplayTreeRoot(cbsSplay(cbs)))->maxSize;
if (maxSize >= size) {
+ CBSBlock block;
METER_ACC(cbs->treeSearch, cbs->treeSize);
found = SplayFindFirst(&tree, cbsSplay(cbs), &cbsTestNode,
&cbsTestTree, NULL, maxSize);
@@ -1040,25 +977,103 @@ Bool CBSFindLargest(Range rangeReturn, Range oldRangeReturn,
AVER(CBSBlockSize(block) >= maxSize);
RangeInit(&range, CBSBlockBase(block), CBSBlockLimit(block));
AVER(RangeSize(&range) >= maxSize);
- cbsFindDeleteRange(rangeReturn, oldRangeReturn, cbs, &range,
- maxSize, findDelete);
+ cbsFindDeleteRange(rangeReturn, oldRangeReturn, land, &range,
+ size, findDelete);
}
}
- cbsLeave(cbs);
return found;
}
-/* CBSDescribe -- describe a CBS
+static Res cbsFindInZones(Bool *foundReturn, Range rangeReturn,
+ Range oldRangeReturn, Land land, Size size,
+ ZoneSet zoneSet, Bool high)
+{
+ CBS cbs;
+ CBSBlock block;
+ Tree tree;
+ cbsTestNodeInZonesClosureStruct closure;
+ Res res;
+ LandFindMethod landFind;
+ SplayFindMethod splayFind;
+ RangeStruct rangeStruct, oldRangeStruct;
+
+ AVER(foundReturn != NULL);
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ cbs = cbsOfLand(land);
+ AVERT(CBS, cbs);
+ AVER(IsLandSubclass(cbsLand(cbs), CBSZonedLandClass));
+ /* AVERT(ZoneSet, zoneSet); */
+ AVER(BoolCheck(high));
+
+ landFind = high ? cbsFindLast : cbsFindFirst;
+ splayFind = high ? SplayFindLast : SplayFindFirst;
+
+ if (zoneSet == ZoneSetEMPTY)
+ goto fail;
+ if (zoneSet == ZoneSetUNIV) {
+ FindDelete fd = high ? FindDeleteHIGH : FindDeleteLOW;
+ *foundReturn = (*landFind)(rangeReturn, oldRangeReturn, land, size, fd);
+ return ResOK;
+ }
+ if (ZoneSetIsSingle(zoneSet) && size > ArenaStripeSize(LandArena(land)))
+ goto fail;
+
+ /* It would be nice if there were a neat way to eliminate all runs of
+ zones in zoneSet too small for size.*/
+
+ closure.arena = LandArena(land);
+ closure.zoneSet = zoneSet;
+ closure.size = size;
+ closure.high = high;
+ if (!(*splayFind)(&tree, cbsSplay(cbs),
+ cbsTestNodeInZones, cbsTestTreeInZones,
+ &closure, UNUSED_SIZE))
+ goto fail;
+
+ block = cbsBlockOfTree(tree);
+
+ AVER(CBSBlockBase(block) <= closure.base);
+ AVER(AddrOffset(closure.base, closure.limit) >= size);
+ AVER(ZoneSetSub(ZoneSetOfRange(LandArena(land), closure.base, closure.limit), zoneSet));
+ AVER(closure.limit <= CBSBlockLimit(block));
+
+ if (!high)
+ RangeInit(&rangeStruct, closure.base, AddrAdd(closure.base, size));
+ else
+ RangeInit(&rangeStruct, AddrSub(closure.limit, size), closure.limit);
+ res = cbsDelete(&oldRangeStruct, land, &rangeStruct);
+ if (res != ResOK)
+ /* not enough memory to split block */
+ return res;
+ RangeCopy(rangeReturn, &rangeStruct);
+ RangeCopy(oldRangeReturn, &oldRangeStruct);
+ *foundReturn = TRUE;
+ return ResOK;
+
+fail:
+ *foundReturn = FALSE;
+ return ResOK;
+}
+
+
+/* cbsDescribe -- describe a CBS
*
- * See .
+ * See .
*/
-Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
+static Res cbsDescribe(Land land, mps_lib_FILE *stream)
{
+ CBS cbs;
Res res;
+ Res (*describe)(Tree, mps_lib_FILE *);
+ if (!TESTT(Land, land))
+ return ResFAIL;
+ cbs = cbsOfLand(land);
if (!TESTT(CBS, cbs))
return ResFAIL;
if (stream == NULL)
@@ -1066,24 +1081,63 @@ Res CBSDescribe(CBS cbs, mps_lib_FILE *stream)
res = WriteF(stream,
"CBS $P {\n", (WriteFP)cbs,
- " alignment: $U\n", (WriteFU)cbs->alignment,
" blockPool: $P\n", (WriteFP)cbsBlockPool(cbs),
- " fastFind: $U\n", (WriteFU)cbs->fastFind,
- " inCBS: $U\n", (WriteFU)cbs->inCBS,
+ " ownPool: $U\n", (WriteFU)cbs->ownPool,
" treeSize: $U\n", (WriteFU)cbs->treeSize,
NULL);
if (res != ResOK) return res;
- res = SplayTreeDescribe(cbsSplay(cbs), stream, &cbsSplayNodeDescribe);
+ if (IsLandSubclass(land, CBSZonedLandClass))
+ describe = cbsZonedSplayNodeDescribe;
+ else if (IsLandSubclass(land, CBSFastLandClass))
+ describe = cbsFastSplayNodeDescribe;
+ else
+ describe = cbsSplayNodeDescribe;
+
+ res = SplayTreeDescribe(cbsSplay(cbs), stream, describe);
if (res != ResOK) return res;
- res = METER_WRITE(cbs->treeSearch, stream);
- if (res != ResOK) return res;
+ METER_WRITE(cbs->treeSearch, stream);
res = WriteF(stream, "}\n", NULL);
return res;
}
+DEFINE_LAND_CLASS(CBSLandClass, class)
+{
+ INHERIT_CLASS(class, LandClass);
+ class->name = "CBS";
+ class->size = sizeof(CBSStruct);
+ class->init = cbsInit;
+ class->finish = cbsFinish;
+ class->sizeMethod = cbsSize;
+ class->insert = cbsInsert;
+ class->delete = cbsDelete;
+ class->iterate = cbsIterate;
+ class->findFirst = cbsFindFirst;
+ class->findLast = cbsFindLast;
+ class->findLargest = cbsFindLargest;
+ class->findInZones = cbsFindInZones;
+ class->describe = cbsDescribe;
+ AVERT(LandClass, class);
+}
+
+DEFINE_LAND_CLASS(CBSFastLandClass, class)
+{
+ INHERIT_CLASS(class, CBSLandClass);
+ class->name = "FASTCBS";
+ class->init = cbsInitFast;
+ AVERT(LandClass, class);
+}
+
+DEFINE_LAND_CLASS(CBSZonedLandClass, class)
+{
+ INHERIT_CLASS(class, CBSFastLandClass);
+ class->name = "ZONEDCBS";
+ class->init = cbsInitZoned;
+ AVERT(LandClass, class);
+}
+
/* C. COPYRIGHT AND LICENSE
*
diff --git a/mps/code/cbs.h b/mps/code/cbs.h
index e425bd80cf8..e6bc276f067 100644
--- a/mps/code/cbs.h
+++ b/mps/code/cbs.h
@@ -15,55 +15,37 @@
#include "range.h"
#include "splay.h"
-
-/* TODO: There ought to be different levels of CBS block with inheritance
- so that CBSs without fastFind don't allocate the maxSize and zones fields,
- and CBSs without zoned don't allocate the zones field. */
-
typedef struct CBSBlockStruct *CBSBlock;
typedef struct CBSBlockStruct {
TreeStruct treeStruct;
Addr base;
Addr limit;
- Size maxSize; /* accurate maximum block size of sub-tree */
- ZoneSet zones; /* union zone set of all ranges in sub-tree */
} CBSBlockStruct;
+typedef struct CBSFastBlockStruct *CBSFastBlock;
+typedef struct CBSFastBlockStruct {
+ struct CBSBlockStruct cbsBlockStruct;
+ Size maxSize; /* accurate maximum block size of sub-tree */
+} CBSFastBlockStruct;
+
+typedef struct CBSZonedBlockStruct *CBSZonedBlock;
+typedef struct CBSZonedBlockStruct {
+ struct CBSFastBlockStruct cbsFastBlockStruct;
+ ZoneSet zones; /* union zone set of all ranges in sub-tree */
+} CBSZonedBlockStruct;
typedef struct CBSStruct *CBS;
-typedef Bool (*CBSVisitor)(CBS cbs, Range range,
- void *closureP, Size closureS);
extern Bool CBSCheck(CBS cbs);
+extern LandClass CBSLandClassGet(void);
+extern LandClass CBSFastLandClassGet(void);
+extern LandClass CBSZonedLandClassGet(void);
+
extern const struct mps_key_s _mps_key_cbs_block_pool;
#define CBSBlockPool (&_mps_key_cbs_block_pool)
#define CBSBlockPool_FIELD pool
-/* TODO: Passing booleans to affect behaviour is ugly and error-prone. */
-extern Res CBSInit(CBS cbs, Arena arena, void *owner, Align alignment,
- Bool fastFind, Bool zoned, ArgList args);
-extern void CBSFinish(CBS cbs);
-
-extern Res CBSInsert(Range rangeReturn, CBS cbs, Range range);
-extern Res CBSDelete(Range rangeReturn, CBS cbs, Range range);
-extern void CBSIterate(CBS cbs, CBSVisitor visitor,
- void *closureP, Size closureS);
-
-extern Res CBSDescribe(CBS cbs, mps_lib_FILE *stream);
-
-typedef Bool (*CBSFindMethod)(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size, FindDelete findDelete);
-extern Bool CBSFindFirst(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size, FindDelete findDelete);
-extern Bool CBSFindLast(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size, FindDelete findDelete);
-extern Bool CBSFindLargest(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size, FindDelete findDelete);
-
-extern Res CBSFindInZones(Range rangeReturn, Range oldRangeReturn,
- CBS cbs, Size size, ZoneSet zoneSet, Bool high);
-
#endif /* cbs_h */
diff --git a/mps/code/chain.h b/mps/code/chain.h
index e47f8000c0b..87cfa08dd71 100644
--- a/mps/code/chain.h
+++ b/mps/code/chain.h
@@ -1,7 +1,7 @@
/* chain.h: GENERATION CHAINS
*
* $Id$
- * Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*/
#ifndef chain_h
@@ -31,7 +31,6 @@ typedef struct GenDescStruct {
ZoneSet zones; /* zoneset for this generation */
Size capacity; /* capacity in kB */
double mortality;
- double proflow; /* predicted proportion of survivors promoted */
RingStruct locusRing; /* Ring of all PoolGen's in this GenDesc (locus) */
} GenDescStruct;
@@ -44,19 +43,19 @@ typedef struct PoolGenStruct *PoolGen;
typedef struct PoolGenStruct {
Sig sig;
- Serial nr; /* generation number */
Pool pool; /* pool this belongs to */
- Chain chain; /* chain this belongs to */
+ GenDesc gen; /* generation this belongs to */
/* link in ring of all PoolGen's in this GenDesc (locus) */
RingStruct genRing;
- Size totalSize; /* total size of segs in gen in this pool */
- Size newSize; /* size allocated since last GC */
- /* newSize when TraceCreate was called. This is used in the
- * TraceStartPoolGen event emitted at the start of a trace; at that
- * time, newSize has already been diminished by Whiten so we can't
- * use that value. TODO: This will not work well with multiple
- * traces. */
- Size newSizeAtCreate;
+
+ /* Accounting of memory in this generation for this pool */
+ STATISTIC_DECL(Size segs); /* number of segments */
+ Size totalSize; /* total (sum of segment sizes) */
+ STATISTIC_DECL(Size freeSize); /* unused (free or lost to fragmentation) */
+ Size newSize; /* allocated since last collection */
+ STATISTIC_DECL(Size oldSize); /* allocated prior to last collection */
+ Size newDeferredSize; /* new (but deferred) */
+ STATISTIC_DECL(Size oldDeferredSize); /* old (but deferred) */
} PoolGenStruct;
@@ -81,27 +80,32 @@ 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);
-extern Res ChainAlloc(Seg *segReturn, Chain chain, Serial genNr,
- SegClass class, Size size, Pool pool,
- Bool withReservoirPermit, ArgList args);
-
-extern Bool PoolGenCheck(PoolGen gen);
-extern Res PoolGenInit(PoolGen gen, Chain chain, Serial nr, Pool pool);
-extern void PoolGenFinish(PoolGen gen);
-extern void PoolGenFlip(PoolGen gen);
-#define PoolGenNr(gen) ((gen)->nr)
+extern GenDesc ChainGen(Chain chain, Index gen);
+extern Bool PoolGenCheck(PoolGen pgen);
+extern Res PoolGenInit(PoolGen pgen, GenDesc gen, Pool pool);
+extern void PoolGenFinish(PoolGen pgen);
+extern Res PoolGenAlloc(Seg *segReturn, PoolGen pgen, SegClass class,
+ Size size, Bool withReservoirPermit, ArgList args);
+extern void PoolGenFree(PoolGen pgen, Seg seg, Size freeSize, Size oldSize,
+ Size newSize, Bool deferred);
+extern void PoolGenAccountForFill(PoolGen pgen, Size size, Bool deferred);
+extern void PoolGenAccountForEmpty(PoolGen pgen, Size unused, Bool deferred);
+extern void PoolGenAccountForAge(PoolGen pgen, Size aged, Bool deferred);
+extern void PoolGenAccountForReclaim(PoolGen pgen, Size reclaimed, Bool deferred);
+extern void PoolGenUndefer(PoolGen pgen, Size oldSize, Size newSize);
+extern void PoolGenAccountForSegSplit(PoolGen pgen);
+extern void PoolGenAccountForSegMerge(PoolGen pgen);
#endif /* chain_h */
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2002 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/clock.h b/mps/code/clock.h
index 253f7a5e0e4..d5fd7bc0e4e 100644
--- a/mps/code/clock.h
+++ b/mps/code/clock.h
@@ -7,7 +7,6 @@
#ifndef clock_h
#define clock_h
-#include
#include "mpmtypes.h" /* for Word */
diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index 70fed15d507..6e5adce14f5 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -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,20 +156,62 @@ 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
FMTSCM = fmtscheme.c
PLINTH = mpsliban.c mpsioan.c
-EVENTPROC = eventcnv.c table.c
-MPMCOMMON = abq.c arena.c arenacl.c arenavm.c arg.c boot.c bt.c \
- buffer.c cbs.c dbgpool.c dbgpooli.c event.c format.c freelist.c \
- global.c ld.c locus.c message.c meter.c mpm.c mpsi.c nailboard.c \
- pool.c poolabs.c poolmfs.c poolmrg.c poolmv.c protocol.c range.c \
- ref.c reserv.c ring.c root.c sa.c sac.c seg.c shield.c splay.c ss.c \
- table.c trace.c traceanc.c tract.c tree.c walk.c
-MPM = $(MPMCOMMON) $(MPMPF)
+MPMCOMMON = \
+ abq.c \
+ arena.c \
+ arenacl.c \
+ arenavm.c \
+ arg.c \
+ boot.c \
+ bt.c \
+ buffer.c \
+ cbs.c \
+ dbgpool.c \
+ dbgpooli.c \
+ event.c \
+ failover.c \
+ format.c \
+ freelist.c \
+ global.c \
+ land.c \
+ ld.c \
+ locus.c \
+ message.c \
+ meter.c \
+ mpm.c \
+ mpsi.c \
+ nailboard.c \
+ pool.c \
+ poolabs.c \
+ poolmfs.c \
+ poolmrg.c \
+ poolmv.c \
+ protocol.c \
+ range.c \
+ ref.c \
+ reserv.c \
+ ring.c \
+ root.c \
+ sa.c \
+ sac.c \
+ seg.c \
+ shield.c \
+ splay.c \
+ ss.c \
+ table.c \
+ trace.c \
+ traceanc.c \
+ tract.c \
+ tree.c \
+ walk.c
+MPM = $(MPMCOMMON) $(MPMPF) $(AMC) $(AMS) $(AWL) $(LO) $(MV2) $(MVFF) $(PLINTH)
# These map the source file lists onto object files and dependency files
@@ -183,38 +223,16 @@ MPM = $(MPMCOMMON) $(MPMPF)
ifdef VARIETY
MPMOBJ = $(MPM:%.c=$(PFM)/$(VARIETY)/%.o) \
$(MPMS:%.s=$(PFM)/$(VARIETY)/%.o)
-MPMDEP = $(MPM:%.c=$(PFM)/$(VARIETY)/%.d)
-AMCOBJ = $(AMC:%.c=$(PFM)/$(VARIETY)/%.o)
-AMCDEP = $(AMC:%.c=$(PFM)/$(VARIETY)/%.d)
-AMSOBJ = $(AMS:%.c=$(PFM)/$(VARIETY)/%.o)
-AMSDEP = $(AMS:%.c=$(PFM)/$(VARIETY)/%.d)
-AWLOBJ = $(AWL:%.c=$(PFM)/$(VARIETY)/%.o)
-AWLDEP = $(AWL:%.c=$(PFM)/$(VARIETY)/%.d)
-LOOBJ = $(LO:%.c=$(PFM)/$(VARIETY)/%.o)
-LODEP = $(LO:%.c=$(PFM)/$(VARIETY)/%.d)
-SNCOBJ = $(SNC:%.c=$(PFM)/$(VARIETY)/%.o)
-SNCDEP = $(SNC:%.c=$(PFM)/$(VARIETY)/%.d)
-POOLNOBJ = $(POOLN:%.c=$(PFM)/$(VARIETY)/%.o)
-POOLNDEP = $(POOLN:%.c=$(PFM)/$(VARIETY)/%.d)
-MV2OBJ = $(MV2:%.c=$(PFM)/$(VARIETY)/%.o)
-MV2DEP = $(MV2:%.c=$(PFM)/$(VARIETY)/%.d)
-MVFFOBJ = $(MVFF:%.c=$(PFM)/$(VARIETY)/%.o)
-MVFFDEP = $(MVFF:%.c=$(PFM)/$(VARIETY)/%.d)
-
-TESTLIBOBJ = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.o)
-TESTLIBDEP = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.d)
FMTDYOBJ = $(FMTDY:%.c=$(PFM)/$(VARIETY)/%.o)
-FMTDYDEP = $(FMTDY:%.c=$(PFM)/$(VARIETY)/%.d)
FMTDYTSTOBJ = $(FMTDYTST:%.c=$(PFM)/$(VARIETY)/%.o)
-FMTDYTSTDEP = $(FMTDYTST:%.c=$(PFM)/$(VARIETY)/%.d)
FMTHETSTOBJ = $(FMTHETST:%.c=$(PFM)/$(VARIETY)/%.o)
-FMTHETSTDEP = $(FMTHETST:%.c=$(PFM)/$(VARIETY)/%.d)
FMTSCMOBJ = $(FMTSCM:%.c=$(PFM)/$(VARIETY)/%.o)
-FMTSCMDEP = $(FMTSCM:%.c=$(PFM)/$(VARIETY)/%.d)
+MV2OBJ = $(MV2:%.c=$(PFM)/$(VARIETY)/%.o)
+MVFFOBJ = $(MVFF:%.c=$(PFM)/$(VARIETY)/%.o)
PLINTHOBJ = $(PLINTH:%.c=$(PFM)/$(VARIETY)/%.o)
-PLINTHDEP = $(PLINTH:%.c=$(PFM)/$(VARIETY)/%.d)
-EVENTPROCOBJ = $(EVENTPROC:%.c=$(PFM)/$(VARIETY)/%.o)
-EVENTPROCDEP = $(EVENTPROC:%.c=$(PFM)/$(VARIETY)/%.d)
+POOLNOBJ = $(POOLN:%.c=$(PFM)/$(VARIETY)/%.o)
+TESTLIBOBJ = $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.o)
+TESTTHROBJ = $(TESTTHR:%.c=$(PFM)/$(VARIETY)/%.o)
endif
@@ -245,11 +263,11 @@ TEST_TARGETS=\
djbench \
exposet0 \
expt825 \
- fbmtest \
finalcv \
finaltest \
fotest \
gcbench \
+ landtest \
locbwcss \
lockcov \
lockut \
@@ -276,7 +294,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 ==
@@ -284,16 +302,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
@@ -308,17 +334,25 @@ clean: phony
$(ECHO) "$(PFM): $@"
rm -rf "$(PFM)"
-# "target" builds some varieties of the target named in the TARGET macro.
+# "target" builds some varieties of the target named in the TARGET
+# macro.
+#
# %%VARIETY: When adding a new target, optionally add a recursive make call
# for the new variety, if it should be built by default. It probably
# shouldn't without a product design decision and an update of the readme
# and build manual!
+#
+# Note that we build VARIETY=cool before VARIETY=hot because
+# the former doesn't need to optimize and so detects errors more
+# quickly; and because the former uses file-at-a-time compilation and
+# so can pick up where it left off instead of having to start from the
+# beginning of mps.c
ifdef TARGET
ifndef VARIETY
target: phony
- $(MAKE) -f $(PFM).gmk VARIETY=hot variety
$(MAKE) -f $(PFM).gmk VARIETY=cool variety
+ $(MAKE) -f $(PFM).gmk VARIETY=hot variety
endif
endif
@@ -354,10 +388,7 @@ endif
$(PFM)/rash/mps.a: $(PFM)/rash/mps.o
$(PFM)/hot/mps.a: $(PFM)/hot/mps.o
-
-$(PFM)/cool/mps.a: \
- $(MPMOBJ) $(AMCOBJ) $(AMSOBJ) $(AWLOBJ) $(LOOBJ) $(SNCOBJ) \
- $(MV2OBJ) $(MVFFOBJ) $(PLINTHOBJ) $(POOLNOBJ)
+$(PFM)/cool/mps.a: $(MPMOBJ)
# OTHER GENUINE TARGETS
@@ -384,7 +415,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
@@ -405,7 +436,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
@@ -414,7 +445,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)/exposet0: $(PFM)/$(VARIETY)/exposet0.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@@ -422,9 +453,6 @@ $(PFM)/$(VARIETY)/exposet0: $(PFM)/$(VARIETY)/exposet0.o \
$(PFM)/$(VARIETY)/expt825: $(PFM)/$(VARIETY)/expt825.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
-$(PFM)/$(VARIETY)/fbmtest: $(PFM)/$(VARIETY)/fbmtest.o \
- $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
-
$(PFM)/$(VARIETY)/finalcv: $(PFM)/$(VARIETY)/finalcv.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@@ -435,7 +463,10 @@ $(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)/landtest: $(PFM)/$(VARIETY)/landtest.o \
+ $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/locbwcss: $(PFM)/$(VARIETY)/locbwcss.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@@ -444,7 +475,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
@@ -468,7 +499,7 @@ $(PFM)/$(VARIETY)/nailboardtest: $(PFM)/$(VARIETY)/nailboardtest.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/poolncv: $(PFM)/$(VARIETY)/poolncv.o \
- $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+ $(POOLNOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/qs: $(PFM)/$(VARIETY)/qs.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@@ -519,11 +550,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
@@ -535,16 +566,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
#
@@ -571,29 +602,28 @@ else
ifeq ($(VARIETY),hot)
include $(PFM)/$(VARIETY)/mps.d
else
-# %%PART: When adding a new part, add the dependency file macro for the new
-# part here.
+include $(MPM:%.c=$(PFM)/$(VARIETY)/%.d)
+endif # VARIETY != hot
+endif # VARIETY != rash
+
+# %%PART: When adding a new part, add the dependencies file for the
+# new part here.
include \
- $(MPMDEP) \
- $(AMCDEP) \
- $(AMSDEP) \
- $(AWLDEP) \
- $(EVENTPROCDEP) \
- $(FMTDYDEP) \
- $(FMTDYTSTDEP) \
- $(FMTHETSTDEP) \
- $(FMTSCMDEP) \
- $(LODEP) \
- $(PLINTHDEP) \
- $(POOLNDEP) \
- $(TESTLIBDEP)
-endif
-endif
+ $(FMTDY:%.c=$(PFM)/$(VARIETY)/%.d) \
+ $(FMTDYTST:%.c=$(PFM)/$(VARIETY)/%.d) \
+ $(FMTHETST:%.c=$(PFM)/$(VARIETY)/%.d) \
+ $(FMTSCM:%.c=$(PFM)/$(VARIETY)/%.d) \
+ $(PLINTH:%.c=$(PFM)/$(VARIETY)/%.d) \
+ $(POOLN:%.c=$(PFM)/$(VARIETY)/%.d) \
+ $(TESTLIB:%.c=$(PFM)/$(VARIETY)/%.d) \
+ $(TESTTHR:%.c=$(PFM)/$(VARIETY)/%.d) \
+ $(EXTRA_TARGETS:mps%=$(PFM)/$(VARIETY)/%.d) \
+ $(TEST_TARGETS:%=$(PFM)/$(VARIETY)/%.d)
-endif
-endif
+endif # !defined TARGET
+endif # !defined VARIETY
-endif
+endif # !defined gendep
# Library
@@ -604,7 +634,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) $@
@@ -612,11 +642,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
diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk
index 7c53d585adb..96fca59e250 100644
--- a/mps/code/commpost.nmk
+++ b/mps/code/commpost.nmk
@@ -39,8 +39,8 @@ clean:
!IFDEF TARGET
!IFNDEF VARIETY
target:
- $(MAKE) /nologo /f $(PFM).nmk VARIETY=hot variety
$(MAKE) /nologo /f $(PFM).nmk VARIETY=cool variety
+ $(MAKE) /nologo /f $(PFM).nmk VARIETY=hot variety
!ENDIF
!ENDIF
@@ -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=hot testrun
- $(MAKE) /nologo /f $(PFM).nmk VARIETY=cool testrun
+ $(MAKE) /nologo /f $(PFM).nmk VARIETY=cool $@
+ $(MAKE) /nologo /f $(PFM).nmk VARIETY=hot $@
!ENDIF
@@ -92,12 +92,9 @@ $(PFM)\hot\mps.lib: $(PFM)\hot\mps.obj
$(ECHO) $@
$(LIBMAN) $(LIBFLAGS) /OUT:$@ $**
-$(PFM)\cool\mps.lib: \
- $(MPMOBJ) $(AMCOBJ) $(AMSOBJ) $(AWLOBJ) $(LOOBJ) $(SNCOBJ) \
- $(MVFFOBJ) $(PLINTHOBJ) $(POOLNOBJ)
+$(PFM)\cool\mps.lib: $(MPMOBJ)
$(ECHO) $@
- $(CC) /c $(CFLAGS) /Fo$(PFM)\$(VARIETY)\version.obj version.c
- $(LIBMAN) $(LIBFLAGS) /OUT:$@ $** $(PFM)\$(VARIETY)\version.obj
+ $(LIBMAN) $(LIBFLAGS) /OUT:$@ $**
# OTHER GENUINE TARGETS
@@ -124,7 +121,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 +145,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 +157,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)
+ $(TESTLIBOBJ) $(TESTTHROBJ)
$(PFM)\$(VARIETY)\exposet0.exe: $(PFM)\$(VARIETY)\exposet0.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
@@ -168,9 +165,6 @@ $(PFM)\$(VARIETY)\exposet0.exe: $(PFM)\$(VARIETY)\exposet0.obj \
$(PFM)\$(VARIETY)\expt825.exe: $(PFM)\$(VARIETY)\expt825.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
-$(PFM)\$(VARIETY)\fbmtest.exe: $(PFM)\$(VARIETY)\fbmtest.obj \
- $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
-
$(PFM)\$(VARIETY)\finalcv.exe: $(PFM)\$(VARIETY)\finalcv.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
@@ -181,7 +175,10 @@ $(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)
+ $(FMTTESTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ)
+
+$(PFM)\$(VARIETY)\landtest.exe: $(PFM)\$(VARIETY)\landtest.obj \
+ $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
$(PFM)\$(VARIETY)\locbwcss.exe: $(PFM)\$(VARIETY)\locbwcss.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
@@ -190,7 +187,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)
@@ -213,8 +210,8 @@ $(PFM)\$(VARIETY)\mv2test.exe: $(PFM)\$(VARIETY)\mv2test.obj \
$(PFM)\$(VARIETY)\nailboardtest.exe: $(PFM)\$(VARIETY)\nailboardtest.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
-$(PFM)\$(VARIETY)\poolncv.exe: $(PFM)\$(VARIETY)\poolncv.obj \
- $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
+$(PFM)\$(VARIETY)\poolncv.exe: $(PFM)\$(VARIETY)\poolncv.obj \
+ $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ) $(POOLNOBJ)
$(PFM)\$(VARIETY)\qs.exe: $(PFM)\$(VARIETY)\qs.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
diff --git a/mps/code/commpre.nmk b/mps/code/commpre.nmk
index 09f4f165207..dbb20936fea 100644
--- a/mps/code/commpre.nmk
+++ b/mps/code/commpre.nmk
@@ -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
#
#
@@ -71,11 +72,11 @@ TEST_TARGETS=\
djbench.exe \
exposet0.exe \
expt825.exe \
- fbmtest.exe \
finalcv.exe \
finaltest.exe \
fotest.exe \
gcbench.exe \
+ landtest.exe \
locbwcss.exe \
lockcov.exe \
lockut.exe \
@@ -130,17 +131,17 @@ MPMCOMMON=\
\
\
\
+ \
\
\
\
+ \
\
- \
\
\
\
\
\
- \
\
\
\
@@ -149,7 +150,6 @@ MPMCOMMON=\
\
\
\
- \
\
[ \
\
@@ -162,12 +162,11 @@ MPMCOMMON=\
\
\
] \
- \
\
\
\
\
- \
+ \
PLINTH =
AMC =
@@ -177,10 +176,12 @@ LO =
MVFF =
POOLN =
SNC =
-DW =
+FMTDY =
FMTTEST =
FMTSCHEME =
-TESTLIB =
+TESTLIB =
+TESTTHR =
+MPM = $(MPMCOMMON) $(MPMPF) $(AMC) $(AMS) $(AWL) $(LO) $(MV2) $(MVFF) $(PLINTH)
# CHECK PARAMETERS
@@ -195,9 +196,15 @@ TESTLIB =
!IFNDEF PFMDEFS
!ERROR commpre.nmk: PFMDEFS not defined
!ENDIF
+!IFNDEF MPM
+!ERROR commpre.nmk: MPM not defined
+!ENDIF
!IFNDEF MPMCOMMON
!ERROR commpre.nmk: MPMCOMMON not defined
!ENDIF
+!IFNDEF MPMPF
+!ERROR commpre.nmk: MPMPF not defined
+!ENDIF
!IFNDEF PLINTH
!ERROR commpre.nmk: PLINTH not defined
!ENDIF
@@ -216,8 +223,8 @@ TESTLIB =
!IFNDEF SNC
!ERROR commpre.nmk: SNC not defined
!ENDIF
-!IFNDEF DW
-!ERROR commpre.nmk: DW not defined
+!IFNDEF FMTDY
+!ERROR commpre.nmk: FMTDY not defined
!ENDIF
!IFNDEF FMTTEST
!ERROR commpre.nmk: FMTTEST not defined
@@ -228,6 +235,9 @@ TESTLIB =
!IFNDEF TESTLIB
!ERROR commpre.nmk: TESTLIB not defined
!ENDIF
+!IFNDEF TESTTHR
+!ERROR commpre.nmk: TESTTHR not defined
+!ENDIF
# DECLARATIONS
diff --git a/mps/code/config.h b/mps/code/config.h
index 3072ad0285f..552b3c943d9 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -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
@@ -231,6 +280,30 @@
#define ATTRIBUTE_NO_SANITIZE_ADDRESS
#endif
+/* Attribute for functions that do not return.
+ * GCC:
+ * Clang:
+ */
+#if defined(MPS_BUILD_GC) || defined(MPS_BUILD_LL)
+#define ATTRIBUTE_NORETURN __attribute__((__noreturn__))
+#else
+#define ATTRIBUTE_NORETURN
+#endif
+
+/* Attribute for functions that may be unused in some build configurations.
+ * GCC:
+ *
+ * This attribute must be applied to all Check functions, otherwise
+ * the RASH variety fails to compile with -Wunused-function. (It
+ * should not be applied to functions that are unused in all build
+ * configurations: these functions should not be compiled.)
+ */
+#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
@@ -245,11 +318,6 @@
#define BUFFER_RANK_DEFAULT (mps_rank_exact())
-/* CBS Configuration -- see */
-
-#define CBS_EXTEND_BY_DEFAULT ((Size)4096)
-
-
/* Format defaults: see */
#define FMT_ALIGN_DEFAULT ((Align)MPS_PF_ALIGN)
@@ -271,7 +339,7 @@
/* Pool AMS Configuration -- see */
-#define AMS_SUPPORT_AMBIGUOUS_DEFAULT FALSE
+#define AMS_SUPPORT_AMBIGUOUS_DEFAULT TRUE
#define AMS_GEN_DEFAULT 0
@@ -357,11 +425,15 @@
pool to be very heavily used. */
#define CONTROL_EXTEND_BY 4096
+#define VM_ARENA_SIZE_DEFAULT ((Size)1 << 28)
+
/* 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)
@@ -390,6 +462,7 @@
*
* Source Symbols Header Feature
* =========== ========================= ============= ====================
+ * eventtxt.c setenv _GNU_SOURCE
* lockli.c pthread_mutexattr_settype _XOPEN_SOURCE >= 500
* prmci3li.c REG_EAX etc. _GNU_SOURCE
* prmci6li.c REG_RAX etc. _GNU_SOURCE
@@ -408,9 +481,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
@@ -536,9 +614,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
diff --git a/mps/code/dbgpool.c b/mps/code/dbgpool.c
index 05a2759e681..84df0418cde 100644
--- a/mps/code/dbgpool.c
+++ b/mps/code/dbgpool.c
@@ -184,7 +184,10 @@ static Res DebugPoolInit(Pool pool, ArgList args)
/* This pool has to be like the arena control pool: the blocks */
/* allocated must be accessible using void*. */
MPS_ARGS_BEGIN(pcArgs) {
- MPS_ARGS_ADD(pcArgs, MPS_KEY_EXTEND_BY, debug->tagSize); /* FIXME: Check this */
+ /* By setting EXTEND_BY to debug->tagSize we get the smallest
+ possible extensions compatible with the tags, and so the
+ least amount of wasted space. */
+ MPS_ARGS_ADD(pcArgs, MPS_KEY_EXTEND_BY, debug->tagSize);
MPS_ARGS_ADD(pcArgs, MPS_KEY_MFS_UNIT_SIZE, debug->tagSize);
res = PoolCreate(&debug->tagPool, PoolArena(pool), PoolClassMFS(), pcArgs);
} MPS_ARGS_END(pcArgs);
diff --git a/mps/code/djbench.c b/mps/code/djbench.c
index 59f05130cf2..00bb5d3f954 100644
--- a/mps/code/djbench.c
+++ b/mps/code/djbench.c
@@ -48,6 +48,7 @@ static double pact = 0.2; /* probability per pass of acting */
static unsigned rinter = 75; /* pass interval for recursion */
static unsigned rmax = 10; /* maximum recursion depth */
static mps_bool_t zoned = TRUE; /* arena allocates using zones */
+static size_t arenasize = 256ul * 1024 * 1024; /* arena size */
#define DJRUN(fname, alloc, free) \
static unsigned fname##_inner(mps_ap_t ap, unsigned depth, unsigned r) { \
@@ -56,6 +57,7 @@ static mps_bool_t zoned = TRUE; /* arena allocates using zones */
\
for (k = 0; k < nblocks; ++k) { \
blocks[k].p = NULL; \
+ blocks[k].s = 0; \
} \
\
for (j = 0; j < npass; ++j) { \
@@ -176,7 +178,7 @@ static void wrap(dj_t dj, mps_class_t dummy, const char *name)
static void arena_wrap(dj_t dj, mps_class_t pool_class, const char *name)
{
MPS_ARGS_BEGIN(args) {
- MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, 256ul * 1024 * 1024); /* FIXME: Why is there no default? */
+ MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, arenasize);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_ZONED, zoned);
DJMUST(mps_arena_create_k(&arena, mps_arena_class_vm(), args));
} MPS_ARGS_END(args);
@@ -200,6 +202,7 @@ static struct option longopts[] = {
{"rinter", required_argument, NULL, 'r'},
{"rmax", required_argument, NULL, 'd'},
{"seed", required_argument, NULL, 'x'},
+ {"arena-size", required_argument, NULL, 'm'},
{"arena-unzoned", no_argument, NULL, 'z'},
{NULL, 0, NULL, 0}
};
@@ -234,7 +237,7 @@ int main(int argc, char *argv[]) {
seed = rnd_seed();
- while ((ch = getopt_long(argc, argv, "ht:i:p:b:s:a:r:d:x:z", longopts, NULL)) != -1)
+ while ((ch = getopt_long(argc, argv, "ht:i:p:b:s:a:r:d:m:x:z", longopts, NULL)) != -1)
switch (ch) {
case 't':
nthreads = (unsigned)strtoul(optarg, NULL, 10);
@@ -266,6 +269,20 @@ int main(int argc, char *argv[]) {
case 'z':
zoned = FALSE;
break;
+ case 'm': {
+ char *p;
+ arenasize = (unsigned)strtoul(optarg, &p, 10);
+ switch(toupper(*p)) {
+ case 'G': arenasize <<= 30; break;
+ case 'M': arenasize <<= 20; break;
+ case 'K': arenasize <<= 10; break;
+ case '\0': break;
+ default:
+ fprintf(stderr, "Bad arena size %s\n", optarg);
+ return EXIT_FAILURE;
+ }
+ }
+ break;
default:
fprintf(stderr,
"Usage: %s [option...] [test...]\n"
diff --git a/mps/code/event.c b/mps/code/event.c
index 2e7468c3752..475fa4f875c 100644
--- a/mps/code/event.c
+++ b/mps/code/event.c
@@ -44,13 +44,13 @@ char EventBuffer[EventKindLIMIT][EventBufferSIZE];
char *EventLast[EventKindLIMIT];
/* Pointers to the last even written out of each buffer. */
-char *EventWritten[EventKindLIMIT];
+static char *EventWritten[EventKindLIMIT];
EventControlSet EventKindControl; /* Bit set used to control output. */
/* A single event structure output once per buffer flush. */
-EventEventClockSyncStruct eventClockSyncStruct;
+static EventEventClockSyncStruct eventClockSyncStruct;
/* eventClockSync -- Populate and write the clock sync event. */
@@ -422,7 +422,7 @@ void EventDump(mps_lib_FILE *stream)
for (kind = 0; kind < EventKindLIMIT; ++kind) {
for (event = (Event)EventLast[kind];
- event < (Event)(EventBuffer[kind] + EventBufferSIZE);
+ (char *)event < EventBuffer[kind] + EventBufferSIZE;
event = (Event)((char *)event + event->any.size)) {
/* Try to keep going even if there's an error, because this is used as a
backtrace and we'll take what we can get. */
diff --git a/mps/code/eventcnv.c b/mps/code/eventcnv.c
index 355b6efa2a2..7b7e060470f 100644
--- a/mps/code/eventcnv.c
+++ b/mps/code/eventcnv.c
@@ -197,6 +197,12 @@ static Res eventRead(Bool *eofOut, EventUnion *event, FILE *stream)
return ResIO;
}
+ if (event->any.size < sizeof(event->any))
+ return ResFAIL; /* invalid size: too small */
+
+ if (event->any.size > sizeof(*event))
+ return ResFAIL; /* invalid size: too large */
+
/* Read the rest of the event. */
rest = event->any.size - sizeof(event->any);
if (rest > 0) {
diff --git a/mps/code/eventcom.h b/mps/code/eventcom.h
index 6114b045d48..931c975596d 100644
--- a/mps/code/eventcom.h
+++ b/mps/code/eventcom.h
@@ -1,6 +1,6 @@
/* -- Event Logging Common Definitions
*
- * Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
* $Id$
*
* .sources: mps.design.telemetry
@@ -56,7 +56,8 @@ ENUM_DECLARE(EventKind)
enum EventDefinitionsEnum {
EVENT_LIST(EVENT_ENUM, X)
- EventEnumWarningSuppressor /* suppress comma-at-end-of-enum warning */
+ /* suppress comma-at-end-of-enum warning */
+ EventEnumWarningSuppressor = USHRT_MAX
};
@@ -89,7 +90,11 @@ typedef Word EventFW; /* word */
typedef unsigned EventFU; /* unsigned integer */
typedef char EventFS[EventStringLengthMAX + sizeof('\0')]; /* string */
typedef double EventFD; /* double */
-typedef int EventFB; /* boolean */
+/* EventFB must be unsigned (even though Bool is a typedef for int)
+ * because it used as the type of a bitfield with width 1, and we need
+ * the legals values of the field to be 0 and 1 (not 0 and -1 which
+ * would be the case for int : 1). */
+typedef unsigned EventFB; /* Boolean */
/* Event packing bitfield specifiers */
#define EventFP_BITFIELD
@@ -133,7 +138,7 @@ typedef union EventUnion {
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2002 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/eventdef.h b/mps/code/eventdef.h
index 4ce313dcfc8..0c94da20cf4 100644
--- a/mps/code/eventdef.h
+++ b/mps/code/eventdef.h
@@ -36,8 +36,8 @@
*/
#define EVENT_VERSION_MAJOR ((unsigned)1)
-#define EVENT_VERSION_MEDIAN ((unsigned)1)
-#define EVENT_VERSION_MINOR ((unsigned)7)
+#define EVENT_VERSION_MEDIAN ((unsigned)2)
+#define EVENT_VERSION_MINOR ((unsigned)0)
/* EVENT_LIST -- list of event types and general properties
@@ -95,7 +95,7 @@
EVENT(X, PoolFinish , 0x0016, TRUE, Pool) \
EVENT(X, PoolAlloc , 0x0017, TRUE, Object) \
EVENT(X, PoolFree , 0x0018, TRUE, Object) \
- EVENT(X, CBSInit , 0x0019, TRUE, Pool) \
+ EVENT(X, LandInit , 0x0019, TRUE, Pool) \
EVENT(X, Intern , 0x001a, TRUE, User) \
EVENT(X, Label , 0x001b, TRUE, User) \
EVENT(X, TraceStart , 0x001c, TRUE, Trace) \
@@ -187,7 +187,7 @@
EVENT(X, VMCompact , 0x0079, TRUE, Arena) \
EVENT(X, amcScanNailed , 0x0080, TRUE, Seg) \
EVENT(X, AMCTraceEnd , 0x0081, TRUE, Trace) \
- EVENT(X, TraceStartPoolGen , 0x0082, TRUE, Trace) \
+ EVENT(X, TraceCreatePoolGen , 0x0082, TRUE, Trace) \
/* new events for performance analysis of large heaps. */ \
EVENT(X, TraceCondemnZones , 0x0083, TRUE, Trace) \
EVENT(X, ArenaGenZoneAdd , 0x0084, TRUE, Arena) \
@@ -311,8 +311,8 @@
PARAM(X, 1, A, old) \
PARAM(X, 2, W, size)
-#define EVENT_CBSInit_PARAMS(PARAM, X) \
- PARAM(X, 0, P, cbs) \
+#define EVENT_LandInit_PARAMS(PARAM, X) \
+ PARAM(X, 0, P, land) \
PARAM(X, 1, P, owner)
#define EVENT_Intern_PARAMS(PARAM, X) \
@@ -713,18 +713,18 @@
PARAM(X, 19, W, pRL) \
PARAM(X, 20, W, pRLr)
-#define EVENT_TraceStartPoolGen_PARAMS(PARAM, X) \
- PARAM(X, 0, P, chain) /* chain (or NULL for topGen) */ \
- PARAM(X, 1, B, top) /* 1 for topGen, 0 otherwise */ \
- PARAM(X, 2, W, index) /* index of generation in the chain */ \
- PARAM(X, 3, P, gendesc) /* generation description */ \
- PARAM(X, 4, W, capacity) /* capacity of generation */ \
- PARAM(X, 5, D, mortality) /* mortality of generation */ \
- PARAM(X, 6, W, zone) /* zone set of generation */ \
- PARAM(X, 7, P, pool) /* pool */ \
- PARAM(X, 8, W, serial) /* pool gen serial number */ \
- PARAM(X, 9, W, totalSize) /* total size of pool gen */ \
- PARAM(X, 10, W, newSizeAtCreate) /* new size of pool gen at trace create */
+#define EVENT_TraceCreatePoolGen_PARAMS(PARAM, X) \
+ PARAM(X, 0, P, gendesc) /* generation description */ \
+ PARAM(X, 1, W, capacity) /* capacity of generation */ \
+ PARAM(X, 2, D, mortality) /* mortality of generation */ \
+ PARAM(X, 3, W, zone) /* zone set of generation */ \
+ PARAM(X, 4, P, pool) /* pool */ \
+ PARAM(X, 5, W, totalSize) /* total size of pool gen */ \
+ PARAM(X, 6, W, freeSize) /* free size of pool gen */ \
+ PARAM(X, 7, W, newSize) /* new size of pool gen */ \
+ PARAM(X, 8, W, oldSize) /* old size of pool gen */ \
+ PARAM(X, 9, W, newDeferredSize) /* new size (deferred) of pool gen */ \
+ PARAM(X, 10, W, oldDeferredSize) /* old size (deferred) of pool gen */
#define EVENT_TraceCondemnZones_PARAMS(PARAM, X) \
PARAM(X, 0, P, trace) /* the trace */ \
@@ -733,7 +733,7 @@
#define EVENT_ArenaGenZoneAdd_PARAMS(PARAM, X) \
PARAM(X, 0, P, arena) /* the arena */ \
- PARAM(X, 1, W, gen) /* the generation number */ \
+ PARAM(X, 1, P, gendesc) /* the generation description */ \
PARAM(X, 2, W, zoneSet) /* the new zoneSet */
#define EVENT_ArenaUseFreeZone_PARAMS(PARAM, X) \
diff --git a/mps/code/eventrep.c b/mps/code/eventrep.c
index 375d793c13f..969d8adcb67 100644
--- a/mps/code/eventrep.c
+++ b/mps/code/eventrep.c
@@ -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);
diff --git a/mps/code/eventsql.c b/mps/code/eventsql.c
index 46bfa688a9b..e1c9ea22381 100644
--- a/mps/code/eventsql.c
+++ b/mps/code/eventsql.c
@@ -102,7 +102,7 @@ typedef sqlite3_int64 int64;
* and for reporting errors.
*/
-unsigned int verbosity = 0;
+static unsigned int verbosity = 0;
#define LOG_ALWAYS 0
#define LOG_OFTEN 1
@@ -533,7 +533,7 @@ static void logFileCompleted(sqlite3 *db,
/* An array of table-creation statement strings. */
-const char *createStatements[] = {
+static const char *createStatements[] = {
"CREATE TABLE IF NOT EXISTS event_kind (name TEXT,"
" description TEXT,"
" enum INTEGER PRIMARY KEY)",
@@ -571,7 +571,7 @@ static void makeTables(sqlite3 *db)
}
}
-const char *glueTables[] = {
+static const char *glueTables[] = {
"event_kind",
"event_type",
"event_param",
diff --git a/mps/code/eventtxt.c b/mps/code/eventtxt.c
index 5b7f7ab1312..01b071aee3a 100644
--- a/mps/code/eventtxt.c
+++ b/mps/code/eventtxt.c
@@ -29,15 +29,21 @@
* $Id$
*/
+#include "check.h"
#include "config.h"
-#include "eventdef.h"
#include "eventcom.h"
+#include "eventdef.h"
+#include "mps.h"
+#include "mpsavm.h"
+#include "mpscmvff.h"
#include "table.h"
#include "testlib.h" /* for ulongest_t and associated print formats */
+#include
+#include
#include
-#include
-#include
+#include /* exit, EXIT_FAILURE, EXIT_SUCCESS */
+#include /* strcpy, strerror, strlen */
static const char *prog; /* program name */
static const char *logFileName = NULL;
@@ -106,15 +112,19 @@ static void parseArgs(int argc, char *argv[])
static void *tableAlloc(void *closure, size_t size)
{
- UNUSED(closure);
- return malloc(size);
+ mps_pool_t pool = closure;
+ mps_addr_t p;
+ mps_res_t res;
+ res = mps_alloc(&p, pool, size);
+ if (res != MPS_RES_OK)
+ everror("allocation failed: %d", res);
+ return p;
}
static void tableFree(void *closure, void *p, size_t size)
{
- UNUSED(closure);
- UNUSED(size);
- free(p);
+ mps_pool_t pool = closure;
+ mps_free(pool, p, size);
}
/* Printing routines */
@@ -171,7 +181,7 @@ static double parseDouble(char **pInOut)
#define MAX_STRING_LENGTH 1024
-char strBuf[MAX_STRING_LENGTH];
+static char strBuf[MAX_STRING_LENGTH];
static char *parseString(char **pInOut)
{
@@ -215,21 +225,21 @@ static Table internTable; /* dictionary of intern ids to strings */
static Table labelTable; /* dictionary of addrs to intern ids */
-static void createTables(void)
+static void createTables(mps_pool_t pool)
{
Res res;
/* MPS intern IDs are serials from zero up, so we can use -1
* and -2 as specials. */
res = TableCreate(&internTable,
(size_t)1<<4,
- tableAlloc, tableFree, NULL,
+ tableAlloc, tableFree, pool,
(Word)-1, (Word)-2);
if (res != ResOK)
everror("Couldn't make intern table.");
/* We assume that 0 and 1 are invalid as Addrs. */
res = TableCreate(&labelTable, (size_t)1<<7,
- tableAlloc, tableFree, NULL,
+ tableAlloc, tableFree, pool,
0, 1);
if (res != ResOK)
everror("Couldn't make label table.");
@@ -238,19 +248,19 @@ static void createTables(void)
/* recordIntern -- record an interned string in the table. a copy of
* the string from the parsed buffer into a newly-allocated block. */
-static void recordIntern(char *p)
+static void recordIntern(mps_pool_t pool, char *p)
{
ulongest_t stringId;
char *string;
- char *copy;
+ mps_addr_t copy;
size_t len;
Res res;
stringId = parseHex(&p);
string = parseString(&p);
len = strlen(string);
- copy = malloc(len+1);
- if (copy == NULL)
+ res = mps_alloc(©, pool, len + 1);
+ if (res != MPS_RES_OK)
everror("Couldn't allocate space for a string.");
(void)strcpy(copy, string);
res = TableDefine(internTable, (Word)stringId, (void *)copy);
@@ -258,12 +268,55 @@ static void recordIntern(char *p)
everror("Couldn't create an intern mapping.");
}
-/* recordLabel records a label (an association between an address and
- * a string ID). Note that the event log may have been generated on a
- * platform with addresses larger than Word on the current platform.
- * If that happens then we are scuppered because our Table code uses
- * Word as the key type: there's nothing we can do except detect this
- * bad case (see also the EventInit handling and warning code).
+/* Over time there may be multiple labels associated with an address,
+ * so we keep a list, recording for each label the clock when the
+ * association was made. This means that printAddr can select the
+ * label that was in force at the time of the event.
+ */
+
+typedef struct LabelStruct *Label;
+typedef struct LabelStruct {
+ ulongest_t clock; /* clock of this label */
+ ulongest_t id; /* string id of this label */
+} LabelStruct;
+
+typedef struct LabelListStruct *LabelList;
+typedef struct LabelListStruct {
+ size_t n; /* number of labels in array */
+ Label labels; /* labels, sorted in order by clock */
+} LabelListStruct;
+
+/* labelFind returns the index of the first entry in list with a clock
+ * value that's greater than 'clock', or list->n if there is no such
+ * label. The list is assumed to be sorted.
+ */
+
+static size_t labelFind(LabelList list, ulongest_t clock)
+{
+ size_t low = 0, high = list->n;
+ while (low < high) {
+ size_t mid = (low + high) / 2;
+ assert(NONNEGATIVE(mid) && mid < list->n);
+ if (list->labels[mid].clock > clock) {
+ high = mid;
+ } else {
+ low = mid + 1;
+ }
+ }
+ assert(NONNEGATIVE(low) && low <= list->n);
+ assert(low == list->n || list->labels[low].clock > clock);
+ return low;
+}
+
+/* recordLabel records a label: an association (made at the time given
+ * by 'clock') between an address and a string ID. These are encoded
+ * as two hexadecimal numbers in the string pointed to by 'p'.
+ *
+ * Note that the event log may have been generated on a platform with
+ * addresses larger than Word on the current platform. If that happens
+ * then we are scuppered because our Table code uses Word as the key
+ * type: there's nothing we can do except detect this bad case (see
+ * also the EventInit handling and warning code).
*
* We can and do handle the case where string IDs (which are Words on
* the MPS platform) are larger than void* on the current platform.
@@ -274,25 +327,50 @@ static void recordIntern(char *p)
* probably a bad idea and maybe doomed to failure.
*/
-static void recordLabel(char *p)
+static void recordLabel(mps_pool_t pool, ulongest_t clock, char *p)
{
ulongest_t address;
- ulongest_t *stringIdP;
+ LabelList list;
+ Label newlabels;
+ mps_addr_t tmp;
+ size_t pos;
Res res;
-
+
address = parseHex(&p);
if (address > (Word)-1) {
(void)printf("label address too large!");
return;
}
-
- stringIdP = malloc(sizeof(ulongest_t));
- if (stringIdP == NULL)
- everror("Can't allocate space for a string's ID");
- *stringIdP = parseHex(&p);
- res = TableDefine(labelTable, (Word)address, (void *)stringIdP);
+
+ if (TableLookup(&tmp, labelTable, address)) {
+ list = tmp;
+ } else {
+ /* First label for this address */
+ res = mps_alloc(&tmp, pool, sizeof(LabelListStruct));
+ if (res != MPS_RES_OK)
+ everror("Can't allocate space for a label list");
+ list = tmp;
+ list->n = 0;
+ res = TableDefine(labelTable, (Word)address, list);
+ if (res != ResOK)
+ everror("Couldn't create a label mapping.");
+ }
+
+ res = mps_alloc(&tmp, pool, sizeof(LabelStruct) * (list->n + 1));
if (res != ResOK)
- everror("Couldn't create an intern mapping.");
+ everror("Couldn't allocate space for list of labels.");
+ newlabels = tmp;
+
+ pos = labelFind(list, clock);
+ memcpy(newlabels, list->labels, sizeof(LabelStruct) * pos);
+ newlabels[pos].clock = clock;
+ newlabels[pos].id = parseHex(&p);
+ memcpy(newlabels + pos + 1, list->labels + pos,
+ sizeof(LabelStruct) * (list->n - pos));
+ if (list->n > 0)
+ mps_free(pool, list->labels, sizeof(LabelStruct) * list->n);
+ list->labels = newlabels;
+ ++ list->n;
}
/* output code */
@@ -308,20 +386,23 @@ static int hexWordWidth = (MPS_WORD_WIDTH+3)/4;
/* printAddr -- output a ulongest_t in hex, with the interned string
* if the value is in the label table */
-static void printAddr(ulongest_t addr, const char *ident)
+static void printAddr(ulongest_t clock, ulongest_t addr, const char *ident)
{
- ulongest_t label;
- void *alias;
+ void *tmp;
printf("%s:%0*" PRIXLONGEST, ident, hexWordWidth, addr);
- if (TableLookup(&alias, labelTable, addr)) {
- label = *(ulongest_t*)alias;
- putchar('[');
- if (TableLookup(&alias, internTable, label))
- printStr((char *)alias);
- else
- printf("unknown label %" PRIuLONGEST, label);
- putchar(']');
+ if (TableLookup(&tmp, labelTable, addr)) {
+ LabelList list = tmp;
+ size_t pos = labelFind(list, clock);
+ if (pos > 0) {
+ ulongest_t id = list->labels[pos - 1].id;
+ putchar('[');
+ if (TableLookup(&tmp, internTable, id))
+ printStr((char *)tmp);
+ else
+ printf("unknown label %" PRIXLONGEST, id);
+ putchar(']');
+ }
}
putchar(' ');
}
@@ -332,7 +413,7 @@ static void printAddr(ulongest_t addr, const char *ident)
#define processParamA(ident) \
val_hex = parseHex(&p); \
- printAddr(val_hex, #ident);
+ printAddr(clock, val_hex, #ident);
#define processParamP processParamA
#define processParamW processParamA
@@ -375,7 +456,7 @@ static const char *eventName[EventCodeMAX+EventCodeMAX];
/* readLog -- read and parse log. Returns the number of events written. */
-static void readLog(FILE *input)
+static void readLog(mps_pool_t pool, FILE *input)
{
int i;
@@ -415,9 +496,9 @@ static void readLog(FILE *input)
/* for a few particular codes, we do local processing. */
if (code == EventInternCode) {
- recordIntern(q);
+ recordIntern(pool, q);
} else if (code == EventLabelCode) {
- recordLabel(q);
+ recordLabel(pool, clock, q);
} else if (code == EventEventInitCode) {
ulongest_t major, median, minor, maxCode, maxNameLen, wordWidth, clocksPerSec;
major = parseHex(&q); /* EVENT_VERSION_MAJOR */
@@ -476,6 +557,9 @@ static void readLog(FILE *input)
int main(int argc, char *argv[])
{
+ mps_arena_t arena;
+ mps_pool_t pool;
+ mps_res_t res;
FILE *input;
parseArgs(argc, argv);
@@ -488,8 +572,25 @@ int main(int argc, char *argv[])
everror("unable to open %s", logFileName);
}
- createTables();
- readLog(input);
+ /* 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);
+
+ res = mps_pool_create_k(&pool, arena, mps_class_mvff(), mps_args_none);
+ if (res != MPS_RES_OK)
+ everror("failed to create pool: %d", res);
+
+ createTables(pool);
+ readLog(pool, input);
+
+ mps_pool_destroy(pool);
+ mps_arena_destroy(arena);
+
(void)fclose(input);
return 0;
}
diff --git a/mps/code/exposet0.c b/mps/code/exposet0.c
index f471dd2a3bc..7e097d6b034 100644
--- a/mps/code/exposet0.c
+++ b/mps/code/exposet0.c
@@ -72,12 +72,6 @@ static void report(mps_arena_t arena)
printf("not_condemned %"PRIuLONGEST"\n", (ulongest_t)not_condemned);
mps_message_discard(arena, message);
-
- if (condemned > (gen1SIZE + gen2SIZE + (size_t)128) * 1024)
- /* When condemned size is larger than could happen in a gen 2
- * collection (discounting ramps, natch), guess that was a dynamic
- * collection, and reset the commit limit, so it doesn't run out. */
- die(mps_arena_commit_limit_set(arena, 2 * testArenaSIZE), "set limit");
}
}
@@ -228,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);
@@ -250,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);
diff --git a/mps/code/expt825.c b/mps/code/expt825.c
index 5e775455909..bd6c5f2b1e0 100644
--- a/mps/code/expt825.c
+++ b/mps/code/expt825.c
@@ -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);
diff --git a/mps/code/failover.c b/mps/code/failover.c
new file mode 100644
index 00000000000..7e9f07d7b8c
--- /dev/null
+++ b/mps/code/failover.c
@@ -0,0 +1,360 @@
+/* failover.c: FAILOVER IMPLEMENTATION
+ *
+ * $Id$
+ * Copyright (c) 2014 Ravenbrook Limited. See end of file for license.
+ *
+ * .design:
+ */
+
+#include "failover.h"
+#include "mpm.h"
+#include "range.h"
+
+SRCID(failover, "$Id$");
+
+
+#define failoverOfLand(land) PARENT(FailoverStruct, landStruct, land)
+
+
+ARG_DEFINE_KEY(failover_primary, Pointer);
+ARG_DEFINE_KEY(failover_secondary, Pointer);
+
+
+Bool FailoverCheck(Failover fo)
+{
+ CHECKS(Failover, fo);
+ CHECKD(Land, &fo->landStruct);
+ CHECKD(Land, fo->primary);
+ CHECKD(Land, fo->secondary);
+ return TRUE;
+}
+
+
+static Res failoverInit(Land land, ArgList args)
+{
+ Failover fo;
+ LandClass super;
+ Land primary, secondary;
+ ArgStruct arg;
+ Res res;
+
+ AVERT(Land, land);
+ super = LAND_SUPERCLASS(FailoverLandClass);
+ res = (*super->init)(land, args);
+ if (res != ResOK)
+ return res;
+
+ ArgRequire(&arg, args, FailoverPrimary);
+ primary = arg.val.p;
+ ArgRequire(&arg, args, FailoverSecondary);
+ secondary = arg.val.p;
+
+ fo = failoverOfLand(land);
+ fo->primary = primary;
+ fo->secondary = secondary;
+ fo->sig = FailoverSig;
+ AVERT(Failover, fo);
+ return ResOK;
+}
+
+
+static void failoverFinish(Land land)
+{
+ Failover fo;
+
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+
+ fo->sig = SigInvalid;
+}
+
+
+static Size failoverSize(Land land)
+{
+ Failover fo;
+
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+
+ return LandSize(fo->primary) + LandSize(fo->secondary);
+}
+
+
+static Res failoverInsert(Range rangeReturn, Land land, Range range)
+{
+ Failover fo;
+ Res res;
+
+ AVER(rangeReturn != NULL);
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+ AVERT(Range, range);
+
+ /* Provide more opportunities for coalescence. See
+ * .
+ */
+ (void)LandFlush(fo->primary, fo->secondary);
+
+ res = LandInsert(rangeReturn, fo->primary, range);
+ if (res != ResOK && res != ResFAIL)
+ res = LandInsert(rangeReturn, fo->secondary, range);
+
+ return res;
+}
+
+
+static Res failoverDelete(Range rangeReturn, Land land, Range range)
+{
+ Failover fo;
+ Res res;
+ RangeStruct oldRange, dummyRange, left, right;
+
+ AVER(rangeReturn != NULL);
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+ AVERT(Range, range);
+
+ /* Prefer efficient search in the primary. See
+ * .
+ */
+ (void)LandFlush(fo->primary, fo->secondary);
+
+ res = LandDelete(&oldRange, fo->primary, range);
+
+ if (res == ResFAIL) {
+ /* Range not found in primary: try secondary. */
+ return LandDelete(rangeReturn, fo->secondary, range);
+ } else if (res != ResOK) {
+ /* Range was found in primary, but couldn't be deleted. The only
+ * case we expect to encounter here is the case where the primary
+ * is out of memory. (In particular, we don't handle the case of a
+ * CBS returning ResLIMIT because its block pool has been
+ * configured not to automatically extend itself.)
+ */
+ AVER(ResIsAllocFailure(res));
+
+ /* Delete the whole of oldRange, and re-insert the fragments
+ * (which might end up in the secondary). See
+ * .
+ */
+ res = LandDelete(&dummyRange, fo->primary, &oldRange);
+ if (res != ResOK)
+ return res;
+
+ AVER(RangesEqual(&oldRange, &dummyRange));
+ RangeInit(&left, RangeBase(&oldRange), RangeBase(range));
+ if (!RangeIsEmpty(&left)) {
+ /* Don't call LandInsert(..., land, ...) here: that would be
+ * re-entrant and fail the landEnter check. */
+ res = LandInsert(&dummyRange, fo->primary, &left);
+ if (res != ResOK) {
+ /* The range was successful deleted from the primary above. */
+ AVER(res != ResFAIL);
+ res = LandInsert(&dummyRange, fo->secondary, &left);
+ AVER(res == ResOK);
+ }
+ }
+ RangeInit(&right, RangeLimit(range), RangeLimit(&oldRange));
+ if (!RangeIsEmpty(&right)) {
+ res = LandInsert(&dummyRange, fo->primary, &right);
+ if (res != ResOK) {
+ /* The range was successful deleted from the primary above. */
+ AVER(res != ResFAIL);
+ res = LandInsert(&dummyRange, fo->secondary, &right);
+ AVER(res == ResOK);
+ }
+ }
+ }
+ if (res == ResOK) {
+ AVER(RangesNest(&oldRange, range));
+ RangeCopy(rangeReturn, &oldRange);
+ }
+ return res;
+}
+
+
+static Bool failoverIterate(Land land, LandVisitor visitor, void *closureP, Size closureS)
+{
+ Failover fo;
+
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+ AVER(visitor != NULL);
+
+ return LandIterate(fo->primary, visitor, closureP, closureS)
+ && LandIterate(fo->secondary, visitor, closureP, closureS);
+}
+
+
+static Bool failoverFindFirst(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+{
+ Failover fo;
+
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+ AVERT(FindDelete, findDelete);
+
+ /* See . */
+ (void)LandFlush(fo->primary, fo->secondary);
+
+ return LandFindFirst(rangeReturn, oldRangeReturn, fo->primary, size, findDelete)
+ || LandFindFirst(rangeReturn, oldRangeReturn, fo->secondary, size, findDelete);
+}
+
+
+static Bool failoverFindLast(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+{
+ Failover fo;
+
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+ AVERT(FindDelete, findDelete);
+
+ /* See . */
+ (void)LandFlush(fo->primary, fo->secondary);
+
+ return LandFindLast(rangeReturn, oldRangeReturn, fo->primary, size, findDelete)
+ || LandFindLast(rangeReturn, oldRangeReturn, fo->secondary, size, findDelete);
+}
+
+
+static Bool failoverFindLargest(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+{
+ Failover fo;
+
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+ AVERT(FindDelete, findDelete);
+
+ /* See . */
+ (void)LandFlush(fo->primary, fo->secondary);
+
+ return LandFindLargest(rangeReturn, oldRangeReturn, fo->primary, size, findDelete)
+ || LandFindLargest(rangeReturn, oldRangeReturn, fo->secondary, size, findDelete);
+}
+
+
+static Bool failoverFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high)
+{
+ Failover fo;
+ Bool found = FALSE;
+ Res res;
+
+ AVER(FALSE); /* TODO: this code is completely untested! */
+ AVER(foundReturn != NULL);
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ fo = failoverOfLand(land);
+ AVERT(Failover, fo);
+ /* AVERT(ZoneSet, zoneSet); */
+ AVERT(Bool, high);
+
+ /* See . */
+ (void)LandFlush(fo->primary, fo->secondary);
+
+ res = LandFindInZones(&found, rangeReturn, oldRangeReturn, fo->primary, size, zoneSet, high);
+ if (res != ResOK || !found)
+ res = LandFindInZones(&found, rangeReturn, oldRangeReturn, fo->secondary, size, zoneSet, high);
+
+ *foundReturn = found;
+ return res;
+}
+
+
+static Res failoverDescribe(Land land, mps_lib_FILE *stream)
+{
+ Failover fo;
+ Res res;
+
+ if (!TESTT(Land, land)) return ResFAIL;
+ fo = failoverOfLand(land);
+ if (!TESTT(Failover, fo)) return ResFAIL;
+ if (stream == NULL) return ResFAIL;
+
+ res = WriteF(stream,
+ "Failover $P {\n", (WriteFP)fo,
+ " primary = $P ($S)\n", (WriteFP)fo->primary,
+ fo->primary->class->name,
+ " secondary = $P ($S)\n", (WriteFP)fo->secondary,
+ fo->secondary->class->name,
+ "}\n", NULL);
+
+ return res;
+}
+
+
+DEFINE_LAND_CLASS(FailoverLandClass, class)
+{
+ INHERIT_CLASS(class, LandClass);
+ class->name = "FAILOVER";
+ class->size = sizeof(FailoverStruct);
+ class->init = failoverInit;
+ class->finish = failoverFinish;
+ class->sizeMethod = failoverSize;
+ class->insert = failoverInsert;
+ class->delete = failoverDelete;
+ class->iterate = failoverIterate;
+ class->findFirst = failoverFindFirst;
+ class->findLast = failoverFindLast;
+ class->findLargest = failoverFindLargest;
+ class->findInZones = failoverFindInZones;
+ class->describe = failoverDescribe;
+ AVERT(LandClass, class);
+}
+
+
+/* C. COPYRIGHT AND LICENSE
+ *
+ * Copyright (C) 2014 Ravenbrook Limited .
+ * 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.
+ */
diff --git a/mps/code/mpsw3.h b/mps/code/failover.h
similarity index 69%
rename from mps/code/mpsw3.h
rename to mps/code/failover.h
index f32b7a09831..56e6149e05e 100644
--- a/mps/code/mpsw3.h
+++ b/mps/code/failover.h
@@ -1,45 +1,35 @@
-/* mpsw3.h: RAVENBROOK MEMORY POOL SYSTEM C INTERFACE, WINDOWS PART
+/* failover.h: FAILOVER ALLOCATOR INTERFACE
*
* $Id$
- * Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2014 Ravenbrook Limited. See end of file for license.
*
- * .readership: customers, MPS developers.
- * .sources: .
+ * .source: .
*/
-#ifndef mpsw3_h
-#define mpsw3_h
+#ifndef failover_h
+#define failover_h
-#include "mps.h" /* needed for mps_tramp_t */
-#include "mpswin.h" /* needed for SEH filter */
+#include "mpmtypes.h"
+typedef struct FailoverStruct *Failover;
-extern LONG mps_SEH_filter(LPEXCEPTION_POINTERS, void **, size_t *);
-extern void mps_SEH_handler(void *, size_t);
+extern Bool FailoverCheck(Failover failover);
+extern LandClass FailoverLandClassGet(void);
-#define mps_tramp(r_o, f, p, s) \
- MPS_BEGIN \
- void **_r_o = (r_o); \
- mps_tramp_t _f = (f); \
- void *_p = (p); \
- size_t _s = (s); \
- void *_hp = NULL; size_t _hs = 0; \
- __try { \
- *_r_o = (*_f)(_p, _s); \
- } __except(mps_SEH_filter(GetExceptionInformation(), \
- &_hp, &_hs)) { \
- mps_SEH_handler(_hp, _hs); \
- } \
- MPS_END
+extern const struct mps_key_s _mps_key_failover_primary;
+#define FailoverPrimary (&_mps_key_failover_primary)
+#define FailoverPrimary_FIELD p
+extern const struct mps_key_s _mps_key_failover_secondary;
+#define FailoverSecondary (&_mps_key_failover_secondary)
+#define FailoverSecondary_FIELD p
-
-#endif /* mpsw3_h */
+#endif /* failover.h */
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2002 Ravenbrook Limited .
+ * Copyright (C) 2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/fbmtest.c b/mps/code/fbmtest.c
index bf1ae605f76..47666563db7 100644
--- a/mps/code/fbmtest.c
+++ b/mps/code/fbmtest.c
@@ -97,6 +97,7 @@ static Bool checkCallback(Range range, void *closureP, Size closureS)
Addr base, limit;
CheckFBMClosure cl = (CheckFBMClosure)closureP;
+ AVER(closureS == UNUSED_SIZE);
UNUSED(closureS);
Insist(cl != NULL);
@@ -148,10 +149,10 @@ static void check(FBMState state)
switch (state->type) {
case FBMTypeCBS:
- CBSIterate(state->the.cbs, checkCBSCallback, (void *)&closure, 0);
+ CBSIterate(state->the.cbs, checkCBSCallback, &closure, UNUSED_SIZE);
break;
case FBMTypeFreelist:
- FreelistIterate(state->the.fl, checkFLCallback, (void *)&closure, 0);
+ FreelistIterate(state->the.fl, checkFLCallback, &closure, UNUSED_SIZE);
break;
default:
cdie(0, "invalid state->type");
diff --git a/mps/code/finalcv.c b/mps/code/finalcv.c
index 1466e514ff8..931503cf9bb 100644
--- a/mps/code/finalcv.c
+++ b/mps/code/finalcv.c
@@ -199,6 +199,7 @@ static void *test(void *arg, size_t s)
/* @@@@ missing */
+ mps_arena_park(arena);
mps_ap_destroy(ap);
mps_root_destroy(mps_root[1]);
mps_root_destroy(mps_root[0]);
diff --git a/mps/code/finaltest.c b/mps/code/finaltest.c
index 02c1448d137..2e36c31ee10 100644
--- a/mps/code/finaltest.c
+++ b/mps/code/finaltest.c
@@ -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
*/
+#include "mpm.h"
#include "testlib.h"
#include "mpslib.h"
#include "mps.h"
@@ -30,10 +45,15 @@
#include /* 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;
@@ -167,12 +204,17 @@ static void test_trees(const char *name, mps_arena_t arena, mps_ap_t ap,
}
finals += final_this_time;
printf("%"PRIuLONGEST" objects finalized: total %"PRIuLONGEST
- " of %"PRIuLONGEST"\n", final_this_time, finals, object_count);
+ " 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;
@@ -181,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);
@@ -193,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_awl());
+ test_pool(mode, arena, chain, mps_class_lo());
}
@@ -213,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);
diff --git a/mps/code/fmtscheme.c b/mps/code/fmtscheme.c
index 5299c8f3525..24fa06db871 100644
--- a/mps/code/fmtscheme.c
+++ b/mps/code/fmtscheme.c
@@ -12,14 +12,8 @@
/* special objects */
-obj_t obj_empty; /* (), the empty list */
-obj_t obj_eof; /* end of file */
-obj_t obj_error; /* error indicator */
-obj_t obj_true; /* #t, boolean true */
-obj_t obj_false; /* #f, boolean false */
-obj_t obj_undefined; /* undefined result indicator */
-obj_t obj_tail; /* tail recursion indicator */
-obj_t obj_deleted; /* deleted key in hashtable */
+static obj_t obj_true; /* #t, boolean true */
+static obj_t obj_false; /* #f, boolean false */
/* MPS globals */
@@ -50,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)
{
@@ -137,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;
@@ -147,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;
@@ -221,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;
}
@@ -458,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");
diff --git a/mps/code/fmtscheme.h b/mps/code/fmtscheme.h
index fbbbddf8ccd..95a62a53cef 100644
--- a/mps/code/fmtscheme.h
+++ b/mps/code/fmtscheme.h
@@ -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;
diff --git a/mps/code/fotest.c b/mps/code/fotest.c
index 2e63d4e121b..788253b570d 100644
--- a/mps/code/fotest.c
+++ b/mps/code/fotest.c
@@ -38,28 +38,35 @@
/* Accessors for the CBS used to implement a pool. */
-extern CBS _mps_mvff_cbs(mps_pool_t);
-extern CBS _mps_mvt_cbs(mps_pool_t);
+extern Land _mps_mvff_cbs(Pool);
+extern Land _mps_mvt_cbs(Pool);
/* "OOM" pool class -- dummy alloc/free pool class whose alloc()
- * method always returns ResMEMORY */
+ * method always fails. */
-static Res OOMAlloc(Addr *pReturn, Pool pool, Size size,
- Bool withReservoirPermit)
+static Res oomAlloc(Addr *pReturn, Pool pool, Size size,
+ Bool withReservoirPermit)
{
UNUSED(pReturn);
UNUSED(pool);
UNUSED(size);
UNUSED(withReservoirPermit);
- return ResMEMORY;
+ switch (rnd() % 3) {
+ case 0:
+ return ResRESOURCE;
+ case 1:
+ return ResMEMORY;
+ default:
+ return ResCOMMIT_LIMIT;
+ }
}
-extern PoolClass PoolClassOOM(void);
+extern PoolClass OOMPoolClassGet(void);
DEFINE_POOL_CLASS(OOMPoolClass, this)
{
INHERIT_CLASS(this, AbstractAllocFreePoolClass);
- this->alloc = OOMAlloc;
+ this->alloc = oomAlloc;
this->size = sizeof(PoolStruct);
AVERT(PoolClass, this);
}
@@ -83,16 +90,17 @@ static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
/* set_oom -- set blockPool of CBS to OOM or MFS according to argument. */
-static void set_oom(CBS cbs, int oom)
+static void set_oom(Land land, int oom)
{
- cbs->blockPool->class = oom ? EnsureOOMPoolClass() : PoolClassMFS();
+ CBS cbs = PARENT(CBSStruct, landStruct, land);
+ cbs->blockPool->class = oom ? OOMPoolClassGet() : PoolClassMFS();
}
/* stress -- create an allocation point and allocate in it */
static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t),
- mps_align_t alignment, mps_pool_t pool, CBS cbs)
+ mps_align_t alignment, mps_pool_t pool, Land cbs)
{
mps_res_t res = MPS_RES_OK;
mps_ap_t ap;
@@ -182,8 +190,8 @@ int main(int argc, char *argv[])
die(mps_pool_create_k(&pool, arena, mps_class_mvff(), args), "create MVFF");
} MPS_ARGS_END(args);
{
- CBS cbs = _mps_mvff_cbs(pool);
- die(stress(randomSizeAligned, alignment, pool, cbs), "stress MVFF");
+ die(stress(randomSizeAligned, alignment, pool, _mps_mvff_cbs(pool)),
+ "stress MVFF");
}
mps_pool_destroy(pool);
mps_arena_destroy(arena);
@@ -201,8 +209,8 @@ int main(int argc, char *argv[])
die(mps_pool_create_k(&pool, arena, mps_class_mvt(), args), "create MVFF");
} MPS_ARGS_END(args);
{
- CBS cbs = _mps_mvt_cbs(pool);
- die(stress(randomSizeAligned, alignment, pool, cbs), "stress MVT");
+ die(stress(randomSizeAligned, alignment, pool, _mps_mvt_cbs(pool)),
+ "stress MVT");
}
mps_pool_destroy(pool);
mps_arena_destroy(arena);
diff --git a/mps/code/freelist.c b/mps/code/freelist.c
index 8468127e963..44553927cbf 100644
--- a/mps/code/freelist.c
+++ b/mps/code/freelist.c
@@ -6,28 +6,58 @@
* .sources: .
*/
-#include "cbs.h"
#include "freelist.h"
#include "mpm.h"
+#include "range.h"
SRCID(freelist, "$Id$");
+#define freelistOfLand(land) PARENT(FreelistStruct, landStruct, land)
+#define freelistAlignment(fl) LandAlignment(&(fl)->landStruct)
+
+
typedef union FreelistBlockUnion {
struct {
FreelistBlock next; /* tagged with low bit 1 */
- /* limit is (char *)this + fl->alignment */
+ /* limit is (char *)this + freelistAlignment(fl) */
} small;
struct {
- FreelistBlock next;
+ FreelistBlock next; /* not tagged (low bit 0) */
Addr limit;
} large;
} FreelistBlockUnion;
+/* freelistEND -- the end of a list
+ *
+ * The end of a list should not be represented with NULL, as this is
+ * ambiguous. However, freelistEND is in fact a null pointer, for
+ * performance. To check whether you have it right, try temporarily
+ * defining freelistEND as ((FreelistBlock)2) or similar (it must be
+ * an even number because of the use of a tag).
+ */
+
+#define freelistEND ((FreelistBlock)0)
+
+
+/* FreelistTag -- return the tag of word */
+
#define FreelistTag(word) ((word) & 1)
+
+
+/* FreelistTagSet -- return word updated with the tag set */
+
#define FreelistTagSet(word) ((FreelistBlock)((Word)(word) | 1))
+
+
+/* FreelistTagReset -- return word updated with the tag reset */
+
#define FreelistTagReset(word) ((FreelistBlock)((Word)(word) & ~(Word)1))
+
+
+/* FreelistTagCopy -- return 'to' updated to have the same tag as 'from' */
+
#define FreelistTagCopy(to, from) ((FreelistBlock)((Word)(to) | FreelistTag((Word)(from))))
@@ -47,7 +77,7 @@ static Addr FreelistBlockLimit(Freelist fl, FreelistBlock block)
{
AVERT(Freelist, fl);
if (FreelistBlockIsSmall(block)) {
- return AddrAdd(FreelistBlockBase(block), fl->alignment);
+ return AddrAdd(FreelistBlockBase(block), freelistAlignment(fl));
} else {
return block->large.limit;
}
@@ -56,11 +86,12 @@ static Addr FreelistBlockLimit(Freelist fl, FreelistBlock block)
/* FreelistBlockCheck -- check a block. */
+ATTRIBUTE_UNUSED
static Bool FreelistBlockCheck(FreelistBlock block)
{
CHECKL(block != NULL);
/* block list is address-ordered */
- CHECKL(FreelistTagReset(block->small.next) == NULL
+ CHECKL(FreelistTagReset(block->small.next) == freelistEND
|| block < FreelistTagReset(block->small.next));
CHECKL(FreelistBlockIsSmall(block) || (Addr)block < block->large.limit);
@@ -68,8 +99,8 @@ static Bool FreelistBlockCheck(FreelistBlock block)
}
-/* FreelistBlockNext -- return the next block in the list, or NULL if
- * there are no more blocks.
+/* FreelistBlockNext -- return the next block in the list, or
+ * freelistEND if there are no more blocks.
*/
static FreelistBlock FreelistBlockNext(FreelistBlock block)
{
@@ -101,7 +132,7 @@ static void FreelistBlockSetLimit(Freelist fl, FreelistBlock block, Addr limit)
AVERT(Freelist, fl);
AVERT(FreelistBlock, block);
- AVER(AddrIsAligned(limit, fl->alignment));
+ AVER(AddrIsAligned(limit, freelistAlignment(fl)));
AVER(FreelistBlockBase(block) < limit);
size = AddrOffset(block, limit);
@@ -124,12 +155,12 @@ static FreelistBlock FreelistBlockInit(Freelist fl, Addr base, Addr limit)
AVERT(Freelist, fl);
AVER(base != NULL);
- AVER(AddrIsAligned(base, fl->alignment));
+ AVER(AddrIsAligned(base, freelistAlignment(fl)));
AVER(base < limit);
- AVER(AddrIsAligned(limit, fl->alignment));
+ AVER(AddrIsAligned(limit, freelistAlignment(fl)));
block = (FreelistBlock)base;
- block->small.next = FreelistTagSet(NULL);
+ block->small.next = FreelistTagSet(freelistEND);
FreelistBlockSetLimit(fl, block, limit);
AVERT(FreelistBlock, block);
return block;
@@ -138,23 +169,39 @@ static FreelistBlock FreelistBlockInit(Freelist fl, Addr base, Addr limit)
Bool FreelistCheck(Freelist fl)
{
+ Land land;
CHECKS(Freelist, fl);
+ land = &fl->landStruct;
+ CHECKD(Land, land);
/* See */
- CHECKL(AlignIsAligned(fl->alignment, FreelistMinimumAlignment));
- CHECKL((fl->list == NULL) == (fl->listSize == 0));
+ CHECKL(AlignIsAligned(freelistAlignment(fl), FreelistMinimumAlignment));
+ CHECKL((fl->list == freelistEND) == (fl->listSize == 0));
+ CHECKL((fl->list == freelistEND) == (fl->size == 0));
+ CHECKL(SizeIsAligned(fl->size, freelistAlignment(fl)));
+
return TRUE;
}
-Res FreelistInit(Freelist fl, Align alignment)
+static Res freelistInit(Land land, ArgList args)
{
- AVER(fl != NULL);
- /* See */
- AVER(AlignIsAligned(alignment, FreelistMinimumAlignment));
+ Freelist fl;
+ LandClass super;
+ Res res;
- fl->alignment = alignment;
- fl->list = NULL;
+ AVERT(Land, land);
+ super = LAND_SUPERCLASS(FreelistLandClass);
+ res = (*super->init)(land, args);
+ if (res != ResOK)
+ return res;
+
+ /* See */
+ AVER(AlignIsAligned(LandAlignment(land), FreelistMinimumAlignment));
+
+ fl = freelistOfLand(land);
+ fl->list = freelistEND;
fl->listSize = 0;
+ fl->size = 0;
fl->sig = FreelistSig;
AVERT(Freelist, fl);
@@ -162,31 +209,56 @@ Res FreelistInit(Freelist fl, Align alignment)
}
-void FreelistFinish(Freelist fl)
+static void freelistFinish(Land land)
{
+ Freelist fl;
+
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
AVERT(Freelist, fl);
fl->sig = SigInvalid;
- fl->list = NULL;
+ fl->list = freelistEND;
+}
+
+
+static Size freelistSize(Land land)
+{
+ Freelist fl;
+
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
+ AVERT(Freelist, fl);
+ return fl->size;
}
/* freelistBlockSetPrevNext -- update list of blocks
- * If prev and next are both NULL, make the block list empty.
- * Otherwise, if prev is NULL, make next the first block in the list.
- * Otherwise, if next is NULL, make prev the last block in the list.
+ *
+ * If prev and next are both freelistEND, make the block list empty.
+ * Otherwise, if prev is freelistEND, make next the first block in the list.
+ * Otherwise, if next is freelistEND, make prev the last block in the list.
* Otherwise, make next follow prev in the list.
* Update the count of blocks by 'delta'.
+
+ * It is tempting to try to simplify this code by putting a
+ * FreelistBlockUnion into the FreelistStruct and so avoiding the
+ * special case on prev. But the problem with that idea is that we
+ * can't guarantee that such a sentinel would respect the isolated
+ * range invariant, and so it would still have to be special-cases.
*/
+
static void freelistBlockSetPrevNext(Freelist fl, FreelistBlock prev,
FreelistBlock next, int delta)
{
AVERT(Freelist, fl);
- if (prev) {
- AVER(next == NULL || FreelistBlockLimit(fl, prev) < FreelistBlockBase(next));
- FreelistBlockSetNext(prev, next);
- } else {
+ if (prev == freelistEND) {
fl->list = next;
+ } else {
+ /* Isolated range invariant (design.mps.freelist.impl.invariant). */
+ AVER(next == freelistEND
+ || FreelistBlockLimit(fl, prev) < FreelistBlockBase(next));
+ FreelistBlockSetNext(prev, next);
}
if (delta < 0) {
AVER(fl->listSize >= (Count)-delta);
@@ -197,29 +269,32 @@ static void freelistBlockSetPrevNext(Freelist fl, FreelistBlock prev,
}
-Res FreelistInsert(Range rangeReturn, Freelist fl, Range range)
+static Res freelistInsert(Range rangeReturn, Land land, Range range)
{
+ Freelist fl;
FreelistBlock prev, cur, next, new;
Addr base, limit;
Bool coalesceLeft, coalesceRight;
AVER(rangeReturn != NULL);
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
AVERT(Freelist, fl);
AVERT(Range, range);
- AVER(RangeIsAligned(range, fl->alignment));
+ AVER(RangeIsAligned(range, freelistAlignment(fl)));
base = RangeBase(range);
limit = RangeLimit(range);
- prev = NULL;
+ prev = freelistEND;
cur = fl->list;
- while (cur) {
+ while (cur != freelistEND) {
if (base < FreelistBlockLimit(fl, cur) && FreelistBlockBase(cur) < limit)
return ResFAIL; /* range overlaps with cur */
if (limit <= FreelistBlockBase(cur))
break;
next = FreelistBlockNext(cur);
- if (next)
+ if (next != freelistEND)
/* Isolated range invariant (design.mps.freelist.impl.invariant). */
AVER(FreelistBlockLimit(fl, cur) < FreelistBlockBase(next));
prev = cur;
@@ -230,8 +305,8 @@ Res FreelistInsert(Range rangeReturn, Freelist fl, Range range)
* coalesces then it does so with prev on the left, and cur on the
* right.
*/
- coalesceLeft = (prev && base == FreelistBlockLimit(fl, prev));
- coalesceRight = (cur && limit == FreelistBlockBase(cur));
+ coalesceLeft = (prev != freelistEND && base == FreelistBlockLimit(fl, prev));
+ coalesceRight = (cur != freelistEND && limit == FreelistBlockBase(cur));
if (coalesceLeft && coalesceRight) {
base = FreelistBlockBase(prev);
@@ -257,17 +332,20 @@ Res FreelistInsert(Range rangeReturn, Freelist fl, Range range)
freelistBlockSetPrevNext(fl, prev, new, +1);
}
+ fl->size += RangeSize(range);
RangeInit(rangeReturn, base, limit);
return ResOK;
}
-/* freelistDeleteFromBlock -- delete 'range' from 'block' (it is known
- * to be a subset of that block); update 'rangeReturn' to the original
- * range of 'block' and update the block list accordingly: 'prev' is
- * the block on the list just before 'block', or NULL if 'block' is
- * the first block on the list.
+/* freelistDeleteFromBlock -- delete range from block
+ *
+ * range must be a subset of block. Update rangeReturn to be the
+ * original range of block and update the block list accordingly: prev
+ * is on the list just before block, or freelistEND if block is the
+ * first block on the list.
*/
+
static void freelistDeleteFromBlock(Range rangeReturn, Freelist fl,
Range range, FreelistBlock prev,
FreelistBlock block)
@@ -278,8 +356,8 @@ static void freelistDeleteFromBlock(Range rangeReturn, Freelist fl,
AVER(rangeReturn != NULL);
AVERT(Freelist, fl);
AVERT(Range, range);
- AVER(RangeIsAligned(range, fl->alignment));
- AVER(prev == NULL || FreelistBlockNext(prev) == block);
+ AVER(RangeIsAligned(range, freelistAlignment(fl)));
+ AVER(prev == freelistEND || FreelistBlockNext(prev) == block);
AVERT(FreelistBlock, block);
AVER(FreelistBlockBase(block) <= RangeBase(range));
AVER(RangeLimit(range) <= FreelistBlockLimit(fl, block));
@@ -312,25 +390,30 @@ static void freelistDeleteFromBlock(Range rangeReturn, Freelist fl,
freelistBlockSetPrevNext(fl, block, new, +1);
}
+ AVER(fl->size >= RangeSize(range));
+ fl->size -= RangeSize(range);
RangeInit(rangeReturn, blockBase, blockLimit);
}
-Res FreelistDelete(Range rangeReturn, Freelist fl, Range range)
+static Res freelistDelete(Range rangeReturn, Land land, Range range)
{
+ Freelist fl;
FreelistBlock prev, cur, next;
Addr base, limit;
AVER(rangeReturn != NULL);
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
AVERT(Freelist, fl);
AVERT(Range, range);
base = RangeBase(range);
limit = RangeLimit(range);
- prev = NULL;
+ prev = freelistEND;
cur = fl->list;
- while (cur) {
+ while (cur != freelistEND) {
Addr blockBase, blockLimit;
blockBase = FreelistBlockBase(cur);
blockLimit = FreelistBlockLimit(fl, cur);
@@ -354,43 +437,82 @@ Res FreelistDelete(Range rangeReturn, Freelist fl, Range range)
}
-void FreelistIterate(Freelist fl, FreelistIterateMethod iterate,
- void *closureP, Size closureS)
+static Bool freelistIterate(Land land, LandVisitor visitor,
+ void *closureP, Size closureS)
{
- FreelistBlock prev, cur, next;
+ Freelist fl;
+ FreelistBlock cur, next;
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
AVERT(Freelist, fl);
- AVER(FUNCHECK(iterate));
+ AVER(FUNCHECK(visitor));
+ /* closureP and closureS are arbitrary */
- prev = NULL;
- cur = fl->list;
- while (cur) {
- Bool delete = FALSE;
+ for (cur = fl->list; cur != freelistEND; cur = next) {
RangeStruct range;
Bool cont;
- RangeInit(&range, FreelistBlockBase(cur), FreelistBlockLimit(fl, cur));
- cont = (*iterate)(&delete, &range, closureP, closureS);
+ /* .next.first: Take next before calling the visitor, in case the
+ * visitor touches the block. */
next = FreelistBlockNext(cur);
- if (delete) {
- freelistBlockSetPrevNext(fl, prev, next, -1);
- } else {
- prev = cur;
- }
- cur = next;
+ RangeInit(&range, FreelistBlockBase(cur), FreelistBlockLimit(fl, cur));
+ cont = (*visitor)(land, &range, closureP, closureS);
if (!cont)
- break;
+ return FALSE;
}
+ return TRUE;
}
-/* freelistFindDeleteFromBlock -- Find a chunk of 'size' bytes in
- * 'block' (which is known to be at least that big) and possibly
- * delete that chunk according to the instruction in 'findDelete'.
- * Return the range of that chunk in 'rangeReturn'. Return the
- * original range of the block in 'oldRangeReturn'. Update the block
- * list accordingly, using 'prev' which is the previous block in the
- * list, or NULL if 'block' is the first block in the list.
+static Bool freelistIterateAndDelete(Land land, LandDeleteVisitor visitor,
+ void *closureP, Size closureS)
+{
+ Freelist fl;
+ FreelistBlock prev, cur, next;
+
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
+ AVERT(Freelist, fl);
+ AVER(FUNCHECK(visitor));
+ /* closureP and closureS are arbitrary */
+
+ prev = freelistEND;
+ cur = fl->list;
+ while (cur != freelistEND) {
+ Bool delete = FALSE;
+ RangeStruct range;
+ Bool cont;
+ Size size;
+ next = FreelistBlockNext(cur); /* See .next.first. */
+ size = FreelistBlockSize(fl, cur);
+ RangeInit(&range, FreelistBlockBase(cur), FreelistBlockLimit(fl, cur));
+ cont = (*visitor)(&delete, land, &range, closureP, closureS);
+ if (delete) {
+ freelistBlockSetPrevNext(fl, prev, next, -1);
+ AVER(fl->size >= size);
+ fl->size -= size;
+ } else {
+ prev = cur;
+ }
+ if (!cont)
+ return FALSE;
+ cur = next;
+ }
+ return TRUE;
+}
+
+
+/* freelistFindDeleteFromBlock -- delete size bytes from block
+ *
+ * Find a chunk of size bytes in block (which is known to be at least
+ * that big) and possibly delete that chunk according to the
+ * instruction in findDelete. Return the range of that chunk in
+ * rangeReturn. Return the original range of the block in
+ * oldRangeReturn. Update the block list accordingly, using prev,
+ * which is previous in list or freelistEND if block is the first
+ * block in the list.
*/
+
static void freelistFindDeleteFromBlock(Range rangeReturn, Range oldRangeReturn,
Freelist fl, Size size,
FindDelete findDelete,
@@ -402,9 +524,9 @@ static void freelistFindDeleteFromBlock(Range rangeReturn, Range oldRangeReturn,
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
AVERT(Freelist, fl);
- AVER(SizeIsAligned(size, fl->alignment));
+ AVER(SizeIsAligned(size, freelistAlignment(fl)));
AVERT(FindDelete, findDelete);
- AVER(prev == NULL || FreelistBlockNext(prev) == block);
+ AVER(prev == freelistEND || FreelistBlockNext(prev) == block);
AVERT(FreelistBlock, block);
AVER(FreelistBlockSize(fl, block) >= size);
@@ -442,20 +564,23 @@ static void freelistFindDeleteFromBlock(Range rangeReturn, Range oldRangeReturn,
}
-Bool FreelistFindFirst(Range rangeReturn, Range oldRangeReturn,
- Freelist fl, Size size, FindDelete findDelete)
+static Bool freelistFindFirst(Range rangeReturn, Range oldRangeReturn,
+ Land land, Size size, FindDelete findDelete)
{
+ Freelist fl;
FreelistBlock prev, cur, next;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
AVERT(Freelist, fl);
- AVER(SizeIsAligned(size, fl->alignment));
+ AVER(SizeIsAligned(size, freelistAlignment(fl)));
AVERT(FindDelete, findDelete);
- prev = NULL;
+ prev = freelistEND;
cur = fl->list;
- while (cur) {
+ while (cur != freelistEND) {
if (FreelistBlockSize(fl, cur) >= size) {
freelistFindDeleteFromBlock(rangeReturn, oldRangeReturn, fl, size,
findDelete, prev, cur);
@@ -470,22 +595,25 @@ Bool FreelistFindFirst(Range rangeReturn, Range oldRangeReturn,
}
-Bool FreelistFindLast(Range rangeReturn, Range oldRangeReturn,
- Freelist fl, Size size, FindDelete findDelete)
+static Bool freelistFindLast(Range rangeReturn, Range oldRangeReturn,
+ Land land, Size size, FindDelete findDelete)
{
+ Freelist fl;
Bool found = FALSE;
FreelistBlock prev, cur, next;
- FreelistBlock foundPrev = NULL, foundCur = NULL;
+ FreelistBlock foundPrev = freelistEND, foundCur = freelistEND;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
AVERT(Freelist, fl);
- AVER(SizeIsAligned(size, fl->alignment));
+ AVER(SizeIsAligned(size, freelistAlignment(fl)));
AVERT(FindDelete, findDelete);
- prev = NULL;
+ prev = freelistEND;
cur = fl->list;
- while (cur) {
+ while (cur != freelistEND) {
if (FreelistBlockSize(fl, cur) >= size) {
found = TRUE;
foundPrev = prev;
@@ -504,21 +632,24 @@ Bool FreelistFindLast(Range rangeReturn, Range oldRangeReturn,
}
-Bool FreelistFindLargest(Range rangeReturn, Range oldRangeReturn,
- Freelist fl, Size size, FindDelete findDelete)
+static Bool freelistFindLargest(Range rangeReturn, Range oldRangeReturn,
+ Land land, Size size, FindDelete findDelete)
{
+ Freelist fl;
Bool found = FALSE;
FreelistBlock prev, cur, next;
- FreelistBlock bestPrev = NULL, bestCur = NULL;
+ FreelistBlock bestPrev = freelistEND, bestCur = freelistEND;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
AVERT(Freelist, fl);
AVERT(FindDelete, findDelete);
- prev = NULL;
+ prev = freelistEND;
cur = fl->list;
- while (cur) {
+ while (cur != freelistEND) {
if (FreelistBlockSize(fl, cur) >= size) {
found = TRUE;
size = FreelistBlockSize(fl, cur);
@@ -538,20 +669,90 @@ Bool FreelistFindLargest(Range rangeReturn, Range oldRangeReturn,
}
-/* freelistDescribeIterateMethod -- Iterate method for
- * FreelistDescribe. Writes a decription of the range into the stream
- * pointed to by 'closureP'.
+static Res freelistFindInZones(Bool *foundReturn, Range rangeReturn,
+ Range oldRangeReturn, Land land, Size size,
+ ZoneSet zoneSet, Bool high)
+{
+ Freelist fl;
+ LandFindMethod landFind;
+ RangeInZoneSet search;
+ Bool found = FALSE;
+ FreelistBlock prev, cur, next;
+ FreelistBlock foundPrev = freelistEND, foundCur = freelistEND;
+ RangeStruct foundRange;
+
+ AVER(FALSE); /* TODO: this code is completely untested! */
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ fl = freelistOfLand(land);
+ AVERT(Freelist, fl);
+ /* AVERT(ZoneSet, zoneSet); */
+ AVERT(Bool, high);
+
+ landFind = high ? freelistFindLast : freelistFindFirst;
+ search = high ? RangeInZoneSetLast : RangeInZoneSetFirst;
+
+ if (zoneSet == ZoneSetEMPTY)
+ goto fail;
+ if (zoneSet == ZoneSetUNIV) {
+ FindDelete fd = high ? FindDeleteHIGH : FindDeleteLOW;
+ *foundReturn = (*landFind)(rangeReturn, oldRangeReturn, land, size, fd);
+ return ResOK;
+ }
+ if (ZoneSetIsSingle(zoneSet) && size > ArenaStripeSize(LandArena(land)))
+ goto fail;
+
+ prev = freelistEND;
+ cur = fl->list;
+ while (cur != freelistEND) {
+ Addr base, limit;
+ if ((*search)(&base, &limit, FreelistBlockBase(cur),
+ FreelistBlockLimit(fl, cur),
+ LandArena(land), zoneSet, size))
+ {
+ found = TRUE;
+ foundPrev = prev;
+ foundCur = cur;
+ RangeInit(&foundRange, base, limit);
+ if (!high)
+ break;
+ }
+ next = FreelistBlockNext(cur);
+ prev = cur;
+ cur = next;
+ }
+
+ if (!found)
+ goto fail;
+
+ freelistDeleteFromBlock(oldRangeReturn, fl, &foundRange, foundPrev, foundCur);
+ RangeCopy(rangeReturn, &foundRange);
+ *foundReturn = TRUE;
+ return ResOK;
+
+fail:
+ *foundReturn = FALSE;
+ return ResOK;
+}
+
+
+/* freelistDescribeVisitor -- visitor method for freelistDescribe
+ *
+ * Writes a decription of the range into the stream pointed to by
+ * closureP.
*/
-static Bool freelistDescribeIterateMethod(Bool *deleteReturn, Range range,
- void *closureP, Size closureS)
+
+static Bool freelistDescribeVisitor(Land land, Range range,
+ void *closureP, Size closureS)
{
Res res;
mps_lib_FILE *stream = closureP;
- AVER(deleteReturn != NULL);
- AVERT(Range, range);
- AVER(stream != NULL);
- UNUSED(closureS);
+ if (!TESTT(Land, land)) return FALSE;
+ if (!RangeCheck(range)) return FALSE;
+ if (stream == NULL) return FALSE;
+ if (closureS != UNUSED_SIZE) return FALSE;
res = WriteF(stream,
" [$P,", (WriteFP)RangeBase(range),
@@ -559,64 +760,52 @@ static Bool freelistDescribeIterateMethod(Bool *deleteReturn, Range range,
" {$U}\n", (WriteFU)RangeSize(range),
NULL);
- *deleteReturn = FALSE;
return res == ResOK;
}
-Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream)
+static Res freelistDescribe(Land land, mps_lib_FILE *stream)
{
+ Freelist fl;
Res res;
+ Bool b;
+ if (!TESTT(Land, land)) return ResFAIL;
+ fl = freelistOfLand(land);
if (!TESTT(Freelist, fl)) return ResFAIL;
if (stream == NULL) return ResFAIL;
res = WriteF(stream,
"Freelist $P {\n", (WriteFP)fl,
- " alignment = $U\n", (WriteFU)fl->alignment,
" listSize = $U\n", (WriteFU)fl->listSize,
NULL);
- FreelistIterate(fl, freelistDescribeIterateMethod, stream, 0);
+ b = LandIterate(land, freelistDescribeVisitor, stream, UNUSED_SIZE);
+ if (!b) return ResFAIL;
res = WriteF(stream, "}\n", NULL);
return res;
}
-/* freelistFlushIterateMethod -- Iterate method for
- * FreelistFlushToCBS. Attempst to insert the range into the CBS.
- */
-static Bool freelistFlushIterateMethod(Bool *deleteReturn, Range range,
- void *closureP, Size closureS)
+DEFINE_LAND_CLASS(FreelistLandClass, class)
{
- Res res;
- RangeStruct newRange;
- CBS cbs;
-
- AVER(deleteReturn != NULL);
- AVERT(Range, range);
- AVER(closureP != NULL);
- UNUSED(closureS);
-
- cbs = closureP;
- res = CBSInsert(&newRange, cbs, range);
- if (res == ResOK) {
- *deleteReturn = TRUE;
- return TRUE;
- } else {
- *deleteReturn = FALSE;
- return FALSE;
- }
-}
-
-
-void FreelistFlushToCBS(Freelist fl, CBS cbs)
-{
- AVERT(Freelist, fl);
- AVERT(CBS, cbs);
-
- FreelistIterate(fl, freelistFlushIterateMethod, cbs, 0);
+ INHERIT_CLASS(class, LandClass);
+ class->name = "FREELIST";
+ class->size = sizeof(FreelistStruct);
+ class->init = freelistInit;
+ class->finish = freelistFinish;
+ class->sizeMethod = freelistSize;
+ class->insert = freelistInsert;
+ class->delete = freelistDelete;
+ class->iterate = freelistIterate;
+ class->iterateAndDelete = freelistIterateAndDelete;
+ class->findFirst = freelistFindFirst;
+ class->findLast = freelistFindLast;
+ class->findLargest = freelistFindLargest;
+ class->findInZones = freelistFindInZones;
+ class->describe = freelistDescribe;
+ AVERT(LandClass, class);
}
diff --git a/mps/code/freelist.h b/mps/code/freelist.h
index 8ac4404736c..db75837253e 100644
--- a/mps/code/freelist.h
+++ b/mps/code/freelist.h
@@ -9,47 +9,16 @@
#ifndef freelist_h
#define freelist_h
-#include "cbs.h"
#include "mpmtypes.h"
-#include "range.h"
-
-#define FreelistSig ((Sig)0x519F6331) /* SIGnature FREEL */
typedef struct FreelistStruct *Freelist;
-typedef union FreelistBlockUnion *FreelistBlock;
+
+extern Bool FreelistCheck(Freelist freelist);
/* See */
#define FreelistMinimumAlignment ((Align)sizeof(FreelistBlock))
-typedef Bool (*FreelistIterateMethod)(Bool *deleteReturn, Range range,
- void *closureP, Size closureS);
-
-typedef struct FreelistStruct {
- Sig sig;
- Align alignment;
- FreelistBlock list;
- Count listSize;
-} FreelistStruct;
-
-extern Bool FreelistCheck(Freelist fl);
-extern Res FreelistInit(Freelist fl, Align alignment);
-extern void FreelistFinish(Freelist fl);
-
-extern Res FreelistInsert(Range rangeReturn, Freelist fl, Range range);
-extern Res FreelistDelete(Range rangeReturn, Freelist fl, Range range);
-extern Res FreelistDescribe(Freelist fl, mps_lib_FILE *stream);
-
-extern void FreelistIterate(Freelist abq, FreelistIterateMethod iterate,
- void *closureP, Size closureS);
-
-extern Bool FreelistFindFirst(Range rangeReturn, Range oldRangeReturn,
- Freelist fl, Size size, FindDelete findDelete);
-extern Bool FreelistFindLast(Range rangeReturn, Range oldRangeReturn,
- Freelist fl, Size size, FindDelete findDelete);
-extern Bool FreelistFindLargest(Range rangeReturn, Range oldRangeReturn,
- Freelist fl, Size size, FindDelete findDelete);
-
-extern void FreelistFlushToCBS(Freelist fl, CBS cbs);
+extern LandClass FreelistLandClassGet(void);
#endif /* freelist.h */
diff --git a/mps/code/gc.gmk b/mps/code/gc.gmk
index 826cb0ef659..76716dc0785 100644
--- a/mps/code/gc.gmk
+++ b/mps/code/gc.gmk
@@ -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
diff --git a/mps/code/gcbench.c b/mps/code/gcbench.c
index 80c68d7f711..733dc0a925b 100644
--- a/mps/code/gcbench.c
+++ b/mps/code/gcbench.c
@@ -12,6 +12,7 @@
#include "testthr.h"
#include "fmtdy.h"
#include "fmtdytst.h"
+#include "mpm.h"
#include /* fprintf, printf, putchars, sscanf, stderr, stdout */
#include /* alloca, exit, EXIT_FAILURE, EXIT_SUCCESS, strtoul */
@@ -243,6 +244,8 @@ 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);
+ printf("%u chunks\n", (unsigned)RingLength(&arena->chunkRing));
mps_pool_destroy(pool);
mps_fmt_destroy(format);
if (ngen > 0)
@@ -318,8 +321,8 @@ int main(int argc, char *argv[]) {
double mort = 0.0;
cap = (size_t)strtoul(optarg, &p, 10);
switch(toupper(*p)) {
- case 'G': cap *= 1024; /* fall through */
- case 'M': cap *= 1024; /* fall through */
+ case 'G': cap <<= 20; p++; break;
+ case 'M': cap <<= 10; p++; break;
case 'K': p++; break;
default: cap = 0; break;
}
@@ -340,9 +343,9 @@ int main(int argc, char *argv[]) {
char *p;
arenasize = (unsigned)strtoul(optarg, &p, 10);
switch(toupper(*p)) {
- case 'G': arenasize *= 1024;
- case 'M': arenasize *= 1024;
- case 'K': arenasize *= 1024; break;
+ case 'G': arenasize <<= 30; break;
+ case 'M': arenasize <<= 20; break;
+ case 'K': arenasize <<= 10; break;
case '\0': break;
default:
fprintf(stderr, "Bad arena size %s\n", optarg);
diff --git a/mps/code/global.c b/mps/code/global.c
index 22326aa391f..eca9e8671cc 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -37,10 +37,6 @@ static Bool arenaRingInit = FALSE;
static RingStruct arenaRing; /* */
static Serial arenaSerial; /* */
-/* forward declarations */
-void arenaEnterLock(Arena, int);
-void arenaLeaveLock(Arena, int);
-
/* arenaClaimRingLock, arenaReleaseRingLock -- lock/release the arena ring
*
@@ -397,25 +393,7 @@ void GlobalsFinish(Globals arenaGlobals)
Arena arena;
Rank rank;
- /* Check that the tear-down is complete: that the client has
- * destroyed all data structures associated with the arena. We do
- * this *before* calling AVERT(Globals, arenaGlobals) because the
- * AVERT will crash if there are any remaining data structures, and
- * it is politer to assert than to crash. (The crash would happen
- * because by this point in the code the control pool has been
- * destroyed and so the address space containing all these rings has
- * potentially been unmapped, and so RingCheck dereferences a
- * pointer into that unmapped memory.) See job000652. */
arena = GlobalsArena(arenaGlobals);
- AVER(RingIsSingle(&arena->formatRing));
- AVER(RingIsSingle(&arena->chainRing));
- AVER(RingIsSingle(&arena->messageRing));
- AVER(RingIsSingle(&arena->threadRing));
- for(rank = 0; rank < RankLIMIT; ++rank)
- AVER(RingIsSingle(&arena->greyRing[rank]));
- AVER(RingIsSingle(&arenaGlobals->poolRing));
- AVER(RingIsSingle(&arenaGlobals->rootRing));
-
AVERT(Globals, arenaGlobals);
STATISTIC_STAT(EVENT2(ArenaWriteFaults, arena,
@@ -445,9 +423,14 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
TraceId ti;
Trace trace;
Chain defaultChain;
+ Rank rank;
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);
@@ -499,6 +482,31 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
arena->finalPool = NULL;
PoolDestroy(pool);
}
+
+ /* Check that the tear-down is complete: that the client has
+ * destroyed all data structures associated with the arena. We do
+ * this here rather than in GlobalsFinish because by the time that
+ * is called, the control pool has been destroyed and so the address
+ * space containing all these rings has potentially been unmapped,
+ * and so RingCheck dereferences a pointer into that unmapped memory
+ * and we get a crash instead of an assertion. See job000652.
+ */
+ AVER(RingIsSingle(&arena->formatRing));
+ AVER(RingIsSingle(&arena->chainRing));
+ AVER(RingIsSingle(&arena->messageRing));
+ AVER(RingIsSingle(&arena->threadRing));
+ AVER(RingIsSingle(&arenaGlobals->rootRing));
+ for(rank = 0; rank < RankLIMIT; ++rank)
+ AVER(RingIsSingle(&arena->greyRing[rank]));
+
+ /* At this point the following pools still exist:
+ * 0. arena->freeCBSBlockPoolStruct
+ * 1. arena->reservoirStruct
+ * 2. arena->controlPoolStruct
+ * 3. arena->controlPoolStruct.blockPoolStruct
+ * 4. arena->controlPoolStruct.spanPoolStruct
+ */
+ AVER(RingLength(&arenaGlobals->poolRing) == 5);
}
@@ -512,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;
@@ -566,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;
@@ -608,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
@@ -617,6 +607,7 @@ void ArenaLeaveRecursive(Arena arena)
* version. The format is platform-specific. We won't necessarily
* publish this. */
+extern MutatorFaultContext mps_exception_info;
MutatorFaultContext mps_exception_info = NULL;
@@ -708,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;
@@ -770,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
@@ -1131,7 +1114,7 @@ void ArenaSetEmergency(Arena arena, Bool emergency)
AVERT(Arena, arena);
AVERT(Bool, emergency);
- EVENT2(ArenaSetEmergency, arena, emergency);
+ EVENT2(ArenaSetEmergency, arena, BOOLOF(emergency));
arena->emergency = emergency;
}
diff --git a/mps/code/land.c b/mps/code/land.c
new file mode 100644
index 00000000000..19f26057623
--- /dev/null
+++ b/mps/code/land.c
@@ -0,0 +1,642 @@
+/* land.c: LAND (COLLECTION OF ADDRESS RANGES) IMPLEMENTATION
+ *
+ * $Id: //info.ravenbrook.com/project/mps/branch/2014-03-30/land/code/land.c#1 $
+ * Copyright (c) 2014 Ravenbrook Limited. See end of file for license.
+ *
+ * .design:
+ */
+
+#include "mpm.h"
+#include "range.h"
+
+SRCID(land, "$Id$");
+
+
+/* FindDeleteCheck -- check method for a FindDelete value */
+
+Bool FindDeleteCheck(FindDelete findDelete)
+{
+ CHECKL(findDelete == FindDeleteNONE
+ || findDelete == FindDeleteLOW
+ || findDelete == FindDeleteHIGH
+ || findDelete == FindDeleteENTIRE);
+ UNUSED(findDelete); /* */
+
+ return TRUE;
+}
+
+
+/* landEnter, landLeave -- Avoid re-entrance
+ *
+ * .enter-leave: The visitor functions passed to LandIterate and
+ * LandIterateAndDelete are not allowed to call methods of that land.
+ * These functions enforce this.
+ *
+ * .enter-leave.simple: Some simple queries are fine to call from
+ * visitor functions. These are marked with the tag of this comment.
+ */
+
+static void landEnter(Land land)
+{
+ /* Don't need to check as always called from interface function. */
+ AVER(!land->inLand);
+ land->inLand = TRUE;
+ return;
+}
+
+static void landLeave(Land land)
+{
+ /* Don't need to check as always called from interface function. */
+ AVER(land->inLand);
+ land->inLand = FALSE;
+ return;
+}
+
+
+/* LandCheck -- check land */
+
+Bool LandCheck(Land land)
+{
+ /* .enter-leave.simple */
+ CHECKS(Land, land);
+ CHECKD(LandClass, land->class);
+ CHECKU(Arena, land->arena);
+ CHECKL(AlignCheck(land->alignment));
+ return TRUE;
+}
+
+
+/* LandInit -- initialize land
+ *
+ * See
+ */
+
+Res LandInit(Land land, LandClass class, Arena arena, Align alignment, void *owner, ArgList args)
+{
+ Res res;
+
+ AVER(land != NULL);
+ AVERT(LandClass, class);
+ AVERT(Align, alignment);
+
+ land->inLand = TRUE;
+ land->alignment = alignment;
+ land->arena = arena;
+ land->class = class;
+ land->sig = LandSig;
+
+ AVERT(Land, land);
+
+ res = (*class->init)(land, args);
+ if (res != ResOK)
+ goto failInit;
+
+ EVENT2(LandInit, land, owner);
+ landLeave(land);
+ return ResOK;
+
+ failInit:
+ land->sig = SigInvalid;
+ return res;
+}
+
+
+/* LandCreate -- allocate and initialize land
+ *
+ * See
+ */
+
+Res LandCreate(Land *landReturn, Arena arena, LandClass class, Align alignment, void *owner, ArgList args)
+{
+ Res res;
+ Land land;
+ void *p;
+
+ AVER(landReturn != NULL);
+ AVERT(Arena, arena);
+ AVERT(LandClass, class);
+
+ res = ControlAlloc(&p, arena, class->size,
+ /* withReservoirPermit */ FALSE);
+ if (res != ResOK)
+ goto failAlloc;
+ land = p;
+
+ res = LandInit(land, class, arena, alignment, owner, args);
+ if (res != ResOK)
+ goto failInit;
+
+ *landReturn = land;
+ return ResOK;
+
+failInit:
+ ControlFree(arena, land, class->size);
+failAlloc:
+ return res;
+}
+
+
+/* LandDestroy -- finish and deallocate land
+ *
+ * See
+ */
+
+void LandDestroy(Land land)
+{
+ Arena arena;
+ LandClass class;
+
+ AVERT(Land, land);
+ arena = land->arena;
+ class = land->class;
+ AVERT(LandClass, class);
+ LandFinish(land);
+ ControlFree(arena, land, class->size);
+}
+
+
+/* LandFinish -- finish land
+ *
+ * See
+ */
+
+void LandFinish(Land land)
+{
+ AVERT(Land, land);
+ landEnter(land);
+
+ (*land->class->finish)(land);
+
+ land->sig = SigInvalid;
+}
+
+
+/* LandSize -- return the total size of ranges in land
+ *
+ * See
+ */
+
+Size LandSize(Land land)
+{
+ /* .enter-leave.simple */
+ AVERT(Land, land);
+
+ return (*land->class->sizeMethod)(land);
+}
+
+
+/* LandInsert -- insert range of addresses into land
+ *
+ * See
+ */
+
+Res LandInsert(Range rangeReturn, Land land, Range range)
+{
+ Res res;
+
+ AVER(rangeReturn != NULL);
+ AVERT(Land, land);
+ AVERT(Range, range);
+ AVER(RangeIsAligned(range, land->alignment));
+ landEnter(land);
+
+ res = (*land->class->insert)(rangeReturn, land, range);
+
+ landLeave(land);
+ return res;
+}
+
+
+/* LandDelete -- delete range of addresses from land
+ *
+ * See
+ */
+
+Res LandDelete(Range rangeReturn, Land land, Range range)
+{
+ Res res;
+
+ AVER(rangeReturn != NULL);
+ AVERT(Land, land);
+ AVERT(Range, range);
+ AVER(RangeIsAligned(range, land->alignment));
+ landEnter(land);
+
+ res = (*land->class->delete)(rangeReturn, land, range);
+
+ landLeave(land);
+ return res;
+}
+
+
+/* LandIterate -- iterate over isolated ranges of addresses in land
+ *
+ * See
+ */
+
+Bool LandIterate(Land land, LandVisitor visitor, void *closureP, Size closureS)
+{
+ Bool b;
+ AVERT(Land, land);
+ AVER(FUNCHECK(visitor));
+ landEnter(land);
+
+ b = (*land->class->iterate)(land, visitor, closureP, closureS);
+
+ landLeave(land);
+ return b;
+}
+
+
+/* LandIterateAndDelete -- iterate over isolated ranges of addresses
+ * in land, deleting some of them
+ *
+ * See
+ */
+
+Bool LandIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closureP, Size closureS)
+{
+ Bool b;
+ AVERT(Land, land);
+ AVER(FUNCHECK(visitor));
+ landEnter(land);
+
+ b = (*land->class->iterateAndDelete)(land, visitor, closureP, closureS);
+
+ landLeave(land);
+ return b;
+}
+
+
+/* LandFindFirst -- find first range of given size
+ *
+ * See
+ */
+
+Bool LandFindFirst(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+{
+ Bool b;
+
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ AVER(SizeIsAligned(size, land->alignment));
+ AVER(FindDeleteCheck(findDelete));
+ landEnter(land);
+
+ b = (*land->class->findFirst)(rangeReturn, oldRangeReturn, land, size,
+ findDelete);
+
+ landLeave(land);
+ return b;
+}
+
+
+/* LandFindLast -- find last range of given size
+ *
+ * See
+ */
+
+Bool LandFindLast(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+{
+ Bool b;
+
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ AVER(SizeIsAligned(size, land->alignment));
+ AVER(FindDeleteCheck(findDelete));
+ landEnter(land);
+
+ b = (*land->class->findLast)(rangeReturn, oldRangeReturn, land, size,
+ findDelete);
+
+ landLeave(land);
+ return b;
+}
+
+
+/* LandFindLargest -- find largest range of at least given size
+ *
+ * See
+ */
+
+Bool LandFindLargest(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+{
+ Bool b;
+
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ AVER(SizeIsAligned(size, land->alignment));
+ AVER(FindDeleteCheck(findDelete));
+ landEnter(land);
+
+ b = (*land->class->findLargest)(rangeReturn, oldRangeReturn, land, size,
+ findDelete);
+
+ landLeave(land);
+ return b;
+}
+
+
+/* LandFindInSize -- find range of given size in set of zones
+ *
+ * See
+ */
+
+Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high)
+{
+ Res res;
+
+ AVER(foundReturn != NULL);
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ AVER(SizeIsAligned(size, land->alignment));
+ /* AVER(ZoneSet, zoneSet); */
+ AVERT(Bool, high);
+ landEnter(land);
+
+ res = (*land->class->findInZones)(foundReturn, rangeReturn, oldRangeReturn,
+ land, size, zoneSet, high);
+
+ landLeave(land);
+ return res;
+}
+
+
+/* LandDescribe -- describe land for debugging
+ *
+ * See
+ */
+
+Res LandDescribe(Land land, mps_lib_FILE *stream)
+{
+ Res res;
+
+ if (!TESTT(Land, land)) return ResFAIL;
+ if (stream == NULL) return ResFAIL;
+
+ res = WriteF(stream,
+ "Land $P {\n", (WriteFP)land,
+ " class $P", (WriteFP)land->class,
+ " (\"$S\")\n", land->class->name,
+ " arena $P\n", (WriteFP)land->arena,
+ " align $U\n", (WriteFU)land->alignment,
+ " inLand: $U\n", (WriteFU)land->inLand,
+ NULL);
+ if (res != ResOK)
+ return res;
+
+ res = (*land->class->describe)(land, stream);
+ if (res != ResOK)
+ return res;
+
+ res = WriteF(stream, "} Land $P\n", (WriteFP)land, NULL);
+ return ResOK;
+}
+
+
+/* landFlushVisitor -- visitor for LandFlush.
+ *
+ * closureP argument is the destination Land. Attempt to insert the
+ * range into the destination.
+ */
+static Bool landFlushVisitor(Bool *deleteReturn, Land land, Range range,
+ void *closureP, Size closureS)
+{
+ Res res;
+ RangeStruct newRange;
+ Land dest;
+
+ AVER(deleteReturn != NULL);
+ AVERT(Land, land);
+ AVERT(Range, range);
+ AVER(closureP != NULL);
+ AVER(closureS == UNUSED_SIZE);
+ UNUSED(closureS);
+
+ dest = closureP;
+ res = LandInsert(&newRange, dest, range);
+ if (res == ResOK) {
+ *deleteReturn = TRUE;
+ return TRUE;
+ } else {
+ *deleteReturn = FALSE;
+ return FALSE;
+ }
+}
+
+
+/* LandFlush -- move ranges from src to dest
+ *
+ * See
+ */
+
+Bool LandFlush(Land dest, Land src)
+{
+ AVERT(Land, dest);
+ AVERT(Land, src);
+
+ return LandIterateAndDelete(src, landFlushVisitor, dest, UNUSED_SIZE);
+}
+
+
+/* LandClassCheck -- check land class */
+
+Bool LandClassCheck(LandClass class)
+{
+ CHECKL(ProtocolClassCheck(&class->protocol));
+ CHECKL(class->name != NULL); /* Should be <=6 char C identifier */
+ CHECKL(class->size >= sizeof(LandStruct));
+ CHECKL(FUNCHECK(class->init));
+ CHECKL(FUNCHECK(class->finish));
+ CHECKL(FUNCHECK(class->insert));
+ CHECKL(FUNCHECK(class->delete));
+ CHECKL(FUNCHECK(class->findFirst));
+ CHECKL(FUNCHECK(class->findLast));
+ CHECKL(FUNCHECK(class->findLargest));
+ CHECKL(FUNCHECK(class->findInZones));
+ CHECKL(FUNCHECK(class->describe));
+ CHECKS(LandClass, class);
+ return TRUE;
+}
+
+
+static Res landTrivInit(Land land, ArgList args)
+{
+ AVERT(Land, land);
+ AVER(ArgListCheck(args));
+ UNUSED(args);
+ return ResOK;
+}
+
+static void landTrivFinish(Land land)
+{
+ AVERT(Land, land);
+ NOOP;
+}
+
+static Size landNoSize(Land land)
+{
+ UNUSED(land);
+ NOTREACHED;
+ return 0;
+}
+
+/* LandSlowSize -- generic size method but slow */
+
+static Bool landSizeVisitor(Land land, Range range,
+ void *closureP, Size closureS)
+{
+ Size *size;
+
+ AVERT(Land, land);
+ AVERT(Range, range);
+ AVER(closureP != NULL);
+ AVER(closureS == UNUSED_SIZE);
+ UNUSED(closureS);
+
+ size = closureP;
+ *size += RangeSize(range);
+
+ return TRUE;
+}
+
+Size LandSlowSize(Land land)
+{
+ Size size = 0;
+ Bool b = LandIterate(land, landSizeVisitor, &size, UNUSED_SIZE);
+ AVER(b);
+ return size;
+}
+
+static Res landNoInsert(Range rangeReturn, Land land, Range range)
+{
+ AVER(rangeReturn != NULL);
+ AVERT(Land, land);
+ AVERT(Range, range);
+ return ResUNIMPL;
+}
+
+static Res landNoDelete(Range rangeReturn, Land land, Range range)
+{
+ AVER(rangeReturn != NULL);
+ AVERT(Land, land);
+ AVERT(Range, range);
+ return ResUNIMPL;
+}
+
+static Bool landNoIterate(Land land, LandVisitor visitor, void *closureP, Size closureS)
+{
+ AVERT(Land, land);
+ AVER(visitor != NULL);
+ UNUSED(closureP);
+ UNUSED(closureS);
+ return FALSE;
+}
+
+static Bool landNoIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closureP, Size closureS)
+{
+ AVERT(Land, land);
+ AVER(visitor != NULL);
+ UNUSED(closureP);
+ UNUSED(closureS);
+ return FALSE;
+}
+
+static Bool landNoFind(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+{
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ UNUSED(size);
+ AVER(FindDeleteCheck(findDelete));
+ return ResUNIMPL;
+}
+
+static Res landNoFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high)
+{
+ AVER(foundReturn != NULL);
+ AVER(rangeReturn != NULL);
+ AVER(oldRangeReturn != NULL);
+ AVERT(Land, land);
+ UNUSED(size);
+ UNUSED(zoneSet);
+ AVER(BoolCheck(high));
+ return ResUNIMPL;
+}
+
+static Res landTrivDescribe(Land land, mps_lib_FILE *stream)
+{
+ if (!TESTT(Land, land))
+ return ResFAIL;
+ if (stream == NULL)
+ return ResFAIL;
+ /* dispatching function does it all */
+ return ResOK;
+}
+
+DEFINE_CLASS(LandClass, class)
+{
+ INHERIT_CLASS(&class->protocol, ProtocolClass);
+ class->name = "LAND";
+ class->size = sizeof(LandStruct);
+ class->init = landTrivInit;
+ class->sizeMethod = landNoSize;
+ class->finish = landTrivFinish;
+ class->insert = landNoInsert;
+ class->delete = landNoDelete;
+ class->iterate = landNoIterate;
+ class->iterateAndDelete = landNoIterateAndDelete;
+ class->findFirst = landNoFind;
+ class->findLast = landNoFind;
+ class->findLargest = landNoFind;
+ class->findInZones = landNoFindInZones;
+ class->describe = landTrivDescribe;
+ class->sig = LandClassSig;
+ AVERT(LandClass, class);
+}
+
+
+/* C. COPYRIGHT AND LICENSE
+ *
+ * Copyright (C) 2014 Ravenbrook Limited .
+ * 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.
+ */
diff --git a/mps/code/landtest.c b/mps/code/landtest.c
new file mode 100644
index 00000000000..af6beff29ac
--- /dev/null
+++ b/mps/code/landtest.c
@@ -0,0 +1,637 @@
+/* landtest.c: LAND TEST
+ *
+ * $Id$
+ * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ *
+ * The MPS contains three land implementations:
+ *
+ * 1. the CBS (Coalescing Block Structure) module maintains blocks in
+ * a splay tree for fast access with a cost in storage;
+ *
+ * 2. the Freelist module maintains blocks in an address-ordered
+ * singly linked list for zero storage overhead with a cost in
+ * performance.
+ *
+ * 3. the Failover module implements a mechanism for using CBS until
+ * it fails, then falling back to a Freelist.
+ */
+
+#include "cbs.h"
+#include "failover.h"
+#include "freelist.h"
+#include "mpm.h"
+#include "mps.h"
+#include "mpsavm.h"
+#include "mpstd.h"
+#include "poolmfs.h"
+#include "testlib.h"
+
+#include /* printf */
+
+SRCID(landtest, "$Id$");
+
+
+#define ArraySize ((Size)123456)
+
+/* CBS is much faster than Freelist, so we apply more operations to
+ * the former. */
+#define nCBSOperations ((Size)125000)
+#define nFLOperations ((Size)12500)
+#define nFOOperations ((Size)12500)
+
+static Count NAllocateTried, NAllocateSucceeded, NDeallocateTried,
+ NDeallocateSucceeded;
+
+static int verbose = 0;
+
+typedef struct TestStateStruct {
+ Align align;
+ BT allocTable;
+ Addr block;
+ Land land;
+} TestStateStruct, *TestState;
+
+typedef struct CheckTestClosureStruct {
+ TestState state;
+ Addr limit;
+ Addr oldLimit;
+} CheckTestClosureStruct, *CheckTestClosure;
+
+
+static Addr (addrOfIndex)(TestState state, Index i)
+{
+ return AddrAdd(state->block, (i * state->align));
+}
+
+
+static Index (indexOfAddr)(TestState state, Addr a)
+{
+ return (Index)(AddrOffset(state->block, a) / state->align);
+}
+
+
+static void describe(TestState state) {
+ die(LandDescribe(state->land, mps_lib_get_stdout()), "LandDescribe");
+}
+
+
+static Bool checkVisitor(Land land, Range range, void *closureP, Size closureS)
+{
+ Addr base, limit;
+ CheckTestClosure cl = closureP;
+
+ testlib_unused(land);
+ Insist(closureS == UNUSED_SIZE);
+ Insist(cl != NULL);
+
+ base = RangeBase(range);
+ limit = RangeLimit(range);
+
+ if (base > cl->oldLimit) {
+ Insist(BTIsSetRange(cl->state->allocTable,
+ indexOfAddr(cl->state, cl->oldLimit),
+ indexOfAddr(cl->state, base)));
+ } else { /* must be at start of table */
+ Insist(base == cl->oldLimit);
+ Insist(cl->oldLimit == cl->state->block);
+ }
+
+ Insist(BTIsResRange(cl->state->allocTable,
+ indexOfAddr(cl->state, base),
+ indexOfAddr(cl->state, limit)));
+
+ cl->oldLimit = limit;
+
+ return TRUE;
+}
+
+static void check(TestState state)
+{
+ CheckTestClosureStruct closure;
+ Bool b;
+
+ closure.state = state;
+ closure.limit = addrOfIndex(state, ArraySize);
+ closure.oldLimit = state->block;
+
+ b = LandIterate(state->land, checkVisitor, &closure, UNUSED_SIZE);
+ Insist(b);
+
+ if (closure.oldLimit == state->block)
+ Insist(BTIsSetRange(state->allocTable, 0,
+ indexOfAddr(state, closure.limit)));
+ else if (closure.limit > closure.oldLimit)
+ Insist(BTIsSetRange(state->allocTable,
+ indexOfAddr(state, closure.oldLimit),
+ indexOfAddr(state, closure.limit)));
+ else
+ Insist(closure.oldLimit == closure.limit);
+}
+
+
+static Word fbmRnd(Word limit)
+{
+ /* Not very uniform, but never mind. */
+ return (Word)rnd() % limit;
+}
+
+
+/* nextEdge -- Finds the next transition in the bit table
+ *
+ * Returns the index greater than such that the
+ * range [, ) has the same value in the bit table,
+ * and has a different value or does not exist.
+ */
+
+static Index nextEdge(BT bt, Size size, Index base)
+{
+ Index end;
+ Bool baseValue;
+
+ Insist(bt != NULL);
+ Insist(base < size);
+
+ baseValue = BTGet(bt, base);
+
+ for(end = base + 1; end < size && BTGet(bt, end) == baseValue; end++)
+ NOOP;
+
+ return end;
+}
+
+
+/* lastEdge -- Finds the previous transition in the bit table
+ *
+ * Returns the index less than such that the range
+ * [, ] has the same value in the bit table,
+ * and -1 has a different value or does not exist.
+ */
+
+static Index lastEdge(BT bt, Size size, Index base)
+{
+ Index end;
+ Bool baseValue;
+
+ Insist(bt != NULL);
+ Insist(base < size);
+
+ baseValue = BTGet(bt, base);
+
+ for(end = base; end > (Index)0 && BTGet(bt, end - 1) == baseValue; end--)
+ NOOP;
+
+ return end;
+}
+
+
+/* randomRange -- picks random range within table
+ *
+ * The function first picks a uniformly distributed within the table.
+ *
+ * It then scans forward a binary exponentially distributed
+ * number of "edges" in the table (that is, transitions between set and
+ * reset) to get . Note that there is a 50% chance that will
+ * be the next edge, a 25% chance it will be the edge after, etc., until
+ * the end of the table.
+ *
+ * Finally it picks a uniformly distributed in the range
+ * [base+1, limit].
+ *
+ * Hence there is a somewhat better than 50% chance that the range will be
+ * all either set or reset.
+ */
+
+static void randomRange(Addr *baseReturn, Addr *limitReturn, TestState state)
+{
+ Index base; /* the start of our range */
+ Index end; /* an edge (i.e. different from its predecessor) */
+ /* after base */
+ Index limit; /* a randomly chosen value in (base, limit]. */
+
+ base = fbmRnd(ArraySize);
+
+ do {
+ end = nextEdge(state->allocTable, ArraySize, base);
+ } while(end < ArraySize && fbmRnd(2) == 0); /* p=0.5 exponential */
+
+ Insist(end > base);
+
+ limit = base + 1 + fbmRnd(end - base);
+
+ *baseReturn = addrOfIndex(state, base);
+ *limitReturn = addrOfIndex(state, limit);
+}
+
+
+static void allocate(TestState state, Addr base, Addr limit)
+{
+ Res res;
+ Index ib, il; /* Indexed for base and limit */
+ Bool isFree;
+ RangeStruct range, oldRange;
+ Addr outerBase, outerLimit; /* interval containing [ib, il) */
+
+ ib = indexOfAddr(state, base);
+ il = indexOfAddr(state, limit);
+
+ isFree = BTIsResRange(state->allocTable, ib, il);
+
+ NAllocateTried++;
+
+ if (isFree) {
+ Size left, right, total; /* Sizes of block and two fragments */
+
+ outerBase =
+ addrOfIndex(state, lastEdge(state->allocTable, ArraySize, ib));
+ outerLimit =
+ addrOfIndex(state, nextEdge(state->allocTable, ArraySize, il - 1));
+
+ left = AddrOffset(outerBase, base);
+ right = AddrOffset(limit, outerLimit);
+ total = AddrOffset(outerBase, outerLimit);
+
+ /* TODO: check these values */
+ testlib_unused(left);
+ testlib_unused(right);
+ testlib_unused(total);
+ } else {
+ outerBase = outerLimit = NULL;
+ }
+
+ RangeInit(&range, base, limit);
+ res = LandDelete(&oldRange, state->land, &range);
+
+ if (verbose) {
+ printf("allocate: [%p,%p) -- %s\n",
+ (void *)base, (void *)limit, isFree ? "succeed" : "fail");
+ describe(state);
+ }
+
+ if (!isFree) {
+ die_expect((mps_res_t)res, MPS_RES_FAIL,
+ "Succeeded in deleting allocated block");
+ } else { /* isFree */
+ die_expect((mps_res_t)res, MPS_RES_OK,
+ "failed to delete free block");
+ Insist(RangeBase(&oldRange) == outerBase);
+ Insist(RangeLimit(&oldRange) == outerLimit);
+ NAllocateSucceeded++;
+ BTSetRange(state->allocTable, ib, il);
+ }
+}
+
+
+static void deallocate(TestState state, Addr base, Addr limit)
+{
+ Res res;
+ Index ib, il;
+ Bool isAllocated;
+ Addr outerBase = base, outerLimit = limit; /* interval containing [ib, il) */
+ RangeStruct range, freeRange; /* interval returned by the manager */
+
+ ib = indexOfAddr(state, base);
+ il = indexOfAddr(state, limit);
+
+ isAllocated = BTIsSetRange(state->allocTable, ib, il);
+
+ NDeallocateTried++;
+
+ if (isAllocated) {
+ Size left, right, total; /* Sizes of block and two fragments */
+
+ /* Find the free blocks adjacent to the allocated block */
+ if (ib > 0 && !BTGet(state->allocTable, ib - 1)) {
+ outerBase =
+ addrOfIndex(state, lastEdge(state->allocTable, ArraySize, ib - 1));
+ } else {
+ outerBase = base;
+ }
+
+ if (il < ArraySize && !BTGet(state->allocTable, il)) {
+ outerLimit =
+ addrOfIndex(state, nextEdge(state->allocTable, ArraySize, il));
+ } else {
+ outerLimit = limit;
+ }
+
+ left = AddrOffset(outerBase, base);
+ right = AddrOffset(limit, outerLimit);
+ total = AddrOffset(outerBase, outerLimit);
+
+ /* TODO: check these values */
+ testlib_unused(left);
+ testlib_unused(right);
+ testlib_unused(total);
+ }
+
+ RangeInit(&range, base, limit);
+ res = LandInsert(&freeRange, state->land, &range);
+
+ if (verbose) {
+ printf("deallocate: [%p,%p) -- %s\n",
+ (void *)base, (void *)limit, isAllocated ? "succeed" : "fail");
+ describe(state);
+ }
+
+ if (!isAllocated) {
+ die_expect((mps_res_t)res, MPS_RES_FAIL,
+ "succeeded in inserting non-allocated block");
+ } else { /* isAllocated */
+ die_expect((mps_res_t)res, MPS_RES_OK,
+ "failed to insert allocated block");
+
+ NDeallocateSucceeded++;
+ BTResRange(state->allocTable, ib, il);
+ Insist(RangeBase(&freeRange) == outerBase);
+ Insist(RangeLimit(&freeRange) == outerLimit);
+ }
+}
+
+
+static void find(TestState state, Size size, Bool high, FindDelete findDelete)
+{
+ Bool expected, found;
+ Index expectedBase, expectedLimit;
+ RangeStruct foundRange, oldRange;
+ Addr remainderBase, remainderLimit;
+ Addr origBase, origLimit;
+ Size oldSize, newSize;
+
+ origBase = origLimit = NULL;
+ expected = (high ? BTFindLongResRangeHigh : BTFindLongResRange)
+ (&expectedBase, &expectedLimit, state->allocTable,
+ (Index)0, (Index)ArraySize, (Count)size);
+
+ if (expected) {
+ oldSize = (expectedLimit - expectedBase) * state->align;
+ remainderBase = origBase = addrOfIndex(state, expectedBase);
+ remainderLimit = origLimit = addrOfIndex(state, expectedLimit);
+
+ switch(findDelete) {
+ case FindDeleteNONE:
+ /* do nothing */
+ break;
+ case FindDeleteENTIRE:
+ remainderBase = remainderLimit;
+ break;
+ case FindDeleteLOW:
+ expectedLimit = expectedBase + size;
+ remainderBase = addrOfIndex(state, expectedLimit);
+ break;
+ case FindDeleteHIGH:
+ expectedBase = expectedLimit - size;
+ remainderLimit = addrOfIndex(state, expectedBase);
+ break;
+ default:
+ cdie(0, "invalid findDelete");
+ break;
+ }
+
+ if (findDelete != FindDeleteNONE) {
+ newSize = AddrOffset(remainderBase, remainderLimit);
+ }
+
+ /* TODO: check these values */
+ testlib_unused(oldSize);
+ testlib_unused(newSize);
+ }
+
+ found = (high ? LandFindLast : LandFindFirst)
+ (&foundRange, &oldRange, state->land, size * state->align, findDelete);
+
+ if (verbose) {
+ printf("find %s %lu: ", high ? "last" : "first",
+ (unsigned long)(size * state->align));
+ if (expected) {
+ printf("expecting [%p,%p)\n",
+ (void *)addrOfIndex(state, expectedBase),
+ (void *)addrOfIndex(state, expectedLimit));
+ } else {
+ printf("expecting this not to be found\n");
+ }
+ if (found) {
+ printf(" found [%p,%p)\n", (void *)RangeBase(&foundRange),
+ (void *)RangeLimit(&foundRange));
+ } else {
+ printf(" not found\n");
+ }
+ }
+
+ Insist(found == expected);
+
+ if (found) {
+ Insist(expectedBase == indexOfAddr(state, RangeBase(&foundRange)));
+ Insist(expectedLimit == indexOfAddr(state, RangeLimit(&foundRange)));
+
+ if (findDelete != FindDeleteNONE) {
+ Insist(RangeBase(&oldRange) == origBase);
+ Insist(RangeLimit(&oldRange) == origLimit);
+ BTSetRange(state->allocTable, expectedBase, expectedLimit);
+ }
+ }
+
+ return;
+}
+
+static void test(TestState state, unsigned n) {
+ Addr base, limit;
+ unsigned i;
+ Size size;
+ Bool high;
+ FindDelete findDelete = FindDeleteNONE;
+
+ BTSetRange(state->allocTable, 0, ArraySize); /* Initially all allocated */
+ check(state);
+ for(i = 0; i < n; i++) {
+ switch(fbmRnd(3)) {
+ case 0:
+ randomRange(&base, &limit, state);
+ allocate(state, base, limit);
+ break;
+ case 1:
+ randomRange(&base, &limit, state);
+ deallocate(state, base, limit);
+ break;
+ case 2:
+ size = fbmRnd(ArraySize / 10) + 1;
+ high = fbmRnd(2) ? TRUE : FALSE;
+ switch(fbmRnd(6)) {
+ default: findDelete = FindDeleteNONE; break;
+ case 3: findDelete = FindDeleteLOW; break;
+ case 4: findDelete = FindDeleteHIGH; break;
+ case 5: findDelete = FindDeleteENTIRE; break;
+ }
+ find(state, size, high, findDelete);
+ break;
+ default:
+ cdie(0, "invalid rnd(3)");
+ return;
+ }
+ if ((i + 1) % 1000 == 0)
+ check(state);
+ }
+}
+
+#define testArenaSIZE (((size_t)4)<<20)
+
+extern int main(int argc, char *argv[])
+{
+ mps_arena_t mpsArena;
+ Arena arena;
+ TestStateStruct state;
+ void *p;
+ Addr dummyBlock;
+ BT allocTable;
+ MFSStruct blockPool;
+ CBSStruct cbsStruct;
+ FreelistStruct flStruct;
+ FailoverStruct foStruct;
+ Land cbs = &cbsStruct.landStruct;
+ Land fl = &flStruct.landStruct;
+ Land fo = &foStruct.landStruct;
+ Pool mfs = &blockPool.poolStruct;
+ Align align;
+ int i;
+
+ testlib_init(argc, argv);
+ align = (1 << rnd() % 4) * MPS_PF_ALIGN;
+
+ NAllocateTried = NAllocateSucceeded = NDeallocateTried =
+ NDeallocateSucceeded = 0;
+
+ die(mps_arena_create(&mpsArena, mps_arena_class_vm(), testArenaSIZE),
+ "mps_arena_create");
+ arena = (Arena)mpsArena; /* avoid pun */
+
+ die((mps_res_t)BTCreate(&allocTable, arena, ArraySize),
+ "failed to create alloc table");
+
+ /* We're not going to use this block, but I feel unhappy just */
+ /* inventing addresses. */
+ die((mps_res_t)ControlAlloc(&p, arena, ArraySize * align,
+ /* withReservoirPermit */ FALSE),
+ "failed to allocate block");
+ dummyBlock = p; /* avoid pun */
+
+ if (verbose) {
+ printf("Allocated block [%p,%p)\n", (void*)dummyBlock,
+ (char *)dummyBlock + ArraySize);
+ }
+
+ /* 1. Test CBS */
+
+ MPS_ARGS_BEGIN(args) {
+ die((mps_res_t)LandInit(cbs, CBSFastLandClassGet(), arena, align, NULL, args),
+ "failed to initialise CBS");
+ } MPS_ARGS_END(args);
+ state.align = align;
+ state.block = dummyBlock;
+ state.allocTable = allocTable;
+ state.land = cbs;
+ test(&state, nCBSOperations);
+ LandFinish(cbs);
+
+ /* 2. Test Freelist */
+
+ die((mps_res_t)LandInit(fl, FreelistLandClassGet(), arena, align, NULL,
+ mps_args_none),
+ "failed to initialise Freelist");
+ state.land = fl;
+ test(&state, nFLOperations);
+ LandFinish(fl);
+
+ /* 3. Test CBS-failing-over-to-Freelist (always failing over on
+ * first iteration, never failing over on second; see fotest.c for a
+ * test case that randomly switches fail-over on and off)
+ */
+
+ for (i = 0; i < 2; ++i) {
+ MPS_ARGS_BEGIN(piArgs) {
+ MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSFastBlockStruct));
+ MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, ArenaAlign(arena));
+ MPS_ARGS_ADD(piArgs, MFSExtendSelf, i);
+ MPS_ARGS_DONE(piArgs);
+ die(PoolInit(mfs, arena, PoolClassMFS(), piArgs), "PoolInit");
+ } MPS_ARGS_END(piArgs);
+
+ MPS_ARGS_BEGIN(args) {
+ MPS_ARGS_ADD(args, CBSBlockPool, mfs);
+ die((mps_res_t)LandInit(cbs, CBSFastLandClassGet(), arena, align, NULL,
+ args),
+ "failed to initialise CBS");
+ } MPS_ARGS_END(args);
+
+ die((mps_res_t)LandInit(fl, FreelistLandClassGet(), arena, align, NULL,
+ mps_args_none),
+ "failed to initialise Freelist");
+ MPS_ARGS_BEGIN(args) {
+ MPS_ARGS_ADD(args, FailoverPrimary, cbs);
+ MPS_ARGS_ADD(args, FailoverSecondary, fl);
+ die((mps_res_t)LandInit(fo, FailoverLandClassGet(), arena, align, NULL,
+ args),
+ "failed to initialise Failover");
+ } MPS_ARGS_END(args);
+
+ state.land = fo;
+ test(&state, nFOOperations);
+ LandFinish(fo);
+ LandFinish(fl);
+ LandFinish(cbs);
+ PoolFinish(mfs);
+ }
+
+ mps_arena_destroy(arena);
+
+ printf("\nNumber of allocations attempted: %"PRIuLONGEST"\n",
+ (ulongest_t)NAllocateTried);
+ printf("Number of allocations succeeded: %"PRIuLONGEST"\n",
+ (ulongest_t)NAllocateSucceeded);
+ printf("Number of deallocations attempted: %"PRIuLONGEST"\n",
+ (ulongest_t)NDeallocateTried);
+ printf("Number of deallocations succeeded: %"PRIuLONGEST"\n",
+ (ulongest_t)NDeallocateSucceeded);
+ printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
+ return 0;
+}
+
+
+/* C. COPYRIGHT AND LICENSE
+ *
+ * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * 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.
+ */
diff --git a/mps/code/ll.gmk b/mps/code/ll.gmk
index dc2595c511f..787380fb3ed 100644
--- a/mps/code/ll.gmk
+++ b/mps/code/ll.gmk
@@ -10,17 +10,20 @@
# common makefile fragment () requires.
CC = clang
-CFLAGSDEBUG = -O -g3
+CFLAGSDEBUG = -O0 -g3
CFLAGSOPT = -O2 -g3
CFLAGSCOMPILER := \
-pedantic \
-Waggregate-return \
-Wall \
-Wcast-qual \
+ -Wconversion \
+ -Wduplicate-enum \
-Werror \
-Wextra \
-Winline \
-Wmissing-prototypes \
+ -Wmissing-variable-declarations \
-Wnested-externs \
-Wno-extended-offsetof \
-Wpointer-arith \
@@ -43,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
diff --git a/mps/code/lock.h b/mps/code/lock.h
index 1431bbacd85..4fcd591a0f2 100644
--- a/mps/code/lock.h
+++ b/mps/code/lock.h
@@ -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 */
diff --git a/mps/code/lockcov.c b/mps/code/lockcov.c
index a7289dca9ce..75ded6f202a 100644
--- a/mps/code/lockcov.c
+++ b/mps/code/lockcov.c
@@ -4,21 +4,37 @@
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*/
+#include "mps.h"
+#include "mpsavm.h"
+#include "mpscmfs.h"
#include "mpm.h"
#include "testlib.h"
#include "mpslib.h"
#include /* printf */
-#include /* free, malloc */
int main(int argc, char *argv[])
{
- Lock a = malloc(LockSize());
- Lock b = malloc(LockSize());
+ mps_arena_t arena;
+ mps_pool_t pool;
+ mps_addr_t p;
+ Lock a, b;
testlib_init(argc, argv);
+ die(mps_arena_create_k(&arena, mps_arena_class_vm(), mps_args_none),
+ "arena_create");
+ MPS_ARGS_BEGIN(args) {
+ MPS_ARGS_ADD(args, MPS_KEY_MFS_UNIT_SIZE, LockSize());
+ die(mps_pool_create_k(&pool, arena, mps_class_mfs(), args), "pool_create");
+ } MPS_ARGS_END(args);
+
+ die(mps_alloc(&p, pool, LockSize()), "alloc a");
+ a = p;
+ die(mps_alloc(&p, pool, LockSize()), "alloc b");
+ b = p;
+
Insist(a != NULL);
Insist(b != NULL);
@@ -46,8 +62,11 @@ int main(int argc, char *argv[])
LockReleaseMPM(a);
LockFinish(a);
LockReleaseGlobalRecursive();
- free(a);
- free(b);
+
+ mps_free(pool, a, LockSize());
+ mps_free(pool, b, LockSize());
+ mps_pool_destroy(pool);
+ mps_arena_destroy(arena);
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
return 0;
diff --git a/mps/code/lockix.c b/mps/code/lockix.c
index c32361e8560..2afd294246e 100644
--- a/mps/code/lockix.c
+++ b/mps/code/lockix.c
@@ -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);
}
diff --git a/mps/code/lockli.c b/mps/code/lockli.c
index 06437b5b531..89e8f4f0653 100644
--- a/mps/code/lockli.c
+++ b/mps/code/lockli.c
@@ -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);
}
diff --git a/mps/code/lockut.c b/mps/code/lockut.c
index ec22369bc13..e93bdea6815 100644
--- a/mps/code/lockut.c
+++ b/mps/code/lockut.c
@@ -4,18 +4,20 @@
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*/
+#include "mps.h"
+#include "mpsavm.h"
+#include "mpscmfs.h"
#include "mpm.h"
#include "testlib.h"
#include "testthr.h"
#include /* printf */
-#include /* malloc */
#define nTHREADS 4
static Lock lock;
-unsigned long shared, tmp;
+static unsigned long shared, tmp;
static void incR(unsigned long i)
@@ -63,12 +65,23 @@ static void *thread0(void *p)
int main(int argc, char *argv[])
{
+ mps_arena_t arena;
+ mps_pool_t pool;
+ mps_addr_t p;
testthr_t t[10];
unsigned i;
testlib_init(argc, argv);
- lock = malloc(LockSize());
+ die(mps_arena_create_k(&arena, mps_arena_class_vm(), mps_args_none),
+ "arena_create");
+ MPS_ARGS_BEGIN(args) {
+ MPS_ARGS_ADD(args, MPS_KEY_MFS_UNIT_SIZE, LockSize());
+ die(mps_pool_create_k(&pool, arena, mps_class_mfs(), args), "pool_create");
+ } MPS_ARGS_END(args);
+
+ die(mps_alloc(&p, pool, LockSize()), "alloc");
+ lock = p;
Insist(lock != NULL);
LockInit(lock);
@@ -86,6 +99,10 @@ int main(int argc, char *argv[])
LockFinish(lock);
+ mps_free(pool, lock, LockSize());
+ mps_pool_destroy(pool);
+ mps_arena_destroy(arena);
+
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
return 0;
}
diff --git a/mps/code/lockw3.c b/mps/code/lockw3.c
index 258b31bff44..2fdc2800032 100644
--- a/mps/code/lockw3.c
+++ b/mps/code/lockw3.c
@@ -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);
diff --git a/mps/code/locus.c b/mps/code/locus.c
index a704c8b820b..537eea666e8 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -6,7 +6,8 @@
* DESIGN
*
* See and for basic locus stuff.
- * See for chains.
+ * See for chains. See for the
+ * collection strategy.
*/
#include "chain.h"
@@ -80,6 +81,7 @@ void SegPrefExpress(SegPref pref, SegPrefKind kind, void *p)
/* GenDescCheck -- check a GenDesc */
+ATTRIBUTE_UNUSED
static Bool GenDescCheck(GenDesc gen)
{
CHECKS(GenDesc, gen);
@@ -87,8 +89,6 @@ static Bool GenDescCheck(GenDesc gen)
/* nothing to check for capacity */
CHECKL(gen->mortality >= 0.0);
CHECKL(gen->mortality <= 1.0);
- CHECKL(gen->proflow >= 0.0);
- CHECKL(gen->proflow <= 1.0);
CHECKD_NOSIG(Ring, &gen->locusRing);
return TRUE;
}
@@ -156,9 +156,9 @@ Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount,
gens[i].zones = ZoneSetEMPTY;
gens[i].capacity = params[i].capacity;
gens[i].mortality = params[i].mortality;
- gens[i].proflow = 1.0; /* @@@@ temporary */
RingInit(&gens[i].locusRing);
gens[i].sig = GenDescSig;
+ AVERT(GenDesc, &gens[i]);
}
res = ControlAlloc(&p, arena, sizeof(ChainStruct), FALSE);
@@ -211,8 +211,10 @@ void ChainDestroy(Chain chain)
size_t i;
AVERT(Chain, chain);
+ AVER(chain->activeTraces == TraceSetEMPTY);
- arena = chain->arena; genCount = chain->genCount;
+ arena = chain->arena;
+ genCount = chain->genCount;
RingRemove(&chain->chainRing);
chain->sig = SigInvalid;
for (i = 0; i < genCount; ++i) {
@@ -234,66 +236,94 @@ size_t ChainGens(Chain chain)
}
-/* ChainAlloc -- allocate tracts in a generation */
+/* ChainGen -- return a generation in a chain, or the arena top generation */
-Res ChainAlloc(Seg *segReturn, Chain chain, Serial genNr, SegClass class,
- Size size, Pool pool, Bool withReservoirPermit,
- ArgList args)
+GenDesc ChainGen(Chain chain, Index gen)
+{
+ AVERT(Chain, chain);
+ AVER(gen <= chain->genCount);
+
+ if (gen < chain->genCount)
+ return &chain->gens[gen];
+ else
+ return &chain->arena->topGen;
+}
+
+
+/* PoolGenAlloc -- allocate a segment in a pool generation and update
+ * accounting
+ */
+
+Res PoolGenAlloc(Seg *segReturn, PoolGen pgen, SegClass class, Size size,
+ Bool withReservoirPermit, ArgList args)
{
SegPrefStruct pref;
Res res;
Seg seg;
ZoneSet zones, moreZones;
Arena arena;
+ GenDesc gen;
- AVERT(Chain, chain);
- AVER(genNr <= chain->genCount);
+ AVER(segReturn != NULL);
+ AVERT(PoolGen, pgen);
+ AVERT(SegClass, class);
+ AVER(size > 0);
+ AVERT(Bool, withReservoirPermit);
+ AVERT(ArgList, args);
- arena = chain->arena;
- if (genNr < chain->genCount)
- zones = chain->gens[genNr].zones;
- else
- zones = arena->topGen.zones;
+ arena = PoolArena(pgen->pool);
+ gen = pgen->gen;
+ zones = gen->zones;
SegPrefInit(&pref);
pref.high = FALSE;
pref.zones = zones;
pref.avoid = ZoneSetBlacklist(arena);
- res = SegAlloc(&seg, class, &pref, size, pool, withReservoirPermit, args);
+ res = SegAlloc(&seg, class, &pref, size, pgen->pool, withReservoirPermit,
+ args);
if (res != ResOK)
return res;
moreZones = ZoneSetUnion(zones, ZoneSetOfSeg(arena, seg));
+ gen->zones = moreZones;
if (!ZoneSetSuper(zones, moreZones)) {
- /* Tracking the whole zoneset for each generation number gives
- * more understandable telemetry than just reporting the added
+ /* Tracking the whole zoneset for each generation gives more
+ * understandable telemetry than just reporting the added
* zones. */
- EVENT3(ArenaGenZoneAdd, arena, genNr, moreZones);
+ EVENT3(ArenaGenZoneAdd, arena, gen, moreZones);
}
- if (genNr < chain->genCount)
- chain->gens[genNr].zones = moreZones;
- else
- chain->arena->topGen.zones = moreZones;
-
+ size = SegSize(seg);
+ pgen->totalSize += size;
+ STATISTIC_STAT ({
+ ++ pgen->segs;
+ pgen->freeSize += size;
+ });
*segReturn = seg;
return ResOK;
}
-
/* ChainDeferral -- time until next ephemeral GC for this chain */
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 +336,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 +344,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 +390,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)
@@ -413,57 +414,257 @@ void ChainEndGC(Chain chain, Trace trace)
/* PoolGenInit -- initialize a PoolGen */
-Res PoolGenInit(PoolGen gen, Chain chain, Serial nr, Pool pool)
+Res PoolGenInit(PoolGen pgen, GenDesc gen, Pool pool)
{
- /* Can't check gen, because it's not been initialized. */
- AVERT(Chain, chain);
- AVER(nr <= chain->genCount);
+ /* Can't check pgen, because it's not been initialized. */
+ AVER(pgen != NULL);
+ AVERT(GenDesc, gen);
AVERT(Pool, pool);
+ AVER(PoolHasAttr(pool, AttrGC));
- gen->nr = nr;
- gen->pool = pool;
- gen->chain = chain;
- RingInit(&gen->genRing);
- gen->totalSize = (Size)0;
- gen->newSize = (Size)0;
- gen->sig = PoolGenSig;
+ pgen->pool = pool;
+ pgen->gen = gen;
+ RingInit(&pgen->genRing);
+ STATISTIC(pgen->segs = 0);
+ pgen->totalSize = 0;
+ STATISTIC(pgen->freeSize = 0);
+ pgen->newSize = 0;
+ STATISTIC(pgen->oldSize = 0);
+ pgen->newDeferredSize = 0;
+ STATISTIC(pgen->oldDeferredSize = 0);
+ pgen->sig = PoolGenSig;
+ AVERT(PoolGen, pgen);
- if(nr != chain->genCount) {
- RingAppend(&chain->gens[nr].locusRing, &gen->genRing);
- } else {
- /* Dynamic generation is linked to the arena, not the chain. */
- RingAppend(&chain->arena->topGen.locusRing, &gen->genRing);
- }
- AVERT(PoolGen, gen);
+ RingAppend(&gen->locusRing, &pgen->genRing);
return ResOK;
}
/* PoolGenFinish -- finish a PoolGen */
-void PoolGenFinish(PoolGen gen)
+void PoolGenFinish(PoolGen pgen)
{
- AVERT(PoolGen, gen);
+ AVERT(PoolGen, pgen);
+ AVER(pgen->totalSize == 0);
+ AVER(pgen->newSize == 0);
+ AVER(pgen->newDeferredSize == 0);
+ STATISTIC_STAT ({
+ AVER(pgen->segs == 0);
+ AVER(pgen->freeSize == 0);
+ AVER(pgen->oldSize == 0);
+ AVER(pgen->oldDeferredSize == 0);
+ });
- gen->sig = SigInvalid;
- RingRemove(&gen->genRing);
+ pgen->sig = SigInvalid;
+ RingRemove(&pgen->genRing);
}
/* PoolGenCheck -- check a PoolGen */
-Bool PoolGenCheck(PoolGen gen)
+Bool PoolGenCheck(PoolGen pgen)
{
- CHECKS(PoolGen, gen);
+ CHECKS(PoolGen, pgen);
/* nothing to check about serial */
- CHECKU(Pool, gen->pool);
- CHECKU(Chain, gen->chain);
- CHECKD_NOSIG(Ring, &gen->genRing);
- CHECKL(gen->newSize <= gen->totalSize);
+ CHECKU(Pool, pgen->pool);
+ CHECKU(GenDesc, pgen->gen);
+ CHECKD_NOSIG(Ring, &pgen->genRing);
+ STATISTIC_STAT ({
+ CHECKL((pgen->totalSize == 0) == (pgen->segs == 0));
+ CHECKL(pgen->totalSize >= pgen->segs * ArenaAlign(PoolArena(pgen->pool)));
+ CHECKL(pgen->totalSize == pgen->freeSize + pgen->newSize + pgen->oldSize
+ + pgen->newDeferredSize + pgen->oldDeferredSize);
+ });
return TRUE;
}
+/* PoolGenAccountForFill -- accounting for allocation
+ *
+ * Call this when the pool allocates memory to the client program via
+ * BufferFill. The deferred flag indicates whether the accounting of
+ * this memory (for the purpose of scheduling collections) should be
+ * deferred until later.
+ *
+ * See
+ */
+
+void PoolGenAccountForFill(PoolGen pgen, Size size, Bool deferred)
+{
+ AVERT(PoolGen, pgen);
+ AVERT(Bool, deferred);
+
+ STATISTIC_STAT ({
+ AVER(pgen->freeSize >= size);
+ pgen->freeSize -= size;
+ });
+ if (deferred)
+ pgen->newDeferredSize += size;
+ else
+ pgen->newSize += size;
+}
+
+
+/* PoolGenAccountForEmpty -- accounting for emptying a buffer
+ *
+ * Call this when the client program returns memory (that was never
+ * condemned) to the pool via BufferEmpty. The deferred flag is as for
+ * PoolGenAccountForFill.
+ *
+ * See
+ */
+
+void PoolGenAccountForEmpty(PoolGen pgen, Size unused, Bool deferred)
+{
+ AVERT(PoolGen, pgen);
+ AVERT(Bool, deferred);
+
+ if (deferred) {
+ AVER(pgen->newDeferredSize >= unused);
+ pgen->newDeferredSize -= unused;
+ } else {
+ AVER(pgen->newSize >= unused);
+ pgen->newSize -= unused;
+ }
+ STATISTIC(pgen->freeSize += unused);
+}
+
+
+/* PoolGenAccountForAge -- accounting for condemning
+ *
+ * Call this when memory is condemned via PoolWhiten. The size
+ * parameter should be the amount of memory that is being condemned
+ * for the first time. The deferred flag is as for PoolGenAccountForFill.
+ *
+ * See
+ */
+
+void PoolGenAccountForAge(PoolGen pgen, Size size, Bool deferred)
+{
+ AVERT(PoolGen, pgen);
+
+ if (deferred) {
+ AVER(pgen->newDeferredSize >= size);
+ pgen->newDeferredSize -= size;
+ STATISTIC(pgen->oldDeferredSize += size);
+ } else {
+ AVER(pgen->newSize >= size);
+ pgen->newSize -= size;
+ STATISTIC(pgen->oldSize += size);
+ }
+}
+
+
+/* PoolGenAccountForReclaim -- accounting for reclaiming
+ *
+ * Call this when reclaiming memory, passing the amount of memory that
+ * was reclaimed. The deferred flag is as for PoolGenAccountForFill.
+ *
+ * See
+ */
+
+void PoolGenAccountForReclaim(PoolGen pgen, Size reclaimed, Bool deferred)
+{
+ AVERT(PoolGen, pgen);
+ AVERT(Bool, deferred);
+
+ STATISTIC_STAT ({
+ if (deferred) {
+ AVER(pgen->oldDeferredSize >= reclaimed);
+ pgen->oldDeferredSize -= reclaimed;
+ } else {
+ AVER(pgen->oldSize >= reclaimed);
+ pgen->oldSize -= reclaimed;
+ }
+ pgen->freeSize += reclaimed;
+ });
+}
+
+
+/* PoolGenUndefer -- finish deferring accounting
+ *
+ * Call this when exiting ramp mode, passing the amount of old
+ * (condemned at least once) and new (never condemned) memory whose
+ * accounting was deferred (for example, during a ramp).
+ *
+ * See
+ */
+
+void PoolGenUndefer(PoolGen pgen, Size oldSize, Size newSize)
+{
+ AVERT(PoolGen, pgen);
+ STATISTIC_STAT ({
+ AVER(pgen->oldDeferredSize >= oldSize);
+ pgen->oldDeferredSize -= oldSize;
+ pgen->oldSize += oldSize;
+ });
+ AVER(pgen->newDeferredSize >= newSize);
+ pgen->newDeferredSize -= newSize;
+ pgen->newSize += newSize;
+}
+
+
+/* PoolGenAccountForSegSplit -- accounting for splitting a segment */
+
+void PoolGenAccountForSegSplit(PoolGen pgen)
+{
+ AVERT(PoolGen, pgen);
+ STATISTIC_STAT ({
+ AVER(pgen->segs >= 1); /* must be at least one segment to split */
+ ++ pgen->segs;
+ });
+}
+
+
+/* PoolGenAccountForSegMerge -- accounting for merging a segment */
+
+void PoolGenAccountForSegMerge(PoolGen pgen)
+{
+ AVERT(PoolGen, pgen);
+ STATISTIC_STAT ({
+ AVER(pgen->segs >= 2); /* must be at least two segments to merge */
+ -- pgen->segs;
+ });
+}
+
+
+/* PoolGenFree -- free a segment and update accounting
+ *
+ * Pass the amount of memory in the segment that is accounted as free,
+ * old, or new, respectively. The deferred flag is as for
+ * PoolGenAccountForFill.
+ *
+ * See
+ */
+
+void PoolGenFree(PoolGen pgen, Seg seg, Size freeSize, Size oldSize,
+ Size newSize, Bool deferred)
+{
+ Size size;
+
+ AVERT(PoolGen, pgen);
+ AVERT(Seg, seg);
+
+ size = SegSize(seg);
+ AVER(freeSize + oldSize + newSize == size);
+
+ /* Pretend to age and reclaim the contents of the segment to ensure
+ * that the entire segment is accounted as free. */
+ PoolGenAccountForAge(pgen, newSize, deferred);
+ PoolGenAccountForReclaim(pgen, oldSize + newSize, deferred);
+
+ AVER(pgen->totalSize >= size);
+ pgen->totalSize -= size;
+ STATISTIC_STAT ({
+ AVER(pgen->segs > 0);
+ -- pgen->segs;
+ AVER(pgen->freeSize >= size);
+ pgen->freeSize -= size;
+ });
+ SegFree(seg);
+}
+
+
/* LocusInit -- initialize the locus module */
void LocusInit(Arena arena)
@@ -477,9 +678,9 @@ void LocusInit(Arena arena)
gen->zones = ZoneSetEMPTY;
gen->capacity = 0; /* unused */
gen->mortality = 0.51;
- gen->proflow = 0.0;
RingInit(&gen->locusRing);
gen->sig = GenDescSig;
+ AVERT(GenDesc, gen);
}
diff --git a/mps/code/meter.h b/mps/code/meter.h
index 7a7f8266e87..f1731400e42 100644
--- a/mps/code/meter.h
+++ b/mps/code/meter.h
@@ -1,7 +1,7 @@
/* meter.h: METER 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.
*
* .sources: mps.design.metrics.
*
@@ -45,9 +45,12 @@ extern void MeterEmit(Meter meter);
#define METER_ACC(meter, delta) \
STATISTIC(MeterAccumulate(&(meter), delta))
#if defined(STATISTICS)
-#define METER_WRITE(meter, stream) MeterWrite(&(meter), stream)
+#define METER_WRITE(meter, stream) BEGIN \
+ Res _res = MeterWrite(&(meter), (stream)); \
+ if (_res != ResOK) return _res; \
+ END
#elif defined(STATISTICS_NONE)
-#define METER_WRITE(meter, stream) (ResOK)
+#define METER_WRITE(meter, stream) NOOP
#else
#error "No statistics configured."
#endif
@@ -59,7 +62,7 @@ extern void MeterEmit(Meter meter);
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2013 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/misc.h b/mps/code/misc.h
index 6ba4be5f49d..3d0f259ff72 100644
--- a/mps/code/misc.h
+++ b/mps/code/misc.h
@@ -1,7 +1,7 @@
/* misc.h: MISCELLANEOUS DEFINITIONS
*
* $Id$
- * Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2001 Global Graphics Software.
*
* Small general things which are useful for C but aren't part of the
@@ -13,8 +13,6 @@
#ifndef misc_h
#define misc_h
-#include
-
typedef int Bool; /* */
enum BoolEnum {
@@ -50,6 +48,7 @@ typedef const struct SrcIdStruct {
#define SRCID(id, scmid) \
static SrcIdStruct id ## FileSrcIdStruct = \
{__FILE__, (scmid), __DATE__, __TIME__}; \
+ extern SrcId id ## SrcId; \
SrcId id ## SrcId = &id ## FileSrcIdStruct
@@ -153,6 +152,19 @@ typedef const struct SrcIdStruct {
#define UNUSED(param) ((void)param)
+/* UNUSED_POINTER, UNUSED_SIZE -- values for unused arguments
+ *
+ * Use these values for unused pointer, size closure arguments and
+ * check them in the callback or visitor.
+ *
+ * We use PointerAdd rather than a cast to avoid "warning C4306: 'type
+ * cast' : conversion from 'unsigned int' to 'Pointer' of greater
+ * size" on platform w3i6mv.
+ */
+#define UNUSED_POINTER PointerAdd(0, 0xB60405ED) /* PointeR UNUSED */
+#define UNUSED_SIZE ((Size)0x520405ED) /* SiZe UNUSED */
+
+
/* PARENT -- parent structure
*
* Given a pointer to a field of a structure this returns a pointer to
@@ -170,6 +182,29 @@ typedef const struct SrcIdStruct {
((type *)(void *)((char *)(p) - offsetof(type, field)))
+
+/* BOOLFIELD -- declare a Boolean bitfield
+ *
+ * A Boolean bitfield needs to be unsigned (not Bool), so that its
+ * values are 0 and 1 (not 0 and -1), in order to avoid a sign
+ * conversion (which would be a compiler error) when assigning TRUE to
+ * the field.
+ *
+ * See
+ */
+#define BOOLFIELD(name) unsigned name : 1
+
+
+/* BITFIELD -- coerce a value into a bitfield
+ *
+ * This coerces value to the given width and type in a way that avoids
+ * warnings from gcc -Wconversion about possible loss of data.
+ */
+
+#define BITFIELD(type, value, width) ((type)value & (((type)1 << (width)) - 1))
+#define BOOLOF(v) BITFIELD(unsigned, (v), 1)
+
+
/* Bit Sets -- sets of integers in [0,N-1].
*
* Can be used on any unsigned integral type, ty. These definitions
@@ -191,6 +226,7 @@ typedef const struct SrcIdStruct {
#define BS_SUB(s1, s2) BS_SUPER((s2), (s1))
#define BS_IS_SINGLE(s) ( ((s) != 0) && (((s) & ((s)-1)) == 0) )
#define BS_SYM_DIFF(s1, s2) ((s1) ^ (s2))
+#define BS_BITFIELD(ty, s) BITFIELD(ty ## Set, (s), ty ## LIMIT)
#endif /* misc_h */
@@ -198,7 +234,7 @@ typedef const struct SrcIdStruct {
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2002 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index f544acca401..a46fdf5fb10 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -174,16 +174,16 @@ Word (WordAlignDown)(Word word, Align alignment)
/* SizeIsP2 -- test whether a size is a power of two */
-Bool SizeIsP2(Size size)
+Bool (SizeIsP2)(Size size)
{
- return WordIsP2((Word)size);
+ return SizeIsP2(size);
}
/* WordIsP2 -- tests whether a word is a power of two */
-Bool WordIsP2(Word word)
+Bool (WordIsP2)(Word word)
{
- return word > 0 && (word & (word - 1)) == 0;
+ return WordIsP2(word);
}
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index d80f55429ff..141d12e8aed 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -144,11 +144,13 @@ extern Bool ResIsAllocFailure(Res res);
* SizeFloorLog2 returns the floor of the logarithm in base 2 of size.
* size can be any positive non-zero value. */
-extern Bool SizeIsP2(Size size);
+extern Bool (SizeIsP2)(Size size);
+#define SizeIsP2(size) WordIsP2((Word)size)
extern Shift SizeLog2(Size size);
extern Shift SizeFloorLog2(Size size);
-extern Bool WordIsP2(Word word);
+extern Bool (WordIsP2)(Word word);
+#define WordIsP2(word) ((word) > 0 && ((word) & ((word) - 1)) == 0)
/* Formatted Output -- see , */
@@ -494,8 +496,8 @@ extern void ArenaFinish(Arena arena);
extern Res ArenaDescribe(Arena arena, mps_lib_FILE *stream);
extern Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream);
extern Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context);
-extern Res ArenaFreeCBSInsert(Arena arena, Addr base, Addr limit);
-extern void ArenaFreeCBSDelete(Arena arena, Addr base, Addr limit);
+extern Res ArenaFreeLandInsert(Arena arena, Addr base, Addr limit);
+extern void ArenaFreeLandDelete(Arena arena, Addr base, Addr limit);
extern Bool GlobalsCheck(Globals arena);
@@ -518,24 +520,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);
@@ -710,10 +715,10 @@ extern Addr (SegLimit)(Seg seg);
#define SegSummary(seg) (((GCSeg)(seg))->summary)
-#define SegSetPM(seg, mode) ((void)((seg)->pm = (mode)))
-#define SegSetSM(seg, mode) ((void)((seg)->sm = (mode)))
-#define SegSetDepth(seg, d) ((void)((seg)->depth = (d)))
-#define SegSetNailed(seg, ts) ((void)((seg)->nailed = (ts)))
+#define SegSetPM(seg, mode) ((void)((seg)->pm = BS_BITFIELD(Access, (mode))))
+#define SegSetSM(seg, mode) ((void)((seg)->sm = BS_BITFIELD(Access, (mode))))
+#define SegSetDepth(seg, d) ((void)((seg)->depth = BITFIELD(unsigned, (d), ShieldDepthWIDTH)))
+#define SegSetNailed(seg, ts) ((void)((seg)->nailed = BS_BITFIELD(Trace, (ts))))
/* Buffer Interface -- see */
@@ -811,7 +816,7 @@ extern AllocPattern AllocPatternRamp(void);
extern AllocPattern AllocPatternRampCollectAll(void);
-/* FindDelete -- see and */
+/* FindDelete -- see */
extern Bool FindDeleteCheck(FindDelete findDelete);
@@ -892,7 +897,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) \
@@ -906,7 +913,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
@@ -921,8 +930,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);
@@ -996,6 +1003,37 @@ extern Size VMReserved(VM vm);
extern Size VMMapped(VM vm);
+/* Land Interface -- see */
+
+extern Bool LandCheck(Land land);
+#define LandArena(land) ((land)->arena)
+#define LandAlignment(land) ((land)->alignment)
+extern Size LandSize(Land land);
+extern Res LandInit(Land land, LandClass class, Arena arena, Align alignment, void *owner, ArgList args);
+extern Res LandCreate(Land *landReturn, Arena arena, LandClass class, Align alignment, void *owner, ArgList args);
+extern void LandDestroy(Land land);
+extern void LandFinish(Land land);
+extern Res LandInsert(Range rangeReturn, Land land, Range range);
+extern Res LandDelete(Range rangeReturn, Land land, Range range);
+extern Bool LandIterate(Land land, LandVisitor visitor, void *closureP, Size closureS);
+extern Bool LandIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closureP, Size closureS);
+extern Bool LandFindFirst(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete);
+extern Bool LandFindLast(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete);
+extern Bool LandFindLargest(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete);
+extern Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high);
+extern Res LandDescribe(Land land, mps_lib_FILE *stream);
+extern Bool LandFlush(Land dest, Land src);
+
+extern Size LandSlowSize(Land land);
+extern Bool LandClassCheck(LandClass class);
+extern LandClass LandClassGet(void);
+#define LAND_SUPERCLASS(className) ((LandClass)SUPERCLASS(className))
+#define DEFINE_LAND_CLASS(className, var) \
+ DEFINE_ALIAS_CLASS(className, LandClass, var)
+#define IsLandSubclass(land, className) \
+ IsSubclassPoly((land)->class, className ## Get())
+
+
/* Stack Probe */
extern void StackProbe(Size depth);
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 85e95a78ec1..86087a31102 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -1,7 +1,7 @@
/* mpmst.h: MEMORY POOL MANAGER DATA STRUCTURES
*
* $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) 2001 Global Graphics Software.
*
* .design: This header file crosses module boundaries. The relevant
@@ -275,8 +275,8 @@ typedef struct SegStruct { /* segment structure */
RingStruct poolRing; /* link in list of segs in pool */
Addr limit; /* limit of segment */
unsigned depth : ShieldDepthWIDTH; /* see */
- AccessSet pm : AccessSetWIDTH; /* protection mode, */
- AccessSet sm : AccessSetWIDTH; /* shield mode, */
+ AccessSet pm : AccessLIMIT; /* protection mode, */
+ AccessSet sm : AccessLIMIT; /* shield mode, */
TraceSet grey : TraceLIMIT; /* traces for which seg is grey */
TraceSet white : TraceLIMIT; /* traces for which seg is white */
TraceSet nailed : TraceLIMIT; /* traces for which seg has nailed objects */
@@ -604,7 +604,53 @@ typedef struct GlobalsStruct {
} GlobalsStruct;
+/* LandClassStruct -- land class structure
+ *
+ * See .
+ */
+
+#define LandClassSig ((Sig)0x5197A4DC) /* SIGnature LAND Class */
+
+typedef struct LandClassStruct {
+ ProtocolClassStruct protocol;
+ const char *name; /* class name string */
+ size_t size; /* size of outer structure */
+ LandSizeMethod sizeMethod; /* total size of ranges in land */
+ LandInitMethod init; /* initialize the land */
+ LandFinishMethod finish; /* finish the land */
+ LandInsertMethod insert; /* insert a range into the land */
+ LandDeleteMethod delete; /* delete a range from the land */
+ LandIterateMethod iterate; /* iterate over ranges in the land */
+ LandIterateAndDeleteMethod iterateAndDelete; /* iterate and maybe delete */
+ LandFindMethod findFirst; /* find first range of given size */
+ LandFindMethod findLast; /* find last range of given size */
+ LandFindMethod findLargest; /* find largest range */
+ LandFindInZonesMethod findInZones; /* find first range of given size in zone set */
+ LandDescribeMethod describe; /* describe the land */
+ Sig sig; /* .class.end-sig */
+} LandClassStruct;
+
+
+/* LandStruct -- generic land structure
+ *
+ * See ,
+ */
+
+#define LandSig ((Sig)0x5197A4D9) /* SIGnature LAND */
+
+typedef struct LandStruct {
+ Sig sig; /* */
+ LandClass class; /* land class structure */
+ Arena arena; /* owning arena */
+ Align alignment; /* alignment of addresses */
+ Bool inLand; /* prevent reentrance */
+} LandStruct;
+
+
/* CBSStruct -- coalescing block structure
+ *
+ * CBS is a Land implementation that maintains a collection of
+ * disjoint ranges in a splay tree.
*
* See .
*/
@@ -612,21 +658,58 @@ typedef struct GlobalsStruct {
#define CBSSig ((Sig)0x519CB599) /* SIGnature CBS */
typedef struct CBSStruct {
+ LandStruct landStruct; /* superclass fields come first */
SplayTreeStruct splayTreeStruct;
STATISTIC_DECL(Count treeSize);
- Arena arena;
- Pool blockPool;
- Align alignment;
- Bool fastFind; /* maintain and use size property? */
- Bool zoned; /* maintain and use zone property? */
- Bool inCBS; /* prevent reentrance */
+ Pool blockPool; /* pool that manages blocks */
+ Size blockStructSize; /* size of block structure */
Bool ownPool; /* did we create blockPool? */
+ Size size; /* total size of ranges in CBS */
/* meters for sizes of search structures at each op */
METER_DECL(treeSearch);
- Sig sig; /* sig at end because embeded */
+ Sig sig; /* .class.end-sig */
} CBSStruct;
+/* FailoverStruct -- fail over from one land to another
+ *
+ * Failover is a Land implementation that combines two other Lands,
+ * using primary until it fails, and then using secondary.
+ *
+ * See .
+ */
+
+#define FailoverSig ((Sig)0x519FA170) /* SIGnature FAILOver */
+
+typedef struct FailoverStruct {
+ LandStruct landStruct; /* superclass fields come first */
+ Land primary; /* use this land normally */
+ Land secondary; /* but use this one if primary fails */
+ Sig sig; /* .class.end-sig */
+} FailoverStruct;
+
+
+/* FreelistStruct -- address-ordered freelist
+ *
+ * Freelist is a subclass of Land that maintains a collection of
+ * disjoint ranges in an address-ordered freelist.
+ *
+ * See .
+ */
+
+#define FreelistSig ((Sig)0x519F6331) /* SIGnature FREEL */
+
+typedef union FreelistBlockUnion *FreelistBlock;
+
+typedef struct FreelistStruct {
+ LandStruct landStruct; /* superclass fields come first */
+ FreelistBlock list; /* first block in list or NULL if empty */
+ Count listSize; /* number of blocks in list */
+ Size size; /* total size of ranges in list */
+ Sig sig; /* .class.end-sig */
+} FreelistStruct;
+
+
/* ArenaStruct -- generic arena
*
* See . */
@@ -661,9 +744,9 @@ typedef struct mps_arena_s {
Serial chunkSerial; /* next chunk number */
ChunkCacheEntryStruct chunkCache; /* just one entry */
- Bool hasFreeCBS; /* Is freeCBS available? */
+ Bool hasFreeLand; /* Is freeLand available? */
MFSStruct freeCBSBlockPoolStruct;
- CBSStruct freeCBSStruct;
+ CBSStruct freeLandStruct;
ZoneSet freeZones; /* zones not yet allocated */
Bool zoned; /* use zoned allocation? */
@@ -738,7 +821,7 @@ typedef struct AllocPatternStruct {
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2013 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h
index 83456b46077..deb70fce89b 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -109,7 +109,10 @@ typedef struct AllocPatternStruct *AllocPattern;
typedef struct AllocFrameStruct *AllocFrame; /* */
typedef struct ReservoirStruct *Reservoir; /* */
typedef struct StackContextStruct *StackContext;
-typedef unsigned FindDelete; /* */
+typedef struct RangeStruct *Range; /* */
+typedef struct LandStruct *Land; /* */
+typedef struct LandClassStruct *LandClass; /* */
+typedef unsigned FindDelete; /* */
/* Arena*Method -- see */
@@ -262,6 +265,22 @@ typedef struct TraceStartMessageStruct *TraceStartMessage;
typedef struct TraceMessageStruct *TraceMessage; /* trace end */
+/* Land*Method -- see */
+
+typedef Res (*LandInitMethod)(Land land, ArgList args);
+typedef void (*LandFinishMethod)(Land land);
+typedef Size (*LandSizeMethod)(Land land);
+typedef Res (*LandInsertMethod)(Range rangeReturn, Land land, Range range);
+typedef Res (*LandDeleteMethod)(Range rangeReturn, Land land, Range range);
+typedef Bool (*LandVisitor)(Land land, Range range, void *closureP, Size closureS);
+typedef Bool (*LandDeleteVisitor)(Bool *deleteReturn, Land land, Range range, void *closureP, Size closureS);
+typedef Bool (*LandIterateMethod)(Land land, LandVisitor visitor, void *closureP, Size closureS);
+typedef Bool (*LandIterateAndDeleteMethod)(Land land, LandDeleteVisitor visitor, void *closureP, Size closureS);
+typedef Bool (*LandFindMethod)(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete);
+typedef Res (*LandFindInZonesMethod)(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high);
+typedef Res (*LandDescribeMethod)(Land land, mps_lib_FILE *stream);
+
+
/* CONSTANTS */
@@ -272,7 +291,7 @@ typedef struct TraceMessageStruct *TraceMessage; /* trace end */
#define AccessSetEMPTY ((AccessSet)0) /* */
#define AccessREAD ((AccessSet)(1<<0))
#define AccessWRITE ((AccessSet)(1<<1))
-#define AccessSetWIDTH (2)
+#define AccessLIMIT (2)
#define RefSetEMPTY BS_EMPTY(RefSet)
#define RefSetUNIV BS_UNIV(RefSet)
#define ZoneSetEMPTY BS_EMPTY(ZoneSet)
@@ -408,7 +427,7 @@ enum {
};
-/* FindDelete operations -- see and */
+/* FindDelete operations -- see */
enum {
FindDeleteNONE = 1, /* don't delete after finding */
diff --git a/mps/code/mps.c b/mps/code/mps.c
index f8c886ac997..115996ba7a0 100644
--- a/mps/code/mps.c
+++ b/mps/code/mps.c
@@ -76,6 +76,8 @@
#include "freelist.c"
#include "sa.c"
#include "nailboard.c"
+#include "land.c"
+#include "failover.c"
/* Additional pool classes */
@@ -85,20 +87,31 @@
#include "poolawl.c"
#include "poollo.c"
#include "poolsnc.c"
-#include "pooln.c"
#include "poolmv2.c"
#include "poolmvff.c"
/* 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 */
diff --git a/mps/code/mps.h b/mps/code/mps.h
index 58cbb2ebf88..050696e19d0 100644
--- a/mps/code/mps.h
+++ b/mps/code/mps.h
@@ -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.
@@ -13,7 +13,7 @@
* `MPS_` or `_mps_` and may use any identifiers with these prefixes in
* future.
*
- * .naming.internal: Any idenfitier beginning with underscore is for
+ * .naming.internal: Any identifier beginning with an underscore is for
* internal use within the interface and may change or be withdrawn without
* warning.
*
@@ -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 .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/mps.xcodeproj/project.pbxproj b/mps/code/mps.xcodeproj/project.pbxproj
index 88f110bab01..39a2d76f8ea 100644
--- a/mps/code/mps.xcodeproj/project.pbxproj
+++ b/mps/code/mps.xcodeproj/project.pbxproj
@@ -7,6 +7,54 @@
objects = {
/* Begin PBXAggregateTarget section */
+ 2215A9A9192A47BB00E9E2CE /* testci */ = {
+ isa = PBXAggregateTarget;
+ buildConfigurationList = 2215A9AD192A47BB00E9E2CE /* Build configuration list for PBXAggregateTarget "testci" */;
+ buildPhases = (
+ 2215A9AC192A47BB00E9E2CE /* ShellScript */,
+ );
+ dependencies = (
+ 2215A9AA192A47BB00E9E2CE /* PBXTargetDependency */,
+ );
+ name = testci;
+ productName = testrun;
+ };
+ 2215A9B1192A47C500E9E2CE /* testansi */ = {
+ isa = PBXAggregateTarget;
+ buildConfigurationList = 2215A9B5192A47C500E9E2CE /* Build configuration list for PBXAggregateTarget "testansi" */;
+ buildPhases = (
+ 2215A9B4192A47C500E9E2CE /* ShellScript */,
+ );
+ dependencies = (
+ 2215A9B2192A47C500E9E2CE /* PBXTargetDependency */,
+ );
+ name = testansi;
+ productName = testrun;
+ };
+ 2215A9B9192A47CE00E9E2CE /* testall */ = {
+ isa = PBXAggregateTarget;
+ buildConfigurationList = 2215A9BD192A47CE00E9E2CE /* Build configuration list for PBXAggregateTarget "testall" */;
+ buildPhases = (
+ 2215A9BC192A47CE00E9E2CE /* ShellScript */,
+ );
+ dependencies = (
+ 2215A9BA192A47CE00E9E2CE /* PBXTargetDependency */,
+ );
+ name = testall;
+ productName = testrun;
+ };
+ 2215A9C1192A47D500E9E2CE /* testpoll */ = {
+ isa = PBXAggregateTarget;
+ buildConfigurationList = 2215A9C5192A47D500E9E2CE /* Build configuration list for PBXAggregateTarget "testpoll" */;
+ buildPhases = (
+ 2215A9C4192A47D500E9E2CE /* ShellScript */,
+ );
+ dependencies = (
+ 2215A9C2192A47D500E9E2CE /* PBXTargetDependency */,
+ );
+ name = testpoll;
+ productName = testrun;
+ };
22CDE8EF16E9E97D00366D0A /* testrun */ = {
isa = PBXAggregateTarget;
buildConfigurationList = 22CDE8F016E9E97E00366D0A /* Build configuration list for PBXAggregateTarget "testrun" */;
@@ -43,11 +91,11 @@
22B2BC3D18B643B300C33E63 /* PBXTargetDependency */,
2291A5E6175CB207001D4920 /* PBXTargetDependency */,
2291A5E8175CB20E001D4920 /* PBXTargetDependency */,
- 3114A65B156E95B4001E0AA3 /* PBXTargetDependency */,
3114A5CC156E932C001E0AA3 /* PBXTargetDependency */,
3114A5EA156E93C4001E0AA3 /* PBXTargetDependency */,
224CC79D175E187C002FF81B /* PBXTargetDependency */,
22B2BC3F18B643B700C33E63 /* PBXTargetDependency */,
+ 3114A65B156E95B4001E0AA3 /* PBXTargetDependency */,
2231BB6D18CA986B002D6322 /* PBXTargetDependency */,
31D60034156D3D5A00337B26 /* PBXTargetDependency */,
2286E4C918F4389E004111E2 /* PBXTargetDependency */,
@@ -79,6 +127,7 @@
/* End PBXAggregateTarget section */
/* Begin PBXBuildFile section */
+ 2215A9C9192A495F00E9E2CE /* pooln.c in Sources */ = {isa = PBXBuildFile; fileRef = 22FACEDE18880933000FDBC1 /* pooln.c */; };
2231BB5118CA97D8002D6322 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
2231BB5318CA97D8002D6322 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
2231BB5F18CA97DC002D6322 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
@@ -112,7 +161,7 @@
2291A5DB175CB05F001D4920 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
2291A5DD175CB05F001D4920 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
2291A5E4175CB076001D4920 /* exposet0.c in Sources */ = {isa = PBXBuildFile; fileRef = 2291A5AA175CAA9B001D4920 /* exposet0.c */; };
- 2291A5ED175CB5E2001D4920 /* fbmtest.c in Sources */ = {isa = PBXBuildFile; fileRef = 2291A5E9175CB4EC001D4920 /* fbmtest.c */; };
+ 2291A5ED175CB5E2001D4920 /* landtest.c in Sources */ = {isa = PBXBuildFile; fileRef = 2291A5E9175CB4EC001D4920 /* landtest.c */; };
22B2BC2E18B6434F00C33E63 /* mps.c in Sources */ = {isa = PBXBuildFile; fileRef = 31A47BA3156C1E130039B1C2 /* mps.c */; };
22B2BC3718B6437C00C33E63 /* scheme-advanced.c in Sources */ = {isa = PBXBuildFile; fileRef = 22B2BC2B18B6434000C33E63 /* scheme-advanced.c */; };
22C2ACA718BE400A006B3677 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
@@ -287,6 +336,34 @@
/* End PBXBuildFile section */
/* Begin PBXContainerItemProxy section */
+ 2215A9AB192A47BB00E9E2CE /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 3104AFF1156D37A0000A585A;
+ remoteInfo = all;
+ };
+ 2215A9B3192A47C500E9E2CE /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 3104AFF1156D37A0000A585A;
+ remoteInfo = all;
+ };
+ 2215A9BB192A47CE00E9E2CE /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 3104AFF1156D37A0000A585A;
+ remoteInfo = all;
+ };
+ 2215A9C3192A47D500E9E2CE /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 3104AFF1156D37A0000A585A;
+ remoteInfo = all;
+ };
2231BB4E18CA97D8002D6322 /* PBXContainerItemProxy */ = {
isa = PBXContainerItemProxy;
containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
@@ -719,7 +796,7 @@
containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
proxyType = 1;
remoteGlobalIDString = 3114A64B156E9596001E0AA3;
- remoteInfo = fbmtest;
+ remoteInfo = landtest;
};
3114A674156E9619001E0AA3 /* PBXContainerItemProxy */ = {
isa = PBXContainerItemProxy;
@@ -1338,7 +1415,7 @@
2291A5BD175CAB2F001D4920 /* awlutth */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = awlutth; sourceTree = BUILT_PRODUCTS_DIR; };
2291A5D1175CAFCA001D4920 /* expt825 */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = expt825; sourceTree = BUILT_PRODUCTS_DIR; };
2291A5E3175CB05F001D4920 /* exposet0 */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = exposet0; sourceTree = BUILT_PRODUCTS_DIR; };
- 2291A5E9175CB4EC001D4920 /* fbmtest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = fbmtest.c; sourceTree = ""; };
+ 2291A5E9175CB4EC001D4920 /* landtest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = landtest.c; sourceTree = ""; };
2291A5EA175CB503001D4920 /* abq.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = abq.h; sourceTree = ""; };
2291A5EB175CB53E001D4920 /* range.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = range.c; sourceTree = ""; };
2291A5EC175CB53E001D4920 /* range.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = range.h; sourceTree = ""; };
@@ -1353,6 +1430,11 @@
22E30E831886FF1400D98EA9 /* nailboard.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = nailboard.h; sourceTree = ""; };
22F846AF18F4379C00982BA7 /* lockut.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = lockut.c; sourceTree = ""; };
22F846BD18F437B900982BA7 /* lockut */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = lockut; sourceTree = BUILT_PRODUCTS_DIR; };
+ 22C5C99A18EC6AEC004C63D4 /* failover.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = failover.c; sourceTree = ""; };
+ 22C5C99B18EC6AEC004C63D4 /* failover.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = failover.h; sourceTree = ""; };
+ 22C5C99C18EC6AEC004C63D4 /* land.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = land.c; sourceTree = ""; };
+ 22DD93E118ED815F00240DD2 /* failover.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = failover.txt; path = ../design/failover.txt; sourceTree = ""; };
+ 22DD93E218ED815F00240DD2 /* land.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = land.txt; path = ../design/land.txt; sourceTree = ""; };
22FA177516E8D6FC0098B23F /* amcssth */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = amcssth; sourceTree = BUILT_PRODUCTS_DIR; };
22FA177616E8D7A80098B23F /* amcssth.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = amcssth.c; sourceTree = ""; };
22FACED1188807FF000FDBC1 /* airtest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = airtest.c; sourceTree = ""; };
@@ -1408,7 +1490,7 @@
3114A633156E94DB001E0AA3 /* abqtest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = abqtest; sourceTree = BUILT_PRODUCTS_DIR; };
3114A63D156E94EA001E0AA3 /* abqtest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = abqtest.c; sourceTree = ""; };
3114A645156E9525001E0AA3 /* abq.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = abq.c; sourceTree = ""; };
- 3114A64C156E9596001E0AA3 /* fbmtest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = fbmtest; sourceTree = BUILT_PRODUCTS_DIR; };
+ 3114A64C156E9596001E0AA3 /* landtest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = landtest; sourceTree = BUILT_PRODUCTS_DIR; };
3114A662156E95D9001E0AA3 /* btcv */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = btcv; sourceTree = BUILT_PRODUCTS_DIR; };
3114A66C156E95EB001E0AA3 /* btcv.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = btcv.c; sourceTree = ""; };
3114A67C156E9668001E0AA3 /* mv2test */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = mv2test; sourceTree = BUILT_PRODUCTS_DIR; };
@@ -2060,6 +2142,7 @@
31160D9C1899540D0071EB17 /* config.txt */,
31160D9D1899540D0071EB17 /* critical-path.txt */,
31160D9E1899540D0071EB17 /* diag.txt */,
+ 22DD93E118ED815F00240DD2 /* failover.txt */,
31160D9F1899540D0071EB17 /* finalize.txt */,
31160DA01899540D0071EB17 /* fix.txt */,
31160DA11899540D0071EB17 /* freelist.txt */,
@@ -2069,6 +2152,7 @@
31160DA51899540D0071EB17 /* interface-c.txt */,
31160DA61899540D0071EB17 /* io.txt */,
31160DA71899540D0071EB17 /* keyword-arguments.txt */,
+ 22DD93E218ED815F00240DD2 /* land.txt */,
31160DA81899540D0071EB17 /* lib.txt */,
31160DA91899540D0071EB17 /* lock.txt */,
31160DAA1899540D0071EB17 /* locus.txt */,
@@ -2139,7 +2223,6 @@
3114A613156E944A001E0AA3 /* bttest.c */,
2291A5AA175CAA9B001D4920 /* exposet0.c */,
2291A5AB175CAA9B001D4920 /* expt825.c */,
- 2291A5E9175CB4EC001D4920 /* fbmtest.c */,
3114A5CD156E9369001E0AA3 /* finalcv.c */,
3114A5E5156E93B9001E0AA3 /* finaltest.c */,
3124CAC6156BE48D00753214 /* fmtdy.c */,
@@ -2153,6 +2236,7 @@
22FACED6188807FF000FDBC1 /* fmtscheme.c */,
22FACED7188807FF000FDBC1 /* fmtscheme.h */,
224CC79E175E3202002FF81B /* fotest.c */,
+ 2291A5E9175CB4EC001D4920 /* landtest.c */,
2231BB6818CA9834002D6322 /* locbwcss.c */,
31D60036156D3E0200337B26 /* lockcov.c */,
2231BB6918CA983C002D6322 /* locusss.c */,
@@ -2244,7 +2328,7 @@
3114A605156E9430001E0AA3 /* bttest */,
3114A61C156E9485001E0AA3 /* teletest */,
3114A633156E94DB001E0AA3 /* abqtest */,
- 3114A64C156E9596001E0AA3 /* fbmtest */,
+ 3114A64C156E9596001E0AA3 /* landtest */,
3114A662156E95D9001E0AA3 /* btcv */,
3114A67C156E9668001E0AA3 /* mv2test */,
3114A695156E971B001E0AA3 /* messtest */,
@@ -2299,10 +2383,13 @@
311F2F5917398AE900C15B6A /* eventcom.h */,
311F2F5A17398AE900C15B6A /* eventdef.h */,
311F2F5C17398AE900C15B6A /* eventrep.h */,
+ 22C5C99A18EC6AEC004C63D4 /* failover.c */,
+ 22C5C99B18EC6AEC004C63D4 /* failover.h */,
31EEAC1A156AB2B200714D05 /* format.c */,
2291A5EE175CB768001D4920 /* freelist.c */,
2291A5EF175CB768001D4920 /* freelist.h */,
31EEAC07156AB27B00714D05 /* global.c */,
+ 22C5C99C18EC6AEC004C63D4 /* land.c */,
31EEAC2B156AB2F200714D05 /* ld.c */,
311F2F5E17398B0E00C15B6A /* lock.h */,
31EEAC08156AB27B00714D05 /* locus.c */,
@@ -2644,7 +2731,7 @@
22FACEE118880983000FDBC1 /* PBXTargetDependency */,
);
name = airtest;
- productName = mv2test;
+ productName = airtest;
productReference = 22FACEED18880983000FDBC1 /* airtest */;
productType = "com.apple.product-type.tool";
};
@@ -2934,9 +3021,9 @@
productReference = 3114A633156E94DB001E0AA3 /* abqtest */;
productType = "com.apple.product-type.tool";
};
- 3114A64B156E9596001E0AA3 /* fbmtest */ = {
+ 3114A64B156E9596001E0AA3 /* landtest */ = {
isa = PBXNativeTarget;
- buildConfigurationList = 3114A653156E9596001E0AA3 /* Build configuration list for PBXNativeTarget "fbmtest" */;
+ buildConfigurationList = 3114A653156E9596001E0AA3 /* Build configuration list for PBXNativeTarget "landtest" */;
buildPhases = (
3114A648156E9596001E0AA3 /* Sources */,
3114A649156E9596001E0AA3 /* Frameworks */,
@@ -2947,9 +3034,9 @@
dependencies = (
3114A659156E95B1001E0AA3 /* PBXTargetDependency */,
);
- name = fbmtest;
- productName = fbmtest;
- productReference = 3114A64C156E9596001E0AA3 /* fbmtest */;
+ name = landtest;
+ productName = landtest;
+ productReference = 3114A64C156E9596001E0AA3 /* landtest */;
productType = "com.apple.product-type.tool";
};
3114A661156E95D9001E0AA3 /* btcv */ = {
@@ -3311,6 +3398,10 @@
projectRoot = "";
targets = (
3104AFF1156D37A0000A585A /* all */,
+ 2215A9B9192A47CE00E9E2CE /* testall */,
+ 2215A9B1192A47C500E9E2CE /* testansi */,
+ 2215A9A9192A47BB00E9E2CE /* testci */,
+ 2215A9C1192A47D500E9E2CE /* testpoll */,
22CDE8EF16E9E97D00366D0A /* testrun */,
31EEABFA156AAF9D00714D05 /* mps */,
3114A632156E94DB001E0AA3 /* abqtest */,
@@ -3330,11 +3421,11 @@
318DA8C31892B0F30089718C /* djbench */,
2291A5D3175CB05F001D4920 /* exposet0 */,
2291A5C1175CAFCA001D4920 /* expt825 */,
- 3114A64B156E9596001E0AA3 /* fbmtest */,
3114A5BC156E9315001E0AA3 /* finalcv */,
3114A5D5156E93A0001E0AA3 /* finaltest */,
224CC78C175E1821002FF81B /* fotest */,
6313D46718A400B200EB03EF /* gcbench */,
+ 3114A64B156E9596001E0AA3 /* landtest */,
2231BB4C18CA97D8002D6322 /* locbwcss */,
31D60026156D3D3E00337B26 /* lockcov */,
2231BB5A18CA97DC002D6322 /* locusss */,
@@ -3364,6 +3455,62 @@
/* End PBXProject section */
/* Begin PBXShellScriptBuildPhase section */
+ 2215A9AC192A47BB00E9E2CE /* ShellScript */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ );
+ outputPaths = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "../tool/testrun.sh \"$TARGET_BUILD_DIR\" \"$TARGET_NAME\"\n";
+ showEnvVarsInLog = 0;
+ };
+ 2215A9B4192A47C500E9E2CE /* ShellScript */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ );
+ outputPaths = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "../tool/testrun.sh \"$TARGET_BUILD_DIR\" \"$TARGET_NAME\"\n";
+ showEnvVarsInLog = 0;
+ };
+ 2215A9BC192A47CE00E9E2CE /* ShellScript */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ );
+ outputPaths = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "../tool/testrun.sh \"$TARGET_BUILD_DIR\" \"$TARGET_NAME\"\n";
+ showEnvVarsInLog = 0;
+ };
+ 2215A9C4192A47D500E9E2CE /* ShellScript */ = {
+ isa = PBXShellScriptBuildPhase;
+ buildActionMask = 2147483647;
+ files = (
+ );
+ inputPaths = (
+ );
+ outputPaths = (
+ );
+ runOnlyForDeploymentPostprocessing = 0;
+ shellPath = /bin/sh;
+ shellScript = "../tool/testrun.sh \"$TARGET_BUILD_DIR\" \"$TARGET_NAME\"\n";
+ showEnvVarsInLog = 0;
+ };
22CDE8F416E9E9D400366D0A /* ShellScript */ = {
isa = PBXShellScriptBuildPhase;
buildActionMask = 2147483647;
@@ -3375,7 +3522,7 @@
);
runOnlyForDeploymentPostprocessing = 0;
shellPath = /bin/sh;
- shellScript = "../tool/testrun.sh \"$TARGET_BUILD_DIR\"\n";
+ shellScript = "../tool/testrun.sh \"$TARGET_BUILD_DIR\" \"$TARGET_NAME\"\n";
showEnvVarsInLog = 0;
};
/* End PBXShellScriptBuildPhase section */
@@ -3664,7 +3811,7 @@
isa = PBXSourcesBuildPhase;
buildActionMask = 2147483647;
files = (
- 2291A5ED175CB5E2001D4920 /* fbmtest.c in Sources */,
+ 2291A5ED175CB5E2001D4920 /* landtest.c in Sources */,
3114A672156E95F6001E0AA3 /* testlib.c in Sources */,
);
runOnlyForDeploymentPostprocessing = 0;
@@ -3791,8 +3938,9 @@
isa = PBXSourcesBuildPhase;
buildActionMask = 2147483647;
files = (
- 31D60048156D3ECF00337B26 /* testlib.c in Sources */,
+ 2215A9C9192A495F00E9E2CE /* pooln.c in Sources */,
31D6004B156D3EE600337B26 /* poolncv.c in Sources */,
+ 31D60048156D3ECF00337B26 /* testlib.c in Sources */,
);
runOnlyForDeploymentPostprocessing = 0;
};
@@ -3876,6 +4024,26 @@
/* End PBXSourcesBuildPhase section */
/* Begin PBXTargetDependency section */
+ 2215A9AA192A47BB00E9E2CE /* PBXTargetDependency */ = {
+ isa = PBXTargetDependency;
+ target = 3104AFF1156D37A0000A585A /* all */;
+ targetProxy = 2215A9AB192A47BB00E9E2CE /* PBXContainerItemProxy */;
+ };
+ 2215A9B2192A47C500E9E2CE /* PBXTargetDependency */ = {
+ isa = PBXTargetDependency;
+ target = 3104AFF1156D37A0000A585A /* all */;
+ targetProxy = 2215A9B3192A47C500E9E2CE /* PBXContainerItemProxy */;
+ };
+ 2215A9BA192A47CE00E9E2CE /* PBXTargetDependency */ = {
+ isa = PBXTargetDependency;
+ target = 3104AFF1156D37A0000A585A /* all */;
+ targetProxy = 2215A9BB192A47CE00E9E2CE /* PBXContainerItemProxy */;
+ };
+ 2215A9C2192A47D500E9E2CE /* PBXTargetDependency */ = {
+ isa = PBXTargetDependency;
+ target = 3104AFF1156D37A0000A585A /* all */;
+ targetProxy = 2215A9C3192A47D500E9E2CE /* PBXContainerItemProxy */;
+ };
2231BB4D18CA97D8002D6322 /* PBXTargetDependency */ = {
isa = PBXTargetDependency;
target = 31EEABFA156AAF9D00714D05 /* mps */;
@@ -4183,7 +4351,7 @@
};
3114A65B156E95B4001E0AA3 /* PBXTargetDependency */ = {
isa = PBXTargetDependency;
- target = 3114A64B156E9596001E0AA3 /* fbmtest */;
+ target = 3114A64B156E9596001E0AA3 /* landtest */;
targetProxy = 3114A65A156E95B4001E0AA3 /* PBXContainerItemProxy */;
};
3114A675156E9619001E0AA3 /* PBXTargetDependency */ = {
@@ -4319,45 +4487,129 @@
/* End PBXTargetDependency section */
/* Begin XCBuildConfiguration section */
+ 2215A9AE192A47BB00E9E2CE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testrun copy";
+ };
+ name = Debug;
+ };
+ 2215A9AF192A47BB00E9E2CE /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testrun copy";
+ };
+ name = Release;
+ };
+ 2215A9B0192A47BB00E9E2CE /* RASH */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testrun copy";
+ };
+ name = RASH;
+ };
+ 2215A9B6192A47C500E9E2CE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testci copy";
+ };
+ name = Debug;
+ };
+ 2215A9B7192A47C500E9E2CE /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testci copy";
+ };
+ name = Release;
+ };
+ 2215A9B8192A47C500E9E2CE /* RASH */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testci copy";
+ };
+ name = RASH;
+ };
+ 2215A9BE192A47CE00E9E2CE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testansi copy";
+ };
+ name = Debug;
+ };
+ 2215A9BF192A47CE00E9E2CE /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testansi copy";
+ };
+ name = Release;
+ };
+ 2215A9C0192A47CE00E9E2CE /* RASH */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testansi copy";
+ };
+ name = RASH;
+ };
+ 2215A9C6192A47D500E9E2CE /* Debug */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testall copy";
+ };
+ name = Debug;
+ };
+ 2215A9C7192A47D500E9E2CE /* Release */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testall copy";
+ };
+ name = Release;
+ };
+ 2215A9C8192A47D500E9E2CE /* RASH */ = {
+ isa = XCBuildConfiguration;
+ buildSettings = {
+ PRODUCT_NAME = "testall copy";
+ };
+ name = RASH;
+ };
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;
};
@@ -4421,7 +4673,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
- PRODUCT_NAME = "scheme-advanced";
+ PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@@ -4429,7 +4681,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
- PRODUCT_NAME = "scheme-advanced";
+ PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@@ -4437,41 +4689,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;
};
@@ -4492,21 +4738,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;
};
@@ -4527,30 +4773,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 = {
@@ -4626,7 +4859,6 @@
3104AFF3156D37A0000A585A /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
- COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
@@ -4634,7 +4866,6 @@
3104AFF4156D37A0000A585A /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
- COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
@@ -4923,7 +5154,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
- PRODUCT_NAME = djbench;
+ PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@@ -4931,7 +5162,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
- PRODUCT_NAME = djbench;
+ PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@@ -4991,7 +5222,6 @@
318DA8D51892C0D00089718C /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
- COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
@@ -5000,7 +5230,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
- COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@@ -5285,7 +5514,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
- PRODUCT_NAME = djbench;
+ PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@@ -5484,7 +5713,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
- COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@@ -5494,7 +5722,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
- COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@@ -5534,7 +5761,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
- PRODUCT_NAME = gcbench;
+ PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@@ -5542,7 +5769,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
- PRODUCT_NAME = gcbench;
+ PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@@ -5550,13 +5777,53 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
- PRODUCT_NAME = gcbench;
+ PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
/* End XCBuildConfiguration section */
/* Begin XCConfigurationList section */
+ 2215A9AD192A47BB00E9E2CE /* Build configuration list for PBXAggregateTarget "testci" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ 2215A9AE192A47BB00E9E2CE /* Debug */,
+ 2215A9AF192A47BB00E9E2CE /* Release */,
+ 2215A9B0192A47BB00E9E2CE /* RASH */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Release;
+ };
+ 2215A9B5192A47C500E9E2CE /* Build configuration list for PBXAggregateTarget "testansi" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ 2215A9B6192A47C500E9E2CE /* Debug */,
+ 2215A9B7192A47C500E9E2CE /* Release */,
+ 2215A9B8192A47C500E9E2CE /* RASH */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Release;
+ };
+ 2215A9BD192A47CE00E9E2CE /* Build configuration list for PBXAggregateTarget "testall" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ 2215A9BE192A47CE00E9E2CE /* Debug */,
+ 2215A9BF192A47CE00E9E2CE /* Release */,
+ 2215A9C0192A47CE00E9E2CE /* RASH */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Release;
+ };
+ 2215A9C5192A47D500E9E2CE /* Build configuration list for PBXAggregateTarget "testpoll" */ = {
+ isa = XCConfigurationList;
+ buildConfigurations = (
+ 2215A9C6192A47D500E9E2CE /* Debug */,
+ 2215A9C7192A47D500E9E2CE /* Release */,
+ 2215A9C8192A47D500E9E2CE /* RASH */,
+ );
+ defaultConfigurationIsVisible = 0;
+ defaultConfigurationName = Release;
+ };
2231BB5518CA97D8002D6322 /* Build configuration list for PBXNativeTarget "locbwcss" */ = {
isa = XCConfigurationList;
buildConfigurations = (
@@ -5672,7 +5939,6 @@
buildConfigurations = (
22FACEEA18880983000FDBC1 /* Debug */,
22FACEEB18880983000FDBC1 /* Release */,
- 22FACEEC18880983000FDBC1 /* WE */,
22C2ACA118BE3FEC006B3677 /* RASH */,
);
defaultConfigurationIsVisible = 0;
@@ -5848,7 +6114,7 @@
defaultConfigurationIsVisible = 0;
defaultConfigurationName = Release;
};
- 3114A653156E9596001E0AA3 /* Build configuration list for PBXNativeTarget "fbmtest" */ = {
+ 3114A653156E9596001E0AA3 /* Build configuration list for PBXNativeTarget "landtest" */ = {
isa = XCConfigurationList;
buildConfigurations = (
3114A654156E9596001E0AA3 /* Debug */,
diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c
index 3df0913df83..0573a6d4256 100644
--- a/mps/code/mpsi.c
+++ b/mps/code/mpsi.c
@@ -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 .
diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c
index 55396aee3fe..6a241561a22 100644
--- a/mps/code/mpsicv.c
+++ b/mps/code/mpsicv.c
@@ -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);
diff --git a/mps/code/mpsliban.c b/mps/code/mpsliban.c
index 75a3d48d518..5e7cfdddc8b 100644
--- a/mps/code/mpsliban.c
+++ b/mps/code/mpsliban.c
@@ -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 */
}
diff --git a/mps/code/nailboard.c b/mps/code/nailboard.c
index 8744514662b..852c98949e7 100644
--- a/mps/code/nailboard.c
+++ b/mps/code/nailboard.c
@@ -30,26 +30,36 @@ static Count nailboardLevels(Count nails)
}
+/* nailboardNails -- return the total number of nails in the board */
+
+static Count nailboardNails(Nailboard board)
+{
+ return RangeSize(&board->range) >> board->alignShift;
+}
+
+
/* nailboardLevelBits -- return the number of bits in the bit table
* for the given level.
*/
-static Count nailboardLevelBits(Nailboard board, Index level)
+static Count nailboardLevelBits(Count nails, Index level)
{
- /* Use <= rather than < because of .check.levels. */
- AVER(level <= board->levels);
- return RangeSize(&board->range) >> (board->alignShift + level * LEVEL_SHIFT);
+ Shift shift = (Shift)(level * LEVEL_SHIFT);
+ return (nails + ((Count)1 << shift) - 1) >> shift;
}
Bool NailboardCheck(Nailboard board)
{
Index i;
+ Count nails;
CHECKS(Nailboard, board);
CHECKL(RangeCheck(&board->range));
CHECKL(0 < board->levels);
- CHECKL(board->levels == nailboardLevels(nailboardLevelBits(board, 0)));
- CHECKL(nailboardLevelBits(board, board->levels - 1) != 0);
- CHECKL(nailboardLevelBits(board, board->levels) == 0); /* .check.levels */
+ nails = nailboardNails(board);
+ CHECKL(board->levels == nailboardLevels(nails));
+ CHECKL(nails == nailboardLevelBits(nails, 0));
+ CHECKL(nailboardLevelBits(nails, board->levels - 1) != 0);
+ CHECKL(nailboardLevelBits(nails, board->levels) == 1);
CHECKL(BoolCheck(board->newNails));
for (i = 0; i < board->levels; ++i) {
CHECKL(board->level[i] != NULL);
@@ -80,8 +90,7 @@ static Size nailboardSize(Count nails, Count levels)
Size size;
size = nailboardStructSize(levels);
for (i = 0; i < levels; ++i) {
- size += BTSize(nails);
- nails >>= LEVEL_SHIFT;
+ size += BTSize(nailboardLevelBits(nails, i));
}
return size;
}
@@ -130,11 +139,11 @@ Res NailboardCreate(Nailboard *boardReturn, Arena arena, Align alignment,
p = PointerAdd(p, nailboardStructSize(levels));
for (i = 0; i < levels; ++i) {
- AVER(nails > 0);
+ Count levelBits = nailboardLevelBits(nails, i);
+ AVER(levelBits > 0);
board->level[i] = p;
- BTResRange(board->level[i], 0, nails);
- p = PointerAdd(p, BTSize(nails));
- nails >>= LEVEL_SHIFT;
+ BTResRange(board->level[i], 0, levelBits);
+ p = PointerAdd(p, BTSize(levelBits));
}
board->sig = NailboardSig;
@@ -154,7 +163,7 @@ void NailboardDestroy(Nailboard board, Arena arena)
AVERT(Nailboard, board);
AVERT(Arena, arena);
- nails = nailboardLevelBits(board, 0);
+ nails = nailboardNails(board);
size = nailboardSize(nails, board->levels);
board->sig = SigInvalid;
@@ -191,8 +200,10 @@ Bool (NailboardNewNails)(Nailboard board)
static Index nailboardIndex(Nailboard board, Index level, Addr addr)
{
- return AddrOffset(RangeBase(&board->range), addr)
+ Index i = AddrOffset(RangeBase(&board->range), addr)
>> (board->alignShift + level * LEVEL_SHIFT);
+ AVER_CRITICAL(i < nailboardLevelBits(nailboardNails(board), level));
+ return i;
}
@@ -414,7 +425,7 @@ Res NailboardDescribe(Nailboard board, mps_lib_FILE *stream)
return res;
for(i = 0; i < board->levels; ++i) {
- Count levelNails = nailboardLevelBits(board, i);
+ Count levelNails = nailboardLevelBits(nailboardNails(board), i);
Count resetNails = BTCountResRange(board->level[i], 0, levelNails);
res = WriteF(stream, " Level $U ($U bits, $U set): ",
i, levelNails, levelNails - resetNails, NULL);
diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c
index aeb04454efe..82e7998a2db 100644
--- a/mps/code/poolamc.c
+++ b/mps/code/poolamc.c
@@ -45,7 +45,6 @@ typedef struct amcGenStruct {
PoolGenStruct pgen;
RingStruct amcRing; /* link in list of gens in pool */
Buffer forward; /* forwarding buffer */
- Count segs; /* number of segs in gen */
Sig sig; /* */
} amcGenStruct;
@@ -72,12 +71,19 @@ enum {
/* amcSegStruct -- AMC-specific fields appended to GCSegStruct
*
- * .seg-ramp-new: The "new" flag is usually true, and indicates that the
- * segment has been counted towards the pool generation's newSize. It is
- * set to FALSE otherwise. This is used by both ramping and hash array
- * allocations. TODO: The code for this is scrappy and needs refactoring,
- * and the *reasons* for setting these flags need properly documenting.
- * RB 2013-07-17
+ * .seq.old: The "old" flag is FALSE if the segment has never been
+ * collected, and so its size is accounted against the pool
+ * generation's newSize; it is TRUE if the segment has been collected
+ * at least once, and so its size is accounted against the pool
+ * generation's oldSize.
+ *
+ * .seg.deferred: The "deferred" flag is TRUE if its size accounting
+ * in the pool generation has been deferred. This is set if the
+ * segment was created in ramping mode (and so we don't want it to
+ * contribute to the pool generation's newSize and so provoke a
+ * collection via TracePoll), and by hash array allocations (where we
+ * don't want the allocation to provoke a collection that makes the
+ * location dependency stale immediately).
*/
typedef struct amcSegStruct *amcSeg;
@@ -88,7 +94,8 @@ typedef struct amcSegStruct {
GCSegStruct gcSegStruct; /* superclass fields must come first */
amcGen gen; /* generation this segment belongs to */
Nailboard board; /* nailboard for this segment or NULL if none */
- Bool new; /* .seg-ramp-new */
+ BOOLFIELD(old); /* .seg.old */
+ BOOLFIELD(deferred); /* .seg.deferred */
Sig sig; /* */
} amcSegStruct;
@@ -96,6 +103,7 @@ typedef struct amcSegStruct {
#define amcSeg2Seg(amcseg) ((Seg)(amcseg))
+ATTRIBUTE_UNUSED
static Bool amcSegCheck(amcSeg amcseg)
{
CHECKS(amcSeg, amcseg);
@@ -105,7 +113,8 @@ static Bool amcSegCheck(amcSeg amcseg)
CHECKD(Nailboard, amcseg->board);
CHECKL(SegNailed(amcSeg2Seg(amcseg)) != TraceSetEMPTY);
}
- CHECKL(BoolCheck(amcseg->new));
+ /* CHECKL(BoolCheck(amcseg->old)); */
+ /* CHECKL(BoolCheck(amcseg->deferred)); */
return TRUE;
}
@@ -140,7 +149,8 @@ static Res AMCSegInit(Seg seg, Pool pool, Addr base, Size size,
amcseg->gen = amcgen;
amcseg->board = NULL;
- amcseg->new = TRUE;
+ amcseg->old = FALSE;
+ amcseg->deferred = FALSE;
amcseg->sig = amcSegSig;
AVERT(amcSeg, amcseg);
@@ -453,7 +463,6 @@ typedef struct AMCStruct { /* */
RankSet rankSet; /* rankSet for entire pool */
RingStruct genRing; /* ring of generations */
Bool gensBooted; /* used during boot (init) */
- Chain chain; /* chain used by this pool */
size_t gens; /* number of generations */
amcGen *gen; /* (pointer to) array of generations */
amcGen nursery; /* the default mutator generation */
@@ -475,6 +484,7 @@ typedef struct AMCStruct { /* */
/* amcGenCheck -- check consistency of a generation structure */
+ATTRIBUTE_UNUSED
static Bool amcGenCheck(amcGen gen)
{
Arena arena;
@@ -486,9 +496,7 @@ static Bool amcGenCheck(amcGen gen)
CHECKU(AMC, amc);
CHECKD(Buffer, gen->forward);
CHECKD_NOSIG(Ring, &gen->amcRing);
- CHECKL((gen->pgen.totalSize == 0) == (gen->segs == 0));
arena = amc->poolStruct.arena;
- CHECKL(gen->pgen.totalSize >= gen->segs * ArenaAlign(arena));
return TRUE;
}
@@ -524,6 +532,7 @@ typedef struct amcBufStruct {
/* amcBufCheck -- check consistency of an amcBuf */
+ATTRIBUTE_UNUSED
static Bool amcBufCheck(amcBuf amcbuf)
{
CHECKS(amcBuf, amcbuf);
@@ -639,12 +648,12 @@ DEFINE_BUFFER_CLASS(amcBufClass, class)
/* amcGenCreate -- create a generation */
-static Res amcGenCreate(amcGen *genReturn, AMC amc, Serial genNr)
+static Res amcGenCreate(amcGen *genReturn, AMC amc, GenDesc gen)
{
Arena arena;
Buffer buffer;
Pool pool;
- amcGen gen;
+ amcGen amcgen;
Res res;
void *p;
@@ -654,25 +663,24 @@ static Res amcGenCreate(amcGen *genReturn, AMC amc, Serial genNr)
res = ControlAlloc(&p, arena, sizeof(amcGenStruct), FALSE);
if(res != ResOK)
goto failControlAlloc;
- gen = (amcGen)p;
+ amcgen = (amcGen)p;
res = BufferCreate(&buffer, EnsureamcBufClass(), pool, FALSE, argsNone);
if(res != ResOK)
goto failBufferCreate;
- res = PoolGenInit(&gen->pgen, amc->chain, genNr, pool);
+ res = PoolGenInit(&amcgen->pgen, gen, pool);
if(res != ResOK)
goto failGenInit;
- RingInit(&gen->amcRing);
- gen->segs = 0;
- gen->forward = buffer;
- gen->sig = amcGenSig;
+ RingInit(&amcgen->amcRing);
+ amcgen->forward = buffer;
+ amcgen->sig = amcGenSig;
- AVERT(amcGen, gen);
+ AVERT(amcGen, amcgen);
- RingAppend(&amc->genRing, &gen->amcRing);
- EVENT2(AMCGenCreate, amc, gen);
- *genReturn = gen;
+ RingAppend(&amc->genRing, &amcgen->amcRing);
+ EVENT2(AMCGenCreate, amc, amcgen);
+ *genReturn = amcgen;
return ResOK;
failGenInit:
@@ -691,8 +699,6 @@ static void amcGenDestroy(amcGen gen)
Arena arena;
AVERT(amcGen, gen);
- AVER(gen->segs == 0);
- AVER(gen->pgen.totalSize == 0);
EVENT1(AMCGenDestroy, gen);
arena = PoolArena(amcGenPool(gen));
@@ -715,11 +721,10 @@ static Res amcGenDescribe(amcGen gen, mps_lib_FILE *stream)
return ResFAIL;
res = WriteF(stream,
- " amcGen $P ($U) {\n",
- (WriteFP)gen, (WriteFU)amcGenNr(gen),
+ " amcGen $P {\n", (WriteFP)gen,
" buffer $P\n", gen->forward,
" segs $U, totalSize $U, newSize $U\n",
- (WriteFU)gen->segs,
+ (WriteFU)gen->pgen.segs,
(WriteFU)gen->pgen.totalSize,
(WriteFU)gen->pgen.newSize,
" } amcGen\n", NULL);
@@ -798,6 +803,7 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args)
size_t genArraySize;
size_t genCount;
Bool interior = AMC_INTERIOR_DEFAULT;
+ Chain chain;
ArgStruct arg;
/* Suppress a warning about this structure not being used when there
@@ -818,14 +824,14 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args)
ArgRequire(&arg, args, MPS_KEY_FORMAT);
pool->format = arg.val.format;
if (ArgPick(&arg, args, MPS_KEY_CHAIN))
- amc->chain = arg.val.chain;
+ chain = arg.val.chain;
else
- amc->chain = ArenaGlobals(arena)->defaultChain;
+ chain = ArenaGlobals(arena)->defaultChain;
if (ArgPick(&arg, args, MPS_KEY_INTERIOR))
interior = arg.val.b;
AVERT(Format, pool->format);
- AVERT(Chain, amc->chain);
+ AVERT(Chain, chain);
pool->alignment = pool->format->alignment;
amc->rankSet = rankSet;
@@ -861,7 +867,7 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args)
AVERT(AMC, amc);
/* Init generations. */
- genCount = ChainGens(amc->chain);
+ genCount = ChainGens(chain);
{
void *p;
@@ -871,11 +877,10 @@ static Res amcInitComm(Pool pool, RankSet rankSet, ArgList args)
if(res != ResOK)
goto failGensAlloc;
amc->gen = p;
- for(i = 0; i < genCount + 1; ++i) {
- res = amcGenCreate(&amc->gen[i], amc, (Serial)i);
- if(res != ResOK) {
+ for (i = 0; i <= genCount; ++i) {
+ res = amcGenCreate(&amc->gen[i], amc, ChainGen(chain, i));
+ if (res != ResOK)
goto failGenAlloc;
- }
}
/* Set up forwarding buffers. */
for(i = 0; i < genCount; ++i) {
@@ -941,21 +946,19 @@ static void AMCFinish(Pool pool)
RING_FOR(node, &amc->genRing, nextNode) {
amcGen gen = RING_ELT(amcGen, amcRing, node);
BufferDetach(gen->forward, pool);
- /* Maintain invariant < totalSize. */
- gen->pgen.newSize = (Size)0;
}
ring = PoolSegRing(pool);
RING_FOR(node, ring, nextNode) {
Seg seg = SegOfPoolRing(node);
- Size size;
amcGen gen = amcSegGen(seg);
-
- --gen->segs;
- size = SegSize(seg);
- gen->pgen.totalSize -= size;
-
- SegFree(seg);
+ amcSeg amcseg = Seg2amcSeg(seg);
+ AVERT(amcSeg, amcseg);
+ PoolGenFree(&gen->pgen, seg,
+ 0,
+ amcseg->old ? SegSize(seg) : 0,
+ amcseg->old ? 0 : SegSize(seg),
+ amcseg->deferred);
}
/* Disassociate forwarding buffers from gens before they are */
@@ -991,7 +994,6 @@ static Res AMCBufferFill(Addr *baseReturn, Addr *limitReturn,
amcGen gen;
PoolGen pgen;
amcBuf amcbuf;
- Bool isRamping;
AVERT(Pool, pool);
amc = Pool2AMC(pool);
@@ -1012,13 +1014,13 @@ static Res AMCBufferFill(Addr *baseReturn, Addr *limitReturn,
pgen = &gen->pgen;
/* Create and attach segment. The location of this segment is */
- /* expressed as a generation number. We rely on the arena to */
+ /* expressed via the pool generation. We rely on the arena to */
/* organize locations appropriately. */
alignedSize = SizeAlignUp(size, ArenaAlign(arena));
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD_FIELD(args, amcKeySegGen, p, gen);
- res = ChainAlloc(&seg, amc->chain, PoolGenNr(pgen), amcSegClassGet(),
- alignedSize, pool, withReservoirPermit, args);
+ res = PoolGenAlloc(&seg, pgen, amcSegClassGet(), alignedSize,
+ withReservoirPermit, args);
} MPS_ARGS_END(args);
if(res != ResOK)
return res;
@@ -1030,23 +1032,17 @@ static Res AMCBufferFill(Addr *baseReturn, Addr *limitReturn,
else
SegSetRankAndSummary(seg, BufferRankSet(buffer), RefSetUNIV);
- /* Put the segment in the generation indicated by the buffer. */
- ++gen->segs;
- pgen->totalSize += alignedSize;
-
- /* If ramping, or if the buffer is intended for allocating
- hash table arrays, don't count it towards newSize. */
- isRamping = (amc->rampMode == RampRAMPING &&
- buffer == amc->rampGen->forward &&
- gen == amc->rampGen);
- if (isRamping || amcbuf->forHashArrays) {
- Seg2amcSeg(seg)->new = FALSE;
- } else {
- pgen->newSize += alignedSize;
+ /* If ramping, or if the buffer is intended for allocating hash
+ * table arrays, defer the size accounting. */
+ if ((amc->rampMode == RampRAMPING
+ && buffer == amc->rampGen->forward
+ && gen == amc->rampGen)
+ || amcbuf->forHashArrays)
+ {
+ Seg2amcSeg(seg)->deferred = TRUE;
}
base = SegBase(seg);
- *baseReturn = base;
if(alignedSize < AMCLargeSegPAGES * ArenaAlign(arena)) {
/* Small or Medium segment: give the buffer the entire seg. */
limit = AddrAdd(base, alignedSize);
@@ -1068,6 +1064,9 @@ static Res AMCBufferFill(Addr *baseReturn, Addr *limitReturn,
ShieldCover(arena, seg);
}
}
+
+ PoolGenAccountForFill(pgen, SegSize(seg), Seg2amcSeg(seg)->deferred);
+ *baseReturn = base;
*limitReturn = limit;
return ResOK;
}
@@ -1110,6 +1109,11 @@ static void AMCBufferEmpty(Pool pool, Buffer buffer,
(*pool->format->pad)(init, size);
ShieldCover(arena, seg);
}
+
+ /* The unused part of the buffer is not reused by AMC, so we pass 0
+ * for the unused argument. This call therefore has no effect on the
+ * accounting, but we call it anyway for consistency. */
+ PoolGenAccountForEmpty(&amcSegGen(seg)->pgen, 0, Seg2amcSeg(seg)->deferred);
}
@@ -1173,16 +1177,19 @@ static void AMCRampEnd(Pool pool, Buffer buf)
NOTREACHED;
}
- /* Adjust amc->rampGen->pgen.newSize: Now count all the segments */
- /* in the ramp generation as new (except if they're white). */
+ /* Now all the segments in the ramp generation contribute to the
+ * pool generation's sizes. */
RING_FOR(node, PoolSegRing(pool), nextNode) {
Seg seg = SegOfPoolRing(node);
-
- if(amcSegGen(seg) == amc->rampGen && !Seg2amcSeg(seg)->new
+ amcSeg amcseg = Seg2amcSeg(seg);
+ if(amcSegGen(seg) == amc->rampGen
+ && amcseg->deferred
&& SegWhite(seg) == TraceSetEMPTY)
{
- pgen->newSize += SegSize(seg);
- Seg2amcSeg(seg)->new = TRUE;
+ PoolGenUndefer(pgen,
+ amcseg->old ? SegSize(seg) : 0,
+ amcseg->old ? 0 : SegSize(seg));
+ amcseg->deferred = FALSE;
}
}
}
@@ -1196,14 +1203,17 @@ static void AMCRampEnd(Pool pool, Buffer buf)
*/
static Res AMCWhiten(Pool pool, Trace trace, Seg seg)
{
+ Size condemned = 0;
amcGen gen;
AMC amc;
Buffer buffer;
+ amcSeg amcseg;
Res res;
AVERT(Pool, pool);
AVERT(Trace, trace);
AVERT(Seg, seg);
+ amcseg = Seg2amcSeg(seg);
buffer = SegBuffer(seg);
if(buffer != NULL) {
@@ -1259,14 +1269,14 @@ static Res AMCWhiten(Pool pool, Trace trace, Seg seg)
/* @@@@ We could subtract all the nailed grains. */
/* Relies on unsigned arithmetic wrapping round */
/* on under- and overflow (which it does). */
- trace->condemned -= AddrOffset(BufferScanLimit(buffer),
- BufferLimit(buffer));
+ condemned -= AddrOffset(BufferScanLimit(buffer), BufferLimit(buffer));
}
}
}
SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
- trace->condemned += SegSize(seg);
+ condemned += SegSize(seg);
+ trace->condemned += condemned;
amc = Pool2AMC(pool);
AVERT(AMC, amc);
@@ -1290,9 +1300,9 @@ static Res AMCWhiten(Pool pool, Trace trace, Seg seg)
gen = amcSegGen(seg);
AVERT(amcGen, gen);
- if(Seg2amcSeg(seg)->new) {
- gen->pgen.newSize -= SegSize(seg);
- Seg2amcSeg(seg)->new = FALSE;
+ if (!amcseg->old) {
+ PoolGenAccountForAge(&gen->pgen, SegSize(seg), amcseg->deferred);
+ amcseg->old = TRUE;
}
/* Ensure we are forwarding into the right generation. */
@@ -1719,10 +1729,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)));
/* */
(void)AddrCopy(newRef, ref, length); /* .exposed.seg */
@@ -1867,10 +1880,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)));
/* */
(void)AddrCopy(newBase, AddrSub(ref, headerSize), length); /* .exposed.seg */
@@ -1987,9 +2003,7 @@ static void amcReclaimNailed(Pool pool, Trace trace, Seg seg)
/* We may not free a buffered seg. */
AVER(SegBuffer(seg) == NULL);
- --gen->segs;
- gen->pgen.totalSize -= SegSize(seg);
- SegFree(seg);
+ PoolGenFree(&gen->pgen, seg, 0, SegSize(seg), 0, Seg2amcSeg(seg)->deferred);
} else {
/* Seg retained */
STATISTIC_STAT( {
@@ -2033,7 +2047,6 @@ static void AMCReclaim(Pool pool, Trace trace, Seg seg)
{
AMC amc;
amcGen gen;
- Size size;
AVERT_CRITICAL(Pool, pool);
amc = Pool2AMC(pool);
@@ -2066,13 +2079,9 @@ static void AMCReclaim(Pool pool, Trace trace, Seg seg)
/* segs should have been nailed anyway). */
AVER(SegBuffer(seg) == NULL);
- --gen->segs;
- size = SegSize(seg);
- gen->pgen.totalSize -= size;
+ trace->reclaimSize += SegSize(seg);
- trace->reclaimSize += size;
-
- SegFree(seg);
+ PoolGenFree(&gen->pgen, seg, 0, SegSize(seg), 0, Seg2amcSeg(seg)->deferred);
}
@@ -2445,6 +2454,8 @@ void mps_amc_apply(mps_pool_t mps_pool,
*
* See .
*/
+
+ATTRIBUTE_UNUSED
static Bool AMCCheck(AMC amc)
{
CHECKS(AMC, amc);
diff --git a/mps/code/poolams.c b/mps/code/poolams.c
index c67a2efd684..b5e942c7e84 100644
--- a/mps/code/poolams.c
+++ b/mps/code/poolams.c
@@ -55,7 +55,7 @@ Bool AMSSegCheck(AMSSeg amsseg)
CHECKL(amsseg->grains == AMSGrains(amsseg->ams, SegSize(seg)));
CHECKL(amsseg->grains > 0);
- CHECKL(amsseg->grains >= amsseg->free + amsseg->newAlloc);
+ CHECKL(amsseg->grains == amsseg->freeGrains + amsseg->oldGrains + amsseg->newGrains);
CHECKL(BoolCheck(amsseg->allocTableInUse));
if (!amsseg->allocTableInUse)
@@ -74,6 +74,11 @@ Bool AMSSegCheck(AMSSeg amsseg)
CHECKD_NOSIG(BT, amsseg->nongreyTable);
CHECKD_NOSIG(BT, amsseg->nonwhiteTable);
+ /* If tables are shared, they mustn't both be in use. */
+ CHECKL(!(amsseg->ams->shareAllocTable
+ && amsseg->allocTableInUse
+ && amsseg->colourTablesInUse));
+
return TRUE;
}
@@ -89,7 +94,7 @@ void AMSSegFreeWalk(AMSSeg amsseg, FreeBlockStepMethod f, void *p)
pool = SegPool(AMSSeg2Seg(amsseg));
seg = AMSSeg2Seg(amsseg);
- if (amsseg->free == 0)
+ if (amsseg->freeGrains == 0)
return;
if (amsseg->allocTableInUse) {
Index base, limit, next;
@@ -102,10 +107,8 @@ void AMSSegFreeWalk(AMSSeg amsseg, FreeBlockStepMethod f, void *p)
(*f)(AMS_INDEX_ADDR(seg, base), AMS_INDEX_ADDR(seg, limit), pool, p);
next = limit + 1;
}
- } else {
- if ( amsseg->firstFree < amsseg->grains )
- (*f)(AMS_INDEX_ADDR(seg, amsseg->firstFree), SegLimit(seg), pool, p);
- }
+ } else if (amsseg->firstFree < amsseg->grains)
+ (*f)(AMS_INDEX_ADDR(seg, amsseg->firstFree), SegLimit(seg), pool, p);
}
@@ -124,7 +127,7 @@ void AMSSegFreeCheck(AMSSeg amsseg)
AVERT(AMSSeg, amsseg);
- if (amsseg->free == 0)
+ if (amsseg->freeGrains == 0)
return;
/* If it's not a debug class, don't bother walking. */
@@ -167,6 +170,15 @@ static Res amsCreateTables(AMS ams, BT *allocReturn,
goto failWhite;
}
+#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;
*nonwhiteReturn = nonwhiteTable;
@@ -227,8 +239,9 @@ static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size,
goto failNextMethod;
amsseg->grains = size >> ams->grainShift;
- amsseg->free = amsseg->grains;
- amsseg->newAlloc = (Count)0;
+ amsseg->freeGrains = amsseg->grains;
+ amsseg->oldGrains = (Count)0;
+ amsseg->newGrains = (Count)0;
amsseg->marksChanged = FALSE; /* */
amsseg->ambiguousFixes = FALSE;
@@ -249,7 +262,6 @@ static Res AMSSegInit(Seg seg, Pool pool, Addr base, Size size,
&amsseg->segRing);
amsseg->sig = AMSSegSig;
- ams->size += size;
AVERT(AMSSeg, amsseg);
return ResOK;
@@ -285,8 +297,6 @@ static void AMSSegFinish(Seg seg)
RingRemove(&amsseg->segRing);
RingFinish(&amsseg->segRing);
- AVER(ams->size >= SegSize(seg));
- ams->size -= SegSize(seg);
amsseg->sig = SigInvalid;
/* finish the superclass fields last */
@@ -345,7 +355,7 @@ static Res AMSSegMerge(Seg seg, Seg segHi,
/* checks for .grain-align */
AVER(allGrains == AddrOffset(base, limit) >> ams->grainShift);
/* checks for .empty */
- AVER(amssegHi->free == hiGrains);
+ AVER(amssegHi->freeGrains == hiGrains);
AVER(!amssegHi->marksChanged);
/* .alloc-early */
@@ -379,8 +389,9 @@ static Res AMSSegMerge(Seg seg, Seg segHi,
MERGE_TABLES(nonwhiteTable, BTSetRange);
amsseg->grains = allGrains;
- amsseg->free = amsseg->free + amssegHi->free;
- amsseg->newAlloc = amsseg->newAlloc + amssegHi->newAlloc;
+ amsseg->freeGrains = amsseg->freeGrains + amssegHi->freeGrains;
+ amsseg->oldGrains = amsseg->oldGrains + amssegHi->oldGrains;
+ amsseg->newGrains = amsseg->newGrains + amssegHi->newGrains;
/* other fields in amsseg are unaffected */
RingRemove(&amssegHi->segRing);
@@ -388,6 +399,7 @@ static Res AMSSegMerge(Seg seg, Seg segHi,
amssegHi->sig = SigInvalid;
AVERT(AMSSeg, amsseg);
+ PoolGenAccountForSegMerge(&ams->pgen);
return ResOK;
failSuper:
@@ -429,7 +441,7 @@ static Res AMSSegSplit(Seg seg, Seg segHi,
/* checks for .grain-align */
AVER(allGrains == amsseg->grains);
/* checks for .empty */
- AVER(amsseg->free >= hiGrains);
+ AVER(amsseg->freeGrains >= hiGrains);
if (amsseg->allocTableInUse) {
AVER(BTIsResRange(amsseg->allocTable, loGrains, allGrains));
} else {
@@ -471,9 +483,11 @@ static Res AMSSegSplit(Seg seg, Seg segHi,
amsseg->grains = loGrains;
amssegHi->grains = hiGrains;
- amsseg->free -= hiGrains;
- amssegHi->free = hiGrains;
- amssegHi->newAlloc = (Count)0;
+ AVER(amsseg->freeGrains >= hiGrains);
+ amsseg->freeGrains -= hiGrains;
+ amssegHi->freeGrains = hiGrains;
+ amssegHi->oldGrains = (Count)0;
+ amssegHi->newGrains = (Count)0;
amssegHi->marksChanged = FALSE; /* */
amssegHi->ambiguousFixes = FALSE;
@@ -491,6 +505,7 @@ static Res AMSSegSplit(Seg seg, Seg segHi,
amssegHi->sig = AMSSegSig;
AVERT(AMSSeg, amsseg);
AVERT(AMSSeg, amssegHi);
+ PoolGenAccountForSegSplit(&ams->pgen);
return ResOK;
failSuper:
@@ -539,6 +554,9 @@ static Res AMSSegDescribe(Seg seg, mps_lib_FILE *stream)
res = WriteF(stream,
" AMS $P\n", (WriteFP)amsseg->ams,
" grains $W\n", (WriteFW)amsseg->grains,
+ " freeGrains $W\n", (WriteFW)amsseg->freeGrains,
+ " oldGrains $W\n", (WriteFW)amsseg->oldGrains,
+ " newGrains $W\n", (WriteFW)amsseg->newGrains,
NULL);
if (res != ResOK) return res;
if (amsseg->allocTableInUse)
@@ -677,14 +695,14 @@ static Res AMSSegCreate(Seg *segReturn, Pool pool, Size size,
if (res != ResOK)
goto failSize;
- res = ChainAlloc(&seg, ams->chain, ams->pgen.nr, (*ams->segClass)(),
- prefSize, pool, withReservoirPermit, argsNone);
+ res = PoolGenAlloc(&seg, &ams->pgen, (*ams->segClass)(), prefSize,
+ withReservoirPermit, argsNone);
if (res != ResOK) { /* try to allocate one that's just large enough */
Size minSize = SizeAlignUp(size, ArenaAlign(arena));
if (minSize == prefSize)
goto failSeg;
- res = ChainAlloc(&seg, ams->chain, ams->pgen.nr, (*ams->segClass)(),
- prefSize, pool, withReservoirPermit, argsNone);
+ res = PoolGenAlloc(&seg, &ams->pgen, (*ams->segClass)(), prefSize,
+ withReservoirPermit, argsNone);
if (res != ResOK)
goto failSeg;
}
@@ -717,9 +735,15 @@ static void AMSSegsDestroy(AMS ams)
ring = PoolSegRing(AMS2Pool(ams));
RING_FOR(node, ring, next) {
Seg seg = SegOfPoolRing(node);
- AVER(Seg2AMSSeg(seg)->ams == ams);
- AMSSegFreeCheck(Seg2AMSSeg(seg));
- SegFree(seg);
+ AMSSeg amsseg = Seg2AMSSeg(seg);
+ AVERT(AMSSeg, amsseg);
+ AVER(amsseg->ams == ams);
+ AMSSegFreeCheck(amsseg);
+ PoolGenFree(&ams->pgen, seg,
+ AMSGrainsSize(ams, amsseg->freeGrains),
+ AMSGrainsSize(ams, amsseg->oldGrains),
+ AMSGrainsSize(ams, amsseg->newGrains),
+ FALSE);
}
}
@@ -808,8 +832,7 @@ Res AMSInitInternal(AMS ams, Format format, Chain chain, unsigned gen,
pool->alignment = pool->format->alignment;
ams->grainShift = SizeLog2(PoolAlignment(pool));
- ams->chain = chain;
- res = PoolGenInit(&ams->pgen, ams->chain, gen, pool);
+ res = PoolGenInit(&ams->pgen, ChainGen(chain, gen), pool);
if (res != ResOK)
return res;
@@ -823,8 +846,6 @@ Res AMSInitInternal(AMS ams, Format format, Chain chain, unsigned gen,
ams->segsDestroy = AMSSegsDestroy;
ams->segClass = AMSSegClassGet;
- ams->size = 0;
-
ams->sig = AMSSig;
AVERT(AMS, ams);
return ResOK;
@@ -891,15 +912,17 @@ static Bool amsSegAlloc(Index *baseReturn, Index *limitReturn,
} else {
if (amsseg->firstFree > amsseg->grains - grains)
return FALSE;
- base = amsseg->firstFree; limit = amsseg->grains;
+ base = amsseg->firstFree;
+ limit = amsseg->grains;
amsseg->firstFree = limit;
}
/* We don't place buffers on white segments, so no need to adjust colour. */
AVER(!amsseg->colourTablesInUse);
- amsseg->free -= limit - base;
- amsseg->newAlloc += limit - base;
+ AVER(amsseg->freeGrains >= limit - base);
+ amsseg->freeGrains -= limit - base;
+ amsseg->newGrains += limit - base;
*baseReturn = base;
*limitReturn = limit;
return TRUE;
@@ -945,12 +968,15 @@ static Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
RING_FOR(node, ring, nextNode) {
AMSSeg amsseg = RING_ELT(AMSSeg, segRing, node);
AVERT_CRITICAL(AMSSeg, amsseg);
- if (amsseg->free >= AMSGrains(ams, size)) {
+ if (amsseg->freeGrains >= AMSGrains(ams, size)) {
seg = AMSSeg2Seg(amsseg);
- if (SegRankSet(seg) == rankSet && SegBuffer(seg) == NULL
+ if (SegRankSet(seg) == rankSet
+ && SegBuffer(seg) == NULL
/* Can't use a white or grey segment, see d.m.p.fill.colour. */
- && SegWhite(seg) == TraceSetEMPTY && SegGrey(seg) == TraceSetEMPTY) {
+ && SegWhite(seg) == TraceSetEMPTY
+ && SegGrey(seg) == TraceSetEMPTY)
+ {
b = amsSegAlloc(&base, &limit, seg, size);
if (b)
goto found;
@@ -970,10 +996,10 @@ static Res AMSBufferFill(Addr *baseReturn, Addr *limitReturn,
baseAddr = AMS_INDEX_ADDR(seg, base); limitAddr = AMS_INDEX_ADDR(seg, limit);
DebugPoolFreeCheck(pool, baseAddr, limitAddr);
allocatedSize = AddrOffset(baseAddr, limitAddr);
- ams->pgen.totalSize += allocatedSize;
- ams->pgen.newSize += allocatedSize;
- *baseReturn = baseAddr; *limitReturn = limitAddr;
+ PoolGenAccountForFill(&ams->pgen, allocatedSize, FALSE);
+ *baseReturn = baseAddr;
+ *limitReturn = limitAddr;
return ResOK;
}
@@ -1023,7 +1049,20 @@ 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 { /* start using allocTable */
+ } 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 AMSWhiten); 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 AMSWhiten). 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);
if (amsseg->firstFree < amsseg->grains)
@@ -1035,20 +1074,19 @@ static void AMSBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
if (amsseg->colourTablesInUse)
AMS_RANGE_WHITEN(seg, initIndex, limitIndex);
- amsseg->free += limitIndex - initIndex;
- /* The unused portion of the buffer must be new, since it's not condemned. */
- AVER(amsseg->newAlloc >= limitIndex - initIndex);
- amsseg->newAlloc -= limitIndex - initIndex;
+ amsseg->freeGrains += limitIndex - initIndex;
+ /* Unused portion of the buffer must be new, since it's not condemned. */
+ AVER(amsseg->newGrains >= limitIndex - initIndex);
+ amsseg->newGrains -= limitIndex - initIndex;
size = AddrOffset(init, limit);
- ams->pgen.totalSize -= size;
- ams->pgen.newSize -= size;
+ PoolGenAccountForEmpty(&ams->pgen, size, FALSE);
}
-/* amsRangeCondemn -- Condemn a part of an AMS segment
+/* amsRangeWhiten -- Condemn a part of an AMS segment
* Allow calling it with base = limit, to simplify the callers.
*/
-static void amsRangeCondemn(Seg seg, Index base, Index limit)
+static void amsRangeWhiten(Seg seg, Index base, Index limit)
{
if (base != limit) {
AMSSeg amsseg = Seg2AMSSeg(seg);
@@ -1061,9 +1099,9 @@ static void amsRangeCondemn(Seg seg, Index base, Index limit)
}
-/* AMSCondemn -- the pool class segment condemning method */
+/* AMSWhiten -- the pool class segment condemning method */
-static Res AMSCondemn(Pool pool, Trace trace, Seg seg)
+static Res AMSWhiten(Pool pool, Trace trace, Seg seg)
{
AMS ams;
AMSSeg amsseg;
@@ -1113,23 +1151,24 @@ static Res AMSCondemn(Pool pool, Trace trace, Seg seg)
scanLimitIndex = AMS_ADDR_INDEX(seg, BufferScanLimit(buffer));
limitIndex = AMS_ADDR_INDEX(seg, BufferLimit(buffer));
- amsRangeCondemn(seg, 0, scanLimitIndex);
+ amsRangeWhiten(seg, 0, scanLimitIndex);
if (scanLimitIndex < limitIndex)
AMS_RANGE_BLACKEN(seg, scanLimitIndex, limitIndex);
- amsRangeCondemn(seg, limitIndex, amsseg->grains);
+ amsRangeWhiten(seg, limitIndex, amsseg->grains);
/* We didn't condemn the buffer, subtract it from the count. */
uncondemned = limitIndex - scanLimitIndex;
} else { /* condemn whole seg */
- amsRangeCondemn(seg, 0, amsseg->grains);
+ amsRangeWhiten(seg, 0, amsseg->grains);
uncondemned = (Count)0;
}
- trace->condemned += SegSize(seg) - AMSGrainsSize(ams, uncondemned);
- /* The unused part of the buffer is new allocation by definition. */
- ams->pgen.newSize -= AMSGrainsSize(ams, amsseg->newAlloc - uncondemned);
- amsseg->newAlloc = uncondemned;
+ /* The unused part of the buffer remains new: the rest becomes old. */
+ PoolGenAccountForAge(&ams->pgen, AMSGrainsSize(ams, amsseg->newGrains - uncondemned), FALSE);
+ amsseg->oldGrains += amsseg->newGrains - uncondemned;
+ amsseg->newGrains = uncondemned;
amsseg->marksChanged = FALSE; /* */
amsseg->ambiguousFixes = FALSE;
+ trace->condemned += AMSGrainsSize(ams, amsseg->oldGrains);
SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
@@ -1415,16 +1454,20 @@ static Res AMSFix(Pool pool, ScanState ss, Seg seg, Ref *refIO)
/* doing that here (this can be called from RootScan, during flip). */
clientRef = *refIO;
+ AVER_CRITICAL(SegBase(seg) <= clientRef);
+ AVER_CRITICAL(clientRef < SegLimit(seg)); /* see .ref-limit */
base = AddrSub((Addr)clientRef, format->headerSize);
/* can get an ambiguous reference too close to the base of the
* segment, so when we subtract the header we are not in the
* segment any longer. This isn't a real reference,
* so we can just skip it. */
if (base < SegBase(seg)) {
- return ResOK;
+ AVER_CRITICAL(ss->rank == RankAMBIG);
+ return ResOK;
}
i = AMS_ADDR_INDEX(seg, base);
+ AVER_CRITICAL(i < amsseg->grains);
AVER_CRITICAL(!AMS_IS_INVALID_COLOUR(seg, i));
ss->wasMarked = TRUE;
@@ -1531,8 +1574,7 @@ static void AMSReclaim(Pool pool, Trace trace, Seg seg)
{
AMS ams;
AMSSeg amsseg;
- Count nowFree, grains;
- Size reclaimedSize;
+ Count nowFree, grains, reclaimedGrains;
PoolDebugMixin debug;
AVERT(Pool, pool);
@@ -1577,20 +1619,26 @@ static void AMSReclaim(Pool pool, Trace trace, Seg seg)
}
}
- reclaimedSize = (nowFree - amsseg->free) << ams->grainShift;
- amsseg->free = nowFree;
- trace->reclaimSize += reclaimedSize;
- ams->pgen.totalSize -= reclaimedSize;
+ reclaimedGrains = nowFree - amsseg->freeGrains;
+ AVER(amsseg->oldGrains >= reclaimedGrains);
+ amsseg->oldGrains -= reclaimedGrains;
+ amsseg->freeGrains += reclaimedGrains;
+ PoolGenAccountForReclaim(&ams->pgen, AMSGrainsSize(ams, reclaimedGrains), FALSE);
+ trace->reclaimSize += AMSGrainsSize(ams, reclaimedGrains);
/* preservedInPlaceCount is updated on fix */
- trace->preservedInPlaceSize += (grains - amsseg->free) << ams->grainShift;
+ trace->preservedInPlaceSize += AMSGrainsSize(ams, amsseg->oldGrains);
- if (amsseg->free == grains && SegBuffer(seg) == NULL) {
+ /* Ensure consistency of segment even if are just about to free it */
+ amsseg->colourTablesInUse = FALSE;
+ SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace));
+
+ if (amsseg->freeGrains == grains && SegBuffer(seg) == NULL)
/* No survivors */
- SegFree(seg);
- } else {
- amsseg->colourTablesInUse = FALSE;
- SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace));
- }
+ PoolGenFree(&ams->pgen, seg,
+ AMSGrainsSize(ams, amsseg->freeGrains),
+ AMSGrainsSize(ams, amsseg->oldGrains),
+ AMSGrainsSize(ams, amsseg->newGrains),
+ FALSE);
}
@@ -1631,11 +1679,7 @@ static Res AMSDescribe(Pool pool, mps_lib_FILE *stream)
"AMS $P {\n", (WriteFP)ams,
" pool $P ($U)\n",
(WriteFP)pool, (WriteFU)pool->serial,
- " size $W\n",
- (WriteFW)ams->size,
" grain shift $U\n", (WriteFU)ams->grainShift,
- " chain $P\n",
- (WriteFP)ams->chain,
NULL);
if (res != ResOK) return res;
@@ -1679,7 +1723,7 @@ DEFINE_CLASS(AMSPoolClass, this)
this->bufferClass = RankBufClassGet;
this->bufferFill = AMSBufferFill;
this->bufferEmpty = AMSBufferEmpty;
- this->whiten = AMSCondemn;
+ this->whiten = AMSWhiten;
this->blacken = AMSBlacken;
this->scan = AMSScan;
this->fix = AMSFix;
@@ -1727,11 +1771,9 @@ Bool AMSCheck(AMS ams)
CHECKS(AMS, ams);
CHECKD(Pool, AMS2Pool(ams));
CHECKL(IsSubclassPoly(AMS2Pool(ams)->class, AMSPoolClassGet()));
- CHECKL(PoolAlignment(AMS2Pool(ams)) == ((Size)1 << ams->grainShift));
+ CHECKL(PoolAlignment(AMS2Pool(ams)) == AMSGrainsSize(ams, (Size)1));
CHECKL(PoolAlignment(AMS2Pool(ams)) == AMS2Pool(ams)->format->alignment);
- CHECKD(Chain, ams->chain);
CHECKD(PoolGen, &ams->pgen);
- CHECKL(SizeIsAligned(ams->size, ArenaAlign(PoolArena(AMS2Pool(ams)))));
CHECKL(FUNCHECK(ams->segSize));
CHECKD_NOSIG(Ring, &ams->segRing);
CHECKL(FUNCHECK(ams->allocRing));
diff --git a/mps/code/poolams.h b/mps/code/poolams.h
index 96cec6c6c7b..8c567910b77 100644
--- a/mps/code/poolams.h
+++ b/mps/code/poolams.h
@@ -41,7 +41,6 @@ typedef Res (*AMSSegSizePolicyFunction)(Size *sizeReturn,
typedef struct AMSStruct {
PoolStruct poolStruct; /* generic pool structure */
Shift grainShift; /* log2 of grain size */
- Chain chain; /* chain used by this pool */
PoolGenStruct pgen; /* generation representing the pool */
Size size; /* total segment size of the pool */
AMSSegSizePolicyFunction segSize; /* SegSize policy */
@@ -58,9 +57,10 @@ typedef struct AMSSegStruct {
GCSegStruct gcSegStruct; /* superclass fields must come first */
AMS ams; /* owning ams */
RingStruct segRing; /* ring that this seg belongs to */
- Count grains; /* number of grains */
- Count free; /* number of free grains */
- Count newAlloc; /* number of grains allocated since last GC */
+ Count grains; /* total grains */
+ Count freeGrains; /* free grains */
+ Count oldGrains; /* grains allocated prior to last collection */
+ Count newGrains; /* grains allocated since last collection */
Bool allocTableInUse; /* allocTable is used */
Index firstFree; /* 1st free grain, if allocTable is not used */
BT allocTable; /* set if grain is allocated */
diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c
index edcae788e3c..eb2b561eb4b 100644
--- a/mps/code/poolawl.c
+++ b/mps/code/poolawl.c
@@ -84,9 +84,7 @@ typedef Addr (*FindDependentMethod)(Addr object);
typedef struct AWLStruct {
PoolStruct poolStruct;
Shift alignShift;
- Chain chain; /* dummy chain */
PoolGenStruct pgen; /* generation representing the pool */
- Size size; /* allocated size in bytes */
Count succAccesses; /* number of successive single accesses */
FindDependentMethod findDependent; /* to find a dependent object */
awlStatTotalStruct stats;
@@ -94,6 +92,7 @@ typedef struct AWLStruct {
} AWLStruct, *AWL;
#define Pool2AWL(pool) PARENT(AWLStruct, poolStruct, pool)
+#define AWLGrainsSize(awl, grains) ((grains) << (awl)->alignShift)
static Bool AWLCheck(AWL awl);
@@ -102,6 +101,8 @@ static Bool AWLCheck(AWL awl);
/* Conversion between indexes and Addrs */
#define awlIndexOfAddr(base, awl, p) \
(AddrOffset((base), (p)) >> (awl)->alignShift)
+#define awlAddrOfIndex(base, awl, i) \
+ AddrAdd(base, AWLGrainsSize(awl, i))
/* AWLSegStruct -- AWL segment subclass
@@ -118,8 +119,10 @@ typedef struct AWLSegStruct {
BT scanned;
BT alloc;
Count grains;
- Count free; /* number of free grains */
- Count singleAccesses; /* number of accesses processed singly */
+ Count freeGrains; /* free grains */
+ Count oldGrains; /* grains allocated prior to last collection */
+ Count newGrains; /* grains allocated since last collection */
+ Count singleAccesses; /* number of accesses processed singly */
awlStatSegStruct stats;
Sig sig;
} AWLSegStruct, *AWLSeg;
@@ -131,6 +134,7 @@ typedef struct AWLSegStruct {
extern SegClass AWLSegClassGet(void);
+ATTRIBUTE_UNUSED
static Bool AWLSegCheck(AWLSeg awlseg)
{
CHECKS(AWLSeg, awlseg);
@@ -138,9 +142,8 @@ static Bool AWLSegCheck(AWLSeg awlseg)
CHECKL(awlseg->mark != NULL);
CHECKL(awlseg->scanned != NULL);
CHECKL(awlseg->alloc != NULL);
- /* Can't do any real check on ->grains */
CHECKL(awlseg->grains > 0);
- CHECKL(awlseg->free <= awlseg->grains);
+ CHECKL(awlseg->grains == awlseg->freeGrains + awlseg->oldGrains + awlseg->newGrains);
return TRUE;
}
@@ -223,10 +226,12 @@ static Res AWLSegInit(Seg seg, Pool pool, Addr base, Size size,
BTResRange(awlseg->scanned, 0, bits);
BTResRange(awlseg->alloc, 0, bits);
SegSetRankAndSummary(seg, rankSet, RefSetUNIV);
- awlseg->free = bits;
- awlseg->sig = AWLSegSig;
+ awlseg->freeGrains = bits;
+ awlseg->oldGrains = (Count)0;
+ awlseg->newGrains = (Count)0;
awlseg->singleAccesses = 0;
awlStatSegInit(awlseg);
+ awlseg->sig = AWLSegSig;
AVERT(AWLSeg, awlseg);
return ResOK;
@@ -305,10 +310,14 @@ DEFINE_SEG_CLASS(AWLSegClass, class)
* it's possible to tweak them in a debugger.
*/
+extern Count AWLSegSALimit;
Count AWLSegSALimit = AWL_SEG_SA_LIMIT;
+extern Bool AWLHaveSegSALimit;
Bool AWLHaveSegSALimit = AWL_HAVE_SEG_SA_LIMIT;
+extern Count AWLTotalSALimit;
Count AWLTotalSALimit = AWL_TOTAL_SA_LIMIT;
+extern Bool AWLHaveTotalSALimit;
Bool AWLHaveTotalSALimit = AWL_HAVE_TOTAL_SA_LIMIT;
@@ -468,8 +477,8 @@ static Res AWLSegCreate(AWLSeg *awlsegReturn,
return ResMEMORY;
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD_FIELD(args, awlKeySegRankSet, u, rankSet);
- res = ChainAlloc(&seg, awl->chain, awl->pgen.nr, AWLSegClassGet(),
- size, pool, reservoirPermit, args);
+ res = PoolGenAlloc(&seg, &awl->pgen, AWLSegClassGet(), size,
+ reservoirPermit, args);
} MPS_ARGS_END(args);
if (res != ResOK)
return res;
@@ -496,7 +505,7 @@ static Bool AWLSegAlloc(Addr *baseReturn, Addr *limitReturn,
AVERT(AWLSeg, awlseg);
AVERT(AWL, awl);
AVER(size > 0);
- AVER(size << awl->alignShift >= size);
+ AVER(AWLGrainsSize(awl, size) >= size);
seg = AWLSeg2Seg(awlseg);
if (size > SegSize(seg))
@@ -504,9 +513,8 @@ static Bool AWLSegAlloc(Addr *baseReturn, Addr *limitReturn,
n = size >> awl->alignShift;
if (!BTFindLongResRange(&i, &j, awlseg->alloc, 0, awlseg->grains, n))
return FALSE;
- awl->size += size;
- *baseReturn = AddrAdd(SegBase(seg), i << awl->alignShift);
- *limitReturn = AddrAdd(SegBase(seg), j << awl->alignShift);
+ *baseReturn = awlAddrOfIndex(SegBase(seg), awl, i);
+ *limitReturn = awlAddrOfIndex(SegBase(seg),awl, j);
return TRUE;
}
@@ -565,15 +573,12 @@ static Res AWLInit(Pool pool, ArgList args)
AVERT(Chain, chain);
AVER(gen <= ChainGens(chain));
- awl->chain = chain;
- res = PoolGenInit(&awl->pgen, chain, gen, pool);
+ res = PoolGenInit(&awl->pgen, ChainGen(chain, gen), pool);
if (res != ResOK)
goto failGenInit;
awl->alignShift = SizeLog2(PoolAlignment(pool));
- awl->size = (Size)0;
-
awl->succAccesses = 0;
awlStatTotalInit(awl);
awl->sig = AWLSig;
@@ -603,8 +608,13 @@ static void AWLFinish(Pool pool)
ring = &pool->segRing;
RING_FOR(node, ring, nextNode) {
Seg seg = SegOfPoolRing(node);
- AVERT(Seg, seg);
- SegFree(seg);
+ AWLSeg awlseg = Seg2AWLSeg(seg);
+ AVERT(AWLSeg, awlseg);
+ PoolGenFree(&awl->pgen, seg,
+ AWLGrainsSize(awl, awlseg->freeGrains),
+ AWLGrainsSize(awl, awlseg->oldGrains),
+ AWLGrainsSize(awl, awlseg->newGrains),
+ FALSE);
}
awl->sig = SigInvalid;
PoolGenFinish(&awl->pgen);
@@ -643,10 +653,11 @@ static Res AWLBufferFill(Addr *baseReturn, Addr *limitReturn,
/* Only try to allocate in the segment if it is not already */
/* buffered, and has the same ranks as the buffer. */
- if (SegBuffer(seg) == NULL && SegRankSet(seg) == BufferRankSet(buffer))
- if (awlseg->free << awl->alignShift >= size
- && AWLSegAlloc(&base, &limit, awlseg, awl, size))
- goto found;
+ if (SegBuffer(seg) == NULL
+ && SegRankSet(seg) == BufferRankSet(buffer)
+ && AWLGrainsSize(awl, awlseg->freeGrains) >= size
+ && AWLSegAlloc(&base, &limit, awlseg, awl, size))
+ goto found;
}
/* No free space in existing awlsegs, so create new awlseg */
@@ -670,7 +681,10 @@ static Res AWLBufferFill(Addr *baseReturn, Addr *limitReturn,
/* Shouldn't this depend on trace phase? @@@@ */
BTSetRange(awlseg->mark, i, j);
BTSetRange(awlseg->scanned, i, j);
- awlseg->free -= j - i;
+ AVER(awlseg->freeGrains >= j - i);
+ awlseg->freeGrains -= j - i;
+ awlseg->newGrains += j - i;
+ PoolGenAccountForFill(&awl->pgen, AddrOffset(base, limit), FALSE);
}
*baseReturn = base;
*limitReturn = limit;
@@ -706,7 +720,10 @@ static void AWLBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
AVER(i <= j);
if (i < j) {
BTResRange(awlseg->alloc, i, j);
- awlseg->free += j - i;
+ AVER(awlseg->newGrains >= j - i);
+ awlseg->newGrains -= j - i;
+ awlseg->freeGrains += j - i;
+ PoolGenAccountForEmpty(&awl->pgen, AddrOffset(init, limit), FALSE);
}
}
@@ -732,6 +749,7 @@ static Res AWLWhiten(Pool pool, Trace trace, Seg seg)
AWL awl;
AWLSeg awlseg;
Buffer buffer;
+ Count uncondemned;
/* All parameters checked by generic PoolWhiten. */
@@ -747,15 +765,13 @@ static Res AWLWhiten(Pool pool, Trace trace, Seg seg)
if(buffer == NULL) {
awlRangeWhiten(awlseg, 0, awlseg->grains);
- trace->condemned += SegSize(seg);
+ uncondemned = (Count)0;
} else {
/* Whiten everything except the buffer. */
Addr base = SegBase(seg);
- Index scanLimitIndex = awlIndexOfAddr(base, awl,
- BufferScanLimit(buffer));
- Index limitIndex = awlIndexOfAddr(base, awl,
- BufferLimit(buffer));
-
+ Index scanLimitIndex = awlIndexOfAddr(base, awl, BufferScanLimit(buffer));
+ Index limitIndex = awlIndexOfAddr(base, awl, BufferLimit(buffer));
+ uncondemned = limitIndex - scanLimitIndex;
awlRangeWhiten(awlseg, 0, scanLimitIndex);
awlRangeWhiten(awlseg, limitIndex, awlseg->grains);
@@ -766,14 +782,12 @@ static Res AWLWhiten(Pool pool, Trace trace, Seg seg)
AVER(BTIsSetRange(awlseg->mark, scanLimitIndex, limitIndex));
AVER(BTIsSetRange(awlseg->scanned, scanLimitIndex, limitIndex));
}
-
- /* We didn't condemn the buffer, subtract it from the count. */
- /* @@@@ We could subtract all the free grains. */
- trace->condemned += SegSize(seg)
- - AddrOffset(BufferScanLimit(buffer),
- BufferLimit(buffer));
}
+ PoolGenAccountForAge(&awl->pgen, AWLGrainsSize(awl, awlseg->newGrains - uncondemned), FALSE);
+ awlseg->oldGrains += awlseg->newGrains - uncondemned;
+ awlseg->newGrains = uncondemned;
+ trace->condemned += AWLGrainsSize(awl, awlseg->oldGrains);
SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
return ResOK;
}
@@ -1085,12 +1099,13 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg)
Addr base;
AWL awl;
AWLSeg awlseg;
+ Buffer buffer;
Index i;
Count oldFree;
Format format;
+ Count reclaimedGrains = (Count)0;
Count preservedInPlaceCount = (Count)0;
Size preservedInPlaceSize = (Size)0;
- Size freed; /* amount reclaimed, in bytes */
AVERT(Pool, pool);
AVERT(Trace, trace);
@@ -1104,8 +1119,10 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg)
format = pool->format;
base = SegBase(seg);
+ buffer = SegBuffer(seg);
- i = 0; oldFree = awlseg->free;
+ i = 0;
+ oldFree = awlseg->freeGrains;
while(i < awlseg->grains) {
Addr p, q;
Index j;
@@ -1114,16 +1131,13 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg)
++i;
continue;
}
- p = AddrAdd(base, i << awl->alignShift);
- if(SegBuffer(seg) != NULL) {
- Buffer buffer = SegBuffer(seg);
-
- if(p == BufferScanLimit(buffer)
- && BufferScanLimit(buffer) != BufferLimit(buffer))
- {
- i = awlIndexOfAddr(base, awl, BufferLimit(buffer));
- continue;
- }
+ p = awlAddrOfIndex(base, awl, i);
+ if (buffer != NULL
+ && p == BufferScanLimit(buffer)
+ && BufferScanLimit(buffer) != BufferLimit(buffer))
+ {
+ i = awlIndexOfAddr(base, awl, BufferLimit(buffer));
+ continue;
}
q = format->skip(AddrAdd(p, format->headerSize));
q = AddrSub(q, format->headerSize);
@@ -1140,20 +1154,30 @@ static void AWLReclaim(Pool pool, Trace trace, Seg seg)
BTResRange(awlseg->mark, i, j);
BTSetRange(awlseg->scanned, i, j);
BTResRange(awlseg->alloc, i, j);
- awlseg->free += j - i;
+ reclaimedGrains += j - i;
}
i = j;
}
AVER(i == awlseg->grains);
- freed = (awlseg->free - oldFree) << awl->alignShift;
- awl->size -= freed;
- trace->reclaimSize += freed;
+ AVER(reclaimedGrains <= awlseg->grains);
+ AVER(awlseg->oldGrains >= reclaimedGrains);
+ awlseg->oldGrains -= reclaimedGrains;
+ awlseg->freeGrains += reclaimedGrains;
+ PoolGenAccountForReclaim(&awl->pgen, AWLGrainsSize(awl, reclaimedGrains), FALSE);
+
+ trace->reclaimSize += AWLGrainsSize(awl, reclaimedGrains);
trace->preservedInPlaceCount += preservedInPlaceCount;
trace->preservedInPlaceSize += preservedInPlaceSize;
SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace));
- /* @@@@ never frees a segment, see job001687. */
- return;
+
+ if (awlseg->freeGrains == awlseg->grains && buffer == NULL)
+ /* No survivors */
+ PoolGenFree(&awl->pgen, seg,
+ AWLGrainsSize(awl, awlseg->freeGrains),
+ AWLGrainsSize(awl, awlseg->oldGrains),
+ AWLGrainsSize(awl, awlseg->newGrains),
+ FALSE);
}
@@ -1295,13 +1319,13 @@ mps_class_t mps_class_awl(void)
/* AWLCheck -- check an AWL pool */
+ATTRIBUTE_UNUSED
static Bool AWLCheck(AWL awl)
{
CHECKS(AWL, awl);
CHECKD(Pool, &awl->poolStruct);
CHECKL(awl->poolStruct.class == AWLPoolClassGet());
- CHECKL((Align)1 << awl->alignShift == awl->poolStruct.alignment);
- CHECKD(Chain, awl->chain);
+ CHECKL(AWLGrainsSize(awl, (Count)1) == awl->poolStruct.alignment);
/* Nothing to check about succAccesses. */
CHECKL(FUNCHECK(awl->findDependent));
/* Don't bother to check stats. */
diff --git a/mps/code/poollo.c b/mps/code/poollo.c
index d8f23584fba..c9b093c960e 100644
--- a/mps/code/poollo.c
+++ b/mps/code/poollo.c
@@ -24,13 +24,13 @@ typedef struct LOStruct *LO;
typedef struct LOStruct {
PoolStruct poolStruct; /* generic pool structure */
Shift alignShift; /* log_2 of pool alignment */
- Chain chain; /* chain used by this pool */
PoolGenStruct pgen; /* generation representing the pool */
Sig sig;
} LOStruct;
#define PoolPoolLO(pool) PARENT(LOStruct, poolStruct, pool)
#define LOPool(lo) (&(lo)->poolStruct)
+#define LOGrainsSize(lo, grains) ((grains) << (lo)->alignShift)
/* forward declaration */
@@ -48,8 +48,9 @@ typedef struct LOSegStruct {
LO lo; /* owning LO */
BT mark; /* mark bit table */
BT alloc; /* alloc bit table */
- Count free; /* number of free grains */
- Count newAlloc; /* number of grains allocated since last GC */
+ Count freeGrains; /* free grains */
+ Count oldGrains; /* grains allocated prior to last collection */
+ Count newGrains; /* grains allocated since last collection */
Sig sig; /* */
} LOSegStruct;
@@ -61,6 +62,7 @@ typedef struct LOSegStruct {
static Res loSegInit(Seg seg, Pool pool, Addr base, Size size,
Bool reservoirPermit, ArgList args);
static void loSegFinish(Seg seg);
+static Count loSegGrains(LOSeg loseg);
/* LOSegClass -- Class definition for LO segments */
@@ -79,6 +81,7 @@ DEFINE_SEG_CLASS(LOSegClass, class)
/* LOSegCheck -- check an LO segment */
+ATTRIBUTE_UNUSED
static Bool LOSegCheck(LOSeg loseg)
{
CHECKS(LOSeg, loseg);
@@ -87,8 +90,8 @@ static Bool LOSegCheck(LOSeg loseg)
CHECKL(loseg->mark != NULL);
CHECKL(loseg->alloc != NULL);
/* Could check exactly how many bits are set in the alloc table. */
- CHECKL(loseg->free + loseg->newAlloc
- <= SegSize(LOSegSeg(loseg)) >> loseg->lo->alignShift);
+ CHECKL(loseg->freeGrains + loseg->oldGrains + loseg->newGrains
+ == SegSize(LOSegSeg(loseg)) >> loseg->lo->alignShift);
return TRUE;
}
@@ -105,7 +108,7 @@ static Res loSegInit(Seg seg, Pool pool, Addr base, Size size,
Size tablebytes; /* # bytes in each control array */
Arena arena;
/* number of bits needed in each control array */
- Count bits;
+ Count grains;
void *p;
AVERT(Seg, seg);
@@ -125,8 +128,8 @@ static Res loSegInit(Seg seg, Pool pool, Addr base, Size size,
AVER(SegWhite(seg) == TraceSetEMPTY);
- bits = size >> lo->alignShift;
- tablebytes = BTSize(bits);
+ grains = size >> lo->alignShift;
+ tablebytes = BTSize(grains);
res = ControlAlloc(&p, arena, tablebytes, reservoirPermit);
if(res != ResOK)
goto failMarkTable;
@@ -135,11 +138,12 @@ static Res loSegInit(Seg seg, Pool pool, Addr base, Size size,
if(res != ResOK)
goto failAllocTable;
loseg->alloc = p;
- BTResRange(loseg->alloc, 0, bits);
- BTSetRange(loseg->mark, 0, bits);
+ BTResRange(loseg->alloc, 0, grains);
+ BTSetRange(loseg->mark, 0, grains);
loseg->lo = lo;
- loseg->free = bits;
- loseg->newAlloc = (Count)0;
+ loseg->freeGrains = grains;
+ loseg->oldGrains = (Count)0;
+ loseg->newGrains = (Count)0;
loseg->sig = LOSegSig;
AVERT(LOSeg, loseg);
return ResOK;
@@ -162,7 +166,7 @@ static void loSegFinish(Seg seg)
Pool pool;
Arena arena;
Size tablesize;
- Count bits;
+ Count grains;
AVERT(Seg, seg);
loseg = SegLOSeg(seg);
@@ -172,8 +176,8 @@ static void loSegFinish(Seg seg)
AVERT(LO, lo);
arena = PoolArena(pool);
- bits = SegSize(seg) >> lo->alignShift;
- tablesize = BTSize(bits);
+ grains = loSegGrains(loseg);
+ tablesize = BTSize(grains);
ControlFree(arena, (Addr)loseg->alloc, tablesize);
ControlFree(arena, (Addr)loseg->mark, tablesize);
loseg->sig = SigInvalid;
@@ -184,7 +188,8 @@ static void loSegFinish(Seg seg)
}
-static Count loSegBits(LOSeg loseg)
+ATTRIBUTE_UNUSED
+static Count loSegGrains(LOSeg loseg)
{
LO lo;
Size size;
@@ -203,7 +208,7 @@ static Count loSegBits(LOSeg loseg)
(AddrOffset((base), (p)) >> (lo)->alignShift)
#define loAddrOfIndex(base, lo, i) \
- (AddrAdd((base), (i) << (lo)->alignShift))
+ (AddrAdd((base), LOGrainsSize((lo), (i))))
/* loSegFree -- mark block from baseIndex to limitIndex free */
@@ -212,12 +217,11 @@ static void loSegFree(LOSeg loseg, Index baseIndex, Index limitIndex)
{
AVERT(LOSeg, loseg);
AVER(baseIndex < limitIndex);
- AVER(limitIndex <= loSegBits(loseg));
+ AVER(limitIndex <= loSegGrains(loseg));
AVER(BTIsSetRange(loseg->alloc, baseIndex, limitIndex));
BTResRange(loseg->alloc, baseIndex, limitIndex);
BTSetRange(loseg->mark, baseIndex, limitIndex);
- loseg->free += limitIndex - baseIndex;
}
@@ -232,7 +236,7 @@ static Bool loSegFindFree(Addr *bReturn, Addr *lReturn,
LO lo;
Seg seg;
Count agrains;
- Count bits;
+ Count grains;
Addr segBase;
AVER(bReturn != NULL);
@@ -247,23 +251,22 @@ static Bool loSegFindFree(Addr *bReturn, Addr *lReturn,
/* of the allocation request */
agrains = size >> lo->alignShift;
AVER(agrains >= 1);
- AVER(agrains <= loseg->free);
+ AVER(agrains <= loseg->freeGrains);
AVER(size <= SegSize(seg));
- if(SegBuffer(seg) != NULL) {
+ if(SegBuffer(seg) != NULL)
/* Don't bother trying to allocate from a buffered segment */
return FALSE;
- }
- bits = SegSize(seg) >> lo->alignShift;
+ grains = loSegGrains(loseg);
if(!BTFindLongResRange(&baseIndex, &limitIndex, loseg->alloc,
- 0, bits, agrains)) {
+ 0, grains, agrains)) {
return FALSE;
}
/* check that BTFindLongResRange really did find enough space */
AVER(baseIndex < limitIndex);
- AVER((limitIndex-baseIndex) << lo->alignShift >= size);
+ AVER(LOGrainsSize(lo, limitIndex - baseIndex) >= size);
segBase = SegBase(seg);
*bReturn = loAddrOfIndex(segBase, lo, baseIndex);
*lReturn = loAddrOfIndex(segBase, lo, limitIndex);
@@ -291,9 +294,9 @@ static Res loSegCreate(LOSeg *loSegReturn, Pool pool, Size size,
lo = PoolPoolLO(pool);
AVERT(LO, lo);
- res = ChainAlloc(&seg, lo->chain, lo->pgen.nr, EnsureLOSegClass(),
- SizeAlignUp(size, ArenaAlign(PoolArena(pool))),
- pool, withReservoirPermit, argsNone);
+ res = PoolGenAlloc(&seg, &lo->pgen, EnsureLOSegClass(),
+ SizeAlignUp(size, ArenaAlign(PoolArena(pool))),
+ withReservoirPermit, argsNone);
if (res != ResOK)
return res;
@@ -311,7 +314,7 @@ static void loSegReclaim(LOSeg loseg, Trace trace)
{
Addr p, base, limit;
Bool marked;
- Count bytesReclaimed = (Count)0;
+ Count reclaimedGrains = (Count)0;
Seg seg;
LO lo;
Format format;
@@ -369,23 +372,30 @@ static void loSegReclaim(LOSeg loseg, Trace trace)
Index j = loIndexOfAddr(base, lo, q);
/* This object is not marked, so free it */
loSegFree(loseg, i, j);
- bytesReclaimed += AddrOffset(p, q);
+ reclaimedGrains += j - i;
}
p = q;
}
AVER(p == limit);
- AVER(bytesReclaimed <= SegSize(seg));
- trace->reclaimSize += bytesReclaimed;
- lo->pgen.totalSize -= bytesReclaimed;
+ AVER(reclaimedGrains <= loSegGrains(loseg));
+ AVER(loseg->oldGrains >= reclaimedGrains);
+ loseg->oldGrains -= reclaimedGrains;
+ loseg->freeGrains += reclaimedGrains;
+ PoolGenAccountForReclaim(&lo->pgen, LOGrainsSize(lo, reclaimedGrains), FALSE);
+
+ trace->reclaimSize += LOGrainsSize(lo, reclaimedGrains);
trace->preservedInPlaceCount += preservedInPlaceCount;
trace->preservedInPlaceSize += preservedInPlaceSize;
SegSetWhite(seg, TraceSetDel(SegWhite(seg), trace));
- if(!marked) {
- SegFree(seg);
- }
+ if (!marked)
+ PoolGenFree(&lo->pgen, seg,
+ LOGrainsSize(lo, loseg->freeGrains),
+ LOGrainsSize(lo, loseg->oldGrains),
+ LOGrainsSize(lo, loseg->newGrains),
+ FALSE);
}
/* This walks over _all_ objects in the heap, whether they are */
@@ -398,7 +408,7 @@ static void LOWalk(Pool pool, Seg seg,
Addr base;
LO lo;
LOSeg loseg;
- Index i, limit;
+ Index i, grains;
Format format;
AVERT(Pool, pool);
@@ -415,10 +425,10 @@ static void LOWalk(Pool pool, Seg seg,
AVERT(Format, format);
base = SegBase(seg);
- limit = SegSize(seg) >> lo->alignShift;
+ grains = loSegGrains(loseg);
i = 0;
- while(i < limit) {
+ while(i < grains) {
/* object is a slight misnomer because it might point to a */
/* free grain */
Addr object = loAddrOfIndex(base, lo, i);
@@ -473,9 +483,11 @@ static Res LOInit(Pool pool, ArgList args)
Arena arena;
Res res;
ArgStruct arg;
+ Chain chain;
unsigned gen = LO_GEN_DEFAULT;
AVERT(Pool, pool);
+ AVERT(ArgList, args);
arena = PoolArena(pool);
@@ -484,22 +496,22 @@ static Res LOInit(Pool pool, ArgList args)
ArgRequire(&arg, args, MPS_KEY_FORMAT);
pool->format = arg.val.format;
if (ArgPick(&arg, args, MPS_KEY_CHAIN))
- lo->chain = arg.val.chain;
+ chain = arg.val.chain;
else {
- lo->chain = ArenaGlobals(arena)->defaultChain;
+ chain = ArenaGlobals(arena)->defaultChain;
gen = 1; /* avoid the nursery of the default chain by default */
}
if (ArgPick(&arg, args, MPS_KEY_GEN))
gen = arg.val.u;
AVERT(Format, pool->format);
- AVERT(Chain, lo->chain);
- AVER(gen <= ChainGens(lo->chain));
+ AVERT(Chain, chain);
+ AVER(gen <= ChainGens(chain));
pool->alignment = pool->format->alignment;
lo->alignShift = SizeLog2((Size)PoolAlignment(pool));
- res = PoolGenInit(&lo->pgen, lo->chain, gen, pool);
+ res = PoolGenInit(&lo->pgen, ChainGen(chain, gen), pool);
if (res != ResOK)
goto failGenInit;
@@ -528,10 +540,12 @@ static void LOFinish(Pool pool)
RING_FOR(node, &pool->segRing, nextNode) {
Seg seg = SegOfPoolRing(node);
LOSeg loseg = SegLOSeg(seg);
-
AVERT(LOSeg, loseg);
- UNUSED(loseg); /* */
- SegFree(seg);
+ PoolGenFree(&lo->pgen, seg,
+ LOGrainsSize(lo, loseg->freeGrains),
+ LOGrainsSize(lo, loseg->oldGrains),
+ LOGrainsSize(lo, loseg->newGrains),
+ FALSE);
}
PoolGenFinish(&lo->pgen);
@@ -566,7 +580,7 @@ static Res LOBufferFill(Addr *baseReturn, Addr *limitReturn,
Seg seg = SegOfPoolRing(node);
loseg = SegLOSeg(seg);
AVERT(LOSeg, loseg);
- if((loseg->free << lo->alignShift) >= size
+ if(LOGrainsSize(lo, loseg->freeGrains) >= size
&& loSegFindFree(&base, &limit, loseg, size))
goto found;
}
@@ -591,12 +605,12 @@ static Res LOBufferFill(Addr *baseReturn, Addr *limitReturn,
AVER(BTIsResRange(loseg->alloc, baseIndex, limitIndex));
AVER(BTIsSetRange(loseg->mark, baseIndex, limitIndex));
BTSetRange(loseg->alloc, baseIndex, limitIndex);
- loseg->free -= limitIndex - baseIndex;
- loseg->newAlloc += limitIndex - baseIndex;
+ AVER(loseg->freeGrains >= limitIndex - baseIndex);
+ loseg->freeGrains -= limitIndex - baseIndex;
+ loseg->newGrains += limitIndex - baseIndex;
}
- lo->pgen.totalSize += AddrOffset(base, limit);
- lo->pgen.newSize += AddrOffset(base, limit);
+ PoolGenAccountForFill(&lo->pgen, AddrOffset(base, limit), FALSE);
*baseReturn = base;
*limitReturn = limit;
@@ -644,17 +658,14 @@ static void LOBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
initIndex = loIndexOfAddr(segBase, lo, init);
limitIndex = loIndexOfAddr(segBase, lo, limit);
- /* Record the unused portion at the end of the buffer */
- /* as being free. */
- AVER(baseIndex == limitIndex
- || BTIsSetRange(loseg->alloc, baseIndex, limitIndex));
if(initIndex != limitIndex) {
+ /* Free the unused portion of the buffer (this must be "new", since
+ * it's not condemned). */
loSegFree(loseg, initIndex, limitIndex);
- lo->pgen.totalSize -= AddrOffset(init, limit);
- /* All of the buffer must be new, since buffered segs are not condemned. */
- AVER(loseg->newAlloc >= limitIndex - baseIndex);
- loseg->newAlloc -= limitIndex - initIndex;
- lo->pgen.newSize -= AddrOffset(init, limit);
+ AVER(loseg->newGrains >= limitIndex - initIndex);
+ loseg->newGrains -= limitIndex - initIndex;
+ loseg->freeGrains += limitIndex - initIndex;
+ PoolGenAccountForEmpty(&lo->pgen, AddrOffset(init, limit), FALSE);
}
}
@@ -664,7 +675,9 @@ static void LOBufferEmpty(Pool pool, Buffer buffer, Addr init, Addr limit)
static Res LOWhiten(Pool pool, Trace trace, Seg seg)
{
LO lo;
- Count bits;
+ LOSeg loseg;
+ Buffer buffer;
+ Count grains, uncondemned;
AVERT(Pool, pool);
lo = PoolPoolLO(pool);
@@ -674,21 +687,32 @@ static Res LOWhiten(Pool pool, Trace trace, Seg seg)
AVERT(Seg, seg);
AVER(SegWhite(seg) == TraceSetEMPTY);
- if(SegBuffer(seg) == NULL) {
- LOSeg loseg = SegLOSeg(seg);
- AVERT(LOSeg, loseg);
+ loseg = SegLOSeg(seg);
+ AVERT(LOSeg, loseg);
+ grains = loSegGrains(loseg);
- bits = SegSize(seg) >> lo->alignShift;
- /* Allocated objects should be whitened, free areas should */
- /* be left "black". */
- BTCopyInvertRange(loseg->alloc, loseg->mark, 0, bits);
- /* @@@@ We could subtract all the free grains. */
- trace->condemned += SegSize(seg);
- lo->pgen.newSize -= loseg->newAlloc << lo->alignShift;
- loseg->newAlloc = (Count)0;
- SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
+ /* Whiten allocated objects; leave free areas black. */
+ buffer = SegBuffer(seg);
+ if (buffer != NULL) {
+ Addr base = SegBase(seg);
+ Index scanLimitIndex = loIndexOfAddr(base, lo, BufferScanLimit(buffer));
+ Index limitIndex = loIndexOfAddr(base, lo, BufferLimit(buffer));
+ uncondemned = limitIndex - scanLimitIndex;
+ if (0 < scanLimitIndex)
+ BTCopyInvertRange(loseg->alloc, loseg->mark, 0, scanLimitIndex);
+ if (limitIndex < grains)
+ BTCopyInvertRange(loseg->alloc, loseg->mark, limitIndex, grains);
+ } else {
+ uncondemned = (Count)0;
+ BTCopyInvertRange(loseg->alloc, loseg->mark, 0, grains);
}
+ PoolGenAccountForAge(&lo->pgen, LOGrainsSize(lo, loseg->newGrains - uncondemned), FALSE);
+ loseg->oldGrains += loseg->newGrains - uncondemned;
+ loseg->newGrains = uncondemned;
+ trace->condemned += LOGrainsSize(lo, loseg->oldGrains);
+ SegSetWhite(seg, TraceSetAdd(SegWhite(seg), trace));
+
return ResOK;
}
@@ -805,14 +829,14 @@ mps_class_t mps_class_lo(void)
/* LOCheck -- check an LO pool */
+ATTRIBUTE_UNUSED
static Bool LOCheck(LO lo)
{
CHECKS(LO, lo);
CHECKD(Pool, &lo->poolStruct);
CHECKL(lo->poolStruct.class == EnsureLOPoolClass());
CHECKL(ShiftCheck(lo->alignShift));
- CHECKL((Align)1 << lo->alignShift == PoolAlignment(&lo->poolStruct));
- CHECKD(Chain, lo->chain);
+ CHECKL(LOGrainsSize(lo, (Count)1) == PoolAlignment(&lo->poolStruct));
CHECKD(PoolGen, &lo->pgen);
return TRUE;
}
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index fbb125a71f2..c203c5697b6 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -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, extendSelf, unitSize);
+ EVENT5(PoolInitMFS, pool, arena, extendBy, BOOLOF(extendSelf), unitSize);
return ResOK;
}
@@ -161,6 +151,8 @@ void MFSFinishTracts(Pool pool, MFSTractVisitor visitor,
static void MFSTractFreeVisitor(Pool pool, Addr base, Size size,
void *closureP, Size closureS)
{
+ AVER(closureP == UNUSED_POINTER);
+ AVER(closureS == UNUSED_SIZE);
UNUSED(closureP);
UNUSED(closureS);
ArenaFree(base, size, pool);
@@ -175,7 +167,7 @@ static void MFSFinish(Pool pool)
mfs = PoolPoolMFS(pool);
AVERT(MFS, mfs);
- MFSFinishTracts(pool, MFSTractFreeVisitor, NULL, 0);
+ MFSFinishTracts(pool, MFSTractFreeVisitor, UNUSED_POINTER, UNUSED_SIZE);
mfs->sig = SigInvalid;
}
diff --git a/mps/code/poolmfs.h b/mps/code/poolmfs.h
index 7ab337d4393..5f2fd0780ed 100644
--- a/mps/code/poolmfs.h
+++ b/mps/code/poolmfs.h
@@ -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 .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/poolmrg.c b/mps/code/poolmrg.c
index 93d9f8bd25e..ace97865f1b 100644
--- a/mps/code/poolmrg.c
+++ b/mps/code/poolmrg.c
@@ -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 .
*/
+
+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;
diff --git a/mps/code/poolmv.c b/mps/code/poolmv.c
index 32f66dc4329..5c9dc98c6b6 100644
--- a/mps/code/poolmv.c
+++ b/mps/code/poolmv.c
@@ -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;
}
diff --git a/mps/code/poolmv.h b/mps/code/poolmv.h
index 098cd3eaa2e..8e6885254bc 100644
--- a/mps/code/poolmv.h
+++ b/mps/code/poolmv.h
@@ -1,41 +1,16 @@
/* poolmv.h: MANUAL VARIABLE POOL
*
* $Id$
- * Copyright (c) 2001 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.
*
* .purpose: This is the interface to the manual-variable pool class.
*
- * .mv: Manual-variable pools manage variably-sized blocks of memory in a
- * flexible manner. They have higher overheads than a fixed-size pool.
+ * .mv: Manual-variable pools manage variably-sized blocks of memory
+ * in a flexible manner. They have higher overheads than a fixed-size
+ * pool.
*
- * .init: This class adds the following arguments to PoolCreate:
- *
- * Size extendBy
- *
- * extendBy is the default number of bytes reserved by the pool at a time.
- * A large size will make allocation cheaper but have a higher resource
- * overhead. A typical value might be 65536. See note 2.
- *
- * Size avgSize
- *
- * avgSize is an estimate of the average size of an allocation, and is used
- * to choose the size of internal tables. An accurate estimate will
- * improve the efficiency of the pool. A low estimate will make the pool
- * less space efficient. A high estimate will make the pool less time
- * efficient. A typical value might be 32. avgSize must not be less than
- * extendBy.
- *
- * Size maxSize
- *
- * maxSize is an estimate of the maximum total size that the pool will
- * reach. Setting this parameter does not actually contrain the pool, but
- * an accurate estimate will improve the efficiency of the pool. maxSize
- * must not be less than extendBy.
- *
- * Notes
- * 2. The documentation could suggest a segment size according to the
- * distribution of allocation size requests. richard 1994-11-08
+ * .design: See
*/
#ifndef poolmv_h
@@ -59,7 +34,7 @@ extern Bool MVCheck(MV mv);
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2002 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/poolmv2.c b/mps/code/poolmv2.c
index 0a700f401b7..a50c6af188d 100644
--- a/mps/code/poolmv2.c
+++ b/mps/code/poolmv2.c
@@ -14,6 +14,7 @@
#include "mpscmvt.h"
#include "abq.h"
#include "cbs.h"
+#include "failover.h"
#include "freelist.h"
#include "meter.h"
#include "range.h"
@@ -51,8 +52,9 @@ static Res MVTContingencySearch(Addr *baseReturn, Addr *limitReturn,
MVT mvt, Size min);
static Bool MVTCheckFit(Addr base, Addr limit, Size min, Arena arena);
static ABQ MVTABQ(MVT mvt);
-static CBS MVTCBS(MVT mvt);
-static Freelist MVTFreelist(MVT mvt);
+static Land MVTCBS(MVT mvt);
+static Land MVTFreelist(MVT mvt);
+static Land MVTFailover(MVT mvt);
/* Types */
@@ -62,6 +64,7 @@ typedef struct MVTStruct
PoolStruct poolStruct;
CBSStruct cbsStruct; /* The coalescing block structure */
FreelistStruct flStruct; /* The emergency free list structure */
+ FailoverStruct foStruct; /* The fail-over mechanism */
ABQStruct abqStruct; /* The available block queue */
/* */
Size minSize; /* Pool parameter */
@@ -78,7 +81,6 @@ typedef struct MVTStruct
Bool abqOverflow; /* ABQ dropped some candidates */
/* .* */
Bool splinter; /* Saved splinter */
- Seg splinterSeg; /* Saved splinter seg */
Addr splinterBase; /* Saved splinter base */
Addr splinterLimit; /* Saved splinter size */
@@ -133,7 +135,7 @@ typedef struct MVTStruct
DEFINE_POOL_CLASS(MVTPoolClass, this)
{
- INHERIT_CLASS(this, AbstractSegBufPoolClass);
+ INHERIT_CLASS(this, AbstractBufferPoolClass);
this->name = "MVT";
this->size = sizeof(MVTStruct);
this->offset = offsetof(MVTStruct, poolStruct);
@@ -150,12 +152,6 @@ DEFINE_POOL_CLASS(MVTPoolClass, this)
/* Macros */
-
-/* .trans.something: the C language sucks */
-#define unless(cond) if (!(cond))
-#define when(cond) if (cond)
-
-
#define Pool2MVT(pool) PARENT(MVTStruct, poolStruct, pool)
#define MVT2Pool(mvt) (&(mvt)->poolStruct)
@@ -169,15 +165,21 @@ static ABQ MVTABQ(MVT mvt)
}
-static CBS MVTCBS(MVT mvt)
+static Land MVTCBS(MVT mvt)
{
- return &mvt->cbsStruct;
+ return &mvt->cbsStruct.landStruct;
}
-static Freelist MVTFreelist(MVT mvt)
+static Land MVTFreelist(MVT mvt)
{
- return &mvt->flStruct;
+ return &mvt->flStruct.landStruct;
+}
+
+
+static Land MVTFailover(MVT mvt)
+{
+ return &mvt->foStruct.landStruct;
}
@@ -275,19 +277,29 @@ static Res MVTInit(Pool pool, ArgList args)
if (abqDepth < 3)
abqDepth = 3;
- res = CBSInit(MVTCBS(mvt), arena, (void *)mvt, align,
- /* fastFind */ FALSE, /* zoned */ FALSE, args);
+ res = LandInit(MVTCBS(mvt), CBSFastLandClassGet(), arena, align, mvt,
+ mps_args_none);
if (res != ResOK)
goto failCBS;
+ res = LandInit(MVTFreelist(mvt), FreelistLandClassGet(), arena, align, mvt,
+ mps_args_none);
+ if (res != ResOK)
+ goto failFreelist;
+
+ MPS_ARGS_BEGIN(foArgs) {
+ MPS_ARGS_ADD(foArgs, FailoverPrimary, MVTCBS(mvt));
+ MPS_ARGS_ADD(foArgs, FailoverSecondary, MVTFreelist(mvt));
+ res = LandInit(MVTFailover(mvt), FailoverLandClassGet(), arena, align, mvt,
+ foArgs);
+ } MPS_ARGS_END(foArgs);
+ if (res != ResOK)
+ goto failFailover;
+
res = ABQInit(arena, MVTABQ(mvt), (void *)mvt, abqDepth, sizeof(RangeStruct));
if (res != ResOK)
goto failABQ;
- res = FreelistInit(MVTFreelist(mvt), align);
- if (res != ResOK)
- goto failFreelist;
-
pool->alignment = align;
mvt->reuseSize = reuseSize;
mvt->fillSize = fillSize;
@@ -297,7 +309,6 @@ static Res MVTInit(Pool pool, ArgList args)
mvt->maxSize = maxSize;
mvt->fragLimit = fragLimit;
mvt->splinter = FALSE;
- mvt->splinterSeg = NULL;
mvt->splinterBase = (Addr)0;
mvt->splinterLimit = (Addr)0;
@@ -351,10 +362,12 @@ static Res MVTInit(Pool pool, ArgList args)
reserveDepth, fragLimit);
return ResOK;
-failFreelist:
- ABQFinish(arena, MVTABQ(mvt));
failABQ:
- CBSFinish(MVTCBS(mvt));
+ LandFinish(MVTFailover(mvt));
+failFailover:
+ LandFinish(MVTFreelist(mvt));
+failFreelist:
+ LandFinish(MVTCBS(mvt));
failCBS:
AVER(res != ResOK);
return res;
@@ -363,6 +376,7 @@ static Res MVTInit(Pool pool, ArgList args)
/* MVTCheck -- validate an MVT Pool */
+ATTRIBUTE_UNUSED
static Bool MVTCheck(MVT mvt)
{
CHECKS(MVT, mvt);
@@ -371,6 +385,7 @@ static Bool MVTCheck(MVT mvt)
CHECKD(CBS, &mvt->cbsStruct);
CHECKD(ABQ, &mvt->abqStruct);
CHECKD(Freelist, &mvt->flStruct);
+ CHECKD(Failover, &mvt->foStruct);
CHECKL(mvt->reuseSize >= 2 * mvt->fillSize);
CHECKL(mvt->fillSize >= mvt->maxSize);
CHECKL(mvt->maxSize >= mvt->meanSize);
@@ -383,9 +398,7 @@ static Bool MVTCheck(MVT mvt)
if (mvt->splinter) {
CHECKL(AddrOffset(mvt->splinterBase, mvt->splinterLimit) >=
mvt->minSize);
- CHECKD(Seg, mvt->splinterSeg);
- CHECKL(mvt->splinterBase >= SegBase(mvt->splinterSeg));
- CHECKL(mvt->splinterLimit <= SegLimit(mvt->splinterSeg));
+ CHECKL(mvt->splinterBase < mvt->splinterLimit);
}
CHECKL(mvt->size == mvt->allocated + mvt->available +
mvt->unavailable);
@@ -422,10 +435,11 @@ static void MVTFinish(Pool pool)
SegFree(SegOfPoolRing(node));
}
- /* Finish the Freelist, ABQ and CBS structures */
- FreelistFinish(MVTFreelist(mvt));
+ /* Finish the ABQ, Failover, Freelist and CBS structures */
ABQFinish(arena, MVTABQ(mvt));
- CBSFinish(MVTCBS(mvt));
+ LandFinish(MVTFailover(mvt));
+ LandFinish(MVTFreelist(mvt));
+ LandFinish(MVTCBS(mvt));
}
@@ -615,14 +629,7 @@ static Bool MVTABQFill(Addr *baseReturn, Addr *limitReturn,
}
-/* MVTContingencyFill -- try to fill a request from the CBS or Freelist
- *
- * (The CBS and Freelist are lumped together under the heading of
- * "contingency" for historical reasons: the Freelist used to be part
- * of the CBS. There is no principled reason why these two are
- * searched at the same time: if it should prove convenient to
- * separate them, go ahead.)
- */
+/* MVTContingencyFill -- try to fill a request from the free lists */
static Bool MVTContingencyFill(Addr *baseReturn, Addr *limitReturn,
MVT mvt, Size minSize)
{
@@ -711,8 +718,7 @@ static Res MVTBufferFill(Addr *baseReturn, Addr *limitReturn,
METER_ACC(mvt->underflows, minSize);
/* If fragmentation is acceptable, attempt to find a free block from
- the CBS or Freelist.
- */
+ the free lists. */
if (mvt->available >= mvt->availLimit) {
METER_ACC(mvt->fragLimitContingencies, minSize);
if (MVTContingencyFill(baseReturn, limitReturn, mvt, minSize))
@@ -753,6 +759,7 @@ static Bool MVTDeleteOverlapping(Bool *deleteReturn, void *element,
AVER(deleteReturn != NULL);
AVER(element != NULL);
AVER(closureP != NULL);
+ AVER(closureS == UNUSED_SIZE);
UNUSED(closureS);
oldRange = element;
@@ -798,8 +805,8 @@ static Bool MVTReserve(MVT mvt, Range range)
}
-/* MVTInsert -- insert an address range into the CBS (or the Freelist
- * if that fails) and update the ABQ accordingly.
+/* MVTInsert -- insert an address range into the free lists and update
+ * the ABQ accordingly.
*/
static Res MVTInsert(MVT mvt, Addr base, Addr limit)
{
@@ -808,18 +815,9 @@ static Res MVTInsert(MVT mvt, Addr base, Addr limit)
AVERT(MVT, mvt);
AVER(base < limit);
-
- /* Attempt to flush the Freelist to the CBS to give maximum
- * opportunities for coalescence. */
- FreelistFlushToCBS(MVTFreelist(mvt), MVTCBS(mvt));
RangeInit(&range, base, limit);
- res = CBSInsert(&newRange, MVTCBS(mvt), &range);
- if (ResIsAllocFailure(res)) {
- /* CBS ran out of memory for splay nodes: add range to emergency
- * free list instead. */
- res = FreelistInsert(&newRange, MVTFreelist(mvt), &range);
- }
+ res = LandInsert(&newRange, MVTFailover(mvt), &range);
if (res != ResOK)
return res;
@@ -828,7 +826,7 @@ static Res MVTInsert(MVT mvt, Addr base, Addr limit)
* with ranges on the ABQ, so ensure that the corresponding ranges
* are coalesced on the ABQ.
*/
- ABQIterate(MVTABQ(mvt), MVTDeleteOverlapping, &newRange, 0);
+ ABQIterate(MVTABQ(mvt), MVTDeleteOverlapping, &newRange, UNUSED_SIZE);
(void)MVTReserve(mvt, &newRange);
}
@@ -836,8 +834,8 @@ static Res MVTInsert(MVT mvt, Addr base, Addr limit)
}
-/* MVTDelete -- delete an address range from the CBS and the Freelist,
- * and update the ABQ accordingly.
+/* MVTDelete -- delete an address range from the free lists, and
+ * update the ABQ accordingly.
*/
static Res MVTDelete(MVT mvt, Addr base, Addr limit)
{
@@ -848,27 +846,7 @@ static Res MVTDelete(MVT mvt, Addr base, Addr limit)
AVER(base < limit);
RangeInit(&range, base, limit);
- res = CBSDelete(&rangeOld, MVTCBS(mvt), &range);
- if (ResIsAllocFailure(res)) {
- /* CBS ran out of memory for splay nodes, which must mean that
- * there were fragments on both sides: see
- * . Handle this by
- * deleting the whole of rangeOld (which requires no
- * allocation) and re-inserting the fragments. */
- RangeStruct rangeOld2;
- res = CBSDelete(&rangeOld2, MVTCBS(mvt), &rangeOld);
- AVER(res == ResOK);
- AVER(RangesEqual(&rangeOld2, &rangeOld));
- AVER(RangeBase(&rangeOld) != base);
- res = MVTInsert(mvt, RangeBase(&rangeOld), base);
- AVER(res == ResOK);
- AVER(RangeLimit(&rangeOld) != limit);
- res = MVTInsert(mvt, limit, RangeLimit(&rangeOld));
- AVER(res == ResOK);
- } else if (res == ResFAIL) {
- /* Not found in the CBS: try the Freelist. */
- res = FreelistDelete(&rangeOld, MVTFreelist(mvt), &range);
- }
+ res = LandDelete(&rangeOld, MVTFailover(mvt), &range);
if (res != ResOK)
return res;
AVER(RangesNest(&rangeOld, &range));
@@ -877,7 +855,7 @@ static Res MVTDelete(MVT mvt, Addr base, Addr limit)
* might be on the ABQ, so ensure it is removed.
*/
if (RangeSize(&rangeOld) >= mvt->reuseSize)
- ABQIterate(MVTABQ(mvt), MVTDeleteOverlapping, &rangeOld, 0);
+ ABQIterate(MVTABQ(mvt), MVTDeleteOverlapping, &rangeOld, UNUSED_SIZE);
/* There might be fragments at the left or the right of the deleted
* range, and either might be big enough to go back on the ABQ.
@@ -956,7 +934,6 @@ static void MVTBufferEmpty(Pool pool, Buffer buffer,
}
mvt->splinter = TRUE;
- mvt->splinterSeg = BufferSeg(buffer);
mvt->splinterBase = base;
mvt->splinterLimit = limit;
}
@@ -1003,8 +980,6 @@ static void MVTFree(Pool pool, Addr base, Size size)
AVER(mvt->size == mvt->allocated + mvt->available +
mvt->unavailable);
METER_ACC(mvt->exceptionReturns, SegSize(seg));
- if (SegBuffer(seg) != NULL)
- BufferDetach(SegBuffer(seg), MVT2Pool(mvt));
MVTSegFree(mvt, seg);
return;
}
@@ -1036,7 +1011,6 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
" availLimit: $U \n", (WriteFU)mvt->availLimit,
" abqOverflow: $S \n", mvt->abqOverflow?"TRUE":"FALSE",
" splinter: $S \n", mvt->splinter?"TRUE":"FALSE",
- " splinterSeg: $P \n", (WriteFP)mvt->splinterSeg,
" splinterBase: $A \n", (WriteFA)mvt->splinterBase,
" splinterLimit: $A \n", (WriteFU)mvt->splinterLimit,
" size: $U \n", (WriteFU)mvt->size,
@@ -1046,77 +1020,46 @@ static Res MVTDescribe(Pool pool, mps_lib_FILE *stream)
NULL);
if(res != ResOK) return res;
- res = CBSDescribe(MVTCBS(mvt), stream);
+ res = LandDescribe(MVTCBS(mvt), stream);
+ if(res != ResOK) return res;
+ res = LandDescribe(MVTFreelist(mvt), stream);
+ if(res != ResOK) return res;
+ res = LandDescribe(MVTFailover(mvt), stream);
if(res != ResOK) return res;
-
res = ABQDescribe(MVTABQ(mvt), (ABQDescribeElement)RangeDescribe, stream);
if(res != ResOK) return res;
- res = FreelistDescribe(MVTFreelist(mvt), stream);
- if(res != ResOK) return res;
-
- res = METER_WRITE(mvt->segAllocs, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->segFrees, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->bufferFills, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->bufferEmpties, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->poolFrees, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->poolSize, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->poolAllocated, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->poolAvailable, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->poolUnavailable, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->poolUtilization, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->finds, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->overflows, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->underflows, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->refills, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->refillPushes, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->returns, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->perfectFits, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->firstFits, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->secondFits, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->failures, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->emergencyContingencies, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->fragLimitContingencies, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->contingencySearches, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->contingencyHardSearches, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->splinters, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->splintersUsed, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->splintersDropped, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->sawdust, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->exceptions, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->exceptionSplinters, stream);
- if (res != ResOK) return res;
- res = METER_WRITE(mvt->exceptionReturns, stream);
- if (res != ResOK) return res;
+ METER_WRITE(mvt->segAllocs, stream);
+ METER_WRITE(mvt->segFrees, stream);
+ METER_WRITE(mvt->bufferFills, stream);
+ METER_WRITE(mvt->bufferEmpties, stream);
+ METER_WRITE(mvt->poolFrees, stream);
+ METER_WRITE(mvt->poolSize, stream);
+ METER_WRITE(mvt->poolAllocated, stream);
+ METER_WRITE(mvt->poolAvailable, stream);
+ METER_WRITE(mvt->poolUnavailable, stream);
+ METER_WRITE(mvt->poolUtilization, stream);
+ METER_WRITE(mvt->finds, stream);
+ METER_WRITE(mvt->overflows, stream);
+ METER_WRITE(mvt->underflows, stream);
+ METER_WRITE(mvt->refills, stream);
+ METER_WRITE(mvt->refillPushes, stream);
+ METER_WRITE(mvt->returns, stream);
+ METER_WRITE(mvt->perfectFits, stream);
+ METER_WRITE(mvt->firstFits, stream);
+ METER_WRITE(mvt->secondFits, stream);
+ METER_WRITE(mvt->failures, stream);
+ METER_WRITE(mvt->emergencyContingencies, stream);
+ METER_WRITE(mvt->fragLimitContingencies, stream);
+ METER_WRITE(mvt->contingencySearches, stream);
+ METER_WRITE(mvt->contingencyHardSearches, stream);
+ METER_WRITE(mvt->splinters, stream);
+ METER_WRITE(mvt->splintersUsed, stream);
+ METER_WRITE(mvt->splintersDropped, stream);
+ METER_WRITE(mvt->sawdust, stream);
+ METER_WRITE(mvt->exceptions, stream);
+ METER_WRITE(mvt->exceptionSplinters, stream);
+ METER_WRITE(mvt->exceptionReturns, stream);
res = WriteF(stream, "}\n", NULL);
return res;
@@ -1194,7 +1137,7 @@ static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size,
{
/* Can't use plain old SegClass here because we need to call
* SegBuffer() in MVTFree(). */
- Res res = SegAlloc(segReturn, GCSegClassGet(),
+ Res res = SegAlloc(segReturn, SegClassGet(),
SegPrefDefault(), size, MVT2Pool(mvt), withReservoirPermit,
argsNone);
@@ -1218,7 +1161,6 @@ static Res MVTSegAlloc(Seg *segReturn, MVT mvt, Size size,
*/
static void MVTSegFree(MVT mvt, Seg seg)
{
- Buffer buffer;
Size size;
size = SegSize(seg);
@@ -1228,16 +1170,6 @@ static void MVTSegFree(MVT mvt, Seg seg)
mvt->size -= size;
mvt->availLimit = mvt->size * mvt->fragLimit / 100;
AVER(mvt->size == mvt->allocated + mvt->available + mvt->unavailable);
-
- /* If the client program allocates the exactly the entire buffer then
- frees the allocated memory then we'll try to free the segment with
- the buffer still attached. It's safe, but we must detach the buffer
- first. See job003520 and job003672. */
- buffer = SegBuffer(seg);
- if (buffer != NULL) {
- AVER(BufferAP(buffer)->init == SegLimit(seg));
- BufferDetach(buffer, MVT2Pool(mvt));
- }
SegFree(seg);
METER_ACC(mvt->segFrees, size);
@@ -1273,13 +1205,20 @@ static Bool MVTReturnSegs(MVT mvt, Range range, Arena arena)
}
-/* MVTRefillCallback -- called from CBSIterate or FreelistIterate at
- * the behest of MVTRefillABQIfEmpty
+/* MVTRefillABQIfEmpty -- refill the ABQ from the free lists if it is
+ * empty.
*/
-static Bool MVTRefillCallback(MVT mvt, Range range)
+
+static Bool MVTRefillVisitor(Land land, Range range,
+ void *closureP, Size closureS)
{
- AVERT(ABQ, MVTABQ(mvt));
- AVERT(Range, range);
+ MVT mvt;
+
+ AVERT(Land, land);
+ mvt = closureP;
+ AVERT(MVT, mvt);
+ AVER(closureS == UNUSED_SIZE);
+ UNUSED(closureS);
if (RangeSize(range) < mvt->reuseSize)
return TRUE;
@@ -1288,80 +1227,54 @@ static Bool MVTRefillCallback(MVT mvt, Range range)
return MVTReserve(mvt, range);
}
-static Bool MVTCBSRefillCallback(CBS cbs, Range range,
- void *closureP, Size closureS)
-{
- MVT mvt;
- AVERT(CBS, cbs);
- mvt = closureP;
- AVERT(MVT, mvt);
- UNUSED(closureS);
- return MVTRefillCallback(mvt, range);
-}
-
-static Bool MVTFreelistRefillCallback(Bool *deleteReturn, Range range,
- void *closureP, Size closureS)
-{
- MVT mvt;
- mvt = closureP;
- AVERT(MVT, mvt);
- UNUSED(closureS);
- AVER(deleteReturn != NULL);
- *deleteReturn = FALSE;
- return MVTRefillCallback(mvt, range);
-}
-
-/* MVTRefillABQIfEmpty -- refill the ABQ from the CBS and the Freelist if
- * it is empty
- */
static void MVTRefillABQIfEmpty(MVT mvt, Size size)
{
AVERT(MVT, mvt);
AVER(size > 0);
/* If there have never been any overflows from the ABQ back to the
- * CBS/Freelist, then there cannot be any blocks in the CBS/Freelist
+ * free lists, then there cannot be any blocks in the free lists
* that are worth adding to the ABQ. So as an optimization, we don't
* bother to look.
*/
if (mvt->abqOverflow && ABQIsEmpty(MVTABQ(mvt))) {
mvt->abqOverflow = FALSE;
METER_ACC(mvt->refills, size);
- CBSIterate(MVTCBS(mvt), &MVTCBSRefillCallback, mvt, 0);
- FreelistIterate(MVTFreelist(mvt), &MVTFreelistRefillCallback, mvt, 0);
+ /* The iteration stops if the ABQ overflows, so may finish or not. */
+ (void)LandIterate(MVTFailover(mvt), MVTRefillVisitor, mvt, UNUSED_SIZE);
}
}
-/* Closure for MVTContingencySearch */
-typedef struct MVTContigencyStruct *MVTContigency;
+/* MVTContingencySearch -- search free lists for a block of a given size */
-typedef struct MVTContigencyStruct
+typedef struct MVTContigencyClosureStruct
{
MVT mvt;
- Bool found;
RangeStruct range;
Arena arena;
Size min;
/* meters */
Count steps;
Count hardSteps;
-} MVTContigencyStruct;
+} MVTContigencyClosureStruct, *MVTContigencyClosure;
-
-/* MVTContingencyCallback -- called from CBSIterate or FreelistIterate
- * at the behest of MVTContingencySearch.
- */
-static Bool MVTContingencyCallback(MVTContigency cl, Range range)
+static Bool MVTContingencyVisitor(Land land, Range range,
+ void *closureP, Size closureS)
{
MVT mvt;
Size size;
Addr base, limit;
+ MVTContigencyClosure cl;
- AVER(cl != NULL);
+ AVERT(Land, land);
+ AVERT(Range, range);
+ AVER(closureP != NULL);
+ cl = closureP;
mvt = cl->mvt;
AVERT(MVT, mvt);
- AVERT(Range, range);
+ AVER(closureS == UNUSED_SIZE);
+ UNUSED(closureS);
base = RangeBase(range);
limit = RangeLimit(range);
@@ -1374,7 +1287,6 @@ static Bool MVTContingencyCallback(MVTContigency cl, Range range)
/* verify that min will fit when seg-aligned */
if (size >= 2 * cl->min) {
RangeInit(&cl->range, base, limit);
- cl->found = TRUE;
return FALSE;
}
@@ -1382,7 +1294,6 @@ static Bool MVTContingencyCallback(MVTContigency cl, Range range)
cl->hardSteps++;
if (MVTCheckFit(base, limit, cl->min, cl->arena)) {
RangeInit(&cl->range, base, limit);
- cl->found = TRUE;
return FALSE;
}
@@ -1390,46 +1301,18 @@ static Bool MVTContingencyCallback(MVTContigency cl, Range range)
return TRUE;
}
-static Bool MVTCBSContingencyCallback(CBS cbs, Range range,
- void *closureP, Size closureS)
-{
- MVTContigency cl = closureP;
- UNUSED(cbs);
- UNUSED(closureS);
- return MVTContingencyCallback(cl, range);
-}
-
-static Bool MVTFreelistContingencyCallback(Bool *deleteReturn, Range range,
- void *closureP, Size closureS)
-{
- MVTContigency cl = closureP;
- UNUSED(closureS);
- AVER(deleteReturn != NULL);
- *deleteReturn = FALSE;
- return MVTContingencyCallback(cl, range);
-}
-
-/* MVTContingencySearch -- search the CBS and the Freelist for a block
- * of size min */
-
static Bool MVTContingencySearch(Addr *baseReturn, Addr *limitReturn,
MVT mvt, Size min)
{
- MVTContigencyStruct cls;
+ MVTContigencyClosureStruct cls;
cls.mvt = mvt;
- cls.found = FALSE;
cls.arena = PoolArena(MVT2Pool(mvt));
cls.min = min;
cls.steps = 0;
cls.hardSteps = 0;
- FreelistFlushToCBS(MVTFreelist(mvt), MVTCBS(mvt));
-
- CBSIterate(MVTCBS(mvt), MVTCBSContingencyCallback, (void *)&cls, 0);
- FreelistIterate(MVTFreelist(mvt), MVTFreelistContingencyCallback,
- (void *)&cls, 0);
- if (!cls.found)
+ if (LandIterate(MVTFailover(mvt), MVTContingencyVisitor, &cls, UNUSED_SIZE))
return FALSE;
AVER(RangeSize(&cls.range) >= min);
@@ -1446,6 +1329,7 @@ static Bool MVTContingencySearch(Addr *baseReturn, Addr *limitReturn,
/* MVTCheckFit -- verify that segment-aligned block of size min can
* fit in a candidate address range.
*/
+
static Bool MVTCheckFit(Addr base, Addr limit, Size min, Arena arena)
{
Seg seg;
@@ -1475,12 +1359,10 @@ static Bool MVTCheckFit(Addr base, Addr limit, Size min, Arena arena)
/* Return the CBS of an MVT pool for the benefit of fotest.c. */
-extern CBS _mps_mvt_cbs(mps_pool_t);
-CBS _mps_mvt_cbs(mps_pool_t mps_pool) {
- Pool pool;
+extern Land _mps_mvt_cbs(Pool);
+Land _mps_mvt_cbs(Pool pool) {
MVT mvt;
- pool = (Pool)mps_pool;
AVERT(Pool, pool);
mvt = Pool2MVT(pool);
AVERT(MVT, mvt);
diff --git a/mps/code/poolmvff.c b/mps/code/poolmvff.c
index 7aa19108134..eca556eea1a 100644
--- a/mps/code/poolmvff.c
+++ b/mps/code/poolmvff.c
@@ -21,6 +21,7 @@
#include "mpscmvff.h"
#include "dbgpool.h"
#include "cbs.h"
+#include "failover.h"
#include "freelist.h"
#include "mpm.h"
@@ -47,9 +48,9 @@ typedef struct MVFFStruct { /* MVFF pool outer structure */
Size minSegSize; /* minimum size of segment */
Size avgSize; /* client estimate of allocation size */
Size total; /* total bytes in pool */
- Size free; /* total free bytes in pool */
CBSStruct cbsStruct; /* free list */
FreelistStruct flStruct; /* emergency free list */
+ FailoverStruct foStruct; /* fail-over mechanism */
Bool firstFit; /* as opposed to last fit */
Bool slotHigh; /* prefers high part of large block */
Sig sig; /* */
@@ -58,10 +59,9 @@ typedef struct MVFFStruct { /* MVFF pool outer structure */
#define Pool2MVFF(pool) PARENT(MVFFStruct, poolStruct, pool)
#define MVFF2Pool(mvff) (&((mvff)->poolStruct))
-#define CBSOfMVFF(mvff) (&((mvff)->cbsStruct))
-#define MVFFOfCBS(cbs) PARENT(MVFFStruct, cbsStruct, cbs)
-#define FreelistOfMVFF(mvff) (&((mvff)->flStruct))
-#define MVFFOfFreelist(fl) PARENT(MVFFStruct, flStruct, fl)
+#define CBSOfMVFF(mvff) (&((mvff)->cbsStruct.landStruct))
+#define FreelistOfMVFF(mvff) (&((mvff)->flStruct.landStruct))
+#define FailoverOfMVFF(mvff) (&((mvff)->foStruct.landStruct))
static Bool MVFFCheck(MVFF mvff);
@@ -80,48 +80,29 @@ typedef MVFFDebugStruct *MVFFDebug;
#define MVFFDebug2MVFF(mvffd) (&((mvffd)->mvffStruct))
-/* MVFFAddToFreeList -- Add given range to free list
+/* MVFFInsert -- add given range to free lists
*
- * Updates MVFF counters for additional free space. Returns maximally
- * coalesced range containing given range. Does not attempt to free
- * segments (see MVFFFreeSegs).
+ * Updates rangeIO to be maximally coalesced range containing given
+ * range. Does not attempt to free segments (see MVFFFreeSegs).
*/
-static Res MVFFAddToFreeList(Addr *baseIO, Addr *limitIO, MVFF mvff) {
- Res res;
- RangeStruct range, newRange;
-
- AVER(baseIO != NULL);
- AVER(limitIO != NULL);
+static Res MVFFInsert(Range rangeIO, MVFF mvff) {
+ AVERT(Range, rangeIO);
AVERT(MVFF, mvff);
- RangeInit(&range, *baseIO, *limitIO);
- res = CBSInsert(&newRange, CBSOfMVFF(mvff), &range);
- if (ResIsAllocFailure(res)) {
- /* CBS ran out of memory for splay nodes: add range to emergency
- * free list instead. */
- res = FreelistInsert(&newRange, FreelistOfMVFF(mvff), &range);
- }
-
- if (res == ResOK) {
- mvff->free += RangeSize(&range);
- *baseIO = RangeBase(&newRange);
- *limitIO = RangeLimit(&newRange);
- }
-
- return res;
+ return LandInsert(rangeIO, FailoverOfMVFF(mvff), rangeIO);
}
-/* MVFFFreeSegs -- Free segments from given range
+/* MVFFFreeSegs -- free segments from given range
*
- * Given a free range, attempts to find entire segments within
- * it, and returns them to the arena, updating total size counter.
+ * Given a free range, attempts to find entire segments within it, and
+ * returns them to the arena, updating total size counter.
*
- * This is usually called immediately after MVFFAddToFreeList.
- * It is not combined with MVFFAddToFreeList because the latter
- * is also called when new segments are added under MVFFAlloc.
+ * This is usually called immediately after MVFFInsert. It is not
+ * combined with MVFFInsert because the latter is also called when new
+ * segments are added under MVFFAlloc.
*/
-static void MVFFFreeSegs(MVFF mvff, Addr base, Addr limit)
+static void MVFFFreeSegs(MVFF mvff, Range range)
{
Seg seg = NULL; /* suppress "may be used uninitialized" */
Arena arena;
@@ -131,72 +112,42 @@ static void MVFFFreeSegs(MVFF mvff, Addr base, Addr limit)
Res res;
AVERT(MVFF, mvff);
- AVER(base < limit);
+ AVERT(Range, range);
/* Could profitably AVER that the given range is free, */
/* but the CBS doesn't provide that facility. */
- if (AddrOffset(base, limit) < mvff->minSegSize)
+ if (RangeSize(range) < mvff->minSegSize)
return; /* not large enough for entire segments */
arena = PoolArena(MVFF2Pool(mvff));
- b = SegOfAddr(&seg, arena, base);
+ b = SegOfAddr(&seg, arena, RangeBase(range));
AVER(b);
segBase = SegBase(seg);
segLimit = SegLimit(seg);
- while(segLimit <= limit) { /* segment ends in range */
- if (segBase >= base) { /* segment starts in range */
- RangeStruct range, oldRange;
- RangeInit(&range, segBase, segLimit);
-
- res = CBSDelete(&oldRange, CBSOfMVFF(mvff), &range);
- if (res == ResOK) {
- mvff->free -= RangeSize(&range);
- } else if (ResIsAllocFailure(res)) {
- /* CBS ran out of memory for splay nodes, which must mean that
- * there were fragments on both sides: see
- * . Handle this by
- * deleting the whole of oldRange (which requires no
- * allocation) and re-inserting the fragments. */
- RangeStruct oldRange2;
- res = CBSDelete(&oldRange2, CBSOfMVFF(mvff), &oldRange);
- AVER(res == ResOK);
- AVER(RangesEqual(&oldRange2, &oldRange));
- mvff->free -= RangeSize(&oldRange);
- AVER(RangeBase(&oldRange) != segBase);
- {
- Addr leftBase = RangeBase(&oldRange);
- Addr leftLimit = segBase;
- res = MVFFAddToFreeList(&leftBase, &leftLimit, mvff);
- }
- AVER(RangeLimit(&oldRange) != segLimit);
- {
- Addr rightBase = segLimit;
- Addr rightLimit = RangeLimit(&oldRange);
- res = MVFFAddToFreeList(&rightBase, &rightLimit, mvff);
- }
- } else if (res == ResFAIL) {
- /* Not found in the CBS: must be found in the Freelist. */
- res = FreelistDelete(&oldRange, FreelistOfMVFF(mvff), &range);
- AVER(res == ResOK);
- mvff->free -= RangeSize(&range);
- }
+ while(segLimit <= RangeLimit(range)) { /* segment ends in range */
+ if (segBase >= RangeBase(range)) { /* segment starts in range */
+ RangeStruct delRange, oldRange;
+ RangeInit(&delRange, segBase, segLimit);
+ res = LandDelete(&oldRange, FailoverOfMVFF(mvff), &delRange);
AVER(res == ResOK);
- AVER(RangesNest(&oldRange, &range));
+ AVER(RangesNest(&oldRange, &delRange));
/* Can't free the segment earlier, because if it was on the
* Freelist rather than the CBS then it likely contains data
* that needs to be read in order to update the Freelist. */
SegFree(seg);
- mvff->total -= RangeSize(&range);
+
+ AVER(mvff->total >= RangeSize(&delRange));
+ mvff->total -= RangeSize(&delRange);
}
/* Avoid calling SegFindAboveAddr if the next segment would fail */
/* the loop test, mainly because there might not be a */
/* next segment. */
- if (segLimit == limit) /* segment ends at end of range */
+ if (segLimit == RangeLimit(range)) /* segment ends at end of range */
break;
b = SegFindAboveAddr(&seg, arena, segBase);
@@ -212,8 +163,8 @@ static void MVFFFreeSegs(MVFF mvff, Addr base, Addr limit)
/* MVFFAddSeg -- Allocates a new segment from the arena
*
* Allocates a new segment from the arena (with the given
- * withReservoirPermit flag) of at least the specified size. The
- * specified size should be pool-aligned. Adds it to the free list.
+ * withReservoirPermit flag) of at least the specified size. The
+ * specified size should be pool-aligned. Adds it to the free lists.
*/
static Res MVFFAddSeg(Seg *segReturn,
MVFF mvff, Size size, Bool withReservoirPermit)
@@ -224,7 +175,7 @@ static Res MVFFAddSeg(Seg *segReturn,
Seg seg;
Res res;
Align align;
- Addr base, limit;
+ RangeStruct range;
AVERT(MVFF, mvff);
AVER(size > 0);
@@ -259,12 +210,11 @@ static Res MVFFAddSeg(Seg *segReturn,
}
mvff->total += segSize;
- base = SegBase(seg);
- limit = AddrAdd(base, segSize);
- DebugPoolFreeSplat(pool, base, limit);
- res = MVFFAddToFreeList(&base, &limit, mvff);
+ RangeInitSize(&range, SegBase(seg), segSize);
+ DebugPoolFreeSplat(pool, RangeBase(&range), RangeLimit(&range));
+ res = MVFFInsert(&range, mvff);
AVER(res == ResOK);
- AVER(base <= SegBase(seg));
+ AVER(RangeBase(&range) <= SegBase(seg));
if (mvff->minSegSize > segSize) mvff->minSegSize = segSize;
/* Don't call MVFFFreeSegs; that would be silly. */
@@ -274,50 +224,32 @@ static Res MVFFAddSeg(Seg *segReturn,
}
-/* MVFFFindFirstFree -- Finds the first (or last) suitable free block
+/* MVFFFindFree -- find the first (or last) suitable free block
*
* Finds a free block of the given (pool aligned) size, according
* to a first (or last) fit policy controlled by the MVFF fields
* firstFit, slotHigh (for whether to allocate the top or bottom
* portion of a larger block).
*
- * Will return FALSE if the free list has no large enough block.
- * In particular, will not attempt to allocate a new segment.
+ * Will return FALSE if the free lists have no large enough block. In
+ * particular, will not attempt to allocate a new segment.
*/
-static Bool MVFFFindFirstFree(Addr *baseReturn, Addr *limitReturn,
- MVFF mvff, Size size)
+static Bool MVFFFindFree(Range rangeReturn, MVFF mvff, Size size)
{
Bool foundBlock;
FindDelete findDelete;
- RangeStruct range, oldRange;
+ RangeStruct oldRange;
- AVER(baseReturn != NULL);
- AVER(limitReturn != NULL);
+ AVER(rangeReturn != NULL);
AVERT(MVFF, mvff);
AVER(size > 0);
AVER(SizeIsAligned(size, PoolAlignment(MVFF2Pool(mvff))));
- FreelistFlushToCBS(FreelistOfMVFF(mvff), CBSOfMVFF(mvff));
-
findDelete = mvff->slotHigh ? FindDeleteHIGH : FindDeleteLOW;
foundBlock =
- (mvff->firstFit ? CBSFindFirst : CBSFindLast)
- (&range, &oldRange, CBSOfMVFF(mvff), size, findDelete);
-
- if (!foundBlock) {
- /* Failed to find a block in the CBS: try the emergency free list
- * as well. */
- foundBlock =
- (mvff->firstFit ? FreelistFindFirst : FreelistFindLast)
- (&range, &oldRange, FreelistOfMVFF(mvff), size, findDelete);
- }
-
- if (foundBlock) {
- *baseReturn = RangeBase(&range);
- *limitReturn = RangeLimit(&range);
- mvff->free -= size;
- }
+ (mvff->firstFit ? LandFindFirst : LandFindLast)
+ (rangeReturn, &oldRange, FailoverOfMVFF(mvff), size, findDelete);
return foundBlock;
}
@@ -330,7 +262,7 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size,
{
Res res;
MVFF mvff;
- Addr base, limit;
+ RangeStruct range;
Bool foundBlock;
AVERT(Pool, pool);
@@ -343,29 +275,28 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size,
size = SizeAlignUp(size, PoolAlignment(pool));
- foundBlock = MVFFFindFirstFree(&base, &limit, mvff, size);
+ foundBlock = MVFFFindFree(&range, mvff, size);
if (!foundBlock) {
Seg seg;
res = MVFFAddSeg(&seg, mvff, size, withReservoirPermit);
if (res != ResOK)
return res;
- foundBlock = MVFFFindFirstFree(&base, &limit, mvff, size);
+ foundBlock = MVFFFindFree(&range, mvff, size);
/* We know that the found range must intersect the new segment. */
/* In particular, it doesn't necessarily lie entirely within it. */
- /* The next three AVERs test for intersection of two intervals. */
- AVER(base >= SegBase(seg) || limit <= SegLimit(seg));
- AVER(base < SegLimit(seg));
- AVER(SegBase(seg) < limit);
+ /* The next two AVERs test for intersection of two intervals. */
+ AVER(RangeBase(&range) < SegLimit(seg));
+ AVER(SegBase(seg) < RangeLimit(&range));
/* We also know that the found range is no larger than the segment. */
- AVER(SegSize(seg) >= AddrOffset(base, limit));
+ AVER(SegSize(seg) >= RangeSize(&range));
}
AVER(foundBlock);
- AVER(AddrOffset(base, limit) == size);
+ AVER(RangeSize(&range) == size);
- *aReturn = base;
+ *aReturn = RangeBase(&range);
return ResOK;
}
@@ -376,7 +307,7 @@ static Res MVFFAlloc(Addr *aReturn, Pool pool, Size size,
static void MVFFFree(Pool pool, Addr old, Size size)
{
Res res;
- Addr base, limit;
+ RangeStruct range;
MVFF mvff;
AVERT(Pool, pool);
@@ -387,42 +318,16 @@ static void MVFFFree(Pool pool, Addr old, Size size)
AVER(AddrIsAligned(old, PoolAlignment(pool)));
AVER(size > 0);
- size = SizeAlignUp(size, PoolAlignment(pool));
- base = old;
- limit = AddrAdd(base, size);
+ RangeInitSize(&range, old, SizeAlignUp(size, PoolAlignment(pool)));
- res = MVFFAddToFreeList(&base, &limit, mvff);
+ res = MVFFInsert(&range, mvff);
AVER(res == ResOK);
if (res == ResOK)
- MVFFFreeSegs(mvff, base, limit);
+ MVFFFreeSegs(mvff, &range);
return;
}
-/* MVFFFindLargest -- call CBSFindLargest and then fall back to
- * FreelistFindLargest if no block in the CBS was big enough. */
-
-static Bool MVFFFindLargest(Range range, Range oldRange, MVFF mvff,
- Size size, FindDelete findDelete)
-{
- AVER(range != NULL);
- AVER(oldRange != NULL);
- AVERT(MVFF, mvff);
- AVER(size > 0);
- AVERT(FindDelete, findDelete);
-
- FreelistFlushToCBS(FreelistOfMVFF(mvff), CBSOfMVFF(mvff));
-
- if (CBSFindLargest(range, oldRange, CBSOfMVFF(mvff), size, findDelete))
- return TRUE;
-
- if (FreelistFindLargest(range, oldRange, FreelistOfMVFF(mvff),
- size, findDelete))
- return TRUE;
-
- return FALSE;
-}
-
/* MVFFBufferFill -- Fill the buffer
*
@@ -447,18 +352,17 @@ static Res MVFFBufferFill(Addr *baseReturn, Addr *limitReturn,
AVER(SizeIsAligned(size, PoolAlignment(pool)));
AVERT(Bool, withReservoirPermit);
- found = MVFFFindLargest(&range, &oldRange, mvff, size, FindDeleteENTIRE);
+ found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size, FindDeleteENTIRE);
if (!found) {
- /* Add a new segment to the free list and try again. */
+ /* Add a new segment to the free lists and try again. */
res = MVFFAddSeg(&seg, mvff, size, withReservoirPermit);
if (res != ResOK)
return res;
- found = MVFFFindLargest(&range, &oldRange, mvff, size, FindDeleteENTIRE);
+ found = LandFindLargest(&range, &oldRange, FailoverOfMVFF(mvff), size, FindDeleteENTIRE);
}
AVER(found);
AVER(RangeSize(&range) >= size);
- mvff->free -= RangeSize(&range);
*baseReturn = RangeBase(&range);
*limitReturn = RangeLimit(&range);
@@ -473,21 +377,22 @@ static void MVFFBufferEmpty(Pool pool, Buffer buffer,
{
Res res;
MVFF mvff;
+ RangeStruct range;
AVERT(Pool, pool);
mvff = Pool2MVFF(pool);
AVERT(MVFF, mvff);
AVERT(Buffer, buffer);
AVER(BufferIsReady(buffer));
- AVER(base <= limit);
+ RangeInit(&range, base, limit);
- if (base == limit)
+ if (RangeIsEmpty(&range))
return;
- res = MVFFAddToFreeList(&base, &limit, mvff);
+ res = MVFFInsert(&range, mvff);
AVER(res == ResOK);
if (res == ResOK)
- MVFFFreeSegs(mvff, base, limit);
+ MVFFFreeSegs(mvff, &range);
return;
}
@@ -601,24 +506,37 @@ static Res MVFFInit(Pool pool, ArgList args)
SegPrefExpress(mvff->segPref, arenaHigh ? SegPrefHigh : SegPrefLow, NULL);
mvff->total = 0;
- mvff->free = 0;
- res = FreelistInit(FreelistOfMVFF(mvff), align);
+ res = LandInit(FreelistOfMVFF(mvff), FreelistLandClassGet(), arena, align,
+ mvff, mps_args_none);
if (res != ResOK)
- goto failInit;
+ goto failFreelistInit;
- res = CBSInit(CBSOfMVFF(mvff), arena, (void *)mvff, align,
- /* fastFind */ TRUE, /* zoned */ FALSE, args);
+ res = LandInit(CBSOfMVFF(mvff), CBSFastLandClassGet(), arena, align, mvff,
+ mps_args_none);
if (res != ResOK)
- goto failInit;
+ goto failCBSInit;
+
+ MPS_ARGS_BEGIN(foArgs) {
+ MPS_ARGS_ADD(foArgs, FailoverPrimary, CBSOfMVFF(mvff));
+ MPS_ARGS_ADD(foArgs, FailoverSecondary, FreelistOfMVFF(mvff));
+ res = LandInit(FailoverOfMVFF(mvff), FailoverLandClassGet(), arena, align,
+ mvff, foArgs);
+ } MPS_ARGS_END(foArgs);
+ if (res != ResOK)
+ goto failFailoverInit;
mvff->sig = MVFFSig;
AVERT(MVFF, mvff);
EVENT8(PoolInitMVFF, pool, arena, extendBy, avgSize, align,
- slotHigh, arenaHigh, firstFit);
+ BOOLOF(slotHigh), BOOLOF(arenaHigh), BOOLOF(firstFit));
return ResOK;
-failInit:
+failFailoverInit:
+ LandFinish(CBSOfMVFF(mvff));
+failCBSInit:
+ LandFinish(FreelistOfMVFF(mvff));
+failFreelistInit:
ControlFree(arena, p, sizeof(SegPrefStruct));
return res;
}
@@ -630,7 +548,6 @@ static void MVFFFinish(Pool pool)
{
MVFF mvff;
Arena arena;
- Seg seg;
Ring ring, node, nextNode;
AVERT(Pool, pool);
@@ -639,20 +556,24 @@ static void MVFFFinish(Pool pool)
ring = PoolSegRing(pool);
RING_FOR(node, ring, nextNode) {
+ Size size;
+ Seg seg;
seg = SegOfPoolRing(node);
AVER(SegPool(seg) == pool);
+ size = AddrOffset(SegBase(seg), SegLimit(seg));
+ AVER(size <= mvff->total);
+ mvff->total -= size;
SegFree(seg);
}
- /* Could maintain mvff->total here and check it falls to zero, */
- /* but that would just make the function slow. If only we had */
- /* a way to do operations only if AVERs are turned on. */
+ AVER(mvff->total == 0);
arena = PoolArena(pool);
ControlFree(arena, mvff->segPref, sizeof(SegPrefStruct));
- CBSFinish(CBSOfMVFF(mvff));
- FreelistFinish(FreelistOfMVFF(mvff));
+ LandFinish(FailoverOfMVFF(mvff));
+ LandFinish(FreelistOfMVFF(mvff));
+ LandFinish(CBSOfMVFF(mvff));
mvff->sig = SigInvalid;
}
@@ -691,16 +612,15 @@ static Res MVFFDescribe(Pool pool, mps_lib_FILE *stream)
" extendBy $W\n", (WriteFW)mvff->extendBy,
" avgSize $W\n", (WriteFW)mvff->avgSize,
" total $U\n", (WriteFU)mvff->total,
- " free $U\n", (WriteFU)mvff->free,
NULL);
if (res != ResOK)
return res;
- res = CBSDescribe(CBSOfMVFF(mvff), stream);
+ res = LandDescribe(CBSOfMVFF(mvff), stream);
if (res != ResOK)
return res;
- res = FreelistDescribe(FreelistOfMVFF(mvff), stream);
+ res = LandDescribe(FreelistOfMVFF(mvff), stream);
if (res != ResOK)
return res;
@@ -769,13 +689,15 @@ size_t mps_mvff_free_size(mps_pool_t mps_pool)
{
Pool pool;
MVFF mvff;
+ Land land;
pool = (Pool)mps_pool;
AVERT(Pool, pool);
mvff = Pool2MVFF(pool);
AVERT(MVFF, mvff);
+ land = FailoverOfMVFF(mvff);
- return (size_t)mvff->free;
+ return (size_t)LandSize(land);
}
/* Total owned bytes. See */
@@ -796,6 +718,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);
@@ -806,11 +729,11 @@ static Bool MVFFCheck(MVFF mvff)
CHECKL(mvff->minSegSize >= ArenaAlign(PoolArena(MVFF2Pool(mvff))));
CHECKL(mvff->avgSize > 0); /* see .arg.check */
CHECKL(mvff->avgSize <= mvff->extendBy); /* see .arg.check */
- CHECKL(mvff->total >= mvff->free);
- CHECKL(SizeIsAligned(mvff->free, PoolAlignment(MVFF2Pool(mvff))));
CHECKL(SizeIsAligned(mvff->total, ArenaAlign(PoolArena(MVFF2Pool(mvff)))));
- CHECKD(CBS, CBSOfMVFF(mvff));
- CHECKD(Freelist, FreelistOfMVFF(mvff));
+ CHECKD(CBS, &mvff->cbsStruct);
+ CHECKD(Freelist, &mvff->flStruct);
+ CHECKD(Failover, &mvff->foStruct);
+ CHECKL(mvff->total >= LandSize(FailoverOfMVFF(mvff)));
CHECKL(BoolCheck(mvff->slotHigh));
CHECKL(BoolCheck(mvff->firstFit));
return TRUE;
@@ -819,12 +742,10 @@ static Bool MVFFCheck(MVFF mvff)
/* Return the CBS of an MVFF pool for the benefit of fotest.c. */
-extern CBS _mps_mvff_cbs(mps_pool_t);
-CBS _mps_mvff_cbs(mps_pool_t mps_pool) {
- Pool pool;
+extern Land _mps_mvff_cbs(Pool);
+Land _mps_mvff_cbs(Pool pool) {
MVFF mvff;
- pool = (Pool)mps_pool;
AVERT(Pool, pool);
mvff = Pool2MVFF(pool);
AVERT(MVFF, mvff);
diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c
index e9afe98a96b..139865fc5ec 100644
--- a/mps/code/poolsnc.c
+++ b/mps/code/poolsnc.c
@@ -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);
diff --git a/mps/code/prmci3li.c b/mps/code/prmci3li.c
index 6a36ae7db2b..5b5d150b8cc 100644
--- a/mps/code/prmci3li.c
+++ b/mps/code/prmci3li.c
@@ -36,27 +36,34 @@ SRCID(prmci3li, "$Id$");
MRef Prmci3AddressHoldingReg(MutatorFaultContext mfc, unsigned int regnum)
{
+ MRef gregs;
+
+ AVER(mfc != NULL);
AVER(NONNEGATIVE(regnum));
AVER(regnum <= 7);
+ AVER(mfc->ucontext != NULL);
+
+ /* TODO: The current arrangement of the fix operation (taking a Ref *)
+ forces us to pun these registers (actually `int` on LII3GC). We can
+ suppress the warning by casting through `void *` and this might make
+ it safe, but does it really? RB 2012-09-10 */
+ AVER(sizeof(void *) == sizeof(*mfc->ucontext->uc_mcontext.gregs));
+ gregs = (void *)mfc->ucontext->uc_mcontext.gregs;
/* .source.i486 */
/* .assume.regref */
/* The register numbers (REG_EAX etc.) are defined in
but only if _GNU_SOURCE is defined: see .feature.li in
config.h. */
- /* TODO: The current arrangement of the fix operation (taking a Ref *)
- forces us to pun these registers (actually `int` on LII3GC). We can
- suppress the warning my casting through `char *` and this might make
- it safe, but does it really? RB 2012-09-10 */
switch (regnum) {
- case 0: return (MRef)((char *)&mfc->ucontext->uc_mcontext.gregs[REG_EAX]);
- case 1: return (MRef)((char *)&mfc->ucontext->uc_mcontext.gregs[REG_ECX]);
- case 2: return (MRef)((char *)&mfc->ucontext->uc_mcontext.gregs[REG_EDX]);
- case 3: return (MRef)((char *)&mfc->ucontext->uc_mcontext.gregs[REG_EBX]);
- case 4: return (MRef)((char *)&mfc->ucontext->uc_mcontext.gregs[REG_ESP]);
- case 5: return (MRef)((char *)&mfc->ucontext->uc_mcontext.gregs[REG_EBP]);
- case 6: return (MRef)((char *)&mfc->ucontext->uc_mcontext.gregs[REG_ESI]);
- case 7: return (MRef)((char *)&mfc->ucontext->uc_mcontext.gregs[REG_EDI]);
+ case 0: return &gregs[REG_EAX];
+ case 1: return &gregs[REG_ECX];
+ case 2: return &gregs[REG_EDX];
+ case 3: return &gregs[REG_EBX];
+ case 4: return &gregs[REG_ESP];
+ case 5: return &gregs[REG_EBP];
+ case 6: return &gregs[REG_ESI];
+ case 7: return &gregs[REG_EDI];
default:
NOTREACHED;
return NULL; /* Avoids compiler warning. */
diff --git a/mps/code/prmci3xc.c b/mps/code/prmci3xc.c
index 786145fc084..eafeff61540 100644
--- a/mps/code/prmci3xc.c
+++ b/mps/code/prmci3xc.c
@@ -34,8 +34,13 @@ SRCID(prmci3li, "$Id$");
MRef Prmci3AddressHoldingReg(MutatorFaultContext mfc, unsigned int regnum)
{
+ THREAD_STATE_S *threadState;
+
+ AVER(mfc != NULL);
AVER(NONNEGATIVE(regnum));
AVER(regnum <= 7);
+ AVER(mfc->threadState != NULL);
+ threadState = mfc->threadState;
/* .source.i486 */
/* .assume.regref */
@@ -44,17 +49,17 @@ MRef Prmci3AddressHoldingReg(MutatorFaultContext mfc, unsigned int regnum)
config.h. */
/* TODO: The current arrangement of the fix operation (taking a Ref *)
forces us to pun these registers (actually `int` on LII3GC). We can
- suppress the warning my casting through `char *` and this might make
+ suppress the warning by casting through `void *` and this might make
it safe, but does it really? RB 2012-09-10 */
switch (regnum) {
- case 0: return (MRef)((char *)&mfc->threadState->__eax);
- case 1: return (MRef)((char *)&mfc->threadState->__ecx);
- case 2: return (MRef)((char *)&mfc->threadState->__edx);
- case 3: return (MRef)((char *)&mfc->threadState->__ebx);
- case 4: return (MRef)((char *)&mfc->threadState->__esp);
- case 5: return (MRef)((char *)&mfc->threadState->__ebp);
- case 6: return (MRef)((char *)&mfc->threadState->__esi);
- case 7: return (MRef)((char *)&mfc->threadState->__edi);
+ case 0: return (void *)&threadState->__eax;
+ case 1: return (void *)&threadState->__ecx;
+ case 2: return (void *)&threadState->__edx;
+ case 3: return (void *)&threadState->__ebx;
+ case 4: return (void *)&threadState->__esp;
+ case 5: return (void *)&threadState->__ebp;
+ case 6: return (void *)&threadState->__esi;
+ case 7: return (void *)&threadState->__edi;
default:
NOTREACHED;
return NULL; /* Avoids compiler warning. */
diff --git a/mps/code/prmci6li.c b/mps/code/prmci6li.c
index 2f8bf9afc62..c00c1359014 100644
--- a/mps/code/prmci6li.c
+++ b/mps/code/prmci6li.c
@@ -33,12 +33,19 @@ SRCID(prmci6li, "$Id$");
MRef Prmci6AddressHoldingReg(MutatorFaultContext mfc, unsigned int regnum)
{
- Word *gregs;
+ MRef gregs;
+ AVER(mfc != NULL);
AVER(NONNEGATIVE(regnum));
AVER(regnum <= 15);
+ AVER(mfc->ucontext != NULL);
- gregs = (Word *)&mfc->ucontext->uc_mcontext.gregs;
+ /* TODO: The current arrangement of the fix operation (taking a Ref *)
+ forces us to pun these registers (actually `int` on LII6GC). We can
+ suppress the warning by casting through `void *` and this might make
+ it safe, but does it really? RB 2012-09-10 */
+ AVER(sizeof(void *) == sizeof(*mfc->ucontext->uc_mcontext.gregs));
+ gregs = (void *)mfc->ucontext->uc_mcontext.gregs;
/* .assume.regref */
/* The register numbers (REG_RAX etc.) are defined in
diff --git a/mps/code/prmci6xc.c b/mps/code/prmci6xc.c
index 02ccb840b6c..131447cd0cc 100644
--- a/mps/code/prmci6xc.c
+++ b/mps/code/prmci6xc.c
@@ -31,33 +31,38 @@ SRCID(prmci6li, "$Id$");
MRef Prmci6AddressHoldingReg(MutatorFaultContext mfc, unsigned int regnum)
{
+ THREAD_STATE_S *threadState;
+
+ AVER(mfc != NULL);
AVER(NONNEGATIVE(regnum));
AVER(regnum <= 15);
+ AVER(mfc->threadState != NULL);
+ threadState = mfc->threadState;
/* .assume.regref */
/* The register numbers (REG_RAX etc.) are defined in
but only if _XOPEN_SOURCE is defined: see .feature.xc in
config.h. */
/* MRef (a Word *) is not compatible with pointers to the register
- types (actually a __uint64_t). To avoid aliasing optimization
- problems, The registers are cast through (char *) */
+ types (actually a __uint64_t). To avoid aliasing optimization
+ problems, the registers are cast through (void *). */
switch (regnum) {
- case 0: return (MRef)((char *)&mfc->threadState->__rax);
- case 1: return (MRef)((char *)&mfc->threadState->__rcx);
- case 2: return (MRef)((char *)&mfc->threadState->__rdx);
- case 3: return (MRef)((char *)&mfc->threadState->__rbx);
- case 4: return (MRef)((char *)&mfc->threadState->__rsp);
- case 5: return (MRef)((char *)&mfc->threadState->__rbp);
- case 6: return (MRef)((char *)&mfc->threadState->__rsi);
- case 7: return (MRef)((char *)&mfc->threadState->__rdi);
- case 8: return (MRef)((char *)&mfc->threadState->__r8);
- case 9: return (MRef)((char *)&mfc->threadState->__r9);
- case 10: return (MRef)((char *)&mfc->threadState->__r10);
- case 11: return (MRef)((char *)&mfc->threadState->__r11);
- case 12: return (MRef)((char *)&mfc->threadState->__r12);
- case 13: return (MRef)((char *)&mfc->threadState->__r13);
- case 14: return (MRef)((char *)&mfc->threadState->__r14);
- case 15: return (MRef)((char *)&mfc->threadState->__r15);
+ case 0: return (void *)&threadState->__rax;
+ case 1: return (void *)&threadState->__rcx;
+ case 2: return (void *)&threadState->__rdx;
+ case 3: return (void *)&threadState->__rbx;
+ case 4: return (void *)&threadState->__rsp;
+ case 5: return (void *)&threadState->__rbp;
+ case 6: return (void *)&threadState->__rsi;
+ case 7: return (void *)&threadState->__rdi;
+ case 8: return (void *)&threadState->__r8;
+ case 9: return (void *)&threadState->__r9;
+ case 10: return (void *)&threadState->__r10;
+ case 11: return (void *)&threadState->__r11;
+ case 12: return (void *)&threadState->__r12;
+ case 13: return (void *)&threadState->__r13;
+ case 14: return (void *)&threadState->__r14;
+ case 15: return (void *)&threadState->__r15;
default:
NOTREACHED;
return NULL; /* Avoids compiler warning. */
diff --git a/mps/code/protan.c b/mps/code/protan.c
index 51b2edd6df8..0e8abf8ac7e 100644
--- a/mps/code/protan.c
+++ b/mps/code/protan.c
@@ -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) { /* */
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 .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/protix.c b/mps/code/protix.c
index 31c272bc5b9..5b310333e84 100644
--- a/mps/code/protix.c
+++ b/mps/code/protix.c
@@ -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
#include
@@ -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 .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/protli.c b/mps/code/protli.c
index ba48cab7f51..dc38154f2b7 100644
--- a/mps/code/protli.c
+++ b/mps/code/protli.c
@@ -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
#include
diff --git a/mps/code/protsgix.c b/mps/code/protsgix.c
index 39f19c90b4c..e587ac86424 100644
--- a/mps/code/protsgix.c
+++ b/mps/code/protsgix.c
@@ -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 /* for many functions */
#include /* for getpid */
diff --git a/mps/code/protw3.c b/mps/code/protw3.c
index 43e0522c074..4ff3e85da42 100644
--- a/mps/code/protw3.c
+++ b/mps/code/protw3.c
@@ -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 .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/protxc.c b/mps/code/protxc.c
index 8f62bb3a5df..7e8f230d061 100644
--- a/mps/code/protxc.c
+++ b/mps/code/protxc.c
@@ -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$");
@@ -243,7 +240,7 @@ static void protCatchOne(void)
different size" warnings in GCC, for the XCI3GC build. */
mfcStruct.address = (Addr)(Word)request.code[1];
AVER(sizeof(*mfcStruct.threadState) == sizeof(THREAD_STATE_S));
- mfcStruct.threadState = (THREAD_STATE_S *)request.old_state;
+ mfcStruct.threadState = (void *)request.old_state;
if (ArenaAccess(mfcStruct.address,
AccessREAD | AccessWRITE,
@@ -282,6 +279,7 @@ static void protCatchOne(void)
* handler won't cause a deadlock.
*/
+ATTRIBUTE_NORETURN
static void *protCatchThread(void *p) {
UNUSED(p);
for (;;)
diff --git a/mps/code/qs.c b/mps/code/qs.c
index 4d78fc6bcb8..2a62a5ef71a 100644
--- a/mps/code/qs.c
+++ b/mps/code/qs.c
@@ -50,7 +50,7 @@ static mps_addr_t isMoved(mps_addr_t object);
static void copy(mps_addr_t object, mps_addr_t to);
static void pad(mps_addr_t base, size_t size);
-struct mps_fmt_A_s fmt_A_s =
+static struct mps_fmt_A_s fmt_A_s =
{
(mps_align_t)4,
scan, skip, copy,
@@ -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);
diff --git a/mps/code/range.c b/mps/code/range.c
index b54a001db2f..1c7f297c46d 100644
--- a/mps/code/range.c
+++ b/mps/code/range.c
@@ -15,7 +15,6 @@ SRCID(range, "$Id$");
Bool RangeCheck(Range range)
{
- CHECKS(Range, range);
CHECKL(range->base <= range->limit);
return TRUE;
@@ -29,14 +28,17 @@ void RangeInit(Range range, Addr base, Addr limit)
range->base = base;
range->limit = limit;
- range->sig = RangeSig;
AVERT(Range, range);
}
+void RangeInitSize(Range range, Addr base, Size size)
+{
+ RangeInit(range, base, AddrAdd(base, size));
+}
+
void RangeFinish(Range range)
{
AVERT(Range, range);
- range->sig = SigInvalid;
}
Res RangeDescribe(Range range, mps_lib_FILE *stream)
diff --git a/mps/code/range.h b/mps/code/range.h
index 0ff105f7f20..c6fd41bad5e 100644
--- a/mps/code/range.h
+++ b/mps/code/range.h
@@ -14,15 +14,8 @@
#include "mpmtypes.h"
-/* Signatures */
-
-#define RangeSig ((Sig)0x5196A493) /* SIGnature RANGE */
-
-
/* Prototypes */
-typedef struct RangeStruct *Range;
-
#define RangeBase(range) ((range)->base)
#define RangeLimit(range) ((range)->limit)
#define RangeSize(range) (AddrOffset(RangeBase(range), RangeLimit(range)))
@@ -30,6 +23,7 @@ typedef struct RangeStruct *Range;
#define RangeIsEmpty(range) (RangeSize(range) == 0)
extern void RangeInit(Range range, Addr base, Addr limit);
+extern void RangeInitSize(Range range, Addr base, Size size);
extern void RangeFinish(Range range);
extern Res RangeDescribe(Range range, mps_lib_FILE *stream);
extern Bool RangeCheck(Range range);
@@ -46,7 +40,6 @@ extern void RangeCopy(Range to, Range from);
/* Types */
typedef struct RangeStruct {
- Sig sig;
Addr base;
Addr limit;
} RangeStruct;
diff --git a/mps/code/reserv.c b/mps/code/reserv.c
index 02b18d66d88..c7dd0507482 100644
--- a/mps/code/reserv.c
+++ b/mps/code/reserv.c
@@ -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;
diff --git a/mps/code/ring.c b/mps/code/ring.c
index ff60149ce40..54902ec3818 100644
--- a/mps/code/ring.c
+++ b/mps/code/ring.c
@@ -1,7 +1,7 @@
/* ring.c: RING IMPLEMENTATION
*
* $Id$
- * Copyright (c) 2001,2003 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*
* .intro: This is a portable implementation of Rings.
*
@@ -52,6 +52,16 @@ Bool RingIsSingle(Ring ring)
return (ring->next == ring);
}
+Size RingLength(Ring ring)
+{
+ Size size = 0;
+ Ring node, next;
+ AVERT(Ring, ring);
+ RING_FOR(node, ring, next)
+ ++ size;
+ return size;
+}
+
/* RingInit -- initialize a ring node
*/
@@ -131,7 +141,7 @@ Ring (RingPrev)(Ring ring)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2003 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/ring.h b/mps/code/ring.h
index d5b64076f6c..cbde6afe814 100644
--- a/mps/code/ring.h
+++ b/mps/code/ring.h
@@ -1,7 +1,7 @@
/* ring.h: RING 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) 2001 Global Graphics Software.
*/
@@ -30,6 +30,7 @@ typedef struct RingStruct { /* double-ended queue structure */
extern Bool RingCheck(Ring ring);
extern Bool RingCheckSingle(Ring ring);
extern Bool RingIsSingle(Ring ring);
+extern Size RingLength(Ring ring);
/* .ring.init: */
extern void (RingInit)(Ring ring);
@@ -115,7 +116,7 @@ extern Ring (RingPrev)(Ring ring);
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2013 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/sac.c b/mps/code/sac.c
index 3854a40b0d5..58fca2b33c3 100644
--- a/mps/code/sac.c
+++ b/mps/code/sac.c
@@ -32,6 +32,7 @@ static Bool sacFreeListBlockCheck(SACFreeListBlock fb)
return TRUE;
}
+ATTRIBUTE_UNUSED
static Bool SACCheck(SAC sac)
{
Index i, j;
@@ -48,18 +49,20 @@ static Bool SACCheck(SAC sac)
CHECKL(esac->_middle > 0);
/* check classes above middle */
prevSize = esac->_middle;
- for (j = sac->middleIndex + 1, i = 0;
- j <= sac->classesCount; ++j, i += 2) {
+ for (j = sac->middleIndex + 1, i = 0; j < sac->classesCount; ++j, i += 2) {
CHECKL(prevSize < esac->_freelists[i]._size);
b = sacFreeListBlockCheck(&(esac->_freelists[i]));
if (!b) return b;
prevSize = esac->_freelists[i]._size;
}
/* check overlarge class */
- CHECKL(esac->_freelists[i-2]._size == SizeMAX);
- CHECKL(esac->_freelists[i-2]._count == 0);
- CHECKL(esac->_freelists[i-2]._count_max == 0);
- CHECKL(esac->_freelists[i-2]._blocks == NULL);
+ CHECKL(prevSize < esac->_freelists[i]._size);
+ b = sacFreeListBlockCheck(&(esac->_freelists[i]));
+ if (!b) return b;
+ CHECKL(esac->_freelists[i]._size == SizeMAX);
+ CHECKL(esac->_freelists[i]._count == 0);
+ CHECKL(esac->_freelists[i]._count_max == 0);
+ CHECKL(esac->_freelists[i]._blocks == NULL);
/* check classes below middle */
prevSize = esac->_middle;
for (j = sac->middleIndex, i = 1; j > 0; --j, i += 2) {
@@ -69,6 +72,7 @@ static Bool SACCheck(SAC sac)
prevSize = esac->_freelists[i]._size;
}
/* check smallest class */
+ CHECKL(prevSize > esac->_freelists[i]._size);
CHECKL(esac->_freelists[i]._size == 0);
b = sacFreeListBlockCheck(&(esac->_freelists[i]));
return b;
diff --git a/mps/code/seg.c b/mps/code/seg.c
index 069b2c50049..c674994a2b7 100644
--- a/mps/code/seg.c
+++ b/mps/code/seg.c
@@ -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, withReservoirPermit);
+ EVENT3(SegMerge, segLo, segHi, BOOLOF(withReservoirPermit));
/* Deallocate segHi object */
ControlFree(arena, segHi, class->size);
AVERT(Seg, segLo);
@@ -636,6 +640,10 @@ Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at,
AVER(at < limit);
AVERT(Bool, withReservoirPermit);
+ /* Can only split a buffered segment if the entire buffer is below
+ * the split point. */
+ AVER(SegBuffer(seg) == NULL || BufferLimit(SegBuffer(seg)) <= at);
+
ShieldFlush(arena); /* see */
/* Allocate the new segment object from the control pool */
@@ -678,10 +686,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 +706,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 */
@@ -1200,7 +1215,7 @@ static void gcSegSetGreyInternal(Seg seg, TraceSet oldGrey, TraceSet grey)
/* Internal method. Parameters are checked by caller */
gcseg = SegGCSeg(seg);
arena = PoolArena(SegPool(seg));
- seg->grey = grey;
+ seg->grey = BS_BITFIELD(Trace, grey);
/* If the segment is now grey and wasn't before, add it to the */
/* appropriate grey list so that TraceFindGrey can locate it */
@@ -1313,11 +1328,11 @@ static void gcSegSetWhite(Seg seg, TraceSet white)
AVERT_CRITICAL(Tract, tract);
AVER_CRITICAL(TRACT_SEG(&trseg, tract) && (trseg == seg));
- TractSetWhite(tract, white);
+ TractSetWhite(tract, BS_BITFIELD(Trace, white));
}
AVER(addr == limit);
- seg->white = white;
+ seg->white = BS_BITFIELD(Trace, white);
}
@@ -1350,7 +1365,7 @@ static void gcSegSetRankSet(Seg seg, RankSet rankSet)
arena = PoolArena(SegPool(seg));
oldRankSet = seg->rankSet;
- seg->rankSet = rankSet;
+ seg->rankSet = BS_BITFIELD(Rank, rankSet);
if (oldRankSet == RankSetEMPTY) {
if (rankSet != RankSetEMPTY) {
@@ -1427,7 +1442,7 @@ static void gcSegSetRankSummary(Seg seg, RankSet rankSet, RefSet summary)
wasShielded = (seg->rankSet != RankSetEMPTY && gcseg->summary != RefSetUNIV);
willbeShielded = (rankSet != RankSetEMPTY && summary != RefSetUNIV);
- seg->rankSet = rankSet;
+ seg->rankSet = BS_BITFIELD(Rank, rankSet);
gcseg->summary = summary;
if (willbeShielded && !wasShielded) {
diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c
index 978c352e0dd..20cedf67dd2 100644
--- a/mps/code/segsmss.c
+++ b/mps/code/segsmss.c
@@ -40,7 +40,6 @@ extern PoolClass AMSTPoolClassGet(void);
typedef struct AMSTStruct {
AMSStruct amsStruct; /* generic AMS structure */
- Chain chain; /* chain to use */
Bool failSegs; /* fail seg splits & merges when true */
Count splits; /* count of successful segment splits */
Count merges; /* count of successful segment merges */
@@ -59,6 +58,7 @@ typedef struct AMSTStruct *AMST;
/* AMSTCheck -- the check method for an AMST */
+ATTRIBUTE_UNUSED
static Bool AMSTCheck(AMST amst)
{
CHECKS(AMST, amst);
@@ -96,6 +96,7 @@ typedef struct AMSTSegStruct {
/* AMSTSegCheck -- check the AMST segment */
+ATTRIBUTE_UNUSED
static Bool AMSTSegCheck(AMSTSeg amstseg)
{
CHECKS(AMSTSeg, amstseg);
@@ -333,25 +334,30 @@ static Res AMSTInit(Pool pool, ArgList args)
Format format;
Chain chain;
Res res;
- static GenParamStruct genParam = { 1024, 0.2 };
+ unsigned gen = AMS_GEN_DEFAULT;
ArgStruct arg;
AVERT(Pool, pool);
-
+ AVERT(ArgList, args);
+
+ if (ArgPick(&arg, args, MPS_KEY_CHAIN))
+ chain = arg.val.chain;
+ else {
+ chain = ArenaGlobals(PoolArena(pool))->defaultChain;
+ gen = 1; /* avoid the nursery of the default chain by default */
+ }
+ if (ArgPick(&arg, args, MPS_KEY_GEN))
+ gen = arg.val.u;
ArgRequire(&arg, args, MPS_KEY_FORMAT);
format = arg.val.format;
- res = ChainCreate(&chain, pool->arena, 1, &genParam);
- if (res != ResOK)
- return res;
- res = AMSInitInternal(Pool2AMS(pool), format, chain, 0, FALSE);
+ res = AMSInitInternal(Pool2AMS(pool), format, chain, gen, FALSE);
if (res != ResOK)
return res;
amst = Pool2AMST(pool);
ams = Pool2AMS(pool);
ams->segSize = AMSTSegSizePolicy;
ams->segClass = AMSTSegClassGet;
- amst->chain = chain;
amst->failSegs = TRUE;
amst->splits = 0;
amst->merges = 0;
@@ -386,7 +392,6 @@ static void AMSTFinish(Pool pool)
AMSFinish(pool);
amst->sig = SigInvalid;
- ChainDestroy(amst->chain);
}
@@ -397,7 +402,7 @@ static Bool AMSSegIsFree(Seg seg)
AMSSeg amsseg;
AVERT(Seg, seg);
amsseg = Seg2AMSSeg(seg);
- return(amsseg->free == amsseg->grains);
+ return amsseg->freeGrains == amsseg->grains;
}
@@ -431,7 +436,7 @@ static Bool AMSSegRegionIsFree(Seg seg, Addr base, Addr limit)
* Used as a means of overriding the behaviour of AMSBufferFill.
* The code is similar to AMSBufferEmpty.
*/
-static void AMSUnallocateRange(Seg seg, Addr base, Addr limit)
+static void AMSUnallocateRange(AMS ams, Seg seg, Addr base, Addr limit)
{
AMSSeg amsseg;
Index baseIndex, limitIndex;
@@ -459,8 +464,10 @@ static void AMSUnallocateRange(Seg seg, Addr base, Addr limit)
BTResRange(amsseg->allocTable, baseIndex, limitIndex);
}
}
- amsseg->free += limitIndex - baseIndex;
- amsseg->newAlloc -= limitIndex - baseIndex;
+ amsseg->freeGrains += limitIndex - baseIndex;
+ AVER(amsseg->newGrains >= limitIndex - baseIndex);
+ amsseg->newGrains -= limitIndex - baseIndex;
+ PoolGenAccountForEmpty(&ams->pgen, AddrOffset(base, limit), FALSE);
}
@@ -469,7 +476,7 @@ static void AMSUnallocateRange(Seg seg, Addr base, Addr limit)
* Used as a means of overriding the behaviour of AMSBufferFill.
* The code is similar to AMSUnallocateRange.
*/
-static void AMSAllocateRange(Seg seg, Addr base, Addr limit)
+static void AMSAllocateRange(AMS ams, Seg seg, Addr base, Addr limit)
{
AMSSeg amsseg;
Index baseIndex, limitIndex;
@@ -497,9 +504,10 @@ static void AMSAllocateRange(Seg seg, Addr base, Addr limit)
BTSetRange(amsseg->allocTable, baseIndex, limitIndex);
}
}
- AVER(amsseg->free >= limitIndex - baseIndex);
- amsseg->free -= limitIndex - baseIndex;
- amsseg->newAlloc += limitIndex - baseIndex;
+ AVER(amsseg->freeGrains >= limitIndex - baseIndex);
+ amsseg->freeGrains -= limitIndex - baseIndex;
+ amsseg->newGrains += limitIndex - baseIndex;
+ PoolGenAccountForFill(&ams->pgen, AddrOffset(base, limit), FALSE);
}
@@ -524,6 +532,7 @@ static Res AMSTBufferFill(Addr *baseReturn, Addr *limitReturn,
PoolClass super;
Addr base, limit;
Arena arena;
+ AMS ams;
AMST amst;
Bool b;
Seg seg;
@@ -535,6 +544,7 @@ static Res AMSTBufferFill(Addr *baseReturn, Addr *limitReturn,
AVER(limitReturn != NULL);
/* other parameters are checked by next method */
arena = PoolArena(pool);
+ ams = Pool2AMS(pool);
amst = Pool2AMST(pool);
/* call next method */
@@ -556,14 +566,14 @@ static Res AMSTBufferFill(Addr *baseReturn, Addr *limitReturn,
Seg mergedSeg;
Res mres;
- AMSUnallocateRange(seg, base, limit);
+ AMSUnallocateRange(ams, seg, base, limit);
mres = SegMerge(&mergedSeg, segLo, seg, withReservoirPermit);
if (ResOK == mres) { /* successful merge */
- AMSAllocateRange(mergedSeg, base, limit);
+ AMSAllocateRange(ams, mergedSeg, base, limit);
/* leave range as-is */
} else { /* failed to merge */
AVER(amst->failSegs); /* deliberate fails only */
- AMSAllocateRange(seg, base, limit);
+ AMSAllocateRange(ams, seg, base, limit);
}
}
@@ -574,13 +584,13 @@ static Res AMSTBufferFill(Addr *baseReturn, Addr *limitReturn,
Addr mid = AddrAdd(base, half);
Seg segLo, segHi;
Res sres;
- AMSUnallocateRange(seg, mid, limit);
+ AMSUnallocateRange(ams, seg, mid, limit);
sres = SegSplit(&segLo, &segHi, seg, mid, withReservoirPermit);
if (ResOK == sres) { /* successful split */
limit = mid; /* range is lower segment */
} else { /* failed to split */
AVER(amst->failSegs); /* deliberate fails only */
- AMSAllocateRange(seg, mid, limit);
+ AMSAllocateRange(ams, seg, mid, limit);
}
}
@@ -756,14 +766,19 @@ static void *test(void *arg, size_t s)
mps_ap_t busy_ap;
mps_addr_t busy_init;
const char *indent = " ";
+ mps_chain_t chain;
+ static mps_gen_param_s genParam = {1024, 0.2};
arena = (mps_arena_t)arg;
(void)s; /* unused */
die(mps_fmt_create_A(&format, arena, dylan_fmt_A()), "fmt_create");
+ die(mps_chain_create(&chain, arena, 1, &genParam), "chain_create");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_FORMAT, format);
+ MPS_ARGS_ADD(args, MPS_KEY_CHAIN, chain);
+ MPS_ARGS_ADD(args, MPS_KEY_GEN, 0);
die(mps_pool_create_k(&pool, arena, mps_class_amst(), args),
"pool_create(amst)");
} MPS_ARGS_END(args);
@@ -834,11 +849,14 @@ 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);
mps_root_destroy(ambigRoot);
mps_pool_destroy(pool);
+ mps_chain_destroy(chain);
mps_fmt_destroy(format);
return NULL;
diff --git a/mps/code/splay.c b/mps/code/splay.c
index 7e061cd14f4..1b0e8afb8fd 100644
--- a/mps/code/splay.c
+++ b/mps/code/splay.c
@@ -945,13 +945,12 @@ Bool SplayTreeNeighbours(Tree *leftReturn, Tree *rightReturn,
/* SplayTreeFirst, SplayTreeNext -- iterators
*
- * SplayTreeFirst receives a key that must precede all
- * nodes in the tree. It returns TreeEMPTY if the tree is empty.
- * Otherwise, it splays the tree to the first node, and returns the
- * new root.
+ * SplayTreeFirst returns TreeEMPTY if the tree is empty. Otherwise,
+ * it splays the tree to the first node, and returns the new root.
*
* SplayTreeNext takes a tree and splays it to the successor of a key
- * and returns the new root. Returns TreeEMPTY is there are no successors.
+ * and returns the new root. Returns TreeEMPTY is there are no
+ * successors.
*
* SplayTreeFirst and SplayTreeNext do not require the tree to remain
* unmodified.
@@ -1006,7 +1005,7 @@ Tree SplayTreeNext(SplayTree splay, TreeKey oldKey) {
*/
static Res SplayNodeDescribe(Tree node, mps_lib_FILE *stream,
- SplayNodeDescribeMethod nodeDescribe) {
+ TreeDescribeMethod nodeDescribe) {
Res res;
#if defined(AVER_AND_CHECK)
@@ -1318,13 +1317,27 @@ void SplayNodeRefresh(SplayTree splay, Tree node)
}
+/* SplayNodeInit -- initialize client property without splaying */
+
+void SplayNodeInit(SplayTree splay, Tree node)
+{
+ AVERT(SplayTree, splay);
+ AVERT(Tree, node);
+ AVER(!TreeHasLeft(node)); /* otherwise, call SplayNodeRefresh */
+ AVER(!TreeHasRight(node)); /* otherwise, call SplayNodeRefresh */
+ AVER(SplayHasUpdate(splay)); /* otherwise, why call? */
+
+ splay->updateNode(splay, node);
+}
+
+
/* SplayTreeDescribe -- Describe a splay tree
*
* See .
*/
Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
- SplayNodeDescribeMethod nodeDescribe) {
+ TreeDescribeMethod nodeDescribe) {
Res res;
#if defined(AVER_AND_CHECK)
diff --git a/mps/code/splay.h b/mps/code/splay.h
index 86f7f470482..24b97c4b055 100644
--- a/mps/code/splay.h
+++ b/mps/code/splay.h
@@ -19,7 +19,6 @@ typedef Bool (*SplayTestNodeMethod)(SplayTree splay, Tree node,
void *closureP, Size closureS);
typedef Bool (*SplayTestTreeMethod)(SplayTree splay, Tree node,
void *closureP, Size closureS);
-typedef Res (*SplayNodeDescribeMethod)(Tree node, mps_lib_FILE *stream);
typedef void (*SplayUpdateNodeMethod)(SplayTree splay, Tree node);
extern void SplayTrivUpdate(SplayTree splay, Tree node);
@@ -70,9 +69,10 @@ extern Bool SplayFindLast(Tree *nodeReturn, SplayTree splay,
void *closureP, Size closureS);
extern void SplayNodeRefresh(SplayTree splay, Tree node);
+extern void SplayNodeInit(SplayTree splay, Tree node);
extern Res SplayTreeDescribe(SplayTree splay, mps_lib_FILE *stream,
- SplayNodeDescribeMethod nodeDescribe);
+ TreeDescribeMethod nodeDescribe);
extern void SplayDebugUpdate(SplayTree splay, Tree tree);
diff --git a/mps/code/ssan.c b/mps/code/ssan.c
index 6f632dd1d24..27233e7b9f6 100644
--- a/mps/code/ssan.c
+++ b/mps/code/ssan.c
@@ -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
+
#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*));
}
diff --git a/mps/code/steptest.c b/mps/code/steptest.c
index c1af5b01089..546eaa7e417 100644
--- a/mps/code/steptest.c
+++ b/mps/code/steptest.c
@@ -71,19 +71,19 @@ static mps_addr_t ambigRoots[ambigRootsCOUNT];
/* Things we want to measure. Times are all in microseconds. */
-double alloc_time; /* Time spent allocating */
-double max_alloc_time; /* Max time taken to allocate one object */
-double step_time; /* Time spent in mps_arena_step returning 1 */
-double max_step_time; /* Max time of mps_arena_step returning 1 */
-double no_step_time; /* Time spent in mps_arena_step returning 0 */
-double max_no_step_time; /* Max time of mps_arena_step returning 0 */
+static double alloc_time; /* Time spent allocating */
+static double max_alloc_time; /* Max time taken to allocate one object */
+static double step_time; /* Time spent in mps_arena_step returning 1 */
+static double max_step_time; /* Max time of mps_arena_step returning 1 */
+static double no_step_time; /* Time spent in mps_arena_step returning 0 */
+static double max_no_step_time; /* Max time of mps_arena_step returning 0 */
-double total_clock_time; /* Time spent reading the clock */
-long clock_reads; /* Number of times clock is read */
-long steps; /* # of mps_arena_step calls returning 1 */
-long no_steps; /* # of mps_arena_step calls returning 0 */
-size_t alloc_bytes; /* # of bytes allocated */
-long commit_failures; /* # of times mps_commit fails */
+static double total_clock_time; /* Time spent reading the clock */
+static long clock_reads; /* Number of times clock is read */
+static long steps; /* # of mps_arena_step calls returning 1 */
+static long no_steps; /* # of mps_arena_step calls returning 0 */
+static size_t alloc_bytes; /* # of bytes allocated */
+static long commit_failures; /* # of times mps_commit fails */
/* Operating-system dependent timing. Defines two functions, void
@@ -151,7 +151,7 @@ static double my_clock(void)
* on thrush.ravenbrook.com on 2002-06-28, clock_time goes from 5.43
* us near process start to 7.45 us later). */
-double clock_time; /* current estimate of time to read the clock */
+static double clock_time; /* current estimate of time to read the clock */
/* take at least this many microseconds to set the clock */
#define CLOCK_TIME_SET 10000
@@ -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);
diff --git a/mps/code/testlib.h b/mps/code/testlib.h
index 0912373031d..38a4c94bdab 100644
--- a/mps/code/testlib.h
+++ b/mps/code/testlib.h
@@ -28,13 +28,10 @@
/* Suppress Pelles C warnings at warning level 2 */
-/* Some of these are also done in config.h. */
+/* This is also done in config.h. */
#ifdef MPS_BUILD_PC
-/* "Structured Exception Handling is not portable." (mps_tramp). */
-#pragma warn(disable: 2008)
-
/* "Unreachable code" (AVER, if condition is constantly true). */
#pragma warn(disable: 2154)
@@ -71,6 +68,22 @@
#endif
+/* setenv -- set environment variable
+ *
+ * Windows lacks setenv(), but _putenv_s() has similar functionality.
+ *
+ *
+ * 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
diff --git a/mps/code/trace.c b/mps/code/trace.c
index 924badcd541..7ecd8a3790a 100644
--- a/mps/code/trace.c
+++ b/mps/code/trace.c
@@ -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;
}
@@ -628,33 +634,6 @@ static Res traceFlip(Trace trace)
return res;
}
-/* traceCopySizes -- preserve size information for later use
- *
- * A PoolGen's newSize is important information that we want to emit in
- * a diagnostic message at TraceStart. In order to do that we must copy
- * the information before Whiten changes it. This function does that.
- */
-
-static void traceCopySizes(Trace trace)
-{
- Ring node, nextNode;
- Index i;
- Arena arena = trace->arena;
-
- RING_FOR(node, &arena->chainRing, nextNode) {
- Chain chain = RING_ELT(Chain, chainRing, node);
-
- for(i = 0; i < chain->genCount; ++i) {
- Ring n, nn;
- GenDesc desc = &chain->gens[i];
- RING_FOR(n, &desc->locusRing, nn) {
- PoolGen gen = RING_ELT(PoolGen, genRing, n);
- gen->newSizeAtCreate = gen->newSize;
- }
- }
- }
- return;
-}
/* TraceCreate -- create a Trace object
*
@@ -671,6 +650,17 @@ static void traceCopySizes(Trace trace)
* This code is written to be adaptable to allocating Trace objects
* dynamically. */
+static void TraceCreatePoolGen(GenDesc gen)
+{
+ Ring n, nn;
+ RING_FOR(n, &gen->locusRing, nn) {
+ PoolGen pgen = RING_ELT(PoolGen, genRing, n);
+ EVENT11(TraceCreatePoolGen, gen, gen->capacity, gen->mortality, gen->zones,
+ pgen->pool, pgen->totalSize, pgen->freeSize, pgen->newSize,
+ pgen->oldSize, pgen->newDeferredSize, pgen->oldDeferredSize);
+ }
+}
+
Res TraceCreate(Trace *traceReturn, Arena arena, int why)
{
TraceId ti;
@@ -741,7 +731,24 @@ Res TraceCreate(Trace *traceReturn, Arena arena, int why)
/* .. _request.dylan.160098: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/dylan/160098 */
ShieldSuspend(arena);
- traceCopySizes(trace);
+ STATISTIC_STAT ({
+ /* Iterate over all chains, all GenDescs within a chain, and all
+ * PoolGens within a GenDesc. */
+ Ring node;
+ Ring nextNode;
+
+ RING_FOR(node, &arena->chainRing, nextNode) {
+ Chain chain = RING_ELT(Chain, chainRing, node);
+ Index i;
+ for (i = 0; i < chain->genCount; ++i) {
+ GenDesc gen = &chain->gens[i];
+ TraceCreatePoolGen(gen);
+ }
+ }
+
+ /* Now do topgen GenDesc, and all PoolGens within it. */
+ TraceCreatePoolGen(&arena->topGen);
+ });
*traceReturn = trace;
return ResOK;
@@ -797,10 +804,11 @@ void TraceDestroy(Trace trace)
(TraceStatReclaim, trace,
trace->reclaimCount, trace->reclaimSize));
+ EVENT1(TraceDestroy, trace);
+
trace->sig = SigInvalid;
trace->arena->busyTraces = TraceSetDel(trace->arena->busyTraces, trace);
trace->arena->flippedTraces = TraceSetDel(trace->arena->flippedTraces, trace);
- EVENT1(TraceDestroy, trace);
}
@@ -1502,21 +1510,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);
@@ -1526,7 +1544,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;
}
@@ -1540,9 +1565,9 @@ double TraceWorkFactor = 0.25;
*
* TraceStart should be passed a trace with state TraceINIT, i.e.,
* recently returned from TraceCreate, with some condemned segments
- * added. mortality is the fraction of the condemned set expected to
- * survive. finishingTime is relative to the current polling clock, see
- * .
+ * added. mortality is the fraction of the condemned set expected not
+ * to survive. finishingTime is relative to the current polling clock,
+ * see .
*
* .start.black: All segments are black w.r.t. a newly allocated trace.
* However, if TraceStart initialized segments to black when it
@@ -1564,19 +1589,6 @@ static Res rootGrey(Root root, void *p)
}
-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, top, i, desc,
- desc->capacity, desc->mortality, desc->zones,
- gen->pool, gen->nr, gen->totalSize,
- gen->newSizeAtCreate);
- }
-}
-
-
/* TraceStart -- start a trace whose white set has been established
*
* The main job of TraceStart is to set up the grey list for a trace. The
@@ -1641,26 +1653,6 @@ Res TraceStart(Trace trace, double mortality, double finishingTime)
} while (SegNext(&seg, arena, seg));
}
- STATISTIC_STAT ({
- /* @@ */
- /* Iterate over all chains, all GenDescs within a chain, */
- /* (and all PoolGens within a GenDesc). */
- Ring node;
- Ring nextNode;
- Index i;
-
- RING_FOR(node, &arena->chainRing, nextNode) {
- Chain chain = RING_ELT(Chain, chainRing, node);
- for(i = 0; i < chain->genCount; ++i) {
- GenDesc desc = &chain->gens[i];
- TraceStartPoolGen(chain, desc, FALSE, i);
- }
- }
-
- /* Now do topgen GenDesc (and all PoolGens within it). */
- TraceStartPoolGen(NULL, &arena->topGen, TRUE, 0);
- });
-
res = RootsIterate(ArenaGlobals(arena), rootGrey, (void *)trace);
AVER(res == ResOK);
@@ -1714,7 +1706,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 {
diff --git a/mps/code/traceanc.c b/mps/code/traceanc.c
index 675e18e1f95..8e0be12dac9 100644
--- a/mps/code/traceanc.c
+++ b/mps/code/traceanc.c
@@ -560,7 +560,7 @@ void ArenaRelease(Globals globals)
AVERT(Globals, globals);
arenaForgetProtection(globals);
globals->clamped = FALSE;
- (void)TracePoll(globals);
+ ArenaPoll(globals);
}
diff --git a/mps/code/tract.c b/mps/code/tract.c
index 2468887bc17..5ca5ab6f040 100644
--- a/mps/code/tract.c
+++ b/mps/code/tract.c
@@ -210,25 +210,25 @@ Res ChunkInit(Chunk chunk, Arena arena,
/* Add the chunk's free address space to the arena's freeCBS, so that
we can allocate from it. */
- if (arena->hasFreeCBS) {
- res = ArenaFreeCBSInsert(arena,
- PageIndexBase(chunk, chunk->allocBase),
- chunk->limit);
+ if (arena->hasFreeLand) {
+ res = ArenaFreeLandInsert(arena,
+ PageIndexBase(chunk, chunk->allocBase),
+ chunk->limit);
if (res != ResOK)
- goto failCBSInsert;
+ goto failLandInsert;
}
chunk->sig = ChunkSig;
AVERT(Chunk, chunk);
/* As part of the bootstrap, the first created chunk becomes the primary
- chunk. This step allows AreaFreeCBSInsert to allocate pages. */
+ chunk. This step allows AreaFreeLandInsert to allocate pages. */
if (arena->primary == NULL)
arena->primary = chunk;
return ResOK;
-failCBSInsert:
+failLandInsert:
(arena->class->chunkFinish)(chunk);
/* .no-clean: No clean-ups needed past this point for boot, as we will
discard the chunk. */
@@ -248,10 +248,10 @@ void ChunkFinish(Chunk chunk)
chunk->sig = SigInvalid;
RingRemove(&chunk->chunkRing);
- if (ChunkArena(chunk)->hasFreeCBS)
- ArenaFreeCBSDelete(ChunkArena(chunk),
- PageIndexBase(chunk, chunk->allocBase),
- chunk->limit);
+ if (ChunkArena(chunk)->hasFreeLand)
+ ArenaFreeLandDelete(ChunkArena(chunk),
+ PageIndexBase(chunk, chunk->allocBase),
+ chunk->limit);
if (chunk->arena->primary == chunk)
chunk->arena->primary = NULL;
diff --git a/mps/code/tract.h b/mps/code/tract.h
index c359032feee..b957e024fd1 100644
--- a/mps/code/tract.h
+++ b/mps/code/tract.h
@@ -37,9 +37,6 @@ typedef union PagePoolUnion {
*
* .tract: Tracts represent the grains of memory allocation from
* the arena. See .
- *
- * .bool: The hasSeg field is a boolean, but can't be represented
- * as type Bool. See .
*/
typedef struct TractStruct { /* Tract structure */
@@ -47,7 +44,7 @@ typedef struct TractStruct { /* Tract structure */
void *p; /* pointer for use of owning pool */
Addr base; /* Base address of the tract */
TraceSet white : TraceLIMIT; /* traces for which tract is white */
- unsigned hasSeg : 1; /* does tract have a seg in p? See .bool */
+ BOOLFIELD(hasSeg); /* does tract have a seg in p? */
} TractStruct;
diff --git a/mps/code/tree.h b/mps/code/tree.h
index 69ee841d3c3..5d9a6206670 100644
--- a/mps/code/tree.h
+++ b/mps/code/tree.h
@@ -25,6 +25,8 @@ typedef struct TreeStruct {
Tree left, right;
} TreeStruct;
+typedef Res (*TreeDescribeMethod)(Tree tree, mps_lib_FILE *stream);
+
/* TreeKey and TreeCompare -- ordered binary trees
*
diff --git a/mps/code/version.c b/mps/code/version.c
index 9f8d644e47a..4771c8a7c69 100644
--- a/mps/code/version.c
+++ b/mps/code/version.c
@@ -47,6 +47,7 @@ SRCID(version, "$Id$");
* (assuming we've made any substantial changes to the library this year).
*/
+extern char MPSCopyrightNotice[];
char MPSCopyrightNotice[] =
"Portions copyright (c) 2010-2014 Ravenbrook Limited and Global Graphics Software.";
@@ -59,6 +60,7 @@ char MPSCopyrightNotice[] =
* see also guide.mps.version.
*/
+extern char MPSVersionString[];
char MPSVersionString[] =
"@(#)Ravenbrook MPS, "
"product." MPS_PROD_STRING ", " MPS_RELEASE ", platform." MPS_PF_STRING
diff --git a/mps/code/vman.c b/mps/code/vman.c
index db7795c9f2e..2e68118e27d 100644
--- a/mps/code/vman.c
+++ b/mps/code/vman.c
@@ -1,7 +1,7 @@
/* vman.c: ANSI VM: MALLOC-BASED PSEUDO MEMORY MAPPING
*
* $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"
@@ -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 */
@@ -117,13 +118,13 @@ void VMDestroy(VM vm)
AVER(vm->mapped == (Size)0);
AVER(vm->reserved == AddrOffset(vm->base, vm->limit));
+ EVENT1(VMDestroy, vm);
+
memset((void *)vm->base, VMJunkBYTE, AddrOffset(vm->base, vm->limit));
free(vm->block);
vm->sig = SigInvalid;
- free(vm);
-
- EVENT1(VMDestroy, vm);
+ free(vm);
}
@@ -215,7 +216,7 @@ void VMUnmap(VM vm, Addr base, Addr limit)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2002 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/vmix.c b/mps/code/vmix.c
index 01a0919b820..0903a031a2c 100644
--- a/mps/code/vmix.c
+++ b/mps/code/vmix.c
@@ -1,7 +1,7 @@
/* vmix.c: VIRTUAL MEMORY MAPPING FOR UNIX (ISH)
*
* $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.
*
* .purpose: This is the implementation of the virtual memory mapping
* interface (vm.h) for Unix-like operating systems. It was created
@@ -186,6 +186,8 @@ void VMDestroy(VM vm)
AVERT(VM, vm);
AVER(vm->mapped == (Size)0);
+ EVENT1(VMDestroy, vm);
+
/* This appears to be pretty pointless, since the descriptor */
/* page is about to vanish completely. However, munmap might fail */
/* for some reason, and this would ensure that it was still */
@@ -197,8 +199,6 @@ void VMDestroy(VM vm)
r = munmap((void *)vm,
(size_t)SizeAlignUp(sizeof(VMStruct), vm->align));
AVER(r == 0);
-
- EVENT1(VMDestroy, vm);
}
@@ -304,7 +304,7 @@ void VMUnmap(VM vm, Addr base, Addr limit)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2013 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/vmw3.c b/mps/code/vmw3.c
index e82f14ccd51..5be8153c73c 100644
--- a/mps/code/vmw3.c
+++ b/mps/code/vmw3.c
@@ -1,7 +1,7 @@
/* vmw3.c: VIRTUAL MEMORY MAPPING 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.
*
* .design: See .
*
@@ -191,6 +191,8 @@ void VMDestroy(VM vm)
AVERT(VM, vm);
AVER(vm->mapped == 0);
+ EVENT1(VMDestroy, vm);
+
/* This appears to be pretty pointless, since the vm descriptor page
* is about to vanish completely. However, the VirtualFree might
* fail and it would be nice to have a dead sig there. */
@@ -201,7 +203,6 @@ void VMDestroy(VM vm)
b = VirtualFree((LPVOID)vm, (SIZE_T)0, MEM_RELEASE);
AVER(b != 0);
- EVENT1(VMDestroy, vm);
}
@@ -303,7 +304,7 @@ void VMUnmap(VM vm, Addr base, Addr limit)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2002 Ravenbrook Limited .
+ * Copyright (C) 2001-2014 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/w3i3mv.nmk b/mps/code/w3i3mv.nmk
index 97a669700cc..458fd033484 100644
--- a/mps/code/w3i3mv.nmk
+++ b/mps/code/w3i3mv.nmk
@@ -7,13 +7,22 @@ PFM = w3i3mv
PFMDEFS = /DCONFIG_PF_STRING="w3i3mv" /DCONFIG_PF_W3I3MV /DWIN32 /D_WINDOWS
+# MPM platform-specific sources.
+MPMPF = \
+ \
+ \
+ \
+ \
+ \
+ \
+ \
+ \
+ \
+
+
!INCLUDE commpre.nmk
!INCLUDE mv.nmk
-# MPM sources: core plus platform-specific.
-MPM = $(MPMCOMMON)