diff --git a/mps/.p4ignore b/mps/.p4ignore
index 25cd419ae6d..89c70e46dc5 100644
--- a/mps/.p4ignore
+++ b/mps/.p4ignore
@@ -8,16 +8,25 @@
# Patch results
*.orig
*.rej
+# Autoconf and Automake output
Makefile
autom4te.cache
config.log
config.status
+.deps
+.dirstamp
+bin
+lib
+# Misc
TAGS
*.dSYM
-code/*/*/*.d
*.pyc
test/obj
test/test/log
test/test/obj
....gcda
-....gcno
\ No newline at end of file
+....gcno
+\#*#
+*~
+.#.*
+core
diff --git a/mps/.renamed-gitignore b/mps/.renamed-gitignore
new file mode 120000
index 00000000000..c5c99a6a89c
--- /dev/null
+++ b/mps/.renamed-gitignore
@@ -0,0 +1 @@
+.p4ignore
\ No newline at end of file
diff --git a/mps/.travis.yml b/mps/.travis.yml
index d78b45e190a..049d3b8848a 100644
--- a/mps/.travis.yml
+++ b/mps/.travis.yml
@@ -16,5 +16,9 @@ notifications:
email:
- mps-travis@ravenbrook.com
irc: "irc.freenode.net#memorypoolsystem"
+# This shows how you can ask Travis to install or update packages.
+#before_install:
+# - if test "$TRAVIS_OS_NAME" = "linux"; then sudo apt-get -qq update; fi
+# - if test "$TRAVIS_OS_NAME" = "linux"; then sudo apt-get install -y gcc-4.7; fi
script:
- ./configure --prefix=$PWD/prefix && make install && make test
diff --git a/mps/Makefile.in b/mps/Makefile.in
index fe33a4d49f6..cdefe0890ea 100644
--- a/mps/Makefile.in
+++ b/mps/Makefile.in
@@ -1,7 +1,7 @@
# Makefile.in -- source for autoconf Makefile
#
# $Id$
-# Copyright (C) 2012-2014 Ravenbrook Limited. See end of file for license.
+# Copyright (C) 2012-2016 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.
@@ -71,7 +71,7 @@ make-install-dirs:
install: @INSTALL_TARGET@
test-make-build:
- $(MAKE) $(TARGET_OPTS) testci
+ $(MAKE) $(TARGET_OPTS) testci testratio testscheme
$(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 testpollnone
@@ -80,3 +80,44 @@ test-xcode-build:
$(XCODEBUILD) -config Release -target testci
test: @TEST_TARGET@
+
+
+# C. COPYRIGHT AND LICENSE
+#
+# Copyright (C) 2012-2016 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/.p4ignore b/mps/code/.p4ignore
index 7db90ebb062..70e69009357 100644
--- a/mps/code/.p4ignore
+++ b/mps/code/.p4ignore
@@ -14,6 +14,8 @@ lii6ll
w3i3mv
w3i6mv
xci3gc
+xci3ll
+xci6gc
xci6ll
# Visual Studio junk
Debug
@@ -33,6 +35,7 @@ mpsio*.txt
*.lib
*.exe
a.out
+core
# Xcode junk
xc
mps.xcodeproj/xcuserdata
@@ -53,3 +56,5 @@ tags
.DS_Store
# Emacs backups
*~
+# GNU make dependencies
+*/*/*.d
diff --git a/mps/code/.renamed-gitignore b/mps/code/.renamed-gitignore
new file mode 120000
index 00000000000..c5c99a6a89c
--- /dev/null
+++ b/mps/code/.renamed-gitignore
@@ -0,0 +1 @@
+.p4ignore
\ No newline at end of file
diff --git a/mps/code/abq.c b/mps/code/abq.c
index 0e9b808a277..b88914e3c17 100644
--- a/mps/code/abq.c
+++ b/mps/code/abq.c
@@ -1,7 +1,7 @@
/* abq.c: QUEUE IMPLEMENTATION
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*
* .purpose: A fixed-length FIFO queue.
*
@@ -41,8 +41,7 @@ Res ABQInit(Arena arena, ABQ abq, void *owner, Count elements, Size elementSize)
"empty" from "full" */
elements = elements + 1;
- res = ControlAlloc(&p, arena, ABQQueueSize(elements, elementSize),
- /* withReservoirPermit */ FALSE);
+ res = ControlAlloc(&p, arena, ABQQueueSize(elements, elementSize));
if (res != ResOK)
return res;
@@ -232,7 +231,7 @@ Count ABQDepth(ABQ abq)
/* ABQIterate -- call 'visitor' for each element in an ABQ */
-void ABQIterate(ABQ abq, ABQVisitor visitor, void *closureP, Size closureS)
+void ABQIterate(ABQ abq, ABQVisitor visitor, void *closure)
{
Index copy, index, in;
@@ -247,7 +246,7 @@ void ABQIterate(ABQ abq, ABQVisitor visitor, void *closureP, Size closureS)
void *element = ABQElement(abq, index);
Bool delete = FALSE;
Bool cont;
- cont = (*visitor)(&delete, element, closureP, closureS);
+ cont = (*visitor)(&delete, element, closure);
AVERT(Bool, cont);
AVERT(Bool, delete);
if (!delete) {
@@ -295,14 +294,15 @@ static Index ABQNextIndex(ABQ abq, Index index)
/* ABQElement -- return pointer to the index'th element in the queue
vector. */
-static void *ABQElement(ABQ abq, Index index) {
+static void *ABQElement(ABQ abq, Index index)
+{
return PointerAdd(abq->queue, index * abq->elementSize);
}
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/abq.h b/mps/code/abq.h
index 85cdfcd5756..90591de9a5f 100644
--- a/mps/code/abq.h
+++ b/mps/code/abq.h
@@ -24,7 +24,7 @@
typedef struct ABQStruct *ABQ;
typedef Res (*ABQDescribeElement)(void *element, mps_lib_FILE *stream, Count depth);
-typedef Bool (*ABQVisitor)(Bool *deleteReturn, void *element, void *closureP, Size closureS);
+typedef Bool (*ABQVisitor)(Bool *deleteReturn, void *element, void *closure);
extern Res ABQInit(Arena arena, ABQ abq, void *owner, Count elements, Size elementSize);
extern Bool ABQCheck(ABQ abq);
@@ -36,7 +36,7 @@ extern Res ABQDescribe(ABQ abq, ABQDescribeElement describeElement, mps_lib_FILE
extern Bool ABQIsEmpty(ABQ abq);
extern Bool ABQIsFull(ABQ abq);
extern Count ABQDepth(ABQ abq);
-extern void ABQIterate(ABQ abq, ABQVisitor visitor, void *closureP, Size closureS);
+extern void ABQIterate(ABQ abq, ABQVisitor visitor, void *closure);
/* Types */
@@ -50,10 +50,10 @@ typedef struct ABQStruct
void *queue;
/* Meter queue depth at each operation */
- METER_DECL(push);
- METER_DECL(pop);
- METER_DECL(peek);
- METER_DECL(delete);
+ METER_DECL(push)
+ METER_DECL(pop)
+ METER_DECL(peek)
+ METER_DECL(delete)
Sig sig;
} ABQStruct;
diff --git a/mps/code/abqtest.c b/mps/code/abqtest.c
index 9aad3351cb6..59f2a64fcd4 100644
--- a/mps/code/abqtest.c
+++ b/mps/code/abqtest.c
@@ -1,7 +1,7 @@
/* abqtest.c: AVAILABLE BLOCK QUEUE TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*/
#include "abq.h"
@@ -92,12 +92,10 @@ typedef struct TestClosureStruct {
} TestClosureStruct;
static Bool TestDeleteCallback(Bool *deleteReturn, void *element,
- void *closureP, Size closureS)
+ void *closure)
{
TestBlock *a = (TestBlock *)element;
- TestClosure cl = (TestClosure)closureP;
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureS);
+ TestClosure cl = (TestClosure)closure;
if (*a == cl->b) {
*deleteReturn = TRUE;
cl->res = ResOK;
@@ -145,13 +143,13 @@ static void step(void)
cdie(b != NULL, "found to delete");
cl.b = b;
cl.res = ResFAIL;
- ABQIterate(&abq, TestDeleteCallback, &cl, UNUSED_SIZE);
+ ABQIterate(&abq, TestDeleteCallback, &cl);
cdie(cl.res == ResOK, "ABQIterate");
}
}
}
-extern int main(int argc, char *argv[])
+int main(int argc, char *argv[])
{
mps_arena_t arena;
int i;
@@ -184,7 +182,7 @@ extern int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/airtest.c b/mps/code/airtest.c
index ad0ec456b99..8b5a6ac8a5c 100644
--- a/mps/code/airtest.c
+++ b/mps/code/airtest.c
@@ -1,7 +1,7 @@
/* airtest.c: AMBIGUOUS INTERIOR REFERENCE TEST
*
- * $Id: //info.ravenbrook.com/project/mps/branch/2014-01-15/nailboard/code/fotest.c#1 $
- * Copyright (c) 2014 Ravenbrook Limited. See end of file for license.
+ * $Id$
+ * Copyright (c) 2014-2016 Ravenbrook Limited. See end of file for license.
*
* .overview: This test case creates a bunch of vectors, registers
* them for finalization, and then discards the base pointers to those
@@ -163,7 +163,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2014 Ravenbrook Limited .
+ * Copyright (c) 2014-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/amcssth.c b/mps/code/amcssth.c
index 596d818bc0b..5b15a5535e9 100644
--- a/mps/code/amcssth.c
+++ b/mps/code/amcssth.c
@@ -1,21 +1,13 @@
/* amcssth.c: POOL CLASS AMC STRESS TEST WITH TWO THREADS
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
* Portions copyright (c) 2002 Global Graphics Software.
*
- * .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.
+ * 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.
*/
#include "fmtdy.h"
@@ -28,11 +20,6 @@
#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)
@@ -133,13 +120,17 @@ typedef struct closure_s {
static void *kid_thread(void *arg)
{
void *marker = ▮
- mps_thr_t thread;
+ mps_thr_t thread1, thread2;
mps_root_t reg_root;
mps_ap_t ap;
closure_t cl = arg;
- die(mps_thread_reg(&thread, (mps_arena_t)arena), "thread_reg");
- die(mps_root_create_thread(®_root, arena, thread, marker),
+ /* Register the thread twice to check this is supported -- see
+ *
+ */
+ die(mps_thread_reg(&thread1, arena), "thread_reg");
+ die(mps_thread_reg(&thread2, arena), "thread_reg");
+ die(mps_root_create_thread(®_root, arena, thread1, marker),
"root_create");
die(mps_ap_create(&ap, cl->pool, mps_rank_exact()), "BufferCreate(fooey)");
@@ -149,7 +140,8 @@ static void *kid_thread(void *arg)
mps_ap_destroy(ap);
mps_root_destroy(reg_root);
- mps_thread_dereg(thread);
+ mps_thread_dereg(thread2);
+ mps_thread_dereg(thread1);
return NULL;
}
@@ -157,8 +149,7 @@ static void *kid_thread(void *arg)
/* test -- the body of the test */
-static void test_pool(const char *name, mps_pool_t pool, size_t roots_count,
- int mode)
+static void test_pool(const char *name, mps_pool_t pool, size_t roots_count)
{
size_t i;
mps_word_t rampSwitch;
@@ -170,8 +161,7 @@ static void test_pool(const char *name, mps_pool_t pool, size_t roots_count,
closure_s cl;
int walked = FALSE, ramped = FALSE;
- printf("\n------ mode: %s pool: %s-------\n",
- mode == ModeWALK ? "WALK" : "COMMIT", name);
+ printf("\n------ pool: %s-------\n", name);
cl.pool = pool;
cl.roots_count = roots_count;
@@ -203,7 +193,7 @@ static void test_pool(const char *name, mps_pool_t pool, size_t roots_count,
size_t condemned = mps_message_gc_condemned_size(arena, msg);
size_t not_condemned = mps_message_gc_not_condemned_size(arena, msg);
- printf("\nCollection %lu finished:\n", collections++);
+ printf("\nCollection %lu finished:\n", (unsigned long)collections++);
printf("live %"PRIuLONGEST"\n", (ulongest_t)live);
printf("condemned %"PRIuLONGEST"\n", (ulongest_t)condemned);
printf("not_condemned %"PRIuLONGEST"\n", (ulongest_t)not_condemned);
@@ -217,7 +207,7 @@ static void test_pool(const char *name, mps_pool_t pool, size_t roots_count,
cdie(exactRoots[i] == objNULL || dylan_check(exactRoots[i]),
"all roots check");
- if (mode == ModeWALK && collections >= collectionsCOUNT / 2 && !walked)
+ if (collections >= collectionsCOUNT / 2 && !walked)
{
unsigned long count = 0;
mps_arena_park(arena);
@@ -278,7 +268,7 @@ static void test_pool(const char *name, mps_pool_t pool, size_t roots_count,
testthr_join(&kids[i], NULL);
}
-static void test_arena(int mode)
+static void test_arena(void)
{
size_t i;
mps_fmt_t format;
@@ -291,8 +281,6 @@ static void test_arena(int mode)
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, testArenaSIZE);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, rnd_grain(testArenaSIZE));
- if (mode == ModeCOMMIT)
- MPS_ARGS_ADD(args, MPS_KEY_COMMIT_LIMIT, 2 * testArenaSIZE);
die(mps_arena_create_k(&arena, mps_arena_class_vm(), args), "arena_create");
} MPS_ARGS_END(args);
mps_message_type_enable(arena, mps_message_type_gc());
@@ -324,8 +312,8 @@ static void test_arena(int mode)
die(mps_pool_create(&amcz_pool, arena, mps_class_amcz(), format, chain),
"pool_create(amcz)");
- test_pool("AMC", amc_pool, exactRootsCOUNT, mode);
- test_pool("AMCZ", amcz_pool, 0, mode);
+ test_pool("AMC", amc_pool, exactRootsCOUNT);
+ test_pool("AMCZ", amcz_pool, 0);
mps_arena_park(arena);
mps_pool_destroy(amc_pool);
@@ -342,8 +330,7 @@ static void test_arena(int mode)
int main(int argc, char *argv[])
{
testlib_init(argc, argv);
- test_arena(ModeWALK);
- test_arena(ModeCOMMIT);
+ test_arena();
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
return 0;
@@ -352,7 +339,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/amsss.c b/mps/code/amsss.c
index 8083123f482..38fa7457d17 100644
--- a/mps/code/amsss.c
+++ b/mps/code/amsss.c
@@ -1,7 +1,7 @@
/* amsss.c: POOL CLASS AMS STRESS TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
* Portions copyright (c) 2002 Global Graphics Software.
*
* .design: Adapted from amcss.c, but not counting collections, just
@@ -76,8 +76,6 @@ static void report(void)
mps_message_discard(arena, message);
}
-
- return;
}
@@ -249,7 +247,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/anangc.gmk b/mps/code/anangc.gmk
index f0a7d2ff515..1c5fb380e16 100644
--- a/mps/code/anangc.gmk
+++ b/mps/code/anangc.gmk
@@ -10,9 +10,9 @@ PFM = anangc
MPMPF = \
lockan.c \
prmcan.c \
+ prmcanan.c \
protan.c \
span.c \
- ssan.c \
than.c \
vman.c
diff --git a/mps/code/ananll.gmk b/mps/code/ananll.gmk
index cc95645f212..849adffa8b6 100644
--- a/mps/code/ananll.gmk
+++ b/mps/code/ananll.gmk
@@ -10,9 +10,9 @@ PFM = ananll
MPMPF = \
lockan.c \
prmcan.c \
+ prmcanan.c \
protan.c \
span.c \
- ssan.c \
than.c \
vman.c
diff --git a/mps/code/ananmv.nmk b/mps/code/ananmv.nmk
index 41d80a0671a..504140a772c 100644
--- a/mps/code/ananmv.nmk
+++ b/mps/code/ananmv.nmk
@@ -1,7 +1,7 @@
# ananmv.nmk: ANSI/ANSI/MICROSOFT VISUAL C/C++ NMAKE FILE -*- makefile -*-
#
# $Id$
-# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+# Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
PFM = ananmv
@@ -10,9 +10,9 @@ PFMDEFS = /DCONFIG_PF_ANSI /DCONFIG_THREAD_SINGLE
MPMPF = \
[lockan] \
[prmcan] \
+ [prmcanan] \
[protan] \
[span] \
- [ssan] \
[than] \
[vman]
@@ -23,7 +23,7 @@ MPMPF = \
# C. COPYRIGHT AND LICENSE
#
-# Copyright (C) 2001-2014 Ravenbrook Limited .
+# Copyright (C) 2001-2018 Ravenbrook Limited .
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
diff --git a/mps/code/apss.c b/mps/code/apss.c
index 5192baada42..05890ed2605 100644
--- a/mps/code/apss.c
+++ b/mps/code/apss.c
@@ -1,12 +1,11 @@
/* apss.c: AP MANUAL ALLOC STRESS TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2002 Global Graphics Software.
*/
-#include "mpscmv.h"
#include "mpscmvff.h"
#include "mpscmvt.h"
#include "mpslib.h"
@@ -23,6 +22,7 @@
#define testArenaSIZE ((((size_t)3)<<24) - 4)
#define testSetSIZE 200
#define testLOOPS 10
+#define MAX_ALIGN 64 /* TODO: Make this test work up to arena_grain_size? */
/* make -- allocate one object */
@@ -76,11 +76,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
/* allocate a load of objects */
for (i=0; i= sizeof(ps[i]))
*ps[i] = 1; /* Write something, so it gets swap. */
@@ -120,10 +121,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
}
/* allocate some new objects */
for (i=testSetSIZE/2; i.
+ * Copyright (c) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/arena.c b/mps/code/arena.c
index 9ea95d57822..8702b290a72 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -1,12 +1,12 @@
/* arena.c: ARENA ALLOCATION FEATURES
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*
* .sources: is the main design document. */
#include "tract.h"
-#include "poolmv.h"
+#include "poolmvff.h"
#include "mpm.h"
#include "cbs.h"
#include "bt.h"
@@ -17,7 +17,7 @@
SRCID(arena, "$Id$");
-#define ArenaControlPool(arena) MVPool(&(arena)->controlPoolStruct)
+#define ArenaControlPool(arena) MVFFPool(&(arena)->controlPoolStruct)
#define ArenaCBSBlockPool(arena) MFSPool(&(arena)->freeCBSBlockPoolStruct)
#define ArenaFreeLand(arena) CBSLand(&(arena)->freeLandStruct)
@@ -42,87 +42,130 @@ Bool ArenaGrainSizeCheck(Size size)
static void ArenaTrivCompact(Arena arena, Trace trace);
static void arenaFreePage(Arena arena, Addr base, Pool pool);
static void arenaFreeLandFinish(Arena arena);
+static Res ArenaAbsInit(Arena arena, Size grainSize, ArgList args);
+static void ArenaAbsFinish(Inst inst);
+static Res ArenaAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth);
-/* ArenaTrivDescribe -- produce trivial description of an arena */
-
-static Res ArenaTrivDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
+static void ArenaNoFree(Addr base, Size size, Pool pool)
{
- if (!TESTT(Arena, arena))
- return ResFAIL;
- if (stream == NULL)
- return ResFAIL;
+ UNUSED(base);
+ UNUSED(size);
+ UNUSED(pool);
+ NOTREACHED;
+}
- /* .describe.triv.never-called-from-subclass-method:
- * This Triv method seems to assume that it will never get called
- * from a subclass-method invoking ARENA_SUPERCLASS()->describe.
- * It assumes that it only gets called if the describe method has
- * not been subclassed. (That's the only reason for printing the
- * "No class-specific description available" message).
- * This is bogus, but that's the status quo. RHSK 2007-04-27.
- */
- /* .describe.triv.dont-upcall: Therefore (for now) the last
- * subclass describe method should avoid invoking
- * ARENA_SUPERCLASS()->describe. RHSK 2007-04-27.
- */
- return WriteF(stream, depth,
- " No class-specific description available.\n", NULL);
+static Res ArenaNoChunkInit(Chunk chunk, BootBlock boot)
+{
+ UNUSED(chunk);
+ UNUSED(boot);
+ NOTREACHED;
+ return ResUNIMPL;
+}
+
+static void ArenaNoChunkFinish(Chunk chunk)
+{
+ UNUSED(chunk);
+ NOTREACHED;
+}
+
+static Res ArenaNoPagesMarkAllocated(Arena arena, Chunk chunk,
+ Index baseIndex, Count pages,
+ Pool pool)
+{
+ UNUSED(arena);
+ UNUSED(chunk);
+ UNUSED(baseIndex);
+ UNUSED(pages);
+ UNUSED(pool);
+ NOTREACHED;
+ return ResUNIMPL;
+}
+
+static Bool ArenaNoChunkPageMapped(Chunk chunk, Index index)
+{
+ UNUSED(chunk);
+ UNUSED(index);
+ NOTREACHED;
+ return FALSE;
+}
+
+static Res ArenaNoCreate(Arena *arenaReturn, ArgList args)
+{
+ UNUSED(arenaReturn);
+ UNUSED(args);
+ NOTREACHED;
+ return ResUNIMPL;
+}
+
+static void ArenaNoDestroy(Arena arena)
+{
+ UNUSED(arena);
+ NOTREACHED;
+}
+
+DEFINE_CLASS(Inst, ArenaClass, klass)
+{
+ INHERIT_CLASS(klass, ArenaClass, InstClass);
+ AVERT(InstClass, klass);
}
-/* AbstractArenaClass -- The abstract arena class definition
- *
- * .null: Most abstract class methods are set to NULL. See
- * . */
+/* AbstractArenaClass -- The abstract arena class definition */
-typedef ArenaClassStruct AbstractArenaClassStruct;
-
-DEFINE_CLASS(AbstractArenaClass, class)
+DEFINE_CLASS(Arena, AbstractArena, klass)
{
- INHERIT_CLASS(&class->protocol, ProtocolClass);
- class->name = "ABSARENA";
- class->size = 0;
- class->offset = 0;
- class->varargs = ArgTrivVarargs;
- class->init = NULL;
- class->finish = NULL;
- class->purgeSpare = ArenaNoPurgeSpare;
- class->extend = ArenaNoExtend;
- class->grow = ArenaNoGrow;
- class->free = NULL;
- class->chunkInit = NULL;
- class->chunkFinish = NULL;
- class->compact = ArenaTrivCompact;
- class->describe = ArenaTrivDescribe;
- class->pagesMarkAllocated = NULL;
- class->sig = ArenaClassSig;
+ INHERIT_CLASS(&klass->instClassStruct, AbstractArena, Inst);
+ klass->instClassStruct.finish = ArenaAbsFinish;
+ klass->instClassStruct.describe = ArenaAbsDescribe;
+ klass->size = sizeof(ArenaStruct);
+ klass->varargs = ArgTrivVarargs;
+ klass->init = ArenaAbsInit;
+ klass->create = ArenaNoCreate;
+ klass->destroy = ArenaNoDestroy;
+ klass->purgeSpare = ArenaNoPurgeSpare;
+ klass->extend = ArenaNoExtend;
+ klass->grow = ArenaNoGrow;
+ klass->free = ArenaNoFree;
+ klass->chunkInit = ArenaNoChunkInit;
+ klass->chunkFinish = ArenaNoChunkFinish;
+ klass->compact = ArenaTrivCompact;
+ klass->pagesMarkAllocated = ArenaNoPagesMarkAllocated;
+ klass->chunkPageMapped = ArenaNoChunkPageMapped;
+ klass->sig = ArenaClassSig;
+ AVERT(ArenaClass, klass);
}
/* ArenaClassCheck -- check the consistency of an arena class */
-Bool ArenaClassCheck(ArenaClass class)
+Bool ArenaClassCheck(ArenaClass klass)
{
- CHECKD(ProtocolClass, &class->protocol);
- CHECKL(class->name != NULL); /* Should be <=6 char C identifier */
- CHECKL(class->size >= sizeof(ArenaStruct));
- /* Offset of generic Pool within class-specific instance cannot be */
- /* greater than the size of the class-specific portion of the */
- /* instance. */
- CHECKL(class->offset <= (size_t)(class->size - sizeof(ArenaStruct)));
- CHECKL(FUNCHECK(class->varargs));
- CHECKL(FUNCHECK(class->init));
- CHECKL(FUNCHECK(class->finish));
- CHECKL(FUNCHECK(class->purgeSpare));
- CHECKL(FUNCHECK(class->extend));
- CHECKL(FUNCHECK(class->grow));
- CHECKL(FUNCHECK(class->free));
- CHECKL(FUNCHECK(class->chunkInit));
- CHECKL(FUNCHECK(class->chunkFinish));
- CHECKL(FUNCHECK(class->compact));
- CHECKL(FUNCHECK(class->describe));
- CHECKL(FUNCHECK(class->pagesMarkAllocated));
- CHECKS(ArenaClass, class);
+ CHECKD(InstClass, &klass->instClassStruct);
+ CHECKL(klass->size >= sizeof(ArenaStruct));
+ CHECKL(FUNCHECK(klass->varargs));
+ CHECKL(FUNCHECK(klass->init));
+ CHECKL(FUNCHECK(klass->create));
+ CHECKL(FUNCHECK(klass->destroy));
+ CHECKL(FUNCHECK(klass->purgeSpare));
+ CHECKL(FUNCHECK(klass->extend));
+ CHECKL(FUNCHECK(klass->grow));
+ CHECKL(FUNCHECK(klass->free));
+ CHECKL(FUNCHECK(klass->chunkInit));
+ CHECKL(FUNCHECK(klass->chunkFinish));
+ CHECKL(FUNCHECK(klass->compact));
+ CHECKL(FUNCHECK(klass->pagesMarkAllocated));
+ CHECKL(FUNCHECK(klass->chunkPageMapped));
+
+ /* Check that arena classes override sets of related methods. */
+ CHECKL((klass->init == ArenaAbsInit)
+ == (klass->instClassStruct.finish == ArenaAbsFinish));
+ CHECKL((klass->create == ArenaNoCreate)
+ == (klass->destroy == ArenaNoDestroy));
+ CHECKL((klass->chunkInit == ArenaNoChunkInit)
+ == (klass->chunkFinish == ArenaNoChunkFinish));
+
+ CHECKS(ArenaClass, klass);
return TRUE;
}
@@ -131,14 +174,12 @@ Bool ArenaClassCheck(ArenaClass class)
Bool ArenaCheck(Arena arena)
{
- CHECKS(Arena, arena);
+ CHECKC(AbstractArena, arena);
CHECKD(Globals, ArenaGlobals(arena));
- CHECKD(ArenaClass, arena->class);
CHECKL(BoolCheck(arena->poolReady));
if (arena->poolReady) { /* */
- CHECKD(MV, &arena->controlPoolStruct);
- CHECKD(Reservoir, &arena->reservoirStruct);
+ CHECKD(MVFF, &arena->controlPoolStruct);
}
/* .reserved.check: Would like to check that arena->committed <=
@@ -149,12 +190,15 @@ Bool ArenaCheck(Arena arena)
*/
CHECKL(arena->committed <= arena->commitLimit);
CHECKL(arena->spareCommitted <= arena->committed);
+ CHECKL(0.0 <= arena->pauseTime);
- CHECKL(ShiftCheck(arena->zoneShift));
+ CHECKL(arena->zoneShift == ZoneShiftUNSET
+ || ShiftCheck(arena->zoneShift));
CHECKL(ArenaGrainSizeCheck(arena->grainSize));
/* Stripes can't be smaller than grains. */
- CHECKL(((Size)1 << arena->zoneShift) >= arena->grainSize);
+ CHECKL(arena->zoneShift == ZoneShiftUNSET
+ || ((Size)1 << arena->zoneShift) >= arena->grainSize);
if (arena->lastTract == NULL) {
CHECKL(arena->lastTractBase == (Addr)0);
@@ -165,7 +209,7 @@ Bool ArenaCheck(Arena arena)
if (arena->primary != NULL) {
CHECKD(Chunk, arena->primary);
}
- CHECKD_NOSIG(Ring, &arena->chunkRing);
+ CHECKD_NOSIG(Ring, ArenaChunkRing(arena));
/* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
CHECKL(TreeCheck(ArenaChunkTree(arena)));
/* TODO: check that the chunkRing and chunkTree have identical members */
@@ -183,26 +227,18 @@ Bool ArenaCheck(Arena arena)
}
-/* ArenaInit -- initialize the generic part of the arena
- *
- * .init.caller: ArenaInit is called by class->init (which is called
- * by ArenaCreate). The initialization must proceed in this order, as
- * opposed to class->init being called by ArenaInit, which would
- * correspond to the initialization order for pools and other objects,
- * because the memory for the arena structure is not available until
- * it has been allocated by the arena class.
- */
+/* ArenaAbsInit -- initialize the generic part of the arena */
-Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
+static Res ArenaAbsInit(Arena arena, Size grainSize, ArgList args)
{
Res res;
Bool zoned = ARENA_DEFAULT_ZONED;
Size commitLimit = ARENA_DEFAULT_COMMIT_LIMIT;
double spare = ARENA_SPARE_DEFAULT;
+ double pauseTime = ARENA_DEFAULT_PAUSE_TIME;
mps_arg_s arg;
AVER(arena != NULL);
- AVERT(ArenaClass, class);
AVERT(ArenaGrainSize, grainSize);
if (ArgPick(&arg, args, MPS_KEY_ARENA_ZONED))
@@ -214,17 +250,21 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
/* MPS_KEY_SPARE_COMMIT_LIMIT is deprecated */
if (ArgPick(&arg, args, MPS_KEY_SPARE_COMMIT_LIMIT))
spare = (double)arg.val.size / (double)commitLimit;
+ if (ArgPick(&arg, args, MPS_KEY_PAUSE_TIME))
+ pauseTime = arg.val.d;
- arena->class = class;
+ /* Superclass init */
+ InstInit(CouldBeA(Inst, arena));
arena->reserved = (Size)0;
arena->committed = (Size)0;
arena->commitLimit = commitLimit;
arena->spareCommitted = (Size)0;
arena->spare = spare;
+ arena->pauseTime = pauseTime;
arena->grainSize = grainSize;
- /* zoneShift is usually overridden by init */
- arena->zoneShift = ARENA_ZONESHIFT;
+ /* zoneShift must be overridden by arena class init */
+ arena->zoneShift = ZoneShiftUNSET;
arena->poolReady = FALSE; /* */
arena->lastTract = NULL;
arena->lastTractBase = NULL;
@@ -233,7 +273,7 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
arena->zoned = zoned;
arena->primary = NULL;
- RingInit(&arena->chunkRing);
+ RingInit(ArenaChunkRing(arena));
arena->chunkTree = TreeEMPTY;
arena->chunkSerial = (Serial)0;
@@ -243,8 +283,9 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
if (res != ResOK)
goto failGlobalsInit;
+ SetClassOfPoly(arena, CLASS(AbstractArena));
arena->sig = ArenaSig;
- AVERT(Arena, arena);
+ AVERC(Arena, arena);
/* Initialise a pool to hold the CBS blocks for the arena's free
* land. This pool can't be allowed to extend itself using
@@ -262,19 +303,12 @@ Res ArenaInit(Arena arena, ArenaClass class, Size grainSize, ArgList args)
if (res != ResOK)
goto failMFSInit;
- /* initialize the reservoir, */
- res = ReservoirInit(&arena->reservoirStruct, arena);
- if (res != ResOK)
- goto failReservoirInit;
-
- AVERT(Arena, arena);
return ResOK;
-failReservoirInit:
- PoolFinish(ArenaCBSBlockPool(arena));
failMFSInit:
GlobalsFinish(ArenaGlobals(arena));
failGlobalsInit:
+ InstFinish(MustBeA(Inst, arena));
return res;
}
@@ -297,6 +331,7 @@ ARG_DEFINE_KEY(ARENA_SIZE, Size);
ARG_DEFINE_KEY(ARENA_ZONED, Bool);
ARG_DEFINE_KEY(COMMIT_LIMIT, Size);
ARG_DEFINE_KEY(SPARE_COMMIT_LIMIT, Size);
+ARG_DEFINE_KEY(PAUSE_TIME, double);
static Res arenaFreeLandInit(Arena arena)
{
@@ -309,7 +344,7 @@ static Res arenaFreeLandInit(Arena arena)
/* Initialise the free land. */
MPS_ARGS_BEGIN(liArgs) {
MPS_ARGS_ADD(liArgs, CBSBlockPool, ArenaCBSBlockPool(arena));
- res = LandInit(ArenaFreeLand(arena), CBSZonedLandClassGet(), arena,
+ res = LandInit(ArenaFreeLand(arena), CLASS(CBSZoned), arena,
ArenaGrainSize(arena), arena, liArgs);
} MPS_ARGS_END(liArgs);
AVER(res == ResOK); /* no allocation, no failure expected */
@@ -335,13 +370,13 @@ static Res arenaFreeLandInit(Arena arena)
return res;
}
-Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
+Res ArenaCreate(Arena *arenaReturn, ArenaClass klass, ArgList args)
{
Arena arena;
Res res;
AVER(arenaReturn != NULL);
- AVERT(ArenaClass, class);
+ AVERT(ArenaClass, klass);
AVERT(ArgList, args);
/* We must initialise the event subsystem very early, because event logging
@@ -349,12 +384,17 @@ Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
to the EventLast pointers. */
EventInit();
- /* Do initialization. This will call ArenaInit (see .init.caller). */
- res = (*class->init)(&arena, class, args);
+ res = klass->create(&arena, args);
if (res != ResOK)
goto failInit;
- /* Grain size must have been set up by *class->init() */
+ /* Zone shift must have been set up by klass->create() */
+ AVER(ShiftCheck(arena->zoneShift));
+
+ /* TODO: Consider how each of the stages below could be incorporated
+ into arena initialization, rather than tacked on here. */
+
+ /* Grain size must have been set up by klass->create() */
if (ArenaGrainSize(arena) > ((Size)1 << arena->zoneShift)) {
res = ResMEMORY; /* size was too small */
goto failStripeSize;
@@ -382,26 +422,24 @@ Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
arenaFreeLandFinish(arena);
failFreeLandInit:
failStripeSize:
- (*class->finish)(arena);
+ klass->destroy(arena);
failInit:
return res;
}
-/* ArenaFinish -- finish the generic part of the arena
- *
- * .finish.caller: Unlike PoolFinish, this is called by the class finish
- * methods, not the generic Destroy. This is because the class is
- * responsible for deallocating the descriptor. */
+/* ArenaAbsFinish -- finish the generic part of the arena */
-void ArenaFinish(Arena arena)
+static void ArenaAbsFinish(Inst inst)
{
+ Arena arena = MustBeA(AbstractArena, inst);
+ AVERC(Arena, arena);
PoolFinish(ArenaCBSBlockPool(arena));
- ReservoirFinish(ArenaReservoir(arena));
arena->sig = SigInvalid;
+ NextMethod(Inst, AbstractArena, finish)(inst);
GlobalsFinish(ArenaGlobals(arena));
LocusFinish(arena);
- RingFinish(&arena->chunkRing);
+ RingFinish(ArenaChunkRing(arena));
AVER(ArenaChunkTree(arena) == TreeEMPTY);
}
@@ -409,13 +447,11 @@ void ArenaFinish(Arena arena)
/* ArenaDestroy -- destroy the arena */
static void arenaMFSPageFreeVisitor(Pool pool, Addr base, Size size,
- void *closureP, Size closureS)
+ void *closure)
{
AVERT(Pool, pool);
- AVER(closureP == UNUSED_POINTER);
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureP);
- UNUSED(closureS);
+ AVER(closure == UNUSED_POINTER);
+ UNUSED(closure);
UNUSED(size);
AVER(size == ArenaGrainSize(PoolArena(pool)));
arenaFreePage(PoolArena(pool), base, pool);
@@ -433,8 +469,8 @@ static void arenaFreeLandFinish(Arena arena)
/* The CBS block pool can't free its own memory via ArenaFree because
* that would use the free land. */
- MFSFinishTracts(ArenaCBSBlockPool(arena), arenaMFSPageFreeVisitor,
- UNUSED_POINTER, UNUSED_SIZE);
+ MFSFinishExtents(ArenaCBSBlockPool(arena), arenaMFSPageFreeVisitor,
+ UNUSED_POINTER);
arena->hasFreeLand = FALSE;
LandFinish(ArenaFreeLand(arena));
@@ -446,17 +482,14 @@ void ArenaDestroy(Arena arena)
GlobalsPrepareToDestroy(ArenaGlobals(arena));
- /* Empty the reservoir - see */
- ReservoirSetLimit(ArenaReservoir(arena), 0);
-
ControlFinish(arena);
/* We must tear down the free land before the chunks, because pages
* containing CBS blocks might be allocated in those chunks. */
arenaFreeLandFinish(arena);
- /* Call class-specific finishing. This will call ArenaFinish. */
- (*arena->class->finish)(arena);
+ /* Call class-specific destruction. This will call ArenaAbsFinish. */
+ Method(Arena, arena, destroy)(arena);
EventFinish();
}
@@ -472,8 +505,8 @@ Res ControlInit(Arena arena)
AVER(!arena->poolReady);
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, CONTROL_EXTEND_BY);
- res = PoolInit(MVPool(&arena->controlPoolStruct), arena,
- PoolClassMV(), args);
+ res = PoolInit(ArenaControlPool(arena), arena,
+ PoolClassMVFF(), args);
} MPS_ARGS_END(args);
if (res != ResOK)
return res;
@@ -489,25 +522,23 @@ void ControlFinish(Arena arena)
AVERT(Arena, arena);
AVER(arena->poolReady);
arena->poolReady = FALSE;
- PoolFinish(MVPool(&arena->controlPoolStruct));
+ PoolFinish(ArenaControlPool(arena));
}
/* ArenaDescribe -- describe the arena */
-Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
+static Res ArenaAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
{
+ Arena arena = CouldBeA(AbstractArena, inst);
Res res;
- if (!TESTT(Arena, arena))
- return ResFAIL;
+ if (!TESTC(AbstractArena, arena))
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
+ return ResPARAM;
- res = WriteF(stream, depth, "Arena $P {\n", (WriteFP)arena,
- " class $P (\"$S\")\n",
- (WriteFP)arena->class, (WriteFS)arena->class->name,
- NULL);
+ res = InstDescribe(CouldBeA(Inst, arena), stream, depth);
if (res != ResOK)
return res;
@@ -544,27 +575,18 @@ Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
if (res != ResOK)
return res;
- res = (*arena->class->describe)(arena, stream, depth);
+ res = GlobalsDescribe(ArenaGlobals(arena), stream, depth + 2);
if (res != ResOK)
return res;
- res = WriteF(stream, depth + 2, "Globals {\n", NULL);
- if (res != ResOK)
- return res;
- res = GlobalsDescribe(ArenaGlobals(arena), stream, depth + 4);
- if (res != ResOK)
- return res;
- res = WriteF(stream, depth + 2, "} Globals\n", NULL);
- if (res != ResOK)
- return res;
-
- res = WriteF(stream, depth,
- "} Arena $P ($U)\n", (WriteFP)arena,
- (WriteFU)arena->serial,
- NULL);
return res;
}
+Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
+{
+ return Method(Inst, arena, describe)(MustBeA(Inst, arena), stream, depth);
+}
+
/* arenaDescribeTractsInChunk -- describe the tracts in a chunk */
@@ -596,10 +618,11 @@ static Res arenaDescribeTractsInChunk(Chunk chunk, mps_lib_FILE *stream, Count d
return res;
if (TractHasPool(tract)) {
Pool pool = TractPool(tract);
+ PoolClass poolClass = ClassOfPoly(Pool, pool);
res = WriteF(stream, 0, " $P $U ($S)",
(WriteFP)pool,
(WriteFU)(pool->serial),
- (WriteFS)(pool->class->name),
+ (WriteFS)ClassName(poolClass),
NULL);
if (res != ResOK)
return res;
@@ -629,7 +652,7 @@ Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
if (stream == NULL)
return ResFAIL;
- RING_FOR(node, &arena->chunkRing, next) {
+ RING_FOR(node, ArenaChunkRing(arena), next) {
Chunk chunk = RING_ELT(Chunk, arenaRing, node);
res = arenaDescribeTractsInChunk(chunk, stream, depth);
if (res != ResOK)
@@ -649,8 +672,7 @@ Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth)
* with void* (), ControlAlloc must take care of
* allocating so that the block can be addressed with a void*. */
-Res ControlAlloc(void **baseReturn, Arena arena, size_t size,
- Bool withReservoirPermit)
+Res ControlAlloc(void **baseReturn, Arena arena, size_t size)
{
Addr base;
Res res;
@@ -658,11 +680,9 @@ Res ControlAlloc(void **baseReturn, Arena arena, size_t size,
AVERT(Arena, arena);
AVER(baseReturn != NULL);
AVER(size > 0);
- AVERT(Bool, withReservoirPermit);
AVER(arena->poolReady);
- res = PoolAlloc(&base, ArenaControlPool(arena), (Size)size,
- withReservoirPermit);
+ res = PoolAlloc(&base, ArenaControlPool(arena), (Size)size);
if (res != ResOK)
return res;
@@ -675,12 +695,15 @@ Res ControlAlloc(void **baseReturn, Arena arena, size_t size,
void ControlFree(Arena arena, void* base, size_t size)
{
+ Pool pool;
+
AVERT(Arena, arena);
AVER(base != NULL);
AVER(size > 0);
AVER(arena->poolReady);
- PoolFree(ArenaControlPool(arena), (Addr)base, (Size)size);
+ pool = ArenaControlPool(arena);
+ PoolFree(pool, (Addr)base, (Size)size);
}
@@ -706,7 +729,8 @@ Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
* if not already set.
*/
-void ArenaChunkInsert(Arena arena, Chunk chunk) {
+void ArenaChunkInsert(Arena arena, Chunk chunk)
+{
Bool inserted;
Tree tree, updatedTree = NULL;
@@ -720,7 +744,7 @@ void ArenaChunkInsert(Arena arena, Chunk chunk) {
AVER(updatedTree);
TreeBalance(&updatedTree);
arena->chunkTree = updatedTree;
- RingAppend(&arena->chunkRing, &chunk->arenaRing);
+ RingAppend(ArenaChunkRing(arena), &chunk->arenaRing);
arena->reserved += ChunkReserved(chunk);
@@ -749,7 +773,7 @@ void ArenaChunkRemoved(Arena arena, Chunk chunk)
if (chunk == arena->primary) {
/* The primary chunk must be the last chunk to be removed. */
- AVER(RingIsSingle(&arena->chunkRing));
+ AVER(RingIsSingle(ArenaChunkRing(arena)));
AVER(arena->reserved == 0);
arena->primary = NULL;
}
@@ -780,9 +804,9 @@ static Res arenaAllocPageInChunk(Addr *baseReturn, Chunk chunk, Pool pool)
chunk->allocBase, chunk->pages, 1))
return ResRESOURCE;
- res = (*arena->class->pagesMarkAllocated)(arena, chunk,
- basePageIndex, 1,
- pool);
+ res = Method(Arena, arena, pagesMarkAllocated)(arena, chunk,
+ basePageIndex, 1,
+ pool);
if (res != ResOK)
return res;
@@ -804,7 +828,7 @@ static Res arenaAllocPage(Addr *baseReturn, Arena arena, Pool pool)
res = arenaAllocPageInChunk(baseReturn, arena->primary, pool);
if (res != ResOK) {
Ring node, next;
- RING_FOR(node, &arena->chunkRing, next) {
+ RING_FOR(node, ArenaChunkRing(arena), next) {
Chunk chunk = RING_ELT(Chunk, arenaRing, node);
if (chunk != arena->primary) {
res = arenaAllocPageInChunk(baseReturn, chunk, pool);
@@ -823,7 +847,7 @@ static void arenaFreePage(Arena arena, Addr base, Pool pool)
{
AVERT(Arena, arena);
AVERT(Pool, pool);
- (*arena->class->free)(base, ArenaGrainSize(arena), pool);
+ Method(Arena, arena, free)(base, ArenaGrainSize(arena), pool);
}
@@ -835,15 +859,16 @@ static void arenaFreePage(Arena arena, Addr base, Pool pool)
static Res arenaExtendCBSBlockPool(Range pageRangeReturn, Arena arena)
{
- Addr pageBase;
+ Addr pageBase, pageLimit;
Res res;
res = arenaAllocPage(&pageBase, arena, ArenaCBSBlockPool(arena));
if (res != ResOK)
return res;
- MFSExtend(ArenaCBSBlockPool(arena), pageBase, ArenaGrainSize(arena));
+ pageLimit = AddrAdd(pageBase, ArenaGrainSize(arena));
+ MFSExtend(ArenaCBSBlockPool(arena), pageBase, pageLimit);
- RangeInitSize(pageRangeReturn, pageBase, ArenaGrainSize(arena));
+ RangeInit(pageRangeReturn, pageBase, pageLimit);
return ResOK;
}
@@ -857,8 +882,9 @@ static void arenaExcludePage(Arena arena, Range pageRange)
{
RangeStruct oldRange;
Res res;
+ Land land = ArenaFreeLand(arena);
- res = LandDelete(&oldRange, ArenaFreeLand(arena), pageRange);
+ res = LandDelete(&oldRange, land, pageRange);
AVER(res == ResOK); /* we just gave memory to the Land */
}
@@ -878,12 +904,14 @@ static Res arenaFreeLandInsertExtend(Range rangeReturn, Arena arena,
Range range)
{
Res res;
+ Land land;
AVER(rangeReturn != NULL);
AVERT(Arena, arena);
AVERT(Range, range);
- res = LandInsert(rangeReturn, ArenaFreeLand(arena), range);
+ land = ArenaFreeLand(arena);
+ res = LandInsert(rangeReturn, land, range);
if (res == ResLIMIT) { /* CBS block pool ran out of blocks */
RangeStruct pageRange;
@@ -892,7 +920,7 @@ static Res arenaFreeLandInsertExtend(Range rangeReturn, Arena arena,
return res;
/* .insert.exclude: Must insert before exclude so that we can
bootstrap when the zoned CBS is empty. */
- res = LandInsert(rangeReturn, ArenaFreeLand(arena), range);
+ res = LandInsert(rangeReturn, land, range);
AVER(res == ResOK); /* we just gave memory to the CBS block pool */
arenaExcludePage(arena, &pageRange);
}
@@ -923,25 +951,28 @@ static void arenaFreeLandInsertSteal(Range rangeReturn, Arena arena,
res = arenaFreeLandInsertExtend(rangeReturn, arena, rangeIO);
if (res != ResOK) {
- Addr pageBase;
+ Land land;
+ Addr pageBase, pageLimit;
Tract tract;
AVER(ResIsAllocFailure(res));
/* Steal a page from the memory we're about to free. */
AVER(RangeSize(rangeIO) >= ArenaGrainSize(arena));
pageBase = RangeBase(rangeIO);
- RangeInit(rangeIO, AddrAdd(pageBase, ArenaGrainSize(arena)),
- RangeLimit(rangeIO));
+ pageLimit = AddrAdd(pageBase, ArenaGrainSize(arena));
+ AVER(pageLimit <= RangeLimit(rangeIO));
+ RangeInit(rangeIO, pageLimit, RangeLimit(rangeIO));
/* Steal the tract from its owning pool. */
tract = TractOfBaseAddr(arena, pageBase);
TractFinish(tract);
TractInit(tract, ArenaCBSBlockPool(arena), pageBase);
- MFSExtend(ArenaCBSBlockPool(arena), pageBase, ArenaGrainSize(arena));
+ MFSExtend(ArenaCBSBlockPool(arena), pageBase, pageLimit);
/* Try again. */
- res = LandInsert(rangeReturn, ArenaFreeLand(arena), rangeIO);
+ land = ArenaFreeLand(arena);
+ res = LandInsert(rangeReturn, land, rangeIO);
AVER(res == ResOK); /* we just gave memory to the CBS block pool */
}
@@ -963,6 +994,7 @@ Res ArenaFreeLandInsert(Arena arena, Addr base, Addr limit)
Res res;
AVERT(Arena, arena);
+ AVER(base < limit);
RangeInit(&range, base, limit);
res = arenaFreeLandInsertExtend(&oldRange, arena, &range);
@@ -996,9 +1028,11 @@ void ArenaFreeLandDelete(Arena arena, Addr base, Addr limit)
{
RangeStruct range, oldRange;
Res res;
+ Land land;
RangeInit(&range, base, limit);
- res = LandDelete(&oldRange, ArenaFreeLand(arena), &range);
+ land = ArenaFreeLand(arena);
+ res = LandDelete(&oldRange, land, &range);
/* Shouldn't be any other kind of failure because we were only deleting
a non-coalesced block. See .chunk.no-coalesce and
@@ -1026,6 +1060,7 @@ Res ArenaFreeLandAlloc(Tract *tractReturn, Arena arena, ZoneSet zones,
Index baseIndex;
Count pages;
Res res;
+ Land land;
AVER(tractReturn != NULL);
AVERT(Arena, arena);
@@ -1040,8 +1075,8 @@ Res ArenaFreeLandAlloc(Tract *tractReturn, Arena arena, ZoneSet zones,
/* Step 1. Find a range of address space. */
- res = LandFindInZones(&found, &range, &oldRange, ArenaFreeLand(arena),
- size, zones, high);
+ land = ArenaFreeLand(arena);
+ res = LandFindInZones(&found, &range, &oldRange, land, size, zones, high);
if (res == ResLIMIT) { /* found block, but couldn't store info */
RangeStruct pageRange;
@@ -1049,8 +1084,7 @@ Res ArenaFreeLandAlloc(Tract *tractReturn, Arena arena, ZoneSet zones,
if (res != ResOK) /* disastrously short on memory */
return res;
arenaExcludePage(arena, &pageRange);
- res = LandFindInZones(&found, &range, &oldRange, ArenaFreeLand(arena),
- size, zones, high);
+ res = LandFindInZones(&found, &range, &oldRange, land, size, zones, high);
AVER(res != ResLIMIT);
}
@@ -1069,7 +1103,7 @@ Res ArenaFreeLandAlloc(Tract *tractReturn, Arena arena, ZoneSet zones,
baseIndex = INDEX_OF_ADDR(chunk, RangeBase(&range));
pages = ChunkSizeToPages(chunk, RangeSize(&range));
- res = (*arena->class->pagesMarkAllocated)(arena, chunk, baseIndex, pages, pool);
+ res = Method(Arena, arena, pagesMarkAllocated)(arena, chunk, baseIndex, pages, pool);
if (res != ResOK)
goto failMark;
@@ -1093,45 +1127,25 @@ Res ArenaFreeLandAlloc(Tract *tractReturn, Arena arena, ZoneSet zones,
/* ArenaAlloc -- allocate some tracts from the arena */
-Res ArenaAlloc(Addr *baseReturn, LocusPref pref, Size size, Pool pool,
- Bool withReservoirPermit)
+Res ArenaAlloc(Addr *baseReturn, LocusPref pref, Size size, Pool pool)
{
Res res;
Arena arena;
Addr base;
Tract tract;
- Reservoir reservoir;
AVER(baseReturn != NULL);
AVERT(LocusPref, pref);
AVER(size > (Size)0);
AVERT(Pool, pool);
- AVERT(Bool, withReservoirPermit);
arena = PoolArena(pool);
AVERT(Arena, arena);
AVER(SizeIsArenaGrains(size, arena));
- reservoir = ArenaReservoir(arena);
- AVERT(Reservoir, reservoir);
-
- if (pool != ReservoirPool(reservoir)) {
- res = ReservoirEnsureFull(reservoir);
- if (res != ResOK) {
- AVER(ResIsAllocFailure(res));
- if (!withReservoirPermit)
- return res;
- }
- }
res = PolicyAlloc(&tract, arena, pref, size, pool);
- if (res != ResOK) {
- if (withReservoirPermit) {
- Res resRes = ReservoirWithdraw(&base, &tract, reservoir, size, pool);
- if (resRes != ResOK)
- goto allocFail;
- } else
- goto allocFail;
- }
+ if (res != ResOK)
+ goto allocFail;
base = TractBase(tract);
@@ -1156,8 +1170,6 @@ void ArenaFree(Addr base, Size size, Pool pool)
{
Arena arena;
Addr limit;
- Reservoir reservoir;
- Res res;
Addr wholeBase;
Size wholeSize;
RangeStruct range, oldRange;
@@ -1167,8 +1179,6 @@ void ArenaFree(Addr base, Size size, Pool pool)
AVER(size > (Size)0);
arena = PoolArena(pool);
AVERT(Arena, arena);
- reservoir = ArenaReservoir(arena);
- AVERT(Reservoir, reservoir);
AVER(AddrIsArenaGrain(base, arena));
AVER(SizeIsArenaGrains(size, arena));
@@ -1182,30 +1192,16 @@ void ArenaFree(Addr base, Size size, Pool pool)
wholeBase = base;
wholeSize = size;
- if (pool != ReservoirPool(reservoir)) {
- res = ReservoirEnsureFull(reservoir);
- if (res != ResOK) {
- AVER(ResIsAllocFailure(res));
- if (!ReservoirDeposit(reservoir, &base, &size))
- goto allDeposited;
- }
- }
-
- /* Just in case the shenanigans with the reservoir mucked this up. */
- AVER(limit == AddrAdd(base, size));
-
RangeInit(&range, base, limit);
arenaFreeLandInsertSteal(&oldRange, arena, &range); /* may update range */
- (*arena->class->free)(RangeBase(&range), RangeSize(&range), pool);
+ Method(Arena, arena, free)(RangeBase(&range), RangeSize(&range), pool);
/* Freeing memory might create spare pages, but not more than this. */
CHECKL((double)arena->spareCommitted / (arena->committed - arena->spareCommitted) <= arena->spare);
-allDeposited:
EVENT3(ArenaFree, arena, wholeBase, wholeSize);
- return;
}
@@ -1246,10 +1242,24 @@ void ArenaSetSpare(Arena arena, double spare)
spareMax = (Size)(arena->committed * arena->spare);
if (arena->spareCommitted > spareMax) {
Size excess = arena->spareCommitted - spareMax;
- (void)arena->class->purgeSpare(arena, excess);
+ (void)Method(Arena, arena, purgeSpare)(arena, excess);
}
}
+double ArenaPauseTime(Arena arena)
+{
+ AVERT(Arena, arena);
+ return arena->pauseTime;
+}
+
+void ArenaSetPauseTime(Arena arena, double pauseTime)
+{
+ AVERT(Arena, arena);
+ AVER(0.0 <= pauseTime);
+ arena->pauseTime = pauseTime;
+ EVENT2(PauseTimeSet, arena, pauseTime);
+}
+
/* Used by arenas which don't use spare committed memory */
Size ArenaNoPurgeSpare(Arena arena, Size size)
{
@@ -1287,7 +1297,7 @@ Res ArenaSetCommitLimit(Arena arena, Size limit)
/* Attempt to set the limit below current committed */
if (limit >= committed - arena->spareCommitted) {
Size excess = committed - limit;
- (void)arena->class->purgeSpare(arena, excess);
+ (void)Method(Arena, arena, purgeSpare)(arena, excess);
AVER(limit >= ArenaCommitted(arena));
arena->commitLimit = limit;
res = ResOK;
@@ -1320,6 +1330,7 @@ Size ArenaAvail(Arena arena)
this information from the operating system. It also depends on the
arena class, of course. */
+ AVER(sSwap >= arena->committed);
return sSwap - arena->committed + arena->spareCommitted;
}
@@ -1329,7 +1340,20 @@ Size ArenaAvail(Arena arena)
Size ArenaCollectable(Arena arena)
{
/* Conservative estimate -- see job003929. */
- return ArenaCommitted(arena) - ArenaSpareCommitted(arena);
+ Size committed = ArenaCommitted(arena);
+ Size spareCommitted = ArenaSpareCommitted(arena);
+ AVER(committed >= spareCommitted);
+ return committed - spareCommitted;
+}
+
+
+/* ArenaAccumulateTime -- accumulate time spent tracing */
+
+void ArenaAccumulateTime(Arena arena, Clock start, Clock end)
+{
+ AVERT(Arena, arena);
+ AVER(start <= end);
+ arena->tracedTime += (end - start) / (double) ClocksPerSec();
}
@@ -1343,7 +1367,7 @@ Res ArenaExtend(Arena arena, Addr base, Size size)
AVER(base != (Addr)0);
AVER(size > 0);
- res = (*arena->class->extend)(arena, base, size);
+ res = Method(Arena, arena, extend)(arena, base, size);
if (res != ResOK)
return res;
@@ -1371,14 +1395,13 @@ void ArenaCompact(Arena arena, Trace trace)
{
AVERT(Arena, arena);
AVERT(Trace, trace);
- (*arena->class->compact)(arena, trace);
+ Method(Arena, arena, compact)(arena, trace);
}
static void ArenaTrivCompact(Arena arena, Trace trace)
{
UNUSED(arena);
UNUSED(trace);
- return;
}
@@ -1393,29 +1416,9 @@ Bool ArenaHasAddr(Arena arena, Addr addr)
}
-/* ArenaAddrObject -- find client pointer to object containing addr
- * See job003589.
- */
-
-Res ArenaAddrObject(Addr *pReturn, Arena arena, Addr addr)
-{
- Seg seg;
- Pool pool;
-
- AVER(pReturn != NULL);
- AVERT(Arena, arena);
-
- if (!SegOfAddr(&seg, arena, addr)) {
- return ResFAIL;
- }
- pool = SegPool(seg);
- return PoolAddrObject(pReturn, pool, seg, addr);
-}
-
-
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index cd5c24fe46a..e2a0da37095 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -21,6 +21,8 @@
SRCID(arenacl, "$Id$");
+DECLARE_CLASS(Arena, ClientArena, AbstractArena);
+
/* ClientArenaStruct -- Client Arena Structure */
@@ -32,9 +34,6 @@ typedef struct ClientArenaStruct {
} ClientArenaStruct;
typedef struct ClientArenaStruct *ClientArena;
-#define Arena2ClientArena(arena) PARENT(ClientArenaStruct, arenaStruct, arena)
-#define ClientArena2Arena(clArena) (&(clArena)->arenaStruct)
-
/* CLChunk -- chunk structure */
@@ -81,11 +80,8 @@ static Bool ClientChunkCheck(ClientChunk clChunk)
ATTRIBUTE_UNUSED
static Bool ClientArenaCheck(ClientArena clientArena)
{
- Arena arena;
+ Arena arena = MustBeA(AbstractArena, clientArena);
- CHECKS(ClientArena, clientArena);
- arena = ClientArena2Arena(clientArena);
- CHECKD(Arena, arena);
/* See */
CHECKL(arena->committed <= arena->reserved);
CHECKL(arena->spareCommitted == 0);
@@ -99,7 +95,7 @@ static Bool ClientArenaCheck(ClientArena clientArena)
static Res clientChunkCreate(Chunk *chunkReturn, ClientArena clientArena,
Addr base, Addr limit)
{
- Arena arena;
+ Arena arena = MustBeA(AbstractArena, clientArena);
ClientChunk clChunk;
Chunk chunk;
Addr alignedBase;
@@ -109,8 +105,6 @@ static Res clientChunkCreate(Chunk *chunkReturn, ClientArena clientArena,
void *p;
AVER(chunkReturn != NULL);
- AVERT(ClientArena, clientArena);
- arena = ClientArena2Arena(clientArena);
AVER(base != (Addr)0);
AVER(limit != (Addr)0);
AVER(limit > base);
@@ -182,7 +176,7 @@ static Res ClientChunkInit(Chunk chunk, BootBlock boot)
/* clientChunkDestroy -- destroy a ClientChunk */
-static Bool clientChunkDestroy(Tree tree, void *closureP, Size closureS)
+static Bool clientChunkDestroy(Tree tree, void *closure)
{
Arena arena;
Chunk chunk;
@@ -190,10 +184,8 @@ static Bool clientChunkDestroy(Tree tree, void *closureP, Size closureS)
Size size;
AVERT(Tree, tree);
- AVER(closureP == UNUSED_POINTER);
- UNUSED(closureP);
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureS);
+ AVER(closure == UNUSED_POINTER);
+ UNUSED(closure);
chunk = ChunkOfTree(tree);
AVERT(Chunk, chunk);
@@ -246,7 +238,7 @@ static void ClientArenaVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs)
ARG_DEFINE_KEY(ARENA_CL_BASE, Addr);
-static Res ClientArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
+static Res ClientArenaCreate(Arena *arenaReturn, ArgList args)
{
Arena arena;
ClientArena clientArena;
@@ -259,7 +251,6 @@ static Res ClientArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
mps_arg_s arg;
AVER(arenaReturn != NULL);
- AVER((ArenaClass)mps_arena_class_cl() == class);
AVERT(ArgList, args);
ArgRequire(&arg, args, MPS_KEY_ARENA_SIZE);
@@ -291,11 +282,13 @@ static Res ClientArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
if (chunkBase > limit)
return ResMEMORY;
- arena = ClientArena2Arena(clientArena);
- /* */
- res = ArenaInit(arena, class, grainSize, args);
+ arena = CouldBeA(AbstractArena, clientArena);
+
+ res = NextMethod(Arena, ClientArena, init)(arena, grainSize, args);
if (res != ResOK)
- return res;
+ goto failSuperInit;
+ SetClassOfPoly(arena, CLASS(ClientArena));
+ AVER(clientArena == MustBeA(ClientArena, arena));
/* have to have a valid arena before calling ChunkCreate */
clientArena->sig = ClientArenaSig;
@@ -318,26 +311,24 @@ static Res ClientArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
return ResOK;
failChunkCreate:
- ArenaFinish(arena);
+ NextMethod(Inst, ClientArena, finish)(MustBeA(Inst, arena));
+failSuperInit:
AVER(res != ResOK);
return res;
}
-/* ClientArenaFinish -- finish the arena */
+/* ClientArenaDestroy -- destroy the arena */
-static void ClientArenaFinish(Arena arena)
+static void ClientArenaDestroy(Arena arena)
{
- ClientArena clientArena;
-
- clientArena = Arena2ClientArena(arena);
- AVERT(ClientArena, clientArena);
+ ClientArena clientArena = MustBeA(ClientArena, arena);
/* Destroy all chunks, including the primary. See
* */
arena->primary = NULL;
TreeTraverseAndDelete(&arena->chunkTree, clientChunkDestroy,
- UNUSED_POINTER, UNUSED_SIZE);
+ UNUSED_POINTER);
clientArena->sig = SigInvalid;
@@ -345,7 +336,7 @@ static void ClientArenaFinish(Arena arena)
AVER(arena->reserved == 0);
AVER(arena->committed == 0);
- ArenaFinish(arena); /* */
+ NextMethod(Inst, ClientArena, finish)(MustBeA(Inst, arena));
}
@@ -353,19 +344,13 @@ static void ClientArenaFinish(Arena arena)
static Res ClientArenaExtend(Arena arena, Addr base, Size size)
{
- ClientArena clientArena;
+ ClientArena clientArena = MustBeA(ClientArena, arena);
Chunk chunk;
- Res res;
- Addr limit;
- AVERT(Arena, arena);
AVER(base != (Addr)0);
AVER(size > 0);
- limit = AddrAdd(base, size);
- clientArena = Arena2ClientArena(arena);
- res = clientChunkCreate(&chunk, clientArena, base, limit);
- return res;
+ return clientChunkCreate(&chunk, clientArena, base, AddrAdd(base, size));
}
@@ -398,6 +383,20 @@ static Res ClientArenaPagesMarkAllocated(Arena arena, Chunk chunk,
}
+/* ClientChunkPageMapped -- determine if a page is mapped */
+
+static Bool ClientChunkPageMapped(Chunk chunk, Index index)
+{
+ UNUSED(chunk);
+ UNUSED(index);
+
+ AVERT(Chunk, chunk);
+ AVER(index < chunk->pages);
+
+ return TRUE;
+}
+
+
/* ClientArenaFree - free a region in the arena */
static void ClientArenaFree(Addr base, Size size, Pool pool)
@@ -405,7 +404,6 @@ static void ClientArenaFree(Addr base, Size size, Pool pool)
Arena arena;
Chunk chunk = NULL; /* suppress "may be used uninitialized" */
Size pages;
- ClientArena clientArena;
Index pi, baseIndex, limitIndex;
Bool foundChunk;
ClientChunk clChunk;
@@ -414,9 +412,7 @@ static void ClientArenaFree(Addr base, Size size, Pool pool)
AVER(size > (Size)0);
AVERT(Pool, pool);
arena = PoolArena(pool);
- AVERT(Arena, arena);
- clientArena = Arena2ClientArena(arena);
- AVERT(ClientArena, clientArena);
+ AVERC(ClientArena, arena);
AVER(SizeIsAligned(size, ChunkPageSize(arena->primary)));
AVER(AddrIsAligned(base, ChunkPageSize(arena->primary)));
@@ -449,21 +445,20 @@ static void ClientArenaFree(Addr base, Size size, Pool pool)
/* ClientArenaClass -- The Client arena class definition */
-DEFINE_ARENA_CLASS(ClientArenaClass, this)
+DEFINE_CLASS(Arena, ClientArena, klass)
{
- INHERIT_CLASS(this, AbstractArenaClass);
- this->name = "CL";
- this->size = sizeof(ClientArenaStruct);
- this->offset = offsetof(ClientArenaStruct, arenaStruct);
- this->varargs = ClientArenaVarargs;
- this->init = ClientArenaInit;
- this->finish = ClientArenaFinish;
- this->extend = ClientArenaExtend;
- this->pagesMarkAllocated = ClientArenaPagesMarkAllocated;
- this->free = ClientArenaFree;
- this->chunkInit = ClientChunkInit;
- this->chunkFinish = ClientChunkFinish;
- AVERT(ArenaClass, this);
+ INHERIT_CLASS(klass, ClientArena, AbstractArena);
+ klass->size = sizeof(ClientArenaStruct);
+ klass->varargs = ClientArenaVarargs;
+ klass->create = ClientArenaCreate;
+ klass->destroy = ClientArenaDestroy;
+ klass->extend = ClientArenaExtend;
+ klass->pagesMarkAllocated = ClientArenaPagesMarkAllocated;
+ klass->free = ClientArenaFree;
+ klass->chunkInit = ClientChunkInit;
+ klass->chunkFinish = ClientChunkFinish;
+ klass->chunkPageMapped = ClientChunkPageMapped;
+ AVERT(ArenaClass, klass);
}
@@ -471,7 +466,7 @@ DEFINE_ARENA_CLASS(ClientArenaClass, this)
mps_arena_class_t mps_arena_class_cl(void)
{
- return (mps_arena_class_t)EnsureClientArenaClass();
+ return (mps_arena_class_t)CLASS(ClientArena);
}
diff --git a/mps/code/arenacv.c b/mps/code/arenacv.c
index 7b02c11bcc2..4aa57909d1b 100644
--- a/mps/code/arenacv.c
+++ b/mps/code/arenacv.c
@@ -15,7 +15,7 @@
*/
#include "mpm.h"
-#include "poolmv.h"
+#include "poolmvff.h"
#include "testlib.h"
#include "mpslib.h"
#include "mpsavm.h"
@@ -161,7 +161,7 @@ static Res allocAsTract(AllocInfoStruct *aiReturn, LocusPref pref,
{
Res res;
Addr base;
- res = ArenaAlloc(&base, pref, size, pool, FALSE);
+ res = ArenaAlloc(&base, pref, size, pool);
if (res == ResOK) {
aiReturn->the.tractData.base = base;
aiReturn->the.tractData.size = size;
@@ -249,7 +249,7 @@ static Res allocAsSeg(AllocInfoStruct *aiReturn, LocusPref pref,
{
Res res;
Seg seg;
- res = SegAlloc(&seg, SegClassGet(), pref, size, pool, FALSE, argsNone);
+ res = SegAlloc(&seg, CLASS(Seg), pref, size, pool, argsNone);
if (res == ResOK) {
aiReturn->the.segData.seg = seg;
}
@@ -402,7 +402,7 @@ static void testAllocAndIterate(Arena arena, Pool pool,
}
-static void testPageTable(ArenaClass class, Size size, Addr addr, Bool zoned)
+static void testPageTable(ArenaClass klass, Size size, Addr addr, Bool zoned)
{
Arena arena; Pool pool;
Size pageSize;
@@ -412,10 +412,10 @@ static void testPageTable(ArenaClass class, Size size, Addr addr, Bool zoned)
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, size);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_CL_BASE, addr);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_ZONED, zoned);
- die(ArenaCreate(&arena, class, args), "ArenaCreate");
+ die(ArenaCreate(&arena, klass, args), "ArenaCreate");
} MPS_ARGS_END(args);
- die(PoolCreate(&pool, arena, PoolClassMV(), argsNone), "PoolCreate");
+ die(PoolCreate(&pool, arena, PoolClassMVFF(), argsNone), "PoolCreate");
pageSize = ArenaGrainSize(arena);
tractsPerPage = pageSize / sizeof(TractStruct);
@@ -446,14 +446,14 @@ static void testPageTable(ArenaClass class, Size size, Addr addr, Bool zoned)
static void testSize(Size size)
{
- ArenaClass class = (ArenaClass)mps_arena_class_vm();
+ ArenaClass klass = (ArenaClass)mps_arena_class_vm();
Arena arena;
Res res;
do {
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, size);
- res = ArenaCreate(&arena, class, args);
+ res = ArenaCreate(&arena, klass, args);
} MPS_ARGS_END(args);
if (res == ResOK)
ArenaDestroy(arena);
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index ac831b6fbd1..6f4839be904 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -1,7 +1,7 @@
/* arenavm.c: VIRTUAL MEMORY ARENA CLASS
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
*
*
* DESIGN
@@ -56,7 +56,7 @@ typedef struct VMChunkStruct {
/* VMChunkVMArena -- get the VM arena from a VM chunk */
#define VMChunkVMArena(vmchunk) \
- Arena2VMArena(ChunkArena(VMChunk2Chunk(vmchunk)))
+ MustBeA(VMArena, ChunkArena(VMChunk2Chunk(vmchunk)))
/* VMArena
@@ -81,8 +81,6 @@ typedef struct VMArenaStruct { /* VM arena structure */
Sig sig; /* */
} VMArenaStruct;
-#define Arena2VMArena(arena) PARENT(VMArenaStruct, arenaStruct, arena)
-#define VMArena2Arena(vmarena) (&(vmarena)->arenaStruct)
#define VMArenaVM(vmarena) (&(vmarena)->vmStruct)
@@ -90,7 +88,7 @@ typedef struct VMArenaStruct { /* VM arena structure */
static Size VMPurgeSpare(Arena arena, Size size);
static void chunkUnmapSpare(Chunk chunk);
-extern ArenaClass VMArenaClassGet(void);
+DECLARE_CLASS(Arena, VMArena, AbstractArena);
static void VMCompact(Arena arena, Trace trace);
@@ -163,7 +161,7 @@ static Bool VMArenaCheck(VMArena vmArena)
VMChunk primary;
CHECKS(VMArena, vmArena);
- arena = VMArena2Arena(vmArena);
+ arena = MustBeA(AbstractArena, vmArena);
CHECKD(Arena, arena);
/* spare pages are committed, so must be less spare than committed. */
CHECKL(vmArena->spareSize <= arena->committed);
@@ -189,29 +187,20 @@ static Bool VMArenaCheck(VMArena vmArena)
/* VMArenaDescribe -- describe the VMArena
*/
-static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
+static Res VMArenaDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
{
+ Arena arena = CouldBeA(AbstractArena, inst);
+ VMArena vmArena = CouldBeA(VMArena, arena);
Res res;
- VMArena vmArena;
- if (!TESTT(Arena, arena))
- return ResFAIL;
+ if (!TESTC(VMArena, vmArena))
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
- vmArena = Arena2VMArena(arena);
- if (!TESTT(VMArena, vmArena))
- return ResFAIL;
+ return ResPARAM;
- /* Describe the superclass fields first via next-method call */
- /* ...but the next method is ArenaTrivDescribe, so don't call it;
- * see impl.c.arena#describe.triv.dont-upcall.
- *
- super = ARENA_SUPERCLASS(VMArenaClass);
- res = super->describe(arena, stream);
+ res = NextMethod(Inst, VMArena, describe)(inst, stream, depth);
if (res != ResOK)
return res;
- *
- */
res = WriteF(stream, depth,
" spareSize: $U\n", (WriteFU)vmArena->spareSize,
@@ -219,7 +208,7 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
if(res != ResOK)
return res;
- /* (incomplete: some fields are not Described) */
+ /* TODO: incomplete -- some fields are not Described */
return ResOK;
}
@@ -234,14 +223,12 @@ static Res VMArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth)
*/
static Res vmArenaMap(VMArena vmArena, VM vm, Addr base, Addr limit)
{
- Arena arena;
- Size size;
+ Arena arena = MustBeA(AbstractArena, vmArena);
+ Size size = AddrOffset(base, limit);
Res res;
/* no checking as function is local to module */
- arena = VMArena2Arena(vmArena);
- size = AddrOffset(base, limit);
/* committed can't overflow (since we can't commit more memory than */
/* address space), but we're paranoid. */
AVER(arena->committed < arena->committed + size);
@@ -259,18 +246,14 @@ static Res vmArenaMap(VMArena vmArena, VM vm, Addr base, Addr limit)
static void vmArenaUnmap(VMArena vmArena, VM vm, Addr base, Addr limit)
{
- Arena arena;
- Size size;
+ Arena arena = MustBeA(AbstractArena, vmArena);
+ Size size = AddrOffset(base, limit);
/* no checking as function is local to module */
-
- arena = VMArena2Arena(vmArena);
- size = AddrOffset(base, limit);
AVER(size <= arena->committed);
VMUnmap(vm, base, limit);
arena->committed -= size;
- return;
}
@@ -282,7 +265,7 @@ static void vmArenaUnmap(VMArena vmArena, VM vm, Addr base, Addr limit)
*/
static Res VMChunkCreate(Chunk *chunkReturn, VMArena vmArena, Size size)
{
- Arena arena;
+ Arena arena = MustBeA(AbstractArena, vmArena);
Res res;
Addr base, limit, chunkStructLimit;
VMStruct vmStruct;
@@ -294,7 +277,6 @@ static Res VMChunkCreate(Chunk *chunkReturn, VMArena vmArena, Size size)
AVER(chunkReturn != NULL);
AVERT(VMArena, vmArena);
- arena = VMArena2Arena(vmArena);
AVER(size > 0);
res = VMInit(vm, size, ArenaGrainSize(arena), vmArena->vmParams);
@@ -308,8 +290,7 @@ static Res VMChunkCreate(Chunk *chunkReturn, VMArena vmArena, Size size)
if (res != ResOK)
goto failBootInit;
- /* Allocate and map the descriptor. */
- /* See .@@@@ */
+ /* .overhead.chunk-struct: Allocate and map the chunk structure. */
res = BootAlloc(&p, boot, sizeof(VMChunkStruct), MPS_PF_ALIGN);
if (res != ResOK)
goto failChunkAlloc;
@@ -361,11 +342,13 @@ static Res VMChunkInit(Chunk chunk, BootBlock boot)
vmChunk = Chunk2VMChunk(chunk);
AVERT(BootBlock, boot);
+ /* .overhead.sa-mapped: Chunk overhead for sparse array 'mapped' table. */
res = BootAlloc(&p, boot, BTSize(chunk->pages), MPS_PF_ALIGN);
if (res != ResOK)
goto failSaMapped;
saMapped = p;
+ /* .overhead.sa-pages: Chunk overhead for sparse array 'pages' table. */
res = BootAlloc(&p, boot, BTSize(chunk->pageTablePages), MPS_PF_ALIGN);
if (res != ResOK)
goto failSaPages;
@@ -373,8 +356,8 @@ static Res VMChunkInit(Chunk chunk, BootBlock boot)
overheadLimit = AddrAdd(chunk->base, (Size)BootAllocated(boot));
- /* Put the page table as late as possible, as in VM systems we don't want */
- /* to map it. */
+ /* .overhead.page-table: Put the page table as late as possible, as
+ * in VM systems we don't want to map it. */
res = BootAlloc(&p, boot, chunk->pageTablePages << chunk->pageShift, chunk->pageSize);
if (res != ResOK)
goto failAllocPageTable;
@@ -409,16 +392,14 @@ static Res VMChunkInit(Chunk chunk, BootBlock boot)
/* vmChunkDestroy -- destroy a VMChunk */
-static Bool vmChunkDestroy(Tree tree, void *closureP, Size closureS)
+static Bool vmChunkDestroy(Tree tree, void *closure)
{
Chunk chunk;
VMChunk vmChunk;
AVERT(Tree, tree);
- AVER(closureP == UNUSED_POINTER);
- UNUSED(closureP);
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureS);
+ AVER(closure == UNUSED_POINTER);
+ UNUSED(closure);
chunk = ChunkOfTree(tree);
AVERT(Chunk, chunk);
@@ -493,7 +474,66 @@ static void vmArenaTrivContracted(Arena arena, Addr base, Size size)
}
-/* VMArenaInit -- create and initialize the VM arena
+/* vmArenaChunkSize -- compute chunk size
+ *
+ * Compute the size of the smallest chunk that has size bytes of usable
+ * address space (that is, after all overheads are accounted for).
+ *
+ * If successful, update *chunkSizeReturn with the computed chunk size
+ * and return ResOK. If size is too large for a chunk, leave
+ * *chunkSizeReturn unchanged and return ResRESOURCE.
+ */
+static Res vmArenaChunkSize(Size *chunkSizeReturn, VMArena vmArena, Size size)
+{
+ Size grainSize; /* Arena grain size. */
+ Shift grainShift; /* The corresponding Shift. */
+ Count pages; /* Number of usable pages in chunk. */
+ Size pageTableSize; /* Size of the page table. */
+ Count pageTablePages; /* Number of pages in the page table. */
+ Size chunkSize; /* Size of the chunk. */
+ Size overhead; /* Total overheads for the chunk. */
+
+ AVER(chunkSizeReturn != NULL);
+ AVERT(VMArena, vmArena);
+ AVER(size > 0);
+
+ grainSize = ArenaGrainSize(MustBeA(AbstractArena, vmArena));
+ grainShift = SizeLog2(grainSize);
+
+ overhead = 0;
+ do {
+ chunkSize = size + overhead;
+ AVER(SizeIsAligned(chunkSize, grainSize));
+
+ /* See .overhead.chunk-struct. */
+ overhead = SizeAlignUp(sizeof(VMChunkStruct), MPS_PF_ALIGN);
+
+ /* See , */
+ pages = chunkSize >> grainShift;
+ overhead += SizeAlignUp(BTSize(pages), MPS_PF_ALIGN);
+
+ /* See .overhead.sa-mapped. */
+ overhead += SizeAlignUp(BTSize(pages), MPS_PF_ALIGN);
+
+ /* See .overhead.sa-pages. */
+ pageTableSize = SizeAlignUp(pages * sizeof(PageUnion), grainSize);
+ pageTablePages = pageTableSize >> grainShift;
+ overhead += SizeAlignUp(BTSize(pageTablePages), MPS_PF_ALIGN);
+
+ /* See .overhead.page-table. */
+ overhead = SizeAlignUp(overhead, grainSize);
+ overhead += SizeAlignUp(pageTableSize, grainSize);
+
+ if (SizeMAX - overhead < size)
+ return ResRESOURCE;
+ } while (chunkSize < size + overhead);
+
+ *chunkSizeReturn = chunkSize;
+ return ResOK;
+}
+
+
+/* VMArenaCreate -- create and initialize the VM arena
*
* .arena.init: Once the arena has been allocated, we call ArenaInit
* to do the generic part of init.
@@ -504,7 +544,7 @@ ARG_DEFINE_KEY(arena_extended, Fun);
ARG_DEFINE_KEY(arena_contracted, Fun);
#define vmKeyArenaContracted (&_mps_key_arena_contracted)
-static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
+static Res VMArenaCreate(Arena *arenaReturn, ArgList args)
{
Size size = VM_ARENA_SIZE_DEFAULT; /* initial arena size */
Align grainSize = MPS_PF_ALIGN; /* arena grain size */
@@ -521,7 +561,6 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
char vmParams[VMParamSize];
AVER(arenaReturn != NULL);
- AVER(class == VMArenaClassGet());
AVERT(ArgList, args);
if (ArgPick(&arg, args, MPS_KEY_ARENA_GRAIN_SIZE))
@@ -556,11 +595,14 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
goto failVMMap;
vmArena = (VMArena)VMBase(vm);
- arena = VMArena2Arena(vmArena);
- /* */
- res = ArenaInit(arena, class, grainSize, args);
+ arena = CouldBeA(AbstractArena, vmArena);
+
+ res = NextMethod(Arena, VMArena, init)(arena, grainSize, args);
if (res != ResOK)
goto failArenaInit;
+ SetClassOfPoly(arena, CLASS(VMArena));
+ AVER(vmArena == MustBeA(VMArena, arena));
+
arena->reserved = VMReserved(vm);
arena->committed = VMMapped(vm);
@@ -591,6 +633,22 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
if (res != ResOK)
goto failChunkCreate;
+#if defined(AVER_AND_CHECK_ALL)
+ /* Check the computation of the chunk size in vmArenaChunkSize, now
+ * that we have the actual chunk for comparison. Note that
+ * vmArenaChunkSize computes the smallest size with a given number
+ * of usable bytes -- the actual chunk may be one grain larger. */
+ {
+ Size usableSize, computedChunkSize;
+ usableSize = AddrOffset(PageIndexBase(chunk, chunk->allocBase),
+ chunk->limit);
+ res = vmArenaChunkSize(&computedChunkSize, vmArena, usableSize);
+ AVER(res == ResOK);
+ AVER(computedChunkSize == ChunkSize(chunk)
+ || computedChunkSize + grainSize == ChunkSize(chunk));
+ }
+#endif
+
/* .zoneshift: Set the zone shift to divide the chunk into the same */
/* number of stripes as will fit into a reference set (the number of */
/* bits in a word). Fail if the chunk is so small stripes are smaller */
@@ -609,7 +667,7 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
return ResOK;
failChunkCreate:
- ArenaFinish(arena);
+ NextMethod(Inst, VMArena, finish)(MustBeA(Inst, arena));
failArenaInit:
VMUnmap(vm, VMBase(vm), VMLimit(vm));
failVMMap:
@@ -619,16 +677,13 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
}
-/* VMArenaFinish -- finish the arena */
+/* VMArenaDestroy -- destroy the arena */
-static void VMArenaFinish(Arena arena)
+static void VMArenaDestroy(Arena arena)
{
+ VMArena vmArena = MustBeA(VMArena, arena);
VMStruct vmStruct;
VM vm = &vmStruct;
- VMArena vmArena;
-
- vmArena = Arena2VMArena(arena);
- AVERT(VMArena, vmArena);
EVENT1(ArenaDestroy, vmArena);
@@ -636,7 +691,7 @@ static void VMArenaFinish(Arena arena)
* */
arena->primary = NULL;
TreeTraverseAndDelete(&arena->chunkTree, vmChunkDestroy,
- UNUSED_POINTER, UNUSED_SIZE);
+ UNUSED_POINTER);
/* Destroying the chunks should have purged and removed all spare pages. */
RingFinish(&vmArena->spareRing);
@@ -647,7 +702,7 @@ static void VMArenaFinish(Arena arena)
vmArena->sig = SigInvalid;
- ArenaFinish(arena); /* */
+ NextMethod(Inst, VMArena, finish)(MustBeA(Inst, arena));
/* Copy VM descriptor to stack-local storage so that we can continue
* using the descriptor after the VM has been unmapped. */
@@ -657,63 +712,34 @@ static void VMArenaFinish(Arena arena)
}
-/* vmArenaChunkSize -- choose chunk size for arena extension
- *
- * .vmchunk.overhead: This code still lacks a proper estimate of
- * the overhead required by a vmChunk for chunkStruct, page tables
- * etc. For now, estimate it as 10%. RHSK 2007-12-21
- */
-static Size vmArenaChunkSize(VMArena vmArena, Size size)
-{
- Size fraction = 10; /* 10% -- see .vmchunk.overhead */
- Size chunkSize;
- Size chunkOverhead;
-
- /* 1: use extendBy, if it is big enough for size + overhead */
- chunkSize = vmArena->extendBy;
- chunkOverhead = chunkSize / fraction;
- if(chunkSize > size && (chunkSize - size) >= chunkOverhead)
- return chunkSize;
-
- /* 2: use size + overhead (unless it overflows SizeMAX) */
- chunkOverhead = size / (fraction - 1);
- if((SizeMAX - size) >= chunkOverhead)
- return size + chunkOverhead;
-
- /* 3: use SizeMAX */
- return SizeMAX;
-}
-
-
/* VMArenaGrow -- Extend the arena by making a new chunk
*
- * The size arg specifies how much we wish to allocate after the extension.
+ * size specifies how much we wish to allocate after the extension.
+ * pref specifies the preference for the location of the allocation.
*/
static Res VMArenaGrow(Arena arena, LocusPref pref, Size size)
{
+ VMArena vmArena = MustBeA(VMArena, arena);
Chunk newChunk;
Size chunkSize;
+ Size chunkMin;
Res res;
- VMArena vmArena;
-
- AVERT(Arena, arena);
- vmArena = Arena2VMArena(arena);
- AVERT(VMArena, vmArena);
/* TODO: Ensure that extended arena will be able to satisfy pref. */
AVERT(LocusPref, pref);
UNUSED(pref);
- chunkSize = vmArenaChunkSize(vmArena, size);
+ res = vmArenaChunkSize(&chunkMin, vmArena, size);
+ if (res != ResOK)
+ return res;
+ chunkSize = vmArena->extendBy;
- EVENT3(vmArenaExtendStart, size, chunkSize,
- ArenaReserved(VMArena2Arena(vmArena)));
+ EVENT3(vmArenaExtendStart, size, chunkSize, ArenaReserved(arena));
/* .chunk-create.fail: If we fail, try again with a smaller size */
{
unsigned fidelity = 8; /* max fraction of addr-space we may 'waste' */
Size chunkHalf;
- Size chunkMin = 4 * 1024; /* typical single page */
Size sliceSize;
if (vmArena->extendMin > chunkMin)
@@ -730,8 +756,7 @@ static Res VMArenaGrow(Arena arena, LocusPref pref, Size size)
/* remove slices, down to chunkHalf but no further */
for(; chunkSize > chunkHalf; chunkSize -= sliceSize) {
if(chunkSize < chunkMin) {
- EVENT2(vmArenaExtendFail, chunkMin,
- ArenaReserved(VMArena2Arena(vmArena)));
+ EVENT2(vmArenaExtendFail, chunkMin, ArenaReserved(arena));
return res;
}
res = VMChunkCreate(&newChunk, vmArena, chunkSize);
@@ -742,8 +767,8 @@ static Res VMArenaGrow(Arena arena, LocusPref pref, Size size)
}
vmArenaGrow_Done:
- EVENT2(vmArenaExtendDone, chunkSize, ArenaReserved(VMArena2Arena(vmArena)));
- vmArena->extended(VMArena2Arena(vmArena),
+ EVENT2(vmArenaExtendDone, chunkSize, ArenaReserved(arena));
+ vmArena->extended(arena,
newChunk->base,
AddrOffset(newChunk->base, newChunk->limit));
@@ -788,7 +813,7 @@ static void sparePageRelease(VMChunk vmChunk, Index pi)
static Res pageDescMap(VMChunk vmChunk, Index basePI, Index limitPI)
{
Size before = VMMapped(VMChunkVM(vmChunk));
- Arena arena = VMArena2Arena(VMChunkVMArena(vmChunk));
+ Arena arena = MustBeA(AbstractArena, VMChunkVMArena(vmChunk));
Res res = SparseArrayMap(&vmChunk->pages, basePI, limitPI);
Size after = VMMapped(VMChunkVM(vmChunk));
AVER(before <= after);
@@ -800,7 +825,7 @@ static void pageDescUnmap(VMChunk vmChunk, Index basePI, Index limitPI)
{
Size size, after;
Size before = VMMapped(VMChunkVM(vmChunk));
- Arena arena = VMArena2Arena(VMChunkVMArena(vmChunk));
+ Arena arena = MustBeA(AbstractArena, VMChunkVMArena(vmChunk));
SparseArrayUnmap(&vmChunk->pages, basePI, limitPI);
after = VMMapped(VMChunkVM(vmChunk));
AVER(after <= before);
@@ -874,6 +899,7 @@ static Res VMPagesMarkAllocated(Arena arena, Chunk chunk,
Index baseIndex, Count pages, Pool pool)
{
Res res;
+ VMArena vmArena = MustBeA(VMArena, arena);
AVERT(Arena, arena);
AVERT(Chunk, chunk);
@@ -882,7 +908,7 @@ static Res VMPagesMarkAllocated(Arena arena, Chunk chunk,
AVER(baseIndex + pages <= chunk->pages);
AVERT(Pool, pool);
- res = pagesMarkAllocated(Arena2VMArena(arena),
+ res = pagesMarkAllocated(vmArena,
Chunk2VMChunk(chunk),
baseIndex,
pages,
@@ -896,7 +922,7 @@ static Res VMPagesMarkAllocated(Arena arena, Chunk chunk,
success if we have enough spare pages. */
if (VMPurgeSpare(arena, pages * ChunkPageSize(chunk)) == 0)
break;
- res = pagesMarkAllocated(Arena2VMArena(arena),
+ res = pagesMarkAllocated(vmArena,
Chunk2VMChunk(chunk),
baseIndex,
pages,
@@ -906,6 +932,16 @@ static Res VMPagesMarkAllocated(Arena arena, Chunk chunk,
}
+static Bool VMChunkPageMapped(Chunk chunk, Index index)
+{
+ VMChunk vmChunk;
+ AVERT(Chunk, chunk);
+ AVER(index < chunk->pages);
+ vmChunk = Chunk2VMChunk(chunk);
+ return BTGet(vmChunk->pages.mapped, index);
+}
+
+
/* chunkUnmapAroundPage -- unmap spare pages in a chunk including this one
*
* Unmap the spare page passed, and possibly other pages in the chunk,
@@ -972,13 +1008,10 @@ static Size chunkUnmapAroundPage(Chunk chunk, Size size, Page page)
static Size arenaUnmapSpare(Arena arena, Size size, Chunk filter)
{
+ VMArena vmArena = MustBeA(VMArena, arena);
Ring node;
Size purged = 0;
- VMArena vmArena;
- AVERT(Arena, arena);
- vmArena = Arena2VMArena(arena);
- AVERT(VMArena, vmArena);
if (filter != NULL)
AVERT(Chunk, filter);
@@ -1040,9 +1073,7 @@ static void VMFree(Addr base, Size size, Pool pool)
AVER(size > (Size)0);
AVERT(Pool, pool);
arena = PoolArena(pool);
- AVERT(Arena, arena);
- vmArena = Arena2VMArena(arena);
- AVERT(VMArena, vmArena);
+ vmArena = MustBeA(VMArena, arena);
/* All chunks have same pageSize. */
AVER(SizeIsAligned(size, ChunkPageSize(arena->primary)));
@@ -1106,19 +1137,14 @@ static void VMFree(Addr base, Size size, Pool pool)
/* vmChunkCompact -- delete chunk if empty and not primary */
-static Bool vmChunkCompact(Tree tree, void *closureP, Size closureS)
+static Bool vmChunkCompact(Tree tree, void *closure)
{
Chunk chunk;
- Arena arena = closureP;
- VMArena vmArena;
+ Arena arena = closure;
+ VMArena vmArena = MustBeA(VMArena, arena);
AVERT(Tree, tree);
- AVERT(Arena, arena);
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureS);
- vmArena = Arena2VMArena(arena);
- AVERT(VMArena, vmArena);
chunk = ChunkOfTree(tree);
AVERT(Chunk, chunk);
if(chunk != arena->primary
@@ -1129,7 +1155,7 @@ static Bool vmChunkCompact(Tree tree, void *closureP, Size closureS)
/* Callback before destroying the chunk, as the arena is (briefly)
invalid afterwards. See job003893. */
(*vmArena->contracted)(arena, base, size);
- vmChunkDestroy(tree, UNUSED_POINTER, UNUSED_SIZE);
+ vmChunkDestroy(tree, UNUSED_POINTER);
return TRUE;
} else {
/* Keep this chunk. */
@@ -1140,34 +1166,26 @@ static Bool vmChunkCompact(Tree tree, void *closureP, Size closureS)
static void VMCompact(Arena arena, Trace trace)
{
- VMArena vmArena;
- Size vmem1;
+ STATISTIC_DECL(Size vmem1)
- vmArena = Arena2VMArena(arena);
- AVERT(VMArena, vmArena);
AVERT(Trace, trace);
- vmem1 = ArenaReserved(arena);
+ STATISTIC(vmem1 = ArenaReserved(arena));
/* Destroy chunks that are completely free, but not the primary
* chunk. See
* TODO: add hysteresis here. See job003815. */
- TreeTraverseAndDelete(&arena->chunkTree, vmChunkCompact, arena,
- UNUSED_SIZE);
+ TreeTraverseAndDelete(&arena->chunkTree, vmChunkCompact, arena);
- {
+ STATISTIC({
Size vmem0 = trace->preTraceArenaReserved;
Size vmem2 = ArenaReserved(arena);
- /* VMCompact event: emit for all client-requested collections, */
- /* plus any others where chunks were gained or lost during the */
- /* collection. */
- if(trace->why == TraceStartWhyCLIENTFULL_INCREMENTAL
- || trace->why == TraceStartWhyCLIENTFULL_BLOCK
- || vmem0 != vmem1
- || vmem1 != vmem2)
+ /* VMCompact event: emit for collections where chunks were gained
+ * or lost during the collection. */
+ if (vmem0 != vmem1 || vmem1 != vmem2)
EVENT3(VMCompact, vmem0, vmem1, vmem2);
- }
+ });
}
mps_res_t mps_arena_vm_growth(mps_arena_t mps_arena,
@@ -1181,8 +1199,7 @@ mps_res_t mps_arena_vm_growth(mps_arena_t mps_arena,
ArenaEnter(arena);
AVERT(Arena, arena);
- vmArena = Arena2VMArena(arena);
- AVERT(VMArena, vmArena);
+ vmArena = MustBeA(VMArena, arena);
/* Must desire at least the minimum increment! */
AVER(desired >= minimum);
@@ -1198,24 +1215,23 @@ mps_res_t mps_arena_vm_growth(mps_arena_t mps_arena,
/* VMArenaClass -- The VM arena class definition */
-DEFINE_ARENA_CLASS(VMArenaClass, this)
+DEFINE_CLASS(Arena, VMArena, klass)
{
- INHERIT_CLASS(this, AbstractArenaClass);
- this->name = "VM";
- this->size = sizeof(VMArenaStruct);
- this->offset = offsetof(VMArenaStruct, arenaStruct);
- this->varargs = VMArenaVarargs;
- this->init = VMArenaInit;
- this->finish = VMArenaFinish;
- this->purgeSpare = VMPurgeSpare;
- this->grow = VMArenaGrow;
- this->free = VMFree;
- this->chunkInit = VMChunkInit;
- this->chunkFinish = VMChunkFinish;
- this->compact = VMCompact;
- this->describe = VMArenaDescribe;
- this->pagesMarkAllocated = VMPagesMarkAllocated;
- AVERT(ArenaClass, this);
+ INHERIT_CLASS(klass, VMArena, AbstractArena);
+ klass->instClassStruct.describe = VMArenaDescribe;
+ klass->size = sizeof(VMArenaStruct);
+ klass->varargs = VMArenaVarargs;
+ klass->create = VMArenaCreate;
+ klass->destroy = VMArenaDestroy;
+ klass->purgeSpare = VMPurgeSpare;
+ klass->grow = VMArenaGrow;
+ klass->free = VMFree;
+ klass->chunkInit = VMChunkInit;
+ klass->chunkFinish = VMChunkFinish;
+ klass->compact = VMCompact;
+ klass->pagesMarkAllocated = VMPagesMarkAllocated;
+ klass->chunkPageMapped = VMChunkPageMapped;
+ AVERT(ArenaClass, klass);
}
@@ -1223,13 +1239,13 @@ DEFINE_ARENA_CLASS(VMArenaClass, this)
mps_arena_class_t mps_arena_class_vm(void)
{
- return (mps_arena_class_t)VMArenaClassGet();
+ return (mps_arena_class_t)CLASS(VMArena);
}
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/arg.c b/mps/code/arg.c
index 4721c415ccb..8d129534a70 100644
--- a/mps/code/arg.c
+++ b/mps/code/arg.c
@@ -1,7 +1,7 @@
/* arg.c: ARGUMENT LISTS
*
* $Id$
- * Copyright (c) 2013-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2013-2018 Ravenbrook Limited. See end of file for license.
*
* .source: See .
*/
@@ -20,86 +20,102 @@ SRCID(arg, "$Id$");
* that don't have any meaningful checking they can do.
*/
-Bool ArgCheckCant(Arg arg) {
+Bool ArgCheckCant(Arg arg)
+{
UNUSED(arg);
return TRUE;
}
-static Bool ArgCheckShouldnt(Arg arg) {
+static Bool ArgCheckShouldnt(Arg arg)
+{
UNUSED(arg);
NOTREACHED;
return FALSE;
}
-Bool ArgCheckFormat(Arg arg) {
+Bool ArgCheckFormat(Arg arg)
+{
CHECKD(Format, arg->val.format);
return TRUE;
}
-Bool ArgCheckChain(Arg arg) {
+Bool ArgCheckChain(Arg arg)
+{
CHECKD(Chain, arg->val.chain);
return TRUE;
}
-Bool ArgCheckSize(Arg arg) {
+Bool ArgCheckSize(Arg arg)
+{
UNUSED(arg); /* TODO: Add and call SizeCheck */
return TRUE;
}
-Bool ArgCheckAddr(Arg arg) {
+Bool ArgCheckAddr(Arg arg)
+{
UNUSED(arg); /* TODO: Add and call AddrCheck */
return TRUE;
}
-Bool ArgCheckPoolDebugOptions(Arg arg) {
+Bool ArgCheckPoolDebugOptions(Arg arg)
+{
CHECKD_NOSIG(PoolDebugOptions, (PoolDebugOptions)arg->val.pool_debug_options);
return TRUE;
}
-Bool ArgCheckFun(Arg arg) {
+Bool ArgCheckFun(Arg arg)
+{
CHECKL(FUNCHECK(arg->val.addr_method)); /* FIXME: Potential pun here */
return TRUE;
}
-Bool ArgCheckAlign(Arg arg) {
+Bool ArgCheckAlign(Arg arg)
+{
CHECKL(AlignCheck(arg->val.align));
return TRUE;
}
-Bool ArgCheckBool(Arg arg) {
+Bool ArgCheckBool(Arg arg)
+{
CHECKL(BoolCheck(arg->val.b));
return TRUE;
}
-Bool ArgCheckCount(Arg arg) {
+Bool ArgCheckCount(Arg arg)
+{
UNUSED(arg); /* TODO: Add and call CountCheck */
return TRUE;
}
-Bool ArgCheckPointer(Arg arg) {
+Bool ArgCheckPointer(Arg arg)
+{
CHECKL(arg != NULL);
return TRUE;
}
-Bool ArgCheckRankSet(Arg arg) {
+Bool ArgCheckRankSet(Arg arg)
+{
CHECKL(COMPATTYPE(RankSet, unsigned));
CHECKL(RankSetCheck(arg->val.u));
return TRUE;
}
-Bool ArgCheckRank(Arg arg) {
+Bool ArgCheckRank(Arg arg)
+{
CHECKL(RankCheck(arg->val.rank));
return TRUE;
}
-Bool ArgCheckdouble(Arg arg) {
- /* It would be nice if we could check doubles with C89, but
- it doesn't have isfinite() etc. which are in C99. */
+Bool ArgCheckdouble(Arg arg)
+{
+ /* Don't call isfinite() here because it's not in C89, and because
+ infinity is a valid value for MPS_KEY_PAUSE_TIME. */
UNUSED(arg);
return TRUE;
}
-Bool ArgCheckPool(Arg arg) {
+Bool ArgCheckPool(Arg arg)
+{
CHECKD(Pool, arg->val.pool);
return TRUE;
}
@@ -146,7 +162,8 @@ Bool ArgListCheck(ArgList args)
/* ArgPick -- try to pick an argument out of the argument list by keyword */
-Bool ArgPick(ArgStruct *argOut, ArgList args, Key key) {
+Bool ArgPick(ArgStruct *argOut, ArgList args, Key key)
+{
Index i;
AVER(argOut != NULL);
@@ -173,7 +190,8 @@ Bool ArgPick(ArgStruct *argOut, ArgList args, Key key) {
/* ArgRequire -- take a required argument out of the argument list by keyword */
-void ArgRequire(ArgStruct *argOut, ArgList args, Key key) {
+void ArgRequire(ArgStruct *argOut, ArgList args, Key key)
+{
Bool b = ArgPick(argOut, args, key);
ASSERT(b, key->name);
}
@@ -192,7 +210,7 @@ void ArgTrivVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 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 e31e157c14c..b0a71ab7454 100644
--- a/mps/code/awlut.c
+++ b/mps/code/awlut.c
@@ -13,6 +13,7 @@
#include "mpsavm.h"
#include "fmtdy.h"
#include "testlib.h"
+#include "testthr.h"
#include "mpslib.h"
#include "mps.h"
#include "mpstd.h"
@@ -172,42 +173,79 @@ static void table_link(mps_word_t *t1, mps_word_t *t2)
}
-static void test(mps_arena_t arena,
- mps_ap_t leafap, mps_ap_t exactap, mps_ap_t weakap,
- mps_ap_t bogusap)
-{
+typedef struct tables_s {
+ mps_arena_t arena;
mps_word_t *weaktable;
mps_word_t *exacttable;
mps_word_t *preserve[TABLE_SLOTS]; /* preserves objects in the weak */
/* table by referring to them */
- size_t i, j;
- void *p;
+ mps_ap_t weakap, exactap, bogusap, leafap;
+} tables_s, *tables_t;
- exacttable = alloc_table(TABLE_SLOTS, exactap);
- weaktable = alloc_table(TABLE_SLOTS, weakap);
- table_link(exacttable, weaktable);
+
+/* populate -- populate the weak table in a thread
+ *
+ * We use a thread to populate the table to avoid leaving any
+ * references to objects in the table in registers, so that we can
+ * test their weakness properly.
+ */
+
+static void *populate(void *state)
+{
+ tables_t tables = state;
+ size_t i;
+ mps_thr_t me;
+ mps_root_t root;
+
+ die(mps_thread_reg(&me, tables->arena), "mps_thread_reg(populate)");
+ die(mps_root_create_thread(&root, tables->arena, me, &state), "mps_root_create_thread(populate)");
+
+ tables->exacttable = alloc_table(TABLE_SLOTS, tables->exactap);
+ tables->weaktable = alloc_table(TABLE_SLOTS, tables->weakap);
+ table_link(tables->exacttable, tables->weaktable);
+
+ for(i = 0; i < TABLE_SLOTS; ++i) {
+ mps_word_t *string;
+ if (rnd() % 2 == 0) {
+ string = alloc_string("iamalive", tables->leafap);
+ tables->preserve[i] = string;
+ } else {
+ string = alloc_string("iamdead", tables->leafap);
+ tables->preserve[i] = 0;
+ }
+ set_table_slot(tables->weaktable, i, string);
+ string = alloc_string("iamexact", tables->leafap);
+ set_table_slot(tables->exacttable, i, string);
+ }
+
+ mps_root_destroy(root);
+ mps_thread_dereg(me);
+
+ return NULL;
+}
+
+static void test(mps_arena_t arena,
+ mps_ap_t leafap, mps_ap_t exactap, mps_ap_t weakap,
+ mps_ap_t bogusap)
+{
+ tables_s tables;
+ size_t i, j;
+ testthr_t thr;
+ void *p;
/* Leave bogusap between reserve and commit for the duration */
die(mps_reserve(&p, bogusap, 64), "Reserve bogus");
- for(i = 0; i < TABLE_SLOTS; ++i) {
- mps_word_t *string;
- /* Ensure that the first and last entries in the table are
- * preserved, so that we don't get false positives due to the
- * local variables 'weak_table' and 'string' keeping these entries
- * alive (see job003436).
- */
- if (rnd() % 2 == 0 || i == 0 || i + 1 == TABLE_SLOTS) {
- string = alloc_string("iamalive", leafap);
- preserve[i] = string;
- } else {
- string = alloc_string("iamdead", leafap);
- preserve[i] = 0;
- }
- set_table_slot(weaktable, i, string);
- string = alloc_string("iamexact", leafap);
- set_table_slot(exacttable, i, string);
- }
+ tables.arena = arena;
+ tables.exactap = exactap;
+ tables.weakap = weakap;
+ tables.leafap = leafap;
+ tables.bogusap = bogusap;
+
+ /* We using a thread for its pararallel execution, so just create
+ and wait for it to finish. */
+ testthr_create(&thr, populate, &tables);
+ testthr_join(&thr, NULL);
for(j = 0; j < ITERATIONS; ++j) {
for(i = 0; i < TABLE_SLOTS; ++i) {
@@ -219,12 +257,12 @@ static void test(mps_arena_t arena,
mps_arena_release(arena);
for(i = 0; i < TABLE_SLOTS; ++i) {
- if (preserve[i] == 0) {
- if (table_slot(weaktable, i)) {
+ if (tables.preserve[i] == 0) {
+ if (table_slot(tables.weaktable, i)) {
error("Strongly unreachable weak table entry found, "
"slot %"PRIuLONGEST".\n", (ulongest_t)i);
} else {
- if (table_slot(exacttable, i) != 0) {
+ if (table_slot(tables.exacttable, i) != 0) {
error("Weak table entry deleted, but corresponding "
"exact table entry not deleted, slot %"PRIuLONGEST".\n",
(ulongest_t)i);
diff --git a/mps/code/awluthe.c b/mps/code/awluthe.c
index a6653a3e23b..f27613a75b0 100644
--- a/mps/code/awluthe.c
+++ b/mps/code/awluthe.c
@@ -14,6 +14,7 @@
#include "fmthe.h"
#include "fmtdy.h"
#include "testlib.h"
+#include "testthr.h"
#include "mpslib.h"
#include "mps.h"
#include "mpstd.h"
@@ -177,42 +178,79 @@ static void table_link(mps_word_t *t1, mps_word_t *t2)
}
-static void test(mps_arena_t arena,
- mps_ap_t leafap, mps_ap_t exactap, mps_ap_t weakap,
- mps_ap_t bogusap)
-{
+typedef struct tables_s {
+ mps_arena_t arena;
mps_word_t *weaktable;
mps_word_t *exacttable;
mps_word_t *preserve[TABLE_SLOTS]; /* preserves objects in the weak */
/* table by referring to them */
- size_t i, j;
- void *p;
+ mps_ap_t weakap, exactap, bogusap, leafap;
+} tables_s, *tables_t;
- exacttable = alloc_table(TABLE_SLOTS, exactap);
- weaktable = alloc_table(TABLE_SLOTS, weakap);
- table_link(exacttable, weaktable);
+/* populate -- populate the weak table in a thread
+ *
+ * We use a thread to populate the table to avoid leaving any
+ * references to objects in the table in registers, so that we can
+ * test their weakness properly.
+ */
+
+static void *populate(void *state)
+{
+ tables_t tables = state;
+ size_t i;
+ mps_thr_t me;
+ mps_root_t root;
+
+ die(mps_thread_reg(&me, tables->arena), "mps_thread_reg(populate)");
+ die(mps_root_create_thread(&root, tables->arena, me, &state), "mps_root_create_thread(populate)");
+
+ tables->exacttable = alloc_table(TABLE_SLOTS, tables->exactap);
+ tables->weaktable = alloc_table(TABLE_SLOTS, tables->weakap);
+ table_link(tables->exacttable, tables->weaktable);
+
+ for(i = 0; i < TABLE_SLOTS; ++i) {
+ mps_word_t *string;
+ if (rnd() % 2 == 0) {
+ string = alloc_string("iamalive", tables->leafap);
+ tables->preserve[i] = string;
+ } else {
+ string = alloc_string("iamdead", tables->leafap);
+ tables->preserve[i] = 0;
+ }
+ set_table_slot(tables->weaktable, i, string);
+ string = alloc_string("iamexact", tables->leafap);
+ set_table_slot(tables->exacttable, i, string);
+ }
+
+ mps_root_destroy(root);
+ mps_thread_dereg(me);
+
+ return NULL;
+}
+
+static void test(mps_arena_t arena,
+ mps_ap_t leafap, mps_ap_t exactap, mps_ap_t weakap,
+ mps_ap_t bogusap)
+{
+ tables_s tables;
+ size_t i, j;
+ testthr_t thr;
+ void *p;
/* Leave bogusap between reserve and commit for the duration */
die(mps_reserve(&p, bogusap, 64), "Reserve bogus");
- for(i = 0; i < TABLE_SLOTS; ++i) {
- mps_word_t *string;
- /* Ensure that the last entry in the table is preserved, so that
- * we don't get a false positive due to the local variable
- * 'string' keeping this entry alive (see job003436).
- */
- if (rnd() % 2 == 0 || i + 1 == TABLE_SLOTS) {
- string = alloc_string("iamalive", leafap);
- preserve[i] = string;
- } else {
- string = alloc_string("iamdead", leafap);
- preserve[i] = 0;
- }
- set_table_slot(weaktable, i, string);
- string = alloc_string("iamexact", leafap);
- set_table_slot(exacttable, i, string);
- }
+ tables.arena = arena;
+ tables.exactap = exactap;
+ tables.weakap = weakap;
+ tables.leafap = leafap;
+ tables.bogusap = bogusap;
+ /* We using a thread for its pararallel execution, so just create
+ and wait for it to finish. */
+ testthr_create(&thr, populate, &tables);
+ testthr_join(&thr, NULL);
+
for(j = 0; j < ITERATIONS; ++j) {
for(i = 0; i < TABLE_SLOTS; ++i) {
(void)alloc_string("spong", leafap);
@@ -223,12 +261,12 @@ static void test(mps_arena_t arena,
mps_arena_release(arena);
for(i = 0; i < TABLE_SLOTS; ++i) {
- if (preserve[i] == 0) {
- if (table_slot(weaktable, i)) {
+ if (tables.preserve[i] == 0) {
+ if (table_slot(tables.weaktable, i)) {
error("Strongly unreachable weak table entry found, "
"slot %"PRIuLONGEST".\n", (ulongest_t)i);
} else {
- if (table_slot(exacttable, i) != 0) {
+ if (table_slot(tables.exacttable, i) != 0) {
error("Weak table entry deleted, but corresponding "
"exact table entry not deleted, slot %"PRIuLONGEST".\n",
(ulongest_t)i);
diff --git a/mps/code/bt.c b/mps/code/bt.c
index 1a79b82f5f3..844846ba723 100644
--- a/mps/code/bt.c
+++ b/mps/code/bt.c
@@ -191,8 +191,7 @@ Res BTCreate(BT *btReturn, Arena arena, Count length)
AVERT(Arena, arena);
AVER(length > 0);
- res = ControlAlloc(&p, arena, BTSize(length),
- /* withReservoirPermit */ FALSE);
+ res = ControlAlloc(&p, arena, BTSize(length));
if (res != ResOK)
return res;
bt = (BT)p;
diff --git a/mps/code/bttest.c b/mps/code/bttest.c
index 20bb4cab4e7..cc51b9cf63d 100644
--- a/mps/code/bttest.c
+++ b/mps/code/bttest.c
@@ -1,7 +1,7 @@
/* bttest.c: BIT TABLE TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*/
@@ -311,7 +311,8 @@ static void obeyCommand(const char *command)
}
-static void showBT(void) {
+static void showBT(void)
+{
Index i;
char c;
if (bt == NULL)
@@ -350,7 +351,7 @@ static void showBT(void) {
#define testArenaSIZE (((size_t)64)<<20)
-extern int main(int argc, char *argv[])
+int main(int argc, char *argv[])
{
bt = NULL;
btSize = 0;
@@ -376,7 +377,7 @@ extern int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/buffer.c b/mps/code/buffer.c
index edef611c217..1fe68becfac 100644
--- a/mps/code/buffer.c
+++ b/mps/code/buffer.c
@@ -1,7 +1,7 @@
/* buffer.c: ALLOCATION BUFFER IMPLEMENTATION
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
*
* .purpose: This is (part of) the implementation of allocation buffers.
* Several macros which also form part of the implementation are in
@@ -28,10 +28,6 @@
SRCID(buffer, "$Id$");
-/* forward declarations */
-static void BufferFrameNotifyPopPending(Buffer buffer);
-
-
/* BufferCheck -- check consistency of a buffer
*
* See .ap.async. */
@@ -39,6 +35,7 @@ static void BufferFrameNotifyPopPending(Buffer buffer);
Bool BufferCheck(Buffer buffer)
{
CHECKS(Buffer, buffer);
+ CHECKC(Buffer, buffer);
CHECKL(buffer->serial < buffer->pool->bufferSerial); /* .trans.mod */
CHECKU(Arena, buffer->arena);
CHECKU(Pool, buffer->pool);
@@ -50,15 +47,6 @@ Bool BufferCheck(Buffer buffer)
CHECKL(buffer->emptySize <= buffer->fillSize);
CHECKL(buffer->alignment == buffer->pool->alignment);
CHECKL(AlignCheck(buffer->alignment));
- CHECKL(BoolCheck(buffer->ap_s._enabled));
-
- if (buffer->ap_s._enabled) {
- /* no useful check for frameptr - mutator may be updating it */
- CHECKL(BoolCheck(buffer->ap_s._lwpoppending));
- } else {
- CHECKL(buffer->ap_s._lwpoppending == FALSE);
- CHECKL(buffer->ap_s._frameptr == NULL);
- }
/* If any of the buffer's fields indicate that it is reset, make */
/* sure it is really reset. Otherwise, check various properties */
@@ -79,8 +67,6 @@ Bool BufferCheck(Buffer buffer)
/* Nothing reliable to check for lightweight frame state */
CHECKL(buffer->poolLimit == (Addr)0);
} else {
- Addr aplimit;
-
/* The buffer is attached to a region of memory. */
/* Check consistency. */
CHECKL(buffer->mode & BufferModeATTACHED);
@@ -99,14 +85,6 @@ Bool BufferCheck(Buffer buffer)
CHECKL(AddrIsAligned(buffer->ap_s.limit, buffer->alignment));
CHECKL(AddrIsAligned(buffer->poolLimit, buffer->alignment));
- /* .lwcheck: If LW frames are enabled, the buffer may become */
- /* trapped asynchronously. It can't become untrapped */
- /* asynchronously, though. See . */
- /* Read a snapshot value of the limit field. Use this to determine */
- /* if we are trapped, and to permit more useful checking when not */
- /* yet trapped. */
- aplimit = buffer->ap_s.limit;
-
/* If the buffer isn't trapped then "limit" should be the limit */
/* set by the owning pool. Otherwise, "init" is either at the */
/* same place it was at flip (.commit.before) or has been set */
@@ -117,12 +95,10 @@ Bool BufferCheck(Buffer buffer)
/* request.dylan.170429.sol.zero_). */
/* .. _request.dylan.170429.sol.zero: https://info.ravenbrook.com/project/mps/import/2001-11-05/mmprevol/request/dylan/170429 */
- if ((buffer->ap_s._enabled && aplimit == (Addr)0) /* see .lwcheck */
- || (!buffer->ap_s._enabled && BufferIsTrapped(buffer))) {
+ if (BufferIsTrapped(buffer)) {
/* .check.use-trapped: This checking function uses BufferIsTrapped, */
/* So BufferIsTrapped can't do checking as that would cause an */
/* infinite loop. */
- CHECKL(aplimit == (Addr)0);
if (buffer->mode & BufferModeFLIPPED) {
CHECKL(buffer->ap_s.init == buffer->initAtFlip
|| buffer->ap_s.init == buffer->ap_s.alloc);
@@ -131,7 +107,6 @@ Bool BufferCheck(Buffer buffer)
}
/* Nothing special to check in the logged mode. */
} else {
- CHECKL(aplimit == buffer->poolLimit); /* see .lwcheck */
CHECKL(buffer->initAtFlip == (Addr)0);
}
}
@@ -144,71 +119,69 @@ Bool BufferCheck(Buffer buffer)
*
* See for structure definitions. */
-Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
+static Res BufferAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
{
+ Buffer buffer = CouldBeA(Buffer, inst);
Res res;
- if (!TESTT(Buffer, buffer))
- return ResFAIL;
+ if (!TESTC(Buffer, buffer))
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
+ return ResPARAM;
- res = WriteF(stream, depth,
- "Buffer $P ($U) {\n",
- (WriteFP)buffer, (WriteFU)buffer->serial,
- " class $P (\"$S\")\n",
- (WriteFP)buffer->class, (WriteFS)buffer->class->name,
- " Arena $P\n", (WriteFP)buffer->arena,
- " Pool $P\n", (WriteFP)buffer->pool,
- " ", buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
- " mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
- (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'),
- (WriteFC)((buffer->mode & BufferModeLOGGED) ? 'l' : '_'),
- (WriteFC)((buffer->mode & BufferModeFLIPPED) ? 'f' : '_'),
- (WriteFC)((buffer->mode & BufferModeATTACHED) ? 'a' : '_'),
- " fillSize $UKb\n", (WriteFU)(buffer->fillSize / 1024),
- " emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
- " alignment $W\n", (WriteFW)buffer->alignment,
- " base $A\n", (WriteFA)buffer->base,
- " initAtFlip $A\n", (WriteFA)buffer->initAtFlip,
- " init $A\n", (WriteFA)buffer->ap_s.init,
- " alloc $A\n", (WriteFA)buffer->ap_s.alloc,
- " limit $A\n", (WriteFA)buffer->ap_s.limit,
- " poolLimit $A\n", (WriteFA)buffer->poolLimit,
- " alignment $W\n", (WriteFW)buffer->alignment,
- " rampCount $U\n", (WriteFU)buffer->rampCount,
- NULL);
+ res = NextMethod(Inst, Buffer, describe)(inst, stream, depth);
if (res != ResOK)
return res;
- res = buffer->class->describe(buffer, stream, depth + 2);
- if (res != ResOK)
- return res;
+ return WriteF(stream, depth + 2,
+ "serial $U\n", (WriteFU)buffer->serial,
+ "Arena $P\n", (WriteFP)buffer->arena,
+ "Pool $P\n", (WriteFP)buffer->pool,
+ buffer->isMutator ? "Mutator" : "Internal", " Buffer\n",
+ "mode $C$C$C$C (TRANSITION, LOGGED, FLIPPED, ATTACHED)\n",
+ (WriteFC)((buffer->mode & BufferModeTRANSITION) ? 't' : '_'),
+ (WriteFC)((buffer->mode & BufferModeLOGGED) ? 'l' : '_'),
+ (WriteFC)((buffer->mode & BufferModeFLIPPED) ? 'f' : '_'),
+ (WriteFC)((buffer->mode & BufferModeATTACHED) ? 'a' : '_'),
+ "fillSize $UKb\n", (WriteFU)(buffer->fillSize / 1024),
+ "emptySize $UKb\n", (WriteFU)(buffer->emptySize / 1024),
+ "alignment $W\n", (WriteFW)buffer->alignment,
+ "base $A\n", (WriteFA)buffer->base,
+ "initAtFlip $A\n", (WriteFA)buffer->initAtFlip,
+ "init $A\n", (WriteFA)buffer->ap_s.init,
+ "alloc $A\n", (WriteFA)buffer->ap_s.alloc,
+ "limit $A\n", (WriteFA)buffer->ap_s.limit,
+ "poolLimit $A\n", (WriteFA)buffer->poolLimit,
+ "alignment $W\n", (WriteFW)buffer->alignment,
+ "rampCount $U\n", (WriteFU)buffer->rampCount,
+ NULL);
+}
- res = WriteF(stream, depth, "} Buffer $P ($U)\n",
- (WriteFP)buffer, (WriteFU)buffer->serial,
- NULL);
- return res;
+Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
+{
+ return Method(Inst, buffer, describe)(MustBeA(Inst, buffer), stream, depth);
}
/* BufferInit -- initialize an allocation buffer */
-static Res BufferInit(Buffer buffer, BufferClass class,
- Pool pool, Bool isMutator, ArgList args)
+static Res BufferAbsInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args)
{
Arena arena;
- Res res;
AVER(buffer != NULL);
- AVERT(BufferClass, class);
AVERT(Pool, pool);
-
+ AVER(BoolCheck(isMutator));
+ AVERT(ArgList, args);
+
+ /* Superclass init */
+ InstInit(CouldBeA(Inst, buffer));
+
arena = PoolArena(pool);
- /* Initialize the buffer. See for a definition of */
- /* the structure. sig and serial comes later .init.sig-serial */
+
+ /* Initialize the buffer. See for a definition of
+ the structure. sig and serial comes later .init.sig-serial */
buffer->arena = arena;
- buffer->class = class;
buffer->pool = pool;
RingInit(&buffer->poolRing);
buffer->isMutator = isMutator;
@@ -228,43 +201,40 @@ static Res BufferInit(Buffer buffer, BufferClass class,
buffer->ap_s.init = (mps_addr_t)0;
buffer->ap_s.alloc = (mps_addr_t)0;
buffer->ap_s.limit = (mps_addr_t)0;
- buffer->ap_s._frameptr = NULL;
- buffer->ap_s._enabled = FALSE;
- buffer->ap_s._lwpoppending = FALSE;
buffer->poolLimit = (Addr)0;
buffer->rampCount = 0;
- /* .init.sig-serial: Now the vanilla stuff is initialized, */
- /* sign the buffer and give it a serial number. It can */
- /* then be safely checked in subclass methods. */
- buffer->sig = BufferSig;
+ /* .init.sig-serial: Now the vanilla stuff is initialized, sign the
+ buffer and give it a serial number. It can then be safely checked
+ in subclass methods. */
buffer->serial = pool->bufferSerial; /* .trans.mod */
++pool->bufferSerial;
+ SetClassOfPoly(buffer, CLASS(Buffer));
+ buffer->sig = BufferSig;
AVERT(Buffer, buffer);
- /* Dispatch to the buffer class method to perform any */
- /* class-specific initialization of the buffer. */
- res = (*class->init)(buffer, pool, args);
- if (res != ResOK)
- goto failInit;
-
/* Attach the initialized buffer to the pool. */
RingAppend(&pool->bufferRing, &buffer->poolRing);
- return ResOK;
+ EVENT3(BufferInit, buffer, pool, BOOLOF(buffer->isMutator));
-failInit:
- RingFinish(&buffer->poolRing);
- buffer->sig = SigInvalid;
- return res;
+ return ResOK;
+}
+
+static Res BufferInit(Buffer buffer, BufferClass klass,
+ Pool pool, Bool isMutator, ArgList args)
+{
+ AVERT(BufferClass, klass);
+ return klass->init(buffer, pool, isMutator, args);
}
/* BufferCreate -- create an allocation buffer
*
- * See . */
+ * See .
+ */
-Res BufferCreate(Buffer *bufferReturn, BufferClass class,
+Res BufferCreate(Buffer *bufferReturn, BufferClass klass,
Pool pool, Bool isMutator, ArgList args)
{
Res res;
@@ -273,20 +243,19 @@ Res BufferCreate(Buffer *bufferReturn, BufferClass class,
void *p;
AVER(bufferReturn != NULL);
- AVERT(BufferClass, class);
+ AVERT(BufferClass, klass);
AVERT(Pool, pool);
arena = PoolArena(pool);
/* Allocate memory for the buffer descriptor structure. */
- res = ControlAlloc(&p, arena, class->size,
- /* withReservoirPermit */ FALSE);
+ res = ControlAlloc(&p, arena, klass->size);
if (res != ResOK)
goto failAlloc;
buffer = p;
/* Initialize the buffer descriptor structure. */
- res = BufferInit(buffer, class, pool, isMutator, args);
+ res = BufferInit(buffer, klass, pool, isMutator, args);
if (res != ResOK)
goto failInit;
@@ -294,7 +263,7 @@ Res BufferCreate(Buffer *bufferReturn, BufferClass class,
return ResOK;
failInit:
- ControlFree(arena, buffer, class->size);
+ ControlFree(arena, buffer, klass->size);
failAlloc:
return res;
}
@@ -312,17 +281,16 @@ void BufferDetach(Buffer buffer, Pool pool)
Size spare;
buffer->mode |= BufferModeTRANSITION;
- init = buffer->ap_s.init;
- limit = buffer->poolLimit;
+
/* Ask the owning pool to do whatever it needs to before the */
/* buffer is detached (e.g. copy buffer state into pool state). */
- (*pool->class->bufferEmpty)(pool, buffer, init, limit);
- /* Use of lightweight frames must have been disabled by now */
- AVER(BufferFrameState(buffer) == BufferFrameDISABLED);
+ Method(Pool, pool, bufferEmpty)(pool, buffer);
/* run any class-specific detachment method */
- buffer->class->detach(buffer);
+ Method(Buffer, buffer, detach)(buffer);
+ init = BufferGetInit(buffer);
+ limit = BufferLimit(buffer);
spare = AddrOffset(init, limit);
buffer->emptySize += spare;
if (buffer->isMutator) {
@@ -342,7 +310,6 @@ void BufferDetach(Buffer buffer, Pool pool)
buffer->poolLimit = (Addr)0;
buffer->mode &=
~(BufferModeATTACHED|BufferModeFLIPPED|BufferModeTRANSITION);
- BufferFrameSetState(buffer, BufferFrameDISABLED);
EVENT2(BufferEmpty, buffer, spare);
}
@@ -356,42 +323,26 @@ void BufferDetach(Buffer buffer, Pool pool)
void BufferDestroy(Buffer buffer)
{
Arena arena;
- BufferClass class;
-
+ Size size;
AVERT(Buffer, buffer);
arena = buffer->arena;
- class = buffer->class;
- AVERT(BufferClass, class);
+ size = ClassOfPoly(Buffer, buffer)->size;
BufferFinish(buffer);
- ControlFree(arena, buffer, class->size);
+ ControlFree(arena, buffer, size);
}
/* BufferFinish -- finish an allocation buffer */
-void BufferFinish(Buffer buffer)
+static void BufferAbsFinish(Inst inst)
{
- Pool pool;
-
+ Buffer buffer = MustBeA(Buffer, inst);
AVERT(Buffer, buffer);
-
- pool = BufferPool(buffer);
-
- AVER(BufferIsReady(buffer));
-
- /* */
- if (BufferIsTrappedByMutator(buffer)) {
- BufferFrameNotifyPopPending(buffer);
- }
-
- BufferDetach(buffer, pool);
-
- /* Dispatch to the buffer class method to perform any */
- /* class-specific finishing of the buffer. */
- (*buffer->class->finish)(buffer);
+ AVER(BufferIsReset(buffer));
/* Detach the buffer from its owning pool and unsig it. */
RingRemove(&buffer->poolRing);
+ InstFinish(MustBeA(Inst, buffer));
buffer->sig = SigInvalid;
/* Finish off the generic buffer fields. */
@@ -400,6 +351,16 @@ void BufferFinish(Buffer buffer)
EVENT1(BufferFinish, buffer);
}
+void BufferFinish(Buffer buffer)
+{
+ AVERT(Buffer, buffer);
+ AVER(BufferIsReady(buffer));
+
+ BufferDetach(buffer, BufferPool(buffer)); /* FIXME: Should be in BufferAbsFinish? */
+
+ Method(Inst, buffer, finish)(MustBeA(Inst, buffer));
+}
+
/* BufferIsReset -- test whether a buffer is in the "reset" state
*
@@ -459,44 +420,6 @@ static void BufferSetUnflipped(Buffer buffer)
}
-/* BufferFrameState
- *
- * Returns the frame state of a buffer. See
- * . */
-
-FrameState BufferFrameState(Buffer buffer)
-{
- AVERT(Buffer, buffer);
- if (buffer->ap_s._enabled) {
- if (buffer->ap_s._lwpoppending) {
- return BufferFramePOP_PENDING;
- } else {
- AVER(buffer->ap_s._frameptr == NULL);
- return BufferFrameVALID;
- }
- } else {
- AVER(buffer->ap_s._frameptr == NULL);
- AVER(buffer->ap_s._lwpoppending == FALSE);
- return BufferFrameDISABLED;
- }
-}
-
-
-/* BufferFrameSetState
- *
- * Sets the frame state of a buffer. Only the mutator may set the
- * PopPending state. See . */
-
-void BufferFrameSetState(Buffer buffer, FrameState state)
-{
- AVERT(Buffer, buffer);
- AVER(state == BufferFrameVALID || state == BufferFrameDISABLED);
- buffer->ap_s._frameptr = NULL;
- buffer->ap_s._lwpoppending = FALSE;
- buffer->ap_s._enabled = (state == BufferFrameVALID);
-}
-
-
/* BufferSetAllocAddr
*
* Sets the init & alloc pointers of a buffer. */
@@ -514,32 +437,6 @@ void BufferSetAllocAddr(Buffer buffer, Addr addr)
}
-/* BufferFrameNotifyPopPending
- *
- * Notifies the pool when a lightweight frame pop operation has been
- * deferred and needs to be processed. See
- * . */
-
-static void BufferFrameNotifyPopPending(Buffer buffer)
-{
- AllocFrame frame;
- Pool pool;
- AVER(BufferIsTrappedByMutator(buffer));
- AVER(BufferFrameState(buffer) == BufferFramePOP_PENDING);
- frame = (AllocFrame)buffer->ap_s._frameptr;
- /* Unset PopPending state & notify the pool */
- BufferFrameSetState(buffer, BufferFrameVALID);
- /* If the frame is no longer trapped, undo the trap by resetting */
- /* the AP limit pointer */
- if (!BufferIsTrapped(buffer)) {
- buffer->ap_s.limit = buffer->poolLimit;
- }
- pool = BufferPool(buffer);
- (*pool->class->framePopPending)(pool, buffer, frame);
-}
-
-
-
/* BufferFramePush
*
* See . */
@@ -551,20 +448,15 @@ Res BufferFramePush(AllocFrame *frameReturn, Buffer buffer)
AVER(frameReturn != NULL);
- /* Process any flip or PopPending */
+ /* Process any flip */
if (!BufferIsReset(buffer) && buffer->ap_s.limit == (Addr)0) {
/* .fill.unflip: If the buffer is flipped then we unflip the buffer. */
if (buffer->mode & BufferModeFLIPPED) {
BufferSetUnflipped(buffer);
}
-
- /* check for PopPending */
- if (BufferIsTrappedByMutator(buffer)) {
- BufferFrameNotifyPopPending(buffer);
- }
}
pool = BufferPool(buffer);
- return (*pool->class->framePush)(frameReturn, pool, buffer);
+ return Method(Pool, pool, framePush)(frameReturn, pool, buffer);
}
@@ -578,7 +470,7 @@ Res BufferFramePop(Buffer buffer, AllocFrame frame)
AVERT(Buffer, buffer);
/* frame is of an abstract type & can't be checked */
pool = BufferPool(buffer);
- return (*pool->class->framePop)(pool, buffer, frame);
+ return Method(Pool, pool, framePop)(pool, buffer, frame);
}
@@ -588,8 +480,7 @@ Res BufferFramePop(Buffer buffer, AllocFrame frame)
*
* .reserve: Keep in sync with . */
-Res BufferReserve(Addr *pReturn, Buffer buffer, Size size,
- Bool withReservoirPermit)
+Res BufferReserve(Addr *pReturn, Buffer buffer, Size size)
{
Addr next;
@@ -597,8 +488,7 @@ Res BufferReserve(Addr *pReturn, Buffer buffer, Size size,
AVERT(Buffer, buffer);
AVER(size > 0);
AVER(SizeIsAligned(size, BufferPool(buffer)->alignment));
- AVER(BufferIsReady(buffer));
- AVERT(Bool, withReservoirPermit);
+ AVER(BufferIsReady(buffer)); /* */
/* Is there enough room in the unallocated portion of the buffer to */
/* satisfy the request? If so, just increase the alloc marker and */
@@ -612,7 +502,7 @@ Res BufferReserve(Addr *pReturn, Buffer buffer, Size size,
}
/* If the buffer can't accommodate the request, call "fill". */
- return BufferFill(pReturn, buffer, size, withReservoirPermit);
+ return BufferFill(pReturn, buffer, size);
}
@@ -659,7 +549,7 @@ void BufferAttach(Buffer buffer, Addr base, Addr limit,
}
/* run any class-specific attachment method */
- buffer->class->attach(buffer, base, limit, init, size);
+ Method(Buffer, buffer, attach)(buffer, base, limit, init, size);
AVERT(Buffer, buffer);
EVENT4(BufferFill, buffer, size, base, filled);
@@ -673,8 +563,7 @@ void BufferAttach(Buffer buffer, Addr base, Addr limit,
* allocation request. This might be because the buffer has been
* trapped and "limit" has been set to zero. */
-Res BufferFill(Addr *pReturn, Buffer buffer, Size size,
- Bool withReservoirPermit)
+Res BufferFill(Addr *pReturn, Buffer buffer, Size size)
{
Res res;
Pool pool;
@@ -696,11 +585,6 @@ Res BufferFill(Addr *pReturn, Buffer buffer, Size size,
BufferSetUnflipped(buffer);
}
- /* */
- if (BufferIsTrappedByMutator(buffer)) {
- BufferFrameNotifyPopPending(buffer);
- }
-
/* .fill.logged: If the buffer is logged then we leave it logged. */
next = AddrAdd(buffer->ap_s.alloc, size);
if (next > (Addr)buffer->ap_s.alloc &&
@@ -721,9 +605,7 @@ Res BufferFill(Addr *pReturn, Buffer buffer, Size size,
BufferDetach(buffer, pool);
/* Ask the pool for some memory. */
- res = (*pool->class->bufferFill)(&base, &limit,
- pool, buffer, size,
- withReservoirPermit);
+ res = Method(Pool, pool, bufferFill)(&base, &limit, pool, buffer, size);
if (res != ResOK)
return res;
@@ -801,8 +683,6 @@ Bool BufferTrip(Buffer buffer, Addr p, Size size)
AVER(buffer->ap_s.limit == 0);
/* Of course we should be trapped. */
AVER(BufferIsTrapped(buffer));
- /* But the mutator shouldn't have caused the trap */
- AVER(!BufferIsTrappedByMutator(buffer));
/* The init and alloc fields should be equal at this point, because */
/* the step .commit.update has happened. */
@@ -846,7 +726,7 @@ Bool BufferTrip(Buffer buffer, Addr p, Size size)
b = PoolFormat(&format, buffer->pool);
if (b) {
- clientClass = format->class(p);
+ clientClass = format->klass(p);
} else {
clientClass = (Addr)0;
}
@@ -907,21 +787,21 @@ Addr BufferScanLimit(Buffer buffer)
Seg BufferSeg(Buffer buffer)
{
AVERT(Buffer, buffer);
- return buffer->class->seg(buffer);
+ return Method(Buffer, buffer, seg)(buffer);
}
RankSet BufferRankSet(Buffer buffer)
{
AVERT(Buffer, buffer);
- return buffer->class->rankSet(buffer);
+ return Method(Buffer, buffer, rankSet)(buffer);
}
void BufferSetRankSet(Buffer buffer, RankSet rankset)
{
AVERT(Buffer, buffer);
AVERT(RankSet, rankset);
- buffer->class->setRankSet(buffer, rankset);
+ Method(Buffer, buffer, setRankSet)(buffer, rankset);
}
@@ -937,7 +817,7 @@ void BufferReassignSeg(Buffer buffer, Seg seg)
AVER(BufferBase(buffer) >= SegBase(seg));
AVER(BufferLimit(buffer) <= SegLimit(seg));
AVER(BufferPool(buffer) == SegPool(seg));
- buffer->class->reassignSeg(buffer, seg);
+ Method(Buffer, buffer, reassignSeg)(buffer, seg);
}
@@ -949,21 +829,7 @@ void BufferReassignSeg(Buffer buffer, Seg seg)
Bool BufferIsTrapped(Buffer buffer)
{
/* Can't check buffer, see .check.use-trapped */
- return BufferIsTrappedByMutator(buffer)
- || ((buffer->mode & (BufferModeFLIPPED|BufferModeLOGGED)) != 0);
-}
-
-
-/* BufferIsTrappedByMutator
- *
- * Indicates whether the mutator trapped the buffer. See
- * and .ap.async. */
-
-Bool BufferIsTrappedByMutator(Buffer buffer)
-{
- AVER(!buffer->ap_s._lwpoppending || buffer->ap_s._enabled);
- /* Can't check buffer, see .check.use-trapped */
- return buffer->ap_s._lwpoppending;
+ return (buffer->mode & (BufferModeFLIPPED|BufferModeLOGGED)) != 0;
}
@@ -1012,7 +878,7 @@ void BufferRampBegin(Buffer buffer, AllocPattern pattern)
pool = BufferPool(buffer);
AVERT(Pool, pool);
- (*pool->class->rampBegin)(pool, buffer,
+ Method(Pool, pool, rampBegin)(pool, buffer,
pattern == &AllocPatternRampCollectAllStruct);
}
@@ -1031,7 +897,7 @@ Res BufferRampEnd(Buffer buffer)
pool = BufferPool(buffer);
AVERT(Pool, pool);
- (*pool->class->rampEnd)(pool, buffer);
+ Method(Pool, pool, rampEnd)(pool, buffer);
return ResOK;
}
@@ -1050,7 +916,7 @@ void BufferRampReset(Buffer buffer)
pool = BufferPool(buffer);
AVERT(Pool, pool);
do
- (*pool->class->rampEnd)(pool, buffer);
+ Method(Pool, pool, rampEnd)(pool, buffer);
while(--buffer->rampCount > 0);
}
@@ -1059,30 +925,6 @@ void BufferRampReset(Buffer buffer)
/* BufferClass -- support for the basic Buffer class */
-/* bufferTrivInit -- basic buffer init method */
-
-static Res bufferTrivInit(Buffer buffer, Pool pool, ArgList args)
-{
- /* initialization happens in BufferInit so checks are safe */
- AVERT(Buffer, buffer);
- AVERT(Pool, pool);
- UNUSED(args);
- EVENT3(BufferInit, buffer, pool, BOOLOF(buffer->isMutator));
- return ResOK;
-}
-
-
-/* bufferTrivFinish -- basic buffer finish method */
-
-static void bufferTrivFinish(Buffer buffer)
-{
- /* No special finish for simple buffers */
- AVERT(Buffer, buffer);
- AVER(BufferIsReset(buffer));
- NOOP;
-}
-
-
/* bufferTrivAttach -- basic buffer attach method */
static void bufferTrivAttach(Buffer buffer, Addr base, Addr limit,
@@ -1159,38 +1001,28 @@ static void bufferNoReassignSeg(Buffer buffer, Seg seg)
}
-/* bufferTrivDescribe -- basic Buffer describe method */
-
-static Res bufferTrivDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
-{
- if (!TESTT(Buffer, buffer))
- return ResFAIL;
- if (stream == NULL)
- return ResFAIL;
- UNUSED(depth);
- /* dispatching function does it all */
- return ResOK;
-}
-
-
/* BufferClassCheck -- check the consistency of a BufferClass */
-Bool BufferClassCheck(BufferClass class)
+Bool BufferClassCheck(BufferClass klass)
{
- CHECKD(ProtocolClass, &class->protocol);
- CHECKL(class->name != NULL); /* Should be <=6 char C identifier */
- CHECKL(class->size >= sizeof(BufferStruct));
- CHECKL(FUNCHECK(class->varargs));
- CHECKL(FUNCHECK(class->init));
- CHECKL(FUNCHECK(class->finish));
- CHECKL(FUNCHECK(class->attach));
- CHECKL(FUNCHECK(class->detach));
- CHECKL(FUNCHECK(class->seg));
- CHECKL(FUNCHECK(class->rankSet));
- CHECKL(FUNCHECK(class->setRankSet));
- CHECKL(FUNCHECK(class->reassignSeg));
- CHECKL(FUNCHECK(class->describe));
- CHECKS(BufferClass, class);
+ CHECKD(InstClass, &klass->instClassStruct);
+ CHECKL(klass->size >= sizeof(BufferStruct));
+ CHECKL(FUNCHECK(klass->varargs));
+ CHECKL(FUNCHECK(klass->init));
+ CHECKL(FUNCHECK(klass->attach));
+ CHECKL(FUNCHECK(klass->detach));
+ CHECKL(FUNCHECK(klass->seg));
+ CHECKL(FUNCHECK(klass->rankSet));
+ CHECKL(FUNCHECK(klass->setRankSet));
+ CHECKL(FUNCHECK(klass->reassignSeg));
+
+ /* Check that buffer classes override sets of related methods. */
+ CHECKL((klass->init == BufferAbsInit)
+ == (klass->instClassStruct.finish == BufferAbsFinish));
+ CHECKL((klass->attach == bufferTrivAttach)
+ == (klass->detach == bufferTrivDetach));
+
+ CHECKS(BufferClass, klass);
return TRUE;
}
@@ -1199,23 +1031,28 @@ Bool BufferClassCheck(BufferClass class)
*
* See . */
-DEFINE_CLASS(BufferClass, class)
+DEFINE_CLASS(Inst, BufferClass, klass)
{
- INHERIT_CLASS(&class->protocol, ProtocolClass);
- class->name = "BUFFER";
- class->size = sizeof(BufferStruct);
- class->varargs = ArgTrivVarargs;
- class->init = bufferTrivInit;
- class->finish = bufferTrivFinish;
- class->attach = bufferTrivAttach;
- class->detach = bufferTrivDetach;
- class->describe = bufferTrivDescribe;
- class->seg = bufferNoSeg;
- class->rankSet = bufferTrivRankSet;
- class->setRankSet = bufferNoSetRankSet;
- class->reassignSeg = bufferNoReassignSeg;
- class->sig = BufferClassSig;
- AVERT(BufferClass, class);
+ INHERIT_CLASS(klass, BufferClass, InstClass);
+ AVERT(InstClass, klass);
+}
+
+DEFINE_CLASS(Buffer, Buffer, klass)
+{
+ INHERIT_CLASS(&klass->instClassStruct, Buffer, Inst);
+ klass->instClassStruct.finish = BufferAbsFinish;
+ klass->instClassStruct.describe = BufferAbsDescribe;
+ klass->size = sizeof(BufferStruct);
+ klass->varargs = ArgTrivVarargs;
+ klass->init = BufferAbsInit;
+ klass->attach = bufferTrivAttach;
+ klass->detach = bufferTrivDetach;
+ klass->seg = bufferNoSeg;
+ klass->rankSet = bufferTrivRankSet;
+ klass->setRankSet = bufferNoSetRankSet;
+ klass->reassignSeg = bufferNoReassignSeg;
+ klass->sig = BufferClassSig;
+ AVERT(BufferClass, klass);
}
@@ -1223,19 +1060,13 @@ DEFINE_CLASS(BufferClass, class)
/* SegBufClass -- support for the SegBuf subclass */
-/* BufferSegBuf -- convert generic Buffer to a SegBuf */
-
-#define BufferSegBuf(buffer) ((SegBuf)(buffer))
-
-
/* SegBufCheck -- check consistency of a SegBuf */
Bool SegBufCheck(SegBuf segbuf)
{
Buffer buffer;
-
CHECKS(SegBuf, segbuf);
- buffer = &segbuf->bufferStruct;
+ buffer = MustBeA(Buffer, segbuf);
CHECKD(Buffer, buffer);
CHECKL(RankSetCheck(segbuf->rankSet));
@@ -1262,27 +1093,24 @@ Bool SegBufCheck(SegBuf segbuf)
/* segBufInit -- SegBuf init method */
-static Res segBufInit(Buffer buffer, Pool pool, ArgList args)
+static Res segBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args)
{
- BufferClass super;
SegBuf segbuf;
Res res;
- AVERT(Buffer, buffer);
- AVERT(Pool, pool);
- segbuf = BufferSegBuf(buffer);
-
/* Initialize the superclass fields first via next-method call */
- super = BUFFER_SUPERCLASS(SegBufClass);
- res = super->init(buffer, pool, args);
+ res = NextMethod(Buffer, SegBuf, init)(buffer, pool, isMutator, args);
if (res != ResOK)
return res;
+ segbuf = CouldBeA(SegBuf, buffer);
segbuf->seg = NULL;
- segbuf->sig = SegBufSig;
segbuf->rankSet = RankSetEMPTY;
-
- AVERT(SegBuf, segbuf);
+
+ SetClassOfPoly(buffer, CLASS(SegBuf));
+ segbuf->sig = SegBufSig;
+ AVERC(SegBuf, segbuf);
+
EVENT3(BufferInitSeg, buffer, pool, BOOLOF(buffer->isMutator));
return ResOK;
}
@@ -1290,21 +1118,13 @@ static Res segBufInit(Buffer buffer, Pool pool, ArgList args)
/* segBufFinish -- SegBuf finish method */
-static void segBufFinish (Buffer buffer)
+static void segBufFinish(Inst inst)
{
- BufferClass super;
- SegBuf segbuf;
-
- AVERT(Buffer, buffer);
+ Buffer buffer = MustBeA(Buffer, inst);
+ SegBuf segbuf = MustBeA(SegBuf, buffer);
AVER(BufferIsReset(buffer));
- segbuf = BufferSegBuf(buffer);
- AVERT(SegBuf, segbuf);
-
segbuf->sig = SigInvalid;
-
- /* finish the superclass fields last */
- super = BUFFER_SUPERCLASS(SegBufClass);
- super->finish(buffer);
+ NextMethod(Inst, SegBuf, finish)(inst);
}
@@ -1313,22 +1133,20 @@ static void segBufFinish (Buffer buffer)
static void segBufAttach(Buffer buffer, Addr base, Addr limit,
Addr init, Size size)
{
- SegBuf segbuf;
+ SegBuf segbuf = MustBeA(SegBuf, buffer);
Seg seg = NULL; /* suppress "may be used uninitialized" */
Arena arena;
Bool found;
- AVERT(Buffer, buffer);
/* Other parameters are consistency checked in BufferAttach */
UNUSED(init);
UNUSED(size);
- segbuf = BufferSegBuf(buffer);
arena = BufferArena(buffer);
found = SegOfAddr(&seg, arena, base);
AVER(found);
AVER(segbuf->seg == NULL);
- AVER(SegBuffer(seg) == NULL);
+ AVER(!SegHasBuffer(seg));
AVER(SegBase(seg) <= base);
AVER(limit <= SegLimit(seg));
@@ -1344,56 +1162,37 @@ static void segBufAttach(Buffer buffer, Addr base, Addr limit,
static void segBufDetach(Buffer buffer)
{
- SegBuf segbuf;
- Seg seg;
-
- AVERT(Buffer, buffer);
- segbuf = BufferSegBuf(buffer);
- AVERT(SegBuf, segbuf);
-
- seg = segbuf->seg;
- AVER(seg != NULL);
- SegSetBuffer(seg, NULL);
+ SegBuf segbuf = MustBeA(SegBuf, buffer);
+ Seg seg = segbuf->seg;
+ SegUnsetBuffer(seg);
segbuf->seg = NULL;
}
/* segBufSeg -- BufferSeg accessor method for SegBuf instances */
-static Seg segBufSeg (Buffer buffer)
+static Seg segBufSeg(Buffer buffer)
{
- SegBuf segbuf;
-
- AVERT(Buffer, buffer);
- segbuf = BufferSegBuf(buffer);
- AVERT(SegBuf, segbuf);
+ SegBuf segbuf = MustBeA(SegBuf, buffer);
return segbuf->seg;
}
/* segBufRankSet -- BufferRankSet accessor for SegBuf instances */
-static RankSet segBufRankSet (Buffer buffer)
+static RankSet segBufRankSet(Buffer buffer)
{
- SegBuf segbuf;
-
- AVERT(Buffer, buffer);
- segbuf = BufferSegBuf(buffer);
- AVERT(SegBuf, segbuf);
+ SegBuf segbuf = MustBeA(SegBuf, buffer);
return segbuf->rankSet;
}
/* segBufSetRankSet -- BufferSetRankSet setter method for SegBuf */
-static void segBufSetRankSet (Buffer buffer, RankSet rankset)
+static void segBufSetRankSet(Buffer buffer, RankSet rankset)
{
- SegBuf segbuf;
-
- AVERT(Buffer, buffer);
+ SegBuf segbuf = MustBeA(SegBuf, buffer);
AVERT(RankSet, rankset);
- segbuf = BufferSegBuf(buffer);
- AVERT(SegBuf, segbuf);
segbuf->rankSet = rankset;
}
@@ -1405,13 +1204,10 @@ static void segBufSetRankSet (Buffer buffer, RankSet rankset)
* .invseg: On entry the buffer is attached to an invalid segment, which
* can't be checked. The method is called to make the attachment valid. */
-static void segBufReassignSeg (Buffer buffer, Seg seg)
+static void segBufReassignSeg(Buffer buffer, Seg seg)
{
- SegBuf segbuf;
-
- AVERT(Buffer, buffer);
+ SegBuf segbuf = CouldBeA(SegBuf, buffer);
AVERT(Seg, seg);
- segbuf = BufferSegBuf(buffer);
/* Can't check segbuf on entry. See .invseg */
AVER(NULL != segbuf->seg);
AVER(seg != segbuf->seg);
@@ -1422,32 +1218,25 @@ static void segBufReassignSeg (Buffer buffer, Seg seg)
/* segBufDescribe -- describe method for SegBuf */
-static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
+static Res segBufDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
{
- SegBuf segbuf;
- BufferClass super;
+ Buffer buffer = CouldBeA(Buffer, inst);
+ SegBuf segbuf = CouldBeA(SegBuf, buffer);
Res res;
- if (!TESTT(Buffer, buffer))
- return ResFAIL;
+ if (!TESTC(SegBuf, segbuf))
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
- segbuf = BufferSegBuf(buffer);
- if (!TESTT(SegBuf, segbuf))
- return ResFAIL;
+ return ResPARAM;
- /* Describe the superclass fields first via next-method call */
- super = BUFFER_SUPERCLASS(SegBufClass);
- res = super->describe(buffer, stream, depth);
+ res = NextMethod(Inst, SegBuf, describe)(inst, stream, depth);
if (res != ResOK)
return res;
- res = WriteF(stream, depth,
- "Seg $P\n", (WriteFP)segbuf->seg,
- "rankSet $U\n", (WriteFU)segbuf->rankSet,
- NULL);
-
- return res;
+ return WriteF(stream, depth + 2,
+ "Seg $P\n", (WriteFP)segbuf->seg,
+ "rankSet $U\n", (WriteFU)segbuf->rankSet,
+ NULL);
}
@@ -1456,23 +1245,20 @@ static Res segBufDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth)
* Supports an association with a single segment when attached. See
* . */
-typedef BufferClassStruct SegBufClassStruct;
-
-DEFINE_CLASS(SegBufClass, class)
+DEFINE_CLASS(Buffer, SegBuf, klass)
{
- INHERIT_CLASS(class, BufferClass);
- class->name = "SEGBUF";
- class->size = sizeof(SegBufStruct);
- class->init = segBufInit;
- class->finish = segBufFinish;
- class->attach = segBufAttach;
- class->detach = segBufDetach;
- class->describe = segBufDescribe;
- class->seg = segBufSeg;
- class->rankSet = segBufRankSet;
- class->setRankSet = segBufSetRankSet;
- class->reassignSeg = segBufReassignSeg;
- AVERT(BufferClass, class);
+ INHERIT_CLASS(klass, SegBuf, Buffer);
+ klass->instClassStruct.finish = segBufFinish;
+ klass->instClassStruct.describe = segBufDescribe;
+ klass->size = sizeof(SegBufStruct);
+ klass->init = segBufInit;
+ klass->attach = segBufAttach;
+ klass->detach = segBufDetach;
+ klass->seg = segBufSeg;
+ klass->rankSet = segBufRankSet;
+ klass->setRankSet = segBufSetRankSet;
+ klass->reassignSeg = segBufReassignSeg;
+ AVERT(BufferClass, klass);
}
@@ -1491,30 +1277,29 @@ static void rankBufVarargs(ArgStruct args[MPS_ARGS_MAX], va_list varargs)
/* rankBufInit -- RankBufClass init method */
-static Res rankBufInit(Buffer buffer, Pool pool, ArgList args)
+static Res rankBufInit(Buffer buffer, Pool pool, Bool isMutator, ArgList args)
{
Rank rank = BUFFER_RANK_DEFAULT;
- BufferClass super;
Res res;
ArgStruct arg;
- AVERT(Buffer, buffer);
- AVERT(Pool, pool);
AVERT(ArgList, args);
if (ArgPick(&arg, args, MPS_KEY_RANK))
rank = arg.val.rank;
AVERT(Rank, rank);
/* Initialize the superclass fields first via next-method call */
- super = BUFFER_SUPERCLASS(RankBufClass);
- res = super->init(buffer, pool, args);
+ res = NextMethod(Buffer, RankBuf, init)(buffer, pool, isMutator, args);
if (res != ResOK)
return res;
BufferSetRankSet(buffer, RankSetSingle(rank));
- /* There's nothing to check that the superclass doesn't, so no AVERT. */
+ SetClassOfPoly(buffer, CLASS(RankBuf));
+ AVERC(RankBuf, buffer);
+
EVENT4(BufferInitRank, buffer, pool, BOOLOF(buffer->isMutator), rank);
+
return ResOK;
}
@@ -1525,21 +1310,18 @@ static Res rankBufInit(Buffer buffer, Pool pool, ArgList args)
*
* Supports initialization to a rank supplied at creation time. */
-typedef BufferClassStruct RankBufClassStruct;
-
-DEFINE_CLASS(RankBufClass, class)
+DEFINE_CLASS(Buffer, RankBuf, klass)
{
- INHERIT_CLASS(class, SegBufClass);
- class->name = "RANKBUF";
- class->varargs = rankBufVarargs;
- class->init = rankBufInit;
- AVERT(BufferClass, class);
+ INHERIT_CLASS(klass, RankBuf, SegBuf);
+ klass->varargs = rankBufVarargs;
+ klass->init = rankBufInit;
+ AVERT(BufferClass, klass);
}
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/cbs.c b/mps/code/cbs.c
index 0b30b68acb1..05d169406a0 100644
--- a/mps/code/cbs.c
+++ b/mps/code/cbs.c
@@ -1,18 +1,25 @@
/* cbs.c: COALESCING BLOCK STRUCTURE IMPLEMENTATION
*
* $Id$
- * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*
* .intro: This is a portable implementation of coalescing block
* structures.
*
- * .purpose: CBSs are used to manage potentially unbounded
- * collections of memory blocks.
+ * .purpose: CBSs are used to manage potentially unbounded collections
+ * of memory blocks.
*
* .sources: .
+ *
+ * .critical: In manual-allocation-bound programs using MVFF, many of
+ * these functions are on the critical paths via mps_alloc (and then
+ * PoolAlloc, MVFFAlloc, failoverFind*, cbsFind*) and mps_free (and
+ * then MVFFFree, failoverInsert, cbsInsert).
*/
#include "cbs.h"
+#include "rangetree.h"
+#include "range.h"
#include "splay.h"
#include "meter.h"
#include "poolmfs.h"
@@ -21,30 +28,16 @@
SRCID(cbs, "$Id$");
-#define CBSBlockBase(block) ((block)->base)
-#define CBSBlockLimit(block) ((block)->limit)
-#define CBSBlockSize(block) AddrOffset((block)->base, (block)->limit)
-
-
-#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 cbsOfSplay(splay) PARENT(CBSStruct, splayTreeStruct, splay)
+#define cbsFastBlockOfTree(tree) \
+ PARENT(CBSFastBlockStruct, rangeTreeStruct, RangeTreeOfTree(tree))
+#define cbsFastBlockNode(block) (&(block)->rangeTreeStruct)
+#define cbsZonedBlockOfTree(tree) \
+ PARENT(CBSZonedBlockStruct, cbsFastBlockStruct, cbsFastBlockOfTree(tree))
+#define cbsZonedBlockNode(block) cbsFastBlockNode(&(block)->cbsFastBlockStruct)
#define cbsBlockPool(cbs) RVALUE((cbs)->blockPool)
-/* We pass the block base directly as a TreeKey (void *) assuming that
- Addr can be encoded, and possibly breaking .
- On an exotic platform where this isn't true, pass the address of base.
- i.e. add an & */
-#define cbsBlockKey(block) ((TreeKey)(block)->base)
-#define keyOfBaseVar(baseVar) ((TreeKey)(baseVar))
-#define baseOfKey(key) ((Addr)(key))
-
/* CBSCheck -- Check CBS */
@@ -60,93 +53,45 @@ Bool CBSCheck(CBS cbs)
CHECKL(cbs->blockStructSize > 0);
CHECKL(BoolCheck(cbs->ownPool));
CHECKL(SizeIsAligned(cbs->size, LandAlignment(land)));
- STATISTIC_STAT({CHECKL((cbs->size == 0) == (cbs->treeSize == 0));});
+ STATISTIC(CHECKL((cbs->size == 0) == (cbs->treeSize == 0)));
return TRUE;
}
-ATTRIBUTE_UNUSED
-static Bool CBSBlockCheck(CBSBlock block)
-{
- UNUSED(block); /* Required because there is no signature */
- CHECKL(block != NULL);
- /* Can't use CHECKD_NOSIG because TreeEMPTY is NULL. */
- CHECKL(TreeCheck(cbsBlockTree(block)));
-
- /* If the block is in the middle of being deleted, */
- /* the pointers will be equal. */
- CHECKL(CBSBlockBase(block) <= CBSBlockLimit(block));
- /* Can't check maxSize because it may be invalid at the time */
- return TRUE;
-}
-
-
-/* cbsCompare -- Compare key to [base,limit)
- *
- * See
- */
-
-static Compare cbsCompare(Tree tree, TreeKey key)
-{
- Addr base1, base2, limit2;
- CBSBlock cbsBlock;
-
- AVERT_CRITICAL(Tree, tree);
- AVER_CRITICAL(tree != TreeEMPTY);
- AVER_CRITICAL(key != NULL);
-
- base1 = baseOfKey(key);
- cbsBlock = cbsBlockOfTree(tree);
- base2 = cbsBlock->base;
- limit2 = cbsBlock->limit;
-
- if (base1 < base2)
- return CompareLESS;
- else if (base1 >= limit2)
- return CompareGREATER;
- else
- return CompareEQUAL;
-}
-
-static TreeKey cbsKey(Tree tree)
-{
- return cbsBlockKey(cbsBlockOfTree(tree));
-}
-
-
/* cbsTestNode, cbsTestTree -- test for nodes larger than the S parameter */
-static Bool cbsTestNode(SplayTree splay, Tree tree,
- void *closureP, Size size)
+static Bool cbsTestNode(SplayTree splay, Tree tree, void *closure)
{
- CBSBlock block;
+ RangeTree block;
+ Size *sizeP = closure;
- AVERT(SplayTree, splay);
- AVERT(Tree, tree);
- AVER(closureP == NULL);
- AVER(size > 0);
- AVER(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass));
+ AVERT_CRITICAL(SplayTree, splay);
+ AVERT_CRITICAL(Tree, tree);
+ AVER_CRITICAL(sizeP != NULL);
+ AVER_CRITICAL(*sizeP > 0);
+ AVER_CRITICAL(IsA(CBSFast, cbsOfSplay(splay)));
- block = cbsBlockOfTree(tree);
+ block = RangeTreeOfTree(tree);
- return CBSBlockSize(block) >= size;
+ return RangeTreeSize(block) >= *sizeP;
}
static Bool cbsTestTree(SplayTree splay, Tree tree,
- void *closureP, Size size)
+ void *closure)
{
CBSFastBlock block;
+ Size *sizeP = closure;
- AVERT(SplayTree, splay);
- AVERT(Tree, tree);
- AVER(closureP == NULL);
- AVER(size > 0);
- AVER(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass));
+ AVERT_CRITICAL(SplayTree, splay);
+ AVERT_CRITICAL(Tree, tree);
+ AVER_CRITICAL(sizeP != NULL);
+ AVER_CRITICAL(*sizeP > 0);
+ AVER_CRITICAL(IsA(CBSFast, cbsOfSplay(splay)));
block = cbsFastBlockOfTree(tree);
- return block->maxSize >= size;
+ return block->maxSize >= *sizeP;
}
@@ -158,9 +103,9 @@ static void cbsUpdateFastNode(SplayTree splay, Tree tree)
AVERT_CRITICAL(SplayTree, splay);
AVERT_CRITICAL(Tree, tree);
- AVER_CRITICAL(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSFastLandClass));
+ AVER_CRITICAL(IsA(CBSFast, cbsOfSplay(splay)));
- maxSize = CBSBlockSize(cbsBlockOfTree(tree));
+ maxSize = RangeTreeSize(RangeTreeOfTree(tree));
if (TreeHasLeft(tree)) {
Size size = cbsFastBlockOfTree(TreeLeft(tree))->maxSize;
@@ -184,19 +129,19 @@ static void cbsUpdateZonedNode(SplayTree splay, Tree tree)
{
ZoneSet zones;
CBSZonedBlock zonedBlock;
- CBSBlock block;
+ RangeTree block;
Arena arena;
AVERT_CRITICAL(SplayTree, splay);
AVERT_CRITICAL(Tree, tree);
- AVER_CRITICAL(IsLandSubclass(CBSLand(cbsOfSplay(splay)), CBSZonedLandClass));
+ AVER_CRITICAL(IsA(CBSZoned, cbsOfSplay(splay)));
cbsUpdateFastNode(splay, tree);
zonedBlock = cbsZonedBlockOfTree(tree);
- block = &zonedBlock->cbsFastBlockStruct.cbsBlockStruct;
+ block = cbsZonedBlockNode(zonedBlock);
arena = LandArena(CBSLand(cbsOfSplay(splay)));
- zones = ZoneSetOfRange(arena, CBSBlockBase(block), CBSBlockLimit(block));
+ zones = ZoneSetOfRange(arena, RangeTreeBase(block), RangeTreeLimit(block));
if (TreeHasLeft(tree))
zones = ZoneSetUnion(zones, cbsZonedBlockOfTree(TreeLeft(tree))->zones);
@@ -215,26 +160,26 @@ static void cbsUpdateZonedNode(SplayTree splay, Tree tree)
ARG_DEFINE_KEY(cbs_block_pool, Pool);
-static Res cbsInitComm(Land land, ArgList args, SplayUpdateNodeFunction update,
+static Res cbsInitComm(Land land, LandClass klass,
+ Arena arena, Align alignment,
+ ArgList args, SplayUpdateNodeFunction update,
Size blockStructSize)
{
CBS cbs;
- LandClass super;
ArgStruct arg;
Res res;
Pool blockPool = NULL;
- AVERT(Land, land);
- super = LAND_SUPERCLASS(CBSLandClass);
- res = (*super->init)(land, args);
+ AVER(land != NULL);
+ res = NextMethod(Land, CBS, init)(land, arena, alignment, args);
if (res != ResOK)
return res;
+ cbs = CouldBeA(CBS, land);
if (ArgPick(&arg, args, CBSBlockPool))
blockPool = arg.val.pool;
- cbs = cbsOfLand(land);
- SplayTreeInit(cbsSplay(cbs), cbsCompare, cbsKey, update);
+ SplayTreeInit(cbsSplay(cbs), RangeTreeCompare, RangeTreeKey, update);
if (blockPool != NULL) {
cbs->blockPool = blockPool;
@@ -248,34 +193,38 @@ static Res cbsInitComm(Land land, ArgList args, SplayUpdateNodeFunction update,
return res;
cbs->ownPool = TRUE;
}
- cbs->treeSize = 0;
+ STATISTIC(cbs->treeSize = 0);
cbs->size = 0;
cbs->blockStructSize = blockStructSize;
METER_INIT(cbs->treeSearch, "size of tree", (void *)cbs);
+ SetClassOfPoly(land, klass);
cbs->sig = CBSSig;
+ AVERC(CBS, cbs);
- AVERT(CBS, cbs);
return ResOK;
}
-static Res cbsInit(Land land, ArgList args)
+static Res cbsInit(Land land, Arena arena, Align alignment, ArgList args)
{
- return cbsInitComm(land, args, SplayTrivUpdate,
- sizeof(CBSBlockStruct));
+ return cbsInitComm(land, CLASS(CBS), arena, alignment,
+ args, SplayTrivUpdate,
+ sizeof(RangeTreeStruct));
}
-static Res cbsInitFast(Land land, ArgList args)
+static Res cbsInitFast(Land land, Arena arena, Align alignment, ArgList args)
{
- return cbsInitComm(land, args, cbsUpdateFastNode,
+ return cbsInitComm(land, CLASS(CBSFast), arena, alignment,
+ args, cbsUpdateFastNode,
sizeof(CBSFastBlockStruct));
}
-static Res cbsInitZoned(Land land, ArgList args)
+static Res cbsInitZoned(Land land, Arena arena, Align alignment, ArgList args)
{
- return cbsInitComm(land, args, cbsUpdateZonedNode,
+ return cbsInitComm(land, CLASS(CBSZoned), arena, alignment,
+ args, cbsUpdateZonedNode,
sizeof(CBSZonedBlockStruct));
}
@@ -285,13 +234,10 @@ static Res cbsInitZoned(Land land, ArgList args)
* See .
*/
-static void cbsFinish(Land land)
+static void cbsFinish(Inst inst)
{
- CBS cbs;
-
- AVERT(Land, land);
- cbs = cbsOfLand(land);
- AVERT(CBS, cbs);
+ Land land = MustBeA(Land, inst);
+ CBS cbs = MustBeA(CBS, land);
METER_EMIT(&cbs->treeSearch);
@@ -300,6 +246,8 @@ static void cbsFinish(Land land)
SplayTreeFinish(cbsSplay(cbs));
if (cbs->ownPool)
PoolDestroy(cbsBlockPool(cbs));
+
+ NextMethod(Inst, CBS, finish)(inst);
}
@@ -310,110 +258,101 @@ static void cbsFinish(Land land)
static Size cbsSize(Land land)
{
- CBS cbs;
-
- AVERT(Land, land);
- cbs = cbsOfLand(land);
- AVERT(CBS, cbs);
-
+ CBS cbs = MustBeA_CRITICAL(CBS, land);
return cbs->size;
}
/* cbsBlockDestroy -- destroy a block */
-static void cbsBlockDestroy(CBS cbs, CBSBlock block)
+static void cbsBlockDestroy(CBS cbs, RangeTree block)
{
Size size;
AVERT(CBS, cbs);
- AVERT(CBSBlock, block);
- size = CBSBlockSize(block);
+ AVERT(RangeTree, block);
+ size = RangeTreeSize(block);
STATISTIC(--cbs->treeSize);
AVER(cbs->size >= size);
cbs->size -= size;
- /* make invalid */
- block->limit = block->base;
+ RangeTreeFinish(block);
PoolFree(cbsBlockPool(cbs), (Addr)block, cbs->blockStructSize);
}
-/* Node change operators
+/* RangeTree change operators
*
* These four functions are called whenever blocks are created,
* destroyed, grow, or shrink. They maintain the maxSize if fastFind is
* enabled.
*/
-static void cbsBlockDelete(CBS cbs, CBSBlock block)
+static void cbsBlockDelete(CBS cbs, RangeTree block)
{
Bool b;
AVERT(CBS, cbs);
- AVERT(CBSBlock, block);
+ AVERT(RangeTree, block);
METER_ACC(cbs->treeSearch, cbs->treeSize);
- b = SplayTreeDelete(cbsSplay(cbs), cbsBlockTree(block));
+ b = SplayTreeDelete(cbsSplay(cbs), RangeTreeTree(block));
AVER(b); /* expect block to be in the tree */
cbsBlockDestroy(cbs, block);
}
-static void cbsBlockShrunk(CBS cbs, CBSBlock block, Size oldSize)
+static void cbsBlockShrunk(CBS cbs, RangeTree block, Size oldSize)
{
Size newSize;
AVERT(CBS, cbs);
- AVERT(CBSBlock, block);
+ AVERT(RangeTree, block);
- newSize = CBSBlockSize(block);
+ newSize = RangeTreeSize(block);
AVER(oldSize > newSize);
AVER(cbs->size >= oldSize - newSize);
- SplayNodeRefresh(cbsSplay(cbs), cbsBlockTree(block));
+ SplayNodeRefresh(cbsSplay(cbs), RangeTreeTree(block));
cbs->size -= oldSize - newSize;
}
-static void cbsBlockGrew(CBS cbs, CBSBlock block, Size oldSize)
+static void cbsBlockGrew(CBS cbs, RangeTree block, Size oldSize)
{
Size newSize;
AVERT(CBS, cbs);
- AVERT(CBSBlock, block);
+ AVERT(RangeTree, block);
- newSize = CBSBlockSize(block);
+ newSize = RangeTreeSize(block);
AVER(oldSize < newSize);
- SplayNodeRefresh(cbsSplay(cbs), cbsBlockTree(block));
+ SplayNodeRefresh(cbsSplay(cbs), RangeTreeTree(block));
cbs->size += newSize - oldSize;
}
/* cbsBlockAlloc -- allocate a new block and set its base and limit,
but do not insert it into the tree yet */
-static Res cbsBlockAlloc(CBSBlock *blockReturn, CBS cbs, Range range)
+static Res cbsBlockAlloc(RangeTree *blockReturn, CBS cbs, Range range)
{
Res res;
- CBSBlock block;
+ RangeTree block;
Addr p;
AVER(blockReturn != NULL);
AVERT(CBS, cbs);
AVERT(Range, range);
- res = PoolAlloc(&p, cbsBlockPool(cbs), cbs->blockStructSize,
- /* withReservoirPermit */ FALSE);
+ res = PoolAlloc(&p, cbsBlockPool(cbs), cbs->blockStructSize);
if (res != ResOK)
goto failPoolAlloc;
- block = (CBSBlock)p;
+ block = (RangeTree)p;
- TreeInit(cbsBlockTree(block));
- block->base = RangeBase(range);
- block->limit = RangeLimit(range);
+ RangeTreeInitFromRange(block, range);
- SplayNodeInit(cbsSplay(cbs), cbsBlockTree(block));
+ SplayNodeInit(cbsSplay(cbs), RangeTreeTree(block));
- AVERT(CBSBlock, block);
+ AVERT(RangeTree, block);
*blockReturn = block;
return ResOK;
@@ -424,18 +363,18 @@ static Res cbsBlockAlloc(CBSBlock *blockReturn, CBS cbs, Range range)
/* cbsBlockInsert -- insert a block into the tree */
-static void cbsBlockInsert(CBS cbs, CBSBlock block)
+static void cbsBlockInsert(CBS cbs, RangeTree block)
{
Bool b;
- AVERT(CBS, cbs);
- AVERT(CBSBlock, block);
+ AVERT_CRITICAL(CBS, cbs);
+ AVERT_CRITICAL(RangeTree, block);
METER_ACC(cbs->treeSearch, cbs->treeSize);
- b = SplayTreeInsert(cbsSplay(cbs), cbsBlockTree(block));
- AVER(b);
+ b = SplayTreeInsert(cbsSplay(cbs), RangeTreeTree(block));
+ AVER_CRITICAL(b);
STATISTIC(++cbs->treeSize);
- cbs->size += CBSBlockSize(block);
+ cbs->size += RangeTreeSize(block);
}
@@ -449,97 +388,98 @@ static void cbsBlockInsert(CBS cbs, CBSBlock block)
static Res cbsInsert(Range rangeReturn, Land land, Range range)
{
- CBS cbs;
+ CBS cbs = MustBeA_CRITICAL(CBS, land);
Bool b;
Res res;
Addr base, limit, newBase, newLimit;
Tree leftSplay, rightSplay;
- CBSBlock leftCBS, rightCBS;
+ RangeTree leftBlock, rightBlock;
Bool leftMerge, rightMerge;
Size oldSize;
- AVER(rangeReturn != NULL);
- AVERT(Land, land);
- AVERT(Range, range);
- AVER(RangeIsAligned(range, LandAlignment(land)));
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVERT_CRITICAL(Range, range);
+ AVER_CRITICAL(RangeIsAligned(range, LandAlignment(land)));
- cbs = cbsOfLand(land);
base = RangeBase(range);
limit = RangeLimit(range);
METER_ACC(cbs->treeSearch, cbs->treeSize);
- b = SplayTreeNeighbours(&leftSplay, &rightSplay, cbsSplay(cbs), keyOfBaseVar(base));
+ b = SplayTreeNeighbours(&leftSplay, &rightSplay, cbsSplay(cbs),
+ RangeTreeKeyOfBaseVar(base));
if (!b) {
res = ResFAIL;
goto fail;
}
- /* The two cases below are not quite symmetrical, because base was
- * passed into the call to SplayTreeNeighbours(), but limit was not.
- * So we know that if there is a left neighbour, then leftCBS->limit
- * <= base (this is ensured by cbsCompare, which is the
- * comparison method on the tree). But if there is a right
- * neighbour, all we know is that base < rightCBS->base. But for the
- * range to fit, we need limit <= rightCBS->base too. Hence the extra
- * check and the possibility of failure in the second case.
- */
+ /* .insert.overlap: The two cases below are not quite symmetrical,
+ because base was passed into the call to SplayTreeNeighbours, but
+ limit was not. So we know that if there is a left neighbour, then
+ leftBlock's limit <= base (this is ensured by RangeTreeCompare,
+ which is the comparison method on the tree). But if there is a
+ right neighbour, all we know is that base < rightBlock's base. But
+ for the range to fit, we need limit <= rightBlock's base too. Hence
+ the extra check and the possibility of failure in the second
+ case. */
+
if (leftSplay == TreeEMPTY) {
- leftCBS = NULL;
+ leftBlock = NULL;
leftMerge = FALSE;
} else {
- leftCBS = cbsBlockOfTree(leftSplay);
- AVER(leftCBS->limit <= base);
- leftMerge = leftCBS->limit == base;
+ leftBlock = RangeTreeOfTree(leftSplay);
+ AVER_CRITICAL(RangeTreeLimit(leftBlock) <= base);
+ leftMerge = RangeTreeLimit(leftBlock) == base;
}
if (rightSplay == TreeEMPTY) {
- rightCBS = NULL;
+ rightBlock = NULL;
rightMerge = FALSE;
} else {
- rightCBS = cbsBlockOfTree(rightSplay);
- if (rightCBS != NULL && limit > CBSBlockLimit(rightCBS)) {
+ rightBlock = RangeTreeOfTree(rightSplay);
+ if (rightBlock != NULL && limit > RangeTreeBase(rightBlock)) {
+ /* .insert.overlap */
res = ResFAIL;
goto fail;
}
- rightMerge = rightCBS->base == limit;
+ rightMerge = RangeTreeBase(rightBlock) == limit;
}
- newBase = leftMerge ? CBSBlockBase(leftCBS) : base;
- newLimit = rightMerge ? CBSBlockLimit(rightCBS) : limit;
+ newBase = leftMerge ? RangeTreeBase(leftBlock) : base;
+ newLimit = rightMerge ? RangeTreeLimit(rightBlock) : limit;
if (leftMerge && rightMerge) {
- Size oldLeftSize = CBSBlockSize(leftCBS);
- Addr rightLimit = CBSBlockLimit(rightCBS);
- cbsBlockDelete(cbs, rightCBS);
- leftCBS->limit = rightLimit;
- cbsBlockGrew(cbs, leftCBS, oldLeftSize);
+ Size oldLeftSize = RangeTreeSize(leftBlock);
+ Addr rightLimit = RangeTreeLimit(rightBlock);
+ cbsBlockDelete(cbs, rightBlock);
+ RangeTreeSetLimit(leftBlock, rightLimit);
+ cbsBlockGrew(cbs, leftBlock, oldLeftSize);
} else if (leftMerge) {
- oldSize = CBSBlockSize(leftCBS);
- leftCBS->limit = limit;
- cbsBlockGrew(cbs, leftCBS, oldSize);
+ oldSize = RangeTreeSize(leftBlock);
+ RangeTreeSetLimit(leftBlock, limit);
+ cbsBlockGrew(cbs, leftBlock, oldSize);
} else if (rightMerge) {
- oldSize = CBSBlockSize(rightCBS);
- rightCBS->base = base;
- cbsBlockGrew(cbs, rightCBS, oldSize);
+ oldSize = RangeTreeSize(rightBlock);
+ RangeTreeSetBase(rightBlock, base);
+ cbsBlockGrew(cbs, rightBlock, oldSize);
} else {
- CBSBlock block;
+ RangeTree block;
res = cbsBlockAlloc(&block, cbs, range);
if (res != ResOK)
goto fail;
cbsBlockInsert(cbs, block);
}
- AVER(newBase <= base);
- AVER(newLimit >= limit);
+ AVER_CRITICAL(newBase <= base);
+ AVER_CRITICAL(newLimit >= limit);
RangeInit(rangeReturn, newBase, newLimit);
return ResOK;
fail:
- AVER(res != ResOK);
+ AVER_CRITICAL(res != ResOK);
return res;
}
@@ -554,15 +494,13 @@ static Res cbsInsert(Range rangeReturn, Land land, Range range)
static Res cbsDelete(Range rangeReturn, Land land, Range range)
{
- CBS cbs;
+ CBS cbs = MustBeA(CBS, land);
Res res;
- CBSBlock cbsBlock;
+ RangeTree block;
Tree tree;
Addr base, limit, oldBase, oldLimit;
Size oldSize;
- AVERT(Land, land);
- cbs = cbsOfLand(land);
AVER(rangeReturn != NULL);
AVERT(Range, range);
AVER(RangeIsAligned(range, LandAlignment(land)));
@@ -571,43 +509,43 @@ static Res cbsDelete(Range rangeReturn, Land land, Range range)
limit = RangeLimit(range);
METER_ACC(cbs->treeSearch, cbs->treeSize);
- if (!SplayTreeFind(&tree, cbsSplay(cbs), keyOfBaseVar(base))) {
+ if (!SplayTreeFind(&tree, cbsSplay(cbs), RangeTreeKeyOfBaseVar(base))) {
res = ResFAIL;
goto failSplayTreeSearch;
}
- cbsBlock = cbsBlockOfTree(tree);
+ block = RangeTreeOfTree(tree);
- if (limit > cbsBlock->limit) {
+ if (limit > RangeTreeLimit(block)) {
res = ResFAIL;
goto failLimitCheck;
}
- oldBase = cbsBlock->base;
- oldLimit = cbsBlock->limit;
- oldSize = CBSBlockSize(cbsBlock);
+ oldBase = RangeTreeBase(block);
+ oldLimit = RangeTreeLimit(block);
+ oldSize = RangeTreeSize(block);
RangeInit(rangeReturn, oldBase, oldLimit);
if (base == oldBase && limit == oldLimit) {
/* entire block */
- cbsBlockDelete(cbs, cbsBlock);
+ cbsBlockDelete(cbs, block);
} else if (base == oldBase) {
/* remaining fragment at right */
AVER(limit < oldLimit);
- cbsBlock->base = limit;
- cbsBlockShrunk(cbs, cbsBlock, oldSize);
+ RangeTreeSetBase(block, limit);
+ cbsBlockShrunk(cbs, block, oldSize);
} else if (limit == oldLimit) {
/* remaining fragment at left */
AVER(base > oldBase);
- cbsBlock->limit = base;
- cbsBlockShrunk(cbs, cbsBlock, oldSize);
+ RangeTreeSetLimit(block, base);
+ cbsBlockShrunk(cbs, block, oldSize);
} else {
/* two remaining fragments. shrink block to represent fragment at
left, and create new block for fragment at right. */
RangeStruct newRange;
- CBSBlock newBlock;
+ RangeTree newBlock;
AVER(base > oldBase);
AVER(limit < oldLimit);
RangeInit(&newRange, limit, oldLimit);
@@ -615,8 +553,8 @@ static Res cbsDelete(Range rangeReturn, Land land, Range range)
if (res != ResOK) {
goto failAlloc;
}
- cbsBlock->limit = base;
- cbsBlockShrunk(cbs, cbsBlock, oldSize);
+ RangeTreeSetLimit(block, base);
+ cbsBlockShrunk(cbs, block, oldSize);
cbsBlockInsert(cbs, newBlock);
}
@@ -630,7 +568,7 @@ static Res cbsDelete(Range rangeReturn, Land land, Range range)
}
-static Res cbsBlockDescribe(CBSBlock block, mps_lib_FILE *stream)
+static Res cbsBlockDescribe(RangeTree block, mps_lib_FILE *stream)
{
Res res;
@@ -639,8 +577,8 @@ static Res cbsBlockDescribe(CBSBlock block, mps_lib_FILE *stream)
res = WriteF(stream, 0,
"[$P,$P)",
- (WriteFP)block->base,
- (WriteFP)block->limit,
+ (WriteFP)RangeTreeBase(block),
+ (WriteFP)RangeTreeLimit(block),
NULL);
return res;
}
@@ -654,7 +592,7 @@ static Res cbsSplayNodeDescribe(Tree tree, mps_lib_FILE *stream)
if (stream == NULL)
return ResFAIL;
- res = cbsBlockDescribe(cbsBlockOfTree(tree), stream);
+ res = cbsBlockDescribe(RangeTreeOfTree(tree), stream);
return res;
}
@@ -667,8 +605,8 @@ static Res cbsFastBlockDescribe(CBSFastBlock block, mps_lib_FILE *stream)
res = WriteF(stream, 0,
"[$P,$P) {$U}",
- (WriteFP)block->cbsBlockStruct.base,
- (WriteFP)block->cbsBlockStruct.limit,
+ (WriteFP)RangeTreeBase(cbsFastBlockNode(block)),
+ (WriteFP)RangeTreeLimit(cbsFastBlockNode(block)),
(WriteFU)block->maxSize,
NULL);
return res;
@@ -696,8 +634,8 @@ static Res cbsZonedBlockDescribe(CBSZonedBlock block, mps_lib_FILE *stream)
res = WriteF(stream, 0,
"[$P,$P) {$U, $B}",
- (WriteFP)block->cbsFastBlockStruct.cbsBlockStruct.base,
- (WriteFP)block->cbsFastBlockStruct.cbsBlockStruct.limit,
+ (WriteFP)RangeTreeBase(cbsZonedBlockNode(block)),
+ (WriteFP)RangeTreeLimit(cbsZonedBlockNode(block)),
(WriteFU)block->cbsFastBlockStruct.maxSize,
(WriteFB)block->zones,
NULL);
@@ -726,29 +664,25 @@ static Res cbsZonedSplayNodeDescribe(Tree tree, mps_lib_FILE *stream)
typedef struct CBSIterateClosure {
Land land;
LandVisitor visitor;
- void *closureP;
+ void *visitorClosure;
} CBSIterateClosure;
-static Bool cbsIterateVisit(Tree tree, void *closureP, Size closureS)
+static Bool cbsIterateVisit(Tree tree, void *closure)
{
- CBSIterateClosure *closure = closureP;
- Land land = closure->land;
- CBSBlock cbsBlock = cbsBlockOfTree(tree);
+ CBSIterateClosure *my = closure;
+ Land land = my->land;
+ RangeTree block = RangeTreeOfTree(tree);
RangeStruct range;
- RangeInit(&range, CBSBlockBase(cbsBlock), CBSBlockLimit(cbsBlock));
- return (*closure->visitor)(land, &range, closure->closureP, closureS);
+ RangeInit(&range, RangeTreeBase(block), RangeTreeLimit(block));
+ return my->visitor(land, &range, my->visitorClosure);
}
-static Bool cbsIterate(Land land, LandVisitor visitor,
- void *closureP, Size closureS)
+static Bool cbsIterate(Land land, LandVisitor visitor, void *visitorClosure)
{
- CBS cbs;
+ CBS cbs = MustBeA(CBS, land);
SplayTree splay;
- CBSIterateClosure closure;
+ CBSIterateClosure iterateClosure;
- AVERT(Land, land);
- cbs = cbsOfLand(land);
- AVERT(CBS, cbs);
AVER(FUNCHECK(visitor));
splay = cbsSplay(cbs);
@@ -756,11 +690,11 @@ static Bool cbsIterate(Land land, LandVisitor visitor,
/* searches and meter it. */
METER_ACC(cbs->treeSearch, cbs->treeSize);
- closure.land = land;
- closure.visitor = visitor;
- closure.closureP = closureP;
+ iterateClosure.land = land;
+ iterateClosure.visitor = visitor;
+ iterateClosure.visitorClosure = visitorClosure;
return TreeTraverse(SplayTreeRoot(splay), splay->compare, splay->nodeKey,
- cbsIterateVisit, &closure, closureS);
+ cbsIterateVisit, &iterateClosure);
}
@@ -773,37 +707,34 @@ typedef struct CBSIterateAndDeleteClosure {
Land land;
LandDeleteVisitor visitor;
Bool cont;
- void *closureP;
+ void *visitorClosure;
} CBSIterateAndDeleteClosure;
-static Bool cbsIterateAndDeleteVisit(Tree tree, void *closureP, Size closureS)
+static Bool cbsIterateAndDeleteVisit(Tree tree, void *closure)
{
- CBSIterateAndDeleteClosure *closure = closureP;
- Land land = closure->land;
- CBS cbs = cbsOfLand(land);
- CBSBlock cbsBlock = cbsBlockOfTree(tree);
+ CBSIterateAndDeleteClosure *my = closure;
+ Land land = my->land;
+ CBS cbs = MustBeA(CBS, land);
+ RangeTree block = RangeTreeOfTree(tree);
Bool deleteNode = FALSE;
RangeStruct range;
- RangeInit(&range, CBSBlockBase(cbsBlock), CBSBlockLimit(cbsBlock));
- if (closure->cont)
- closure->cont = (*closure->visitor)(&deleteNode, land, &range,
- closure->closureP, closureS);
+ RangeInit(&range, RangeTreeBase(block), RangeTreeLimit(block));
+ if (my->cont)
+ my->cont = my->visitor(&deleteNode, land, &range,
+ my->visitorClosure);
if (deleteNode)
- cbsBlockDestroy(cbs, cbsBlock);
+ cbsBlockDestroy(cbs, block);
return deleteNode;
}
static Bool cbsIterateAndDelete(Land land, LandDeleteVisitor visitor,
- void *closureP, Size closureS)
+ void *visitorClosure)
{
- CBS cbs;
+ CBS cbs = MustBeA(CBS, land);
SplayTree splay;
- CBSIterateAndDeleteClosure closure;
+ CBSIterateAndDeleteClosure iterateClosure;
- AVERT(Land, land);
- cbs = cbsOfLand(land);
- AVERT(CBS, cbs);
AVER(FUNCHECK(visitor));
splay = cbsSplay(cbs);
@@ -811,13 +742,13 @@ static Bool cbsIterateAndDelete(Land land, LandDeleteVisitor visitor,
/* searches and meter it. */
METER_ACC(cbs->treeSearch, cbs->treeSize);
- closure.land = land;
- closure.visitor = visitor;
- closure.closureP = closureP;
- closure.cont = TRUE;
+ iterateClosure.land = land;
+ iterateClosure.visitor = visitor;
+ iterateClosure.visitorClosure = visitorClosure;
+ iterateClosure.cont = TRUE;
TreeTraverseAndDelete(&splay->root, cbsIterateAndDeleteVisit,
- &closure, closureS);
- return closure.cont;
+ &iterateClosure);
+ return iterateClosure.cont;
}
@@ -887,31 +818,26 @@ static void cbsFindDeleteRange(Range rangeReturn, Range oldRangeReturn,
static Bool cbsFindFirst(Range rangeReturn, Range oldRangeReturn,
Land land, Size size, FindDelete findDelete)
{
- CBS cbs;
+ CBS cbs = MustBeA_CRITICAL(CBS, land);
Bool found;
Tree tree;
- AVERT(Land, land);
- cbs = cbsOfLand(land);
- AVERT(CBS, cbs);
- AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass));
-
- AVER(rangeReturn != NULL);
- AVER(oldRangeReturn != NULL);
- AVER(size > 0);
- AVER(SizeIsAligned(size, LandAlignment(land)));
- AVERT(FindDelete, findDelete);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVER_CRITICAL(oldRangeReturn != NULL);
+ AVER_CRITICAL(size > 0);
+ AVER_CRITICAL(SizeIsAligned(size, LandAlignment(land)));
+ AVERT_CRITICAL(FindDelete, findDelete);
METER_ACC(cbs->treeSearch, cbs->treeSize);
found = SplayFindFirst(&tree, cbsSplay(cbs), &cbsTestNode,
- &cbsTestTree, NULL, size);
+ &cbsTestTree, &size);
if (found) {
- CBSBlock block;
+ RangeTree block;
RangeStruct range;
- block = cbsBlockOfTree(tree);
- AVER(CBSBlockSize(block) >= size);
- RangeInit(&range, CBSBlockBase(block), CBSBlockLimit(block));
- AVER(RangeSize(&range) >= size);
+ block = RangeTreeOfTree(tree);
+ AVER_CRITICAL(RangeTreeSize(block) >= size);
+ RangeInit(&range, RangeTreeBase(block), RangeTreeLimit(block));
+ AVER_CRITICAL(RangeSize(&range) >= size);
cbsFindDeleteRange(rangeReturn, oldRangeReturn, land, &range,
size, findDelete);
}
@@ -919,9 +845,12 @@ static Bool cbsFindFirst(Range rangeReturn, Range oldRangeReturn,
return found;
}
-/* 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.)
+
+/* cbsFindInZones -- find a block within a zone set
+ *
+ * Finds 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 {
@@ -934,36 +863,34 @@ typedef struct cbsTestNodeInZonesClosureStruct {
} cbsTestNodeInZonesClosureStruct, *cbsTestNodeInZonesClosure;
static Bool cbsTestNodeInZones(SplayTree splay, Tree tree,
- void *closureP, Size closureS)
+ void *closure)
{
- CBSBlock block = cbsBlockOfTree(tree);
- cbsTestNodeInZonesClosure closure = closureP;
+ RangeTree block = RangeTreeOfTree(tree);
+ cbsTestNodeInZonesClosure my = closure;
RangeInZoneSet search;
-
+
+ AVER_CRITICAL(closure != NULL);
UNUSED(splay);
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureS);
- search = closure->high ? RangeInZoneSetLast : RangeInZoneSetFirst;
+ search = my->high ? RangeInZoneSetLast : RangeInZoneSetFirst;
- return search(&closure->base, &closure->limit,
- CBSBlockBase(block), CBSBlockLimit(block),
- closure->arena, closure->zoneSet, closure->size);
+ return search(&my->base, &my->limit,
+ RangeTreeBase(block), RangeTreeLimit(block),
+ my->arena, my->zoneSet, my->size);
}
static Bool cbsTestTreeInZones(SplayTree splay, Tree tree,
- void *closureP, Size closureS)
+ void *closure)
{
CBSFastBlock fastBlock = cbsFastBlockOfTree(tree);
CBSZonedBlock zonedBlock = cbsZonedBlockOfTree(tree);
- cbsTestNodeInZonesClosure closure = closureP;
+ cbsTestNodeInZonesClosure my = closure;
+ AVER_CRITICAL(closure != NULL);
UNUSED(splay);
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureS);
- return fastBlock->maxSize >= closure->size
- && ZoneSetInter(zonedBlock->zones, closure->zoneSet) != ZoneSetEMPTY;
+ return fastBlock->maxSize >= my->size
+ && ZoneSetInter(zonedBlock->zones, my->zoneSet) != ZoneSetEMPTY;
}
@@ -972,31 +899,26 @@ static Bool cbsTestTreeInZones(SplayTree splay, Tree tree,
static Bool cbsFindLast(Range rangeReturn, Range oldRangeReturn,
Land land, Size size, FindDelete findDelete)
{
- CBS cbs;
+ CBS cbs = MustBeA_CRITICAL(CBSFast, land);
Bool found;
Tree tree;
- AVERT(Land, land);
- cbs = cbsOfLand(land);
- AVERT(CBS, cbs);
- AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass));
-
- AVER(rangeReturn != NULL);
- AVER(oldRangeReturn != NULL);
- AVER(size > 0);
- AVER(SizeIsAligned(size, LandAlignment(land)));
- AVERT(FindDelete, findDelete);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVER_CRITICAL(oldRangeReturn != NULL);
+ AVER_CRITICAL(size > 0);
+ AVER_CRITICAL(SizeIsAligned(size, LandAlignment(land)));
+ AVERT_CRITICAL(FindDelete, findDelete);
METER_ACC(cbs->treeSearch, cbs->treeSize);
found = SplayFindLast(&tree, cbsSplay(cbs), &cbsTestNode,
- &cbsTestTree, NULL, size);
+ &cbsTestTree, &size);
if (found) {
- CBSBlock block;
+ RangeTree block;
RangeStruct range;
- block = cbsBlockOfTree(tree);
- AVER(CBSBlockSize(block) >= size);
- RangeInit(&range, CBSBlockBase(block), CBSBlockLimit(block));
- AVER(RangeSize(&range) >= size);
+ block = RangeTreeOfTree(tree);
+ AVER_CRITICAL(RangeTreeSize(block) >= size);
+ RangeInit(&range, RangeTreeBase(block), RangeTreeLimit(block));
+ AVER_CRITICAL(RangeSize(&range) >= size);
cbsFindDeleteRange(rangeReturn, oldRangeReturn, land, &range,
size, findDelete);
}
@@ -1010,18 +932,13 @@ static Bool cbsFindLast(Range rangeReturn, Range oldRangeReturn,
static Bool cbsFindLargest(Range rangeReturn, Range oldRangeReturn,
Land land, Size size, FindDelete findDelete)
{
- CBS cbs;
+ CBS cbs = MustBeA_CRITICAL(CBSFast, land);
Bool found = FALSE;
- AVERT(Land, land);
- cbs = cbsOfLand(land);
- AVERT(CBS, cbs);
- AVER(IsLandSubclass(CBSLand(cbs), CBSFastLandClass));
-
- AVER(rangeReturn != NULL);
- AVER(oldRangeReturn != NULL);
- AVER(size > 0);
- AVERT(FindDelete, findDelete);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVER_CRITICAL(oldRangeReturn != NULL);
+ AVER_CRITICAL(size > 0);
+ AVERT_CRITICAL(FindDelete, findDelete);
if (!SplayTreeIsEmpty(cbsSplay(cbs))) {
RangeStruct range;
@@ -1030,15 +947,15 @@ static Bool cbsFindLargest(Range rangeReturn, Range oldRangeReturn,
maxSize = cbsFastBlockOfTree(SplayTreeRoot(cbsSplay(cbs)))->maxSize;
if (maxSize >= size) {
- CBSBlock block;
+ RangeTree block;
METER_ACC(cbs->treeSearch, cbs->treeSize);
found = SplayFindFirst(&tree, cbsSplay(cbs), &cbsTestNode,
- &cbsTestTree, NULL, maxSize);
- AVER(found); /* maxSize is exact, so we will find it. */
- block = cbsBlockOfTree(tree);
- AVER(CBSBlockSize(block) >= maxSize);
- RangeInit(&range, CBSBlockBase(block), CBSBlockLimit(block));
- AVER(RangeSize(&range) >= maxSize);
+ &cbsTestTree, &maxSize);
+ AVER_CRITICAL(found); /* maxSize is exact, so we will find it. */
+ block = RangeTreeOfTree(tree);
+ AVER_CRITICAL(RangeTreeSize(block) >= maxSize);
+ RangeInit(&range, RangeTreeBase(block), RangeTreeLimit(block));
+ AVER_CRITICAL(RangeSize(&range) >= maxSize);
cbsFindDeleteRange(rangeReturn, oldRangeReturn, land, &range,
size, findDelete);
}
@@ -1052,8 +969,8 @@ static Res cbsFindInZones(Bool *foundReturn, Range rangeReturn,
Range oldRangeReturn, Land land, Size size,
ZoneSet zoneSet, Bool high)
{
- CBS cbs;
- CBSBlock block;
+ CBS cbs = MustBeA_CRITICAL(CBSZoned, land);
+ RangeTree block;
Tree tree;
cbsTestNodeInZonesClosureStruct closure;
Res res;
@@ -1061,15 +978,11 @@ static Res cbsFindInZones(Bool *foundReturn, Range rangeReturn,
SplayFindFunction 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); */
- AVERT(Bool, high);
+ AVER_CRITICAL(foundReturn != NULL);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVER_CRITICAL(oldRangeReturn != NULL);
+ /* AVERT_CRITICAL(ZoneSet, zoneSet); */
+ AVERT_CRITICAL(Bool, high);
landFind = high ? cbsFindLast : cbsFindFirst;
splayFind = high ? SplayFindLast : SplayFindFirst;
@@ -1093,15 +1006,15 @@ static Res cbsFindInZones(Bool *foundReturn, Range rangeReturn,
closure.high = high;
if (!(*splayFind)(&tree, cbsSplay(cbs),
cbsTestNodeInZones, cbsTestTreeInZones,
- &closure, UNUSED_SIZE))
+ &closure))
goto fail;
- block = cbsBlockOfTree(tree);
+ block = RangeTreeOfTree(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));
+ AVER_CRITICAL(RangeTreeBase(block) <= closure.base);
+ AVER_CRITICAL(AddrOffset(closure.base, closure.limit) >= size);
+ AVER_CRITICAL(ZoneSetSub(ZoneSetOfRange(LandArena(land), closure.base, closure.limit), zoneSet));
+ AVER_CRITICAL(closure.limit <= RangeTreeLimit(block));
if (!high)
RangeInit(&rangeStruct, closure.base, AddrAdd(closure.base, size));
@@ -1127,34 +1040,37 @@ static Res cbsFindInZones(Bool *foundReturn, Range rangeReturn,
* See .
*/
-static Res cbsDescribe(Land land, mps_lib_FILE *stream, Count depth)
+static Res cbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
{
- CBS cbs;
+ Land land = CouldBeA(Land, inst);
+ CBS cbs = CouldBeA(CBS, land);
Res res;
Res (*describe)(Tree, mps_lib_FILE *);
- if (!TESTT(Land, land))
- return ResFAIL;
- cbs = cbsOfLand(land);
- if (!TESTT(CBS, cbs))
- return ResFAIL;
+ if (!TESTC(CBS, cbs))
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
+ return ResPARAM;
- res = WriteF(stream, depth,
- "CBS $P {\n", (WriteFP)cbs,
- " blockPool: $P\n", (WriteFP)cbsBlockPool(cbs),
- " ownPool: $U\n", (WriteFU)cbs->ownPool,
- " treeSize: $U\n", (WriteFU)cbs->treeSize,
+ res = NextMethod(Inst, CBS, describe)(inst, stream, depth);
+ if (res != ResOK)
+ return res;
+
+ res = WriteF(stream, depth + 2,
+ "blockPool $P\n", (WriteFP)cbsBlockPool(cbs),
+ "ownPool $U\n", (WriteFU)cbs->ownPool,
+ STATISTIC_WRITE(" treeSize: $U\n", (WriteFU)cbs->treeSize)
NULL);
if (res != ResOK)
return res;
METER_WRITE(cbs->treeSearch, stream, depth + 2);
- if (IsLandSubclass(land, CBSZonedLandClass))
+ /* This could be done by specialised methods in subclasses, but it
+ doesn't really come out any neater. */
+ if (IsA(CBSZoned, land))
describe = cbsZonedSplayNodeDescribe;
- else if (IsLandSubclass(land, CBSFastLandClass))
+ else if (IsA(CBSFast, land))
describe = cbsFastSplayNodeDescribe;
else
describe = cbsSplayNodeDescribe;
@@ -1163,52 +1079,46 @@ static Res cbsDescribe(Land land, mps_lib_FILE *stream, Count depth)
if (res != ResOK)
return res;
- res = WriteF(stream, depth, "} CBS $P\n", (WriteFP)cbs, NULL);
-
- res = WriteF(stream, 0, "}\n", NULL);
return res;
}
-DEFINE_LAND_CLASS(CBSLandClass, class)
+DEFINE_CLASS(Land, CBS, klass)
{
- 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->iterateAndDelete = cbsIterateAndDelete;
- class->findFirst = cbsFindFirst;
- class->findLast = cbsFindLast;
- class->findLargest = cbsFindLargest;
- class->findInZones = cbsFindInZones;
- class->describe = cbsDescribe;
- AVERT(LandClass, class);
+ INHERIT_CLASS(klass, CBS, Land);
+ klass->instClassStruct.describe = cbsDescribe;
+ klass->instClassStruct.finish = cbsFinish;
+ klass->size = sizeof(CBSStruct);
+ klass->init = cbsInit;
+ klass->sizeMethod = cbsSize;
+ klass->insert = cbsInsert;
+ klass->delete = cbsDelete;
+ klass->iterate = cbsIterate;
+ klass->iterateAndDelete = cbsIterateAndDelete;
+ klass->findFirst = cbsFindFirst;
+ klass->findLast = cbsFindLast;
+ klass->findLargest = cbsFindLargest;
+ klass->findInZones = cbsFindInZones;
+ AVERT(LandClass, klass);
}
-DEFINE_LAND_CLASS(CBSFastLandClass, class)
+DEFINE_CLASS(Land, CBSFast, klass)
{
- INHERIT_CLASS(class, CBSLandClass);
- class->name = "FASTCBS";
- class->init = cbsInitFast;
- AVERT(LandClass, class);
+ INHERIT_CLASS(klass, CBSFast, CBS);
+ klass->init = cbsInitFast;
+ AVERT(LandClass, klass);
}
-DEFINE_LAND_CLASS(CBSZonedLandClass, class)
+DEFINE_CLASS(Land, CBSZoned, klass)
{
- INHERIT_CLASS(class, CBSFastLandClass);
- class->name = "ZONEDCBS";
- class->init = cbsInitZoned;
- AVERT(LandClass, class);
+ INHERIT_CLASS(klass, CBSZoned, CBSFast);
+ klass->init = cbsInitZoned;
+ AVERT(LandClass, klass);
}
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2015 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/cbs.h b/mps/code/cbs.h
index a1496b3f771..844cd8cba6c 100644
--- a/mps/code/cbs.h
+++ b/mps/code/cbs.h
@@ -11,20 +11,14 @@
#include "arg.h"
#include "mpmtypes.h"
+#include "mpm.h"
#include "mpmst.h"
-#include "range.h"
+#include "rangetree.h"
#include "splay.h"
-typedef struct CBSBlockStruct *CBSBlock;
-typedef struct CBSBlockStruct {
- TreeStruct treeStruct;
- Addr base;
- Addr limit;
-} CBSBlockStruct;
-
typedef struct CBSFastBlockStruct *CBSFastBlock;
typedef struct CBSFastBlockStruct {
- struct CBSBlockStruct cbsBlockStruct;
+ struct RangeTreeStruct rangeTreeStruct;
Size maxSize; /* accurate maximum block size of sub-tree */
} CBSFastBlockStruct;
@@ -34,14 +28,25 @@ typedef struct CBSZonedBlockStruct {
ZoneSet zones; /* union zone set of all ranges in sub-tree */
} CBSZonedBlockStruct;
-typedef struct CBSStruct *CBS;
+typedef struct CBSStruct *CBS, *CBSFast, *CBSZoned;
extern Bool CBSCheck(CBS cbs);
+
+
+/* CBSLand -- convert CBS to Land
+ *
+ * We would like to use MustBeA(Land, cbs) for this, but it produces
+ * bogus warnings about strict aliasing from GCC 4.7 (and probably
+ * 4.8). We can abolish this macro when those are no longer in use in
+ * MPS development.
+ */
+
#define CBSLand(cbs) (&(cbs)->landStruct)
-extern LandClass CBSLandClassGet(void);
-extern LandClass CBSFastLandClassGet(void);
-extern LandClass CBSZonedLandClassGet(void);
+
+DECLARE_CLASS(Land, CBS, Land);
+DECLARE_CLASS(Land, CBSFast, CBS);
+DECLARE_CLASS(Land, CBSZoned, CBSFast);
extern const struct mps_key_s _mps_key_cbs_block_pool;
#define CBSBlockPool (&_mps_key_cbs_block_pool)
diff --git a/mps/code/check.h b/mps/code/check.h
index a2450bebd9a..eb7219bbe05 100644
--- a/mps/code/check.h
+++ b/mps/code/check.h
@@ -1,7 +1,7 @@
/* check.h: ASSERTION INTERFACE
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2017 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2002 Global Graphics Software.
*
* .aver: This header defines a family of AVER and NOTREACHED macros.
@@ -37,6 +37,7 @@
#include "config.h"
#include "misc.h"
#include "mpslib.h"
+#include "protocol.h"
/* ASSERT -- basic assertion
@@ -51,12 +52,22 @@
#define ASSERT(cond, condstring) \
BEGIN \
- if (cond) NOOP; else \
+ if (LIKELY(cond)) NOOP; else \
mps_lib_assert_fail(MPS_FILE, __LINE__, (condstring)); \
END
+#define ASSERTP(cond, condstring, default_) \
+ ((void)(LIKELY(cond) \
+ || (mps_lib_assert_fail(MPS_FILE, __LINE__, (condstring)), FALSE)), \
+ (default_))
+
+#define ASSERT_ISTYPE(type, val) (type ## Check(val))
#define ASSERT_TYPECHECK(type, val) \
- ASSERT(type ## Check(val), "TypeCheck " #type ": " #val)
+ ASSERT(ASSERT_ISTYPE(type, val), "TypeCheck " #type ": " #val)
+
+#define ASSERT_ISCLASS(klass, val) (klass ## Check(CouldBeA(klass, val)))
+#define ASSERT_CLASSCHECK(klass, val) \
+ ASSERT(ASSERT_ISCLASS(klass, val), "ClassCheck " #klass ": " #val)
#define ASSERT_NULLCHECK(type, val) \
ASSERT((val) != NULL, "NullCheck " #type ": " #val)
@@ -103,28 +114,44 @@ extern unsigned CheckLevel;
#endif
-/* AVER, AVERT -- MPM assertions
+/* AVER, AVERT, AVERC, AVERP -- MPM assertions
*
- * AVER and AVERT are used to assert conditions in the code. AVER checks
- * an expression. AVERT checks that a value is of the correct type and
- * may perform consistency checks on the value.
+ * AVER and friends are used to assert conditions in the code.
*
- * AVER and AVERT are on by default, and check conditions even in "hot"
- * varieties intended to work in production. To avoid the cost of a check
- * in critical parts of the code, use AVER_CRITICAL and AVERT_CRITICAL,
- * but only when you've *proved* that this makes a difference to performance
- * that affects requirements.
+ * AVER checks an expression.
+ *
+ * AVERT checks that a value is of the correct type and may perform
+ * consistency checks on the value by calling a check function.
+ *
+ * AVERC checks that a value is of the correct class (including
+ * subclasses) and may perform consistency checks on the value by
+ * calling a check function.
+ *
+ * AVERP checks an expression but is itself a void * expression, and
+ * so can be used in expression macros.
+ *
+ * AVER etc. are on by default, and check conditions even in "hot"
+ * varieties intended to work in production. To avoid the cost of a
+ * check in critical parts of the code, use AVER_CRITICAL etc., but
+ * only when you've *proved* that this makes a difference to
+ * performance that affects requirements.
*/
#if defined(AVER_AND_CHECK_NONE)
#define AVER(cond) DISCARD(cond)
-#define AVERT(type, val) DISCARD(type ## Check(val))
+#define AVERT(type, val) DISCARD(ASSERT_ISTYPE(type, val))
+#define AVERC(klass, val) DISCARD(ASSERT_ISCLASS(klass, val))
+#define AVERP(cond, dflt) (DISCARD_EXP(cond), dflt)
+#define AVERPC(cond, condstring, dflt) (DISCARD_EXP(cond), dflt)
#else
#define AVER(cond) ASSERT(cond, #cond)
#define AVERT ASSERT_TYPECHECK
+#define AVERC ASSERT_CLASSCHECK
+#define AVERP(cond, dflt) ASSERTP(cond, #cond, dflt)
+#define AVERPC ASSERTP
#endif
@@ -132,11 +159,17 @@ extern unsigned CheckLevel;
#define AVER_CRITICAL(cond) ASSERT(cond, #cond)
#define AVERT_CRITICAL ASSERT_TYPECHECK
+#define AVERC_CRITICAL ASSERT_CLASSCHECK
+#define AVERP_CRITICAL(cond, dflt) ASSERTP(cond, #cond, dflt)
+#define AVERPC_CRITICAL ASSERTP
#else
#define AVER_CRITICAL DISCARD
-#define AVERT_CRITICAL(type, val) DISCARD(type ## Check(val))
+#define AVERT_CRITICAL(type, val) DISCARD(ASSERT_ISTYPE(type, val))
+#define AVERC_CRITICAL(klass, val) DISCARD(ASSERT_ISCLASS(klass, val))
+#define AVERP_CRITICAL(cond, dflt) (DISCARD_EXP(cond), dflt)
+#define AVERPC_CRITICAL(cond, condstring, dflt) (DISCARD_EXP(cond), dflt)
#endif
@@ -170,16 +203,27 @@ extern unsigned CheckLevel;
#define TESTT(type, val) ((val) != NULL && (val)->sig == type ## Sig)
-/* CHECKS -- Check Signature
+/* TESTC -- check class simply
+ *
+ * TODO: Does this need to be thread safe like TESTT?
+ */
+
+#define TESTC(klass, val) ((val) != NULL && IsA(klass, val))
+
+
+/* CHECKS, CHECKC -- Check Signature, Check Class
*
* (if CHECKLEVEL == CheckLevelMINIMAL, this is all we check)
*/
#if defined(AVER_AND_CHECK_NONE)
#define CHECKS(type, val) DISCARD(TESTT(type, val))
+#define CHECKC(klass, val) DISCARD(MustBeA(klass, val))
#else
#define CHECKS(type, val) \
ASSERT(TESTT(type, val), "SigCheck " #type ": " #val)
+#define CHECKC(klass, val) \
+ ASSERT(TESTC(klass, val), "ClassCheck " #klass ": " #val)
#endif
@@ -253,6 +297,11 @@ extern unsigned CheckLevel;
ASSERT_NULLCHECK(type, val), \
ASSERT_TYPECHECK(type, val))
+#define CHECKD_CLASS(klass, val) \
+ CHECK_BY_LEVEL(NOOP, \
+ CHECKC(klass, val) \
+ ASSERT_CLASSCHECK(klass, val))
+
#define CHECKU(type, val) \
CHECK_BY_LEVEL(NOOP, \
CHECKS(type, val), \
@@ -265,15 +314,16 @@ extern unsigned CheckLevel;
#else /* AVER_AND_CHECK_ALL, not */
-/* TODO: This gives comparable performance to white-hot when compiling
+/* TODO: This gives comparable performance to RASH when compiling
using mps.c and -O2 (to get check methods inlined), but is it a bit
too minimal? How much do we rely on check methods? */
-#define CHECKL(cond) DISCARD(cond)
-#define CHECKD(type, val) DISCARD(TESTT(type, val))
-#define CHECKD_NOSIG(type, val) DISCARD((val) != NULL)
-#define CHECKU(type, val) DISCARD(TESTT(type, val))
-#define CHECKU_NOSIG(type, val) DISCARD((val) != NULL)
+#define CHECKL(cond) DISCARD(cond)
+#define CHECKD(type, val) DISCARD(TESTT(type, val))
+#define CHECKD_NOSIG(type, val) DISCARD((val) != NULL)
+#define CHECKD_CLASS(klass, val) DISCARD((val) != NULL)
+#define CHECKU(type, val) DISCARD(TESTT(type, val))
+#define CHECKU_NOSIG(type, val) DISCARD((val) != NULL)
#endif /* AVER_AND_CHECK_ALL */
@@ -324,7 +374,7 @@ extern unsigned CheckLevel;
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2017 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk
index e5af99266ae..d323b3ea67d 100644
--- a/mps/code/comm.gmk
+++ b/mps/code/comm.gmk
@@ -73,9 +73,9 @@ endif
# EXTRA TARGETS
#
# Don't build mpseventsql by default (might not have sqlite3 installed),
-# but do build mpseventcnv and mpseventtxt.
+# but do build mpseventcnv, mpseventpy and mpseventtxt.
-EXTRA_TARGETS ?= mpseventcnv mpseventtxt
+EXTRA_TARGETS ?= mpseventcnv mpseventpy mpseventtxt
#
@@ -192,11 +192,10 @@ MPMCOMMON = \
poolabs.c \
poolmfs.c \
poolmrg.c \
- poolmv.c \
protocol.c \
range.c \
+ rangetree.c \
ref.c \
- reserv.c \
ring.c \
root.c \
sa.c \
@@ -267,6 +266,7 @@ TEST_TARGETS=\
expt825 \
finalcv \
finaltest \
+ forktest \
fotest \
gcbench \
landtest \
@@ -284,6 +284,7 @@ TEST_TARGETS=\
qs \
sacss \
segsmss \
+ sncss \
steptest \
tagtest \
teletest \
@@ -319,18 +320,41 @@ $(addprefix $(PFM)/$(VARIETY)/,$(TEST_SUITES)): $(TEST_TARGETS)
../tool/testrun.sh -s "$(notdir $@)" "$(PFM)/$(VARIETY)"
+# == Automated performance testing ==
+#
+# testratio = measure performance ratio of hot variety versus rash
+
+TESTRATIO_SEED = 1564912146
+
+define ratio
+TIME_HOT=$$(/usr/bin/time -p $(PFM)/hot/$(1) -x $(TESTRATIO_SEED) $(2) 2>&1 | tail -2 | awk '{T += $$2} END {print T}'); \
+TIME_RASH=$$(/usr/bin/time -p $(PFM)/rash/$(1) -x $(TESTRATIO_SEED) $(2) 2>&1 | tail -2 | awk '{T += $$2} END {print T}'); \
+RATIO=$$(awk "BEGIN{print int(100 * $$TIME_HOT / $$TIME_RASH)}"); \
+printf "Performance ratio (hot/rash) for $(2): %d%%\n" $$RATIO
+endef
+
+testratio: phony
+ $(MAKE) -f $(PFM).gmk VARIETY=hot djbench gcbench
+ $(MAKE) -f $(PFM).gmk VARIETY=rash djbench gcbench
+ $(call ratio,gcbench,amc)
+ $(call ratio,djbench,mvff)
+
+
# == MMQA test suite ==
#
# See test/README for documentation on running the MMQA test suite.
-MMQA=perl test/qa -i ../code -l ../code/$(PFM)/$(VARIETY)/mps.o
+MMQA=perl test/qa -p $(PFM) -v $(VARIETY)
$(PFM)/$(VARIETY)/testmmqa:
- $(MAKE) -f $(PFM).gmk VARIETY=$(VARIETY) TARGET=mps.o variety
- (if [ "$(VARIETY)" = "cool" ]; then cd ../test && $(MMQA) runset testsets/coolonly; fi)
- (cd ../test && $(MMQA) runset testsets/argerr)
- (cd ../test && $(MMQA) runset testsets/conerr)
- (cd ../test && $(MMQA) runset testsets/passing)
+ if [ "$(VARIETY)" = "cool" ]; then (cd ../test && $(MMQA) runset testsets/coolonly); fi
+ (cd ../test && $(MMQA) runset testsets/argerr testsets/conerr testsets/passing)
+
+
+# == Toy Scheme interpreter ==
+
+testscheme: phony
+ $(MAKE) -C ../example/scheme test
# These convenience targets allow one to type "make foo" to build target
@@ -447,10 +471,10 @@ $(PFM)/$(VARIETY)/arenacv: $(PFM)/$(VARIETY)/arenacv.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/awlut: $(PFM)/$(VARIETY)/awlut.o \
- $(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+ $(FMTDYTSTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/awluthe: $(PFM)/$(VARIETY)/awluthe.o \
- $(FMTHETSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+ $(FMTHETSTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/awlutth: $(PFM)/$(VARIETY)/awlutth.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(TESTTHROBJ) $(PFM)/$(VARIETY)/mps.a
@@ -476,6 +500,9 @@ $(PFM)/$(VARIETY)/finalcv: $(PFM)/$(VARIETY)/finalcv.o \
$(PFM)/$(VARIETY)/finaltest: $(PFM)/$(VARIETY)/finaltest.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+$(PFM)/$(VARIETY)/forktest: $(PFM)/$(VARIETY)/forktest.o \
+ $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+
$(PFM)/$(VARIETY)/fotest: $(PFM)/$(VARIETY)/fotest.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@@ -527,15 +554,18 @@ $(PFM)/$(VARIETY)/sacss: $(PFM)/$(VARIETY)/sacss.o \
$(PFM)/$(VARIETY)/segsmss: $(PFM)/$(VARIETY)/segsmss.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+$(PFM)/$(VARIETY)/sncss: $(PFM)/$(VARIETY)/sncss.o \
+ $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+
+$(PFM)/$(VARIETY)/steptest: $(PFM)/$(VARIETY)/steptest.o \
+ $(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+
$(PFM)/$(VARIETY)/tagtest: $(PFM)/$(VARIETY)/tagtest.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
$(PFM)/$(VARIETY)/teletest: $(PFM)/$(VARIETY)/teletest.o \
$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
-$(PFM)/$(VARIETY)/steptest: $(PFM)/$(VARIETY)/steptest.o \
- $(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
-
$(PFM)/$(VARIETY)/walkt0: $(PFM)/$(VARIETY)/walkt0.o \
$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
@@ -548,6 +578,9 @@ $(PFM)/$(VARIETY)/zmess: $(PFM)/$(VARIETY)/zmess.o \
$(PFM)/$(VARIETY)/mpseventcnv: $(PFM)/$(VARIETY)/eventcnv.o \
$(PFM)/$(VARIETY)/mps.a
+$(PFM)/$(VARIETY)/mpseventpy: $(PFM)/$(VARIETY)/eventpy.o \
+ $(PFM)/$(VARIETY)/mps.a
+
$(PFM)/$(VARIETY)/mpseventtxt: $(PFM)/$(VARIETY)/eventtxt.o \
$(PFM)/$(VARIETY)/mps.a
diff --git a/mps/code/commpost.nmk b/mps/code/commpost.nmk
index 201094905bd..55cb47aaaa0 100644
--- a/mps/code/commpost.nmk
+++ b/mps/code/commpost.nmk
@@ -1,7 +1,7 @@
# commpost.nmk: SECOND COMMON FRAGMENT FOR PLATFORMS USING NMAKE -*- makefile -*-
#
# $Id$
-# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
#
# DESCRIPTION
#
@@ -203,11 +203,11 @@ $(PFM)\$(VARIETY)\arenacv.exe: $(PFM)\$(VARIETY)\arenacv.obj \
$(PFM)\$(VARIETY)\awlut.exe: $(PFM)\$(VARIETY)\awlut.obj \
$(FMTTESTOBJ) \
- $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
+ $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ) $(TESTTHROBJ)
$(PFM)\$(VARIETY)\awluthe.exe: $(PFM)\$(VARIETY)\awluthe.obj \
$(FMTTESTOBJ) \
- $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
+ $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ) $(TESTTHROBJ)
$(PFM)\$(VARIETY)\awlutth.exe: $(PFM)\$(VARIETY)\awlutth.obj \
$(FMTTESTOBJ) \
@@ -288,9 +288,15 @@ $(PFM)\$(VARIETY)\sacss.exe: $(PFM)\$(VARIETY)\sacss.obj \
$(PFM)\$(VARIETY)\segsmss.exe: $(PFM)\$(VARIETY)\segsmss.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
+$(PFM)\$(VARIETY)\sncss.exe: $(PFM)\$(VARIETY)\sncss.obj \
+ $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
+
$(PFM)\$(VARIETY)\steptest.exe: $(PFM)\$(VARIETY)\steptest.obj \
$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
+$(PFM)\$(VARIETY)\tagtest.exe: $(PFM)\$(VARIETY)\tagtest.obj \
+ $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
+
$(PFM)\$(VARIETY)\teletest.exe: $(PFM)\$(VARIETY)\teletest.obj \
$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
@@ -309,6 +315,9 @@ $(PFM)\$(VARIETY)\ztfm.exe: $(PFM)\$(VARIETY)\ztfm.obj \
$(PFM)\$(VARIETY)\mpseventcnv.exe: $(PFM)\$(VARIETY)\eventcnv.obj \
$(PFM)\$(VARIETY)\mps.lib
+$(PFM)\$(VARIETY)\mpseventpy.exe: $(PFM)\$(VARIETY)\eventpy.obj \
+ $(PFM)\$(VARIETY)\mps.lib
+
$(PFM)\$(VARIETY)\mpseventtxt.exe: $(PFM)\$(VARIETY)\eventtxt.obj \
$(PFM)\$(VARIETY)\mps.lib
@@ -329,6 +338,9 @@ $(PFM)\$(VARIETY)\replaysw.obj: $(PFM)\$(VARIETY)\replay.obj
$(PFM)\$(VARIETY)\mpseventcnv.obj: $(PFM)\$(VARIETY)\eventcnv.obj
copy $** $@ >nul:
+$(PFM)\$(VARIETY)\mpseventpy.obj: $(PFM)\$(VARIETY)\eventpy.obj
+ copy $** $@ >nul:
+
$(PFM)\$(VARIETY)\mpseventtxt.obj: $(PFM)\$(VARIETY)\eventtxt.obj
copy $** $@ >nul:
@@ -379,7 +391,7 @@ $(PFM)\$(VARIETY)\sqlite3.obj:
# C. COPYRIGHT AND LICENSE
#
-# Copyright (C) 2001-2014 Ravenbrook Limited .
+# Copyright (c) 2001-2016 Ravenbrook Limited .
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
diff --git a/mps/code/commpre.nmk b/mps/code/commpre.nmk
index e3d2443fe21..f88d2a08a72 100644
--- a/mps/code/commpre.nmk
+++ b/mps/code/commpre.nmk
@@ -94,7 +94,9 @@ TEST_TARGETS=\
qs.exe \
sacss.exe \
segsmss.exe \
+ sncss.exe \
steptest.exe \
+ tagtest.exe \
teletest.exe \
walkt0.exe \
zcoll.exe \
@@ -103,7 +105,7 @@ TEST_TARGETS=\
# Stand-alone programs go in EXTRA_TARGETS if they should always be
# built, or in OPTIONAL_TARGETS if they should only be built if
-EXTRA_TARGETS=mpseventcnv.exe mpseventtxt.exe
+EXTRA_TARGETS=mpseventcnv.exe mpseventpy.exe mpseventtxt.exe
OPTIONAL_TARGETS=mpseventsql.exe
# This target records programs that we were once able to build but
@@ -152,11 +154,10 @@ MPMCOMMON=\
[poolmfs] \
[poolmrg] \
[poolmv2] \
- [poolmv] \
[protocol] \
[range] \
+ [rangetree] \
[ref] \
- [reserv] \
[ring] \
[root] \
[sa] \
diff --git a/mps/code/config.h b/mps/code/config.h
index 4fa4c0b3979..80789d8c069 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -1,7 +1,7 @@
/* config.h: MPS CONFIGURATION
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
* Portions copyright (c) 2002 Global Graphics Software.
*
* PURPOSE
@@ -106,8 +106,6 @@
#if defined(CONFIG_STATS)
/* CONFIG_STATS = STATISTICS = METERs */
-/* WARNING: this may change the size and fields of MPS structs */
-/* (...but see STATISTIC_DECL, which is invariant) */
#define STATISTICS
#define MPS_STATS_STRING "stats"
#else
@@ -169,8 +167,9 @@
/* 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.
+ * execution only, where locks are not needed and so the generic
+ * ("ANSI") lock module lockan.c can be used instead of the
+ * platform-specific lock module.
*/
#if !defined(CONFIG_THREAD_SINGLE)
@@ -279,8 +278,20 @@
#define ATTRIBUTE_NO_SANITIZE_ADDRESS
#endif
+/* Attribute for functions that must not be inlined.
+ * GCC:
+ * MSVC:
+ */
+#if defined(MPS_BUILD_GC) || defined(MPS_BUILD_LL)
+#define ATTRIBUTE_NOINLINE __attribute__((__noinline__))
+#elif defined(MPS_BUILD_MV)
+#define ATTRIBUTE_NOINLINE __declspec(noinline)
+#else
+#define ATTRIBUTE_NOINLINE
+#endif
+
/* Attribute for functions that do not return.
- * GCC:
+ * GCC:
* Clang:
*/
#if defined(MPS_BUILD_GC) || defined(MPS_BUILD_LL)
@@ -290,7 +301,7 @@
#endif
/* Attribute for functions that may be unused in some build configurations.
- * GCC:
+ * GCC:
*
* This attribute must be applied to all Check functions, otherwise
* the RASH variety fails to compile with -Wunused-function. (It
@@ -304,12 +315,20 @@
#endif
-/* EPVMDefaultSubsequentSegSIZE is a default for the alignment of
- * subsequent segments (non-initial at each save level) in EPVM. See
- * design.mps.poolepvm.arch.segment.size.
+/* Compiler extensions */
+
+/* LIKELY -- likely conditions
+ *
+ * Use to annotate conditions that are likely to be true, such as
+ * assertions, to help move unlikely code out-of-line. See
+ * .
*/
-#define EPVMDefaultSubsequentSegSIZE ((Size)64 * 1024)
+#if defined(MPS_BUILD_GC) || defined(MPS_BUILD_LL)
+#define LIKELY(exp) __builtin_expect((exp) != 0, 1)
+#else
+#define LIKELY(exp) ((exp) != 0)
+#endif
/* Buffer Configuration -- see */
@@ -357,14 +376,6 @@
#define LO_GEN_DEFAULT 0
-/* Pool MV Configuration -- see */
-
-#define MV_ALIGN_DEFAULT MPS_PF_ALIGN
-#define MV_EXTEND_BY_DEFAULT ((Size)65536)
-#define MV_AVG_SIZE_DEFAULT ((Size)32)
-#define MV_MAX_SIZE_DEFAULT ((Size)65536)
-
-
/* Pool MFS Configuration -- see */
#define MFS_EXTEND_BY_DEFAULT ((Size)65536)
@@ -396,8 +407,6 @@
#define ArenaPollALLOCTIME (65536.0)
-#define ARENA_ZONESHIFT ((Shift)20)
-
/* .client.seg-size: ARENA_CLIENT_GRAIN_SIZE is the minimum size, in
* bytes, of a grain in the client arena. It's set at 8192 with no
* particular justification. */
@@ -408,6 +417,13 @@
#define ARENA_SPARE_DEFAULT 0.75
+/* ARENA_DEFAULT_PAUSE_TIME is the maximum time (in seconds) that
+ * operations within the arena may pause the mutator for. The default
+ * is set for typical human interaction. See mps_arena_pause_time_set
+ * in the manual. */
+
+#define ARENA_DEFAULT_PAUSE_TIME (0.1)
+
#define ARENA_DEFAULT_ZONED TRUE
/* ARENA_MINIMUM_COLLECTABLE_SIZE is the minimum size (in bytes) of
@@ -417,8 +433,9 @@
#define ARENA_MINIMUM_COLLECTABLE_SIZE ((Size)1000000)
/* ARENA_DEFAULT_COLLECTION_RATE is an estimate of the MPS's
- * collection rate (in bytes per second), for use in the case where
- * there isn't enough data to use a measured value. */
+ * collection rate (in work per second; see ), for
+ * use in the case where there isn't enough data to use a measured
+ * value. */
#define ARENA_DEFAULT_COLLECTION_RATE (25000000.0)
@@ -459,10 +476,17 @@
#define VM_ARENA_SIZE_DEFAULT ((Size)1 << 28)
-/* Stack configuration -- see */
+/* Locus configuration -- see */
+
+/* Weighting for the current observation, in the exponential moving
+ * average computation of the mortality of a generation. */
+#define LocusMortalityALPHA (0.4)
+
+
+/* Stack probe configuration -- see */
/* Currently StackProbe has a useful implementation only on Windows. */
-#if defined(MPS_OS_W3)
+#if defined(MPS_OS_W3) && !defined(CONFIG_PF_ANSI)
/* See for a justification of this value. */
#define StackProbeDEPTH ((Size)500)
#else
@@ -472,8 +496,8 @@
/* Shield Configuration -- see */
-#define ShieldCacheSIZE ((size_t)16)
-#define ShieldDepthWIDTH (4)
+#define ShieldQueueLENGTH 512 /* initial length of shield queue */
+#define ShieldDepthWIDTH 4 /* log2(max nested exposes + 1) */
/* VM Configuration -- see */
@@ -491,10 +515,10 @@
* 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
+ * lockix.c pthread_mutexattr_settype _XOPEN_SOURCE >= 500
* prmcix.h stack_t, siginfo_t _XOPEN_SOURCE
+ * prmclii3.c REG_EAX etc. _GNU_SOURCE
+ * prmclii6.c REG_RAX etc. _GNU_SOURCE
* pthrdext.c sigaction etc. _XOPEN_SOURCE
* vmix.c MAP_ANON _GNU_SOURCE
*
@@ -523,14 +547,14 @@
#endif
-/* .feature.xc: OS X feature specification
+/* .feature.xc: macOS feature specification
*
* The MPS needs the following symbols which are not defined by default
*
* Source Symbols Header Feature
* =========== ========================= ============= ====================
- * prmci3li.c __eax etc. _XOPEN_SOURCE
- * prmci6li.c __rax etc. _XOPEN_SOURCE
+ * prmclii3.c __eax etc. _XOPEN_SOURCE
+ * prmclii6.c __rax etc. _XOPEN_SOURCE
*
* It is not possible to localize these feature specifications around
* the individual headers: all headers share a common set of features
@@ -547,21 +571,6 @@
#endif
-/* Protection Configuration see
-
- For each architecture/OS that uses protix.c or protsgix.c, we need to
- define what signal number to use, and what si_code value to check.
-*/
-
-#if defined(MPS_OS_FR)
-#define PROT_SIGNAL (SIGSEGV)
-#endif
-
-#if defined(MPS_OS_FR)
-#define PROT_SIGINFO_GOOD(info) ((info)->si_code == SEGV_ACCERR)
-#endif
-
-
/* Almost all of protxc.c etc. are architecture-independent, but unfortunately
the Mach headers don't provide architecture neutral symbols for simple
things like thread states. These definitions fix that. */
@@ -581,12 +590,35 @@
#else
-#error "Unknown OS X architecture"
+#error "Unknown macOS architecture"
#endif
#endif
+/* POSIX thread extensions configuration -- see */
+
+#if defined(MPS_OS_LI) || defined(MPS_OS_FR)
+
+/* PTHREADEXT_SIGSUSPEND -- signal used to suspend a thread
+ * See
+ */
+#if defined(CONFIG_PTHREADEXT_SIGSUSPEND)
+#define PTHREADEXT_SIGSUSPEND CONFIG_PTHREADEXT_SIGSUSPEND
+#else
+#define PTHREADEXT_SIGSUSPEND SIGXFSZ
+#endif
+
+/* PTHREADEXT_SIGRESUME -- signal used to resume a thread
+ * See
+ */
+#if defined(CONFIG_PTHREADEXT_SIGRESUME)
+#define PTHREADEXT_SIGRESUME CONFIG_PTHREADEXT_SIGRESUME
+#else
+#define PTHREADEXT_SIGRESUME SIGXCPU
+#endif
+
+#endif
/* Tracer Configuration -- see */
@@ -657,12 +689,31 @@
}
+/* Write barrier deferral
+ *
+ * See design.mps.write-barrier.deferral.
+ *
+ * TODO: These settings were determined by trial and error, but should
+ * be based on measurement of the protection overhead on each
+ * platform. We know it's extremely different between macOS and
+ * Windows, for example. See design.mps.write-barrier.improv.by-os.
+ *
+ * TODO: Consider basing the count on the amount of time that has
+ * passed in the mutator rather than the number of scans.
+ */
+
+#define WB_DEFER_BITS 2 /* bitfield width for deferral count */
+#define WB_DEFER_INIT 3 /* boring scans after new segment */
+#define WB_DEFER_DELAY 3 /* boring scans after interesting scan */
+#define WB_DEFER_HIT 1 /* boring scans after barrier hit */
+
+
#endif /* config_h */
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/dbgpool.c b/mps/code/dbgpool.c
index 6a8417595f7..b2e7bdb433d 100644
--- a/mps/code/dbgpool.c
+++ b/mps/code/dbgpool.c
@@ -1,7 +1,7 @@
/* dbgpool.c: POOL DEBUG MIXIN
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2002 Global Graphics Software.
*
* .source: design.mps.object-debug
@@ -87,7 +87,7 @@ Bool PoolDebugMixinCheck(PoolDebugMixin debug)
/* DebugPoolDebugMixin -- gets the debug mixin, if any */
-#define DebugPoolDebugMixin(pool) (((pool)->class->debugMixin)(pool))
+#define DebugPoolDebugMixin(pool) (Method(Pool, pool, debugMixin)(pool))
/* PoolNoDebugMixin -- debug mixin methods for pools with no mixin */
@@ -127,7 +127,7 @@ static PoolDebugOptionsStruct debugPoolOptionsDefault = {
"POST", 4, "DEAD", 4,
};
-static Res DebugPoolInit(Pool pool, ArgList args)
+static Res DebugPoolInit(Pool pool, Arena arena, PoolClass klass, ArgList args)
{
Res res;
PoolDebugOptions options = &debugPoolOptionsDefault;
@@ -136,7 +136,10 @@ static Res DebugPoolInit(Pool pool, ArgList args)
Size tagSize;
ArgStruct arg;
- AVERT(Pool, pool);
+ AVER(pool != NULL);
+ AVERT(Arena, arena);
+ AVERT(PoolClass, klass);
+ AVERT(ArgList, args);
if (ArgPick(&arg, args, MPS_KEY_POOL_DEBUG_OPTIONS))
options = (PoolDebugOptions)arg.val.pool_debug_options;
@@ -147,10 +150,11 @@ static Res DebugPoolInit(Pool pool, ArgList args)
/* not been published yet. */
tagInit = NULL; tagSize = 0;
- res = SuperclassOfPool(pool)->init(pool, args);
+ res = SuperclassPoly(Pool, klass)->init(pool, arena, klass, args);
if (res != ResOK)
return res;
+ SetClassOfPoly(pool, klass);
debug = DebugPoolDebugMixin(pool);
AVER(debug != NULL);
@@ -202,7 +206,7 @@ static Res DebugPoolInit(Pool pool, ArgList args)
return ResOK;
tagFail:
- SuperclassOfPool(pool)->finish(pool);
+ SuperclassPoly(Inst, klass)->finish(MustBeA(Inst, pool));
AVER(res != ResOK);
return res;
}
@@ -210,9 +214,11 @@ static Res DebugPoolInit(Pool pool, ArgList args)
/* DebugPoolFinish -- finish method for a debug pool */
-static void DebugPoolFinish(Pool pool)
+static void DebugPoolFinish(Inst inst)
{
+ Pool pool = MustBeA(AbstractPool, inst);
PoolDebugMixin debug;
+ PoolClass klass;
AVERT(Pool, pool);
@@ -223,7 +229,8 @@ static void DebugPoolFinish(Pool pool)
SplayTreeFinish(&debug->index);
PoolDestroy(debug->tagPool);
}
- SuperclassOfPool(pool)->finish(pool);
+ klass = ClassOfPoly(Pool, pool);
+ SuperclassPoly(Inst, klass)->finish(inst);
}
@@ -397,14 +404,16 @@ static Bool freeCheck(PoolDebugMixin debug, Pool pool, Addr base, Addr limit)
/* freeCheckAlloc -- allocation wrapper for free-checking */
static Res freeCheckAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
- Size size, Bool withReservoir)
+ Size size)
{
Res res;
Addr new;
+ PoolClass klass;
AVER(aReturn != NULL);
- res = SuperclassOfPool(pool)->alloc(&new, pool, size, withReservoir);
+ klass = ClassOfPoly(Pool, pool);
+ res = SuperclassPoly(Pool, klass)->alloc(&new, pool, size);
if (res != ResOK)
return res;
if (debug->freeSize != 0)
@@ -421,9 +430,11 @@ static Res freeCheckAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
static void freeCheckFree(PoolDebugMixin debug,
Pool pool, Addr old, Size size)
{
+ PoolClass klass;
if (debug->freeSize != 0)
freeSplat(debug, pool, old, AddrAdd(old, size));
- SuperclassOfPool(pool)->free(pool, old, size);
+ klass = ClassOfPoly(Pool, pool);
+ SuperclassPoly(Pool, klass)->free(pool, old, size);
}
@@ -445,7 +456,7 @@ static void freeCheckFree(PoolDebugMixin debug,
*/
static Res fenceAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
- Size size, Bool withReservoir)
+ Size size)
{
Res res;
Addr obj, startFence, clientNew, clientLimit, limit;
@@ -458,8 +469,7 @@ static Res fenceAlloc(Addr *aReturn, PoolDebugMixin debug, Pool pool,
alignedFenceSize = SizeAlignUp(debug->fenceSize, PoolAlignment(pool));
alignedSize = SizeAlignUp(size, PoolAlignment(pool));
res = freeCheckAlloc(&obj, debug, pool,
- alignedSize + 2 * alignedFenceSize,
- withReservoir);
+ alignedSize + 2 * alignedFenceSize);
if (res != ResOK)
return res;
@@ -514,7 +524,7 @@ static void fenceFree(PoolDebugMixin debug,
{
Size alignedFenceSize, alignedSize;
- ASSERT(fenceCheck(debug, pool, old, size), "fencepost check on free");
+ ASSERT(fenceCheck(debug, pool, old, size), "fencepost check on free"); /* */
alignedFenceSize = SizeAlignUp(debug->fenceSize, PoolAlignment(pool));
alignedSize = SizeAlignUp(size, PoolAlignment(pool));
@@ -526,7 +536,7 @@ static void fenceFree(PoolDebugMixin debug,
/* tagAlloc -- allocation wrapper for tagged pools */
static Res tagAlloc(PoolDebugMixin debug,
- Pool pool, Addr new, Size size, Bool withReservoir)
+ Pool pool, Addr new, Size size)
{
Tag tag;
Res res;
@@ -534,15 +544,9 @@ static Res tagAlloc(PoolDebugMixin debug,
Addr addr;
UNUSED(pool);
- res = PoolAlloc(&addr, debug->tagPool, debug->tagSize, FALSE);
- if (res != ResOK) {
- if (withReservoir) { /* missingTags++;
- return ResOK;
- } else {
- return res;
- }
- }
+ res = PoolAlloc(&addr, debug->tagPool, debug->tagSize);
+ if (res != ResOK)
+ return res;
tag = (Tag)addr;
tag->addr = new; tag->size = size;
TreeInit(TagTree(tag));
@@ -585,8 +589,7 @@ static void tagFree(PoolDebugMixin debug, Pool pool, Addr old, Size size)
* Eventually, tag init args will need to be handled somewhere here.
*/
-static Res DebugPoolAlloc(Addr *aReturn,
- Pool pool, Size size, Bool withReservoir)
+static Res DebugPoolAlloc(Addr *aReturn, Pool pool, Size size)
{
Res res;
Addr new = NULL; /* suppress "may be used uninitialized" warning */
@@ -595,20 +598,19 @@ static Res DebugPoolAlloc(Addr *aReturn,
AVER(aReturn != NULL);
AVERT(Pool, pool);
AVER(size > 0);
- AVERT(Bool, withReservoir);
debug = DebugPoolDebugMixin(pool);
AVER(debug != NULL);
AVERT(PoolDebugMixin, debug);
if (debug->fenceSize != 0)
- res = fenceAlloc(&new, debug, pool, size, withReservoir);
+ res = fenceAlloc(&new, debug, pool, size);
else
- res = freeCheckAlloc(&new, debug, pool, size, withReservoir);
+ res = freeCheckAlloc(&new, debug, pool, size);
if (res != ResOK)
return res;
/* Allocate object first, so it fits even when the tag doesn't. */
if (debug->tagInit != NULL) {
- res = tagAlloc(debug, pool, new, size, withReservoir);
+ res = tagAlloc(debug, pool, new, size);
if (res != ResOK)
goto tagFail;
}
@@ -737,7 +739,7 @@ void DebugPoolFreeCheck(Pool pool, Addr base, Addr limit)
AVERT(PoolDebugMixin, debug);
if (debug->freeSize != 0)
ASSERT(freeCheck(debug, pool, base, limit),
- "free space corrupted on release");
+ "free space corrupted on release"); /* */
}
}
@@ -771,19 +773,19 @@ void DebugPoolCheckFreeSpace(Pool pool)
/* PoolClassMixInDebug -- mix in the debug support for class init */
-void PoolClassMixInDebug(PoolClass class)
+void PoolClassMixInDebug(PoolClass klass)
{
- /* Can't check class because it's not initialized yet */
- class->init = DebugPoolInit;
- class->finish = DebugPoolFinish;
- class->alloc = DebugPoolAlloc;
- class->free = DebugPoolFree;
+ /* Can't check klass because it's not initialized yet */
+ klass->instClassStruct.finish = DebugPoolFinish;
+ klass->init = DebugPoolInit;
+ klass->alloc = DebugPoolAlloc;
+ klass->free = DebugPoolFree;
}
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/dbgpool.h b/mps/code/dbgpool.h
index e01d8c3b650..051582121b0 100644
--- a/mps/code/dbgpool.h
+++ b/mps/code/dbgpool.h
@@ -59,7 +59,7 @@ extern Bool PoolDebugOptionsCheck(PoolDebugOptions opt);
extern Bool PoolDebugMixinCheck(PoolDebugMixin dbg);
-extern void PoolClassMixInDebug(PoolClass class);
+extern void PoolClassMixInDebug(PoolClass klass);
extern void DebugPoolCheckFences(Pool pool);
extern void DebugPoolCheckFreeSpace(Pool pool);
diff --git a/mps/code/djbench.c b/mps/code/djbench.c
index fbc6dcabc1c..c417e6004c5 100644
--- a/mps/code/djbench.c
+++ b/mps/code/djbench.c
@@ -1,7 +1,7 @@
/* djbench.c -- "DJ" Benchmark on ANSI C library
*
* $Id$
- * Copyright 2013 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2013-2018 Ravenbrook Limited. See end of file for license.
*
* This is an allocation stress benchmark test for manual variable pools
* and also for stdlib malloc/free (for comparison).
@@ -232,17 +232,18 @@ static struct {
} pools[] = {
{"mvt", arena_wrap, dj_reserve, mps_class_mvt},
{"mvff", arena_wrap, dj_reserve, mps_class_mvff},
- {"mv", arena_wrap, dj_alloc, mps_class_mv},
- {"mvb", arena_wrap, dj_reserve, mps_class_mv}, /* mv with buffers */
+ {"mvffa", arena_wrap, dj_alloc, mps_class_mvff}, /* mvff with alloc */
{"an", wrap, dj_malloc, dummy_class},
};
/* Command-line driver */
-int main(int argc, char *argv[]) {
+int main(int argc, char *argv[])
+{
int ch;
unsigned i;
+ mps_bool_t seed_specified = FALSE;
seed = rnd_seed();
@@ -274,6 +275,7 @@ int main(int argc, char *argv[]) {
break;
case 'x':
seed = strtoul(optarg, NULL, 10);
+ seed_specified = TRUE;
break;
case 'z':
zoned = FALSE;
@@ -358,8 +360,10 @@ int main(int argc, char *argv[]) {
argc -= optind;
argv += optind;
- printf("seed: %lu\n", seed);
- (void)fflush(stdout);
+ if (!seed_specified) {
+ printf("seed: %lu\n", seed);
+ (void)fflush(stdout);
+ }
while (argc > 0) {
for (i = 0; i < NELEMS(pools); ++i)
@@ -381,7 +385,7 @@ int main(int argc, char *argv[]) {
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2013-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/event.c b/mps/code/event.c
index cf9d4e0a8b5..b8f12383b0e 100644
--- a/mps/code/event.c
+++ b/mps/code/event.c
@@ -1,19 +1,12 @@
/* event.c: EVENT LOGGING
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*
* .sources: mps.design.event
*
* TRANSGRESSIONS (rule.impl.trans)
*
- * .trans.ref: The reference counting used to destroy the mps_io object
- * isn't right.
- *
- * .trans.log: The log file will be re-created if the lifetimes of
- * arenas don't overlap, but shared if they do. mps_io_create cannot
- * be called twice, but EventInit avoids this anyway.
- *
* .trans.ifdef: This file should logically be split into two, event.c
* (which contains NOOP definitions, for general use) and eventdl.c, which
* is specific to the logging variety and actually does logging (maybe).
@@ -24,6 +17,7 @@
#include "mpm.h"
#include "event.h"
#include "mpsio.h"
+#include "lock.h"
SRCID(event, "$Id$");
@@ -34,7 +28,6 @@ SRCID(event, "$Id$");
static Bool eventInited = FALSE;
static Bool eventIOInited = FALSE;
static mps_io_t eventIO;
-static Count eventUserCount;
static Serial EventInternSerial;
/* Buffers in which events are recorded, from the top down. */
@@ -207,25 +200,26 @@ void EventInit(void)
AVER(EventBufferSIZE <= EventSizeMAX);
/* Only if this is the first call. */
- if(!eventInited) { /* See .trans.log */
- EventKind kind;
- for (kind = 0; kind < EventKindLIMIT; ++kind) {
- AVER(EventLast[kind] == NULL);
- AVER(EventWritten[kind] == NULL);
- EventLast[kind] = EventWritten[kind] = EventBuffer[kind] + EventBufferSIZE;
+ if (!eventInited) { /* See .trans.log */
+ LockClaimGlobalRecursive();
+ if (!eventInited) {
+ EventKind kind;
+ for (kind = 0; kind < EventKindLIMIT; ++kind) {
+ AVER(EventLast[kind] == NULL);
+ AVER(EventWritten[kind] == NULL);
+ EventLast[kind] = EventWritten[kind] = EventBuffer[kind] + EventBufferSIZE;
+ }
+ eventInited = TRUE;
+ EventKindControl = (Word)mps_lib_telemetry_control();
+ EventInternSerial = (Serial)1; /* 0 is reserved */
+ (void)EventInternString(MPSVersion()); /* emit version */
+ EVENT7(EventInit, EVENT_VERSION_MAJOR, EVENT_VERSION_MEDIAN,
+ EVENT_VERSION_MINOR, EventCodeMAX, EventNameMAX, MPS_WORD_WIDTH,
+ mps_clocks_per_sec());
+ /* flush these initial events to get the first ClockSync out. */
+ EventSync();
}
- eventUserCount = (Count)1;
- eventInited = TRUE;
- EventKindControl = (Word)mps_lib_telemetry_control();
- EventInternSerial = (Serial)1; /* 0 is reserved */
- (void)EventInternString(MPSVersion()); /* emit version */
- EVENT7(EventInit, EVENT_VERSION_MAJOR, EVENT_VERSION_MEDIAN,
- EVENT_VERSION_MINOR, EventCodeMAX, EventNameMAX, MPS_WORD_WIDTH,
- mps_clocks_per_sec());
- /* flush these initial events to get the first ClockSync out. */
- EventSync();
- } else {
- ++eventUserCount;
+ LockReleaseGlobalRecursive();
}
}
@@ -235,11 +229,8 @@ void EventInit(void)
void EventFinish(void)
{
AVER(eventInited);
- AVER(eventUserCount > 0);
EventSync();
-
- --eventUserCount;
}
@@ -518,7 +509,7 @@ Res EventWrite(Event event, mps_lib_FILE *stream)
}
-extern void EventDump(mps_lib_FILE *stream)
+void EventDump(mps_lib_FILE *stream)
{
UNUSED(stream);
}
@@ -529,7 +520,7 @@ extern void EventDump(mps_lib_FILE *stream)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 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 f121d684bc8..adacf12c548 100644
--- a/mps/code/eventdef.h
+++ b/mps/code/eventdef.h
@@ -1,7 +1,7 @@
/* -- Event Logging Definitions
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
*
* .source:
*
@@ -36,7 +36,7 @@
*/
#define EVENT_VERSION_MAJOR ((unsigned)1)
-#define EVENT_VERSION_MEDIAN ((unsigned)5)
+#define EVENT_VERSION_MEDIAN ((unsigned)7)
#define EVENT_VERSION_MINOR ((unsigned)0)
@@ -67,7 +67,7 @@
*/
#define EventNameMAX ((size_t)19)
-#define EventCodeMAX ((EventCode)0x0086)
+#define EventCodeMAX ((EventCode)0x0088)
#define EVENT_LIST(EVENT, X) \
/* 0123456789012345678 <- don't exceed without changing EventNameMAX */ \
@@ -93,8 +93,8 @@
EVENT(X, SegFree , 0x0014, TRUE, Seg) \
EVENT(X, PoolInit , 0x0015, TRUE, Pool) \
EVENT(X, PoolFinish , 0x0016, TRUE, Pool) \
- EVENT(X, PoolAlloc , 0x0017, TRUE, Object) \
- EVENT(X, PoolFree , 0x0018, TRUE, Object) \
+ EVENT(X, PoolAlloc , 0x0017, FALSE, Object) \
+ EVENT(X, PoolFree , 0x0018, FALSE, Object) \
EVENT(X, LandInit , 0x0019, TRUE, Pool) \
EVENT(X, Intern , 0x001a, TRUE, User) \
EVENT(X, Label , 0x001b, TRUE, User) \
@@ -138,7 +138,7 @@
EVENT(X, TraceScanSeg , 0x003C, TRUE, Seg) \
/* TraceScanSingleRef abuses kind, see .kind.abuse */ \
EVENT(X, TraceScanSingleRef , 0x003D, TRUE, Seg) \
- EVENT(X, TraceStatCondemn , 0x003E, TRUE, Trace) \
+ /* EVENT(X, TraceStatCondemn , 0x003E, TRUE, Trace) */ \
EVENT(X, TraceStatScan , 0x003F, TRUE, Trace) \
EVENT(X, TraceStatFix , 0x0040, TRUE, Trace) \
EVENT(X, TraceStatReclaim , 0x0041, TRUE, Trace) \
@@ -160,7 +160,7 @@
/* PoolPush/Pop go under Object, because they're user ops. */ \
/* EVENT(X, PoolPush , 0x0060, TRUE, Object) */ \
/* EVENT(X, PoolPop , 0x0061, TRUE, Object) */ \
- EVENT(X, ReservoirLimitSet , 0x0062, TRUE, Arena) \
+ /* EVENT(X, ReservoirLimitSet , 0x0062, TRUE, Arena) */ \
EVENT(X, CommitLimitSet , 0x0063, TRUE, Arena) \
EVENT(X, ArenaSetSpare , 0x0064, TRUE, Arena) \
EVENT(X, ArenaAlloc , 0x0065, TRUE, Arena) \
@@ -186,13 +186,15 @@
EVENT(X, ArenaSetEmergency , 0x0078, TRUE, Arena) \
EVENT(X, VMCompact , 0x0079, TRUE, Arena) \
EVENT(X, amcScanNailed , 0x0080, TRUE, Seg) \
- EVENT(X, AMCTraceEnd , 0x0081, TRUE, Trace) \
+ /* EVENT(X, AMCTraceEnd , 0x0081, TRUE, Trace) */ \
EVENT(X, TraceCreatePoolGen , 0x0082, TRUE, Trace) \
/* new events for performance analysis of large heaps. */ \
- EVENT(X, TraceCondemnZones , 0x0083, TRUE, Trace) \
+ /* EVENT(X, TraceCondemnZones , 0x0083, TRUE, Trace) */ \
EVENT(X, ArenaGenZoneAdd , 0x0084, TRUE, Arena) \
EVENT(X, ArenaUseFreeZone , 0x0085, TRUE, Arena) \
- /* EVENT(X, ArenaBlacklistZone , 0x0086, TRUE, Arena) */
+ /* EVENT(X, ArenaBlacklistZone , 0x0086, TRUE, Arena) */ \
+ EVENT(X, PauseTimeSet , 0x0087, TRUE, Arena) \
+ EVENT(X, TraceEndGen , 0x0088, TRUE, Trace)
/* Remember to update EventNameMAX and EventCodeMAX above!
@@ -442,15 +444,6 @@
PARAM(X, 2, P, arena) \
PARAM(X, 3, A, refIO)
-#define EVENT_TraceStatCondemn_PARAMS(PARAM, X) \
- PARAM(X, 0, P, trace) \
- PARAM(X, 1, W, condemned) \
- PARAM(X, 2, W, notCondemned) \
- PARAM(X, 3, W, foundation) \
- PARAM(X, 4, W, rate) \
- PARAM(X, 5, D, mortality) \
- PARAM(X, 6, D, finishingTime)
-
#define EVENT_TraceStatScan_PARAMS(PARAM, X) \
PARAM(X, 0, P, trace) \
PARAM(X, 1, W, rootScanCount) \
@@ -551,10 +544,6 @@
PARAM(X, 2, B, isMutator) \
PARAM(X, 3, U, rank)
-#define EVENT_ReservoirLimitSet_PARAMS(PARAM, X) \
- PARAM(X, 0, P, arena) \
- PARAM(X, 1, W, size)
-
#define EVENT_CommitLimitSet_PARAMS(PARAM, X) \
PARAM(X, 0, P, arena) \
PARAM(X, 1, W, limit) \
@@ -583,8 +572,7 @@
#define EVENT_SegMerge_PARAMS(PARAM, X) \
PARAM(X, 0, P, segLo) \
- PARAM(X, 1, P, segHi) \
- PARAM(X, 2, B, withReservoirPermit)
+ PARAM(X, 1, P, segHi)
#define EVENT_SegSplit_PARAMS(PARAM, X) \
PARAM(X, 0, P, seg) \
@@ -655,7 +643,7 @@
#define EVENT_ArenaPoll_PARAMS(PARAM, X) \
PARAM(X, 0, P, arena) \
PARAM(X, 1, W, start) \
- PARAM(X, 2, W, quanta)
+ PARAM(X, 2, B, workWasDone)
#define EVENT_ArenaSetEmergency_PARAMS(PARAM, X) \
PARAM(X, 0, P, arena) \
@@ -674,7 +662,7 @@
PARAM(X, 4, W, notCondemned) /* collectible but not condemned bytes */ \
PARAM(X, 5, W, foundation) /* foundation size */ \
PARAM(X, 6, W, white) /* white reference set */ \
- PARAM(X, 7, W, rate) /* segs to scan per increment */
+ PARAM(X, 7, W, quantumWork) /* tracing work to be done in each poll */
#define EVENT_VMCompact_PARAMS(PARAM, X) \
PARAM(X, 0, W, vmem0) /* pre-collection reserved size */ \
@@ -689,30 +677,6 @@
PARAM(X, 4, W, fixed) /* scan state fixed summary */ \
PARAM(X, 5, W, refset) /* scan state refset */
-#define EVENT_AMCTraceEnd_PARAMS(PARAM, X) \
- PARAM(X, 0, W, epoch) /* current arena epoch */ \
- PARAM(X, 1, U, why) /* reason trace started */ \
- PARAM(X, 2, W, grainSize) /* arena grain size */ \
- PARAM(X, 3, W, large) /* AMC large size */ \
- PARAM(X, 4, W, pRetMin) /* threshold for event */ \
- /* remaining parameters are copy of PageRetStruct, which see */ \
- PARAM(X, 5, W, pCond) \
- PARAM(X, 6, W, pRet) \
- PARAM(X, 7, W, pCS) \
- PARAM(X, 8, W, pRS) \
- PARAM(X, 9, W, sCM) \
- PARAM(X, 10, W, pCM) \
- PARAM(X, 11, W, sRM) \
- PARAM(X, 12, W, pRM) \
- PARAM(X, 13, W, pRM1) \
- PARAM(X, 14, W, pRMrr) \
- PARAM(X, 15, W, pRMr1) \
- PARAM(X, 16, W, sCL) \
- PARAM(X, 17, W, pCL) \
- PARAM(X, 18, W, sRL) \
- PARAM(X, 19, W, pRL) \
- PARAM(X, 20, W, pRLr)
-
#define EVENT_TraceCreatePoolGen_PARAMS(PARAM, X) \
PARAM(X, 0, P, gendesc) /* generation description */ \
PARAM(X, 1, W, capacity) /* capacity of generation */ \
@@ -726,11 +690,6 @@
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 */ \
- PARAM(X, 1, W, condemnedSet) /* the condemned zoneSet */ \
- PARAM(X, 2, W, white) /* the trace's white zoneSet */
-
#define EVENT_ArenaGenZoneAdd_PARAMS(PARAM, X) \
PARAM(X, 0, P, arena) /* the arena */ \
PARAM(X, 1, P, gendesc) /* the generation description */ \
@@ -740,12 +699,24 @@
PARAM(X, 0, P, arena) /* the arena */ \
PARAM(X, 1, W, zoneSet) /* zones that aren't free any longer */
+#define EVENT_PauseTimeSet_PARAMS(PARAM, X) \
+ PARAM(X, 0, P, arena) /* the arena */ \
+ PARAM(X, 1, D, pauseTime) /* the new maximum pause time, in seconds */
+
+#define EVENT_TraceEndGen_PARAMS(PARAM, X) \
+ PARAM(X, 0, P, trace) /* the trace */ \
+ PARAM(X, 1, P, gen) /* the generation */ \
+ PARAM(X, 2, W, condemned) /* bytes condemned in generation */ \
+ PARAM(X, 3, W, forwarded) /* bytes forwarded from generation */ \
+ PARAM(X, 4, W, preservedInPlace) /* bytes preserved in generation */ \
+ PARAM(X, 5, D, mortality) /* updated mortality */
+
#endif /* eventdef_h */
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/eventpy.c b/mps/code/eventpy.c
new file mode 100644
index 00000000000..feac0efefb5
--- /dev/null
+++ b/mps/code/eventpy.c
@@ -0,0 +1,103 @@
+/* eventpy.c: GENERATE PYTHON INTERFACE TO EVENTS
+ *
+ * $Id$
+ * Copyright (c) 2016-2018 Ravenbrook Limited. See end of file for license.
+ *
+ * This command-line program emits Python data structures that can be
+ * used to parse an event stream in text format (as output by the
+ * mpseventcnv program).
+ */
+
+#include /* printf, puts */
+
+#include "event.h"
+
+int main(int argc, char *argv[])
+{
+ UNUSED(argc);
+ UNUSED(argv);
+
+ puts("from collections import namedtuple");
+
+ printf("__version__ = %d, %d, %d\n", EVENT_VERSION_MAJOR,
+ EVENT_VERSION_MEDIAN, EVENT_VERSION_MINOR);
+
+ puts("KindDesc = namedtuple('KindDesc', 'name code doc')");
+ puts("class Kind:");
+#define ENUM(_, NAME, DOC) \
+ printf(" " #NAME " = KindDesc('" #NAME "', %d, \"%s\")\n", \
+ EventKind ## NAME, DOC);
+ EventKindENUM(ENUM, _);
+#undef ENUM
+
+ puts("KIND = {");
+#define ENUM(_, NAME, _1) \
+ printf(" %d: Kind." #NAME ",\n", EventKind ## NAME);
+ EventKindENUM(ENUM, _);
+#undef ENUM
+ puts("}");
+
+ puts("EventParam = namedtuple('EventParam', 'sort name')");
+ puts("EventDesc = namedtuple('EventDesc', 'name code always kind params')");
+ puts("class Event:");
+#define EVENT_PARAM(X, INDEX, SORT, NAME) \
+ puts(" EventParam('" #SORT "', '" #NAME "'),");
+#define EVENT_DEFINE(X, NAME, CODE, ALWAYS, KIND) \
+ printf(" " #NAME " = EventDesc('" #NAME "', %d, %s, Kind." #KIND ", [\n", \
+ CODE, ALWAYS ? "True" : "False"); \
+ EVENT_ ## NAME ## _PARAMS(EVENT_PARAM, X); \
+ puts(" ])");
+ EVENT_LIST(EVENT_DEFINE, 0);
+#undef EVENT
+
+ puts("EVENT = {");
+#define EVENT_ITEM(X, NAME, CODE, ALWAYS, KIND) \
+ printf(" %d: Event." #NAME ",\n", CODE);
+ EVENT_LIST(EVENT_ITEM, 0);
+#undef EVENT
+ puts("}");
+
+ return 0;
+}
+
+
+/* C. COPYRIGHT AND LICENSE
+ *
+ * Copyright (c) 2016-2018 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/eventrep.c b/mps/code/eventrep.c
deleted file mode 100644
index c363010bea7..00000000000
--- a/mps/code/eventrep.c
+++ /dev/null
@@ -1,693 +0,0 @@
-/* eventrep.c: Allocation replayer routines
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
- *
- * $Id$
- */
-
-#include "config.h"
-/* override variety setting for EVENT */
-#define EVENT
-
-#include "eventcom.h"
-#include "eventrep.h"
-#include "eventpro.h"
-#include "mpmtypes.h"
-
-#include "mps.h"
-#include "mpsavm.h"
-#include "mpsacl.h"
-#include "mpscmv.h"
-#include "mpscmvff.h"
-#include "mpscepvm.h"
-#include "fmtpstst.h"
-#include "mpscepdl.h"
-
-#include "table.h"
-
-#include /* for size_t */
-#include /* for va_list */
-#include /* for EXIT_FAILURE */
-#include /* for printf */
-#include "mpstd.h"
-
-
-#if defined(MPS_OS_W3) && defined(MPS_ARCH_I6)
-#define PRIuLONGEST "llu"
-#define PRIXPTR "016llX"
-typedef unsigned long long ulongest_t;
-#else
-#define PRIuLONGEST "lu"
-#define PRIXPTR "08lX"
-typedef unsigned long ulongest_t;
-#endif
-
-
-typedef unsigned long ulong;
-
-
-/* Globals */
-
-static ulong totalEvents; /* count of events */
-static ulong discardedEvents; /* count of ignored events */
-static ulong unknownEvents; /* count of unknown events */
-
-static Word eventTime;
-
-/* Dictionaries for translating from log to replay values */
-static Table arenaTable; /* dictionary of arenas */
-static Table poolTable; /* dictionary of poolReps */
-static Table apTable; /* dictionary of apReps */
-
-
-/* poolSupport -- describes pool support for explicit deallocation */
-
-enum {supportTruncate = 1, supportFree, supportNothing};
-typedef int poolSupport;
-
-
-/* objectTable -- object address mapping structure
- *
- * .obj-mapping.truncate: Pools that support truncate need to keep track
- * of object end points as well. .obj-mapping.partial-free: Arbitrary
- * partial free is not supported.
- */
-
-typedef struct objectTableStruct {
- Table startTable;
- Table endTable;
-} objectTableStruct;
-typedef struct objectTableStruct *objectTable;
-
-
-/* poolRep -- pool tracking structure
- *
- * .pool.object-addr: Pools that support explicit free (or truncate)
- * need to maintain a mapping from the addresses in the log to those in
- * the replay.
- *
- * .bufclass: In order to create APs with the correct arguments, the
- * replayer has to pick the right BufferInit event to use, as there's
- * one for each superclass. The pool determines the buffer class, so
- * we store its subclass level in the pool representation.
- */
-
-typedef struct poolRepStruct {
- mps_pool_t pool; /* the replay pool */
- objectTable objects;
- int bufferClassLevel; /* subclass level of the buffer class */
-} poolRepStruct;
-typedef struct poolRepStruct *poolRep;
-
-
-/* apRep -- ap tracking structure */
-
-typedef struct apRepStruct {
- mps_ap_t ap; /* the replay ap */
- objectTable objects; /* object mapping for the pool of this ap */
-} apRepStruct;
-typedef struct apRepStruct *apRep;
-
-
-/* PointerAdd -- add offset to pointer */
-
-#define PointerAdd(p, s) ((void *)((char *)(p) + (s)))
-#define PointerSub(p, s) ((void *)((char *)(p) - (s)))
-
-
-/* error -- error signalling */
-
-ATTRIBUTE_FORMAT((printf, 1, 2))
-static void error(const char *format, ...)
-{
- va_list args;
-
- fflush(stdout); /* sync */
- fprintf(stderr, "Failed @%"PRIuLONGEST" ", (ulongest_t)eventTime);
- va_start(args, format);
- vfprintf(stderr, format, args);
- fprintf(stderr, "\n");
- va_end(args);
- exit(EXIT_FAILURE);
-}
-
-
-/* verify, verifyMPS -- check return values
- *
- * We don't use assert for this, because we want it in release as well.
- */
-
-#define verifyMPS(res) \
- MPS_BEGIN if ((res) != MPS_RES_OK) error("line %d MPS", __LINE__); MPS_END
-
-#define verify(cond) \
- MPS_BEGIN if (!(cond)) error("line %d " #cond, __LINE__); MPS_END
-
-
-/* objectTableCreate -- create an objectTable */
-
-static objectTable objectTableCreate(poolSupport support)
-{
- if (support != supportNothing) {
- Res ires;
- objectTable table;
-
- table = malloc(sizeof(objectTableStruct));
- verify(table != NULL);
- ires = TableCreate(&table->startTable, (size_t)1<<12);
- verify(ires == ResOK);
- if (support == supportTruncate) {
- ires = TableCreate(&table->endTable, (size_t)1<<12);
- verify(ires == ResOK);
- } else {
- table->endTable = NULL;
- }
- return table;
- } else {
- return NULL;
- }
-}
-
-
-/* objectTableDestroy -- destroy an objectTable */
-
-static void objectTableDestroy(objectTable table)
-{
- if (table != NULL) {
- TableDestroy(table->startTable);
- if (table->endTable != NULL)
- TableDestroy(table->endTable);
- free(table);
- }
-}
-
-
-/* objDefine -- add a new mapping to an objectTable */
-
-static void objDefine(objectTable table,
- void *logObj, void *obj, size_t size)
-{
- if (table != NULL) {
- Res ires;
-
- ires = TableDefine(table->startTable, (TableKey)logObj, obj);
- verify(ires == ResOK);
- if (table->endTable != NULL) {
- ires = TableDefine(table->endTable,
- (TableKey)PointerAdd(logObj, size),
- PointerAdd(obj, size));
- verify(ires == ResOK);
- }
- }
-}
-
-
-/* objRemove -- look up and remove a mapping in an objectTable */
-
-static void objRemove(void **objReturn, objectTable table,
- void *logObj, size_t size)
-{
- Bool found;
- Res ires;
- void *obj;
- void *end;
- void *logEnd;
-
- found = TableLookup(&obj, table->startTable, (TableKey)logObj);
- if (found) {
- ires = TableRemove(table->startTable, (TableKey)logObj);
- verify(ires == ResOK);
- if (table->endTable != NULL) {
- ires = TableRemove(table->endTable,
- (TableKey)PointerAdd(logObj, size));
- verify(ires == ResOK);
- }
- *objReturn = obj;
- return;
- }
- /* Must be a truncation. */
- verify(table->endTable != NULL);
- logEnd = PointerAdd(logObj, size);
- found = TableLookup(&end, table->endTable, (TableKey)logEnd);
- verify(found);
- obj = PointerSub(end, size);
- /* Remove the old end and insert the new one. */
- ires = TableRemove(table->endTable, (TableKey)logEnd);
- verify(ires == ResOK);
- ires = TableDefine(table->endTable, (TableKey)logObj, obj);
- verify(ires == ResOK);
- *objReturn = obj;
- return;
-}
-
-
-/* poolRecreate -- create and record a pool */
-
-static void poolRecreate(void *logPool, void *logArena,
- mps_pool_class_t pool_class,
- poolSupport support, int bufferClassLevel, ...)
-{
- va_list args;
- mps_pool_t pool;
- mps_res_t eres;
- poolRep rep;
- Res ires;
- void *entry;
- Bool found;
-
- found = TableLookup(&entry, arenaTable, (TableKey)logArena);
- verify(found);
- va_start(args, bufferClassLevel);
- eres = mps_pool_create_v(&pool, (mps_arena_t)entry, class, args);
- verifyMPS(eres);
- va_end(args);
- rep = malloc(sizeof(poolRepStruct));
- verify(rep != NULL);
- rep->pool = pool;
- rep->objects = objectTableCreate(support);
- rep->bufferClassLevel = bufferClassLevel;
- ires = TableDefine(poolTable, (TableKey)logPool, (void *)rep);
- verify(ires == ResOK);
-}
-
-
-/* poolRedestroy -- destroy and derecord a pool */
-
-static void poolRedestroy(void *logPool)
-{
- Res ires;
- void *entry;
- Bool found;
- poolRep rep;
-
- found = TableLookup(&entry, poolTable, (TableKey)logPool);
- verify(found);
- rep = (poolRep)entry;
- mps_pool_destroy(rep->pool);
- ires = TableRemove(poolTable, (TableKey)logPool);
- verify(ires == ResOK);
- objectTableDestroy(rep->objects);
- free(rep);
-}
-
-
-/* apRecreate -- create and record an ap */
-
-static void apRecreate(void *logAp, void *logPool, ...)
-{
- va_list args;
- mps_ap_t ap;
- poolRep pRep;
- apRep aRep;
- mps_res_t eres;
- Res ires;
- void *entry;
- Bool found;
-
- found = TableLookup(&entry, poolTable, (TableKey)logPool);
- verify(found);
- pRep = (poolRep)entry;
- va_start(args, logPool);
- eres = mps_ap_create_v(&ap, pRep->pool, args);
- verifyMPS(eres);
- va_end(args);
- aRep = malloc(sizeof(apRepStruct));
- verify(aRep != NULL);
- aRep->ap = ap;
- aRep->objects = pRep->objects;
- ires = TableDefine(apTable, (TableKey)logAp, (void *)aRep);
- verify(ires == ResOK);
-}
-
-
-/* apRedestroy -- destroy and derecord an ap */
-
-static void apRedestroy(void *logAp)
-{
- Res ires;
- void *entry;
- Bool found;
- apRep rep;
-
- found = TableLookup(&entry, apTable, (TableKey)logAp);
- verify(found);
- rep = (apRep)entry;
- mps_ap_destroy(rep->ap);
- ires = TableRemove(apTable, (TableKey)logAp);
- verify(ires == ResOK);
- free(rep);
-}
-
-
-/* EventReplay -- replay event */
-
-static arenaJustCreated = FALSE;
-
-void EventReplay(Event event, Word etime)
-{
- mps_res_t eres;
- Res ires;
- Bool found;
- void *entry;
-
- ++totalEvents;
- eventTime = etime;
- switch(event->any.code) {
- case EventArenaCreateVM: { /* arena, userSize, chunkSize */
- mps_arena_t arena;
-
- eres = mps_arena_create(&arena, mps_arena_class_vm(),
- event->pww.w1);
- verifyMPS(eres);
- ires = TableDefine(arenaTable, (TableKey)event->pww.p0, (void *)arena);
- verify(ires == ResOK);
- arenaJustCreated = TRUE;
- } break;
- case EventArenaCreateVMNZ: { /* arena, userSize, chunkSize */
- mps_arena_t arena;
-
- eres = mps_arena_create(&arena, mps_arena_class_vmnz(),
- event->pww.w1);
- verifyMPS(eres);
- ires = TableDefine(arenaTable, (TableKey)event->pww.p0, (void *)arena);
- verify(ires == ResOK);
- arenaJustCreated = TRUE;
- } break;
- case EventArenaCreateCL: { /* arena, size, base */
- mps_arena_t arena;
- void *base;
-
- base = malloc((size_t)event->pwa.w1);
- verify(base != NULL);
- eres = mps_arena_create(&arena, mps_arena_class_cl(),
- (Size)event->pwa.w1, base);
- verifyMPS(eres);
- ires = TableDefine(arenaTable, (TableKey)event->pw.p0, (void *)arena);
- verify(ires == ResOK);
- arenaJustCreated = TRUE;
- } break;
- case EventArenaDestroy: { /* arena */
- found = TableLookup(&entry, arenaTable, (TableKey)event->p.p0);
- verify(found);
- mps_arena_destroy((mps_arena_t)entry);
- ires = TableRemove(arenaTable, (TableKey)event->pw.p0);
- verify(ires == ResOK);
- } break;
- case EventPoolInitMVFF: {
- /* pool, arena, extendBy, avgSize, align, slotHigh, arenaHigh, firstFit */
- poolRecreate(event->ppwwwuuu.p0, event->ppwwwuuu.p1,
- mps_class_mvff(), supportFree, 0,
- (size_t)event->ppwwwuuu.w2,
- (size_t)event->ppwwwuuu.w3,
- (size_t)event->ppwwwuuu.w4,
- (mps_bool_t)event->ppwwwuuu.u5,
- (mps_bool_t)event->ppwwwuuu.u6,
- (mps_bool_t)event->ppwwwuuu.u7);
- } break;
- case EventPoolInitMV: { /* pool, arena, extendBy, avgSize, maxSize */
- /* .pool.control: The control pool will get created just after */
- /* its arena; ignore it. */
- if (!arenaJustCreated) {
- poolRecreate(event->ppwww.p0, event->ppwww.p1,
- mps_class_mv(), supportFree, 0, (size_t)event->ppwww.w2,
- (size_t)event->ppwww.w3, (size_t)event->ppwww.w4);
- } else {
- arenaJustCreated = FALSE;
- }
- } break;
- case EventPoolInitMFS: { /* pool, arena, extendBy, unitSize */
- /* internal only */
- ++discardedEvents;
- } break;
- case EventPoolInit: { /* pool, arena, class */
- /* all internal only */
- ++discardedEvents;
- } break;
- case EventPoolFinish: { /* pool */
- found = TableLookup(&entry, poolTable, (TableKey)event->p.p0);
- if (found) {
- poolRedestroy(event->p.p0);
- } else {
- ++discardedEvents;
- }
- } break;
- case EventBufferInit: { /* buffer, pool, isMutator */
- if ((Bool)event->ppu.u2) {
- found = TableLookup(&entry, poolTable, (TableKey)event->ppu.p1);
- if (found) {
- poolRep rep = (poolRep)entry;
-
- if(rep->bufferClassLevel == 0) { /* see .bufclass */
- apRecreate(event->ppu.p0, event->ppu.p1);
- } else {
- ++discardedEvents;
- }
- } else {
- ++discardedEvents;
- }
- } else {
- ++discardedEvents;
- }
- } break;
- case EventBufferInitSeg: { /* buffer, pool, isMutator */
- if ((Bool)event->ppu.u2) {
- found = TableLookup(&entry, poolTable, (TableKey)event->ppu.p1);
- if (found) {
- poolRep rep = (poolRep)entry;
-
- if(rep->bufferClassLevel == 1) { /* see .bufclass */
- apRecreate(event->ppu.p0, event->ppu.p1);
- } else {
- ++discardedEvents;
- }
- } else {
- ++discardedEvents;
- }
- } else {
- ++discardedEvents;
- }
- } break;
- case EventBufferInitRank: { /* buffer, pool, isMutator, rank */
- if ((Bool)event->ppuu.u2) {
- found = TableLookup(&entry, poolTable, (TableKey)event->ppuu.p1);
- if (found) {
- poolRep rep = (poolRep)entry;
-
- if(rep->bufferClassLevel == 2) { /* see .bufclass */
- apRecreate(event->ppuu.p0, event->ppuu.p1, event->ppuu.u3);
- } else {
- ++discardedEvents;
- }
- } else {
- ++discardedEvents;
- }
- } else {
- ++discardedEvents;
- }
- } break;
- case EventBufferFinish: { /* buffer */
- found = TableLookup(&entry, apTable, (TableKey)event->p.p0);
- if (found) {
- apRedestroy(event->p.p0);
- } else {
- ++discardedEvents;
- }
- } break;
- case EventBufferReserve: { /* buffer, init, size */
- found = TableLookup(&entry, apTable, (TableKey)event->paw.p0);
- if (found) {
- apRep rep = (apRep)entry;
- mps_addr_t p;
-
- eres = mps_reserve(&p, rep->ap, (size_t)event->paw.w2);
- verifyMPS(eres);
- } else {
- ++discardedEvents;
- }
- } break;
- case EventBufferCommit: { /* buffer, p, size, clientClass */
- found = TableLookup(&entry, apTable, (TableKey)event->pawa.p0);
- if (found) {
- apRep rep = (apRep)entry;
- mps_addr_t obj = rep->ap->init;
- mps_bool_t committed;
- size_t size = (size_t)event->pawa.w2;
-
- committed = mps_commit(rep->ap, obj, size);
- verifyMPS(committed ? MPS_RES_OK : MPS_RES_FAIL);
- objDefine(rep->objects, event->pawa.a1, obj, size);
- } else {
- ++discardedEvents;
- }
- } break;
- case EventPoolAlloc: { /* pool, obj, size */
- found = TableLookup(&entry, poolTable, (TableKey)event->paw.p0);
- if (found) {
- poolRep rep = (poolRep)entry;
- void *obj;
- size_t size = (size_t)event->paw.w2;
-
- eres = mps_alloc(&obj, rep->pool, size);
- verifyMPS(eres);
- objDefine(rep->objects, event->paw.a1, obj, size);
- } else {
- ++discardedEvents;
- }
- } break;
- case EventPoolFree: { /* pool, obj, size */
- found = TableLookup(&entry, poolTable, (TableKey)event->paw.p0);
- if (found) {
- poolRep rep = (poolRep)entry;
- void *obj;
- size_t size = (size_t)event->paw.w2;
-
- objRemove(&obj, rep->objects, event->paw.a1, size);
- mps_free(rep->pool, obj, size);
- } else {
- ++discardedEvents;
- }
- } break;
- case EventCommitLimitSet: { /* arena, limit, succeeded */
- found = TableLookup(&entry, arenaTable, (TableKey)event->pwu.p0);
- verify(found);
- eres = mps_arena_commit_limit_set((mps_arena_t)entry,
- (size_t)event->pwu.w1);
- verifyMPS(((Bool)event->pwu.u2 == (eres == MPS_RES_OK))
- ? MPS_RES_OK : MPS_RES_FAIL);
- } break;
- case EventSetSpare: { /* arena, spare */
- found = TableLookup(&entry, arenaTable, (TableKey)event->pd.p0);
- verify(found);
- mps_arena_spare_set((mps_arena_t)entry, event->pd.d1);
- } break;
- case EventReservoirLimitSet: { /* arena, limit */
- found = TableLookup(&entry, arenaTable, (TableKey)event->pw.p0);
- verify(found);
- mps_reservoir_limit_set((mps_arena_t)entry, (size_t)event->pw.w1);
- } break;
- case EventVMMap: case EventVMUnmap:
- case EventVMInit: case EventVMFinish:
- case EventArenaWriteFaults:
- case EventArenaAlloc: case EventArenaAllocFail: case EventArenaFree:
- case EventSegAlloc: case EventSegAllocFail: case EventSegFree:
- case EventSegMerge: case EventSegSplit:
- case EventBufferFill: case EventBufferEmpty:
- case EventCBSInit: case EventMeterInit: case EventMeterValues:
- case EventIntern: case EventLabel: {
- ++discardedEvents;
- } break;
- default: {
- ++unknownEvents;
- if (unknownEvents < 12) /* don't output too much */
- printf("Unknown event @%ld: %s.\n", etime,
- EventCode2Name(EventGetCode(event)));
- } break;
- }
-}
-
-
-/* Checking macros, copied from check.h */
-
-#define COMPATLVALUE(lv1, lv2) \
- ((void)sizeof((lv1) = (lv2)), (void)sizeof((lv2) = (lv1)), TRUE)
-
-#define COMPATTYPE(t1, t2) \
- (sizeof(t1) == sizeof(t2) && \
- COMPATLVALUE(*((t1 *)0), *((t2 *)0)))
-
-
-/* CHECKCONV -- check t2 can be cast to t1 without loss */
-
-#define CHECKCONV(t1, t2) \
- (sizeof(t1) >= sizeof(t2))
-
-
-/* EventRepInit -- initialize the module */
-
-Res EventRepInit(void)
-{
- Res res;
-
- /* Check using pointers as keys in the tables. */
- verify(CHECKCONV(Word, void *));
- /* Check storage of MPS opaque handles in the tables. */
- verify(COMPATTYPE(mps_arena_t, void *));
- verify(COMPATTYPE(mps_ap_t, void *));
- /* .event-conv: Conversion of event fields into the types required */
- /* by the MPS functions is justified by the reverse conversion */
- /* being acceptable (which is upto the event log generator). */
-
- totalEvents = 0; discardedEvents = 0; unknownEvents = 0;
-
- res = TableCreate(&arenaTable, (size_t)1);
- if (res != ResOK)
- goto failArena;
- res = TableCreate(&poolTable, (size_t)1<<4);
- if (res != ResOK)
- goto failPool;
- res = TableCreate(&apTable, (size_t)1<<6);
- if (res != ResOK)
- goto failAp;
-
- return ResOK;
-
-failAp:
- TableDestroy(poolTable);
-failPool:
- TableDestroy(arenaTable);
-failArena:
- return res;
-}
-
-
-/* EventRepFinish -- finish the module */
-
-void EventRepFinish(void)
-{
- /* @@@@ add listing of remaining objects? */
- /* No point in cleaning up the tables, since we're quitting. */
- printf("Replayed %lu and discarded %lu events (%lu unknown).\n",
- totalEvents - discardedEvents - unknownEvents,
- discardedEvents + unknownEvents, unknownEvents);
-}
-
-
-/* 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/failover.c b/mps/code/failover.c
index 750c6b1b17b..86d1b193411 100644
--- a/mps/code/failover.c
+++ b/mps/code/failover.c
@@ -4,6 +4,11 @@
* Copyright (c) 2014 Ravenbrook Limited. See end of file for license.
*
* .design:
+ *
+ * .critical: In manual-allocation-bound programs using MVFF, many of
+ * these functions are on the critical paths via mps_alloc (and then
+ * PoolAlloc, MVFFAlloc, failoverFind*) and mps_free (and then
+ * MVFFFree, failoverInsert).
*/
#include "failover.h"
@@ -13,9 +18,6 @@
SRCID(failover, "$Id$");
-#define failoverOfLand(land) PARENT(FailoverStruct, landStruct, land)
-
-
ARG_DEFINE_KEY(failover_primary, Pointer);
ARG_DEFINE_KEY(failover_secondary, Pointer);
@@ -30,68 +32,54 @@ Bool FailoverCheck(Failover fo)
}
-static Res failoverInit(Land land, ArgList args)
+static Res failoverInit(Land land, Arena arena, Align alignment, 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);
+ AVER(land != NULL);
+ res = NextMethod(Land, Failover, init)(land, arena, alignment, args);
if (res != ResOK)
return res;
+ fo = CouldBeA(Failover, land);
ArgRequire(&arg, args, FailoverPrimary);
- primary = arg.val.p;
+ fo->primary = arg.val.p;
ArgRequire(&arg, args, FailoverSecondary);
- secondary = arg.val.p;
+ fo->secondary = arg.val.p;
- fo = failoverOfLand(land);
- fo->primary = primary;
- fo->secondary = secondary;
+ SetClassOfPoly(land, CLASS(Failover));
fo->sig = FailoverSig;
- AVERT(Failover, fo);
+ AVERC(Failover, fo);
+
return ResOK;
}
-static void failoverFinish(Land land)
+static void failoverFinish(Inst inst)
{
- Failover fo;
-
- AVERT(Land, land);
- fo = failoverOfLand(land);
- AVERT(Failover, fo);
-
+ Land land = MustBeA(Land, inst);
+ Failover fo = MustBeA(Failover, land);
fo->sig = SigInvalid;
+ NextMethod(Inst, Failover, finish)(inst);
}
static Size failoverSize(Land land)
{
- Failover fo;
-
- AVERT(Land, land);
- fo = failoverOfLand(land);
- AVERT(Failover, fo);
-
+ Failover fo = MustBeA_CRITICAL(Failover, land);
return LandSize(fo->primary) + LandSize(fo->secondary);
}
static Res failoverInsert(Range rangeReturn, Land land, Range range)
{
- Failover fo;
+ Failover fo = MustBeA_CRITICAL(Failover, land);
Res res;
- AVER(rangeReturn != NULL);
- AVERT(Land, land);
- fo = failoverOfLand(land);
- AVERT(Failover, fo);
- AVERT(Range, range);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVERT_CRITICAL(Range, range);
/* Provide more opportunities for coalescence. See
* .
@@ -108,14 +96,11 @@ static Res failoverInsert(Range rangeReturn, Land land, Range range)
static Res failoverDelete(Range rangeReturn, Land land, Range range)
{
- Failover fo;
+ Failover fo = MustBeA(Failover, land);
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
@@ -170,37 +155,31 @@ static Res failoverDelete(Range rangeReturn, Land land, Range range)
}
}
if (res == ResOK) {
- AVER(RangesNest(&oldRange, range));
+ AVER_CRITICAL(RangesNest(&oldRange, range));
RangeCopy(rangeReturn, &oldRange);
}
return res;
}
-static Bool failoverIterate(Land land, LandVisitor visitor, void *closureP, Size closureS)
+static Bool failoverIterate(Land land, LandVisitor visitor, void *closure)
{
- Failover fo;
+ Failover fo = MustBeA(Failover, land);
- 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);
+ return LandIterate(fo->primary, visitor, closure)
+ && LandIterate(fo->secondary, visitor, closure);
}
static Bool failoverFindFirst(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
{
- Failover fo;
+ Failover fo = MustBeA_CRITICAL(Failover, land);
- AVER(rangeReturn != NULL);
- AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
- fo = failoverOfLand(land);
- AVERT(Failover, fo);
- AVERT(FindDelete, findDelete);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVER_CRITICAL(oldRangeReturn != NULL);
+ AVERT_CRITICAL(FindDelete, findDelete);
/* See . */
(void)LandFlush(fo->primary, fo->secondary);
@@ -212,14 +191,11 @@ static Bool failoverFindFirst(Range rangeReturn, Range oldRangeReturn, Land land
static Bool failoverFindLast(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
{
- Failover fo;
+ Failover fo = MustBeA_CRITICAL(Failover, land);
- AVER(rangeReturn != NULL);
- AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
- fo = failoverOfLand(land);
- AVERT(Failover, fo);
- AVERT(FindDelete, findDelete);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVER_CRITICAL(oldRangeReturn != NULL);
+ AVERT_CRITICAL(FindDelete, findDelete);
/* See . */
(void)LandFlush(fo->primary, fo->secondary);
@@ -231,14 +207,11 @@ static Bool failoverFindLast(Range rangeReturn, Range oldRangeReturn, Land land,
static Bool failoverFindLargest(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
{
- Failover fo;
+ Failover fo = MustBeA_CRITICAL(Failover, land);
- AVER(rangeReturn != NULL);
- AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
- fo = failoverOfLand(land);
- AVERT(Failover, fo);
- AVERT(FindDelete, findDelete);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVER_CRITICAL(oldRangeReturn != NULL);
+ AVERT_CRITICAL(FindDelete, findDelete);
/* See . */
(void)LandFlush(fo->primary, fo->secondary);
@@ -250,19 +223,16 @@ static Bool failoverFindLargest(Range rangeReturn, Range oldRangeReturn, Land la
static Bool failoverFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high)
{
- Failover fo;
+ Failover fo = MustBeA_CRITICAL(Failover, land);
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);
+ AVER_CRITICAL(FALSE); /* TODO: this code is completely untested! */
+ AVER_CRITICAL(foundReturn != NULL);
+ AVER_CRITICAL(rangeReturn != NULL);
+ AVER_CRITICAL(oldRangeReturn != NULL);
+ /* AVERT_CRITICAL(ZoneSet, zoneSet); */
+ AVERT_CRITICAL(Bool, high);
/* See . */
(void)LandFlush(fo->primary, fo->secondary);
@@ -276,48 +246,52 @@ static Bool failoverFindInZones(Bool *foundReturn, Range rangeReturn, Range oldR
}
-static Res failoverDescribe(Land land, mps_lib_FILE *stream, Count depth)
+static Res failoverDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
{
- Failover fo;
+ Land land = CouldBeA(Land, inst);
+ Failover fo = CouldBeA(Failover, land);
+ LandClass primaryClass, secondaryClass;
Res res;
- if (!TESTT(Land, land))
- return ResFAIL;
- fo = failoverOfLand(land);
- if (!TESTT(Failover, fo))
- return ResFAIL;
+ if (!TESTC(Failover, fo))
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
+ return ResPARAM;
- res = WriteF(stream, depth,
- "Failover $P {\n", (WriteFP)fo,
- " primary = $P ($S)\n", (WriteFP)fo->primary,
- (WriteFS)fo->primary->class->name,
- " secondary = $P ($S)\n", (WriteFP)fo->secondary,
- (WriteFS)fo->secondary->class->name,
- "}\n", NULL);
+ res = NextMethod(Inst, Failover, describe)(inst, stream, depth);
+ if (res != ResOK)
+ return res;
- return res;
+ primaryClass = ClassOfPoly(Land, fo->primary);
+ secondaryClass = ClassOfPoly(Land, fo->secondary);
+
+ return WriteF(stream, depth + 2,
+ "primary = $P ($S)\n",
+ (WriteFP)fo->primary,
+ (WriteFS)ClassName(primaryClass),
+ "secondary = $P ($S)\n",
+ (WriteFP)fo->secondary,
+ (WriteFS)ClassName(secondaryClass),
+ NULL);
}
-DEFINE_LAND_CLASS(FailoverLandClass, class)
+DEFINE_CLASS(Land, Failover, klass)
{
- 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);
+ INHERIT_CLASS(klass, Failover, Land);
+ klass->instClassStruct.describe = failoverDescribe;
+ klass->instClassStruct.finish = failoverFinish;
+ klass->size = sizeof(FailoverStruct);
+ klass->init = failoverInit;
+ klass->sizeMethod = failoverSize;
+ klass->insert = failoverInsert;
+ klass->delete = failoverDelete;
+ klass->iterate = failoverIterate;
+ klass->findFirst = failoverFindFirst;
+ klass->findLast = failoverFindLast;
+ klass->findLargest = failoverFindLargest;
+ klass->findInZones = failoverFindInZones;
+ AVERT(LandClass, klass);
}
diff --git a/mps/code/failover.h b/mps/code/failover.h
index 3676bade103..a74ab69a1fb 100644
--- a/mps/code/failover.h
+++ b/mps/code/failover.h
@@ -10,6 +10,8 @@
#define failover_h
#include "mpmtypes.h"
+#include "mpm.h"
+#include "protocol.h"
typedef struct FailoverStruct *Failover;
@@ -17,7 +19,7 @@ typedef struct FailoverStruct *Failover;
extern Bool FailoverCheck(Failover failover);
-extern LandClass FailoverLandClassGet(void);
+DECLARE_CLASS(Land, Failover, Land);
extern const struct mps_key_s _mps_key_failover_primary;
#define FailoverPrimary (&_mps_key_failover_primary)
diff --git a/mps/code/fbmtest.c b/mps/code/fbmtest.c
deleted file mode 100644
index f5aa6831db8..00000000000
--- a/mps/code/fbmtest.c
+++ /dev/null
@@ -1,663 +0,0 @@
-/* fbmtest.c: FREE BLOCK MANAGEMENT TEST
- *
- * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
- *
- * The MPS contains two free block management modules:
- *
- * 1. the CBS (Coalescing Block Structure) module maintains free
- * blocks in a splay tree for fast access with a cost in storage;
- *
- * 2. the Freelist module maintains free blocks in an address-ordered
- * singly linked list for zero storage overhead with a cost in
- * performance.
- *
- * The two modules present identical interfaces, so we apply the same
- * test cases to both.
- */
-
-#include "cbs.h"
-#include "freelist.h"
-#include "mpm.h"
-#include "mps.h"
-#include "mpsavm.h"
-#include "testlib.h"
-
-#include /* printf */
-
-SRCID(fbmtest, "$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)
-
-static Count NAllocateTried, NAllocateSucceeded, NDeallocateTried,
- NDeallocateSucceeded;
-
-static Bool verbose = FALSE;
-
-typedef unsigned FBMType;
-enum {
- FBMTypeCBS = 1,
- FBMTypeFreelist,
- FBMTypeLimit
-};
-
-typedef struct FBMStateStruct {
- FBMType type;
- Align align;
- BT allocTable;
- Addr block;
- union {
- CBS cbs;
- Freelist fl;
- } the;
-} FBMStateStruct, *FBMState;
-
-typedef struct CheckFBMClosureStruct {
- FBMState state;
- Addr limit;
- Addr oldLimit;
-} CheckFBMClosureStruct, *CheckFBMClosure;
-
-
-static Addr (addrOfIndex)(FBMState state, Index i)
-{
- return AddrAdd(state->block, (i * state->align));
-}
-
-
-static Index (indexOfAddr)(FBMState state, Addr a)
-{
- return (Index)(AddrOffset(state->block, a) / state->align);
-}
-
-
-static void describe(FBMState state) {
- switch (state->type) {
- case FBMTypeCBS:
- die(CBSDescribe(state->the.cbs, mps_lib_get_stdout(), 0),
- "CBSDescribe");
- break;
- case FBMTypeFreelist:
- die(FreelistDescribe(state->the.fl, mps_lib_get_stdout(), 0),
- "FreelistDescribe");
- break;
- default:
- cdie(0, "invalid state->type");
- break;
- }
-}
-
-
-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);
-
- 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 Bool checkCBSCallback(CBS cbs, Range range,
- void *closureP, Size closureS)
-{
- UNUSED(cbs);
- return checkCallback(range, closureP, closureS);
-}
-
-
-static Bool checkFLCallback(Bool *deleteReturn, Range range,
- void *closureP, Size closureS)
-{
- *deleteReturn = FALSE;
- return checkCallback(range, closureP, closureS);
-}
-
-
-static void check(FBMState state)
-{
- CheckFBMClosureStruct closure;
-
- closure.state = state;
- closure.limit = addrOfIndex(state, ArraySize);
- closure.oldLimit = state->block;
-
- switch (state->type) {
- case FBMTypeCBS:
- CBSIterate(state->the.cbs, checkCBSCallback, &closure, UNUSED_SIZE);
- break;
- case FBMTypeFreelist:
- FreelistIterate(state->the.fl, checkFLCallback, &closure, UNUSED_SIZE);
- break;
- default:
- cdie(0, "invalid state->type");
- return;
- }
-
- 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, FBMState 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(FBMState 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 */
- UNUSED(left);
- UNUSED(right);
- UNUSED(total);
- } else {
- outerBase = outerLimit = NULL;
- }
-
- RangeInit(&range, base, limit);
- switch (state->type) {
- case FBMTypeCBS:
- res = CBSDelete(&oldRange, state->the.cbs, &range);
- break;
- case FBMTypeFreelist:
- res = FreelistDelete(&oldRange, state->the.fl, &range);
- break;
- default:
- cdie(0, "invalid state->type");
- return;
- }
-
- 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(FBMState 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 */
- UNUSED(left);
- UNUSED(right);
- UNUSED(total);
- }
-
- RangeInit(&range, base, limit);
- switch (state->type) {
- case FBMTypeCBS:
- res = CBSInsert(&freeRange, state->the.cbs, &range);
- break;
- case FBMTypeFreelist:
- res = FreelistInsert(&freeRange, state->the.fl, &range);
- break;
- default:
- cdie(0, "invalid state->type");
- return;
- }
-
- 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(FBMState 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 */
- UNUSED(oldSize);
- UNUSED(newSize);
- }
-
- switch (state->type) {
- case FBMTypeCBS:
- found = (high ? CBSFindLast : CBSFindFirst)
- (&foundRange, &oldRange, state->the.cbs, size * state->align, findDelete);
- break;
- case FBMTypeFreelist:
- found = (high ? FreelistFindLast : FreelistFindFirst)
- (&foundRange, &oldRange, state->the.fl, size * state->align, findDelete);
- break;
- default:
- cdie(0, "invalid state->type");
- return;
- }
-
- 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(FBMState 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 state->type");
- return;
- }
- if ((i + 1) % 1000 == 0)
- check(state);
- if (i == 100)
- describe(state);
- }
-}
-
-#define testArenaSIZE (((size_t)4)<<20)
-
-extern int main(int argc, char *argv[])
-{
- mps_arena_t mpsArena;
- Arena arena; /* the ANSI arena which we use to allocate the BT */
- FBMStateStruct state;
- void *p;
- Addr dummyBlock;
- BT allocTable;
- FreelistStruct flStruct;
- CBSStruct cbsStruct;
- Align align;
-
- testlib_init(argc, argv);
- align = sizeof(void *) << (rnd() % 4);
-
- 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);
- }
-
- die((mps_res_t)CBSInit(&cbsStruct, arena, arena, align,
- /* fastFind */ TRUE, /* zoned */ FALSE, mps_args_none),
- "failed to initialise CBS");
- state.type = FBMTypeCBS;
- state.align = align;
- state.block = dummyBlock;
- state.allocTable = allocTable;
- state.the.cbs = &cbsStruct;
- test(&state, nCBSOperations);
- CBSFinish(&cbsStruct);
-
- die((mps_res_t)FreelistInit(&flStruct, align),
- "failed to initialise Freelist");
- state.type = FBMTypeFreelist;
- state.the.fl = &flStruct;
- test(&state, nFLOperations);
- FreelistFinish(&flStruct);
-
- 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/finalcv.c b/mps/code/finalcv.c
index 2be7f083735..1871141bbdf 100644
--- a/mps/code/finalcv.c
+++ b/mps/code/finalcv.c
@@ -1,7 +1,7 @@
/* finalcv.c: FINALIZATION COVERAGE TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2002 Global Graphics Software.
*
* DESIGN
@@ -40,7 +40,7 @@
#define finalizationRATE 6
#define gcINTERVAL ((size_t)150 * 1024)
#define collectionCOUNT 3
-#define messageCOUNT 3
+#define finalizationCOUNT 3
/* 3 words: wrapper | vector-len | first-slot */
#define vectorSIZE (3*sizeof(mps_word_t))
@@ -110,11 +110,11 @@ static void test(mps_arena_t arena, mps_pool_class_t pool_class)
mps_root_t mps_root[2];
mps_addr_t nullref = NULL;
int state[rootCOUNT];
- mps_message_t message;
- size_t messages = 0;
+ size_t finalizations = 0;
+ size_t collections = 0;
void *p;
- printf("---- finalcv: pool class %s ----\n", pool_class->name);
+ printf("---- finalcv: pool class %s ----\n", ClassName(pool_class));
die(mps_fmt_create_A(&fmt, arena, dylan_fmt_A()), "fmt_create\n");
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
@@ -143,15 +143,21 @@ static void test(mps_arena_t arena, mps_pool_class_t pool_class)
/* store index in vector's slot */
((mps_word_t *)p)[vectorSLOT] = dylan_int(i);
+ /* mps_definalize fails when there have been no calls to mps_finalize
+ yet, or for an address that was not registered for finalization. */
+ Insist(mps_definalize(arena, &p) == MPS_RES_FAIL);
+
die(mps_finalize(arena, &p), "finalize\n");
root[i] = p; state[i] = rootSTATE;
}
p = NULL;
mps_message_type_enable(arena, mps_message_type_finalization());
+ mps_message_type_enable(arena, mps_message_type_gc());
/* */
- while (messages < messageCOUNT && mps_collections(arena) < collectionCOUNT) {
+ while (finalizations < finalizationCOUNT && collections < collectionCOUNT) {
+ mps_message_type_t type;
/* Perhaps cause (minor) collection */
churn(ap);
@@ -177,31 +183,37 @@ static void test(mps_arena_t arena, mps_pool_class_t pool_class)
}
}
- /* Test any finalized objects, and perhaps resurrect some */
- while (mps_message_poll(arena)) {
- mps_word_t *obj;
- mps_word_t objind;
- mps_addr_t objaddr;
+ while (mps_message_queue_type(&type, arena)) {
+ mps_message_t message;
+ cdie(mps_message_get(&message, arena, type), "message_get");
+ if (type == mps_message_type_finalization()) {
+ /* Check finalized object, and perhaps resurrect it. */
+ mps_word_t *obj;
+ mps_word_t objind;
+ mps_addr_t objaddr;
- /* */
- cdie(mps_message_get(&message, arena, mps_message_type_finalization()),
- "get");
- cdie(0 == mps_message_clock(arena, message),
- "message clock should be 0 (unset) for finalization messages");
- mps_message_finalization_ref(&objaddr, arena, message);
- obj = objaddr;
- objind = dylan_int_int(obj[vectorSLOT]);
- printf("Finalizing: object %"PRIuLONGEST" at %p\n",
- (ulongest_t)objind, objaddr);
- /* */
- cdie(root[objind] == NULL, "finalized live");
- cdie(state[objind] == finalizableSTATE, "finalized dead");
- state[objind] = finalizedSTATE;
- /* sometimes resurrect */
- if (rnd() % 2 == 0)
- root[objind] = objaddr;
+ /* */
+ cdie(0 == mps_message_clock(arena, message),
+ "message clock should be 0 (unset) for finalization messages");
+ mps_message_finalization_ref(&objaddr, arena, message);
+ obj = objaddr;
+ objind = dylan_int_int(obj[vectorSLOT]);
+ printf("Finalizing: object %"PRIuLONGEST" at %p\n",
+ (ulongest_t)objind, objaddr);
+ /* */
+ cdie(root[objind] == NULL, "finalized live");
+ cdie(state[objind] == finalizableSTATE, "finalized dead");
+ state[objind] = finalizedSTATE;
+ /* sometimes resurrect */
+ if (rnd() % 2 == 0)
+ root[objind] = objaddr;
+ ++ finalizations;
+ } else if (type == mps_message_type_gc()) {
+ ++ collections;
+ } else {
+ error("Unexpected message type %lu.", (unsigned long)type);
+ }
mps_message_discard(arena, message);
- ++ messages;
}
}
@@ -238,7 +250,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/finaltest.c b/mps/code/finaltest.c
index 9f3ef13b967..877e37f9699 100644
--- a/mps/code/finaltest.c
+++ b/mps/code/finaltest.c
@@ -43,6 +43,7 @@
#include "fmtdytst.h"
#include "mpstd.h"
+#include /* HUGE_VAL */
#include /* fflush, printf, stdout */
enum {
@@ -149,13 +150,15 @@ static void test_trees(int mode, const char *name, mps_arena_t arena,
size_t finals = 0;
size_t i;
int object_alloc;
+ PoolClass klass = ClassOfPoly(Pool, pool);
object_count = 0;
printf("---- Mode %s, pool class %s, %s trees ----\n",
mode == ModePARK ? "PARK" : "POLL",
- pool->class->name, name);
+ ClassName(klass), name);
mps_arena_park(arena);
+ mps_message_type_enable(arena, mps_message_type_gc());
/* make some trees */
for(i = 0; i < rootCOUNT; ++i) {
@@ -169,6 +172,7 @@ static void test_trees(int mode, const char *name, mps_arena_t arena,
}
while (finals < object_count && collections < collectionCOUNT) {
+ mps_message_type_t type;
mps_word_t final_this_time = 0;
switch (mode) {
default:
@@ -188,30 +192,43 @@ static void test_trees(int mode, const char *name, mps_arena_t arena,
printf(" Done.\n");
break;
}
- ++ collections;
{
size_t live_size = (object_count - finals) * sizeof(void *) * 3;
- size_t alloc_size = mps_pool_total_size(pool) - mps_pool_free_size(pool);
- Insist(live_size <= alloc_size);
+ size_t total_size = mps_pool_total_size(pool);
+ size_t free_size = mps_pool_free_size(pool);
+ Insist(free_size <= total_size);
+ Insist(free_size + live_size <= total_size);
}
- while (mps_message_poll(arena)) {
+ while (mps_message_queue_type(&type, arena)) {
mps_message_t message;
- mps_addr_t objaddr;
- cdie(mps_message_get(&message, arena, mps_message_type_finalization()),
- "message_get");
- mps_message_finalization_ref(&objaddr, arena, message);
+ cdie(mps_message_get(&message, arena, type), "message_get");
+ if (type == mps_message_type_finalization()) {
+ mps_addr_t objaddr;
+ mps_message_finalization_ref(&objaddr, arena, message);
+ ++ final_this_time;
+ } else if (type == mps_message_type_gc()) {
+ ++ collections;
+ } else {
+ error("Unexpected message type %lu.", (unsigned long)type);
+ }
mps_message_discard(arena, message);
- ++ final_this_time;
}
finals += final_this_time;
printf("%"PRIuLONGEST" objects finalized: total %"PRIuLONGEST
" of %"PRIuLONGEST"\n", (ulongest_t)final_this_time,
(ulongest_t)finals, (ulongest_t)object_count);
}
- if (finals != object_count)
+
+ if (finals != object_count) {
+ PoolClass poolClass = ClassOfPoly(Pool, BufferOfAP(ap)->pool);
error("Not all objects were finalized for %s in mode %s.",
- BufferOfAP(ap)->pool->class->name,
+ ClassName(poolClass),
mode == ModePOLL ? "POLL" : "PARK");
+ }
+
+ if (collections > collectionCOUNT)
+ error("Expected no more than %lu collections but got %lu.",
+ (unsigned long)collectionCOUNT, (unsigned long)collections);
}
static void test_pool(int mode, mps_arena_t arena, mps_chain_t chain,
@@ -270,8 +287,18 @@ int main(int argc, char *argv[])
testlib_init(argc, argv);
- die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
- "arena_create\n");
+ MPS_ARGS_BEGIN(args) {
+ /* Randomize pause time as a regression test for job004007. */
+ double t = rnd_double();
+ if (t == 0.0)
+ t = HUGE_VAL; /* Would prefer to use INFINITY but it's not in C89. */
+ else
+ t = 1 / t - 1;
+ MPS_ARGS_ADD(args, MPS_KEY_PAUSE_TIME, t);
+ MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, testArenaSIZE);
+ die(mps_arena_create_k(&arena, mps_arena_class_vm(), args),
+ "arena_create\n");
+ } MPS_ARGS_END(args);
mps_message_type_enable(arena, mps_message_type_finalization());
die(mps_thread_reg(&thread, arena), "thread_reg\n");
for (i = 0; i < gens; ++i) {
diff --git a/mps/code/fmtdy.c b/mps/code/fmtdy.c
index 0cb4adea11d..2f88fd53d82 100644
--- a/mps/code/fmtdy.c
+++ b/mps/code/fmtdy.c
@@ -1,7 +1,7 @@
/* fmtdy.c: DYLAN OBJECT FORMAT IMPLEMENTATION
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
* Portions copyright (c) 2002 Global Graphics Software.
*
* .readership: MPS developers, Dylan developers
@@ -96,7 +96,7 @@ int dylan_wrapper_check(mps_word_t *w)
mps_word_t vh;
mps_word_t version;
mps_word_t reserved;
- mps_word_t class;
+ mps_word_t klass;
mps_word_t fh, fl, ff;
mps_word_t vb, es, vf;
mps_word_t vt, t;
@@ -129,8 +129,8 @@ int dylan_wrapper_check(mps_word_t *w)
/* Unpack the wrapper. */
- class = w[WC]; /* class */
- unused(class);
+ klass = w[WC]; /* class */
+ unused(klass);
fh = w[WF]; /* fixed part header word */
fl = fh >> 2; /* fixed part length */
ff = fh & 3; /* fixed part format code */
@@ -152,8 +152,8 @@ int dylan_wrapper_check(mps_word_t *w)
/* The second word is the class of the wrapped object. */
/* It would be good to check which pool this is in. */
- assert(class != 0); /* class exists */
- assert((class & 3) == 0); /* class is aligned */
+ assert(klass != 0); /* class exists */
+ assert((klass & 3) == 0); /* class is aligned */
/* The third word contains the fixed part format and length. */
/* The only illegal format is 3. Anything else is possible, although */
@@ -236,7 +236,7 @@ static mps_res_t dylan_scan_contig(mps_ss_t mps_ss,
/* dylan_weak_dependent -- returns the linked object, if any.
*/
-extern mps_addr_t dylan_weak_dependent(mps_addr_t parent)
+mps_addr_t dylan_weak_dependent(mps_addr_t parent)
{
mps_word_t *object;
mps_word_t *wrapper;
@@ -366,7 +366,7 @@ static mps_res_t dylan_scan_pat(mps_ss_t mps_ss,
(_vt) << ((_es) - FMTDY_WORD_SHIFT))
-extern mps_res_t dylan_scan1(mps_ss_t mps_ss, mps_addr_t *object_io)
+mps_res_t dylan_scan1(mps_ss_t mps_ss, mps_addr_t *object_io)
{
mps_addr_t *p; /* cursor in object */
mps_addr_t *q; /* cursor limit for loops */
@@ -407,8 +407,11 @@ extern mps_res_t dylan_scan1(mps_ss_t mps_ss, mps_addr_t *object_io)
return MPS_RES_OK;
}
- res = mps_fix(mps_ss, p); /* fix the wrapper */
- if ( res != MPS_RES_OK ) return res;
+ MPS_SCAN_BEGIN(mps_ss) {
+ res = MPS_FIX12(mps_ss, p); /* fix the wrapper */
+ } MPS_SCAN_END(mps_ss);
+ if (res != MPS_RES_OK)
+ return res;
w = (mps_word_t *)p[0]; /* wrapper is header word */
assert(dylan_wrapper_check(w));
@@ -546,7 +549,7 @@ static mps_addr_t dylan_class(mps_addr_t obj)
return (mps_addr_t)first_word;
}
-extern mps_res_t dylan_scan1_weak(mps_ss_t mps_ss, mps_addr_t *object_io)
+mps_res_t dylan_scan1_weak(mps_ss_t mps_ss, mps_addr_t *object_io)
{
mps_addr_t *assoc;
mps_addr_t *base;
@@ -567,8 +570,11 @@ extern mps_res_t dylan_scan1_weak(mps_ss_t mps_ss, mps_addr_t *object_io)
assert((h & 3) == 0);
unused(h);
- res = mps_fix(mps_ss, p);
- if ( res != MPS_RES_OK ) return res;
+ MPS_SCAN_BEGIN(mps_ss) {
+ res = MPS_FIX12(mps_ss, p);
+ } MPS_SCAN_END(mps_ss);
+ if (res != MPS_RES_OK)
+ return res;
/* w points to wrapper */
w = (mps_word_t *)p[0];
@@ -628,7 +634,7 @@ static mps_res_t dylan_scan_weak(mps_ss_t mps_ss,
return MPS_RES_OK;
}
-static mps_addr_t dylan_skip(mps_addr_t object)
+mps_addr_t dylan_skip(mps_addr_t object)
{
mps_addr_t *p; /* cursor in object */
mps_word_t *w; /* wrapper cursor */
@@ -746,6 +752,14 @@ void dylan_pad(mps_addr_t addr, size_t size)
}
}
+mps_bool_t dylan_ispad(mps_addr_t addr)
+{
+ mps_word_t *p;
+
+ p = (mps_word_t *)addr;
+ return p[0] == 1 || p[0] == 2;
+}
+
/* The dylan format structures */
@@ -844,7 +858,7 @@ mps_res_t dylan_fmt_weak(mps_fmt_t *mps_fmt_o, mps_arena_t arena)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/fmtdy.h b/mps/code/fmtdy.h
index b7434abebd7..67483639c2b 100644
--- a/mps/code/fmtdy.h
+++ b/mps/code/fmtdy.h
@@ -24,8 +24,10 @@ extern mps_res_t dylan_fmt_weak(mps_fmt_t *, mps_arena_t);
extern mps_addr_t dylan_weak_dependent(mps_addr_t);
-extern void dylan_pad(mps_addr_t addr, size_t size);
-extern int dylan_wrapper_check(mps_word_t *w);
+extern mps_addr_t dylan_skip(mps_addr_t);
+extern void dylan_pad(mps_addr_t, size_t);
+extern mps_bool_t dylan_ispad(mps_addr_t);
+extern int dylan_wrapper_check(mps_word_t *);
/* Constants describing wrappers. Used only for debugging / testing */
#define WW 0 /* offset of Wrapper-Wrapper */
diff --git a/mps/code/fmtscheme.c b/mps/code/fmtscheme.c
index 24fa06db871..979672c9de3 100644
--- a/mps/code/fmtscheme.c
+++ b/mps/code/fmtscheme.c
@@ -1,7 +1,7 @@
/* fmtscheme.c: SCHEME OBJECT FORMAT IMPLEMENTATION
*
- * $Id: //info.ravenbrook.com/project/mps/branch/2014-01-15/nailboard/code/fmtdy.c#1 $
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * $Id$
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
*/
#include
@@ -460,7 +460,7 @@ void scheme_fmt(mps_fmt_t *fmt)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/fmtscheme.h b/mps/code/fmtscheme.h
index 1149d9496a1..92d4c270bb6 100644
--- a/mps/code/fmtscheme.h
+++ b/mps/code/fmtscheme.h
@@ -1,7 +1,7 @@
/* fmtscheme.h: SCHEME OBJECT FORMAT INTERFACE
*
- * $Id: //info.ravenbrook.com/project/mps/branch/2014-01-15/nailboard/code/fmtdy.h#1 $
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * $Id$
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
*/
#ifndef fmtscheme_h
@@ -193,7 +193,7 @@ extern mps_ap_t obj_ap;
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/forktest.c b/mps/code/forktest.c
new file mode 100644
index 00000000000..e1d1909d4c1
--- /dev/null
+++ b/mps/code/forktest.c
@@ -0,0 +1,231 @@
+/* forktest.c: FORK SAFETY TEST
+ *
+ * $Id: //info.ravenbrook.com/project/mps/branch/2018-06-13/fork/code/tagtest.c#1 $
+ * Copyright (c) 2018 Ravenbrook Limited. See end of file for license.
+ *
+ * .overview: This test case is a regression test for job004062. It
+ * checks that the MPS correctly runs in the child process after a
+ * fork() on FreeBSD, Linux or macOS.
+ *
+ * .format: This test case uses a trivial object format in which each
+ * object contains a single reference.
+ */
+
+#include
+#include
+#include
+
+#include "mps.h"
+#include "mpsavm.h"
+#include "mpscamc.h"
+#include "testlib.h"
+
+enum {
+ TYPE_REF,
+ TYPE_FWD,
+ TYPE_PAD
+};
+
+typedef struct obj_s {
+ unsigned type; /* One of the TYPE_ enums */
+ union {
+ struct obj_s *ref; /* TYPE_REF */
+ mps_addr_t fwd; /* TYPE_FWD */
+ size_t pad; /* TYPE_PAD */
+ } u;
+} obj_s, *obj_t;
+
+static void obj_fwd(mps_addr_t old, mps_addr_t new)
+{
+ obj_t obj = old;
+ obj->type = TYPE_FWD;
+ obj->u.fwd = new;
+}
+
+static mps_addr_t obj_isfwd(mps_addr_t addr)
+{
+ obj_t obj = addr;
+ if (obj->type == TYPE_FWD) {
+ return obj->u.fwd;
+ } else {
+ return NULL;
+ }
+}
+
+static void obj_pad(mps_addr_t addr, size_t size)
+{
+ obj_t obj = addr;
+ obj->type = TYPE_PAD;
+ obj->u.pad = size;
+}
+
+static mps_addr_t obj_skip(mps_addr_t addr)
+{
+ obj_t obj = addr;
+ size_t size;
+ if (obj->type == TYPE_PAD) {
+ size = obj->u.pad;
+ } else {
+ size = sizeof(obj_s);
+ }
+ return (char *)addr + size;
+}
+
+static mps_res_t obj_scan(mps_ss_t ss, mps_addr_t base, mps_addr_t limit)
+{
+ MPS_SCAN_BEGIN(ss) {
+ while (base < limit) {
+ obj_t obj = base;
+ if (obj->type == TYPE_REF) {
+ mps_addr_t p = obj->u.ref;
+ mps_res_t res = MPS_FIX12(ss, &p);
+ if (res != MPS_RES_OK) {
+ return res;
+ }
+ obj->u.ref = p;
+ }
+ base = obj_skip(base);
+ }
+ } MPS_SCAN_END(ss);
+ return MPS_RES_OK;
+}
+
+int main(int argc, char *argv[])
+{
+ void *marker = ▮
+ int pid;
+ mps_arena_t arena;
+ mps_fmt_t obj_fmt;
+ mps_pool_t pool;
+ mps_thr_t thread;
+ mps_root_t stack_root;
+ mps_ap_t obj_ap;
+ size_t i;
+ obj_t obj, first;
+
+ testlib_init(argc, argv);
+
+ /* Set the pause time to be very small so that the incremental
+ collector (when it runs) will have to leave a read barrier in
+ place for us to hit. */
+ MPS_ARGS_BEGIN(args) {
+ MPS_ARGS_ADD(args, MPS_KEY_PAUSE_TIME, 0.0);
+ die(mps_arena_create_k(&arena, mps_arena_class_vm(), args),
+ "mps_arena_create");
+ } MPS_ARGS_END(args);
+ mps_arena_park(arena);
+
+ die(mps_thread_reg(&thread, arena), "Couldn't register thread");
+ die(mps_root_create_thread(&stack_root, arena, thread, marker),
+ "Couldn't create thread root");
+
+ MPS_ARGS_BEGIN(args) {
+ MPS_ARGS_ADD(args, MPS_KEY_FMT_ALIGN, sizeof(obj_s));
+ MPS_ARGS_ADD(args, MPS_KEY_FMT_SCAN, obj_scan);
+ MPS_ARGS_ADD(args, MPS_KEY_FMT_SKIP, obj_skip);
+ 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);
+ die(mps_fmt_create_k(&obj_fmt, arena, args), "Couldn't create obj format");
+ } MPS_ARGS_END(args);
+
+ MPS_ARGS_BEGIN(args) {
+ MPS_ARGS_ADD(args, MPS_KEY_FORMAT, obj_fmt);
+ die(mps_pool_create_k(&pool, arena, mps_class_amc(), args),
+ "Couldn't create pool");
+ } MPS_ARGS_END(args);
+
+ die(mps_ap_create_k(&obj_ap, pool, mps_args_none),
+ "Couldn't create obj allocation point");
+
+ /* Create a linked list of objects. */
+ first = NULL;
+ for (i = 0; i < 100000; ++i) {
+ size_t size = sizeof(obj_s);
+ mps_addr_t addr;
+ do {
+ die(mps_reserve(&addr, obj_ap, size), "Couldn't allocate.");
+ obj = addr;
+ obj->type = TYPE_REF;
+ obj->u.ref = NULL;
+ } while (!mps_commit(obj_ap, addr, size));
+ obj->u.ref = first;
+ first = obj;
+ }
+
+ pid = fork();
+ cdie(pid >= 0, "fork failed");
+
+ /* Allow a collection to start, which will cause a read barrier to
+ be applied to any segment containing live objects that was
+ scanned. */
+ mps_arena_release(arena);
+
+ /* Read all the objects, so that if there is read barrier in place
+ we will hit it. */
+ for (obj = first; obj != NULL; obj = obj->u.ref) {
+ Insist(obj->type == TYPE_REF);
+ }
+
+ mps_arena_park(arena);
+
+ if (pid != 0) {
+ /* Parent: wait for child and check that its exit status is zero. */
+ int stat;
+ cdie(pid == waitpid(pid, &stat, 0), "waitpid failed");
+ cdie(WIFEXITED(stat), "child did not exit normally");
+ cdie(WEXITSTATUS(stat) == 0, "child exited with nonzero status");
+ printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
+ }
+
+ mps_ap_destroy(obj_ap);
+ mps_pool_destroy(pool);
+ mps_fmt_destroy(obj_fmt);
+ mps_root_destroy(stack_root);
+ mps_thread_dereg(thread);
+ mps_arena_destroy(arena);
+
+ return 0;
+}
+
+
+/* C. COPYRIGHT AND LICENSE
+ *
+ * Copyright (c) 2018 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/format.c b/mps/code/format.c
index 26b3e4bb751..b9c4a59fb14 100644
--- a/mps/code/format.c
+++ b/mps/code/format.c
@@ -1,7 +1,7 @@
/* format.c: OBJECT FORMATS
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
* Portions copyright (c) 2002 Global Graphics Software.
*
* DESIGN
@@ -32,7 +32,7 @@ Bool FormatCheck(Format format)
CHECKL(FUNCHECK(format->move));
CHECKL(FUNCHECK(format->isMoved));
CHECKL(FUNCHECK(format->pad));
- CHECKL(FUNCHECK(format->class));
+ CHECKL(FUNCHECK(format->klass));
return TRUE;
}
@@ -133,14 +133,14 @@ Res FormatCreate(Format *formatReturn, Arena arena, ArgList args)
if (ArgPick(&arg, args, MPS_KEY_FMT_CLASS))
fmtClass = arg.val.fmt_class;
- res = ControlAlloc(&p, arena, sizeof(FormatStruct),
- /* withReservoirPermit */ FALSE);
+ res = ControlAlloc(&p, arena, sizeof(FormatStruct));
if(res != ResOK)
return res;
format = (Format)p; /* avoid pun */
format->arena = arena;
RingInit(&format->arenaRing);
+ format->poolCount = 0;
format->alignment = fmtAlign;
format->headerSize = fmtHeaderSize;
format->scan = fmtScan;
@@ -148,7 +148,7 @@ Res FormatCreate(Format *formatReturn, Arena arena, ArgList args)
format->move = fmtFwd;
format->isMoved = fmtIsfwd;
format->pad = fmtPad;
- format->class = fmtClass;
+ format->klass = fmtClass;
format->sig = FormatSig;
format->serial = arena->formatSerial;
@@ -168,6 +168,7 @@ Res FormatCreate(Format *formatReturn, Arena arena, ArgList args)
void FormatDestroy(Format format)
{
AVERT(Format, format);
+ AVER(format->poolCount == 0); /* */
RingRemove(&format->arenaRing);
@@ -230,6 +231,7 @@ Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth)
"Format $P ($U) {\n", (WriteFP)format, (WriteFU)format->serial,
" arena $P ($U)\n",
(WriteFP)format->arena, (WriteFU)format->arena->serial,
+ " poolCount $U\n", (WriteFU)format->poolCount,
" alignment $W\n", (WriteFW)format->alignment,
" scan $F\n", (WriteFF)format->scan,
" skip $F\n", (WriteFF)format->skip,
@@ -248,7 +250,7 @@ Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/fotest.c b/mps/code/fotest.c
index 750883f61a4..262414bacf7 100644
--- a/mps/code/fotest.c
+++ b/mps/code/fotest.c
@@ -1,7 +1,7 @@
/* fotest.c: FAIL-OVER TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2002 Global Graphics Software.
*
* This tests fail-over behaviour in low memory situations. The MVFF
@@ -10,9 +10,8 @@
* request due to running out of memory, they fall back to a Freelist
* (which has zero memory overhead, at some cost in performance).
*
- * This is a white box test: it patches the class of the CBS's
- * internal block pool (MFS) with a pointer to a dummy class whose
- * alloc() method always returns ResMEMORY.
+ * This is a white box test: it monkey-patches the MFS pool's alloc
+ * method with a method that always returns a memory error code.
*/
@@ -36,43 +35,6 @@
#define testLOOPS 10
-/* Accessors for the CBS used to implement a pool. */
-
-extern Land _mps_mvff_cbs(Pool);
-extern Land _mps_mvt_cbs(Pool);
-
-
-/* "OOM" pool class -- dummy alloc/free pool class whose alloc()
- * method always fails and whose free method does nothing. */
-
-static Res oomAlloc(Addr *pReturn, Pool pool, Size size,
- Bool withReservoirPermit)
-{
- UNUSED(pReturn);
- UNUSED(pool);
- UNUSED(size);
- UNUSED(withReservoirPermit);
- switch (rnd() % 3) {
- case 0:
- return ResRESOURCE;
- case 1:
- return ResMEMORY;
- default:
- return ResCOMMIT_LIMIT;
- }
-}
-
-extern PoolClass OOMPoolClassGet(void);
-DEFINE_POOL_CLASS(OOMPoolClass, this)
-{
- INHERIT_CLASS(this, AbstractPoolClass);
- this->alloc = oomAlloc;
- this->free = PoolTrivFree;
- this->size = sizeof(PoolStruct);
- AVERT(PoolClass, this);
-}
-
-
/* make -- allocate one object */
static mps_res_t make(mps_addr_t *p, mps_ap_t ap, size_t size)
@@ -89,19 +51,44 @@ 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. */
+/* The original alloc method on the MFS pool. */
+static PoolAllocMethod mfs_alloc;
-static void set_oom(Land land, int oom)
+
+/* oomAlloc -- allocation function that always fails
+ *
+ * Returns a randomly chosen memory error code.
+ */
+
+static Res oomAlloc(Addr *pReturn, Pool pool, Size size)
{
- CBS cbs = PARENT(CBSStruct, landStruct, land);
- cbs->blockPool->class = oom ? OOMPoolClassGet() : PoolClassMFS();
+ MFS mfs = MustBeA(MFSPool, pool);
+ UNUSED(pReturn);
+ UNUSED(size);
+ if (mfs->extendSelf) {
+ /* This is the MFS block pool belonging to the CBS belonging to
+ * the MVFF or MVT pool under test, so simulate a failure to
+ * enforce the fail-over behaviour. */
+ switch (rnd() % 3) {
+ case 0:
+ return ResRESOURCE;
+ case 1:
+ return ResMEMORY;
+ default:
+ return ResCOMMIT_LIMIT;
+ }
+ } else {
+ /* This is the MFS block pool belonging to the arena's free land,
+ * so succeed here (see job004041). */
+ return mfs_alloc(pReturn, pool, size);
+ }
}
/* 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, Land cbs)
+ mps_align_t alignment, mps_pool_t pool)
{
mps_res_t res = MPS_RES_OK;
mps_ap_t ap;
@@ -113,11 +100,12 @@ static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t),
/* allocate a load of objects */
for (i=0; i= sizeof(ps[i]))
*ps[i] = 1; /* Write something, so it gets swap. */
}
@@ -143,15 +131,17 @@ static mps_res_t stress(size_t (*size)(unsigned long, mps_align_t),
}
/* allocate some new objects */
for (i=testSetSIZE/2; i.
+ * Copyright (c) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/freelist.c b/mps/code/freelist.c
index 6eddc3dff83..b3e2fde3112 100644
--- a/mps/code/freelist.c
+++ b/mps/code/freelist.c
@@ -13,7 +13,6 @@
SRCID(freelist, "$Id$");
-#define freelistOfLand(land) PARENT(FreelistStruct, landStruct, land)
#define freelistAlignment(fl) LandAlignment(FreelistLand(fl))
@@ -187,51 +186,45 @@ Bool FreelistCheck(Freelist fl)
}
-static Res freelistInit(Land land, ArgList args)
+static Res freelistInit(Land land, Arena arena, Align alignment, ArgList args)
{
Freelist fl;
- LandClass super;
Res res;
- AVERT(Land, land);
- super = LAND_SUPERCLASS(FreelistLandClass);
- res = (*super->init)(land, args);
+ AVER(land != NULL);
+ res = NextMethod(Land, Freelist, init)(land, arena, alignment, args);
if (res != ResOK)
return res;
+ fl = CouldBeA(Freelist, land);
/* See */
AVER(AlignIsAligned(LandAlignment(land), FreelistMinimumAlignment));
- fl = freelistOfLand(land);
fl->list = freelistEND;
fl->listSize = 0;
fl->size = 0;
+ SetClassOfPoly(land, CLASS(Freelist));
fl->sig = FreelistSig;
- AVERT(Freelist, fl);
+ AVERC(Freelist, fl);
+
return ResOK;
}
-static void freelistFinish(Land land)
+static void freelistFinish(Inst inst)
{
- Freelist fl;
-
- AVERT(Land, land);
- fl = freelistOfLand(land);
- AVERT(Freelist, fl);
+ Land land = MustBeA(Land, inst);
+ Freelist fl = MustBeA(Freelist, land);
fl->sig = SigInvalid;
fl->list = freelistEND;
+ NextMethod(Inst, Freelist, finish)(inst);
}
static Size freelistSize(Land land)
{
- Freelist fl;
-
- AVERT(Land, land);
- fl = freelistOfLand(land);
- AVERT(Freelist, fl);
+ Freelist fl = MustBeA(Freelist, land);
return fl->size;
}
@@ -277,15 +270,12 @@ static void freelistBlockSetPrevNext(Freelist fl, FreelistBlock prev,
static Res freelistInsert(Range rangeReturn, Land land, Range range)
{
- Freelist fl;
+ Freelist fl = MustBeA(Freelist, land);
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, freelistAlignment(fl)));
@@ -404,14 +394,11 @@ static void freelistDeleteFromBlock(Range rangeReturn, Freelist fl,
static Res freelistDelete(Range rangeReturn, Land land, Range range)
{
- Freelist fl;
+ Freelist fl = MustBeA(Freelist, land);
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);
@@ -444,16 +431,13 @@ static Res freelistDelete(Range rangeReturn, Land land, Range range)
static Bool freelistIterate(Land land, LandVisitor visitor,
- void *closureP, Size closureS)
+ void *closure)
{
- Freelist fl;
+ Freelist fl = MustBeA(Freelist, land);
FreelistBlock cur, next;
- AVERT(Land, land);
- fl = freelistOfLand(land);
- AVERT(Freelist, fl);
AVER(FUNCHECK(visitor));
- /* closureP and closureS are arbitrary */
+ /* closure arbitrary */
for (cur = fl->list; cur != freelistEND; cur = next) {
RangeStruct range;
@@ -462,7 +446,7 @@ static Bool freelistIterate(Land land, LandVisitor visitor,
* visitor touches the block. */
next = freelistBlockNext(cur);
RangeInit(&range, freelistBlockBase(cur), freelistBlockLimit(fl, cur));
- cont = (*visitor)(land, &range, closureP, closureS);
+ cont = (*visitor)(land, &range, closure);
if (!cont)
return FALSE;
}
@@ -471,16 +455,13 @@ static Bool freelistIterate(Land land, LandVisitor visitor,
static Bool freelistIterateAndDelete(Land land, LandDeleteVisitor visitor,
- void *closureP, Size closureS)
+ void *closure)
{
- Freelist fl;
+ Freelist fl = MustBeA(Freelist, land);
FreelistBlock prev, cur, next;
- AVERT(Land, land);
- fl = freelistOfLand(land);
- AVERT(Freelist, fl);
AVER(FUNCHECK(visitor));
- /* closureP and closureS are arbitrary */
+ /* closure arbitrary */
prev = freelistEND;
cur = fl->list;
@@ -492,7 +473,7 @@ static Bool freelistIterateAndDelete(Land land, LandDeleteVisitor visitor,
next = freelistBlockNext(cur); /* See .next.first. */
size = freelistBlockSize(fl, cur);
RangeInit(&range, freelistBlockBase(cur), freelistBlockLimit(fl, cur));
- cont = (*visitor)(&delete, land, &range, closureP, closureS);
+ cont = (*visitor)(&delete, land, &range, closure);
if (delete) {
freelistBlockSetPrevNext(fl, prev, next, -1);
AVER(fl->size >= size);
@@ -573,14 +554,11 @@ static void freelistFindDeleteFromBlock(Range rangeReturn, Range oldRangeReturn,
static Bool freelistFindFirst(Range rangeReturn, Range oldRangeReturn,
Land land, Size size, FindDelete findDelete)
{
- Freelist fl;
+ Freelist fl = MustBeA(Freelist, land);
FreelistBlock prev, cur, next;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
- fl = freelistOfLand(land);
- AVERT(Freelist, fl);
AVER(SizeIsAligned(size, freelistAlignment(fl)));
AVERT(FindDelete, findDelete);
@@ -604,16 +582,13 @@ static Bool freelistFindFirst(Range rangeReturn, Range oldRangeReturn,
static Bool freelistFindLast(Range rangeReturn, Range oldRangeReturn,
Land land, Size size, FindDelete findDelete)
{
- Freelist fl;
+ Freelist fl = MustBeA(Freelist, land);
Bool found = FALSE;
FreelistBlock prev, cur, next;
FreelistBlock foundPrev = freelistEND, foundCur = freelistEND;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
- fl = freelistOfLand(land);
- AVERT(Freelist, fl);
AVER(SizeIsAligned(size, freelistAlignment(fl)));
AVERT(FindDelete, findDelete);
@@ -641,16 +616,13 @@ static Bool freelistFindLast(Range rangeReturn, Range oldRangeReturn,
static Bool freelistFindLargest(Range rangeReturn, Range oldRangeReturn,
Land land, Size size, FindDelete findDelete)
{
- Freelist fl;
+ Freelist fl = MustBeA(Freelist, land);
Bool found = FALSE;
FreelistBlock prev, cur, next;
FreelistBlock bestPrev = freelistEND, bestCur = freelistEND;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
- fl = freelistOfLand(land);
- AVERT(Freelist, fl);
AVERT(FindDelete, findDelete);
prev = freelistEND;
@@ -679,7 +651,7 @@ static Res freelistFindInZones(Bool *foundReturn, Range rangeReturn,
Range oldRangeReturn, Land land, Size size,
ZoneSet zoneSet, Bool high)
{
- Freelist fl;
+ Freelist fl = MustBeA(Freelist, land);
LandFindMethod landFind;
RangeInZoneSet search;
Bool found = FALSE;
@@ -690,9 +662,6 @@ static Res freelistFindInZones(Bool *foundReturn, Range rangeReturn,
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);
@@ -746,24 +715,28 @@ static Res freelistFindInZones(Bool *foundReturn, Range rangeReturn,
/* freelistDescribeVisitor -- visitor method for freelistDescribe
*
* Writes a decription of the range into the stream pointed to by
- * closureP.
+ * closure.
*/
+typedef struct FreelistDescribeClosureStruct {
+ mps_lib_FILE *stream;
+ Count depth;
+} FreelistDescribeClosureStruct, *FreelistDescribeClosure;
+
static Bool freelistDescribeVisitor(Land land, Range range,
- void *closureP, Size closureS)
+ void *closure)
{
Res res;
- mps_lib_FILE *stream = closureP;
- Count depth = closureS;
+ FreelistDescribeClosure my = closure;
if (!TESTT(Land, land))
return FALSE;
if (!RangeCheck(range))
return FALSE;
- if (stream == NULL)
+ if (my->stream == NULL)
return FALSE;
- res = WriteF(stream, depth,
+ res = WriteF(my->stream, my->depth,
"[$P,", (WriteFP)RangeBase(range),
"$P)", (WriteFP)RangeLimit(range),
" {$U}\n", (WriteFU)RangeSize(range),
@@ -773,53 +746,55 @@ static Bool freelistDescribeVisitor(Land land, Range range,
}
-static Res freelistDescribe(Land land, mps_lib_FILE *stream, Count depth)
+static Res freelistDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
{
- Freelist fl;
+ Land land = CouldBeA(Land, inst);
+ Freelist fl = CouldBeA(Freelist, land);
Res res;
Bool b;
+ FreelistDescribeClosureStruct closure;
- if (!TESTT(Land, land))
- return ResFAIL;
- fl = freelistOfLand(land);
- if (!TESTT(Freelist, fl))
- return ResFAIL;
+ if (!TESTC(Freelist, fl))
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
+ return ResPARAM;
- res = WriteF(stream, depth,
- "Freelist $P {\n", (WriteFP)fl,
- " listSize = $U\n", (WriteFU)fl->listSize,
- " size = $U\n", (WriteFU)fl->size,
+ res = NextMethod(Inst, Freelist, describe)(inst, stream, depth);
+ if (res != ResOK)
+ return res;
+
+ res = WriteF(stream, depth + 2,
+ "listSize $U\n", (WriteFU)fl->listSize,
+ "size $U\n", (WriteFU)fl->size,
NULL);
- b = LandIterate(land, freelistDescribeVisitor, stream, depth + 2);
+ closure.stream = stream;
+ closure.depth = depth + 2;
+ b = LandIterate(land, freelistDescribeVisitor, &closure);
if (!b)
return ResFAIL;
- res = WriteF(stream, depth, "} Freelist $P\n", (WriteFP)fl, NULL);
return res;
}
-DEFINE_LAND_CLASS(FreelistLandClass, class)
+DEFINE_CLASS(Land, Freelist, klass)
{
- 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);
+ INHERIT_CLASS(klass, Freelist, Land);
+ klass->instClassStruct.describe = freelistDescribe;
+ klass->instClassStruct.finish = freelistFinish;
+ klass->size = sizeof(FreelistStruct);
+ klass->init = freelistInit;
+ klass->sizeMethod = freelistSize;
+ klass->insert = freelistInsert;
+ klass->delete = freelistDelete;
+ klass->iterate = freelistIterate;
+ klass->iterateAndDelete = freelistIterateAndDelete;
+ klass->findFirst = freelistFindFirst;
+ klass->findLast = freelistFindLast;
+ klass->findLargest = freelistFindLargest;
+ klass->findInZones = freelistFindInZones;
+ AVERT(LandClass, klass);
}
diff --git a/mps/code/freelist.h b/mps/code/freelist.h
index dab791c9c03..6b84564e0ab 100644
--- a/mps/code/freelist.h
+++ b/mps/code/freelist.h
@@ -10,6 +10,8 @@
#define freelist_h
#include "mpmtypes.h"
+#include "mpm.h"
+#include "protocol.h"
typedef struct FreelistStruct *Freelist;
@@ -20,7 +22,7 @@ extern Bool FreelistCheck(Freelist freelist);
/* See */
#define FreelistMinimumAlignment ((Align)sizeof(FreelistBlock))
-extern LandClass FreelistLandClassGet(void);
+DECLARE_CLASS(Land, Freelist, Land);
#endif /* freelist.h */
diff --git a/mps/code/fri3gc.gmk b/mps/code/fri3gc.gmk
index 99d455e51fa..3bcbf187ef1 100644
--- a/mps/code/fri3gc.gmk
+++ b/mps/code/fri3gc.gmk
@@ -3,19 +3,19 @@
# fri3gc.gmk: BUILD FOR FreeBSD/i386/GCC PLATFORM
#
# $Id$
-# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
PFM = fri3gc
MPMPF = \
lockix.c \
- prmcan.c \
- prmci3fr.c \
+ prmcanan.c \
+ prmcfri3.c \
+ prmcix.c \
protix.c \
protsgix.c \
pthrdext.c \
span.c \
- ssixi3.c \
thix.c \
vmix.c
@@ -32,7 +32,7 @@ include comm.gmk
# C. COPYRIGHT AND LICENSE
#
-# Copyright (C) 2001-2014 Ravenbrook Limited .
+# Copyright (C) 2001-2016 Ravenbrook Limited .
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
diff --git a/mps/code/fri3ll.gmk b/mps/code/fri3ll.gmk
index 8801830e757..82389f7ebbe 100644
--- a/mps/code/fri3ll.gmk
+++ b/mps/code/fri3ll.gmk
@@ -3,19 +3,19 @@
# fri3ll.gmk: BUILD FOR FreeBSD/i386/GCC PLATFORM
#
# $Id$
-# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
PFM = fri3ll
MPMPF = \
lockix.c \
- prmcan.c \
- prmci3fr.c \
+ prmcanan.c \
+ prmcfri3.c \
+ prmcix.c \
protix.c \
protsgix.c \
pthrdext.c \
span.c \
- ssixi3.c \
thix.c \
vmix.c
@@ -32,7 +32,7 @@ include comm.gmk
# C. COPYRIGHT AND LICENSE
#
-# Copyright (C) 2001-2014 Ravenbrook Limited .
+# Copyright (C) 2001-2016 Ravenbrook Limited .
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
diff --git a/mps/code/fri6gc.gmk b/mps/code/fri6gc.gmk
index a0cb6270c12..7d165182468 100644
--- a/mps/code/fri6gc.gmk
+++ b/mps/code/fri6gc.gmk
@@ -3,33 +3,36 @@
# fri6gc.gmk: BUILD FOR FreeBSD/x86-64/GCC PLATFORM
#
# $Id$
-# Copyright (c) 2001-2013 Ravenbrook Limited. See end of file for license.
+# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
PFM = fri6gc
-MPMPF = lockix.c thix.c pthrdext.c vmix.c \
- protix.c protsgix.c prmcan.c prmci6fr.c ssixi6.c span.c
+MPMPF = \
+ lockix.c \
+ prmcanan.c \
+ prmcfri6.c \
+ prmcix.c \
+ protix.c \
+ protsgix.c \
+ pthrdext.c \
+ span.c \
+ thix.c \
+ vmix.c
LIBS = -lm -pthread
include gc.gmk
-# FIXME: We pun types through the MPS interface, setting off this warning.
-# Can we avoid this? The puns might indeed be dangerous.
-CFLAGSCOMPILER += -Wno-strict-aliasing
-
# For SQLite3.
LINKFLAGS += -L/usr/local/lib
CFLAGSCOMPILER += -I/usr/local/include
-CC = cc
-
include comm.gmk
# C. COPYRIGHT AND LICENSE
#
-# Copyright (C) 2001-2013 Ravenbrook Limited .
+# Copyright (C) 2001-2016 Ravenbrook Limited .
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
diff --git a/mps/code/fri6ll.gmk b/mps/code/fri6ll.gmk
index 6595410c9a3..faccd6d928b 100644
--- a/mps/code/fri6ll.gmk
+++ b/mps/code/fri6ll.gmk
@@ -1,29 +1,32 @@
# -*- makefile -*-
#
-# fri6ll.gmk: BUILD FOR FreeBSD/x86-64/GCC PLATFORM
+# fri6ll.gmk: BUILD FOR FreeBSD/x86-64/Clang PLATFORM
#
# $Id$
# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
PFM = fri6ll
-MPMPF = lockix.c thix.c pthrdext.c vmix.c \
- protix.c protsgix.c prmcan.c prmci6fr.c ssixi6.c span.c
+MPMPF = \
+ lockix.c \
+ prmcanan.c \
+ prmcfri6.c \
+ prmcix.c \
+ protix.c \
+ protsgix.c \
+ pthrdext.c \
+ span.c \
+ thix.c \
+ vmix.c
LIBS = -lm -pthread
include ll.gmk
-# FIXME: We pun types through the MPS interface, setting off this warning.
-# Can we avoid this? The puns might indeed be dangerous.
-#CFLAGSCOMPILER += -Wno-strict-aliasing
-
# For SQLite3.
LINKFLAGS += -L/usr/local/lib
CFLAGSCOMPILER += -I/usr/local/include
-CC = cc
-
include comm.gmk
diff --git a/mps/code/gc.gmk b/mps/code/gc.gmk
index 76716dc0785..f871b4f5c8b 100644
--- a/mps/code/gc.gmk
+++ b/mps/code/gc.gmk
@@ -13,21 +13,21 @@ CC = gcc
CFLAGSDEBUG = -O -g3
CFLAGSOPT = -O2 -g3
CFLAGSCOMPILER := \
- -Waggregate-return \
- -Wall \
- -Wcast-qual \
- -Werror \
- -Wextra \
- -Winline \
- -Wmissing-prototypes \
- -Wnested-externs \
- -Wpointer-arith \
- -Wshadow \
- -Wstrict-aliasing=2 \
- -Wstrict-prototypes \
- -Wswitch-default \
- -Wwrite-strings
-CFLAGSCOMPILERSTRICT := -ansi -pedantic
+-Waggregate-return \
+-Wall \
+-Wcast-qual \
+-Werror \
+-Wextra \
+-Winline \
+-Wmissing-prototypes \
+-Wnested-externs \
+-Wpointer-arith \
+-Wshadow \
+-Wstrict-aliasing=2 \
+-Wstrict-prototypes \
+-Wswitch-default \
+-Wwrite-strings
+CFLAGSCOMPILERSTRICT := -std=c89 -pedantic
# A different set of compiler flags for less strict compilation, for
# instance when we need to #include a third-party header file that
@@ -41,9 +41,9 @@ CFLAGSCOMPILERLAX :=
# If interrupted, this is liable to leave a zero-length file behind.
define gendep
- $(SHELL) -ec "$(CC) $(CFLAGSSTRICT) -MM $< | \
- sed '/:/s!$*.o!$(@D)/& $(@D)/$*.d!' > $@"
- [ -s $@ ] || rm -f $@
+$(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 8624637da4a..40612fbfab8 100644
--- a/mps/code/gcbench.c
+++ b/mps/code/gcbench.c
@@ -1,7 +1,7 @@
/* gcbench.c -- "GC" Benchmark on ANSI C library
*
* $Id$
- * Copyright 2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2014-2018 Ravenbrook Limited. See end of file for license.
*
* This is an allocation stress benchmark test for gc pools
*/
@@ -55,6 +55,7 @@ static size_t arena_size = 256ul * 1024 * 1024; /* arena size */
static size_t arena_grain_size = 1; /* arena grain size */
static unsigned pinleaf = FALSE; /* are leaf objects pinned at start */
static mps_bool_t zoned = TRUE; /* arena allocates using zones */
+static double pause_time = ARENA_DEFAULT_PAUSE_TIME; /* maximum pause time */
typedef struct gcthread_s *gcthread_t;
@@ -70,22 +71,26 @@ struct gcthread_s {
typedef mps_word_t obj_t;
-static obj_t mkvector(mps_ap_t ap, size_t n) {
+static obj_t mkvector(mps_ap_t ap, size_t n)
+{
mps_word_t v;
RESMUST(make_dylan_vector(&v, ap, n));
return v;
}
-static obj_t aref(obj_t v, size_t i) {
+static obj_t aref(obj_t v, size_t i)
+{
return DYLAN_VECTOR_SLOT(v, i);
}
-static void aset(obj_t v, size_t i, obj_t val) {
+static void aset(obj_t v, size_t i, obj_t val)
+{
DYLAN_VECTOR_SLOT(v, i) = val;
}
/* mktree - make a tree of nodes with depth d. */
-static obj_t mktree(mps_ap_t ap, unsigned d, obj_t leaf) {
+static obj_t mktree(mps_ap_t ap, unsigned d, obj_t leaf)
+{
obj_t tree;
size_t i;
if (d <= 0)
@@ -97,7 +102,8 @@ static obj_t mktree(mps_ap_t ap, unsigned d, obj_t leaf) {
return tree;
}
-static obj_t random_subtree(obj_t tree, unsigned levels) {
+static obj_t random_subtree(obj_t tree, unsigned levels)
+{
while(tree != objNULL && levels > 0) {
tree = aref(tree, rnd() % width);
--levels;
@@ -113,7 +119,8 @@ static obj_t random_subtree(obj_t tree, unsigned levels) {
* NOTE: Changing preuse will dramatically change how much work
* is done. In particular, if preuse==1, the old tree is returned
* unchanged. */
-static obj_t new_tree(mps_ap_t ap, obj_t oldtree, unsigned d) {
+static obj_t new_tree(mps_ap_t ap, obj_t oldtree, unsigned d)
+{
obj_t subtree;
size_t i;
if (rnd_double() < preuse) {
@@ -132,7 +139,8 @@ static obj_t new_tree(mps_ap_t ap, obj_t oldtree, unsigned d) {
/* Update tree to be identical tree but with nodes reallocated
* with probability pupdate. This avoids writing to vector slots
* if unecessary. */
-static obj_t update_tree(mps_ap_t ap, obj_t oldtree, unsigned d) {
+static obj_t update_tree(mps_ap_t ap, obj_t oldtree, unsigned d)
+{
obj_t tree;
size_t i;
if (oldtree == objNULL || d == 0)
@@ -155,7 +163,8 @@ static obj_t update_tree(mps_ap_t ap, obj_t oldtree, unsigned d) {
return tree;
}
-static void *gc_tree(gcthread_t thread) {
+static void *gc_tree(gcthread_t thread)
+{
unsigned i, j;
mps_ap_t ap = thread->ap;
obj_t leaf = pinleaf ? mktree(ap, 1, objNULL) : objNULL;
@@ -172,7 +181,8 @@ static void *gc_tree(gcthread_t thread) {
}
/* start -- start routine for each thread */
-static void *start(void *p) {
+static void *start(void *p)
+{
gcthread_t thread = p;
void *marker;
RESMUST(mps_thread_reg(&thread->mps_thread, arena));
@@ -235,6 +245,7 @@ static void arena_setup(gcthread_fn_t fn,
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, arena_size);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, arena_grain_size);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_ZONED, zoned);
+ MPS_ARGS_ADD(args, MPS_KEY_PAUSE_TIME, pause_time);
RESMUST(mps_arena_create_k(&arena, mps_arena_class_vm(), args));
} MPS_ARGS_END(args);
RESMUST(dylan_fmt(&format, arena));
@@ -251,8 +262,6 @@ static void arena_setup(gcthread_fn_t fn,
} MPS_ARGS_END(args);
watch(fn, name);
mps_arena_park(arena);
- printf("%u chunks\n", (unsigned)TreeDebugCount(ArenaChunkTree(arena),
- ChunkCompare, ChunkKey));
mps_pool_destroy(pool);
mps_fmt_destroy(format);
if (ngen > 0)
@@ -278,6 +287,7 @@ static struct option longopts[] = {
{"pin-leaf", no_argument, NULL, 'l'},
{"seed", required_argument, NULL, 'x'},
{"arena-unzoned", no_argument, NULL, 'z'},
+ {"pause-time", required_argument, NULL, 'P'},
{NULL, 0, NULL, 0 }
};
@@ -289,25 +299,22 @@ static struct {
} pools[] = {
{"amc", gc_tree, mps_class_amc},
{"ams", gc_tree, mps_class_ams},
+ {"awl", gc_tree, mps_class_awl},
};
/* Command-line driver */
-int main(int argc, char *argv[]) {
+int main(int argc, char *argv[])
+{
int ch;
unsigned i;
- int k;
+ mps_bool_t seed_specified = FALSE;
seed = rnd_seed();
- for(k=0; k 0) {
for (i = 0; i < NELEMS(pools); ++i)
@@ -472,7 +488,7 @@ int main(int argc, char *argv[]) {
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2014-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/global.c b/mps/code/global.c
index 354adb54a9a..a69dad836cb 100644
--- a/mps/code/global.c
+++ b/mps/code/global.c
@@ -1,7 +1,7 @@
/* global.c: ARENA-GLOBAL INTERFACES
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2002 Global Graphics Software.
*
* .sources: See . design.mps.thread-safety is relevant
@@ -24,7 +24,6 @@
#include "bt.h"
#include "poolmrg.h"
#include "mps.h" /* finalization */
-#include "poolmv.h"
#include "mpm.h"
SRCID(global, "$Id$");
@@ -53,6 +52,47 @@ static void arenaReleaseRingLock(void)
}
+/* GlobalsClaimAll -- claim all MPS locks
+ *
+ */
+
+void GlobalsClaimAll(void)
+{
+ LockClaimGlobalRecursive();
+ arenaClaimRingLock();
+ GlobalsArenaMap(ArenaEnter);
+}
+
+/* GlobalsReleaseAll -- release all MPS locks. GlobalsClaimAll must
+ * previously have been called. */
+
+void GlobalsReleaseAll(void)
+{
+ GlobalsArenaMap(ArenaLeave);
+ arenaReleaseRingLock();
+ LockReleaseGlobalRecursive();
+}
+
+/* arenaReinitLock -- reinitialize the lock for an arena */
+
+static void arenaReinitLock(Arena arena)
+{
+ AVERT(Arena, arena);
+ ShieldLeave(arena);
+ LockInit(ArenaGlobals(arena)->lock);
+}
+
+/* GlobalsReinitializeAll -- reinitialize all MPS locks, and leave the
+ * shield for all arenas. GlobalsClaimAll must previously have been
+ * called. */
+
+void GlobalsReinitializeAll(void)
+{
+ GlobalsArenaMap(arenaReinitLock);
+ LockInitGlobal();
+}
+
+
/* arenaAnnounce -- add a new arena into the global ring of arenas
*
* On entry, the arena must not be locked (there should be no need,
@@ -100,6 +140,21 @@ static void arenaDenounce(Arena arena)
}
+/* GlobalsArenaMap -- map a function over the arenas. The caller must
+ * have acquired the ring lock. */
+
+void GlobalsArenaMap(void (*func)(Arena arena))
+{
+ Ring node, nextNode;
+ AVERT(Ring, &arenaRing);
+ RING_FOR(node, &arenaRing, nextNode) {
+ Globals arenaGlobals = RING_ELT(Globals, globalRing, node);
+ Arena arena = GlobalsArena(arenaGlobals);
+ func(arena);
+ }
+}
+
+
/* GlobalsCheck -- check the arena globals */
Bool GlobalsCheck(Globals arenaGlobals)
@@ -107,9 +162,6 @@ Bool GlobalsCheck(Globals arenaGlobals)
Arena arena;
TraceId ti;
Trace trace;
- Index i;
- Size depth;
- RefSet rs;
Rank rank;
CHECKS(Globals, arenaGlobals);
@@ -155,20 +207,7 @@ Bool GlobalsCheck(Globals arenaGlobals)
CHECKD_NOSIG(Ring, &arena->threadRing);
CHECKD_NOSIG(Ring, &arena->deadRing);
- CHECKL(BoolCheck(arena->insideShield));
- CHECKL(arena->shCacheLimit <= ShieldCacheSIZE);
- CHECKL(arena->shCacheI < arena->shCacheLimit);
- CHECKL(BoolCheck(arena->suspended));
-
- depth = 0;
- for (i = 0; i < arena->shCacheLimit; ++i) {
- Seg seg = arena->shCache[i];
- if (seg != NULL) {
- CHECKD(Seg, seg);
- depth += SegDepth(seg);
- }
- }
- CHECKL(depth <= arena->shDepth);
+ CHECKD(Shield, ArenaShield(arena));
CHECKL(TraceSetCheck(arena->busyTraces));
CHECKL(TraceSetCheck(arena->flippedTraces));
@@ -190,23 +229,12 @@ Bool GlobalsCheck(Globals arenaGlobals)
CHECKD_NOSIG(Ring, &arena->greyRing[rank]);
CHECKD_NOSIG(Ring, &arena->chainRing);
- CHECKL(arena->tracedSize >= 0.0);
+ CHECKL(arena->tracedWork >= 0.0);
CHECKL(arena->tracedTime >= 0.0);
/* no check for arena->lastWorldCollect (Clock) */
/* can't write a check for arena->epoch */
-
- /* check that each history entry is a subset of the next oldest */
- rs = RefSetEMPTY;
- /* note this loop starts from 1; there is no history age 0 */
- for (i=1; i <= LDHistoryLENGTH; ++ i) {
- /* check history age 'i'; 'j' is the history index. */
- Index j = (arena->epoch + LDHistoryLENGTH - i) % LDHistoryLENGTH;
- CHECKL(RefSetSub(rs, arena->history[j]));
- rs = arena->history[j];
- }
- /* the oldest history entry must be a subset of the prehistory */
- CHECKL(RefSetSub(rs, arena->prehistory));
+ CHECKD(History, ArenaHistory(arena));
/* we also check the statics now. */
CHECKL(BoolCheck(arenaRingInit));
@@ -215,12 +243,15 @@ Bool GlobalsCheck(Globals arenaGlobals)
CHECKL(RingCheck(&arenaRing));
CHECKL(BoolCheck(arena->emergency));
+ /* .emergency.invariant: There can only be an emergency when a trace
+ * is busy. */
+ CHECKL(!arena->emergency || arena->busyTraces != TraceSetEMPTY);
if (arenaGlobals->defaultChain != NULL)
CHECKD(Chain, arenaGlobals->defaultChain);
- /* can't check arena->stackAtArenaEnter */
-
+ /* can't check arena->stackWarm */
+
return TRUE;
}
@@ -230,7 +261,6 @@ Bool GlobalsCheck(Globals arenaGlobals)
Res GlobalsInit(Globals arenaGlobals)
{
Arena arena;
- Index i;
Rank rank;
TraceId ti;
@@ -246,7 +276,13 @@ Res GlobalsInit(Globals arenaGlobals)
arenaRingInit = TRUE;
RingInit(&arenaRing);
arenaSerial = (Serial)0;
+ /* The setup functions call pthread_atfork (on the appropriate
+ platforms) and so must be called in the correct order. Here we
+ require the locks to be taken first in the "prepare" case and
+ released last in the "parent" and "child" cases. */
+ ThreadSetup();
ProtSetup();
+ LockSetup();
}
arena = GlobalsArena(arenaGlobals);
/* Ensure updates to arenaSerial do not race by doing the update
@@ -272,6 +308,11 @@ Res GlobalsInit(Globals arenaGlobals)
arenaGlobals->bufferLogging = FALSE;
RingInit(&arenaGlobals->poolRing);
arenaGlobals->poolSerial = (Serial)0;
+ /* The system pools are:
+ 1. arena->freeCBSBlockPoolStruct
+ 2. arena->controlPoolStruct
+ 3. arena->controlPoolStruct.cbsBlockPoolStruct */
+ arenaGlobals->systemPools = (Count)3;
RingInit(&arenaGlobals->rootRing);
arenaGlobals->rootSerial = (Serial)0;
RingInit(&arenaGlobals->rememberedSummaryRing);
@@ -289,16 +330,10 @@ Res GlobalsInit(Globals arenaGlobals)
arena->finalPool = NULL;
arena->busyTraces = TraceSetEMPTY; /* */
arena->flippedTraces = TraceSetEMPTY; /* */
- arena->tracedSize = 0.0;
+ arena->tracedWork = 0.0;
arena->tracedTime = 0.0;
arena->lastWorldCollect = ClockNow();
- arena->insideShield = FALSE; /* */
- arena->shCacheI = (Size)0;
- arena->shCacheLimit = (Size)1;
- arena->shDepth = (Size)0;
- arena->suspended = FALSE;
- for(i = 0; i < ShieldCacheSIZE; i++)
- arena->shCache[i] = NULL;
+ ShieldInit(ArenaShield(arena));
for (ti = 0; ti < TraceLIMIT; ++ti) {
/* */
@@ -315,14 +350,11 @@ Res GlobalsInit(Globals arenaGlobals)
STATISTIC(arena->writeBarrierHitCount = 0);
RingInit(&arena->chainRing);
- arena->epoch = (Epoch)0; /* */
- arena->prehistory = RefSetEMPTY;
- for(i = 0; i < LDHistoryLENGTH; ++i)
- arena->history[i] = RefSetEMPTY;
-
+ HistoryInit(ArenaHistory(arena));
+
arena->emergency = FALSE;
- arena->stackAtArenaEnter = NULL;
+ arena->stackWarm = NULL;
arenaGlobals->defaultChain = NULL;
@@ -352,7 +384,7 @@ Res GlobalsCompleteCreate(Globals arenaGlobals)
{
void *v;
- res = ControlAlloc(&v, arena, BTSize(MessageTypeLIMIT), FALSE);
+ res = ControlAlloc(&v, arena, BTSize(MessageTypeLIMIT));
if (res != ResOK)
return res;
arena->enabledMessageTypes = v;
@@ -366,7 +398,7 @@ Res GlobalsCompleteCreate(Globals arenaGlobals)
return res;
TRACE_SET_ITER_END(ti, trace, TraceSetUNIV, arena);
- res = ControlAlloc(&p, arena, LockSize(), FALSE);
+ res = ControlAlloc(&p, arena, LockSize());
if (res != ResOK)
return res;
arenaGlobals->lock = (Lock)p;
@@ -398,11 +430,12 @@ void GlobalsFinish(Globals arenaGlobals)
arena = GlobalsArena(arenaGlobals);
AVERT(Globals, arenaGlobals);
- STATISTIC_STAT(EVENT2(ArenaWriteFaults, arena,
- arena->writeBarrierHitCount));
+ STATISTIC(EVENT2(ArenaWriteFaults, arena, arena->writeBarrierHitCount));
arenaGlobals->sig = SigInvalid;
+ ShieldFinish(ArenaShield(arena));
+ HistoryFinish(ArenaHistory(arena));
RingFinish(&arena->formatRing);
RingFinish(&arena->chainRing);
RingFinish(&arena->messageRing);
@@ -435,6 +468,7 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
ArenaPark(arenaGlobals);
arena = GlobalsArena(arenaGlobals);
+
arenaDenounce(arena);
defaultChain = arenaGlobals->defaultChain;
@@ -486,6 +520,8 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
PoolDestroy(pool);
}
+ ShieldDestroyQueue(ArenaShield(arena), arena);
+
/* 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
@@ -494,23 +530,15 @@ void GlobalsPrepareToDestroy(Globals arenaGlobals)
* 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->formatRing)); /* */
+ AVER(RingIsSingle(&arena->chainRing)); /* */
AVER(RingIsSingle(&arena->messageRing));
- AVER(RingIsSingle(&arena->threadRing));
+ AVER(RingIsSingle(&arena->threadRing)); /* */
AVER(RingIsSingle(&arena->deadRing));
- AVER(RingIsSingle(&arenaGlobals->rootRing));
+ AVER(RingIsSingle(&arenaGlobals->rootRing)); /* */
for(rank = RankMIN; 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);
+ AVER(RingLength(&arenaGlobals->poolRing) == arenaGlobals->systemPools); /* */
}
@@ -524,10 +552,9 @@ Ring GlobalsRememberedSummaryRing(Globals global)
/* ArenaEnter -- enter the state where you can look at the arena */
-void (ArenaEnter)(Arena arena)
+void ArenaEnter(Arena arena)
{
- AVERT(Arena, arena);
- ArenaEnter(arena);
+ ArenaEnterLock(arena, FALSE);
}
/* The recursive argument specifies whether to claim the lock
@@ -558,7 +585,6 @@ void ArenaEnterLock(Arena arena, Bool recursive)
} else {
ShieldEnter(arena);
}
- return;
}
/* Same as ArenaEnter, but for the few functions that need to be
@@ -572,10 +598,10 @@ void ArenaEnterRecursive(Arena arena)
/* ArenaLeave -- leave the state where you can look at MPM data structures */
-void (ArenaLeave)(Arena arena)
+void ArenaLeave(Arena arena)
{
AVERT(Arena, arena);
- ArenaLeave(arena);
+ ArenaLeaveLock(arena, FALSE);
}
void ArenaLeaveLock(Arena arena, Bool recursive)
@@ -597,7 +623,6 @@ void ArenaLeaveLock(Arena arena, Bool recursive)
} else {
LockRelease(lock);
}
- return;
}
void ArenaLeaveRecursive(Arena arena)
@@ -605,14 +630,10 @@ void ArenaLeaveRecursive(Arena arena)
ArenaLeaveLock(arena, TRUE);
}
-/* mps_exception_info -- pointer to exception info
- *
- * This is a hack to make exception info easier to find in a release
- * version. The format is platform-specific. We won't necessarily
- * publish this. */
-
-extern MutatorFaultContext mps_exception_info;
-MutatorFaultContext mps_exception_info = NULL;
+Bool ArenaBusy(Arena arena)
+{
+ return LockIsHeld(ArenaGlobals(arena)->lock);
+}
/* ArenaAccess -- deal with an access fault
@@ -621,7 +642,7 @@ MutatorFaultContext mps_exception_info = NULL;
* corresponds to which mode flags need to be cleared in order for the
* access to continue. */
-Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context)
+Bool ArenaAccess(Addr addr, AccessSet mode, MutatorContext context)
{
static Count count = 0; /* used to match up ArenaAccess events */
Seg seg;
@@ -629,7 +650,6 @@ Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context)
Res res;
arenaClaimRingLock(); /* */
- mps_exception_info = context;
AVERT(Ring, &arenaRing);
RING_FOR(node, &arenaRing, nextNode) {
@@ -645,7 +665,6 @@ Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context)
/* protected root on a segment. */
/* It is possible to overcome this restriction. */
if (SegOfAddr(&seg, arena, addr)) {
- mps_exception_info = NULL;
arenaReleaseRingLock();
/* An access in a different thread (or even in the same thread,
* via a signal or exception handler) may have already caused
@@ -654,7 +673,7 @@ Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context)
* thread. */
mode &= SegPM(seg);
if (mode != AccessSetEMPTY) {
- res = PoolAccess(SegPool(seg), seg, addr, mode, context);
+ res = SegAccess(seg, arena, addr, mode, context);
AVER(res == ResOK); /* Mutator can't continue unless this succeeds */
} else {
/* Protection was already cleared, for example by another thread
@@ -664,7 +683,6 @@ Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context)
ArenaLeave(arena);
return TRUE;
} else if (RootOfAddr(&root, arena, addr)) {
- mps_exception_info = NULL;
arenaReleaseRingLock();
mode &= RootPM(root);
if (mode != AccessSetEMPTY)
@@ -682,7 +700,6 @@ Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context)
ArenaLeave(arena);
}
- mps_exception_info = NULL;
arenaReleaseRingLock();
return FALSE;
}
@@ -708,8 +725,9 @@ void (ArenaPoll)(Globals globals)
{
Arena arena;
Clock start;
- Count quanta;
- Size tracedSize;
+ Bool worldCollected = FALSE;
+ Bool moreWork, workWasDone = FALSE;
+ Work tracedWork;
AVERT(Globals, globals);
@@ -725,35 +743,34 @@ void (ArenaPoll)(Globals globals)
/* fillMutatorSize has advanced; call TracePoll enough to catch up. */
start = ClockNow();
- quanta = 0;
- EVENT3(ArenaPoll, arena, start, 0);
+ EVENT3(ArenaPoll, arena, start, FALSE);
do {
- tracedSize = TracePoll(globals);
- if (tracedSize > 0) {
- quanta += 1;
- arena->tracedSize += tracedSize;
+ moreWork = TracePoll(&tracedWork, &worldCollected, globals,
+ !worldCollected);
+ if (moreWork) {
+ workWasDone = TRUE;
}
- } while (PolicyPollAgain(arena, start, tracedSize));
+ } while (PolicyPollAgain(arena, start, moreWork, tracedWork));
/* Don't count time spent checking for work, if there was no work to do. */
- if(quanta > 0) {
- arena->tracedTime += (ClockNow() - start) / (double) ClocksPerSec();
+ if (workWasDone) {
+ ArenaAccumulateTime(arena, start, ClockNow());
}
- AVER(!PolicyPoll(arena));
-
- EVENT3(ArenaPoll, arena, start, quanta);
+ EVENT3(ArenaPoll, arena, start, BOOLOF(workWasDone));
globals->insidePoll = FALSE;
}
+
+/* ArenaStep -- use idle time for collection work */
+
Bool ArenaStep(Globals globals, double interval, double multiplier)
{
- Size scanned;
- Bool stepped;
- Clock start, end, now;
+ Bool workWasDone = FALSE;
+ Clock start, intervalEnd, availableEnd, now;
Clock clocks_per_sec;
Arena arena;
@@ -764,39 +781,46 @@ Bool ArenaStep(Globals globals, double interval, double multiplier)
arena = GlobalsArena(globals);
clocks_per_sec = ClocksPerSec();
- start = ClockNow();
- end = start + (Clock)(interval * clocks_per_sec);
- AVER(end >= start);
-
- stepped = FALSE;
-
- if (PolicyShouldCollectWorld(arena, interval, multiplier,
- start, clocks_per_sec))
- {
- Res res;
- Trace trace;
- res = TraceStartCollectAll(&trace, arena, TraceStartWhyOPPORTUNISM);
- if (res == ResOK) {
- arena->lastWorldCollect = start;
- stepped = TRUE;
- }
- }
+ start = now = ClockNow();
+ intervalEnd = start + (Clock)(interval * clocks_per_sec);
+ AVER(intervalEnd >= start);
+ availableEnd = start + (Clock)(interval * multiplier * clocks_per_sec);
+ AVER(availableEnd >= start);
/* loop while there is work to do and time on the clock. */
do {
- scanned = TracePoll(globals);
- now = ClockNow();
- if (scanned > 0) {
- stepped = TRUE;
- arena->tracedSize += scanned;
+ Trace trace;
+ if (arena->busyTraces != TraceSetEMPTY) {
+ trace = ArenaTrace(arena, (TraceId)0);
+ } else {
+ /* No traces are running: consider collecting the world. */
+ if (PolicyShouldCollectWorld(arena, (double)(availableEnd - now), now,
+ clocks_per_sec))
+ {
+ Res res;
+ res = TraceStartCollectAll(&trace, arena, TraceStartWhyOPPORTUNISM);
+ if (res != ResOK)
+ break;
+ arena->lastWorldCollect = now;
+ } else {
+ /* Not worth collecting the world; consider starting a trace. */
+ Bool worldCollected;
+ if (!PolicyStartTrace(&trace, &worldCollected, arena, FALSE))
+ break;
+ }
}
- } while ((scanned > 0) && (now < end));
+ TraceAdvance(trace);
+ if (trace->state == TraceFINISHED)
+ TraceDestroyFinished(trace);
+ workWasDone = TRUE;
+ now = ClockNow();
+ } while (now < intervalEnd);
- if (stepped) {
- arena->tracedTime += (now - start) / (double) clocks_per_sec;
+ if (workWasDone) {
+ ArenaAccumulateTime(arena, start, now);
}
- return stepped;
+ return workWasDone;
}
/* ArenaFinalize -- registers an object for finalization
@@ -846,7 +870,7 @@ Res ArenaDefinalize(Arena arena, Ref obj)
}
-/* Peek / Poke */
+/* ArenaPeek -- read a single reference, possibly through a barrier */
Ref ArenaPeek(Arena arena, Ref *p)
{
@@ -854,6 +878,7 @@ Ref ArenaPeek(Arena arena, Ref *p)
Ref ref;
AVERT(Arena, arena);
+ /* Can't check p as it is arbitrary */
if (SegOfAddr(&seg, arena, (Addr)p))
ref = ArenaPeekSeg(arena, seg, p);
@@ -862,74 +887,19 @@ Ref ArenaPeek(Arena arena, Ref *p)
return ref;
}
+/* ArenaPeekSeg -- as ArenaPeek, but p must be in seg. */
+
Ref ArenaPeekSeg(Arena arena, Seg seg, Ref *p)
{
Ref ref;
-
- AVERT(Arena, arena);
- AVERT(Seg, seg);
-
- AVER(SegBase(seg) <= (Addr)p);
- AVER((Addr)p < SegLimit(seg));
- /* TODO: Consider checking addr's alignment using seg->pool->alignment */
-
- ShieldExpose(arena, seg);
- ref = *p;
- ShieldCover(arena, seg);
- return ref;
-}
-
-void ArenaPoke(Arena arena, Ref *p, Ref ref)
-{
- Seg seg;
-
- AVERT(Arena, arena);
- /* Can't check addr as it is arbitrary */
- /* Can't check ref as it is arbitrary */
-
- if (SegOfAddr(&seg, arena, (Addr)p))
- ArenaPokeSeg(arena, seg, p, ref);
- else
- *p = ref;
-}
-
-void ArenaPokeSeg(Arena arena, Seg seg, Ref *p, Ref ref)
-{
- RefSet summary;
-
- AVERT(Arena, arena);
- AVERT(Seg, seg);
- AVER(SegBase(seg) <= (Addr)p);
- AVER((Addr)p < SegLimit(seg));
- /* TODO: Consider checking addr's alignment using seg->pool->alignment */
- /* ref is arbitrary and can't be checked */
-
- ShieldExpose(arena, seg);
- *p = ref;
- summary = SegSummary(seg);
- summary = RefSetAdd(arena, summary, (Addr)ref);
- SegSetSummary(seg, summary);
- ShieldCover(arena, seg);
-}
-
-
-/* ArenaRead -- read a single reference, possibly through a barrier
- *
- * This forms part of a software barrier. It provides fine-grain access
- * to single references in segments.
- *
- * See also PoolSingleAccess and PoolSegAccess. */
-
-Ref ArenaRead(Arena arena, Ref *p)
-{
- Bool b;
- Seg seg = NULL; /* suppress "may be used uninitialized" */
Rank rank;
AVERT(Arena, arena);
-
- b = SegOfAddr(&seg, arena, (Addr)p);
- AVER(b == TRUE);
+ AVERT(Seg, seg);
+ AVER(PoolArena(SegPool(seg)) == arena);
+ AVER(SegBase(seg) <= (Addr)p);
+ AVER((Addr)p < SegLimit(seg));
+ /* TODO: Consider checking p's alignment using seg->pool->alignment */
/* .read.flipped: We AVER that the reference that we are reading */
/* refers to an object for which all the traces that the object is */
@@ -951,11 +921,81 @@ Ref ArenaRead(Arena arena, Ref *p)
/* We don't need to update the Seg Summary as in PoolSingleAccess
* because we are not changing it after it has been scanned. */
+
+ ShieldExpose(arena, seg);
+ ref = *p;
+ ShieldCover(arena, seg);
+ return ref;
+}
+
+/* ArenaPoke -- write a single reference, possibly through a barrier */
+
+void ArenaPoke(Arena arena, Ref *p, Ref ref)
+{
+ Seg seg;
+
+ AVERT(Arena, arena);
+ /* Can't check p as it is arbitrary */
+ /* Can't check ref as it is arbitrary */
+
+ if (SegOfAddr(&seg, arena, (Addr)p))
+ ArenaPokeSeg(arena, seg, p, ref);
+ else
+ *p = ref;
+}
+
+/* ArenaPokeSeg -- as ArenaPoke, but p must be in seg. */
+
+void ArenaPokeSeg(Arena arena, Seg seg, Ref *p, Ref ref)
+{
+ RefSet summary;
+
+ AVERT(Arena, arena);
+ AVERT(Seg, seg);
+ AVER(PoolArena(SegPool(seg)) == arena);
+ AVER(SegBase(seg) <= (Addr)p);
+ AVER((Addr)p < SegLimit(seg));
+ /* TODO: Consider checking p's alignment using seg->pool->alignment */
+ /* ref is arbitrary and can't be checked */
+
+ ShieldExpose(arena, seg);
+ *p = ref;
+ summary = SegSummary(seg);
+ summary = RefSetAdd(arena, summary, (Addr)ref);
+ SegSetSummary(seg, summary);
+ ShieldCover(arena, seg);
+}
+
+/* ArenaRead -- like ArenaPeek, but reference known to be owned by arena */
+
+Ref ArenaRead(Arena arena, Ref *p)
+{
+ Bool b;
+ Seg seg = NULL; /* suppress "may be used uninitialized" */
+
+ AVERT(Arena, arena);
+
+ b = SegOfAddr(&seg, arena, (Addr)p);
+ AVER(b == TRUE);
- /* get the possibly fixed reference */
return ArenaPeekSeg(arena, seg, p);
}
+/* ArenaWrite -- like ArenaPoke, but reference known to be owned by arena */
+
+void ArenaWrite(Arena arena, Ref *p, Ref ref)
+{
+ Bool b;
+ Seg seg = NULL; /* suppress "may be used uninitialized" */
+
+ AVERT(Arena, arena);
+
+ b = SegOfAddr(&seg, arena, (Addr)p);
+ AVER(b == TRUE);
+
+ ArenaPokeSeg(arena, seg, p, ref);
+}
+
/* GlobalsDescribe -- describe the arena globals */
@@ -964,7 +1004,6 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth)
Res res;
Arena arena;
Ring node, nextNode;
- Index i;
TraceId ti;
Trace trace;
@@ -973,8 +1012,12 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth)
if (stream == NULL)
return ResFAIL;
+ res = WriteF(stream, depth, "Globals\n", NULL);
+ if (res != ResOK)
+ return res;
+
arena = GlobalsArena(arenaGlobals);
- res = WriteF(stream, depth,
+ res = WriteF(stream, depth + 2,
"mpsVersion $S\n", (WriteFS)arenaGlobals->mpsVersionString,
"lock $P\n", (WriteFP)arenaGlobals->lock,
"pollThreshold $U kB\n",
@@ -995,70 +1038,55 @@ Res GlobalsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth)
"rootSerial $U\n", (WriteFU)arenaGlobals->rootSerial,
"formatSerial $U\n", (WriteFU)arena->formatSerial,
"threadSerial $U\n", (WriteFU)arena->threadSerial,
- arena->insideShield ? "inside" : "outside", " shield\n",
"busyTraces $B\n", (WriteFB)arena->busyTraces,
"flippedTraces $B\n", (WriteFB)arena->flippedTraces,
- "epoch $U\n", (WriteFU)arena->epoch,
- "prehistory = $B\n", (WriteFB)arena->prehistory,
- "history {\n",
- " [note: indices are raw, not rotated]\n",
NULL);
if (res != ResOK)
return res;
- for(i=0; i < LDHistoryLENGTH; ++ i) {
- res = WriteF(stream, depth + 2,
- "[$U] = $B\n", (WriteFU)i, (WriteFB)arena->history[i],
- NULL);
- if (res != ResOK)
- return res;
- }
-
- res = WriteF(stream, depth,
- "} history\n",
- "suspended $S\n", WriteFYesNo(arena->suspended),
- "shDepth $U\n", (WriteFU)arena->shDepth,
- "shCacheI $U\n", (WriteFU)arena->shCacheI,
- /* @@@@ should SegDescribe the cached segs? */
- NULL);
+ res = HistoryDescribe(ArenaHistory(arena), stream, depth + 2);
if (res != ResOK)
return res;
- res = RootsDescribe(arenaGlobals, stream, depth);
+ res = ShieldDescribe(ArenaShield(arena), stream, depth + 2);
+ if (res != ResOK)
+ return res;
+
+ res = RootsDescribe(arenaGlobals, stream, depth + 2);
if (res != ResOK)
return res;
RING_FOR(node, &arenaGlobals->poolRing, nextNode) {
Pool pool = RING_ELT(Pool, arenaRing, node);
- res = PoolDescribe(pool, stream, depth);
+ res = PoolDescribe(pool, stream, depth + 2);
if (res != ResOK)
return res;
}
RING_FOR(node, &arena->formatRing, nextNode) {
Format format = RING_ELT(Format, arenaRing, node);
- res = FormatDescribe(format, stream, depth);
+ res = FormatDescribe(format, stream, depth + 2);
if (res != ResOK)
return res;
}
RING_FOR(node, &arena->threadRing, nextNode) {
Thread thread = ThreadRingThread(node);
- res = ThreadDescribe(thread, stream, depth);
+ res = ThreadDescribe(thread, stream, depth + 2);
if (res != ResOK)
return res;
}
RING_FOR(node, &arena->chainRing, nextNode) {
Chain chain = RING_ELT(Chain, chainRing, node);
- res = ChainDescribe(chain, stream, depth);
+ res = ChainDescribe(chain, stream, depth + 2);
if (res != ResOK)
return res;
}
TRACE_SET_ITER(ti, trace, TraceSetUNIV, arena)
if (TraceSetIsMember(arena->busyTraces, trace)) {
- res = TraceDescribe(trace, stream, depth);
+ res = TraceDescribe(trace, stream, depth + 2);
if (res != ResOK)
return res;
}
@@ -1103,7 +1131,7 @@ Bool ArenaEmergency(Arena arena)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/land.c b/mps/code/land.c
index 18d446288f8..18f2232f841 100644
--- a/mps/code/land.c
+++ b/mps/code/land.c
@@ -1,9 +1,16 @@
/* land.c: LAND (COLLECTION OF ADDRESS RANGES) IMPLEMENTATION
*
* $Id$
- * Copyright (c) 2014-2015 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2014-2016 Ravenbrook Limited. See end of file for license.
*
* .design:
+ *
+ * .critical.macros: In manual-allocation-bound programs using MVFF,
+ * the Land generic functions are on the critical path via mps_free.
+ * In non-checking varieties we provide macro alternatives (in mpm.h)
+ * to these functions that call the underlying methods directly,
+ * giving a few percent improvement in performance but skipping the
+ * re-entrancy checking provided by landEnter and landLeave.
*/
#include "mpm.h"
@@ -12,6 +19,12 @@
SRCID(land, "$Id$");
+/* Forward declarations */
+
+static Res landNoInsert(Range rangeReturn, Land land, Range range);
+static Res landNoDelete(Range rangeReturn, Land land, Range range);
+
+
/* FindDeleteCheck -- check method for a FindDelete value */
Bool FindDeleteCheck(FindDelete findDelete)
@@ -41,7 +54,6 @@ 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)
@@ -49,7 +61,6 @@ static void landLeave(Land land)
/* Don't need to check as always called from interface function. */
AVER(land->inLand);
land->inLand = FALSE;
- return;
}
@@ -57,102 +68,68 @@ static void landLeave(Land land)
Bool LandCheck(Land land)
{
+ LandClass klass;
/* .enter-leave.simple */
CHECKS(Land, land);
- CHECKD(LandClass, land->class);
+ CHECKC(Land, land);
+ klass = ClassOfPoly(Land, land);
+ CHECKD(LandClass, klass);
CHECKU(Arena, land->arena);
CHECKL(AlignCheck(land->alignment));
CHECKL(BoolCheck(land->inLand));
return TRUE;
}
+static Res LandAbsInit(Land land, Arena arena, Align alignment, ArgList args)
+{
+ AVER(land != NULL);
+ AVERT(Arena, arena);
+ AVERT(Align, alignment);
+ UNUSED(args);
+
+ /* Superclass init */
+ InstInit(CouldBeA(Inst, land));
+
+ land->inLand = TRUE;
+ land->alignment = alignment;
+ land->arena = arena;
+
+ SetClassOfPoly(land, CLASS(Land));
+ land->sig = LandSig;
+ AVERC(Land, land);
+
+ return ResOK;
+}
+
+static void LandAbsFinish(Inst inst)
+{
+ Land land = MustBeA(Land, inst);
+ AVERC(Land, land);
+ land->sig = SigInvalid;
+ NextMethod(Inst, Land, finish)(inst);
+}
+
/* LandInit -- initialize land
*
* See
*/
-Res LandInit(Land land, LandClass class, Arena arena, Align alignment, void *owner, ArgList args)
+Res LandInit(Land land, LandClass klass, Arena arena, Align alignment, void *owner, ArgList args)
{
Res res;
AVER(land != NULL);
- AVERT(LandClass, class);
+ AVERT(LandClass, klass);
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);
+ res = klass->init(land, arena, alignment, args);
if (res != ResOK)
- goto failInit;
+ return res;
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);
}
@@ -163,12 +140,10 @@ void LandDestroy(Land land)
void LandFinish(Land land)
{
- AVERT(Land, land);
+ AVERC(Land, land);
landEnter(land);
- (*land->class->finish)(land);
-
- land->sig = SigInvalid;
+ Method(Inst, land, finish)(MustBeA(Inst, land));
}
@@ -177,12 +152,12 @@ void LandFinish(Land land)
* See
*/
-Size LandSize(Land land)
+Size (LandSize)(Land land)
{
/* .enter-leave.simple */
- AVERT(Land, land);
+ AVERC(Land, land);
- return (*land->class->sizeMethod)(land);
+ return LandSizeMacro(land);
}
@@ -191,17 +166,18 @@ Size LandSize(Land land)
* See
*/
-Res LandInsert(Range rangeReturn, Land land, Range range)
+Res (LandInsert)(Range rangeReturn, Land land, Range range)
{
Res res;
AVER(rangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
AVERT(Range, range);
AVER(RangeIsAligned(range, land->alignment));
+ AVER(!RangeIsEmpty(range));
landEnter(land);
- res = (*land->class->insert)(rangeReturn, land, range);
+ res = LandInsertMacro(rangeReturn, land, range);
landLeave(land);
return res;
@@ -213,17 +189,17 @@ Res LandInsert(Range rangeReturn, Land land, Range range)
* See
*/
-Res LandDelete(Range rangeReturn, Land land, Range range)
+Res (LandDelete)(Range rangeReturn, Land land, Range range)
{
Res res;
AVER(rangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
AVERT(Range, range);
AVER(RangeIsAligned(range, land->alignment));
landEnter(land);
- res = (*land->class->delete)(rangeReturn, land, range);
+ res = LandDeleteMacro(rangeReturn, land, range);
landLeave(land);
return res;
@@ -235,14 +211,14 @@ Res LandDelete(Range rangeReturn, Land land, Range range)
* See
*/
-Bool LandIterate(Land land, LandVisitor visitor, void *closureP, Size closureS)
+Bool (LandIterate)(Land land, LandVisitor visitor, void *closure)
{
Bool b;
- AVERT(Land, land);
+ AVERC(Land, land);
AVER(FUNCHECK(visitor));
landEnter(land);
- b = (*land->class->iterate)(land, visitor, closureP, closureS);
+ b = LandIterateMacro(land, visitor, closure);
landLeave(land);
return b;
@@ -255,14 +231,14 @@ Bool LandIterate(Land land, LandVisitor visitor, void *closureP, Size closureS)
* See
*/
-Bool LandIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closureP, Size closureS)
+Bool (LandIterateAndDelete)(Land land, LandDeleteVisitor visitor, void *closure)
{
Bool b;
- AVERT(Land, land);
+ AVERC(Land, land);
AVER(FUNCHECK(visitor));
landEnter(land);
- b = (*land->class->iterateAndDelete)(land, visitor, closureP, closureS);
+ b = LandIterateAndDeleteMacro(land, visitor, closure);
landLeave(land);
return b;
@@ -274,19 +250,18 @@ Bool LandIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closureP,
* See
*/
-Bool LandFindFirst(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+Bool (LandFindFirst)(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
{
Bool b;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
AVER(SizeIsAligned(size, land->alignment));
AVERT(FindDelete, findDelete);
landEnter(land);
- b = (*land->class->findFirst)(rangeReturn, oldRangeReturn, land, size,
- findDelete);
+ b = LandFindFirstMacro(rangeReturn, oldRangeReturn, land, size, findDelete);
landLeave(land);
return b;
@@ -298,19 +273,18 @@ Bool LandFindFirst(Range rangeReturn, Range oldRangeReturn, Land land, Size size
* See
*/
-Bool LandFindLast(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+Bool (LandFindLast)(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
{
Bool b;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
AVER(SizeIsAligned(size, land->alignment));
AVERT(FindDelete, findDelete);
landEnter(land);
- b = (*land->class->findLast)(rangeReturn, oldRangeReturn, land, size,
- findDelete);
+ b = LandFindLastMacro(rangeReturn, oldRangeReturn, land, size, findDelete);
landLeave(land);
return b;
@@ -322,19 +296,18 @@ Bool LandFindLast(Range rangeReturn, Range oldRangeReturn, Land land, Size size,
* See
*/
-Bool LandFindLargest(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
+Bool (LandFindLargest)(Range rangeReturn, Range oldRangeReturn, Land land, Size size, FindDelete findDelete)
{
Bool b;
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
AVER(SizeIsAligned(size, land->alignment));
AVERT(FindDelete, findDelete);
landEnter(land);
- b = (*land->class->findLargest)(rangeReturn, oldRangeReturn, land, size,
- findDelete);
+ b = LandFindLargestMacro(rangeReturn, oldRangeReturn, land, size, findDelete);
landLeave(land);
return b;
@@ -346,21 +319,21 @@ Bool LandFindLargest(Range rangeReturn, Range oldRangeReturn, Land land, Size si
* See
*/
-Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn, Land land, Size size, ZoneSet zoneSet, Bool high)
+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);
+ AVERC(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);
+ res = LandFindInZonesMacro(foundReturn, rangeReturn, oldRangeReturn,
+ land, size, zoneSet, high);
landLeave(land);
return res;
@@ -374,53 +347,33 @@ Res LandFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRangeReturn,
Res LandDescribe(Land land, mps_lib_FILE *stream, Count depth)
{
- Res res;
-
- if (!TESTT(Land, land))
- return ResFAIL;
- if (stream == NULL)
- return ResFAIL;
-
- res = WriteF(stream, depth,
- "Land $P {\n", (WriteFP)land,
- " class $P", (WriteFP)land->class,
- " (\"$S\")\n", (WriteFS)land->class->name,
- " arena $P\n", (WriteFP)land->arena,
- " align $U\n", (WriteFU)land->alignment,
- " inLand $S\n", WriteFYesNo(land->inLand),
- NULL);
- if (res != ResOK)
- return res;
-
- res = (*land->class->describe)(land, stream, depth + 2);
- if (res != ResOK)
- return res;
-
- res = WriteF(stream, depth, "} Land $P\n", (WriteFP)land, NULL);
- return ResOK;
+ return Method(Inst, land, describe)(MustBeA(Inst, land), stream, depth);
}
/* landFlushVisitor -- visitor for LandFlush.
*
- * closureP argument is the destination Land. Attempt to insert the
+ * closure argument is the destination Land. Attempt to insert the
* range into the destination.
+ *
+ * .flush.critical: In manual-allocation-bound programs using MVFF
+ * this is on the critical paths via mps_alloc (and then PoolAlloc,
+ * MVFFAlloc, failoverFind*, LandFlush) and mps_free (and then
+ * MVFFFree, failoverInsert, LandFlush).
*/
-static Bool landFlushVisitor(Bool *deleteReturn, Land land, Range range,
- void *closureP, Size closureS)
+Bool LandFlushVisitor(Bool *deleteReturn, Land land, Range range,
+ void *closure)
{
Res res;
RangeStruct newRange;
Land dest;
- AVER(deleteReturn != NULL);
- AVERT(Land, land);
- AVERT(Range, range);
- AVER(closureP != NULL);
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureS);
+ AVER_CRITICAL(deleteReturn != NULL);
+ AVERC_CRITICAL(Land, land);
+ AVERT_CRITICAL(Range, range);
+ AVER_CRITICAL(closure != NULL);
- dest = closureP;
+ dest = MustBeA_CRITICAL(Land, closure);
res = LandInsert(&newRange, dest, range);
if (res == ResOK) {
*deleteReturn = TRUE;
@@ -437,50 +390,39 @@ static Bool landFlushVisitor(Bool *deleteReturn, Land land, Range range,
* See
*/
-Bool LandFlush(Land dest, Land src)
+Bool (LandFlush)(Land dest, Land src)
{
- AVERT(Land, dest);
- AVERT(Land, src);
+ AVERC(Land, dest);
+ AVERC(Land, src);
- return LandIterateAndDelete(src, landFlushVisitor, dest, UNUSED_SIZE);
+ return LandFlushMacro(dest, src);
}
/* LandClassCheck -- check land class */
-Bool LandClassCheck(LandClass class)
+Bool LandClassCheck(LandClass klass)
{
- 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);
+ CHECKL(InstClassCheck(&klass->instClassStruct));
+ CHECKL(klass->size >= sizeof(LandStruct));
+ CHECKL(FUNCHECK(klass->init));
+ CHECKL(FUNCHECK(klass->insert));
+ CHECKL(FUNCHECK(klass->delete));
+ CHECKL(FUNCHECK(klass->findFirst));
+ CHECKL(FUNCHECK(klass->findLast));
+ CHECKL(FUNCHECK(klass->findLargest));
+ CHECKL(FUNCHECK(klass->findInZones));
+
+ /* Check that land classes override sets of related methods. */
+ CHECKL((klass->init == LandAbsInit)
+ == (klass->instClassStruct.finish == LandAbsFinish));
+ CHECKL((klass->insert == landNoInsert) == (klass->delete == landNoDelete));
+
+ CHECKS(LandClass, klass);
return TRUE;
}
-static Res landTrivInit(Land land, ArgList args)
-{
- AVERT(Land, land);
- AVERT(ArgList, args);
- UNUSED(args);
- return ResOK;
-}
-
-static void landTrivFinish(Land land)
-{
- AVERT(Land, land);
- NOOP;
-}
-
static Size landNoSize(Land land)
{
UNUSED(land);
@@ -491,17 +433,15 @@ static Size landNoSize(Land land)
/* LandSlowSize -- generic size method but slow */
static Bool landSizeVisitor(Land land, Range range,
- void *closureP, Size closureS)
+ void *closure)
{
Size *size;
- AVERT(Land, land);
+ AVERC(Land, land);
AVERT(Range, range);
- AVER(closureP != NULL);
- AVER(closureS == UNUSED_SIZE);
- UNUSED(closureS);
+ AVER(closure != NULL);
- size = closureP;
+ size = closure;
*size += RangeSize(range);
return TRUE;
@@ -510,7 +450,7 @@ static Bool landSizeVisitor(Land land, Range range,
Size LandSlowSize(Land land)
{
Size size = 0;
- Bool b = LandIterate(land, landSizeVisitor, &size, UNUSED_SIZE);
+ Bool b = LandIterate(land, landSizeVisitor, &size);
AVER(b);
return size;
}
@@ -518,7 +458,7 @@ Size LandSlowSize(Land land)
static Res landNoInsert(Range rangeReturn, Land land, Range range)
{
AVER(rangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
AVERT(Range, range);
return ResUNIMPL;
}
@@ -526,26 +466,24 @@ static Res landNoInsert(Range rangeReturn, Land land, Range range)
static Res landNoDelete(Range rangeReturn, Land land, Range range)
{
AVER(rangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
AVERT(Range, range);
return ResUNIMPL;
}
-static Bool landNoIterate(Land land, LandVisitor visitor, void *closureP, Size closureS)
+static Bool landNoIterate(Land land, LandVisitor visitor, void *closure)
{
- AVERT(Land, land);
+ AVERC(Land, land);
AVER(visitor != NULL);
- UNUSED(closureP);
- UNUSED(closureS);
+ UNUSED(closure);
return FALSE;
}
-static Bool landNoIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closureP, Size closureS)
+static Bool landNoIterateAndDelete(Land land, LandDeleteVisitor visitor, void *closure)
{
- AVERT(Land, land);
+ AVERC(Land, land);
AVER(visitor != NULL);
- UNUSED(closureP);
- UNUSED(closureS);
+ UNUSED(closure);
return FALSE;
}
@@ -553,7 +491,7 @@ static Bool landNoFind(Range rangeReturn, Range oldRangeReturn, Land land, Size
{
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
UNUSED(size);
AVERT(FindDelete, findDelete);
return ResUNIMPL;
@@ -564,49 +502,68 @@ static Res landNoFindInZones(Bool *foundReturn, Range rangeReturn, Range oldRang
AVER(foundReturn != NULL);
AVER(rangeReturn != NULL);
AVER(oldRangeReturn != NULL);
- AVERT(Land, land);
+ AVERC(Land, land);
UNUSED(size);
UNUSED(zoneSet);
AVERT(Bool, high);
return ResUNIMPL;
}
-static Res landTrivDescribe(Land land, mps_lib_FILE *stream, Count depth)
+static Res LandAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth)
{
- if (!TESTT(Land, land))
- return ResFAIL;
+ Land land = CouldBeA(Land, inst);
+ LandClass klass;
+ Res res;
+
+ if (!TESTC(Land, land))
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
- UNUSED(depth);
- /* dispatching function does it all */
- return ResOK;
+ return ResPARAM;
+
+ res = NextMethod(Inst, Land, describe)(inst, stream, depth);
+ if (res != ResOK)
+ return res;
+
+ klass = ClassOfPoly(Land, land);
+ return WriteF(stream, depth + 2,
+ "class $P (\"$S\")\n",
+ (WriteFP)klass, (WriteFS)ClassName(klass),
+ "arena $P\n", (WriteFP)land->arena,
+ "align $U\n", (WriteFU)land->alignment,
+ "inLand $S\n", WriteFYesNo(land->inLand),
+ NULL);
}
-DEFINE_CLASS(LandClass, class)
+DEFINE_CLASS(Inst, LandClass, klass)
{
- 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);
+ INHERIT_CLASS(klass, LandClass, InstClass);
+ AVERT(InstClass, klass);
+}
+
+DEFINE_CLASS(Land, Land, klass)
+{
+ INHERIT_CLASS(&klass->instClassStruct, Land, Inst);
+ klass->instClassStruct.describe = LandAbsDescribe;
+ klass->instClassStruct.finish = LandAbsFinish;
+ klass->size = sizeof(LandStruct);
+ klass->init = LandAbsInit;
+ klass->sizeMethod = landNoSize;
+ klass->insert = landNoInsert;
+ klass->delete = landNoDelete;
+ klass->iterate = landNoIterate;
+ klass->iterateAndDelete = landNoIterateAndDelete;
+ klass->findFirst = landNoFind;
+ klass->findLast = landNoFind;
+ klass->findLargest = landNoFind;
+ klass->findInZones = landNoFindInZones;
+ klass->sig = LandClassSig;
+ AVERT(LandClass, klass);
}
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2014-2015 Ravenbrook Limited .
+ * Copyright (C) 2014-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/landtest.c b/mps/code/landtest.c
index eb4229f65e8..53a04cc98e7 100644
--- a/mps/code/landtest.c
+++ b/mps/code/landtest.c
@@ -1,7 +1,7 @@
/* landtest.c: LAND TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*
* Test all three Land implementations against duplicate operations on
* a bit-table.
@@ -62,18 +62,18 @@ static Index (indexOfAddr)(TestState state, Addr a)
}
-static void describe(TestState state) {
+static void describe(TestState state)
+{
die(LandDescribe(state->land, mps_lib_get_stdout(), 0), "LandDescribe");
}
-static Bool checkVisitor(Land land, Range range, void *closureP, Size closureS)
+static Bool checkVisitor(Land land, Range range, void *closure)
{
Addr base, limit;
- CheckTestClosure cl = closureP;
+ CheckTestClosure cl = closure;
testlib_unused(land);
- Insist(closureS == UNUSED_SIZE);
Insist(cl != NULL);
base = RangeBase(range);
@@ -106,7 +106,7 @@ static void check(TestState state)
closure.limit = addrOfIndex(state, state->size);
closure.oldLimit = state->block;
- b = LandIterate(state->land, checkVisitor, &closure, UNUSED_SIZE);
+ b = LandIterate(state->land, checkVisitor, &closure);
Insist(b);
if (closure.oldLimit == state->block)
@@ -385,11 +385,10 @@ static void find(TestState state, Size size, Bool high, FindDelete findDelete)
BTSetRange(state->allocTable, expectedBase, expectedLimit);
}
}
-
- return;
}
-static void test(TestState state, unsigned n) {
+static void test(TestState state, unsigned n, unsigned operations)
+{
Addr base, limit;
unsigned i;
Size size;
@@ -399,7 +398,7 @@ static void test(TestState state, unsigned n) {
BTSetRange(state->allocTable, 0, state->size); /* Initially all allocated */
check(state);
for(i = 0; i < n; i++) {
- switch(fbmRnd(3)) {
+ switch (fbmRnd(operations)) {
case 0:
randomRange(&base, &limit, state);
allocate(state, base, limit);
@@ -420,7 +419,7 @@ static void test(TestState state, unsigned n) {
find(state, size, high, findDelete);
break;
default:
- cdie(0, "invalid rnd(3)");
+ cdie(0, "invalid operation");
return;
}
if ((i + 1) % 1000 == 0)
@@ -430,8 +429,16 @@ static void test(TestState state, unsigned n) {
#define testArenaSIZE (((size_t)4)<<20)
-extern int main(int argc, char *argv[])
+int main(int argc, char *argv[])
{
+ static const struct {
+ LandClass (*klass)(void);
+ unsigned operations;
+ } cbsConfig[] = {
+ {CBSClassGet, 2},
+ {CBSFastClassGet, 3},
+ {CBSZonedClassGet, 3},
+ };
mps_arena_t mpsArena;
Arena arena;
TestStateStruct state;
@@ -444,7 +451,7 @@ extern int main(int argc, char *argv[])
Land fl = FreelistLand(&flStruct);
Land fo = FailoverLand(&foStruct);
Pool mfs = MFSPool(&blockPool);
- int i;
+ size_t i;
testlib_init(argc, argv);
state.size = ArraySize;
@@ -460,8 +467,7 @@ extern int main(int argc, char *argv[])
die((mps_res_t)BTCreate(&state.allocTable, arena, state.size),
"failed to create alloc table");
- die((mps_res_t)ControlAlloc(&p, arena, (state.size + 1) * state.align,
- /* withReservoirPermit */ FALSE),
+ die((mps_res_t)ControlAlloc(&p, arena, (state.size + 1) * state.align),
"failed to allocate block");
state.block = AddrAlignUp(p, state.align);
@@ -472,22 +478,24 @@ extern int main(int argc, char *argv[])
/* 1. Test CBS */
- MPS_ARGS_BEGIN(args) {
- die((mps_res_t)LandInit(cbs, CBSFastLandClassGet(), arena, state.align,
- NULL, args),
- "failed to initialise CBS");
- } MPS_ARGS_END(args);
- state.land = cbs;
- test(&state, nCBSOperations);
- LandFinish(cbs);
+ for (i = 0; i < NELEMS(cbsConfig); ++i) {
+ MPS_ARGS_BEGIN(args) {
+ die((mps_res_t)LandInit(cbs, cbsConfig[i].klass(), arena, state.align,
+ NULL, args),
+ "failed to initialise CBS");
+ } MPS_ARGS_END(args);
+ state.land = cbs;
+ test(&state, nCBSOperations, cbsConfig[i].operations);
+ LandFinish(cbs);
+ }
/* 2. Test Freelist */
- die((mps_res_t)LandInit(fl, FreelistLandClassGet(), arena, state.align,
+ die((mps_res_t)LandInit(fl, CLASS(Freelist), arena, state.align,
NULL, mps_args_none),
"failed to initialise Freelist");
state.land = fl;
- test(&state, nFLOperations);
+ test(&state, nFLOperations, 3);
LandFinish(fl);
/* 3. Test CBS-failing-over-to-Freelist (always failing over on
@@ -499,30 +507,30 @@ extern int main(int argc, char *argv[])
MPS_ARGS_BEGIN(piArgs) {
MPS_ARGS_ADD(piArgs, MPS_KEY_MFS_UNIT_SIZE, sizeof(CBSFastBlockStruct));
MPS_ARGS_ADD(piArgs, MPS_KEY_EXTEND_BY, ArenaGrainSize(arena));
- MPS_ARGS_ADD(piArgs, MFSExtendSelf, i);
+ MPS_ARGS_ADD(piArgs, MFSExtendSelf, i != 0);
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, state.align,
+ die((mps_res_t)LandInit(cbs, CLASS(CBSFast), arena, state.align,
NULL, args),
"failed to initialise CBS");
} MPS_ARGS_END(args);
- die((mps_res_t)LandInit(fl, FreelistLandClassGet(), arena, state.align,
+ die((mps_res_t)LandInit(fl, CLASS(Freelist), arena, state.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, state.align,
+ die((mps_res_t)LandInit(fo, CLASS(Failover), arena, state.align,
NULL, args),
"failed to initialise Failover");
} MPS_ARGS_END(args);
state.land = fo;
- test(&state, nFOOperations);
+ test(&state, nFOOperations, 3);
LandFinish(fo);
LandFinish(fl);
LandFinish(cbs);
@@ -547,7 +555,7 @@ extern int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/ld.c b/mps/code/ld.c
index c9e79f8a762..71264ff78a7 100644
--- a/mps/code/ld.c
+++ b/mps/code/ld.c
@@ -51,6 +51,88 @@
SRCID(ld, "$Id$");
+void HistoryInit(History history)
+{
+ Index i;
+
+ AVER(history != NULL);
+
+ history->epoch = 0;
+ history->prehistory = RefSetEMPTY;
+ for (i = 0; i < LDHistoryLENGTH; ++i)
+ history->history[i] = RefSetEMPTY;
+
+ history->sig = HistorySig;
+ AVERT(History, history);
+}
+
+Bool HistoryCheck(History history)
+{
+ Index i;
+ RefSet rs;
+
+ CHECKS(History, history);
+
+ /* check that each history entry is a subset of the next oldest */
+ rs = RefSetEMPTY;
+ /* note this loop starts from 1; there is no history age 0 */
+ for (i = 1; i <= LDHistoryLENGTH; ++i) {
+ /* check history age 'i'; 'j' is the history index. */
+ Index j = (history->epoch + LDHistoryLENGTH - i) % LDHistoryLENGTH;
+ CHECKL(RefSetSub(rs, history->history[j]));
+ rs = history->history[j];
+ }
+ /* the oldest history entry must be a subset of the prehistory */
+ CHECKL(RefSetSub(rs, history->prehistory));
+
+ return TRUE;
+}
+
+void HistoryFinish(History history)
+{
+ AVERT(History, history);
+ history->sig = SigInvalid;
+}
+
+Res HistoryDescribe(History history, mps_lib_FILE *stream, Count depth)
+{
+ Res res;
+ Index i;
+
+ if (!TESTT(History, history))
+ return ResPARAM;
+ if (stream == NULL)
+ return ResPARAM;
+
+ res = WriteF(stream, depth,
+ "History $P {\n", (WriteFP)history,
+ " epoch = $U\n", (WriteFU)history->epoch,
+ " prehistory = $B\n", (WriteFB)history->prehistory,
+ " history {\n",
+ " [note: indices are raw, not rotated]\n",
+ NULL);
+ if (res != ResOK)
+ return res;
+
+ for (i = 0; i < LDHistoryLENGTH; ++i) {
+ res = WriteF(stream, depth + 4,
+ "[$U] = $B\n", (WriteFU)i, (WriteFB)history->history[i],
+ NULL);
+ if (res != ResOK)
+ return res;
+ }
+
+ res = WriteF(stream, depth,
+ " }\n",
+ "} History $P\n", (WriteFP)history,
+ NULL);
+ if (res != ResOK)
+ return res;
+
+ return ResOK;
+}
+
+
/* LDReset -- reset a dependency to empty
*
* .reset.sync: This does not need to be synchronized with LDAge
@@ -68,7 +150,7 @@ void LDReset(mps_ld_t ld, Arena arena)
b = SegOfAddr(&seg, arena, (Addr)ld);
if (b)
ShieldExpose(arena, seg); /* .ld.access */
- ld->_epoch = arena->epoch;
+ ld->_epoch = ArenaHistory(arena)->epoch;
ld->_rs = RefSetEMPTY;
if (b)
ShieldCover(arena, seg);
@@ -106,7 +188,7 @@ void LDAdd(mps_ld_t ld, Arena arena, Addr addr)
{
AVER(ld != NULL);
AVER(TESTT(Arena, arena)); /* see .add.lock-free */
- AVER(ld->_epoch <= arena->epoch);
+ AVER(ld->_epoch <= ArenaHistory(arena)->epoch);
ld->_rs = RefSetAdd(arena, ld->_rs, addr);
}
@@ -134,23 +216,25 @@ void LDAdd(mps_ld_t ld, Arena arena, Addr addr)
*/
Bool LDIsStaleAny(mps_ld_t ld, Arena arena)
{
+ History history;
RefSet rs;
AVER(ld != NULL);
AVER(TESTT(Arena, arena)); /* .stale.thread-safe */
- AVER(ld->_epoch <= arena->epoch);
+ history = ArenaHistory(arena);
+ AVER(ld->_epoch <= history->epoch);
- if (arena->epoch == ld->_epoch) /* .stale.current */
+ if (history->epoch == ld->_epoch) /* .stale.current */
return FALSE;
/* Load the history refset, _then_ check to see if it's recent.
* This may in fact load an okay refset, which we decide to throw
* away and use the pre-history instead. */
- rs = arena->history[ld->_epoch % LDHistoryLENGTH];
+ rs = history->history[ld->_epoch % LDHistoryLENGTH];
/* .stale.recent */
/* .stale.recent.conservative */
- if (arena->epoch - ld->_epoch > LDHistoryLENGTH) {
- rs = arena->prehistory; /* .stale.old */
+ if (history->epoch - ld->_epoch > LDHistoryLENGTH) {
+ rs = history->prehistory; /* .stale.old */
}
return RefSetInter(ld->_rs, rs) != RefSetEMPTY;
@@ -186,28 +270,30 @@ Bool LDIsStale(mps_ld_t ld, Arena arena, Addr addr)
*/
void LDAge(Arena arena, RefSet rs)
{
+ History history;
Size i;
AVERT(Arena, arena);
+ history = ArenaHistory(arena);
AVER(rs != RefSetEMPTY);
/* Replace the entry for epoch - LDHistoryLENGTH by an empty */
/* set which will become the set which has moved since the */
/* current epoch. */
- arena->history[arena->epoch % LDHistoryLENGTH] = RefSetEMPTY;
+ history->history[history->epoch % LDHistoryLENGTH] = RefSetEMPTY;
/* Record the fact that the moved set has moved, by adding it */
/* to all the sets in the history, including the set for the */
/* current epoch. */
for(i = 0; i < LDHistoryLENGTH; ++i)
- arena->history[i] = RefSetUnion(arena->history[i], rs);
+ history->history[i] = RefSetUnion(history->history[i], rs);
/* This is the union of all movement since time zero. */
- arena->prehistory = RefSetUnion(arena->prehistory, rs);
+ history->prehistory = RefSetUnion(history->prehistory, rs);
/* Advance the epoch by one. */
- ++arena->epoch;
- AVER(arena->epoch != 0); /* .epoch-size */
+ ++history->epoch;
+ AVER(history->epoch != 0); /* .epoch-size */
}
@@ -221,9 +307,9 @@ void LDMerge(mps_ld_t ld, Arena arena, mps_ld_t from)
{
AVER(ld != NULL);
AVER(TESTT(Arena, arena)); /* .merge.lock-free */
- AVER(ld->_epoch <= arena->epoch);
+ AVER(ld->_epoch <= ArenaHistory(arena)->epoch);
AVER(from != NULL);
- AVER(from->_epoch <= arena->epoch);
+ AVER(from->_epoch <= ArenaHistory(arena)->epoch);
/* If a reference has been added since epoch e1 then I've */
/* certainly added since epoch e0 where e0 < e1. Therefore */
diff --git a/mps/code/lii3gc.gmk b/mps/code/lii3gc.gmk
index 00be40c673c..2795633655f 100644
--- a/mps/code/lii3gc.gmk
+++ b/mps/code/lii3gc.gmk
@@ -3,19 +3,19 @@
# lii3gc.gmk: BUILD FOR LINUX/x86/GCC PLATFORM
#
# $Id$
-# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
PFM = lii3gc
MPMPF = \
- lockli.c \
- prmci3li.c \
- proti3.c \
+ lockix.c \
+ prmci3.c \
+ prmcix.c \
+ prmclii3.c \
protix.c \
- protli.c \
+ protsgix.c \
pthrdext.c \
span.c \
- ssixi3.c \
thix.c \
vmix.c
@@ -27,7 +27,7 @@ include comm.gmk
# C. COPYRIGHT AND LICENSE
#
-# Copyright (C) 2001-2014 Ravenbrook Limited .
+# Copyright (C) 2001-2016 Ravenbrook Limited .
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
diff --git a/mps/code/lii6gc.gmk b/mps/code/lii6gc.gmk
index 91f8f5d9066..dd04715299f 100644
--- a/mps/code/lii6gc.gmk
+++ b/mps/code/lii6gc.gmk
@@ -3,19 +3,19 @@
# lii6gc.gmk: BUILD FOR LINUX/x64/GCC PLATFORM
#
# $Id$
-# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
PFM = lii6gc
MPMPF = \
- lockli.c \
- prmci6li.c \
- proti6.c \
+ lockix.c \
+ prmci6.c \
+ prmcix.c \
+ prmclii6.c \
protix.c \
- protli.c \
+ protsgix.c \
pthrdext.c \
span.c \
- ssixi6.c \
thix.c \
vmix.c
@@ -27,7 +27,7 @@ include comm.gmk
# C. COPYRIGHT AND LICENSE
#
-# Copyright (C) 2001-2014 Ravenbrook Limited .
+# Copyright (C) 2001-2016 Ravenbrook Limited .
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
diff --git a/mps/code/lii6ll.gmk b/mps/code/lii6ll.gmk
index 5988b0c0b17..048ccb9f242 100644
--- a/mps/code/lii6ll.gmk
+++ b/mps/code/lii6ll.gmk
@@ -3,19 +3,19 @@
# lii6ll.gmk: BUILD FOR LINUX/x64/Clang PLATFORM
#
# $Id$
-# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+# Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
PFM = lii6ll
MPMPF = \
- lockli.c \
- prmci6li.c \
- proti6.c \
+ lockix.c \
+ prmci6.c \
+ prmcix.c \
+ prmclii6.c \
protix.c \
- protli.c \
+ protsgix.c \
pthrdext.c \
span.c \
- ssixi6.c \
thix.c \
vmix.c
@@ -27,7 +27,7 @@ include comm.gmk
# C. COPYRIGHT AND LICENSE
#
-# Copyright (C) 2001-2014 Ravenbrook Limited .
+# Copyright (C) 2001-2016 Ravenbrook Limited .
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#
diff --git a/mps/code/ll.gmk b/mps/code/ll.gmk
index 787380fb3ed..db30cde45f0 100644
--- a/mps/code/ll.gmk
+++ b/mps/code/ll.gmk
@@ -13,7 +13,6 @@ CC = clang
CFLAGSDEBUG = -O0 -g3
CFLAGSOPT = -O2 -g3
CFLAGSCOMPILER := \
- -pedantic \
-Waggregate-return \
-Wall \
-Wcast-qual \
@@ -32,7 +31,7 @@ CFLAGSCOMPILER := \
-Wstrict-prototypes \
-Wunreachable-code \
-Wwrite-strings
-CFLAGSCOMPILERSTRICT :=
+CFLAGSCOMPILERSTRICT := -std=c89 -pedantic
# A different set of compiler flags for less strict compilation, for
# instance when we need to #include a third-party header file that
diff --git a/mps/code/lock.h b/mps/code/lock.h
index 35d0ed6db41..32664d2262a 100644
--- a/mps/code/lock.h
+++ b/mps/code/lock.h
@@ -21,6 +21,11 @@
extern size_t LockSize(void);
+/* LockInitGlobal -- initialize global locks */
+
+extern void LockInitGlobal(void);
+
+
/* LockInit/Finish
*
* lock points to the allocated lock structure. A lock has no
@@ -78,6 +83,11 @@ extern void LockRelease(Lock lock);
extern Bool LockCheck(Lock lock);
+/* LockIsHeld -- test whether lock is held by any thread */
+
+extern Bool LockIsHeld(Lock lock);
+
+
/* == Global locks == */
@@ -123,24 +133,9 @@ extern void LockClaimGlobal(void);
extern void LockReleaseGlobal(void);
-#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)
-#define LockClaimRecursive(lock) UNUSED(lock)
-#define LockReleaseRecursive(lock) UNUSED(lock)
-#define LockClaim(lock) UNUSED(lock)
-#define LockRelease(lock) UNUSED(lock)
-#define LockCheck(lock) ((void)lock, TRUE)
-#define LockClaimGlobalRecursive()
-#define LockReleaseGlobalRecursive()
-#define LockClaimGlobal()
-#define LockReleaseGlobal()
-#else
-#error "No lock configuration."
-#endif /* LOCK */
+/* LockSetup -- one-time lock initialization */
+
+extern void LockSetup(void);
#endif /* lock_h */
diff --git a/mps/code/lockan.c b/mps/code/lockan.c
index fe5082a6ebf..061b63d20a9 100644
--- a/mps/code/lockan.c
+++ b/mps/code/lockan.c
@@ -79,6 +79,12 @@ void (LockReleaseRecursive)(Lock lock)
--lock->claims;
}
+Bool (LockIsHeld)(Lock lock)
+{
+ AVERT(Lock, lock);
+ return lock->claims > 0;
+}
+
/* Global locking is performed by normal locks.
* A separate lock structure is used for recursive and
@@ -100,6 +106,13 @@ static Lock globalLock = &globalLockStruct;
static Lock globalRecLock = &globalRecursiveLockStruct;
+void LockInitGlobal(void)
+{
+ globalLock->claims = 0;
+ LockInit(globalLock);
+ globalRecLock->claims = 0;
+ LockInit(globalRecLock);
+}
void (LockClaimGlobalRecursive)(void)
{
@@ -121,6 +134,11 @@ void (LockReleaseGlobal)(void)
LockRelease(globalLock);
}
+void LockSetup(void)
+{
+ /* Nothing to do as ANSI platform does not have fork(). */
+}
+
/* C. COPYRIGHT AND LICENSE
*
diff --git a/mps/code/lockcov.c b/mps/code/lockcov.c
index 84866046d82..af225d07c40 100644
--- a/mps/code/lockcov.c
+++ b/mps/code/lockcov.c
@@ -39,20 +39,28 @@ int main(int argc, char *argv[])
Insist(b != NULL);
LockInit(a);
+ Insist(!LockIsHeld(a));
LockInit(b);
+ Insist(!LockIsHeld(b));
LockClaimGlobal();
LockClaim(a);
+ Insist(LockIsHeld(a));
LockClaimRecursive(b);
+ Insist(LockIsHeld(b));
LockClaimGlobalRecursive();
LockReleaseGlobal();
LockClaimGlobal();
LockRelease(a);
+ Insist(!LockIsHeld(a));
LockClaimGlobalRecursive();
LockReleaseGlobal();
LockClaimRecursive(b);
+ Insist(LockIsHeld(b));
LockFinish(a);
LockReleaseRecursive(b);
+ Insist(LockIsHeld(b));
LockReleaseRecursive(b);
+ Insist(!LockIsHeld(b));
LockFinish(b);
LockInit(a);
LockClaim(a);
diff --git a/mps/code/lockix.c b/mps/code/lockix.c
index c982bf0cb17..17aab7bd014 100644
--- a/mps/code/lockix.c
+++ b/mps/code/lockix.c
@@ -1,7 +1,7 @@
/* lockix.c: RECURSIVE LOCKS FOR POSIX SYSTEMS
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*
* .posix: The implementation uses a POSIX interface, and should be reusable
* for many Unix-like operating systems.
@@ -9,7 +9,7 @@
* .freebsd: This implementation supports FreeBSD (platform
* MPS_OS_FR).
*
- * .darwin: This implementation supports Darwin (OS X) (platform
+ * .darwin: This implementation supports Darwin (macOS) (platform
* MPS_OS_XC).
*
* .design: These locks are implemented using mutexes.
@@ -24,25 +24,26 @@
* number of claims acquired on a lock. This field must only be
* modified while we hold the mutex.
*
- * .from: This version was copied from the FreeBSD version (lockfr.c)
- * which was itself a cleaner version of the Linux version (lockli.c).
+ * .from: This was copied from the FreeBSD implementation (lockfr.c)
+ * which was itself a cleaner version of the LinuxThreads
+ * implementation (lockli.c).
*/
-#include
+#include "mpm.h"
+
+#if !defined(MPS_OS_FR) && !defined(MPS_OS_LI) && !defined(MPS_OS_XC)
+#error "lockix.c is specific to MPS_OS_FR, MPS_OS_LI or MPS_OS_XC"
+#endif
+
+#include "lock.h"
+
+#include /* see .feature.li in config.h */
#include
#include
-#include "mpmtypes.h"
-#include "lock.h"
-#include "config.h"
-
-
-#if !defined(MPS_OS_FR) && !defined(MPS_OS_XC)
-#error "lockix.c is Unix specific, currently for MPS_OS_FR XC."
-#endif
-
SRCID(lockix, "$Id$");
+#if defined(LOCK)
/* LockStruct -- the MPS lock structure
*
@@ -122,7 +123,7 @@ void (LockClaim)(Lock lock)
res = pthread_mutex_lock(&lock->mut);
/* pthread_mutex_lock will error if we own the lock already. */
- AVER(res == 0);
+ AVER(res == 0); /* */
/* This should be the first claim. Now we own the mutex */
/* it is ok to check this. */
@@ -158,8 +159,8 @@ void (LockClaimRecursive)(Lock lock)
/* pthread_mutex_lock will return: */
/* 0 if we have just claimed the lock */
/* EDEADLK if we own the lock already. */
- AVER((res == 0 && lock->claims == 0) ||
- (res == EDEADLK && lock->claims > 0));
+ AVER((res == 0) == (lock->claims == 0));
+ AVER((res == EDEADLK) == (lock->claims > 0));
++lock->claims;
AVER(lock->claims > 0);
@@ -183,6 +184,21 @@ void (LockReleaseRecursive)(Lock lock)
}
+/* LockIsHeld -- test whether lock is held */
+
+Bool (LockIsHeld)(Lock lock)
+{
+ AVERT(Lock, lock);
+ if (pthread_mutex_trylock(&lock->mut) == 0) {
+ Bool claimed = lock->claims > 0;
+ int res = pthread_mutex_unlock(&lock->mut);
+ AVER(res == 0);
+ return claimed;
+ }
+ return TRUE;
+}
+
+
/* Global locks
*
* .global: The two "global" locks are statically allocated normal locks.
@@ -194,7 +210,7 @@ static Lock globalLock = &globalLockStruct;
static Lock globalRecLock = &globalRecLockStruct;
static pthread_once_t isGlobalLockInit = PTHREAD_ONCE_INIT;
-static void globalLockInit(void)
+void LockInitGlobal(void)
{
LockInit(globalLock);
LockInit(globalRecLock);
@@ -208,7 +224,7 @@ void (LockClaimGlobalRecursive)(void)
int res;
/* Ensure the global lock has been initialized */
- res = pthread_once(&isGlobalLockInit, globalLockInit);
+ res = pthread_once(&isGlobalLockInit, LockInitGlobal);
AVER(res == 0);
LockClaimRecursive(globalRecLock);
}
@@ -229,7 +245,7 @@ void (LockClaimGlobal)(void)
int res;
/* Ensure the global lock has been initialized */
- res = pthread_once(&isGlobalLockInit, globalLockInit);
+ res = pthread_once(&isGlobalLockInit, LockInitGlobal);
AVER(res == 0);
LockClaim(globalLock);
}
@@ -243,9 +259,26 @@ void (LockReleaseGlobal)(void)
}
+/* LockSetup -- one-time lock initialization */
+
+void LockSetup(void)
+{
+ /* Claim all locks before a fork; release in the parent;
+ reinitialize in the child */
+ pthread_atfork(GlobalsClaimAll, GlobalsReleaseAll, GlobalsReinitializeAll);
+}
+
+
+#elif defined(LOCK_NONE)
+#include "lockan.c"
+#else
+#error "No lock configuration."
+#endif
+
+
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/lockli.c b/mps/code/lockli.c
deleted file mode 100644
index 0dc98fb8a25..00000000000
--- a/mps/code/lockli.c
+++ /dev/null
@@ -1,299 +0,0 @@
-/* lockli.c: RECURSIVE LOCKS FOR POSIX SYSTEMS
- *
- * $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
- *
- * .linux: This implementation currently just supports LinuxThreads
- * (platform MPS_OS_LI), Single Unix i/f.
- *
- * .posix: In fact, the implementation should be reusable for most POSIX
- * implementations, but may need some customization for each.
- *
- * .design: These locks are implemented using mutexes.
- *
- * .recursive: Mutexes support both non-recursive and recursive locking, but
- * only at initialization time. This doesn't match the API of MPS Lock module,
- * which chooses at locking time, so all locks are made (non-recursive)
- * errorchecking. Recursive locks are implemented by checking the error
- * code.
- *
- * .claims: During use the claims field is updated to remember the number of
- * claims acquired on a lock. This field must only be modified
- * while we hold the mutex.
- */
-
-#include "mpmtypes.h"
-#include "lock.h"
-#include "config.h"
-
-#include /* see .feature.li in config.h */
-#include
-#include
-
-
-#ifndef MPS_OS_LI
-#error "lockli.c is specific to LinuxThreads but MPS_OS_LI not defined"
-#endif
-
-SRCID(lockli, "$Id$");
-
-
-/* LockAttrSetRecursive -- Set mutexattr to permit recursive locking
- *
- * There's a standard way to do this - but early LinuxThreads doesn't
- * quite follow the standard. Some other implementations might not
- * either.
- */
-
-#ifdef OLD_LINUXTHREADS
-
-#define LockAttrSetRecursive(attrptr) \
- pthread_mutexattr_setkind_np(attrptr, PTHREAD_MUTEX_ERRORCHECK_NP)
-
-#else
-
-#define LockAttrSetRecursive(attrptr) \
- pthread_mutexattr_settype(attrptr, PTHREAD_MUTEX_ERRORCHECK)
-
-#endif
-
-
-/* LockStruct -- the MPS lock structure
- *
- * .lock.posix: Posix lock structure; uses a mutex.
- */
-
-typedef struct LockStruct {
- Sig sig; /* */
- unsigned long claims; /* # claims held by owner */
- pthread_mutex_t mut; /* the mutex itself */
-} LockStruct;
-
-
-/* LockSize -- size of a LockStruct */
-
-size_t (LockSize)(void)
-{
- return sizeof(LockStruct);
-}
-
-
-/* LockCheck -- check a 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. */
- /* There's no way to test the mutex, or check if it's held by somebody. */
- return TRUE;
-}
-
-
-/* LockInit -- initialize a lock */
-
-void (LockInit)(Lock lock)
-{
- pthread_mutexattr_t attr;
- int res;
-
- AVER(lock != NULL);
- lock->claims = 0;
- res = pthread_mutexattr_init(&attr);
- AVER(res == 0);
- res = LockAttrSetRecursive(&attr);
- AVER(res == 0);
- res = pthread_mutex_init(&lock->mut, &attr);
- AVER(res == 0);
- res = pthread_mutexattr_destroy(&attr);
- AVER(res == 0);
- lock->sig = LockSig;
- AVERT(Lock, lock);
-}
-
-
-/* LockFinish -- finish a lock */
-
-void (LockFinish)(Lock lock)
-{
- int res;
-
- AVERT(Lock, lock);
- /* Lock should not be finished while held */
- AVER(lock->claims == 0);
- res = pthread_mutex_destroy(&lock->mut);
- AVER(res == 0);
- lock->sig = SigInvalid;
-}
-
-
-/* LockClaim -- claim a lock (non-recursive) */
-
-void (LockClaim)(Lock lock)
-{
- int res;
-
- AVERT(Lock, lock);
-
- res = pthread_mutex_lock(&lock->mut);
- /* pthread_mutex_lock will error if we own the lock already. */
- AVER(res == 0);
-
- /* This should be the first claim. Now we own the mutex */
- /* it is ok to check this. */
- AVER(lock->claims == 0);
- lock->claims = 1;
-}
-
-
-/* LockRelease -- release a lock (non-recursive) */
-
-void (LockRelease)(Lock lock)
-{
- int res;
-
- AVERT(Lock, lock);
- AVER(lock->claims == 1); /* The lock should only be held once */
- lock->claims = 0; /* Must set this before releasing the lock */
- res = pthread_mutex_unlock(&lock->mut);
- /* pthread_mutex_unlock will error if we didn't own the lock. */
- AVER(res == 0);
-}
-
-
-/* LockClaimRecursive -- claim a lock (recursive) */
-
-void (LockClaimRecursive)(Lock lock)
-{
- int res;
-
- AVERT(Lock, lock);
-
- res = pthread_mutex_lock(&lock->mut);
- /* pthread_mutex_lock will return: */
- /* 0 if we have just claimed the lock */
- /* EDEADLK if we own the lock already. */
- AVER((res == 0 && lock->claims == 0) ||
- (res == EDEADLK && lock->claims > 0));
-
- ++lock->claims;
- AVER(lock->claims > 0);
-}
-
-
-/* LockReleaseRecursive -- release a lock (recursive) */
-
-void (LockReleaseRecursive)(Lock lock)
-{
- int res;
-
- AVERT(Lock, lock);
- AVER(lock->claims > 0);
- --lock->claims;
- if (lock->claims == 0) {
- res = pthread_mutex_unlock(&lock->mut);
- /* pthread_mutex_unlock will error if we didn't own the lock. */
- AVER(res == 0);
- }
-}
-
-
-/* Global locks
- *
- * .global: The two "global" locks are statically allocated normal locks.
- */
-
-static LockStruct globalLockStruct;
-static LockStruct globalRecLockStruct;
-static Lock globalLock = &globalLockStruct;
-static Lock globalRecLock = &globalRecLockStruct;
-static pthread_once_t isGlobalLockInit = PTHREAD_ONCE_INIT;
-
-static void globalLockInit(void)
-{
- LockInit(globalLock);
- LockInit(globalRecLock);
-}
-
-
-/* LockClaimGlobalRecursive -- claim the global recursive lock */
-
-void (LockClaimGlobalRecursive)(void)
-{
- int res;
-
- /* Ensure the global lock has been initialized */
- res = pthread_once(&isGlobalLockInit, globalLockInit);
- AVER(res == 0);
- LockClaimRecursive(globalRecLock);
-}
-
-
-/* LockReleaseGlobalRecursive -- release the global recursive lock */
-
-void (LockReleaseGlobalRecursive)(void)
-{
- LockReleaseRecursive(globalRecLock);
-}
-
-
-/* LockClaimGlobal -- claim the global non-recursive lock */
-
-void (LockClaimGlobal)(void)
-{
- int res;
-
- /* Ensure the global lock has been initialized */
- res = pthread_once(&isGlobalLockInit, globalLockInit);
- AVER(res == 0);
- LockClaim(globalLock);
-}
-
-
-/* LockReleaseGlobal -- release the global non-recursive lock */
-
-void (LockReleaseGlobal)(void)
-{
- LockRelease(globalLock);
-}
-
-
-/* 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/lockut.c b/mps/code/lockut.c
index a6e592988f1..9f9637914f0 100644
--- a/mps/code/lockut.c
+++ b/mps/code/lockut.c
@@ -57,7 +57,14 @@ static void inc(unsigned long i)
#define COUNT 100000l
static void *thread0(void *p)
{
+ unsigned i;
testlib_unused(p);
+ LockClaimGlobal();
+ LockReleaseGlobal();
+ for (i = 0; i < COUNT; ++i)
+ LockClaimGlobalRecursive();
+ for (i = 0; i < COUNT; ++i)
+ LockReleaseGlobalRecursive();
inc(COUNT);
return NULL;
}
diff --git a/mps/code/lockw3.c b/mps/code/lockw3.c
index 53da970aed2..ba177c6b68b 100644
--- a/mps/code/lockw3.c
+++ b/mps/code/lockw3.c
@@ -1,7 +1,7 @@
/* lockw3.c: RECURSIVE LOCKS IN WIN32
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*
* .design: These are implemented using critical sections.
* See the section titled "Synchronization functions" in the Groups
@@ -23,14 +23,15 @@
#include "mpm.h"
-#ifndef MPS_OS_W3
-#error "lockw3.c is specific to Win32 but MPS_OS_W3 not defined"
+#if !defined(MPS_OS_W3)
+#error "lockw3.c is specific to MPS_OS_W3"
#endif
#include "mpswin.h"
SRCID(lockw3, "$Id$");
+#if defined(LOCK)
/* .lock.win32: Win32 lock structure; uses CRITICAL_SECTION */
typedef struct LockStruct {
@@ -75,7 +76,7 @@ void (LockClaim)(Lock lock)
EnterCriticalSection(&lock->cs);
/* This should be the first claim. Now we are inside the
* critical section it is ok to check this. */
- AVER(lock->claims == 0);
+ AVER(lock->claims == 0); /* */
lock->claims = 1;
}
@@ -103,6 +104,15 @@ void (LockReleaseRecursive)(Lock lock)
LeaveCriticalSection(&lock->cs);
}
+Bool (LockIsHeld)(Lock lock)
+{
+ if (TryEnterCriticalSection(&lock->cs)) {
+ Bool claimed = lock->claims > 0;
+ LeaveCriticalSection(&lock->cs);
+ return claimed;
+ }
+ return TRUE;
+}
/* Global locking is performed by normal locks.
@@ -117,16 +127,41 @@ static Lock globalLock = &globalLockStruct;
static Lock globalRecLock = &globalRecLockStruct;
static Bool globalLockInit = FALSE; /* TRUE iff initialized */
+void LockInitGlobal(void)
+{
+ globalLock->claims = 0;
+ LockInit(globalLock);
+ globalRecLock->claims = 0;
+ LockInit(globalRecLock);
+ globalLockInit = TRUE;
+}
+
+/* lockEnsureGlobalLock -- one-time initialization of global locks
+ *
+ * InitOnceExecuteOnce ensures that only one thread can be running the
+ * callback at a time, which allows to safely check globalLockInit. See
+ *
+ * but note that at time of writing (2018-06-27) the documentation has
+ * the arguments the wrong way round (parameter comes before context).
+ */
+
+static BOOL CALLBACK lockEnsureGlobalLockCallback(INIT_ONCE *init_once, void *parameter, void **context)
+{
+ UNUSED(init_once);
+ AVER(parameter == UNUSED_POINTER);
+ UNUSED(context);
+ if (!globalLockInit) {
+ LockInitGlobal();
+ }
+ return TRUE;
+}
static void lockEnsureGlobalLock(void)
{
- /* Ensure both global locks have been initialized. */
- /* There is a race condition initializing them. */
- if (!globalLockInit) {
- LockInit(globalLock);
- LockInit(globalRecLock);
- globalLockInit = TRUE;
- }
+ static INIT_ONCE init_once = INIT_ONCE_STATIC_INIT;
+ BOOL b = InitOnceExecuteOnce(&init_once, lockEnsureGlobalLockCallback,
+ UNUSED_POINTER, NULL);
+ AVER(b);
}
void (LockClaimGlobalRecursive)(void)
@@ -155,10 +190,21 @@ void (LockReleaseGlobal)(void)
LockRelease(globalLock);
}
+void LockSetup(void)
+{
+ /* Nothing to do as MPS does not support fork() on Windows. */
+}
+
+#elif defined(LOCK_NONE)
+#include "lockan.c"
+#else
+#error "No lock configuration."
+#endif
+
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/locus.c b/mps/code/locus.c
index cc367b15a6c..b683aa0f3ec 100644
--- a/mps/code/locus.c
+++ b/mps/code/locus.c
@@ -1,7 +1,7 @@
/* locus.c: LOCUS MANAGER
*
* $Id$
- * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*
* DESIGN
*
@@ -107,14 +107,68 @@ Bool GenDescCheck(GenDesc gen)
{
CHECKS(GenDesc, gen);
/* nothing to check for zones */
- /* nothing to check for capacity */
+ CHECKL(gen->capacity > 0);
CHECKL(gen->mortality >= 0.0);
CHECKL(gen->mortality <= 1.0);
CHECKD_NOSIG(Ring, &gen->locusRing);
+ CHECKD_NOSIG(Ring, &gen->segRing);
return TRUE;
}
+/* GenParamCheck -- check consistency of generation parameters */
+
+ATTRIBUTE_UNUSED
+static Bool GenParamCheck(GenParamStruct *params)
+{
+ CHECKL(params != NULL);
+ CHECKL(params->capacity > 0);
+ CHECKL(params->capacity <= SizeMAX / 1024);
+ CHECKL(params->mortality >= 0.0);
+ CHECKL(params->mortality <= 1.0);
+ return TRUE;
+}
+
+
+/* GenDescInit -- initialize a generation in a chain */
+
+static void GenDescInit(GenDesc gen, GenParamStruct *params)
+{
+ TraceId ti;
+
+ AVER(gen != NULL);
+ AVER(GenParamCheck(params));
+
+ gen->zones = ZoneSetEMPTY;
+ gen->capacity = params->capacity * 1024;
+ gen->mortality = params->mortality;
+ RingInit(&gen->locusRing);
+ RingInit(&gen->segRing);
+ gen->activeTraces = TraceSetEMPTY;
+ for (ti = 0; ti < TraceLIMIT; ++ti)
+ RingInit(&gen->trace[ti].traceRing);
+ gen->sig = GenDescSig;
+ AVERT(GenDesc, gen);
+}
+
+
+/* GenDescFinish -- finish a generation in a chain */
+
+static void GenDescFinish(GenDesc gen)
+{
+ TraceId ti;
+
+ AVERT(GenDesc, gen);
+
+ gen->sig = SigInvalid;
+ RingFinish(&gen->locusRing);
+ RingFinish(&gen->segRing);
+ AVER(gen->activeTraces == TraceSetEMPTY); /* */
+ for (ti = 0; ti < TraceLIMIT; ++ti)
+ RingFinish(&gen->trace[ti].traceRing);
+}
+
+
/* GenDescNewSize -- return effective size of generation */
Size GenDescNewSize(GenDesc gen)
@@ -133,6 +187,86 @@ Size GenDescNewSize(GenDesc gen)
}
+/* genDescTraceStart -- notify generation of start of a trace */
+
+void GenDescStartTrace(GenDesc gen, Trace trace)
+{
+ GenTrace genTrace;
+
+ AVERT(GenDesc, gen);
+ AVERT(Trace, trace);
+
+ AVER(!TraceSetIsMember(gen->activeTraces, trace));
+ gen->activeTraces = TraceSetAdd(gen->activeTraces, trace);
+ genTrace = &gen->trace[trace->ti];
+ AVER(RingIsSingle(&genTrace->traceRing));
+ RingAppend(&trace->genRing, &genTrace->traceRing);
+ genTrace->condemned = 0;
+ genTrace->forwarded = 0;
+ genTrace->preservedInPlace = 0;
+}
+
+
+/* genDescEndTrace -- notify generation of end of a trace */
+
+void GenDescEndTrace(GenDesc gen, Trace trace)
+{
+ GenTrace genTrace;
+ Size survived;
+
+ AVERT(GenDesc, gen);
+ AVERT(Trace, trace);
+
+ AVER(TraceSetIsMember(gen->activeTraces, trace));
+ gen->activeTraces = TraceSetDel(gen->activeTraces, trace);
+ genTrace = &gen->trace[trace->ti];
+ RingRemove(&genTrace->traceRing);
+ survived = genTrace->forwarded + genTrace->preservedInPlace;
+ AVER(survived <= genTrace->condemned);
+
+ if (genTrace->condemned > 0) {
+ double mortality = 1.0 - survived / (double)genTrace->condemned;
+ double alpha = LocusMortalityALPHA;
+ gen->mortality = gen->mortality * (1 - alpha) + mortality * alpha;
+ EVENT6(TraceEndGen, trace, gen, genTrace->condemned, genTrace->forwarded,
+ genTrace->preservedInPlace, gen->mortality);
+ }
+}
+
+
+/* GenDescCondemned -- memory in a generation was condemned for a trace */
+
+void GenDescCondemned(GenDesc gen, Trace trace, Size size)
+{
+ GenTrace genTrace;
+
+ AVERT(GenDesc, gen);
+ AVERT(Trace, trace);
+
+ genTrace = &gen->trace[trace->ti];
+ genTrace->condemned += size;
+ trace->condemned += size;
+}
+
+
+/* GenDescSurvived -- memory in a generation survived a trace */
+
+void GenDescSurvived(GenDesc gen, Trace trace, Size forwarded,
+ Size preservedInPlace)
+{
+ GenTrace genTrace;
+
+ AVERT(GenDesc, gen);
+ AVERT(Trace, trace);
+
+ genTrace = &gen->trace[trace->ti];
+ genTrace->forwarded += forwarded;
+ genTrace->preservedInPlace += preservedInPlace;
+ trace->forwardedSize += forwarded;
+ trace->preservedInPlaceSize += preservedInPlace;
+}
+
+
/* GenDescTotalSize -- return total size of generation */
Size GenDescTotalSize(GenDesc gen)
@@ -155,6 +289,7 @@ Size GenDescTotalSize(GenDesc gen)
Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth)
{
+ Index i;
Res res;
Ring node, nextNode;
@@ -166,12 +301,25 @@ Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth)
res = WriteF(stream, depth,
"GenDesc $P {\n", (WriteFP)gen,
" zones $B\n", (WriteFB)gen->zones,
- " capacity $W\n", (WriteFW)gen->capacity,
+ " capacity $U\n", (WriteFW)gen->capacity,
" mortality $D\n", (WriteFD)gen->mortality,
+ " activeTraces $B\n", (WriteFB)gen->activeTraces,
NULL);
if (res != ResOK)
return res;
+ for (i = 0; i < NELEMS(gen->trace); ++i) {
+ GenTrace genTrace = &gen->trace[i];
+ res = WriteF(stream, depth + 2,
+ "trace $U {\n", (WriteFW)i,
+ " condemned $U\n", (WriteFW)genTrace->condemned,
+ " forwarded $U\n", (WriteFW)genTrace->forwarded,
+ " preservedInPlace $U\n", (WriteFW)genTrace->preservedInPlace,
+ "}\n", NULL);
+ if (res != ResOK)
+ return res;
+ }
+
RING_FOR(node, &gen->locusRing, nextNode) {
PoolGen pgen = RING_ELT(PoolGen, genRing, node);
res = PoolGenDescribe(pgen, stream, depth + 2);
@@ -184,12 +332,35 @@ Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth)
}
+/* ChainInit -- initialize a generation chain */
+
+static void ChainInit(ChainStruct *chain, Arena arena, GenDescStruct *gens,
+ Count genCount)
+{
+ AVER(chain != NULL);
+ AVERT(Arena, arena);
+ AVER(gens != NULL);
+ AVER(genCount > 0);
+
+ chain->arena = arena;
+ RingInit(&chain->chainRing);
+ chain->genCount = genCount;
+ chain->gens = gens;
+ chain->sig = ChainSig;
+
+ AVERT(Chain, chain);
+
+ RingAppend(&arena->chainRing, &chain->chainRing);
+}
+
+
/* ChainCreate -- create a generation chain */
Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount,
GenParamStruct *params)
{
size_t i;
+ Size size;
Chain chain;
GenDescStruct *gens;
Res res;
@@ -199,46 +370,20 @@ Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount,
AVERT(Arena, arena);
AVER(genCount > 0);
AVER(params != NULL);
- for (i = 0; i < genCount; ++i) {
- AVER(params[i].capacity > 0);
- AVER(params[i].mortality > 0.0);
- AVER(params[i].mortality < 1.0);
- }
- res = ControlAlloc(&p, arena, genCount * sizeof(GenDescStruct), FALSE);
+ size = sizeof(ChainStruct) + genCount * sizeof(GenDescStruct);
+ res = ControlAlloc(&p, arena, size);
if (res != ResOK)
return res;
- gens = (GenDescStruct *)p;
+ chain = p;
+ gens = PointerAdd(p, sizeof(ChainStruct));
- for (i = 0; i < genCount; ++i) {
- gens[i].zones = ZoneSetEMPTY;
- gens[i].capacity = params[i].capacity;
- gens[i].mortality = params[i].mortality;
- RingInit(&gens[i].locusRing);
- gens[i].sig = GenDescSig;
- AVERT(GenDesc, &gens[i]);
- }
+ for (i = 0; i < genCount; ++i)
+ GenDescInit(&gens[i], ¶ms[i]);
+ ChainInit(chain, arena, gens, genCount);
- res = ControlAlloc(&p, arena, sizeof(ChainStruct), FALSE);
- if (res != ResOK)
- goto failChainAlloc;
- chain = (Chain)p;
-
- chain->arena = arena;
- RingInit(&chain->chainRing);
- chain->activeTraces = TraceSetEMPTY;
- chain->genCount = genCount;
- chain->gens = gens;
- chain->sig = ChainSig;
-
- RingAppend(&arena->chainRing, &chain->chainRing);
- AVERT(Chain, chain);
*chainReturn = chain;
return ResOK;
-
-failChainAlloc:
- ControlFree(arena, gens, genCount * sizeof(GenDescStruct));
- return res;
}
@@ -251,7 +396,6 @@ Bool ChainCheck(Chain chain)
CHECKS(Chain, chain);
CHECKU(Arena, chain->arena);
CHECKD_NOSIG(Ring, &chain->chainRing);
- CHECKL(TraceSetCheck(chain->activeTraces));
CHECKL(chain->genCount > 0);
for (i = 0; i < chain->genCount; ++i) {
CHECKD(GenDesc, &chain->gens[i]);
@@ -265,23 +409,23 @@ Bool ChainCheck(Chain chain)
void ChainDestroy(Chain chain)
{
Arena arena;
+ Size size;
size_t genCount;
size_t i;
AVERT(Chain, chain);
- AVER(chain->activeTraces == TraceSetEMPTY);
arena = chain->arena;
genCount = chain->genCount;
RingRemove(&chain->chainRing);
chain->sig = SigInvalid;
- for (i = 0; i < genCount; ++i) {
- RingFinish(&chain->gens[i].locusRing);
- chain->gens[i].sig = SigInvalid;
- }
+ for (i = 0; i < genCount; ++i)
+ GenDescFinish(&chain->gens[i]);
+
RingFinish(&chain->chainRing);
- ControlFree(arena, chain->gens, genCount * sizeof(GenDescStruct));
- ControlFree(arena, chain, sizeof(ChainStruct));
+
+ size = sizeof(ChainStruct) + genCount * sizeof(GenDescStruct);
+ ControlFree(arena, chain, size);
}
@@ -308,61 +452,6 @@ GenDesc ChainGen(Chain chain, Index gen)
}
-/* 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)
-{
- LocusPrefStruct pref;
- Res res;
- Seg seg;
- ZoneSet zones, moreZones;
- Arena arena;
- GenDesc gen;
-
- AVER(segReturn != NULL);
- AVERT(PoolGen, pgen);
- AVERT(SegClass, class);
- AVER(size > 0);
- AVERT(Bool, withReservoirPermit);
- AVERT(ArgList, args);
-
- arena = PoolArena(pgen->pool);
- gen = pgen->gen;
- zones = gen->zones;
-
- LocusPrefInit(&pref);
- pref.high = FALSE;
- pref.zones = zones;
- pref.avoid = ZoneSetBlacklist(arena);
- 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 gives more
- * understandable telemetry than just reporting the added
- * zones. */
- EVENT3(ArenaGenZoneAdd, arena, gen, 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)
@@ -372,41 +461,20 @@ double ChainDeferral(Chain chain)
AVERT(Chain, chain);
- 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;
- }
+ for (i = 0; i < chain->genCount; ++i) {
+ double genTime;
+ GenDesc gen = &chain->gens[i];
+ if (gen->activeTraces != TraceSetEMPTY)
+ return DBL_MAX;
+ genTime = (double)gen->capacity - (double)GenDescNewSize(&chain->gens[i]);
+ if (genTime < time)
+ time = genTime;
}
return time;
}
-/* ChainStartGC -- called to notify start of GC for this chain */
-
-void ChainStartGC(Chain chain, Trace trace)
-{
- AVERT(Chain, chain);
- AVERT(Trace, trace);
-
- chain->activeTraces = TraceSetAdd(chain->activeTraces, trace);
-}
-
-
-/* ChainEndGC -- called to notify end of GC for this chain */
-
-void ChainEndGC(Chain chain, Trace trace)
-{
- AVERT(Chain, chain);
- AVERT(Trace, trace);
-
- chain->activeTraces = TraceSetDel(chain->activeTraces, trace);
-}
-
-
/* ChainDescribe -- describe a chain */
Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth)
@@ -422,7 +490,6 @@ Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth)
res = WriteF(stream, depth,
"Chain $P {\n", (WriteFP)chain,
" arena $P\n", (WriteFP)chain->arena,
- " activeTraces $B\n", (WriteFB)chain->activeTraces,
NULL);
if (res != ResOK)
return res;
@@ -453,13 +520,14 @@ Res PoolGenInit(PoolGen pgen, GenDesc gen, Pool pool)
pgen->pool = pool;
pgen->gen = gen;
RingInit(&pgen->genRing);
- STATISTIC(pgen->segs = 0);
+ pgen->segs = 0;
pgen->totalSize = 0;
- STATISTIC(pgen->freeSize = 0);
+ pgen->freeSize = 0;
+ pgen->bufferedSize = 0;
pgen->newSize = 0;
- STATISTIC(pgen->oldSize = 0);
+ pgen->oldSize = 0;
pgen->newDeferredSize = 0;
- STATISTIC(pgen->oldDeferredSize = 0);
+ pgen->oldDeferredSize = 0;
pgen->sig = PoolGenSig;
AVERT(PoolGen, pgen);
@@ -473,15 +541,14 @@ Res PoolGenInit(PoolGen pgen, GenDesc gen, Pool pool)
void PoolGenFinish(PoolGen pgen)
{
AVERT(PoolGen, pgen);
+ AVER(pgen->segs == 0);
AVER(pgen->totalSize == 0);
+ AVER(pgen->freeSize == 0);
+ AVER(pgen->bufferedSize == 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);
- });
+ AVER(pgen->oldSize == 0);
+ AVER(pgen->oldDeferredSize == 0);
pgen->sig = SigInvalid;
RingRemove(&pgen->genRing);
@@ -497,88 +564,149 @@ Bool PoolGenCheck(PoolGen pgen)
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 * ArenaGrainSize(PoolArena(pgen->pool)));
- CHECKL(pgen->totalSize == pgen->freeSize + pgen->newSize + pgen->oldSize
- + pgen->newDeferredSize + pgen->oldDeferredSize);
- });
+ CHECKL((pgen->totalSize == 0) == (pgen->segs == 0));
+ CHECKL(pgen->totalSize >= pgen->segs * ArenaGrainSize(PoolArena(pgen->pool)));
+ CHECKL(pgen->totalSize == pgen->freeSize + pgen->bufferedSize
+ + pgen->newSize + pgen->oldSize
+ + pgen->newDeferredSize + pgen->oldDeferredSize);
return TRUE;
}
-/* PoolGenAccountForFill -- accounting for allocation
+/* PoolGenAccountForAlloc -- accounting for allocation of a segment */
+
+static void PoolGenAccountForAlloc(PoolGen pgen, Size size)
+{
+ pgen->totalSize += size;
+ ++ pgen->segs;
+ pgen->freeSize += size;
+}
+
+
+/* PoolGenAlloc -- allocate a segment in a pool generation
+ *
+ * Allocate a segment belong to klass (which must be GCSegClass or a
+ * subclass), attach it to the generation, and update the accounting.
+ */
+
+Res PoolGenAlloc(Seg *segReturn, PoolGen pgen, SegClass klass, Size size,
+ ArgList args)
+{
+ LocusPrefStruct pref;
+ Res res;
+ Seg seg;
+ ZoneSet zones, moreZones;
+ Arena arena;
+ GenDesc gen;
+
+ AVER(segReturn != NULL);
+ AVERT(PoolGen, pgen);
+ AVERT(SegClass, klass);
+ AVER(IsSubclass(klass, GCSeg));
+ AVER(size > 0);
+ AVERT(ArgList, args);
+
+ arena = PoolArena(pgen->pool);
+ gen = pgen->gen;
+ zones = gen->zones;
+
+ LocusPrefInit(&pref);
+ pref.high = FALSE;
+ pref.zones = zones;
+ pref.avoid = ZoneSetBlacklist(arena);
+ res = SegAlloc(&seg, klass, &pref, size, pgen->pool, args);
+ if (res != ResOK)
+ return res;
+
+ RingAppend(&gen->segRing, &SegGCSeg(seg)->genRing);
+
+ moreZones = ZoneSetUnion(zones, ZoneSetOfSeg(arena, seg));
+ gen->zones = moreZones;
+
+ if (!ZoneSetSuper(zones, moreZones)) {
+ /* Tracking the whole zoneset for each generation gives more
+ * understandable telemetry than just reporting the added
+ * zones. */
+ EVENT3(ArenaGenZoneAdd, arena, gen, moreZones);
+ }
+
+ PoolGenAccountForAlloc(pgen, SegSize(seg));
+
+ *segReturn = seg;
+ return ResOK;
+}
+
+
+/* PoolGenAccountForFill -- accounting for allocation within a segment
*
* 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.
+ * BufferFill.
*
* See
*/
-void PoolGenAccountForFill(PoolGen pgen, Size size, Bool deferred)
+void PoolGenAccountForFill(PoolGen pgen, Size size)
{
AVERT(PoolGen, pgen);
- AVERT(Bool, deferred);
- STATISTIC_STAT ({
- AVER(pgen->freeSize >= size);
- pgen->freeSize -= size;
- });
- if (deferred)
- pgen->newDeferredSize += size;
- else
- pgen->newSize += size;
+ AVER(pgen->freeSize >= size);
+ pgen->freeSize -= size;
+ pgen->bufferedSize += 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.
+ * Call this when the client program returns memory to the pool via
+ * BufferEmpty. The deferred flag indicates whether the accounting of
+ * the used memory (for the purpose of scheduling collections) should
+ * be deferred until later.
*
* See
*/
-void PoolGenAccountForEmpty(PoolGen pgen, Size unused, Bool deferred)
+void PoolGenAccountForEmpty(PoolGen pgen, Size used, Size unused, Bool deferred)
{
AVERT(PoolGen, pgen);
AVERT(Bool, deferred);
+ AVER(pgen->bufferedSize >= used + unused);
+ pgen->bufferedSize -= used + unused;
if (deferred) {
- AVER(pgen->newDeferredSize >= unused);
- pgen->newDeferredSize -= unused;
+ pgen->newDeferredSize += used;
} else {
- AVER(pgen->newSize >= unused);
- pgen->newSize -= unused;
+ pgen->newSize += used;
}
- STATISTIC(pgen->freeSize += unused);
+ 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.
+ * Call this when memory is condemned via PoolWhiten, or when
+ * artificially ageing memory in PoolGenFree. The size parameter
+ * should be the amount of memory that is being condemned for the
+ * first time. The deferred flag is as for PoolGenAccountForEmpty.
*
* See
*/
-void PoolGenAccountForAge(PoolGen pgen, Size size, Bool deferred)
+void PoolGenAccountForAge(PoolGen pgen, Size wasBuffered, Size wasNew,
+ Bool deferred)
{
AVERT(PoolGen, pgen);
-
+ AVERT(Bool, deferred);
+
+ AVER(pgen->bufferedSize >= wasBuffered);
+ pgen->bufferedSize -= wasBuffered;
if (deferred) {
- AVER(pgen->newDeferredSize >= size);
- pgen->newDeferredSize -= size;
- STATISTIC(pgen->oldDeferredSize += size);
+ AVER(pgen->newDeferredSize >= wasNew);
+ pgen->newDeferredSize -= wasNew;
+ pgen->oldDeferredSize += wasBuffered + wasNew;
} else {
- AVER(pgen->newSize >= size);
- pgen->newSize -= size;
- STATISTIC(pgen->oldSize += size);
+ AVER(pgen->newSize >= wasNew);
+ pgen->newSize -= wasNew;
+ pgen->oldSize += wasBuffered + wasNew;
}
}
@@ -586,7 +714,7 @@ void PoolGenAccountForAge(PoolGen pgen, Size size, Bool deferred)
/* PoolGenAccountForReclaim -- accounting for reclaiming
*
* Call this when reclaiming memory, passing the amount of memory that
- * was reclaimed. The deferred flag is as for PoolGenAccountForFill.
+ * was reclaimed. The deferred flag is as for PoolGenAccountForEmpty.
*
* See
*/
@@ -596,16 +724,14 @@ 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;
- });
+ if (deferred) {
+ AVER(pgen->oldDeferredSize >= reclaimed);
+ pgen->oldDeferredSize -= reclaimed;
+ } else {
+ AVER(pgen->oldSize >= reclaimed);
+ pgen->oldSize -= reclaimed;
+ }
+ pgen->freeSize += reclaimed;
}
@@ -621,11 +747,9 @@ void PoolGenAccountForReclaim(PoolGen pgen, Size reclaimed, Bool deferred)
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->oldDeferredSize >= oldSize);
+ pgen->oldDeferredSize -= oldSize;
+ pgen->oldSize += oldSize;
AVER(pgen->newDeferredSize >= newSize);
pgen->newDeferredSize -= newSize;
pgen->newSize += newSize;
@@ -637,10 +761,8 @@ void PoolGenUndefer(PoolGen pgen, Size oldSize, Size newSize)
void PoolGenAccountForSegSplit(PoolGen pgen)
{
AVERT(PoolGen, pgen);
- STATISTIC_STAT ({
- AVER(pgen->segs >= 1); /* must be at least one segment to split */
- ++ pgen->segs;
- });
+ AVER(pgen->segs >= 1); /* must be at least one segment to split */
+ ++ pgen->segs;
}
@@ -649,10 +771,28 @@ void PoolGenAccountForSegSplit(PoolGen pgen)
void PoolGenAccountForSegMerge(PoolGen pgen)
{
AVERT(PoolGen, pgen);
- STATISTIC_STAT ({
- AVER(pgen->segs >= 2); /* must be at least two segments to merge */
- -- pgen->segs;
- });
+ AVER(pgen->segs >= 2); /* must be at least two segments to merge */
+ -- pgen->segs;
+}
+
+
+/* PoolGenAccountForFree -- accounting for the freeing of a segment */
+
+static void PoolGenAccountForFree(PoolGen pgen, Size size,
+ Size oldSize, Size newSize,
+ Bool deferred)
+{
+ /* Pretend to age and reclaim the contents of the segment to ensure
+ * that the entire segment is accounted as free. */
+ PoolGenAccountForAge(pgen, 0, newSize, deferred);
+ PoolGenAccountForReclaim(pgen, oldSize + newSize, deferred);
+
+ AVER(pgen->totalSize >= size);
+ pgen->totalSize -= size;
+ AVER(pgen->segs > 0);
+ -- pgen->segs;
+ AVER(pgen->freeSize >= size);
+ pgen->freeSize -= size;
}
@@ -660,7 +800,7 @@ void PoolGenAccountForSegMerge(PoolGen pgen)
*
* Pass the amount of memory in the segment that is accounted as free,
* old, or new, respectively. The deferred flag is as for
- * PoolGenAccountForFill.
+ * PoolGenAccountForEmpty.
*
* See
*/
@@ -676,19 +816,10 @@ void PoolGenFree(PoolGen pgen, Seg seg, Size freeSize, Size oldSize,
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);
+ PoolGenAccountForFree(pgen, size, oldSize, newSize, deferred);
+
+ RingRemove(&SegGCSeg(seg)->genRing);
- AVER(pgen->totalSize >= size);
- pgen->totalSize -= size;
- STATISTIC_STAT ({
- AVER(pgen->segs > 0);
- -- pgen->segs;
- AVER(pgen->freeSize >= size);
- pgen->freeSize -= size;
- });
SegFree(seg);
}
@@ -698,20 +829,24 @@ void PoolGenFree(PoolGen pgen, Seg seg, Size freeSize, Size oldSize,
Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream, Count depth)
{
Res res;
+ PoolClass poolClass;
if (!TESTT(PoolGen, pgen))
- return ResFAIL;
+ return ResPARAM;
if (stream == NULL)
- return ResFAIL;
+ return ResPARAM;
+
+ poolClass = ClassOfPoly(Pool, pgen->pool);
res = WriteF(stream, depth,
"PoolGen $P {\n", (WriteFP)pgen,
" pool $P ($U) \"$S\"\n",
(WriteFP)pgen->pool, (WriteFU)pgen->pool->serial,
- (WriteFS)pgen->pool->class->name,
+ (WriteFS)ClassName(poolClass),
" segs $U\n", (WriteFU)pgen->segs,
" totalSize $U\n", (WriteFU)pgen->totalSize,
" freeSize $U\n", (WriteFU)pgen->freeSize,
+ " bufferedSize $U\n", (WriteFU)pgen->bufferedSize,
" oldSize $U\n", (WriteFU)pgen->oldSize,
" oldDeferredSize $U\n", (WriteFU)pgen->oldDeferredSize,
" newSize $U\n", (WriteFU)pgen->newSize,
@@ -726,18 +861,14 @@ Res PoolGenDescribe(PoolGen pgen, mps_lib_FILE *stream, Count depth)
void LocusInit(Arena arena)
{
- GenDesc gen = &arena->topGen;
+ GenParamStruct params;
- /* Can't check arena, because it's not been inited. */
-
- /* TODO: The mortality estimate here is unjustifiable. Dynamic generation
- decision making needs to be improved and this constant removed. */
- gen->zones = ZoneSetEMPTY;
- gen->capacity = 0; /* unused */
- gen->mortality = 0.51;
- RingInit(&gen->locusRing);
- gen->sig = GenDescSig;
- AVERT(GenDesc, gen);
+ AVER(arena != NULL); /* not initialized yet. */
+
+ params.capacity = 1; /* unused since top generation is not on any chain */
+ params.mortality = 0.5;
+
+ GenDescInit(&arena->topGen, ¶ms);
}
@@ -745,12 +876,9 @@ void LocusInit(Arena arena)
void LocusFinish(Arena arena)
{
- GenDesc gen = &arena->topGen;
-
/* Can't check arena, because it's being finished. */
-
- gen->sig = SigInvalid;
- RingFinish(&gen->locusRing);
+ AVER(arena != NULL);
+ GenDescFinish(&arena->topGen);
}
@@ -766,7 +894,7 @@ Bool LocusCheck(Arena arena)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2016 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/locus.h b/mps/code/locus.h
index d1d9716303e..7c71a714dd1 100644
--- a/mps/code/locus.h
+++ b/mps/code/locus.h
@@ -17,11 +17,23 @@
typedef struct GenParamStruct *GenParam;
typedef struct GenParamStruct {
- Size capacity; /* capacity in kB */
- double mortality;
+ Size capacity; /* capacity in kB */
+ double mortality; /* predicted mortality */
} GenParamStruct;
+/* GenTrace -- per-generation per-trace structure */
+
+typedef struct GenTraceStruct *GenTrace;
+
+typedef struct GenTraceStruct {
+ RingStruct traceRing; /* link in ring of generations condemned by trace */
+ Size condemned; /* size of objects condemned by the trace */
+ Size forwarded; /* size of objects that were forwarded by the trace */
+ Size preservedInPlace; /* size of objects preserved in place by the trace */
+} GenTraceStruct;
+
+
/* GenDesc -- descriptor of a generation in a chain */
typedef struct GenDescStruct *GenDesc;
@@ -30,17 +42,18 @@ typedef struct GenDescStruct *GenDesc;
typedef struct GenDescStruct {
Sig sig;
- ZoneSet zones; /* zoneset for this generation */
- Size capacity; /* capacity in kB */
- double mortality;
+ ZoneSet zones; /* zoneset for this generation */
+ Size capacity; /* capacity in bytes */
+ double mortality; /* predicted mortality */
RingStruct locusRing; /* Ring of all PoolGen's in this GenDesc (locus) */
+ RingStruct segRing; /* Ring of GCSegs in this generation */
+ TraceSet activeTraces; /* set of traces collecting this generation */
+ GenTraceStruct trace[TraceLIMIT];
} GenDescStruct;
/* PoolGen -- descriptor of a generation in a pool */
-typedef struct PoolGenStruct *PoolGen;
-
#define PoolGenSig ((Sig)0x519B009E) /* SIGnature POOl GEn */
typedef struct PoolGenStruct {
@@ -51,13 +64,14 @@ typedef struct PoolGenStruct {
RingStruct genRing;
/* 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) */
+ Size segs; /* number of segments */
+ Size totalSize; /* total (sum of segment sizes) */
+ Size freeSize; /* unused (free or lost to fragmentation) */
+ Size bufferedSize; /* held in buffers but not condemned yet */
+ Size newSize; /* allocated since last collection */
+ Size oldSize; /* allocated prior to last collection */
+ Size newDeferredSize; /* new (but deferred) */
+ Size oldDeferredSize; /* old (but deferred) */
} PoolGenStruct;
@@ -69,7 +83,6 @@ typedef struct mps_chain_s {
Sig sig;
Arena arena;
RingStruct chainRing; /* list of chains in the arena */
- TraceSet activeTraces; /* set of traces collecting this chain */
size_t genCount; /* number of generations */
GenDesc gens; /* the array of generations */
} ChainStruct;
@@ -78,7 +91,12 @@ typedef struct mps_chain_s {
extern Bool GenDescCheck(GenDesc gen);
extern Size GenDescNewSize(GenDesc gen);
extern Size GenDescTotalSize(GenDesc gen);
+extern void GenDescStartTrace(GenDesc gen, Trace trace);
+extern void GenDescEndTrace(GenDesc gen, Trace trace);
+extern void GenDescCondemned(GenDesc gen, Trace trace, Size size);
+extern void GenDescSurvived(GenDesc gen, Trace trace, Size forwarded, Size preservedInPlace);
extern Res GenDescDescribe(GenDesc gen, mps_lib_FILE *stream, Count depth);
+#define GenDescOfTraceRing(node, trace) PARENT(GenDescStruct, trace[trace->ti], RING_ELT(GenTrace, traceRing, node))
extern Res ChainCreate(Chain *chainReturn, Arena arena, size_t genCount,
GenParam params);
@@ -86,8 +104,6 @@ extern void ChainDestroy(Chain chain);
extern Bool ChainCheck(Chain chain);
extern double ChainDeferral(Chain chain);
-extern void ChainStartGC(Chain chain, Trace trace);
-extern void ChainEndGC(Chain chain, Trace trace);
extern size_t ChainGens(Chain chain);
extern GenDesc ChainGen(Chain chain, Index gen);
extern Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth);
@@ -95,13 +111,13 @@ extern Res ChainDescribe(Chain chain, mps_lib_FILE *stream, Count depth);
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 Res PoolGenAlloc(Seg *segReturn, PoolGen pgen, SegClass klass,
+ Size size, 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 PoolGenAccountForFill(PoolGen pgen, Size size);
+extern void PoolGenAccountForEmpty(PoolGen pgen, Size used, Size unused, Bool deferred);
+extern void PoolGenAccountForAge(PoolGen pgen, Size wasBuffered, Size wasNew, 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);
diff --git a/mps/code/locusss.c b/mps/code/locusss.c
index b3769dd674a..8af79958c56 100644
--- a/mps/code/locusss.c
+++ b/mps/code/locusss.c
@@ -5,7 +5,6 @@
*/
#include "mpscmvff.h"
-#include "mpscmv.h"
#include "mpslib.h"
#include "mpsavm.h"
#include "testlib.h"
@@ -169,8 +168,8 @@ static void testInArena(mps_arena_t arena,
FALSE, FALSE, TRUE),
"Create LO MFFV");
- die(mps_pool_create(&temppool, arena, mps_class_mv(),
- chunkSize, chunkSize, chunkSize),
+ die(mps_pool_create_k(&temppool, arena, mps_class_mvff(),
+ mps_args_none),
"Create TEMP");
if(failcase) {
diff --git a/mps/code/locv.c b/mps/code/locv.c
index 06d2722dac3..4bcfd936b39 100644
--- a/mps/code/locv.c
+++ b/mps/code/locv.c
@@ -1,7 +1,7 @@
/* locv.c: LEAF OBJECT POOL CLASS COVERAGE TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
*
* This is (not much of) a coverage test for the Leaf Object
* pool (PoolClassLO).
@@ -165,14 +165,13 @@ static void stepper(mps_addr_t addr, mps_fmt_t fmt, mps_pool_t pool,
pcount = p;
*pcount += 1;
- return;
}
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/message.c b/mps/code/message.c
index eba94182837..c22fe2e5b28 100644
--- a/mps/code/message.c
+++ b/mps/code/message.c
@@ -1,7 +1,7 @@
/* message.c: MPS/CLIENT MESSAGES
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
*
* DESIGN
*
@@ -12,6 +12,8 @@
* .purpose: Provide the generic part of the MPS / Client message
* interface. Messages are instances of Message Classes; much of the
* "real work" goes on in the modules that provide the actual messages.
+ *
+ * TODO: Consider using protocol classes for messages.
*/
#include "bt.h"
@@ -45,14 +47,14 @@ Bool MessageTypeCheck(MessageType type)
/* See .message.clocked. Currently finalization messages are the */
/* only ones that can be numerous. */
-#define MessageIsClocked(message) ((message)->class->type \
- != MessageTypeFINALIZATION)
+#define MessageIsClocked(message) \
+ ((message)->klass->type != MessageTypeFINALIZATION)
Bool MessageCheck(Message message)
{
CHECKS(Message, message);
CHECKU(Arena, message->arena);
- CHECKD(MessageClass, message->class);
+ CHECKD(MessageClass, message->klass);
CHECKD_NOSIG(Ring, &message->queueRing);
/* postedClock is uncheckable for clocked message types, */
/* but must be 0 for unclocked message types: */
@@ -61,32 +63,32 @@ Bool MessageCheck(Message message)
return TRUE;
}
-Bool MessageClassCheck(MessageClass class)
+Bool MessageClassCheck(MessageClass klass)
{
- CHECKS(MessageClass, class);
- CHECKL(class->name != NULL);
- CHECKL(MessageTypeCheck(class->type));
- CHECKL(FUNCHECK(class->delete));
- CHECKL(FUNCHECK(class->finalizationRef));
- CHECKL(FUNCHECK(class->gcLiveSize));
- CHECKL(FUNCHECK(class->gcCondemnedSize));
- CHECKL(FUNCHECK(class->gcNotCondemnedSize));
- CHECKL(FUNCHECK(class->gcStartWhy));
- CHECKL(class->endSig == MessageClassSig);
+ CHECKS(MessageClass, klass);
+ CHECKL(klass->name != NULL);
+ CHECKL(MessageTypeCheck(klass->type));
+ CHECKL(FUNCHECK(klass->delete));
+ CHECKL(FUNCHECK(klass->finalizationRef));
+ CHECKL(FUNCHECK(klass->gcLiveSize));
+ CHECKL(FUNCHECK(klass->gcCondemnedSize));
+ CHECKL(FUNCHECK(klass->gcNotCondemnedSize));
+ CHECKL(FUNCHECK(klass->gcStartWhy));
+ CHECKL(klass->endSig == MessageClassSig);
return TRUE;
}
-void MessageInit(Arena arena, Message message, MessageClass class,
+void MessageInit(Arena arena, Message message, MessageClass klass,
MessageType type)
{
AVERT(Arena, arena);
AVER(message != NULL);
- AVERT(MessageClass, class);
+ AVERT(MessageClass, klass);
AVERT(MessageType, type);
message->arena = arena;
- message->class = class;
+ message->klass = klass;
RingInit(&message->queueRing);
message->postedClock = 0;
message->sig = MessageSig;
@@ -279,20 +281,20 @@ void MessageDiscard(Arena arena, Message message)
/* Message Methods, Generic
*
- * (Some of these dispatch on message->class).
+ * (Some of these dispatch on message->klass).
*/
/* Return the type of a message */
MessageType MessageGetType(Message message)
{
- MessageClass class;
+ MessageClass klass;
AVERT(Message, message);
- class = message->class;
- AVERT(MessageClass, class);
+ klass = message->klass;
+ AVERT(MessageClass, klass);
- return class->type;
+ return klass->type;
}
/* Return the class of a message */
@@ -300,7 +302,7 @@ MessageClass MessageGetClass(Message message)
{
AVERT(Message, message);
- return message->class;
+ return message->klass;
}
Clock MessageGetClock(Message message)
@@ -314,7 +316,7 @@ static void MessageDelete(Message message)
{
AVERT(Message, message);
- (*message->class->delete)(message);
+ (*message->klass->delete)(message);
}
@@ -331,9 +333,7 @@ void MessageFinalizationRef(Ref *refReturn, Arena arena,
AVERT(Message, message);
AVER(MessageGetType(message) == MessageTypeFINALIZATION);
- (*message->class->finalizationRef)(refReturn, arena, message);
-
- return;
+ (*message->klass->finalizationRef)(refReturn, arena, message);
}
Size MessageGCLiveSize(Message message)
@@ -341,7 +341,7 @@ Size MessageGCLiveSize(Message message)
AVERT(Message, message);
AVER(MessageGetType(message) == MessageTypeGC);
- return (*message->class->gcLiveSize)(message);
+ return (*message->klass->gcLiveSize)(message);
}
Size MessageGCCondemnedSize(Message message)
@@ -349,7 +349,7 @@ Size MessageGCCondemnedSize(Message message)
AVERT(Message, message);
AVER(MessageGetType(message) == MessageTypeGC);
- return (*message->class->gcCondemnedSize)(message);
+ return (*message->klass->gcCondemnedSize)(message);
}
Size MessageGCNotCondemnedSize(Message message)
@@ -357,7 +357,7 @@ Size MessageGCNotCondemnedSize(Message message)
AVERT(Message, message);
AVER(MessageGetType(message) == MessageTypeGC);
- return (*message->class->gcNotCondemnedSize)(message);
+ return (*message->klass->gcNotCondemnedSize)(message);
}
const char *MessageGCStartWhy(Message message)
@@ -365,7 +365,7 @@ const char *MessageGCStartWhy(Message message)
AVERT(Message, message);
AVER(MessageGetType(message) == MessageTypeGCSTART);
- return (*message->class->gcStartWhy)(message);
+ return (*message->klass->gcStartWhy)(message);
}
@@ -427,7 +427,7 @@ const char *MessageNoGCStartWhy(Message message)
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/messtest.c b/mps/code/messtest.c
index 96deeebfc58..0958d9319c7 100644
--- a/mps/code/messtest.c
+++ b/mps/code/messtest.c
@@ -1,7 +1,7 @@
/* messtest.c: MESSAGE TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*/
#include "mpm.h"
@@ -71,18 +71,17 @@ static void topMessageType(MessageType *typeReturn, Arena arena)
/* postDummyMessage -- post a dummy message */
-static void postDummyMessage(Arena arena, MessageClass class,
+static void postDummyMessage(Arena arena, MessageClass klass,
MessageType type)
{
void *p;
Message message;
- die((mps_res_t)ControlAlloc(&p, arena, sizeof(MessageStruct), FALSE),
+ die((mps_res_t)ControlAlloc(&p, arena, sizeof(MessageStruct)),
"AllocMessage");
message = (Message)p;
- MessageInit(arena, message, class, type);
+ MessageInit(arena, message, klass, type);
MessagePost(arena, message);
- return;
}
@@ -255,7 +254,7 @@ static void testGetEmpty(Arena arena)
#define testArenaSIZE (((size_t)64)<<20)
-extern int main(int argc, char *argv[])
+int main(int argc, char *argv[])
{
mps_arena_t mpsArena;
Arena arena;
@@ -277,7 +276,7 @@ extern int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2001-2018 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 9b22522558a..3a5d3c18e60 100644
--- a/mps/code/misc.h
+++ b/mps/code/misc.h
@@ -109,19 +109,26 @@ typedef const struct SrcIdStruct {
#define NELEMS(a) (sizeof(a)/sizeof((a)[0]))
-/* DISCARD -- discards an expression, but checks syntax
+/* DISCARD_EXP -- discard an expression, but check syntax
+ *
+ * .discard: DISCARD_EXP uses sizeof so that the expression is not
+ * evaluated and yet the compiler will check that it is a valid
+ * expression. The conditional is compared with zero so it can
+ * designate a bitfield object.
+ */
+
+#define DISCARD_EXP(expr) ((void)sizeof((expr)!=0))
+
+
+/* DISCARD -- discards an expression in statement context, but checks syntax
*
* The argument is an expression; the expansion followed by a semicolon
* is syntactically a statement (to avoid it being used in computation).
- *
- * .discard: DISCARD uses sizeof so that the expression is not evaluated
- * and yet the compiler will check that it is a valid expression. The
- * conditional is compared with zero so it can designate a bitfield object.
*/
#define DISCARD(expr) \
BEGIN \
- (void)sizeof((expr)!=0); \
+ DISCARD_EXP(expr); \
END
diff --git a/mps/code/mpm.c b/mps/code/mpm.c
index aba1ac2f5cb..71072b67c9d 100644
--- a/mps/code/mpm.c
+++ b/mps/code/mpm.c
@@ -1,7 +1,7 @@
/* mpm.c: GENERAL MPM SUPPORT
*
* $Id$
- * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
*
* .purpose: Miscellaneous support for the implementation of the MPM
* and pool classes.
@@ -9,6 +9,7 @@
* .sources: */
#include "check.h"
+#include "misc.h"
#include "mpm.h"
#include "vm.h"
@@ -88,6 +89,11 @@ Bool MPMCheck(void)
* . */
CHECKL(StackProbeDEPTH * sizeof(Word) < PageSize());
+ /* Check these values will fit in their bitfield. */
+ CHECKL(WB_DEFER_INIT <= ((1ul << WB_DEFER_BITS) - 1));
+ CHECKL(WB_DEFER_DELAY <= ((1ul << WB_DEFER_BITS) - 1));
+ CHECKL(WB_DEFER_HIT <= ((1ul << WB_DEFER_BITS) - 1));
+
return TRUE;
}
@@ -614,16 +620,19 @@ Res WriteF_firstformat_v(mps_lib_FILE *stream, Count depth,
size_t StringLength(const char *s)
{
- size_t i;
+ size_t i = 0;
AVER(s != NULL);
- for(i = 0; s[i] != '\0'; i++)
- NOOP;
- return(i);
+ while (s[i] != '\0')
+ ++i;
+
+ return i;
}
+#if 0 /* This code is currently not in use in the MPS */
+
/* StringEqual -- slow substitute for (strcmp == 0) */
Bool StringEqual(const char *s1, const char *s2)
@@ -644,11 +653,153 @@ Bool StringEqual(const char *s1, const char *s2)
return TRUE;
}
+#endif /* not currently in use */
+
+
+/* Random -- a random number generator
+ *
+ * TODO: This is a copy of the generator from testlib.c, which has
+ * extensive notes and verification tests. The notes need to go to a
+ * design document, and the tests to a test.
+ */
+
+static unsigned RandomSeed = 1;
+#define Random_m 2147483647UL
+#define Random_a 48271UL
+unsigned Random32(void)
+{
+ /* requires m == 2^31-1, a < 2^16 */
+ unsigned bot = Random_a * (RandomSeed & 0x7FFF);
+ unsigned top = Random_a * (RandomSeed >> 15);
+ AVER(UINT_MAX >= 4294967295U);
+ RandomSeed = bot + ((top & 0xFFFF) << 15) + (top >> 16);
+ if (RandomSeed > Random_m)
+ RandomSeed -= Random_m;
+ return RandomSeed;
+}
+
+Word RandomWord(void)
+{
+ Word word = 0;
+ Index i;
+ for (i = 0; i < MPS_WORD_WIDTH; i += 31)
+ word = (word << 31) | Random32();
+ return word;
+}
+
+
+/* QuickSort -- non-recursive bounded sort
+ *
+ * We can't rely on the standard library's qsort, which might have
+ * O(n) stack usage. This version does not recurse.
+ */
+
+#ifdef QUICKSORT_DEBUG
+static Bool quickSorted(void *array[], Count length,
+ QuickSortCompare compare, void *closure)
+{
+ Index i;
+ if (length > 0) {
+ for (i = 0; i < length - 1; ++i) {
+ if (compare(array[i], array[i+1], closure) == CompareGREATER)
+ return FALSE;
+ }
+ }
+ return TRUE;
+}
+#endif
+
+void QuickSort(void *array[], Count length,
+ QuickSortCompare compare, void *closure,
+ SortStruct *sortStruct)
+{
+ Index left, right, sp, lo, hi, leftLimit, rightBase;
+ void *pivot, *temp;
+
+ AVER(array != NULL);
+ /* can't check length */
+ AVER(FUNCHECK(compare));
+ /* can't check closure */
+ AVER(sortStruct != NULL);
+
+ sp = 0;
+ left = 0;
+ right = length;
+
+ for (;;) {
+ while (right - left > 1) { /* only need to sort if two or more */
+ /* Pick a random pivot. */
+ pivot = array[left + RandomWord() % (right - left)];
+
+ /* Hoare partition: scan from left to right, dividing it into
+ elements less than the pivot and elements greater or
+ equal. */
+ lo = left;
+ hi = right;
+ for (;;) {
+ while (compare(array[lo], pivot, closure) == CompareLESS)
+ ++lo;
+ do
+ --hi;
+ while (compare(pivot, array[hi], closure) == CompareLESS);
+ if (lo >= hi)
+ break;
+ temp = array[hi];
+ array[hi] = array[lo];
+ array[lo] = temp;
+ ++lo; /* step over what we just swapped */
+ }
+
+ /* After partition, if we ended up at a pivot, then it is in its
+ final position and we must skip it to ensure termination.
+ This handles the case where the pivot is at the start of the
+ array, and one of the partitions is the whole array, for
+ example. */
+ if (lo == hi) {
+ AVER_CRITICAL(array[hi] == pivot); /* and it's in place */
+ leftLimit = lo;
+ rightBase = lo + 1;
+ } else {
+ AVER_CRITICAL(lo == hi + 1);
+ leftLimit = lo;
+ rightBase = lo;
+ }
+
+ /* Sort the smaller part now, so that we're sure to use at most
+ log2 length stack levels. Push the larger part on the stack
+ for later. */
+ AVER_CRITICAL(sp < sizeof sortStruct->stack / sizeof sortStruct->stack[0]);
+ if (leftLimit - left < right - rightBase) {
+ sortStruct->stack[sp].left = rightBase;
+ sortStruct->stack[sp].right = right;
+ ++sp;
+ right = leftLimit;
+ } else {
+ sortStruct->stack[sp].left = left;
+ sortStruct->stack[sp].right = leftLimit;
+ ++sp;
+ left = rightBase;
+ }
+ }
+
+ if (sp == 0)
+ break;
+
+ --sp;
+ left = sortStruct->stack[sp].left;
+ right = sortStruct->stack[sp].right;
+ AVER_CRITICAL(left < right); /* we will have done a zero-length part first */
+ }
+
+#ifdef QUICKSORT_DEBUG
+ AVER(quickSorted(array, length, compare, closure));
+#endif
+}
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2015 Ravenbrook Limited .
+ * Copyright (C) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 4390c37153d..855a18172f2 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -1,12 +1,18 @@
/* mpm.h: MEMORY POOL MANAGER DEFINITIONS
*
* $Id$
- * Copyright (c) 2001-2015 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2002 Global Graphics Software.
*
* .trans.bufferinit: The Buffer data structure has an Init field and
* an Init method, there's a name clash. We resolve this by calling the
* accessor BufferGetInit.
+ *
+ * .critical.macros: In manual-allocation-bound programs using MVFF,
+ * PoolFree and the Land generic functions are on the critical path
+ * via mps_free. In non-checking varieties we provide macro
+ * alternatives to these functions that call the underlying methods
+ * directly, giving a few percent improvement in performance.
*/
#ifndef mpm_h
@@ -18,6 +24,7 @@
#include "event.h"
#include "lock.h"
+#include "prmc.h"
#include "prot.h"
#include "sp.h"
#include "th.h"
@@ -171,6 +178,15 @@ extern Res WriteF_firstformat_v(mps_lib_FILE *stream, Count depth,
extern size_t StringLength(const char *s);
extern Bool StringEqual(const char *s1, const char *s2);
+extern unsigned Random32(void);
+extern Word RandomWord(void);
+
+typedef Compare QuickSortCompare(void *left, void *right,
+ void *closure);
+extern void QuickSort(void *array[], Count length,
+ QuickSortCompare compare, void *closure,
+ SortStruct *sortStruct);
+
/* Version Determination
*
@@ -181,9 +197,9 @@ extern char *MPSVersion(void);
/* Pool Interface -- see impl.c.pool */
-extern Res PoolInit(Pool pool, Arena arena, PoolClass class, ArgList args);
+extern Res PoolInit(Pool pool, Arena arena, PoolClass klass, ArgList args);
extern void PoolFinish(Pool pool);
-extern Bool PoolClassCheck(PoolClass class);
+extern Bool PoolClassCheck(PoolClass klass);
extern Bool PoolCheck(Pool pool);
extern Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth);
@@ -193,7 +209,12 @@ extern Res PoolDescribe(Pool pool, mps_lib_FILE *stream, Count depth);
#define PoolSegRing(pool) (&(pool)->segRing)
#define PoolArenaRing(pool) (&(pool)->arenaRing)
#define PoolOfArenaRing(node) RING_ELT(Pool, arenaRing, node)
-#define PoolHasAttr(pool, Attr) (((pool)->class->attr & (Attr)) != 0)
+#define PoolHasAttr(pool, Attr) ((ClassOfPoly(Pool, pool)->attr & (Attr)) != 0)
+#define PoolSizeGrains(pool, size) ((size) >> (pool)->alignShift)
+#define PoolGrainsSize(pool, grains) ((grains) << (pool)->alignShift)
+#define PoolIndexOfAddr(base, pool, p) \
+ (AddrOffset((base), (p)) >> (pool)->alignShift)
+#define PoolAddrOfIndex(base, pool, i) AddrAdd(base, PoolGrainsSize(pool, i))
extern Bool PoolFormat(Format *formatReturn, Pool pool);
@@ -204,70 +225,36 @@ extern Bool PoolOfRange(Pool *poolReturn, Arena arena, Addr base, Addr limit);
extern Bool PoolHasAddr(Pool pool, Addr addr);
extern Bool PoolHasRange(Pool pool, Addr base, Addr limit);
-extern Res PoolCreate(Pool *poolReturn, Arena arena, PoolClass class,
+extern Res PoolCreate(Pool *poolReturn, Arena arena, PoolClass klass,
ArgList args);
extern void PoolDestroy(Pool pool);
extern BufferClass PoolDefaultBufferClass(Pool pool);
-extern Res PoolAlloc(Addr *pReturn, Pool pool, Size size,
- Bool withReservoirPermit);
-extern void PoolFree(Pool pool, Addr old, Size size);
+extern Res PoolAlloc(Addr *pReturn, Pool pool, Size size);
+extern void (PoolFree)(Pool pool, Addr old, Size size);
+extern PoolGen PoolSegPoolGen(Pool pool, Seg seg);
extern Res PoolTraceBegin(Pool pool, Trace trace);
-extern Res PoolAccess(Pool pool, Seg seg, Addr addr,
- AccessSet mode, MutatorFaultContext context);
-extern Res PoolWhiten(Pool pool, Trace trace, Seg seg);
-extern void PoolGrey(Pool pool, Trace trace, Seg seg);
-extern void PoolBlacken(Pool pool, TraceSet traceSet, Seg seg);
-extern Res PoolScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg);
-extern Res (PoolFix)(Pool pool, ScanState ss, Seg seg, Addr *refIO);
-#define PoolFix(pool, ss, seg, refIO) \
- ((*(pool)->fix)(pool, ss, seg, refIO))
-extern Res PoolFixEmergency(Pool pool, ScanState ss, Seg seg, Addr *refIO);
-extern void PoolReclaim(Pool pool, Trace trace, Seg seg);
-extern void PoolTraceEnd(Pool pool, Trace trace);
-extern Res PoolAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr);
-extern void PoolWalk(Pool pool, Seg seg, FormattedObjectsVisitor f,
- void *v, size_t s);
extern void PoolFreeWalk(Pool pool, FreeBlockVisitor f, void *p);
extern Size PoolTotalSize(Pool pool);
extern Size PoolFreeSize(Pool pool);
-extern Res PoolTrivInit(Pool pool, ArgList arg);
-extern void PoolTrivFinish(Pool pool);
-extern Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size,
- Bool withReservoirPermit);
-extern Res PoolTrivAlloc(Addr *pReturn, Pool pool, Size size,
- Bool withReservoirPermit);
+extern Res PoolAbsInit(Pool pool, Arena arena, PoolClass klass, ArgList arg);
+extern void PoolAbsFinish(Inst inst);
+extern Res PoolNoAlloc(Addr *pReturn, Pool pool, Size size);
+extern Res PoolTrivAlloc(Addr *pReturn, Pool pool, Size size);
extern void PoolNoFree(Pool pool, Addr old, Size size);
extern void PoolTrivFree(Pool pool, Addr old, Size size);
+extern PoolGen PoolNoSegPoolGen(Pool pool, Seg seg);
extern Res PoolNoBufferFill(Addr *baseReturn, Addr *limitReturn,
- Pool pool, Buffer buffer, Size size,
- Bool withReservoirPermit);
+ Pool pool, Buffer buffer, Size size);
extern Res PoolTrivBufferFill(Addr *baseReturn, Addr *limitReturn,
- Pool pool, Buffer buffer, Size size,
- Bool withReservoirPermit);
-extern void PoolNoBufferEmpty(Pool pool, Buffer buffer,
- Addr init, Addr limit);
-extern void PoolTrivBufferEmpty(Pool pool, Buffer buffer,
- Addr init, Addr limit);
-extern Res PoolTrivDescribe(Pool pool, mps_lib_FILE *stream, Count depth);
+ Pool pool, Buffer buffer, Size size);
+extern void PoolNoBufferEmpty(Pool pool, Buffer buffer);
+extern void PoolSegBufferEmpty(Pool pool, Buffer buffer);
+extern void PoolTrivBufferEmpty(Pool pool, Buffer buffer);
+extern Res PoolAbsDescribe(Inst inst, mps_lib_FILE *stream, Count depth);
extern Res PoolNoTraceBegin(Pool pool, Trace trace);
extern Res PoolTrivTraceBegin(Pool pool, Trace trace);
-extern Res PoolNoAccess(Pool pool, Seg seg, Addr addr,
- AccessSet mode, MutatorFaultContext context);
-extern Res PoolSegAccess(Pool pool, Seg seg, Addr addr,
- AccessSet mode, MutatorFaultContext context);
-extern Res PoolSingleAccess(Pool pool, Seg seg, Addr addr,
- AccessSet mode, MutatorFaultContext context);
-extern Res PoolNoWhiten(Pool pool, Trace trace, Seg seg);
-extern Res PoolTrivWhiten(Pool pool, Trace trace, Seg seg);
-extern void PoolNoGrey(Pool pool, Trace trace, Seg seg);
-extern void PoolTrivGrey(Pool pool, Trace trace, Seg seg);
-extern void PoolNoBlacken(Pool pool, TraceSet traceSet, Seg seg);
-extern void PoolTrivBlacken(Pool pool, TraceSet traceSet, Seg seg);
extern Res PoolNoScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg);
-extern Res PoolNoFix(Pool pool, ScanState ss, Seg seg, Ref *refIO);
-extern void PoolNoReclaim(Pool pool, Trace trace, Seg seg);
-extern void PoolTrivTraceEnd(Pool pool, Trace trace);
extern void PoolNoRampBegin(Pool pool, Buffer buf, Bool collectAll);
extern void PoolTrivRampBegin(Pool pool, Buffer buf, Bool collectAll);
extern void PoolNoRampEnd(Pool pool, Buffer buf);
@@ -276,50 +263,36 @@ extern Res PoolNoFramePush(AllocFrame *frameReturn, Pool pool, Buffer buf);
extern Res PoolTrivFramePush(AllocFrame *frameReturn, Pool pool, Buffer buf);
extern Res PoolNoFramePop(Pool pool, Buffer buf, AllocFrame frame);
extern Res PoolTrivFramePop(Pool pool, Buffer buf, AllocFrame frame);
-extern void PoolNoFramePopPending(Pool pool, Buffer buf, AllocFrame frame);
-extern void PoolTrivFramePopPending(Pool pool, Buffer buf, AllocFrame frame);
-extern Res PoolNoAddrObject(Addr *pReturn, Pool pool, Seg seg, Addr addr);
-extern void PoolNoWalk(Pool pool, Seg seg, FormattedObjectsVisitor f,
- void *p, size_t s);
extern void PoolTrivFreeWalk(Pool pool, FreeBlockVisitor f, void *p);
extern PoolDebugMixin PoolNoDebugMixin(Pool pool);
extern BufferClass PoolNoBufferClass(void);
extern Size PoolNoSize(Pool pool);
-#define ClassOfPool(pool) ((pool)->class)
-#define SuperclassOfPool(pool) \
- ((PoolClass)ProtocolClassSuperclassPoly((pool)->class))
-
+/* See .critical.macros. */
+#define PoolFreeMacro(pool, old, size) Method(Pool, pool, free)(pool, old, size)
+#if !defined(AVER_AND_CHECK_ALL)
+#define PoolFree(pool, old, size) PoolFreeMacro(pool, old, size)
+#endif /* !defined(AVER_AND_CHECK_ALL) */
/* Abstract Pool Classes Interface -- see */
-extern void PoolClassMixInBuffer(PoolClass class);
-extern void PoolClassMixInScan(PoolClass class);
-extern void PoolClassMixInFormat(PoolClass class);
-extern void PoolClassMixInCollect(PoolClass class);
-extern AbstractPoolClass AbstractPoolClassGet(void);
-extern AbstractBufferPoolClass AbstractBufferPoolClassGet(void);
-extern AbstractBufferPoolClass AbstractSegBufPoolClassGet(void);
-extern AbstractScanPoolClass AbstractScanPoolClassGet(void);
-extern AbstractCollectPoolClass AbstractCollectPoolClassGet(void);
-
-/* DEFINE_POOL_CLASS
- *
- * Convenience macro -- see . */
-
-#define DEFINE_POOL_CLASS(className, var) \
- DEFINE_ALIAS_CLASS(className, PoolClass, var)
-
-#define POOL_SUPERCLASS(className) \
- ((PoolClass)SUPERCLASS(className))
+extern void PoolClassMixInBuffer(PoolClass klass);
+extern void PoolClassMixInCollect(PoolClass klass);
+DECLARE_CLASS(Inst, PoolClass, InstClass);
+DECLARE_CLASS(Pool, AbstractPool, Inst);
+DECLARE_CLASS(Pool, AbstractBufferPool, AbstractPool);
+DECLARE_CLASS(Pool, AbstractSegBufPool, AbstractBufferPool);
+typedef Pool AbstractCollectPool;
+#define AbstractCollectPoolCheck PoolCheck
+DECLARE_CLASS(Pool, AbstractCollectPool, AbstractSegBufPool);
/* Message Interface -- see */
/* -- Internal (MPM) Interface -- functions for message originator */
extern Bool MessageCheck(Message message);
-extern Bool MessageClassCheck(MessageClass class);
+extern Bool MessageClassCheck(MessageClass klass);
extern Bool MessageTypeCheck(MessageType type);
extern void MessageInit(Arena arena, Message message,
- MessageClass class, MessageType type);
+ MessageClass klass, MessageType type);
extern void MessageFinish(Message message);
extern Arena MessageArena(Message message);
extern Bool MessageOnQueue(Message message);
@@ -394,12 +367,16 @@ extern Bool TraceIdCheck(TraceId id);
extern Bool TraceSetCheck(TraceSet ts);
extern Bool TraceCheck(Trace trace);
extern Res TraceCreate(Trace *traceReturn, Arena arena, int why);
-extern void TraceDestroy(Trace trace);
+extern void TraceDestroyInit(Trace trace);
+extern void TraceDestroyFinished(Trace trace);
+extern Bool TraceIsEmpty(Trace trace);
extern Res TraceAddWhite(Trace trace, Seg seg);
-extern Res TraceCondemnZones(Trace trace, ZoneSet condemnedSet);
+extern void TraceCondemnStart(Trace trace);
+extern Res TraceCondemnEnd(double *mortalityReturn, Trace trace);
extern Res TraceStart(Trace trace, double mortality, double finishingTime);
-extern Size TracePoll(Globals globals);
+extern Bool TracePoll(Work *workReturn, Bool *collectWorldReturn,
+ Globals globals, Bool collectWorldAllowed);
extern Rank TraceRankForAccess(Arena arena, Seg seg);
extern void TraceSegAccess(Arena arena, Seg seg, AccessSet mode);
@@ -419,11 +396,6 @@ extern Bool TraceIdMessagesCheck(Arena arena, TraceId ti);
extern Res TraceIdMessagesCreate(Arena arena, TraceId ti);
extern void TraceIdMessagesDestroy(Arena arena, TraceId ti);
-/* Collection control parameters */
-
-extern double TraceWorkFactor;
-
-
/* Equivalent to MPS_SCAN_BEGIN */
#define TRACE_SCAN_BEGIN(ss) \
@@ -482,32 +454,19 @@ extern void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena,
/* Arena Interface -- see */
-/* DEFINE_ARENA_CLASS
- *
- * Convenience macro -- see . */
-
-#define DEFINE_ARENA_CLASS(className, var) \
- DEFINE_ALIAS_CLASS(className, ArenaClass, var)
-
-#define ARENA_SUPERCLASS(className) \
- ((ArenaClass)SUPERCLASS(className))
-
-extern AbstractArenaClass AbstractArenaClassGet(void);
-extern Bool ArenaClassCheck(ArenaClass class);
+DECLARE_CLASS(Inst, ArenaClass, InstClass);
+DECLARE_CLASS(Arena, AbstractArena, Inst);
+extern Bool ArenaClassCheck(ArenaClass klass);
extern Bool ArenaCheck(Arena arena);
-extern Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args);
+extern Res ArenaCreate(Arena *arenaReturn, ArenaClass klass, ArgList args);
extern void ArenaDestroy(Arena arena);
-extern Res ArenaInit(Arena arena, ArenaClass class, Size grainSize,
- ArgList args);
-extern void ArenaFinish(Arena arena);
extern Res ArenaDescribe(Arena arena, mps_lib_FILE *stream, Count depth);
extern Res ArenaDescribeTracts(Arena arena, mps_lib_FILE *stream, Count depth);
-extern Bool ArenaAccess(Addr addr, AccessSet mode, MutatorFaultContext context);
+extern Bool ArenaAccess(Addr addr, AccessSet mode, MutatorContext context);
extern Res ArenaFreeLandInsert(Arena arena, Addr base, Addr limit);
extern void ArenaFreeLandDelete(Arena arena, Addr base, Addr limit);
-
extern Bool GlobalsCheck(Globals arena);
extern Res GlobalsInit(Globals arena);
extern void GlobalsFinish(Globals arena);
@@ -515,13 +474,17 @@ extern Res GlobalsCompleteCreate(Globals arenaGlobals);
extern void GlobalsPrepareToDestroy(Globals arenaGlobals);
extern Res GlobalsDescribe(Globals arena, mps_lib_FILE *stream, Count depth);
extern Ring GlobalsRememberedSummaryRing(Globals);
+extern void GlobalsArenaMap(void (*func)(Arena arena));
+extern void GlobalsClaimAll(void);
+extern void GlobalsReleaseAll(void);
+extern void GlobalsReinitializeAll(void);
#define ArenaGlobals(arena) (&(arena)->globals)
#define GlobalsArena(glob) PARENT(ArenaStruct, globals, glob)
#define ArenaThreadRing(arena) (&(arena)->threadRing)
#define ArenaDeadRing(arena) (&(arena)->deadRing)
-#define ArenaEpoch(arena) ((arena)->epoch) /* .epoch.ts */
+#define ArenaEpoch(arena) (ArenaHistory(arena)->epoch) /* .epoch.ts */
#define ArenaTrace(arena, ti) (&(arena)->trace[ti])
#define ArenaZoneShift(arena) ((arena)->zoneShift)
#define ArenaStripeSize(arena) ((Size)1 << ArenaZoneShift(arena))
@@ -529,6 +492,9 @@ extern Ring GlobalsRememberedSummaryRing(Globals);
#define ArenaGreyRing(arena, rank) (&(arena)->greyRing[rank])
#define ArenaPoolRing(arena) (&ArenaGlobals(arena)->poolRing)
#define ArenaChunkTree(arena) RVALUE((arena)->chunkTree)
+#define ArenaChunkRing(arena) (&(arena)->chunkRing)
+#define ArenaShield(arena) (&(arena)->shieldStruct)
+#define ArenaHistory(arena) (&(arena)->historyStruct)
extern Bool ArenaGrainSizeCheck(Size size);
#define AddrArenaGrainUp(addr, arena) AddrAlignUp(addr, ArenaGrainSize(arena))
@@ -540,16 +506,12 @@ extern Bool ArenaGrainSizeCheck(Size size);
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 ArenaEnter(Arena arena);
+extern void ArenaLeave(Arena arena);
extern void (ArenaPoll)(Globals globals);
#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) AVER(arena->busyTraces == TraceSetEMPTY)
#define ArenaPoll(globals) UNUSED(globals)
#else
#error "No shield configuration."
@@ -562,57 +524,53 @@ extern Bool (ArenaStep)(Globals globals, double interval, double multiplier);
extern void ArenaClamp(Globals globals);
extern void ArenaRelease(Globals globals);
extern void ArenaPark(Globals globals);
+extern void ArenaPostmortem(Globals globals);
extern void ArenaExposeRemember(Globals globals, Bool remember);
extern void ArenaRestoreProtection(Globals globals);
extern Res ArenaStartCollect(Globals globals, int why);
extern Res ArenaCollect(Globals globals, int why);
+extern Bool ArenaBusy(Arena arena);
extern Bool ArenaHasAddr(Arena arena, Addr addr);
-extern Res ArenaAddrObject(Addr *pReturn, Arena arena, Addr addr);
extern void ArenaChunkInsert(Arena arena, Chunk chunk);
extern void ArenaChunkRemoved(Arena arena, Chunk chunk);
+extern void ArenaAccumulateTime(Arena arena, Clock start, Clock now);
extern void ArenaSetEmergency(Arena arena, Bool emergency);
extern Bool ArenaEmergency(Arena arean);
extern Res ControlInit(Arena arena);
extern void ControlFinish(Arena arena);
-extern Res ControlAlloc(void **baseReturn, Arena arena, size_t size,
- Bool withReservoirPermit);
+extern Res ControlAlloc(void **baseReturn, Arena arena, size_t size);
extern void ControlFree(Arena arena, void *base, size_t size);
extern Res ControlDescribe(Arena arena, mps_lib_FILE *stream, Count depth);
-/* Peek/Poke
+/* Peek/Poke/Read/Write -- read/write possibly through barrier
*
* These are provided so that modules in the MPS can make occasional
- * access to client data. They perform the appropriate shield and
- * summary manipulations that are necessary.
+ * access to client data, and to implement a software barrier for
+ * segments that are not handed out to the mutator. They protect the
+ * necessary colour, shield and summary invariants.
*
- * Note that Peek and Poke can be called with address that may or
- * may not be in arena managed memory. */
+ * Note that Peek and Poke can be called with an address that may or
+ * may not be in memory managed by arena, whereas Read and Write
+ * assert this is the case.
+ */
/* Peek reads a value */
extern Ref ArenaPeek(Arena arena, Ref *p);
+/* Same, but p known to be owned by arena */
+extern Ref ArenaRead(Arena arena, Ref *p);
/* Same, but p must be in seg */
extern Ref ArenaPeekSeg(Arena arena, Seg seg, Ref *p);
/* Poke stores a value */
extern void ArenaPoke(Arena arena, Ref *p, Ref ref);
+/* Same, but p known to be owned by arena */
+extern void ArenaWrite(Arena arena, Ref *p, Ref ref);
/* Same, but p must be in seg */
extern void ArenaPokeSeg(Arena arena, Seg seg, Ref *p, Ref ref);
-/* Read/Write
- *
- * These simulate mutator reads and writes to locations.
- * They are effectively a software barrier, and maintain the tricolor
- * invariant (hence performing any scanning or color manipulation
- * necessary).
- *
- * Only Read provided right now. */
-
-Ref ArenaRead(Arena arena, Ref *p);
-
-
extern Size ArenaReserved(Arena arena);
extern Size ArenaCommitted(Arena arena);
extern Size ArenaSpareCommitted(Arena arena);
@@ -624,6 +582,8 @@ extern double ArenaSpare(Arena arena);
extern Size ArenaCommitLimit(Arena arena);
extern Res ArenaSetCommitLimit(Arena arena, Size limit);
extern void ArenaSetSpare(Arena arena, double spare);
+extern double ArenaPauseTime(Arena arena);
+extern void ArenaSetPauseTime(Arena arena, double pauseTime);
extern Size ArenaNoPurgeSpare(Arena arena, Size size);
extern Res ArenaNoGrow(Arena arena, LocusPref pref, Size size);
@@ -637,22 +597,8 @@ extern void ArenaCompact(Arena arena, Trace trace);
extern Res ArenaFinalize(Arena arena, Ref obj);
extern Res ArenaDefinalize(Arena arena, Ref obj);
-#define ArenaReservoir(arena) (&(arena)->reservoirStruct)
-#define ReservoirPool(reservoir) (&(reservoir)->poolStruct)
-
-extern Bool ReservoirCheck(Reservoir reservoir);
-extern Res ReservoirInit(Reservoir reservoir, Arena arena);
-extern void ReservoirFinish (Reservoir reservoir);
-extern Size ReservoirLimit(Reservoir reservoir);
-extern void ReservoirSetLimit(Reservoir reservoir, Size size);
-extern Size ReservoirAvailable(Reservoir reservoir);
-extern Res ReservoirEnsureFull(Reservoir reservoir);
-extern Bool ReservoirDeposit(Reservoir reservoir, Addr *baseIO, Size *sizeIO);
-extern Res ReservoirWithdraw(Addr *baseReturn, Tract *baseTractReturn,
- Reservoir reservoir, Size size, Pool pool);
-
extern Res ArenaAlloc(Addr *baseReturn, LocusPref pref,
- Size size, Pool pool, Bool withReservoirPermit);
+ Size size, Pool pool);
extern Res ArenaFreeLandAlloc(Tract *tractReturn, Arena arena, ZoneSet zones,
Bool high, Size size, Pool pool);
extern void ArenaFree(Addr base, Size size, Pool pool);
@@ -664,12 +610,12 @@ extern Res ArenaNoExtend(Arena arena, Addr base, Size size);
extern Res PolicyAlloc(Tract *tractReturn, Arena arena, LocusPref pref,
Size size, Pool pool);
-extern Bool PolicyShouldCollectWorld(Arena arena, double interval,
- double multiplier, Clock now,
- Clock clocks_per_sec);
-extern Bool PolicyStartTrace(Trace *traceReturn, Arena arena);
+extern Bool PolicyShouldCollectWorld(Arena arena, double availableTime,
+ Clock now, Clock clocks_per_sec);
+extern Bool PolicyStartTrace(Trace *traceReturn, Bool *collectWorldReturn,
+ Arena arena, Bool collectWorldAllowed);
extern Bool PolicyPoll(Arena arena);
-extern Bool PolicyPollAgain(Arena arena, Clock start, Size tracedSize);
+extern Bool PolicyPollAgain(Arena arena, Clock start, Bool moreWork, Work tracedWork);
/* Locus interface */
@@ -687,8 +633,8 @@ extern Bool LocusCheck(Arena arena);
/* Segment interface */
-extern Res SegAlloc(Seg *segReturn, SegClass class, LocusPref pref,
- Size size, Pool pool, Bool withReservoirPermit,
+extern Res SegAlloc(Seg *segReturn, SegClass klass, LocusPref pref,
+ Size size, Pool pool,
ArgList args);
extern void SegFree(Seg seg);
extern Bool SegOfAddr(Seg *segReturn, Arena arena, Addr addr);
@@ -697,34 +643,45 @@ extern Bool SegNext(Seg *segReturn, Arena arena, Seg seg);
extern Bool SegNextOfRing(Seg *segReturn, Arena arena, Pool pool, Ring next);
extern void SegSetWhite(Seg seg, TraceSet white);
extern void SegSetGrey(Seg seg, TraceSet grey);
+extern void SegFlip(Seg seg, Trace trace);
extern void SegSetRankSet(Seg seg, RankSet rankSet);
extern void SegSetRankAndSummary(Seg seg, RankSet rankSet, RefSet summary);
-extern Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi,
- Bool withReservoirPermit);
-extern Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at,
- Bool withReservoirPermit);
+extern Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi);
+extern Res SegSplit(Seg *segLoReturn, Seg *segHiReturn, Seg seg, Addr at);
+extern Res SegAccess(Seg seg, Arena arena, Addr addr,
+ AccessSet mode, MutatorContext context);
+extern Res SegWholeAccess(Seg seg, Arena arena, Addr addr,
+ AccessSet mode, MutatorContext context);
+extern Res SegSingleAccess(Seg seg, Arena arena, Addr addr,
+ AccessSet mode, MutatorContext context);
+extern Res SegWhiten(Seg seg, Trace trace);
+extern void SegGreyen(Seg seg, Trace trace);
+extern void SegBlacken(Seg seg, TraceSet traceSet);
+extern Res SegScan(Bool *totalReturn, Seg seg, ScanState ss);
+extern Res SegFix(Seg seg, ScanState ss, Addr *refIO);
+extern Res SegFixEmergency(Seg seg, ScanState ss, Addr *refIO);
+extern void SegReclaim(Seg seg, Trace trace);
+extern void SegWalk(Seg seg, Format format, FormattedObjectsVisitor f,
+ void *v, size_t s);
+extern Res SegAbsDescribe(Inst seg, mps_lib_FILE *stream, Count depth);
extern Res SegDescribe(Seg seg, mps_lib_FILE *stream, Count depth);
extern void SegSetSummary(Seg seg, RefSet summary);
-extern Buffer SegBuffer(Seg seg);
+extern Bool SegHasBuffer(Seg seg);
+extern Bool SegBuffer(Buffer *bufferReturn, Seg seg);
extern void SegSetBuffer(Seg seg, Buffer buffer);
+extern void SegUnsetBuffer(Seg seg);
+extern Bool SegBufferFill(Addr *baseReturn, Addr *limitReturn,
+ Seg seg, Size size, RankSet rankSet);
+extern Addr SegBufferScanLimit(Seg seg);
extern Bool SegCheck(Seg seg);
extern Bool GCSegCheck(GCSeg gcseg);
-extern Bool SegClassCheck(SegClass class);
-extern SegClass SegClassGet(void);
-extern SegClass GCSegClassGet(void);
-extern void SegClassMixInNoSplitMerge(SegClass class);
-
-
-/* DEFINE_SEG_CLASS -- define a segment class */
-
-#define DEFINE_SEG_CLASS(className, var) \
- DEFINE_ALIAS_CLASS(className, SegClass, var)
-
-
-#define SEG_SUPERCLASS(className) \
- ((SegClass)SUPERCLASS(className))
-
-#define ClassOfSeg(seg) ((seg)->class)
+extern Bool SegClassCheck(SegClass klass);
+DECLARE_CLASS(Inst, SegClass, InstClass);
+DECLARE_CLASS(Seg, Seg, Inst);
+DECLARE_CLASS(Seg, GCSeg, Seg);
+DECLARE_CLASS(Seg, MutatorSeg, GCSeg);
+#define SegGCSeg(seg) MustBeA(GCSeg, (seg))
+extern void SegClassMixInNoSplitMerge(SegClass klass);
extern Size SegSize(Seg seg);
extern Addr (SegBase)(Seg seg);
@@ -735,15 +692,15 @@ extern Addr (SegLimit)(Seg seg);
/* .bitfield.promote: The bit field accesses need to be cast to the */
/* right type, otherwise they'll be promoted to signed int, see */
/* standard.ansic.6.2.1.1. */
-#define SegRankSet(seg) ((RankSet)(seg)->rankSet)
-#define SegPM(seg) ((AccessSet)(seg)->pm)
-#define SegSM(seg) ((AccessSet)(seg)->sm)
-#define SegDepth(seg) ((unsigned)(seg)->depth)
-#define SegGrey(seg) ((TraceSet)(seg)->grey)
-#define SegWhite(seg) ((TraceSet)(seg)->white)
-#define SegNailed(seg) ((TraceSet)(seg)->nailed)
+#define SegRankSet(seg) RVALUE((RankSet)(seg)->rankSet)
+#define SegPM(seg) RVALUE((AccessSet)(seg)->pm)
+#define SegSM(seg) RVALUE((AccessSet)(seg)->sm)
+#define SegDepth(seg) RVALUE((unsigned)(seg)->depth)
+#define SegGrey(seg) RVALUE((TraceSet)(seg)->grey)
+#define SegWhite(seg) RVALUE((TraceSet)(seg)->white)
+#define SegNailed(seg) RVALUE((TraceSet)(seg)->nailed)
#define SegPoolRing(seg) (&(seg)->poolRing)
-#define SegOfPoolRing(node) (RING_ELT(Seg, poolRing, (node)))
+#define SegOfPoolRing(node) RING_ELT(Seg, poolRing, (node))
#define SegOfGreyRing(node) (&(RING_ELT(GCSeg, greyRing, (node)) \
->segStruct))
@@ -757,27 +714,25 @@ extern Addr (SegLimit)(Seg seg);
/* Buffer Interface -- see */
-extern Res BufferCreate(Buffer *bufferReturn, BufferClass class,
+extern Res BufferCreate(Buffer *bufferReturn, BufferClass klass,
Pool pool, Bool isMutator, ArgList args);
extern void BufferDestroy(Buffer buffer);
extern Bool BufferCheck(Buffer buffer);
extern Bool SegBufCheck(SegBuf segbuf);
extern Res BufferDescribe(Buffer buffer, mps_lib_FILE *stream, Count depth);
-extern Res BufferReserve(Addr *pReturn, Buffer buffer, Size size,
- Bool withReservoirPermit);
+extern Res BufferReserve(Addr *pReturn, Buffer buffer, Size size);
/* macro equivalent for BufferReserve, keep in sync with */
/* TODO: Perhaps this isn't really necessary now that we build the MPS with
more global optimisation and inlining. RB 2012-09-07 */
-#define BUFFER_RESERVE(pReturn, buffer, size, withReservoirPermit) \
+#define BUFFER_RESERVE(pReturn, buffer, size) \
(AddrAdd(BufferAlloc(buffer), size) > BufferAlloc(buffer) && \
AddrAdd(BufferAlloc(buffer), size) <= (Addr)BufferAP(buffer)->limit ? \
(*(pReturn) = BufferAlloc(buffer), \
BufferAP(buffer)->alloc = AddrAdd(BufferAlloc(buffer), size), \
ResOK) : \
- BufferFill(pReturn, buffer, size, withReservoirPermit))
+ BufferFill(pReturn, buffer, size))
-extern Res BufferFill(Addr *pReturn, Buffer buffer, Size size,
- Bool withReservoirPermit);
+extern Res BufferFill(Addr *pReturn, Buffer buffer, Size size);
extern Bool BufferCommit(Buffer buffer, Addr p, Size size);
/* macro equivalent for BufferCommit, keep in sync with */
@@ -821,7 +776,6 @@ extern Addr BufferScanLimit(Buffer buffer);
extern void BufferReassignSeg(Buffer buffer, Seg seg);
extern Bool BufferIsTrapped(Buffer buffer);
-extern Bool BufferIsTrappedByMutator(Buffer buffer);
extern void BufferRampBegin(Buffer buffer, AllocPattern pattern);
extern Res BufferRampEnd(Buffer buffer);
@@ -829,22 +783,14 @@ extern void BufferRampReset(Buffer buffer);
extern Res BufferFramePush(AllocFrame *frameReturn, Buffer buffer);
extern Res BufferFramePop(Buffer buffer, AllocFrame frame);
-extern FrameState BufferFrameState(Buffer buffer);
-extern void BufferFrameSetState(Buffer buffer, FrameState state);
-
-/* DEFINE_BUFFER_CLASS -- define a buffer class */
-
-#define DEFINE_BUFFER_CLASS(className, var) \
- DEFINE_ALIAS_CLASS(className, BufferClass, var)
-
-#define BUFFER_SUPERCLASS(className) \
- ((BufferClass)SUPERCLASS(className))
-
-extern Bool BufferClassCheck(BufferClass class);
-extern BufferClass BufferClassGet(void);
-extern BufferClass SegBufClassGet(void);
-extern BufferClass RankBufClassGet(void);
+extern Bool BufferClassCheck(BufferClass klass);
+DECLARE_CLASS(Inst, BufferClass, InstClass);
+DECLARE_CLASS(Buffer, Buffer, Inst);
+DECLARE_CLASS(Buffer, SegBuf, Buffer);
+typedef Buffer RankBuf;
+#define RankBufCheck BufferCheck
+DECLARE_CLASS(Buffer, RankBuf, SegBuf);
extern AllocPattern AllocPatternRamp(void);
extern AllocPattern AllocPatternRampCollectAll(void);
@@ -922,14 +868,19 @@ extern ZoneSet ZoneSetBlacklist(Arena arena);
/* Shield Interface -- see */
+extern void ShieldInit(Shield shield);
+extern void ShieldFinish(Shield shield);
+extern Bool ShieldCheck(Shield shield);
+extern Res ShieldDescribe(Shield shield, mps_lib_FILE *stream, Count depth);
+extern void ShieldDestroyQueue(Shield shield, Arena arena);
extern void (ShieldRaise)(Arena arena, Seg seg, AccessSet mode);
extern void (ShieldLower)(Arena arena, Seg seg, AccessSet mode);
extern void (ShieldEnter)(Arena arena);
extern void (ShieldLeave)(Arena arena);
extern void (ShieldExpose)(Arena arena, Seg seg);
extern void (ShieldCover)(Arena arena, Seg seg);
-extern void (ShieldSuspend)(Arena arena);
-extern void (ShieldResume)(Arena arena);
+extern void (ShieldHold)(Arena arena);
+extern void (ShieldRelease)(Arena arena);
extern void (ShieldFlush)(Arena arena);
#if defined(SHIELD)
@@ -940,13 +891,13 @@ extern void (ShieldFlush)(Arena arena);
#define ShieldLower(arena, seg, mode) \
BEGIN UNUSED(arena); UNUSED(seg); UNUSED(mode); END
#define ShieldEnter(arena) BEGIN UNUSED(arena); END
-#define ShieldLeave(arena) BEGIN UNUSED(arena); END
+#define ShieldLeave(arena) AVER(arena->busyTraces == TraceSetEMPTY)
#define ShieldExpose(arena, seg) \
BEGIN UNUSED(arena); UNUSED(seg); END
#define ShieldCover(arena, seg) \
BEGIN UNUSED(arena); UNUSED(seg); END
-#define ShieldSuspend(arena) BEGIN UNUSED(arena); END
-#define ShieldResume(arena) BEGIN UNUSED(arena); END
+#define ShieldHold(arena) BEGIN UNUSED(arena); END
+#define ShieldRelease(arena) BEGIN UNUSED(arena); END
#define ShieldFlush(arena) BEGIN UNUSED(arena); END
#else
#error "No shield configuration."
@@ -955,6 +906,10 @@ extern void (ShieldFlush)(Arena arena);
/* Location Dependency -- see */
+extern void HistoryInit(History history);
+extern void HistoryFinish(History);
+extern Res HistoryDescribe(History history, mps_lib_FILE *stream, Count depth);
+extern Bool HistoryCheck(History history);
extern void LDReset(mps_ld_t ld, Arena arena);
extern void LDAdd(mps_ld_t ld, Arena arena, Addr addr);
extern Bool LDIsStaleAny(mps_ld_t ld, Arena arena);
@@ -1014,59 +969,64 @@ extern Res RootsIterate(Globals arena, RootIterateFn f, void *p);
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 Size (LandSize)(Land land);
+extern Res LandInit(Land land, LandClass klass, Arena arena, Align alignment, void *owner, ArgList args);
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 (LandInsert)(Range rangeReturn, Land land, Range range);
+extern Res (LandDelete)(Range rangeReturn, Land land, Range range);
+extern Bool (LandIterate)(Land land, LandVisitor visitor, void *closure);
+extern Bool (LandIterateAndDelete)(Land land, LandDeleteVisitor visitor, void *closure);
+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, Count depth);
-extern Bool LandFlush(Land dest, Land src);
-
+extern Bool LandFlushVisitor(Bool *deleteReturn, Land land, Range range, void *closure);
+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())
+extern Bool LandClassCheck(LandClass klass);
+
+/* See .critical.macros. */
+#define LandSizeMacro(land) Method(Land, land, sizeMethod)(land)
+#define LandInsertMacro(rangeReturn, land, range) Method(Land, land, insert)(rangeReturn, land, range)
+#define LandDeleteMacro(rangeReturn, land, range) Method(Land, land, delete)(rangeReturn, land, range)
+#define LandIterateMacro(land, visitor, closure) Method(Land, land, iterate)(land, visitor, closure)
+#define LandIterateAndDeleteMacro(land, visitor, closure) Method(Land, land, iterateAndDelete)(land, visitor, closure)
+#define LandFindFirstMacro(rangeReturn, oldRangeReturn, land, size, findDelete) Method(Land, land, findFirst)(rangeReturn, oldRangeReturn, land, size, findDelete)
+#define LandFindLastMacro(rangeReturn, oldRangeReturn, land, size, findDelete) Method(Land, land, findLast)(rangeReturn, oldRangeReturn, land, size, findDelete)
+#define LandFindLargestMacro(rangeReturn, oldRangeReturn, land, size, findDelete) Method(Land, land, findLargest)(rangeReturn, oldRangeReturn, land, size, findDelete)
+#define LandFindInZonesMacro(foundReturn, rangeReturn, oldRangeReturn, land, size, zoneSet, high) Method(Land, land, findInZones)(foundReturn, rangeReturn, oldRangeReturn, land, size, zoneSet, high)
+#define LandFlushMacro(dest, src) LandIterateAndDelete(src, LandFlushVisitor, dest)
+#if !defined(AVER_AND_CHECK_ALL)
+#define LandSize(land) LandSizeMacro(land)
+#define LandInsert(rangeReturn, land, range) LandInsertMacro(rangeReturn, land, range)
+#define LandDelete(rangeReturn, land, range) LandDeleteMacro(rangeReturn, land, range)
+#define LandIterate(land, visitor, closure) LandIterateMacro(land, visitor, closure)
+#define LandIterateAndDelete(land, visitor, closure) LandIterateAndDeleteMacro(land, visitor, closure)
+#define LandFindFirst(rangeReturn, oldRangeReturn, land, size, findDelete) LandFindFirstMacro(rangeReturn, oldRangeReturn, land, size, findDelete)
+#define LandFindLast(rangeReturn, oldRangeReturn, land, size, findDelete) LandFindLastMacro(rangeReturn, oldRangeReturn, land, size, findDelete)
+#define LandFindLargest(rangeReturn, oldRangeReturn, land, size, findDelete) LandFindLargestMacro(rangeReturn, oldRangeReturn, land, size, findDelete)
+#define LandFindInZones(foundReturn, rangeReturn, oldRangeReturn, land, size, zoneSet, high) LandFindInZonesMacro(foundReturn, rangeReturn, oldRangeReturn, land, size, zoneSet, high)
+#define LandFlush(dest, src) LandFlushMacro(dest, src)
+#endif /* !defined(AVER_AND_CHECK_ALL) */
+
+DECLARE_CLASS(Inst, LandClass, InstClass);
+DECLARE_CLASS(Land, Land, Inst);
/* STATISTIC -- gather statistics (in some varieties)
*
- * The argument of STATISTIC is an expression; the expansion followed by
- * a semicolon is syntactically a statement.
- *
- * The argument of STATISTIC_STAT is a statement; the expansion followed by
- * a semicolon is syntactically a statement.
- *
- * STATISTIC_WRITE is inserted in WriteF arguments to output the values
- * of statistic fields.
- *
- * .statistic.whitehot: The implementation of STATISTIC for
- * non-statistical varieties passes the parameter to DISCARD to ensure
- * the parameter is syntactically an expression. The parameter is
- * passed as part of a comma-expression so that its type is not
- * important. This permits an expression of type void. */
+ * See .
+ */
#if defined(STATISTICS)
-#define STATISTIC(gather) BEGIN (gather); END
-#define STATISTIC_STAT(gather) BEGIN gather; END
+#define STATISTIC(gather) BEGIN gather; END
#define STATISTIC_WRITE(format, arg) (format), (arg),
#elif defined(STATISTICS_NONE)
-#define STATISTIC(gather) DISCARD(((gather), 0))
-#define STATISTIC_STAT DISCARD_STAT
+#define STATISTIC(gather) NOOP
#define STATISTIC_WRITE(format, arg)
#else /* !defined(STATISTICS) && !defined(STATISTICS_NONE) */
@@ -1080,7 +1040,7 @@ extern LandClass LandClassGet(void);
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2015 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/mpmss.c b/mps/code/mpmss.c
index 2c746b7e34d..792c2e0ff4a 100644
--- a/mps/code/mpmss.c
+++ b/mps/code/mpmss.c
@@ -1,7 +1,7 @@
/* mpmss.c: MPM STRESS TEST
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2002 Global Graphics Software.
*/
@@ -9,7 +9,6 @@
#include "mps.h"
#include "mpsavm.h"
#include "mpscmfs.h"
-#include "mpscmv.h"
#include "mpscmvff.h"
#include "mpslib.h"
#include "mpslib.h"
@@ -37,9 +36,9 @@ static void check_allocated_size(mps_pool_t pool, size_t allocated)
/* stress -- create a pool of the requested type and allocate in it */
static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
- size_t (*size)(size_t i), mps_align_t align,
- const char *name, mps_pool_class_t pool_class,
- mps_arg_s *args)
+ size_t (*size)(size_t i, mps_align_t align),
+ mps_align_t align, const char *name,
+ mps_pool_class_t pool_class, mps_arg_s *args)
{
mps_res_t res;
mps_pool_t pool;
@@ -57,11 +56,12 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
/* allocate a load of objects */
for (i=0; i= sizeof(ps[i]))
*ps[i] = 1; /* Write something, so it gets swap. */
@@ -83,7 +83,7 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
}
/* free half of the objects */
/* upper half, as when allocating them again we want smaller objects */
- /* see randomSize() */
+ /* see randomSizeAligned() */
for (i=testSetSIZE/2; i> (i / 10)), 2) + 1;
-}
-
-
-/* randomSize8 -- produce sizes both large and small, 8-byte aligned */
-
-static size_t randomSize8(size_t i)
+static size_t randomSizeAligned(size_t i, mps_align_t align)
{
size_t maxSize = 2 * 160 * 0x2000;
/* Reduce by a factor of 2 every 10 cycles. Total allocation about 40 MB. */
- return alignUp(rnd() % max((maxSize >> (i / 10)), 2) + 1, 8);
+ return alignUp(rnd() % max((maxSize >> (i / 10)), 2) + 1, align);
}
@@ -135,9 +125,10 @@ static size_t randomSize8(size_t i)
static size_t fixedSizeSize = 0;
-static size_t fixedSize(size_t i)
+static size_t fixedSize(size_t i, mps_align_t align)
{
testlib_unused(i);
+ testlib_unused(align);
return fixedSizeSize;
}
@@ -158,8 +149,8 @@ static mps_pool_debug_option_s fenceOptions = {
/* testInArena -- test all the pool classes in the given arena */
-static void testInArena(mps_arena_class_t arena_class, mps_arg_s *arena_args,
- mps_pool_debug_option_s *options)
+static void testInArena(mps_arena_class_t arena_class, size_t arena_grain_size,
+ mps_arg_s *arena_args, mps_pool_debug_option_s *options)
{
mps_arena_t arena;
@@ -167,43 +158,28 @@ static void testInArena(mps_arena_class_t arena_class, mps_arg_s *arena_args,
"mps_arena_create");
MPS_ARGS_BEGIN(args) {
- mps_align_t align = sizeof(void *) << (rnd() % 4);
+ mps_align_t align = rnd_align(sizeof(void *), arena_grain_size);
MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_ARENA_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_SLOT_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_SPARE, rnd_double());
- die(stress(arena, NULL, randomSize8, align, "MVFF",
+ die(stress(arena, NULL, randomSizeAligned, align, "MVFF",
mps_class_mvff(), args), "stress MVFF");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
- mps_align_t align = sizeof(void *) << (rnd() % 4);
+ mps_align_t align = rnd_align(sizeof(void *), arena_grain_size);
MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_ARENA_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_SLOT_HIGH, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, TRUE);
MPS_ARGS_ADD(args, MPS_KEY_SPARE, rnd_double());
MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, options);
- die(stress(arena, options, randomSize8, align, "MVFF debug",
+ die(stress(arena, options, randomSizeAligned, align, "MVFF debug",
mps_class_mvff_debug(), args), "stress MVFF debug");
} MPS_ARGS_END(args);
- MPS_ARGS_BEGIN(args) {
- mps_align_t align = (mps_align_t)1 << (rnd() % 6);
- MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
- die(stress(arena, NULL, randomSize, align, "MV",
- mps_class_mv(), args), "stress MV");
- } MPS_ARGS_END(args);
-
- MPS_ARGS_BEGIN(args) {
- mps_align_t align = (mps_align_t)1 << (rnd() % 6);
- MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
- MPS_ARGS_ADD(args, MPS_KEY_POOL_DEBUG_OPTIONS, options);
- die(stress(arena, options, randomSize, align, "MV debug",
- mps_class_mv_debug(), args), "stress MV debug");
- } MPS_ARGS_END(args);
-
MPS_ARGS_BEGIN(args) {
fixedSizeSize = 1 + rnd() % 64;
MPS_ARGS_ADD(args, MPS_KEY_MFS_UNIT_SIZE, fixedSizeSize);
@@ -212,24 +188,30 @@ static void testInArena(mps_arena_class_t arena_class, mps_arg_s *arena_args,
mps_class_mfs(), args), "stress MFS");
} MPS_ARGS_END(args);
+ /* Manual allocation should not cause any garbage collections. */
+ Insist(mps_collections(arena) == 0);
mps_arena_destroy(arena);
}
int main(int argc, char *argv[])
{
+ size_t arena_grain_size;
+
testlib_init(argc, argv);
+ arena_grain_size = rnd_grain(testArenaSIZE);
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, testArenaSIZE);
- MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, rnd_grain(testArenaSIZE));
- testInArena(mps_arena_class_vm(), args, &bothOptions);
+ MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, arena_grain_size);
+ testInArena(mps_arena_class_vm(), arena_grain_size, args, &bothOptions);
} MPS_ARGS_END(args);
+ arena_grain_size = rnd_grain(smallArenaSIZE);
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, smallArenaSIZE);
- MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, rnd_grain(smallArenaSIZE));
- testInArena(mps_arena_class_vm(), args, &fenceOptions);
+ MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, arena_grain_size);
+ testInArena(mps_arena_class_vm(), arena_grain_size, args, &fenceOptions);
} MPS_ARGS_END(args);
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
@@ -239,7 +221,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (c) 2001-2014 Ravenbrook Limited .
+ * Copyright (c) 2001-2016 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index 23103762ee9..b66643233c0 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-2016 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
* Portions copyright (C) 2001 Global Graphics Software.
*
* .design: This header file crosses module boundaries. The relevant
@@ -36,11 +36,12 @@
* See .
*
* .class: The pool class structure is defined by each pool class
- * implementation in order to provide an interface between the MPM
- * and the class (see ) via generic
- * functions (see ). A class XXX defines a function
- * PoolClassXXX() returning a PoolClass pointing to a PoolClassStruct
- * of methods which implement the memory management policy.
+ * implementation in order to provide an interface between the MPM and
+ * the class (see ) via generic functions (see
+ * ). Pool classes use the class protocol (see
+ * ) and so CLASS(ABCPool) returns a PoolClass
+ * pointing to a PoolClassStruct of methods which implement the memory
+ * management policy for pool class ABC.
*
* .class.end-sig: The class structure has a signature at the end. This
* causes the compiler to complain if the class structure is extended
@@ -49,41 +50,25 @@
#define PoolClassSig ((Sig)0x519C7A55) /* SIGnature pool CLASS */
typedef struct mps_pool_class_s {
- ProtocolClassStruct protocol;
- const char *name; /* class name string */
+ InstClassStruct instClassStruct;
size_t size; /* size of outer structure */
- size_t offset; /* offset of generic struct in outer struct */
Attr attr; /* attributes */
PoolVarargsMethod varargs; /* convert deprecated varargs into keywords */
PoolInitMethod init; /* initialize the pool descriptor */
- PoolFinishMethod finish; /* finish the pool descriptor */
PoolAllocMethod alloc; /* allocate memory from pool */
PoolFreeMethod free; /* free memory to pool */
+ PoolSegPoolGenMethod segPoolGen; /* get pool generation of segment */
PoolBufferFillMethod bufferFill; /* out-of-line reserve */
PoolBufferEmptyMethod bufferEmpty; /* out-of-line commit */
- PoolAccessMethod access; /* handles read/write accesses */
- PoolWhitenMethod whiten; /* whiten objects in a segment */
- PoolGreyMethod grey; /* grey non-white objects */
- PoolBlackenMethod blacken; /* blacken grey objects without scanning */
- PoolScanMethod scan; /* find references during tracing */
- PoolFixMethod fix; /* referent reachable during tracing */
- PoolFixEmergencyMethod fixEmergency; /* as fix, no failure allowed */
- PoolReclaimMethod reclaim; /* reclaim dead objects after tracing */
- PoolTraceEndMethod traceEnd; /* do something after all reclaims */
PoolRampBeginMethod rampBegin;/* begin a ramp pattern */
PoolRampEndMethod rampEnd; /* end a ramp pattern */
PoolFramePushMethod framePush; /* push an allocation frame */
PoolFramePopMethod framePop; /* pop an allocation frame */
- PoolFramePopPendingMethod framePopPending; /* notify pending pop */
- PoolAddrObjectMethod addrObject; /* find client pointer to object */
- PoolWalkMethod walk; /* walk over a segment */
PoolFreeWalkMethod freewalk; /* walk over free blocks */
PoolBufferClassMethod bufferClass; /* default BufferClass of pool */
- PoolDescribeMethod describe; /* describe the contents of the pool */
PoolDebugMixinMethod debugMixin; /* find the debug mixin, if any */
PoolSizeMethod totalSize; /* total memory allocated from arena */
PoolSizeMethod freeSize; /* free memory (unused by client program) */
- Bool labelled; /* whether it has been EventLabelled */
Sig sig; /* .class.end-sig */
} PoolClassStruct;
@@ -95,22 +80,23 @@ typedef struct mps_pool_class_s {
* a "subclass" of the pool structure (the "outer structure") which
* contains PoolStruct as a a field. The outer structure holds the
* class-specific part of the pool's state. See ,
- * . */
+ * .
+ */
#define PoolSig ((Sig)0x519B0019) /* SIGnature POOL */
typedef struct mps_pool_s { /* generic structure */
+ InstStruct instStruct;
Sig sig; /* */
Serial serial; /* from arena->poolSerial */
- PoolClass class; /* pool class structure */
Arena arena; /* owning arena */
RingStruct arenaRing; /* link in list of pools in arena */
RingStruct bufferRing; /* allocation buffers are attached to pool */
Serial bufferSerial; /* serial of next buffer */
RingStruct segRing; /* segs are attached to pool */
- Align alignment; /* alignment for units */
- Format format; /* format only if class->attr&AttrFMT */
- PoolFixMethod fix; /* fix method */
+ Align alignment; /* alignment for grains */
+ Shift alignShift; /* log2(alignment) */
+ Format format; /* format or NULL */
} PoolStruct;
@@ -136,56 +122,11 @@ typedef struct MFSStruct { /* MFS outer structure */
struct MFSHeaderStruct *freeList; /* head of the free list */
Size total; /* total size allocated from arena */
Size free; /* free space in pool */
- Tract tractList; /* the first tract */
+ RingStruct extentRing; /* ring of extents in pool */
Sig sig; /* */
} MFSStruct;
-/* MVStruct -- MV (Manual Variable) pool outer structure
- *
- * .mv: See , .
- *
- * The MV pool outer structure is declared here because it is the
- * control pool structure which is inlined in the arena. Normally,
- * pool outer structures are declared with the pools. */
-
-#define MVSig ((Sig)0x5193B999) /* SIGnature MV */
-
-typedef struct MVStruct { /* MV pool outer structure */
- PoolStruct poolStruct; /* generic structure */
- MFSStruct blockPoolStruct; /* for managing block descriptors */
- MFSStruct spanPoolStruct; /* for managing span descriptors */
- Size extendBy; /* segment size to extend pool by */
- Size avgSize; /* client estimate of allocation size */
- Size maxSize; /* client estimate of maximum size */
- Size free; /* free space in pool */
- Size lost; /* */
- RingStruct spans; /* span chain */
- Sig sig; /* */
-} MVStruct;
-
-
-/* ReservoirStruct -- Reservoir structure
- *
- * .reservoir: See , .
- *
- * The Reservoir structure is declared here because it is in-lined in
- * the arena for storing segments for the low-memory reservoir. It is
- * implemented as a pool - but doesn't follow the normal pool naming
- * conventions because it's not intended for general use and the use of
- * a pool is an incidental detail. */
-
-#define ReservoirSig ((Sig)0x5196e599) /* SIGnature REServoir */
-
-typedef struct ReservoirStruct { /* Reservoir structure */
- PoolStruct poolStruct; /* generic pool structure */
- Tract reserve; /* linked list of reserve tracts */
- Size reservoirLimit; /* desired reservoir size */
- Size reservoirSize; /* actual reservoir size */
- Sig sig; /* */
-} ReservoirStruct;
-
-
/* MessageClassStruct -- Message Class structure
*
* See (and ,
@@ -202,7 +143,7 @@ typedef struct MessageClassStruct {
/* generic methods */
MessageDeleteMethod delete; /* terminates a message */
- /* methods specific to MessageTypeFinalization */
+ /* methods specific to MessageTypeFINALIZATION */
MessageFinalizationRefMethod finalizationRef;
/* methods specific to MessageTypeGC */
@@ -210,7 +151,7 @@ typedef struct MessageClassStruct {
MessageGCCondemnedSizeMethod gcCondemnedSize;
MessageGCNotCondemnedSizeMethod gcNotCondemnedSize;
- /* methods specific to MessageTypeGCStart */
+ /* methods specific to MessageTypeGCSTART */
MessageGCStartWhyMethod gcStartWhy;
Sig endSig; /* */
@@ -225,7 +166,7 @@ typedef struct MessageClassStruct {
typedef struct mps_message_s {
Sig sig; /* */
Arena arena; /* owning arena */
- MessageClass class; /* Message Class Structure */
+ MessageClass klass; /* Message Class Structure */
Clock postedClock; /* mps_clock() at post time, or 0 */
RingStruct queueRing; /* Message queue ring */
} MessageStruct;
@@ -242,21 +183,31 @@ typedef struct mps_message_s {
#define SegClassSig ((Sig)0x5195E9C7) /* SIGnature SEG CLass */
typedef struct SegClassStruct {
- ProtocolClassStruct protocol;
- const char *name; /* class name string */
+ InstClassStruct instClassStruct;
size_t size; /* size of outer structure */
SegInitMethod init; /* initialize the segment */
- SegFinishMethod finish; /* finish the segment */
SegSetSummaryMethod setSummary; /* set the segment summary */
SegBufferMethod buffer; /* get the segment buffer */
SegSetBufferMethod setBuffer; /* set the segment buffer */
+ SegUnsetBufferMethod unsetBuffer; /* unset the segment buffer */
+ SegBufferFillMethod bufferFill; /* try filling buffer from segment */
+ SegBufferEmptyMethod bufferEmpty; /* empty buffer to segment */
SegSetGreyMethod setGrey; /* change greyness of segment */
+ SegFlipMethod flip; /* raise barrier for a flipped trace */
SegSetWhiteMethod setWhite; /* change whiteness of segment */
SegSetRankSetMethod setRankSet; /* change rank set of segment */
SegSetRankSummaryMethod setRankSummary; /* change rank set & summary */
- SegDescribeMethod describe; /* describe the contents of the seg */
SegMergeMethod merge; /* merge two adjacent segments */
SegSplitMethod split; /* split a segment into two */
+ SegAccessMethod access; /* handles read/write accesses */
+ SegWhitenMethod whiten; /* whiten objects */
+ SegGreyenMethod greyen; /* greyen non-white objects */
+ SegBlackenMethod blacken; /* blacken grey objects without scanning */
+ SegScanMethod scan; /* find references during tracing */
+ SegFixMethod fix; /* referent reachable during tracing */
+ SegFixMethod fixEmergency; /* as fix, no failure allowed */
+ SegReclaimMethod reclaim; /* reclaim dead objects after tracing */
+ SegWalkMethod walk; /* walk over a segment */
Sig sig; /* .class.end-sig */
} SegClassStruct;
@@ -269,18 +220,20 @@ typedef struct SegClassStruct {
#define SegSig ((Sig)0x5195E999) /* SIGnature SEG */
typedef struct SegStruct { /* segment structure */
+ InstStruct instStruct;
Sig sig; /* */
- SegClass class; /* segment class structure */
Tract firstTract; /* first tract of segment */
RingStruct poolRing; /* link in list of segs in pool */
Addr limit; /* limit of segment */
- unsigned depth : ShieldDepthWIDTH; /* see */
+ unsigned depth : ShieldDepthWIDTH; /* see design.mps.shield.def.depth */
+ BOOLFIELD(queued); /* in shield queue? */
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 */
RankSet rankSet : RankLIMIT; /* ranks of references in this seg */
+ unsigned defer : WB_DEFER_BITS; /* defer write barrier for this many scans */
} SegStruct;
@@ -296,6 +249,7 @@ typedef struct GCSegStruct { /* GC segment structure */
RingStruct greyRing; /* link in list of grey segs */
RefSet summary; /* summary of references out of seg */
Buffer buffer; /* non-NULL if seg is buffered */
+ RingStruct genRing; /* link in list of segs in gen */
Sig sig; /* */
} GCSegStruct;
@@ -328,15 +282,12 @@ typedef struct LocusPrefStruct { /* locus placement preferences */
#define BufferClassSig ((Sig)0x519B0FC7) /* SIGnature BUFfer CLass */
typedef struct BufferClassStruct {
- ProtocolClassStruct protocol;
- const char *name; /* class name string */
+ InstClassStruct instClassStruct;
size_t size; /* size of outer structure */
BufferVarargsMethod varargs; /* parse obsolete varargs */
BufferInitMethod init; /* initialize the buffer */
- BufferFinishMethod finish; /* finish the buffer */
BufferAttachMethod attach; /* attach the buffer */
BufferDetachMethod detach; /* detach the buffer */
- BufferDescribeMethod describe;/* describe the contents of the buffer */
BufferSegMethod seg; /* seg of buffer */
BufferRankSetMethod rankSet; /* rank set of buffer */
BufferSetRankSetMethod setRankSet; /* change rank set of buffer */
@@ -358,8 +309,8 @@ typedef struct BufferClassStruct {
#define BufferSig ((Sig)0x519B0FFE) /* SIGnature BUFFEr */
typedef struct BufferStruct {
+ InstStruct instStruct;
Sig sig; /* */
- BufferClass class; /* buffer class structure */
Serial serial; /* from pool->bufferSerial */
Arena arena; /* owning arena */
Pool pool; /* owning pool */
@@ -406,13 +357,14 @@ typedef struct mps_fmt_s {
Serial serial; /* from arena->formatSerial */
Arena arena; /* owning arena */
RingStruct arenaRing; /* formats are attached to the arena */
+ Count poolCount; /* number of pools using the format */
Align alignment; /* alignment of formatted objects */
mps_fmt_scan_t scan;
mps_fmt_skip_t skip;
mps_fmt_fwd_t move;
mps_fmt_isfwd_t isMoved;
mps_fmt_pad_t pad;
- mps_fmt_class_t class; /* pointer indicating class */
+ mps_fmt_class_t klass; /* pointer indicating class */
Size headerSize; /* size of header */
} FormatStruct;
@@ -425,6 +377,11 @@ typedef struct mps_fmt_s {
* through the MPS interface to optimise the critical path scan loop.
* See ["The critical path through the MPS"](../design/critical-path.txt).
*
+ * .ss.fix-closure: The fixClosure member allows the caller of the
+ * scanning protocol to pass data through to this fix function. This
+ * is not used in the public MPS, but is needed by the transforms
+ * extension.
+ *
* .ss.zone: For binary compatibility, the zone shift is exported as
* a word rather than a shift, so that the external mps_ss_s is a uniform
* three-word structure. See and .
@@ -445,23 +402,21 @@ typedef struct ScanStateStruct {
Sig sig; /* */
struct mps_ss_s ss_s; /* .ss */
Arena arena; /* owning arena */
- PoolFixMethod fix; /* third stage fix function */
- void *fixClosure; /* closure data for fix */
+ SegFixMethod fix; /* third stage fix function */
+ void *fixClosure; /* see .ss.fix-closure */
TraceSet traces; /* traces to scan for */
Rank rank; /* reference rank of scanning */
Bool wasMarked; /* design.mps.fix.protocol.was-ready */
RefSet fixedSummary; /* accumulated summary of fixed references */
- STATISTIC_DECL(Count fixRefCount); /* refs which pass zone check */
- STATISTIC_DECL(Count segRefCount); /* refs which refer to segs */
- STATISTIC_DECL(Count whiteSegRefCount); /* refs which refer to white segs */
- STATISTIC_DECL(Count nailCount); /* segments nailed by ambig refs */
- STATISTIC_DECL(Count snapCount); /* refs snapped to forwarded objs */
- STATISTIC_DECL(Count forwardedCount); /* objects preserved by moving */
- Size forwardedSize; /* bytes preserved by moving */
- STATISTIC_DECL(Count preservedInPlaceCount); /* objects preserved in place */
- Size preservedInPlaceSize; /* bytes preserved in place */
- STATISTIC_DECL(Size copiedSize); /* bytes copied */
- STATISTIC_DECL(Size scannedSize); /* bytes scanned */
+ STATISTIC_DECL(Count fixRefCount) /* refs which pass zone check */
+ STATISTIC_DECL(Count segRefCount) /* refs which refer to segs */
+ STATISTIC_DECL(Count whiteSegRefCount) /* refs which refer to white segs */
+ STATISTIC_DECL(Count nailCount) /* segments nailed by ambig refs */
+ STATISTIC_DECL(Count snapCount) /* refs snapped to forwarded objs */
+ STATISTIC_DECL(Count forwardedCount) /* objects preserved by moving */
+ STATISTIC_DECL(Count preservedInPlaceCount) /* objects preserved in place */
+ STATISTIC_DECL(Size copiedSize) /* bytes copied */
+ Size scannedSize; /* bytes scanned */
} ScanStateStruct;
@@ -479,38 +434,38 @@ typedef struct TraceStruct {
TraceState state; /* current state of trace */
Rank band; /* current band */
Bool firstStretch; /* in first stretch of band (see accessor) */
- PoolFixMethod fix; /* fix method to apply to references */
- void *fixClosure; /* closure information for fix method */
- Chain chain; /* chain being incrementally collected */
- STATISTIC_DECL(Size preTraceArenaReserved); /* ArenaReserved before this trace */
+ SegFixMethod fix; /* fix method to apply to references */
+ void *fixClosure; /* see .ss.fix-closure */
+ RingStruct genRing; /* ring of generations condemned for trace */
+ STATISTIC_DECL(Size preTraceArenaReserved) /* ArenaReserved before this trace */
Size condemned; /* condemned bytes */
Size notCondemned; /* collectable but not condemned */
Size foundation; /* initial grey set size */
- Size rate; /* segs to scan per increment */
- STATISTIC_DECL(Count greySegCount); /* number of grey segs */
- STATISTIC_DECL(Count greySegMax); /* max number of grey segs */
- STATISTIC_DECL(Count rootScanCount); /* number of roots scanned */
+ Work quantumWork; /* tracing work to be done in each poll */
+ STATISTIC_DECL(Count greySegCount) /* number of grey segs */
+ STATISTIC_DECL(Count greySegMax) /* max number of grey segs */
+ STATISTIC_DECL(Count rootScanCount) /* number of roots scanned */
Count rootScanSize; /* total size of scanned roots */
- Size rootCopiedSize; /* bytes copied by scanning roots */
- STATISTIC_DECL(Count segScanCount); /* number of segs scanned */
+ STATISTIC_DECL(Size rootCopiedSize) /* bytes copied by scanning roots */
+ STATISTIC_DECL(Count segScanCount) /* number of segs scanned */
Count segScanSize; /* total size of scanned segments */
- Size segCopiedSize; /* bytes copied by scanning segments */
- STATISTIC_DECL(Count singleScanCount); /* number of single refs scanned */
- STATISTIC_DECL(Count singleScanSize); /* total size of single refs scanned */
- STATISTIC_DECL(Size singleCopiedSize); /* bytes copied by scanning single refs */
- STATISTIC_DECL(Count fixRefCount); /* refs which pass zone check */
- STATISTIC_DECL(Count segRefCount); /* refs which refer to segs */
- STATISTIC_DECL(Count whiteSegRefCount); /* refs which refer to white segs */
- STATISTIC_DECL(Count nailCount); /* segments nailed by ambig refs */
- STATISTIC_DECL(Count snapCount); /* refs snapped to forwarded objs */
- STATISTIC_DECL(Count readBarrierHitCount); /* read barrier faults */
- STATISTIC_DECL(Count pointlessScanCount); /* pointless seg scans */
- STATISTIC_DECL(Count forwardedCount); /* objects preserved by moving */
+ STATISTIC_DECL(Size segCopiedSize) /* bytes copied by scanning segments */
+ STATISTIC_DECL(Count singleScanCount) /* number of single refs scanned */
+ STATISTIC_DECL(Count singleScanSize) /* total size of single refs scanned */
+ STATISTIC_DECL(Size singleCopiedSize) /* bytes copied by scanning single refs */
+ STATISTIC_DECL(Count fixRefCount) /* refs which pass zone check */
+ STATISTIC_DECL(Count segRefCount) /* refs which refer to segs */
+ STATISTIC_DECL(Count whiteSegRefCount) /* refs which refer to white segs */
+ STATISTIC_DECL(Count nailCount) /* segments nailed by ambig refs */
+ STATISTIC_DECL(Count snapCount) /* refs snapped to forwarded objs */
+ STATISTIC_DECL(Count readBarrierHitCount) /* read barrier faults */
+ STATISTIC_DECL(Count pointlessScanCount) /* pointless seg scans */
+ STATISTIC_DECL(Count forwardedCount) /* objects preserved by moving */
Size forwardedSize; /* bytes preserved by moving */
- STATISTIC_DECL(Count preservedInPlaceCount); /* objects preserved in place */
+ STATISTIC_DECL(Count preservedInPlaceCount) /* objects preserved in place */
Size preservedInPlaceSize; /* bytes preserved in place */
- STATISTIC_DECL(Count reclaimCount); /* segments reclaimed */
- STATISTIC_DECL(Count reclaimSize); /* bytes reclaimed */
+ STATISTIC_DECL(Count reclaimCount) /* segments reclaimed */
+ STATISTIC_DECL(Count reclaimSize) /* bytes reclaimed */
} TraceStruct;
@@ -519,13 +474,12 @@ typedef struct TraceStruct {
#define ArenaClassSig ((Sig)0x519A6C1A) /* SIGnature ARena CLAss */
typedef struct mps_arena_class_s {
- ProtocolClassStruct protocol;
- const char *name; /* class name string */
+ InstClassStruct instClassStruct;
size_t size; /* size of outer structure */
- size_t offset; /* offset of generic struct in outer struct */
ArenaVarargsMethod varargs;
ArenaInitMethod init;
- ArenaFinishMethod finish;
+ ArenaCreateMethod create;
+ ArenaDestroyMethod destroy;
ArenaPurgeSpareMethod purgeSpare;
ArenaExtendMethod extend;
ArenaGrowMethod grow;
@@ -533,8 +487,8 @@ typedef struct mps_arena_class_s {
ArenaChunkInitMethod chunkInit;
ArenaChunkFinishMethod chunkFinish;
ArenaCompactMethod compact;
- ArenaDescribeMethod describe;
ArenaPagesMarkAllocatedMethod pagesMarkAllocated;
+ ArenaChunkPageMappedMethod chunkPageMapped;
Sig sig;
} ArenaClassStruct;
@@ -574,6 +528,7 @@ typedef struct GlobalsStruct {
/* pool fields () */
RingStruct poolRing; /* ring of pools in arena */
Serial poolSerial; /* serial of next created pool */
+ Count systemPools; /* count of pools remaining at ArenaDestroy */
/* root fields () */
RingStruct rootRing; /* ring of roots attached to arena */
@@ -598,12 +553,10 @@ typedef struct GlobalsStruct {
#define LandClassSig ((Sig)0x5197A4DC) /* SIGnature LAND Class */
typedef struct LandClassStruct {
- ProtocolClassStruct protocol;
- const char *name; /* class name string */
+ InstClassStruct instClassStruct;
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 */
@@ -612,7 +565,6 @@ typedef struct LandClassStruct {
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;
@@ -625,8 +577,8 @@ typedef struct LandClassStruct {
#define LandSig ((Sig)0x5197A4D9) /* SIGnature LAND */
typedef struct LandStruct {
+ InstStruct instStruct;
Sig sig; /* */
- LandClass class; /* land class structure */
Arena arena; /* owning arena */
Align alignment; /* alignment of addresses */
Bool inLand; /* prevent reentrance */
@@ -646,13 +598,13 @@ typedef struct LandStruct {
typedef struct CBSStruct {
LandStruct landStruct; /* superclass fields come first */
SplayTreeStruct splayTreeStruct;
- STATISTIC_DECL(Count treeSize);
+ STATISTIC_DECL(Count treeSize)
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);
+ METER_DECL(treeSearch)
Sig sig; /* .class.end-sig */
} CBSStruct;
@@ -696,29 +648,110 @@ typedef struct FreelistStruct {
} FreelistStruct;
+/* SortStruct -- extra memory required by sorting
+ *
+ * See QuickSort in mpm.c. This exists so that the caller can make
+ * the choice about where to allocate the memory, since the MPS has to
+ * operate in tight stack constraints -- see design.mps.sp.
+ */
+
+typedef struct SortStruct {
+ struct {
+ Index left, right;
+ } stack[MPS_WORD_WIDTH];
+} SortStruct;
+
+
+/* ShieldStruct -- per-arena part of the shield
+ *
+ * See design.mps.shield, impl.c.shield.
+ */
+
+#define ShieldSig ((Sig)0x519581E1) /* SIGnature SHEILd */
+
+typedef struct ShieldStruct {
+ Sig sig; /* design.mps.sig */
+ BOOLFIELD(inside); /* design.mps.shield.def.inside */
+ BOOLFIELD(suspended); /* mutator suspended? */
+ BOOLFIELD(queuePending); /* queue insertion pending? */
+ Seg *queue; /* queue of unsynced segs */
+ Count length; /* number of elements in shield queue */
+ Index next; /* next free element in shield queue */
+ Index limit; /* high water mark for cache usage */
+ Count depth; /* sum of depths of all segs */
+ Count unsynced; /* number of unsynced segments */
+ Count holds; /* number of holds */
+ SortStruct sortStruct; /* workspace for queue sort */
+} ShieldStruct;
+
+
+/* History -- location dependency history
+ *
+ * See design.mps.arena.ld.
+ */
+
+#define HistorySig ((Sig)0x51981520) /* SIGnature HISTOry */
+
+typedef struct HistoryStruct {
+ Sig sig; /* design.mps.sig */
+ Epoch epoch; /* */
+ RefSet prehistory; /* */
+ RefSet history[LDHistoryLENGTH]; /* */
+} HistoryStruct;
+
+
+/* MVFFStruct -- MVFF (Manual Variable First Fit) pool outer structure
+ *
+ * The signature is placed at the end, see
+ *
+ *
+ * The MVFF pool outer structure is declared here because it is the
+ * control pool structure which is inlined in the arena. Normally,
+ * pool outer structures are declared with the pools.
+ */
+
+#define MVFFSig ((Sig)0x5193FFF9) /* SIGnature MVFF */
+
+typedef struct MVFFStruct { /* MVFF pool outer structure */
+ PoolStruct poolStruct; /* generic structure */
+ LocusPrefStruct locusPrefStruct; /* the preferences for allocation */
+ Size extendBy; /* size to extend pool by */
+ Size avgSize; /* client estimate of allocation size */
+ double spare; /* spare space fraction, see MVFFReduce */
+ MFSStruct cbsBlockPoolStruct; /* stores blocks for CBSs */
+ CBSStruct totalCBSStruct; /* all memory allocated from the arena */
+ CBSStruct freeCBSStruct; /* free memory (primary) */
+ FreelistStruct flStruct; /* free memory (secondary, for emergencies) */
+ FailoverStruct foStruct; /* free memory (fail-over mechanism) */
+ Bool firstFit; /* as opposed to last fit */
+ Bool slotHigh; /* prefers high part of large block */
+ Sig sig; /* */
+} MVFFStruct;
+
+
/* ArenaStruct -- generic arena
*
- * See . */
+ * See .
+ */
#define ArenaSig ((Sig)0x519A6E4A) /* SIGnature ARENA */
typedef struct mps_arena_s {
+ InstStruct instStruct;
+
GlobalsStruct globals; /* must be first, see */
Serial serial;
- ArenaClass class; /* arena class structure */
-
Bool poolReady; /* */
- MVStruct controlPoolStruct; /* */
-
- ReservoirStruct reservoirStruct; /* */
+ MVFFStruct controlPoolStruct; /* */
Size reserved; /* total reserved address space */
Size committed; /* total committed memory */
Size commitLimit; /* client-configurable commit limit */
- Size spareCommitted; /* Amount of memory in hysteresis fund */
+ Size spareCommitted; /* amount of memory in hysteresis fund */
double spare; /* limit on spareCommitted */
+ double pauseTime; /* maximum pause time, in seconds */
Shift zoneShift; /* see also */
Size grainSize; /* */
@@ -757,15 +790,9 @@ typedef struct mps_arena_s {
RingStruct threadRing; /* ring of attached threads */
RingStruct deadRing; /* ring of dead threads */
Serial threadSerial; /* serial of next thread */
-
- /* shield fields () */
- Bool insideShield; /* TRUE if and only if inside shield */
- Seg shCache[ShieldCacheSIZE]; /* Cache of unsynced segs */
- Size shCacheI; /* index into cache */
- Size shCacheLimit; /* High water mark for cache usage */
- Size shDepth; /* sum of depths of all segs */
- Bool suspended; /* TRUE iff mutator suspended */
+ ShieldStruct shieldStruct;
+
/* trace fields () */
TraceSet busyTraces; /* set of running traces */
TraceSet flippedTraces; /* set of running and flipped traces */
@@ -777,23 +804,21 @@ typedef struct mps_arena_s {
TraceMessage tMessage[TraceLIMIT]; /* */
/* policy fields */
- double tracedSize;
+ double tracedWork;
double tracedTime;
Clock lastWorldCollect;
RingStruct greyRing[RankLIMIT]; /* ring of grey segments at each rank */
- STATISTIC_DECL(Count writeBarrierHitCount); /* write barrier hits */
+ STATISTIC_DECL(Count writeBarrierHitCount) /* write barrier hits */
RingStruct chainRing; /* ring of chains */
- /* location dependency fields () */
- Epoch epoch; /* */
- RefSet prehistory; /* */
- RefSet history[LDHistoryLENGTH]; /* */
-
+ struct HistoryStruct historyStruct;
+
Bool emergency; /* garbage collect in emergency mode? */
- Word *stackAtArenaEnter; /* NULL or hot end of client stack, in the thread */
- /* that then entered the MPS. */
+ /* Stack scanning -- see design.mps.stack-scan */
+ void *stackWarm; /* NULL or stack pointer warmer than
+ mutator state. */
Sig sig;
} ArenaStruct;
@@ -809,7 +834,7 @@ typedef struct AllocPatternStruct {
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2016 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 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 2571106984a..ce21bc5b3ab 100644
--- a/mps/code/mpmtypes.h
+++ b/mps/code/mpmtypes.h
@@ -1,7 +1,7 @@
/* mpmtypes.h: MEMORY POOL MANAGER TYPES
*
* $Id$
- * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
+ * Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
* Portions copyright (c) 2001 Global Graphics Software.
*
* .design:
@@ -38,6 +38,7 @@ typedef Word Size; /* */
typedef Word Count; /* */
typedef Word Index; /* */
typedef Word Align; /* */
+typedef Word Work; /* */
typedef unsigned Shift; /* */
typedef unsigned Serial; /* */
typedef Addr Ref; /* */
@@ -61,26 +62,19 @@ typedef unsigned TraceSet; /* */
typedef unsigned TraceState; /* */
typedef unsigned AccessSet; /* */
typedef unsigned Attr; /* */
-typedef int RootVar; /* */
+typedef unsigned RootVar; /* */
typedef Word *BT; /* */
typedef struct BootBlockStruct *BootBlock; /* */
typedef struct BufferStruct *Buffer; /* */
typedef struct SegBufStruct *SegBuf; /* */
typedef struct BufferClassStruct *BufferClass; /* */
-typedef BufferClass SegBufClass; /* */
-typedef BufferClass RankBufClass; /* */
typedef unsigned BufferMode; /* */
-typedef unsigned FrameState; /* */
typedef struct mps_fmt_s *Format; /* design.mps.format */
typedef struct LockStruct *Lock; /* * */
typedef struct mps_pool_s *Pool; /* */
+typedef Pool AbstractPool;
typedef struct mps_pool_class_s *PoolClass; /* */
-typedef PoolClass AbstractPoolClass; /* */
-typedef PoolClass AbstractBufferPoolClass; /* */
-typedef PoolClass AbstractSegBufPoolClass; /* */
-typedef PoolClass AbstractScanPoolClass; /* */
-typedef PoolClass AbstractCollectPoolClass; /* */
typedef struct TraceStruct *Trace; /* */
typedef struct ScanStateStruct *ScanState; /* */
typedef struct mps_chain_s *Chain; /* */
@@ -91,35 +85,36 @@ typedef union PageUnion *Page; /* */
typedef struct SegStruct *Seg; /* */
typedef struct GCSegStruct *GCSeg; /* */
typedef struct SegClassStruct *SegClass; /* */
-typedef SegClass GCSegClass; /* */
typedef struct LocusPrefStruct *LocusPref; /* , */
-typedef int LocusPrefKind; /* , */
+typedef unsigned LocusPrefKind; /* , */
typedef struct mps_arena_class_s *ArenaClass; /* */
-typedef ArenaClass AbstractArenaClass; /* */
typedef struct mps_arena_s *Arena; /* */
+typedef Arena AbstractArena;
typedef struct GlobalsStruct *Globals; /* */
typedef struct VMStruct *VM; /* * */
typedef struct RootStruct *Root; /* */
typedef struct mps_thr_s *Thread; /* * */
-typedef struct MutatorFaultContextStruct
- *MutatorFaultContext; /* */
+typedef struct MutatorContextStruct *MutatorContext; /* */
typedef struct PoolDebugMixinStruct *PoolDebugMixin;
typedef struct AllocPatternStruct *AllocPattern;
typedef struct AllocFrameStruct *AllocFrame; /* */
-typedef struct ReservoirStruct *Reservoir; /* */
typedef struct StackContextStruct *StackContext;
typedef struct RangeStruct *Range; /* */
+typedef struct RangeTreeStruct *RangeTree;
typedef struct LandStruct *Land; /* */
typedef struct LandClassStruct *LandClass; /* */
typedef unsigned FindDelete; /* */
+typedef struct ShieldStruct *Shield; /* design.mps.shield */
+typedef struct HistoryStruct *History; /* design.mps.arena.ld */
+typedef struct PoolGenStruct *PoolGen; /* */
/* Arena*Method -- see */
typedef void (*ArenaVarargsMethod)(ArgStruct args[], va_list varargs);
-typedef Res (*ArenaInitMethod)(Arena *arenaReturn,
- ArenaClass class, ArgList args);
-typedef void (*ArenaFinishMethod)(Arena arena);
+typedef Res (*ArenaCreateMethod)(Arena *arenaReturn, ArgList args);
+typedef void (*ArenaDestroyMethod)(Arena arena);
+typedef Res (*ArenaInitMethod)(Arena arena, Size grainSize, ArgList args);
typedef Size (*ArenaPurgeSpareMethod)(Arena arena, Size size);
typedef Res (*ArenaExtendMethod)(Arena arena, Addr base, Size size);
typedef Res (*ArenaGrowMethod)(Arena arena, LocusPref pref, Size size);
@@ -127,10 +122,10 @@ typedef void (*ArenaFreeMethod)(Addr base, Size size, Pool pool);
typedef Res (*ArenaChunkInitMethod)(Chunk chunk, BootBlock boot);
typedef void (*ArenaChunkFinishMethod)(Chunk chunk);
typedef void (*ArenaCompactMethod)(Arena arena, Trace trace);
-typedef Res (*ArenaDescribeMethod)(Arena arena, mps_lib_FILE *stream, Count depth);
typedef Res (*ArenaPagesMarkAllocatedMethod)(Arena arena, Chunk chunk,
Index baseIndex, Count pages,
Pool pool);
+typedef Bool (*ArenaChunkPageMappedMethod)(Chunk chunk, Index index);
/* These are not generally exposed and public, but are part of a commercial
@@ -157,29 +152,40 @@ typedef void (*FreeBlockVisitor)(Addr base, Addr limit, Pool pool, void *p);
/* Seg*Method -- see */
typedef Res (*SegInitMethod)(Seg seg, Pool pool, Addr base, Size size,
- Bool withReservoirPermit, ArgList args);
-typedef void (*SegFinishMethod)(Seg seg);
+ ArgList args);
typedef void (*SegSetGreyMethod)(Seg seg, TraceSet grey);
+typedef void (*SegFlipMethod)(Seg seg, Trace trace);
typedef void (*SegSetWhiteMethod)(Seg seg, TraceSet white);
typedef void (*SegSetRankSetMethod)(Seg seg, RankSet rankSet);
typedef void (*SegSetRankSummaryMethod)(Seg seg, RankSet rankSet,
RefSet summary);
typedef void (*SegSetSummaryMethod)(Seg seg, RefSet summary);
-typedef Buffer (*SegBufferMethod)(Seg seg);
+typedef Bool (*SegBufferMethod)(Buffer *bufferReturn, Seg seg);
typedef void (*SegSetBufferMethod)(Seg seg, Buffer buffer);
-typedef Res (*SegDescribeMethod)(Seg seg, mps_lib_FILE *stream, Count depth);
+typedef void (*SegUnsetBufferMethod)(Seg seg);
+typedef Bool (*SegBufferFillMethod)(Addr *baseReturn, Addr *limitReturn,
+ Seg seg, Size size, RankSet rankSet);
+typedef void (*SegBufferEmptyMethod)(Seg seg, Buffer buffer);
typedef Res (*SegMergeMethod)(Seg seg, Seg segHi,
- Addr base, Addr mid, Addr limit,
- Bool withReservoirPermit);
+ Addr base, Addr mid, Addr limit);
typedef Res (*SegSplitMethod)(Seg seg, Seg segHi,
- Addr base, Addr mid, Addr limit,
- Bool withReservoirPermit);
+ Addr base, Addr mid, Addr limit);
+typedef Res (*SegAccessMethod)(Seg seg, Arena arena, Addr addr,
+ AccessSet mode, MutatorContext context);
+typedef Res (*SegWhitenMethod)(Seg seg, Trace trace);
+typedef void (*SegGreyenMethod)(Seg seg, Trace trace);
+typedef void (*SegBlackenMethod)(Seg seg, TraceSet traceSet);
+typedef Res (*SegScanMethod)(Bool *totalReturn, Seg seg, ScanState ss);
+typedef Res (*SegFixMethod)(Seg seg, ScanState ss, Ref *refIO);
+typedef void (*SegReclaimMethod)(Seg seg, Trace trace);
+typedef void (*SegWalkMethod)(Seg seg, Format format, FormattedObjectsVisitor f,
+ void *v, size_t s);
+
/* Buffer*Method -- see */
typedef void (*BufferVarargsMethod)(ArgStruct args[], va_list varargs);
-typedef Res (*BufferInitMethod)(Buffer buffer, Pool pool, ArgList args);
-typedef void (*BufferFinishMethod)(Buffer buffer);
+typedef Res (*BufferInitMethod)(Buffer buffer, Pool pool, Bool isMutator, ArgList args);
typedef void (*BufferAttachMethod)(Buffer buffer, Addr base, Addr limit,
Addr init, Size size);
typedef void (*BufferDetachMethod)(Buffer buffer);
@@ -187,53 +193,28 @@ typedef Seg (*BufferSegMethod)(Buffer buffer);
typedef RankSet (*BufferRankSetMethod)(Buffer buffer);
typedef void (*BufferSetRankSetMethod)(Buffer buffer, RankSet rankSet);
typedef void (*BufferReassignSegMethod)(Buffer buffer, Seg seg);
-typedef Res (*BufferDescribeMethod)(Buffer buffer, mps_lib_FILE *stream, Count depth);
-/* Pool*Method -- see */
+/* Pool*Method -- see */
/* Order of types corresponds to PoolClassStruct in */
typedef void (*PoolVarargsMethod)(ArgStruct args[], va_list varargs);
-typedef Res (*PoolInitMethod)(Pool pool, ArgList args);
-typedef void (*PoolFinishMethod)(Pool pool);
-typedef Res (*PoolAllocMethod)(Addr *pReturn, Pool pool, Size size,
- Bool withReservoirPermit);
+typedef Res (*PoolInitMethod)(Pool pool, Arena arena, PoolClass klass, ArgList args);
+typedef Res (*PoolAllocMethod)(Addr *pReturn, Pool pool, Size size);
typedef void (*PoolFreeMethod)(Pool pool, Addr old, Size size);
+typedef PoolGen (*PoolSegPoolGenMethod)(Pool pool, Seg seg);
typedef Res (*PoolBufferFillMethod)(Addr *baseReturn, Addr *limitReturn,
- Pool pool, Buffer buffer, Size size,
- Bool withReservoirPermit);
-typedef void (*PoolBufferEmptyMethod)(Pool pool, Buffer buffer,
- Addr init, Addr limit);
-typedef Res (*PoolTraceBeginMethod)(Pool pool, Trace trace);
-typedef Res (*PoolAccessMethod)(Pool pool, Seg seg, Addr addr,
- AccessSet mode, MutatorFaultContext context);
-typedef Res (*PoolWhitenMethod)(Pool pool, Trace trace, Seg seg);
-typedef void (*PoolGreyMethod)(Pool pool, Trace trace, Seg seg);
-typedef void (*PoolBlackenMethod)(Pool pool, TraceSet traceSet, Seg seg);
-typedef Res (*PoolScanMethod)(Bool *totalReturn, ScanState ss,
- Pool pool, Seg seg);
-typedef Res (*PoolFixMethod)(Pool pool, ScanState ss, Seg seg,
- Ref *refIO);
-typedef Res (*PoolFixEmergencyMethod)(Pool pool, ScanState ss,
- Seg seg, Ref *refIO);
-typedef void (*PoolReclaimMethod)(Pool pool, Trace trace, Seg seg);
-typedef void (*PoolTraceEndMethod)(Pool pool, Trace trace);
+ Pool pool, Buffer buffer, Size size);
+typedef void (*PoolBufferEmptyMethod)(Pool pool, Buffer buffer);
typedef void (*PoolRampBeginMethod)(Pool pool, Buffer buf, Bool collectAll);
typedef void (*PoolRampEndMethod)(Pool pool, Buffer buf);
typedef Res (*PoolFramePushMethod)(AllocFrame *frameReturn,
Pool pool, Buffer buf);
typedef Res (*PoolFramePopMethod)(Pool pool, Buffer buf,
AllocFrame frame);
-typedef void (*PoolFramePopPendingMethod)(Pool pool, Buffer buf,
- AllocFrame frame);
-typedef Res (*PoolAddrObjectMethod)(Addr *pReturn,
- Pool pool, Seg seg, Addr addr);
-typedef void (*PoolWalkMethod)(Pool pool, Seg seg, FormattedObjectsVisitor f,
- void *v, size_t s);
typedef void (*PoolFreeWalkMethod)(Pool pool, FreeBlockVisitor f, void *p);
typedef BufferClass (*PoolBufferClassMethod)(void);
-typedef Res (*PoolDescribeMethod)(Pool pool, mps_lib_FILE *stream, Count depth);
typedef PoolDebugMixin (*PoolDebugMixinMethod)(Pool pool);
typedef Size (*PoolSizeMethod)(Pool pool);
@@ -265,25 +246,23 @@ typedef struct TraceMessageStruct *TraceMessage; /* trace end */
/* Land*Method -- see */
-typedef Res (*LandInitMethod)(Land land, ArgList args);
-typedef void (*LandFinishMethod)(Land land);
+typedef Res (*LandInitMethod)(Land land, Arena arena, Align alignment, ArgList args);
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 (*LandVisitor)(Land land, Range range, void *closure);
+typedef Bool (*LandDeleteVisitor)(Bool *deleteReturn, Land land, Range range, void *closure);
+typedef Bool (*LandIterateMethod)(Land land, LandVisitor visitor, void *closure);
+typedef Bool (*LandIterateAndDeleteMethod)(Land land, LandDeleteVisitor visitor, void *closure);
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, Count depth);
/* CONSTANTS */
-/* SIGnature IS BAD */
-#define SigInvalid ((Sig)0x51915BAD)
+/* */
+#define SigInvalid ((Sig)0x51915BAD) /* SIGnature IS BAD */
#define SizeMAX ((Size)-1)
#define AccessSetEMPTY ((AccessSet)0) /* */
@@ -294,14 +273,14 @@ typedef Res (*LandDescribeMethod)(Land land, mps_lib_FILE *stream, Count depth);
#define RefSetUNIV BS_UNIV(RefSet)
#define ZoneSetEMPTY BS_EMPTY(ZoneSet)
#define ZoneSetUNIV BS_UNIV(ZoneSet)
+#define ZoneShiftUNSET ((Shift)-1)
#define TraceSetEMPTY BS_EMPTY(TraceSet)
#define TraceSetUNIV ((TraceSet)((1u << TraceLIMIT) - 1))
#define RankSetEMPTY BS_EMPTY(RankSet)
#define RankSetUNIV ((RankSet)((1u << RankLIMIT) - 1))
-#define AttrFMT ((Attr)(1<<0)) /* */
-#define AttrGC ((Attr)(1<<1))
-#define AttrMOVINGGC ((Attr)(1<<2))
-#define AttrMASK (AttrFMT | AttrGC | AttrMOVINGGC)
+#define AttrGC ((Attr)(1<<0))
+#define AttrMOVINGGC ((Attr)(1<<1))
+#define AttrMASK (AttrGC | AttrMOVINGGC)
/* Locus preferences */
@@ -320,14 +299,6 @@ enum {
#define BufferModeTRANSITION ((BufferMode)(1<<3))
-/* Buffer frame states. See */
-enum {
- BufferFrameVALID = 1,
- BufferFramePOP_PENDING,
- BufferFrameDISABLED
-};
-
-
/* Rank constants -- see */
/* These definitions must match . */
/* This is checked by . */
@@ -443,14 +414,13 @@ typedef double WriteFD;
/* STATISTIC_DECL -- declare a field to accumulate statistics in
*
* The argument is a field declaration (a struct-declaration minus the
- * semicolon) for a single field (no commas). Currently, we always
- * leave them in, see design.mps.metrics.
+ * semicolon) for a single field (no commas).
*/
#if defined(STATISTICS)
-#define STATISTIC_DECL(field) field
+#define STATISTIC_DECL(field) field;
#elif defined(STATISTICS_NONE)
-#define STATISTIC_DECL(field) field
+#define STATISTIC_DECL(field)
#else
#error "No statistics configured."
#endif
@@ -461,7 +431,7 @@ typedef double WriteFD;
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2001-2014 Ravenbrook Limited .
+ * Copyright (C) 2001-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/mps.c b/mps/code/mps.c
index 48028242a92..f11381213a5 100644
--- a/mps/code/mps.c
+++ b/mps/code/mps.c
@@ -1,14 +1,14 @@
/* mps.c: MEMORY POOL SYSTEM ALL-IN-ONE TRANSLATION UNIT
*
* $Id$
- * Copyright (C) 2012-2016 Ravenbrook Limited. See end of file for license.
+ * Copyright (C) 2012-2018 Ravenbrook Limited. See end of file for license.
*
* .purpose: This file can be compiled to create the complete MPS library in
* a single compilation, allowing the compiler to apply global optimizations
* and inlining effectively. On most modern compilers this is also faster
* than compiling each file separately.
*
- * .purpose.universal: This file also allows simple building of a Mac OS X
+ * .purpose.universal: This file also allows simple building of a macOS
* "universal" (multiple architecture) binary when the set of source files
* differs by architecture. It may work for other platforms in a similar
* manner.
@@ -39,7 +39,6 @@
#include "locus.c"
#include "tract.c"
#include "walk.c"
-#include "reserv.c"
#include "protocol.c"
#include "pool.c"
#include "poolabs.c"
@@ -60,12 +59,12 @@
#include "message.c"
#include "poolmrg.c"
#include "poolmfs.c"
-#include "poolmv.c"
#include "dbgpool.c"
#include "dbgpooli.c"
#include "boot.c"
#include "meter.c"
#include "tree.c"
+#include "rangetree.c"
#include "splay.c"
#include "cbs.c"
#include "ss.c"
@@ -107,39 +106,39 @@
#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 "prmcan.c" /* generic operating system mutator context */
+#include "prmcanan.c" /* generic architecture 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 */
+/* macOS on IA-32 built with Clang or GCC */
#elif defined(MPS_PF_XCI3LL) || defined(MPS_PF_XCI3GC)
#include "lockix.c" /* Posix locks */
-#include "thxc.c" /* OS X Mach threading */
+#include "thxc.c" /* macOS Mach threading */
#include "vmix.c" /* Posix virtual memory */
#include "protix.c" /* Posix protection */
-#include "protxc.c" /* OS X Mach exception handling */
-#include "proti3.c" /* 32-bit Intel mutator context decoding */
-#include "prmci3xc.c" /* 32-bit Intel for Mac OS X mutator context */
+#include "protxc.c" /* macOS Mach exception handling */
+#include "prmci3.c" /* IA-32 mutator context */
+#include "prmcxc.c" /* macOS mutator context */
+#include "prmcxci3.c" /* IA-32 for macOS mutator context */
#include "span.c" /* generic stack probe */
-#include "ssixi3.c" /* Posix on 32-bit Intel stack scan */
-/* Mac OS X on 64-bit Intel build with Clang or GCC */
+/* macOS on x86-64 build with Clang or GCC */
#elif defined(MPS_PF_XCI6LL) || defined(MPS_PF_XCI6GC)
#include "lockix.c" /* Posix locks */
-#include "thxc.c" /* OS X Mach threading */
+#include "thxc.c" /* macOS Mach threading */
#include "vmix.c" /* Posix virtual memory */
#include "protix.c" /* Posix protection */
-#include "protxc.c" /* OS X Mach exception handling */
-#include "proti6.c" /* 64-bit Intel mutator context decoding */
-#include "prmci6xc.c" /* 64-bit Intel for Mac OS X mutator context */
+#include "protxc.c" /* macOS Mach exception handling */
+#include "prmci6.c" /* x86-64 mutator context */
+#include "prmcxc.c" /* macOS mutator context */
+#include "prmcxci6.c" /* x86-64 for macOS mutator context */
#include "span.c" /* generic stack probe */
-#include "ssixi6.c" /* Posix on 64-bit Intel stack scan */
-/* FreeBSD on 32-bit Intel built with GCC or Clang */
+/* FreeBSD on IA-32 built with GCC or Clang */
#elif defined(MPS_PF_FRI3GC) || defined(MPS_PF_FRI3LL)
@@ -149,12 +148,12 @@
#include "vmix.c" /* Posix virtual memory */
#include "protix.c" /* Posix protection */
#include "protsgix.c" /* Posix signal handling */
-#include "prmcan.c" /* generic mutator context */
-#include "prmci3fr.c" /* 32-bit Intel for FreeBSD mutator context */
+#include "prmcanan.c" /* generic architecture mutator context */
+#include "prmcix.c" /* Posix mutator context */
+#include "prmcfri3.c" /* IA-32 for FreeBSD mutator context */
#include "span.c" /* generic stack probe */
-#include "ssixi3.c" /* Posix on 32-bit Intel stack scan */
-/* FreeBSD on 64-bit Intel built with GCC or Clang */
+/* FreeBSD on x86-64 built with GCC or Clang */
#elif defined(MPS_PF_FRI6GC) || defined(MPS_PF_FRI6LL)
@@ -164,99 +163,67 @@
#include "vmix.c" /* Posix virtual memory */
#include "protix.c" /* Posix protection */
#include "protsgix.c" /* Posix signal handling */
-#include "prmcan.c" /* generic mutator context */
-#include "prmci6fr.c" /* 64-bit Intel for FreeBSD mutator context */
+#include "prmcanan.c" /* generic architecture mutator context */
+#include "prmcix.c" /* Posix mutator context */
+#include "prmcfri6.c" /* x86-64 for FreeBSD mutator context */
#include "span.c" /* generic stack probe */
-#include "ssixi6.c" /* Posix on 64-bit Intel stack scan */
-/* Linux on 32-bit Intel with GCC */
+/* Linux on IA-32 with GCC */
#elif defined(MPS_PF_LII3GC)
-#include "lockli.c" /* Linux locks */
+#include "lockix.c" /* Posix locks */
#include "thix.c" /* Posix threading */
#include "pthrdext.c" /* Posix thread extensions */
#include "vmix.c" /* Posix virtual memory */
#include "protix.c" /* Posix protection */
-#include "protli.c" /* Linux protection */
-#include "proti3.c" /* 32-bit Intel mutator context */
-#include "prmci3li.c" /* 32-bit Intel for Linux mutator context */
+#include "protsgix.c" /* Posix signal handling */
+#include "prmci3.c" /* IA-32 mutator context */
+#include "prmcix.c" /* Posix mutator context */
+#include "prmclii3.c" /* IA-32 for Linux mutator context */
#include "span.c" /* generic stack probe */
-#include "ssixi3.c" /* Posix on 32-bit Intel stack scan */
-/* Linux on 64-bit Intel with GCC or Clang */
+/* Linux on x86-64 with GCC or Clang */
#elif defined(MPS_PF_LII6GC) || defined(MPS_PF_LII6LL)
-#include "lockli.c" /* Linux locks */
+#include "lockix.c" /* Posix locks */
#include "thix.c" /* Posix threading */
#include "pthrdext.c" /* Posix thread extensions */
#include "vmix.c" /* Posix virtual memory */
#include "protix.c" /* Posix protection */
-#include "protli.c" /* Linux protection */
-#include "proti6.c" /* 64-bit Intel mutator context */
-#include "prmci6li.c" /* 64-bit Intel for Linux mutator context */
+#include "protsgix.c" /* Posix signal handling */
+#include "prmci6.c" /* x86-64 mutator context */
+#include "prmcix.c" /* Posix mutator context */
+#include "prmclii6.c" /* x86-64 for Linux mutator context */
#include "span.c" /* generic stack probe */
-#include "ssixi6.c" /* Posix on 64-bit Intel stack scan */
-/* Windows on 32-bit Intel with Microsoft Visual Studio */
+/* Windows on IA-32 with Microsoft Visual Studio or Pelles C */
-#elif defined(MPS_PF_W3I3MV)
+#elif defined(MPS_PF_W3I3MV) || defined(MPS_PF_W3I3PC)
#include "lockw3.c" /* Windows locks */
#include "thw3.c" /* Windows threading */
-#include "thw3i3.c" /* Windows on 32-bit Intel thread stack scan */
#include "vmw3.c" /* Windows virtual memory */
#include "protw3.c" /* Windows protection */
-#include "proti3.c" /* 32-bit Intel mutator context decoding */
-#include "prmci3w3.c" /* Windows on 32-bit Intel mutator context */
-#include "ssw3i3mv.c" /* Windows on 32-bit Intel stack scan for Microsoft C */
-#include "spw3i3.c" /* Windows on 32-bit Intel stack probe */
+#include "prmci3.c" /* IA-32 mutator context */
+#include "prmcw3.c" /* Windows mutator context */
+#include "prmcw3i3.c" /* Windows on IA-32 mutator context */
+#include "spw3i3.c" /* Windows on IA-32 stack probe */
#include "mpsiw3.c" /* Windows interface layer extras */
-/* Windows on 64-bit Intel with Microsoft Visual Studio */
+/* Windows on x86-64 with Microsoft Visual Studio or Pelles C */
-#elif defined(MPS_PF_W3I6MV)
+#elif defined(MPS_PF_W3I6MV) || defined(MPS_PF_W3I6PC)
#include "lockw3.c" /* Windows locks */
#include "thw3.c" /* Windows threading */
-#include "thw3i6.c" /* Windows on 64-bit Intel thread stack scan */
#include "vmw3.c" /* Windows virtual memory */
#include "protw3.c" /* Windows protection */
-#include "proti6.c" /* 64-bit Intel mutator context decoding */
-#include "prmci6w3.c" /* Windows on 64-bit Intel mutator context */
-#include "ssw3i6mv.c" /* Windows on 64-bit Intel stack scan for Microsoft C */
-#include "spw3i6.c" /* Windows on 64-bit Intel stack probe */
-#include "mpsiw3.c" /* Windows interface layer extras */
-
-/* Windows on 32-bit Intel with Pelles C */
-
-#elif defined(MPS_PF_W3I3PC)
-
-#include "lockw3.c" /* Windows locks */
-#include "thw3.c" /* Windows threading */
-#include "thw3i3.c" /* Windows on 32-bit Intel thread stack scan */
-#include "vmw3.c" /* Windows virtual memory */
-#include "protw3.c" /* Windows protection */
-#include "proti3.c" /* 32-bit Intel mutator context decoding */
-#include "prmci3w3.c" /* Windows on 32-bit Intel mutator context */
-#include "ssw3i3pc.c" /* Windows on 32-bit stack scan for Pelles C */
-#include "spw3i3.c" /* 32-bit Intel stack probe */
-#include "mpsiw3.c" /* Windows interface layer extras */
-
-/* Windows on 64-bit Intel with Pelles C */
-
-#elif defined(MPS_PF_W3I6PC)
-
-#include "lockw3.c" /* Windows locks */
-#include "thw3.c" /* Windows threading */
-#include "thw3i6.c" /* Windows on 64-bit Intel thread stack scan */
-#include "vmw3.c" /* Windows virtual memory */
-#include "protw3.c" /* Windows protection */
-#include "proti6.c" /* 64-bit Intel mutator context decoding */
-#include "prmci6w3.c" /* Windows on 64-bit Intel mutator context */
-#include "ssw3i6pc.c" /* Windows on 64-bit stack scan for Pelles C */
-#include "spw3i6.c" /* 64-bit Intel stack probe */
+#include "prmci6.c" /* x86-64 mutator context */
+#include "prmcw3.c" /* Windows mutator context */
+#include "prmcw3i6.c" /* Windows on x86-64 mutator context */
+#include "spw3i6.c" /* Windows on x86-64 stack probe */
#include "mpsiw3.c" /* Windows interface layer extras */
#else
@@ -269,7 +236,7 @@
/* C. COPYRIGHT AND LICENSE
*
- * Copyright (C) 2012-2016 Ravenbrook Limited .
+ * Copyright (C) 2012-2018 Ravenbrook Limited .
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
diff --git a/mps/code/mps.h b/mps/code/mps.h
index 0719a80e339..70a9561a513 100644
--- a/mps/code/mps.h
+++ b/mps/code/mps.h
@@ -189,6 +189,9 @@ extern const struct mps_key_s _mps_key_COMMIT_LIMIT;
extern const struct mps_key_s _mps_key_SPARE_COMMIT_LIMIT;
#define MPS_KEY_SPARE_COMMIT_LIMIT (&_mps_key_SPARE_COMMIT_LIMIT)
#define MPS_KEY_SPARE_COMMIT_LIMIT_FIELD size
+extern const struct mps_key_s _mps_key_PAUSE_TIME;
+#define MPS_KEY_PAUSE_TIME (&_mps_key_PAUSE_TIME)
+#define MPS_KEY_PAUSE_TIME_FIELD d
extern const struct mps_key_s _mps_key_EXTEND_BY;
#define MPS_KEY_EXTEND_BY (&_mps_key_EXTEND_BY)
@@ -318,9 +321,6 @@ typedef struct mps_ap_s { /* allocation point descriptor */
mps_addr_t init; /* limit of initialized memory */
mps_addr_t alloc; /* limit of allocated memory */
mps_addr_t limit; /* limit of available memory */
- mps_addr_t _frameptr; /* lightweight frame pointer */
- mps_bool_t _enabled; /* lightweight frame status */
- mps_bool_t _lwpoppending; /* lightweight pop pending? */
} mps_ap_s;
@@ -435,6 +435,7 @@ typedef struct mps_fmt_fixed_s {
extern void mps_arena_clamp(mps_arena_t);
extern void mps_arena_release(mps_arena_t);
extern void mps_arena_park(mps_arena_t);
+extern void mps_arena_postmortem(mps_arena_t);
extern void mps_arena_expose(mps_arena_t);
extern void mps_arena_unsafe_expose_remember_protection(mps_arena_t);
extern void mps_arena_unsafe_restore_protection(mps_arena_t);
@@ -459,6 +460,10 @@ extern void mps_arena_spare_set(mps_arena_t, double);
extern void mps_arena_spare_commit_limit_set(mps_arena_t, size_t);
extern size_t mps_arena_spare_commit_limit(mps_arena_t);
+extern double mps_arena_pause_time(mps_arena_t);
+extern void mps_arena_pause_time_set(mps_arena_t, double);
+
+extern mps_bool_t mps_arena_busy(mps_arena_t);
extern mps_bool_t mps_arena_has_addr(mps_arena_t, mps_addr_t);
extern mps_bool_t mps_addr_pool(mps_pool_t *, mps_arena_t, mps_addr_t);
extern mps_bool_t mps_addr_fmt(mps_fmt_t *, mps_arena_t, mps_addr_t);
@@ -529,6 +534,8 @@ extern mps_res_t (mps_reserve)(mps_addr_t *, mps_ap_t, size_t);
extern mps_bool_t (mps_commit)(mps_ap_t, mps_addr_t, size_t);
extern mps_res_t mps_ap_fill(mps_addr_t *, mps_ap_t, size_t);
+
+/* mps_ap_fill_with_reservoir_permit is deprecated */
extern mps_res_t mps_ap_fill_with_reservoir_permit(mps_addr_t *,
mps_ap_t,
size_t);
@@ -611,7 +618,7 @@ extern void mps_sac_empty(mps_sac_t, mps_addr_t, size_t);
#define MPS_SAC_FREE(sac, p, size) MPS_SAC_FREE_FAST(sac, p, size)
-/* Low memory reservoir */
+/* Low memory reservoir (deprecated) */
extern void mps_reservoir_limit_set(mps_arena_t, size_t);
extern size_t mps_reservoir_limit(mps_arena_t);
@@ -647,17 +654,7 @@ extern mps_res_t mps_reserve_with_reservoir_permit(mps_addr_t *,
MPS_END
-#define MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(_res_v, _p_v, _mps_ap, _size) \
- MPS_BEGIN \
- char *_alloc = (char *)(_mps_ap)->alloc; \
- char *_next = _alloc + (_size); \
- if(_next > _alloc && _next <= (char *)(_mps_ap)->limit) { \
- (_mps_ap)->alloc = (mps_addr_t)_next; \
- (_p_v) = (_mps_ap)->init; \
- (_res_v) = MPS_RES_OK; \
- } else \
- (_res_v) = mps_ap_fill_with_reservoir_permit(&(_p_v), _mps_ap, _size); \
- MPS_END
+#define MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK MPS_RESERVE_BLOCK
/* Commit Macros */
diff --git a/mps/code/mps.xcodeproj/project.pbxproj b/mps/code/mps.xcodeproj/project.pbxproj
index e36b800455b..0980991ffa2 100644
--- a/mps/code/mps.xcodeproj/project.pbxproj
+++ b/mps/code/mps.xcodeproj/project.pbxproj
@@ -93,6 +93,7 @@
2291A5E8175CB20E001D4920 /* PBXTargetDependency */,
3114A5CC156E932C001E0AA3 /* PBXTargetDependency */,
3114A5EA156E93C4001E0AA3 /* PBXTargetDependency */,
+ 22EA3F4820D2B23F0065F5B6 /* PBXTargetDependency */,
224CC79D175E187C002FF81B /* PBXTargetDependency */,
22B2BC3F18B643B700C33E63 /* PBXTargetDependency */,
3114A65B156E95B4001E0AA3 /* PBXTargetDependency */,
@@ -112,6 +113,7 @@
22B2BC3918B643AD00C33E63 /* PBXTargetDependency */,
22B2BC3B18B643B000C33E63 /* PBXTargetDependency */,
3104B04A156D3AE4000A585A /* PBXTargetDependency */,
+ 229E228819EAB10D00E21417 /* PBXTargetDependency */,
31D6009D156D404B00337B26 /* PBXTargetDependency */,
314CB6EB1C6D272A0073CA42 /* PBXTargetDependency */,
3114A62E156E94AA001E0AA3 /* PBXTargetDependency */,
@@ -135,6 +137,9 @@
2231BB6118CA97DC002D6322 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
2231BB6A18CA984F002D6322 /* locusss.c in Sources */ = {isa = PBXBuildFile; fileRef = 2231BB6918CA983C002D6322 /* locusss.c */; };
2231BB6B18CA9861002D6322 /* locbwcss.c in Sources */ = {isa = PBXBuildFile; fileRef = 2231BB6818CA9834002D6322 /* locbwcss.c */; };
+ 223E795D19EAB00B00DC26A6 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
+ 223E795F19EAB00B00DC26A6 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
+ 223E796719EAB05C00DC26A6 /* sncss.c in Sources */ = {isa = PBXBuildFile; fileRef = 223E796619EAB04100DC26A6 /* sncss.c */; };
224CC791175E1821002FF81B /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
224CC793175E1821002FF81B /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
224CC79F175E321C002FF81B /* mv2test.c in Sources */ = {isa = PBXBuildFile; fileRef = 3114A686156E9674001E0AA3 /* mv2test.c */; };
@@ -168,6 +173,9 @@
22C2ACA718BE400A006B3677 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
22C2ACA918BE400A006B3677 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
22C2ACB018BE4049006B3677 /* nailboardtest.c in Sources */ = {isa = PBXBuildFile; fileRef = 22C2ACA018BE3FEC006B3677 /* nailboardtest.c */; };
+ 22EA3F3D20D2B0D90065F5B6 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
+ 22EA3F3F20D2B0D90065F5B6 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
+ 22EA3F4620D2B0FD0065F5B6 /* forktest.c in Sources */ = {isa = PBXBuildFile; fileRef = 22EA3F3720D2B0730065F5B6 /* forktest.c */; };
22F846B518F437B900982BA7 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
22F846B718F437B900982BA7 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
22F846BE18F437D700982BA7 /* lockut.c in Sources */ = {isa = PBXBuildFile; fileRef = 22F846AF18F4379C00982BA7 /* lockut.c */; };
@@ -268,6 +276,8 @@
3114A6D1156E9829001E0AA3 /* eventcnv.c in Sources */ = {isa = PBXBuildFile; fileRef = 3114A6D0156E9829001E0AA3 /* eventcnv.c */; };
3114A6D7156E9923001E0AA3 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
3114A6DD156E9A0F001E0AA3 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
+ 311A44F81C8B1EBD00852E2B /* testthrix.c in Sources */ = {isa = PBXBuildFile; fileRef = 22561A9718F4263300372C66 /* testthrix.c */; };
+ 311A44F91C8B1EC200852E2B /* testthrix.c in Sources */ = {isa = PBXBuildFile; fileRef = 22561A9718F4263300372C66 /* testthrix.c */; };
3124CAC3156BE40100753214 /* awlut.c in Sources */ = {isa = PBXBuildFile; fileRef = 3124CAC2156BE40100753214 /* awlut.c */; };
3124CAC4156BE40D00753214 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; };
3124CAC5156BE41700753214 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; };
@@ -394,6 +404,13 @@
remoteGlobalIDString = 2231BB5A18CA97DC002D6322;
remoteInfo = locusss;
};
+ 223E795A19EAB00B00DC26A6 /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 31EEABFA156AAF9D00714D05;
+ remoteInfo = mps;
+ };
224CC78E175E1821002FF81B /* PBXContainerItemProxy */ = {
isa = PBXContainerItemProxy;
containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
@@ -464,6 +481,13 @@
remoteGlobalIDString = 2291A5C1175CAFCA001D4920;
remoteInfo = expt825;
};
+ 229E228719EAB10D00E21417 /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 223E795819EAB00B00DC26A6;
+ remoteInfo = sncss;
+ };
22B2BC3818B643AD00C33E63 /* PBXContainerItemProxy */ = {
isa = PBXContainerItemProxy;
containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
@@ -513,6 +537,20 @@
remoteGlobalIDString = 3104AFF1156D37A0000A585A;
remoteInfo = all;
};
+ 22EA3F3A20D2B0D90065F5B6 /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 31EEABFA156AAF9D00714D05;
+ remoteInfo = mps;
+ };
+ 22EA3F4720D2B23F0065F5B6 /* PBXContainerItemProxy */ = {
+ isa = PBXContainerItemProxy;
+ containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
+ proxyType = 1;
+ remoteGlobalIDString = 22EA3F3820D2B0D90065F5B6;
+ remoteInfo = forktest;
+ };
22F846B218F437B900982BA7 /* PBXContainerItemProxy */ = {
isa = PBXContainerItemProxy;
containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */;
@@ -1017,6 +1055,15 @@
);
runOnlyForDeploymentPostprocessing = 1;
};
+ 223E796019EAB00B00DC26A6 /* CopyFiles */ = {
+ isa = PBXCopyFilesBuildPhase;
+ buildActionMask = 2147483647;
+ dstPath = /usr/share/man/man1/;
+ dstSubfolderSpec = 0;
+ files = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ };
224CC794175E1821002FF81B /* CopyFiles */ = {
isa = PBXCopyFilesBuildPhase;
buildActionMask = 2147483647;
@@ -1071,6 +1118,15 @@
);
runOnlyForDeploymentPostprocessing = 1;
};
+ 22EA3F4020D2B0D90065F5B6 /* CopyFiles */ = {
+ isa = PBXCopyFilesBuildPhase;
+ buildActionMask = 2147483647;
+ dstPath = /usr/share/man/man1/;
+ dstSubfolderSpec = 0;
+ files = (
+ );
+ runOnlyForDeploymentPostprocessing = 1;
+ };
22F846B818F437B900982BA7 /* CopyFiles */ = {
isa = PBXCopyFilesBuildPhase;
buildActionMask = 2147483647;
@@ -1425,12 +1481,18 @@
/* End PBXCopyFilesBuildPhase section */
/* Begin PBXFileReference section */
+ 2213454C1DB0386600E14202 /* prmc.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = prmc.h; sourceTree = ""; };
+ 2213454D1DB038D400E14202 /* prmcxc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = prmcxc.c; sourceTree = ""; };
2231BB5918CA97D8002D6322 /* locbwcss */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = locbwcss; sourceTree = BUILT_PRODUCTS_DIR; };
2231BB6718CA97DC002D6322 /* locusss */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = locusss; sourceTree = BUILT_PRODUCTS_DIR; };
2231BB6818CA9834002D6322 /* locbwcss.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = locbwcss.c; sourceTree = ""; };
2231BB6918CA983C002D6322 /* locusss.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = locusss.c; sourceTree = ""; };
223475CB194CA09500C69128 /* vm.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = vm.c; sourceTree = ""; };
223475CC194CA09500C69128 /* vm.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = vm.h; sourceTree = "