Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-15 21:11:25 +00:00
Code Issues Projects Releases Packages Wiki Activity

Catch-up merge from master sources at changelevel 194869 to branch/2016-03-04/spare-fraction.

Browse source 
Copied from Perforce
 Change: 194872
This commit is contained in:
Gareth Rees 2018-08-02 15:14:23 +01:00
commit bcb24de010
558 changed files with 20603 additions and 22098 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
mps/.p4ignore
View file

@ -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
....gcno
\#*#
*~
.#.*
core

1
mps/.renamed-gitignore Symbolic link
View file

@ -0,0 +1 @@
.p4ignore

4
mps/.travis.yml
View file

@ -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

45
mps/Makefile.in
View file

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

5
mps/code/.p4ignore
View file

@ -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

1
mps/code/.renamed-gitignore Symbolic link
View file

@ -0,0 +1 @@
.p4ignore

14
mps/code/abq.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

12
mps/code/abq.h
View file

@ -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;

14
mps/code/abqtest.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

6
mps/code/airtest.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (c) 2014-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

59
mps/code/amcssth.c
View file

@ -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 <stdio.h> /* 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 = &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(&reg_root, arena, thread, marker),
/* Register the thread twice to check this is supported -- see
* <design/thread-manager/#req.register.multi>
*/
die(mps_thread_reg(&thread1, arena), "thread_reg");
die(mps_thread_reg(&thread2, arena), "thread_reg");
die(mps_root_create_thread(&reg_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 <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

6
mps/code/amsss.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

2
mps/code/anangc.gmk
View file

@ -10,9 +10,9 @@ PFM = anangc
MPMPF = \
lockan.c \
prmcan.c \
prmcanan.c \
protan.c \
span.c \
ssan.c \
than.c \
vman.c

2
mps/code/ananll.gmk
View file

@ -10,9 +10,9 @@ PFM = ananll
MPMPF = \
lockan.c \
prmcan.c \
prmcanan.c \
protan.c \
span.c \
ssan.c \
than.c \
vman.c

6
mps/code/ananmv.nmk
View file

@ -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 <http://www.ravenbrook.com/>.
# Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

61
mps/code/apss.c
View file

@ -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<testSetSIZE; ++i) {
mps_addr_t obj;
ss[i] = (*size)(i, align);
res = make((mps_addr_t *)&ps[i], ap, ss[i]);
res = make(&obj, ap, ss[i]);
if (res != MPS_RES_OK)
goto allocFail;
ps[i] = obj;
allocated += ss[i] + debugOverhead;
if (ss[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<testSetSIZE; ++i) {
mps_addr_t obj;
ss[i] = (*size)(i, align);
res = make((mps_addr_t *)&ps[i], ap, ss[i]);
res = make(&obj, ap, ss[i]);
if (res != MPS_RES_OK)
goto allocFail;
ps[i] = obj;
allocated += ss[i] + debugOverhead;
}
check_allocated_size(pool, ap, allocated);
@ -169,13 +172,16 @@ static mps_pool_debug_option_s fenceOptions = {
*/
static void test(mps_arena_class_t arena_class, mps_arg_s arena_args[],
size_t arena_grain_size,
mps_pool_debug_option_s *options)
{
mps_arena_t arena;
die(mps_arena_create_k(&arena, arena_class, arena_args), "mps_arena_create");
(void)arena_grain_size; /* TODO: test larger alignments up to this */
MPS_ARGS_BEGIN(args) {
mps_align_t align = sizeof(void *) << (rnd() % 4);
mps_align_t align = rnd_align(sizeof(void *), MAX_ALIGN);
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);
@ -185,59 +191,52 @@ static void test(mps_arena_class_t arena_class, mps_arg_s arena_args[],
mps_class_mvff(), args), "stress MVFF");
} MPS_ARGS_END(args);
/* IWBN to test MVFFDebug, but the MPS doesn't support debugging APs, */
/* yet (MV Debug works here, because it fakes it through PoolAlloc). */
/* IWBN to test MVFFDebug, but the MPS doesn't support debugging
allocation points. See job003995. */
(void)options;
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, align, randomSizeAligned, "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, align, randomSizeAligned, "MV debug",
mps_class_mv_debug(), args), "stress MV debug");
} MPS_ARGS_END(args);
MPS_ARGS_BEGIN(args) {
mps_align_t align = sizeof(void *) << (rnd() % 4);
mps_align_t align = rnd_align(sizeof(void *), MAX_ALIGN);
MPS_ARGS_ADD(args, MPS_KEY_ALIGN, align);
die(stress(arena, NULL, align, randomSizeAligned, "MVT",
mps_class_mvt(), args), "stress MVT");
} 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, 2 * testArenaSIZE);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, rnd_grain(2*testArenaSIZE));
MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, arena_grain_size);
MPS_ARGS_ADD(args, MPS_KEY_COMMIT_LIMIT, testArenaSIZE);
test(mps_arena_class_vm(), args, &fenceOptions);
test(mps_arena_class_vm(), args, arena_grain_size, &fenceOptions);
} MPS_ARGS_END(args);
arena_grain_size = rnd_grain(2 * testArenaSIZE);
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, 2 * testArenaSIZE);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_ZONED, FALSE);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, rnd_grain(2*testArenaSIZE));
test(mps_arena_class_vm(), args, &bothOptions);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, arena_grain_size);
test(mps_arena_class_vm(), args, arena_grain_size, &bothOptions);
} MPS_ARGS_END(args);
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_ZONED, FALSE);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_CL_BASE, malloc(testArenaSIZE));
MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, rnd_grain(testArenaSIZE));
test(mps_arena_class_cl(), args, &bothOptions);
MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, arena_grain_size);
test(mps_arena_class_cl(), args, arena_grain_size, &bothOptions);
} MPS_ARGS_END(args);
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
@ -247,7 +246,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
* Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

513
mps/code/arena.c
View file

File diff suppressed because it is too large Load diff

109
mps/code/arenacl.c
View file

@ -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 <code/arena.c#.reserved.check> */
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);
/* <code/arena.c#init.caller> */
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
* <design/arena/#chunk.delete> */
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); /* <code/arena.c#finish.caller> */
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);
}

16
mps/code/arenacv.c
View file

@ -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);

332
mps/code/arenavm.c
View file

@ -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; /* <design/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 <design/arena/>.@@@@ */
/* .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 <code/tract.c#overhead.pages>, */
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);
/* <code/arena.c#init.caller> */
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)
* <design/arena/#chunk.delete> */
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); /* <code/global.c#finish.caller> */
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 <design/arena/#chunk.delete>
* 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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

62
mps/code/arg.c
View file

@ -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 <design/keyword-arguments.rst>.
*/
@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

98
mps/code/awlut.c
View file

@ -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);

96
mps/code/awluthe.c
View file

@ -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);

3
mps/code/bt.c
View file

@ -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;

9
mps/code/bttest.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

634
mps/code/buffer.c
View file

File diff suppressed because it is too large Load diff

710
mps/code/cbs.c
View file

File diff suppressed because it is too large Load diff

31
mps/code/cbs.h
View file

@ -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)

94
mps/code/check.h
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2017 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

63
mps/code/comm.gmk
View file

@ -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

20
mps/code/commpost.nmk
View file

@ -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 <http://www.ravenbrook.com/>.
# Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

7
mps/code/commpre.nmk
View file

@ -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] \

151
mps/code/config.h
View file

@ -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: <http://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html>
* MSVC: <https://docs.microsoft.com/en-us/cpp/cpp/noinline>
*/
#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: <http://gcc.gnu.org/onlinedocs/gcc/Function-Attributes.html>
* GCC: <http://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html>
* Clang: <http://clang.llvm.org/docs/AttributeReference.html#id1>
*/
#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: <http://gcc.gnu.org/onlinedocs/gcc/Function-Attributes.html>
* GCC: <http://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html>
*
* 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
* <https://gcc.gnu.org/onlinedocs/gcc/Other-Builtins.html>.
*/
#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 <code/buffer.c> */
@ -357,14 +376,6 @@
#define LO_GEN_DEFAULT 0
/* Pool MV Configuration -- see <code/poolmv.c> */
#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 <code/poolmfs.c> */
#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 <design/type/#work>), 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 <code/sp*.c> */
/* Locus configuration -- see <code/locus.c> */
/* 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 <code/sp*.c> */
/* Currently StackProbe has a useful implementation only on Windows. */
#if defined(MPS_OS_W3)
#if defined(MPS_OS_W3) && !defined(CONFIG_PF_ANSI)
/* See <design/sp/#sol.depth.analysis> for a justification of this value. */
#define StackProbeDEPTH ((Size)500)
#else
@ -472,8 +496,8 @@
/* Shield Configuration -- see <code/shield.c> */
#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 <code/vm*.c> */
@ -491,10 +515,10 @@
* Source Symbols Header Feature
* =========== ========================= ============= ====================
* eventtxt.c setenv <stdlib.h> _GNU_SOURCE
* lockli.c pthread_mutexattr_settype <pthread.h> _XOPEN_SOURCE >= 500
* prmci3li.c REG_EAX etc. <ucontext.h> _GNU_SOURCE
* prmci6li.c REG_RAX etc. <ucontext.h> _GNU_SOURCE
* lockix.c pthread_mutexattr_settype <pthread.h> _XOPEN_SOURCE >= 500
* prmcix.h stack_t, siginfo_t <signal.h> _XOPEN_SOURCE
* prmclii3.c REG_EAX etc. <ucontext.h> _GNU_SOURCE
* prmclii6.c REG_RAX etc. <ucontext.h> _GNU_SOURCE
* pthrdext.c sigaction etc. <signal.h> _XOPEN_SOURCE
* vmix.c MAP_ANON <sys/mman.h> _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. <ucontext.h> _XOPEN_SOURCE
* prmci6li.c __rax etc. <ucontext.h> _XOPEN_SOURCE
* prmclii3.c __eax etc. <ucontext.h> _XOPEN_SOURCE
* prmclii6.c __rax etc. <ucontext.h> _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 <code/prot*.c>
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 <code/pthrdext.c> */
#if defined(MPS_OS_LI) || defined(MPS_OS_FR)
/* PTHREADEXT_SIGSUSPEND -- signal used to suspend a thread
* See <design/pthreadext/#impl.signals>
*/
#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 <design/pthreadext/#impl.signals>
*/
#if defined(CONFIG_PTHREADEXT_SIGRESUME)
#define PTHREADEXT_SIGRESUME CONFIG_PTHREADEXT_SIGRESUME
#else
#define PTHREADEXT_SIGRESUME SIGXCPU
#endif
#endif
/* Tracer Configuration -- see <code/trace.c> */
@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

80
mps/code/dbgpool.c
View file

@ -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"); /* <design/check/#.common> */
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) { /* <design/object-debug/#out-of-space */
debug->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"); /* <design/check/#.common> */
}
}
@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

2
mps/code/dbgpool.h
View file

@ -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);

18
mps/code/djbench.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (c) 2013-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

55
mps/code/event.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

85
mps/code/eventdef.h
View file

@ -1,7 +1,7 @@
/* <code/eventdef.h> -- 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: <design/telemetry/>
*
@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

103
mps/code/eventpy.c Normal file
View file

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

693
mps/code/eventrep.c
View file

@ -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 <stddef.h> /* for size_t */
#include <stdarg.h> /* for va_list */
#include <stdlib.h> /* for EXIT_FAILURE */
#include <stdio.h> /* 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 <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* 3. Redistributions in any form must be accompanied by information on how
* to obtain complete source code for this software and any accompanying
* software that uses this software. The source code must either be
* included in the distribution or be available for no more than the cost
* of distribution plus a nominal fee, and must be freely redistributable
* under reasonable conditions. For an executable file, complete source
* code means the source code for all modules it contains. It does not
* include source code for modules or files that typically accompany the
* major components of the operating system on which the executable file
* runs.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
* IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
* PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
* COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
* USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
* ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
* THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/

192
mps/code/failover.c
View file

@ -4,6 +4,11 @@
* Copyright (c) 2014 Ravenbrook Limited. See end of file for license.
*
* .design: <design/failover/>
*
* .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
* <design/failover/#impl.assume.flush>.
@ -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 <design/failover/#impl.assume.flush>. */
(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 <design/failover/#impl.assume.flush>. */
(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 <design/failover/#impl.assume.flush>. */
(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 <design/failover/#impl.assume.flush>. */
(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);
}

4
mps/code/failover.h
View file

@ -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)

663
mps/code/fbmtest.c
View file

@ -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 <stdio.h> /* 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 <base> such that the
* range [<base>, <return>) has the same value in the bit table,
* and <return> 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 <base> such that the range
* [<return>, <base>] has the same value in the bit table,
* and <return>-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 <base> 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 <end>. Note that there is a 50% chance that <end> 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 <limit> 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 <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* 3. Redistributions in any form must be accompanied by information on how
* to obtain complete source code for this software and any accompanying
* software that uses this software. The source code must either be
* included in the distribution or be available for no more than the cost
* of distribution plus a nominal fee, and must be freely redistributable
* under reasonable conditions. For an executable file, complete source
* code means the source code for all modules it contains. It does not
* include source code for modules or files that typically accompany the
* major components of the operating system on which the executable file
* runs.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
* IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
* PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
* COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
* USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
* ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
* THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/

72
mps/code/finalcv.c
View file

@ -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());
/* <design/poolmrg/#test.promise.ut.churn> */
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;
/* <design/poolmrg/#test.promise.ut.message> */
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);
/* <design/poolmrg/#test.promise.ut.final.check> */
cdie(root[objind] == NULL, "finalized live");
cdie(state[objind] == finalizableSTATE, "finalized dead");
state[objind] = finalizedSTATE;
/* sometimes resurrect */
if (rnd() % 2 == 0)
root[objind] = objaddr;
/* <design/poolmrg/#test.promise.ut.message> */
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);
/* <design/poolmrg/#test.promise.ut.final.check> */
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 <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

55
mps/code/finaltest.c
View file

@ -43,6 +43,7 @@
#include "fmtdytst.h"
#include "mpstd.h"
#include <math.h> /* HUGE_VAL */
#include <stdio.h> /* 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) {

44
mps/code/fmtdy.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

6
mps/code/fmtdy.h
View file

@ -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 */

6
mps/code/fmtscheme.c
View file

@ -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 <string.h>
@ -460,7 +460,7 @@ void scheme_fmt(mps_fmt_t *fmt)
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

6
mps/code/fmtscheme.h
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

231
mps/code/forktest.c Normal file
View file

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

14
mps/code/format.c
View file

@ -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); /* <design/check/#.common> */
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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

105
mps/code/fotest.c
View file

@ -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<testSetSIZE; ++i) {
mps_addr_t obj;
ss[i] = (*size)(i, alignment);
res = make((mps_addr_t *)&ps[i], ap, ss[i]);
res = make(&obj, ap, ss[i]);
if (res != MPS_RES_OK)
goto allocFail;
ps[i] = obj;
if (ss[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<testSetSIZE; ++i) {
mps_addr_t obj;
ss[i] = (*size)(i, alignment);
res = make((mps_addr_t *)&ps[i], ap, ss[i]);
res = make(&obj, ap, ss[i]);
if (res != MPS_RES_OK)
goto allocFail;
ps[i] = obj;
}
set_oom(cbs, rnd() % 2);
CLASS_STATIC(MFSPool).alloc = rnd() % 2 ? mfs_alloc : oomAlloc;
}
set_oom(cbs, 0);
CLASS_STATIC(MFSPool).alloc = mfs_alloc;
allocFail:
mps_ap_destroy(ap);
@ -180,6 +170,7 @@ int main(int argc, char *argv[])
die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE),
"mps_arena_create");
mfs_alloc = CLASS_STATIC(MFSPool).alloc;
alignment = sizeof(void *) << (rnd() % 4);
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, (64 + rnd() % 64) * 1024);
@ -190,10 +181,7 @@ int main(int argc, char *argv[])
MPS_ARGS_ADD(args, MPS_KEY_MVFF_FIRST_FIT, rnd() % 2);
die(mps_pool_create_k(&pool, arena, mps_class_mvff(), args), "create MVFF");
} MPS_ARGS_END(args);
{
die(stress(randomSizeAligned, alignment, pool, _mps_mvff_cbs(pool)),
"stress MVFF");
}
die(stress(randomSizeAligned, alignment, pool), "stress MVFF");
mps_pool_destroy(pool);
mps_arena_destroy(arena);
@ -209,10 +197,7 @@ int main(int argc, char *argv[])
MPS_ARGS_ADD(args, MPS_KEY_MVT_FRAG_LIMIT, (rnd() % 101) / 100.0);
die(mps_pool_create_k(&pool, arena, mps_class_mvt(), args), "create MVFF");
} MPS_ARGS_END(args);
{
die(stress(randomSizeAligned, alignment, pool, _mps_mvt_cbs(pool)),
"stress MVT");
}
die(stress(randomSizeAligned, alignment, pool), "stress MVT");
mps_pool_destroy(pool);
mps_arena_destroy(arena);
@ -223,7 +208,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
* Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

163
mps/code/freelist.c
View file

@ -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 <design/freelist/#impl.grain> */
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);
}

4
mps/code/freelist.h
View file

@ -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 <design/freelist/#impl.grain.align> */
#define FreelistMinimumAlignment ((Align)sizeof(FreelistBlock))
extern LandClass FreelistLandClassGet(void);
DECLARE_CLASS(Land, Freelist, Land);
#endif /* freelist.h */

10
mps/code/fri3gc.gmk
View file

@ -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 <http://www.ravenbrook.com/>.
# Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

10
mps/code/fri3ll.gmk
View file

@ -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 <http://www.ravenbrook.com/>.
# Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

23
mps/code/fri6gc.gmk
View file

@ -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 <http://www.ravenbrook.com/>.
# Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

21
mps/code/fri6ll.gmk
View file

@ -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

36
mps/code/gc.gmk
View file

@ -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

66
mps/code/gcbench.c
View file

@ -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<argc; k++) {
printf("%s", argv[k]);
if (k + 1 < argc)
putchar(' ');
}
putchar('\n');
while ((ch = getopt_long(argc, argv, "ht:i:p:g:m:a:w:d:r:u:lx:z", longopts, NULL)) != -1)
while ((ch = getopt_long(argc, argv, "ht:i:p:g:m:a:w:d:r:u:lx:zP:",
longopts, NULL)) != -1)
switch (ch) {
case 't':
nthreads = (unsigned)strtoul(optarg, NULL, 10);
@ -392,10 +399,14 @@ int main(int argc, char *argv[]) {
break;
case 'x':
seed = strtoul(optarg, NULL, 10);
seed_specified = TRUE;
break;
case 'z':
zoned = FALSE;
break;
case 'P':
pause_time = strtod(optarg, NULL);
break;
default:
/* This is printed in parts to keep within the 509 character
limit for string literals in portable standard C. */
@ -441,16 +452,21 @@ int main(int argc, char *argv[]) {
fprintf(stderr,
" -z, --arena-unzoned\n"
" Disable zoned allocation in the arena\n"
" -P t, --pause-time\n"
" Maximum pause time in seconds (default %f) \n"
"Tests:\n"
" amc pool class AMC\n"
" ams pool class AMS\n");
" ams pool class AMS\n",
pause_time);
return EXIT_FAILURE;
}
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)
@ -472,7 +488,7 @@ int main(int argc, char *argv[]) {
/* C. COPYRIGHT AND LICENSE
*
* Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (c) 2014-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

474
mps/code/global.c
View file

@ -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/arena/>. 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
* <design/thread-safety/#sol.fork.lock>
*/
void GlobalsClaimAll(void)
{
LockClaimGlobalRecursive();
arenaClaimRingLock();
GlobalsArenaMap(ArenaEnter);
}
/* GlobalsReleaseAll -- release all MPS locks. GlobalsClaimAll must
* previously have been called. <design/thread-safety/#sol.fork.lock> */
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. <design/thread-safety/#sol.fork.lock> */
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. <design/arena/#static.check> */
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; /* <code/trace.c> */
arena->flippedTraces = TraceSetEMPTY; /* <code/trace.c> */
arena->tracedSize = 0.0;
arena->tracedWork = 0.0;
arena->tracedTime = 0.0;
arena->lastWorldCollect = ClockNow();
arena->insideShield = FALSE; /* <code/shield.c> */
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) {
/* <design/arena/#trace.invalid> */
@ -315,14 +350,11 @@ Res GlobalsInit(Globals arenaGlobals)
STATISTIC(arena->writeBarrierHitCount = 0);
RingInit(&arena->chainRing);
arena->epoch = (Epoch)0; /* <code/ld.c> */
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)); /* <design/check/#.common> */
AVER(RingIsSingle(&arena->chainRing)); /* <design/check/#.common> */
AVER(RingIsSingle(&arena->messageRing));
AVER(RingIsSingle(&arena->threadRing));
AVER(RingIsSingle(&arena->threadRing)); /* <design/check/#.common> */
AVER(RingIsSingle(&arena->deadRing));
AVER(RingIsSingle(&arenaGlobals->rootRing));
AVER(RingIsSingle(&arenaGlobals->rootRing)); /* <design/check/#.common> */
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); /* <design/check/#.common> */
}
@ -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(); /* <design/arena/#lock.ring> */
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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

397
mps/code/land.c
View file

@ -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: <design/land/>
*
* .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 <design/land/#function.init>
*/
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 <design/land/#function.create>
*/
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 <design/land/#function.destroy>
*/
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 <design/land/#function.size>
*/
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 <design/land/#function.insert>
*/
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 <design/land/#function.delete>
*/
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 <design/land/#function.iterate>
*/
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 <design/land/#function.iterate.and.delete>
*/
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 <design/land/#function.find.first>
*/
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 <design/land/#function.find.last>
*/
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 <design/land/#function.find.largest>
*/
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 <design/land/#function.find.zones>
*/
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 <design/land/#function.flush>
*/
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 <http://www.ravenbrook.com/>.
* Copyright (C) 2014-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

70
mps/code/landtest.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

114
mps/code/ld.c
View file

@ -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 */

14
mps/code/lii3gc.gmk
View file

@ -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 <http://www.ravenbrook.com/>.
# Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

14
mps/code/lii6gc.gmk
View file

@ -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 <http://www.ravenbrook.com/>.
# Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

14
mps/code/lii6ll.gmk
View file

@ -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 <http://www.ravenbrook.com/>.
# Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
# All rights reserved. This is an open source license. Contact
# Ravenbrook for commercial licensing options.
#

3
mps/code/ll.gmk
View file

@ -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

31
mps/code/lock.h
View file

@ -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 */

18
mps/code/lockan.c
View file

@ -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
*

8
mps/code/lockcov.c
View file

@ -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);

75
mps/code/lockix.c
View file

@ -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 <pthread.h>
#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 <pthread.h> /* see .feature.li in config.h */
#include <semaphore.h>
#include <errno.h>
#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); /* <design/check/#.common> */
/* 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 <design/thread-safety/#sol.fork.lock> */
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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

299
mps/code/lockli.c
View file

@ -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 <pthread.h> /* see .feature.li in config.h */
#include <semaphore.h>
#include <errno.h>
#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; /* <design/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 <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* 3. Redistributions in any form must be accompanied by information on how
* to obtain complete source code for this software and any accompanying
* software that uses this software. The source code must either be
* included in the distribution or be available for no more than the cost
* of distribution plus a nominal fee, and must be freely redistributable
* under reasonable conditions. For an executable file, complete source
* code means the source code for all modules it contains. It does not
* include source code for modules or files that typically accompany the
* major components of the operating system on which the executable file
* runs.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
* IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
* PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE
* COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
* USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
* ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
* THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/

7
mps/code/lockut.c
View file

@ -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;
}

70
mps/code/lockw3.c
View file

@ -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); /* <design/check/#.common> */
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
* <https://docs.microsoft.com/en-us/windows/desktop/api/synchapi/nf-synchapi-initonceexecuteonce>
* 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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

600
mps/code/locus.c
View file

@ -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); /* <design/check/#.common> */
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], &params[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 <design/strategy/#accounting.op.fill>
*/
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 <design/strategy/#accounting.op.empty>
*/
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 <design/strategy/#accounting.op.age>
*/
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 <design/strategy/#accounting.op.reclaim>
*/
@ -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 <design/strategy/#accounting.op.free>
*/
@ -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, &params);
}
@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

60
mps/code/locus.h
View file

@ -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);

5
mps/code/locusss.c
View file

@ -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) {

5
mps/code/locv.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

66
mps/code/message.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

13
mps/code/messtest.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

19
mps/code/misc.h
View file

@ -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

163
mps/code/mpm.c
View file

@ -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: <design/writef/> */
#include "check.h"
#include "misc.h"
#include "mpm.h"
#include "vm.h"
@ -88,6 +89,11 @@ Bool MPMCheck(void)
* <design/sp/#sol.depth.constraint>. */
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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

470
mps/code/mpm.h
View file

@ -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 <code/poolabs.c> */
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 <design/protocol/#int.define-special>. */
#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 <design/message/> */
/* -- 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 <code/mps.h> MPS_SCAN_BEGIN */
#define TRACE_SCAN_BEGIN(ss) \
@ -482,32 +454,19 @@ extern void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena,
/* Arena Interface -- see <code/arena.c> */
/* DEFINE_ARENA_CLASS
*
* Convenience macro -- see <design/protocol/#int.define-special>. */
#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 <code/buffer.c> */
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 <code/buffer.c> */
/* 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 <code/buffer.c> */
@ -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 <code/shield.c> */
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 <code/ld.c> */
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 <design/diag/#stat>.
*/
#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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

88
mps/code/mpmss.c
View file

@ -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<testSetSIZE; ++i) {
ss[i] = (*size)(i);
res = mps_alloc((mps_addr_t *)&ps[i], pool, ss[i]);
mps_addr_t obj;
ss[i] = (*size)(i, align);
res = mps_alloc(&obj, pool, ss[i]);
if (res != MPS_RES_OK)
return res;
ps[i] = obj;
allocated += alignUp(ss[i], align) + debugOverhead;
if (ss[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<testSetSIZE; ++i) {
mps_free(pool, (mps_addr_t)ps[i], ss[i]);
/* if (i == testSetSIZE/2) */
@ -93,10 +93,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<testSetSIZE; ++i) {
ss[i] = (*size)(i);
res = mps_alloc((mps_addr_t *)&ps[i], pool, ss[i]);
mps_addr_t obj;
ss[i] = (*size)(i, align);
res = mps_alloc(&obj, pool, ss[i]);
if (res != MPS_RES_OK)
return res;
ps[i] = obj;
allocated += alignUp(ss[i], align) + debugOverhead;
}
check_allocated_size(pool, allocated);
@ -109,25 +111,13 @@ static mps_res_t stress(mps_arena_t arena, mps_pool_debug_option_s *options,
}
/* randomSize -- produce sizes both large and small */
/* randomSizeAligned -- produce sizes both large and small */
static size_t randomSize(size_t i)
{
/* Make the range large enough to span three pages in the segment table: */
/* 160 segments/page, page size max 0x2000. */
size_t maxSize = 2 * 160 * 0x2000;
/* Reduce by a factor of 2 every 10 cycles. Total allocation about 40 MB. */
return rnd() % max((maxSize >> (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 <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

355
mps/code/mpmst.h
View file

@ -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 <design/pool/>.
*
* .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 <design/class-interface/>) via generic
* functions (see <code/pool.c>). 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 <design/pool/>) via generic functions (see
* <code/pool.c>). Pool classes use the class protocol (see
* <design/protocol/>) 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 <code/pool.c>,
* <design/pool/>. */
* <design/pool/>.
*/
#define PoolSig ((Sig)0x519B0019) /* SIGnature POOL */
typedef struct mps_pool_s { /* generic structure */
InstStruct instStruct;
Sig sig; /* <design/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; /* <design/sig/> */
} MFSStruct;
/* MVStruct -- MV (Manual Variable) pool outer structure
*
* .mv: See <code/poolmv.c>, <design/poolmv/>.
*
* 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; /* <design/poolmv/#lost> */
RingStruct spans; /* span chain */
Sig sig; /* <design/sig/> */
} MVStruct;
/* ReservoirStruct -- Reservoir structure
*
* .reservoir: See <code/reserv.c>, <design/reservoir/>.
*
* 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; /* <design/sig/> */
} ReservoirStruct;
/* MessageClassStruct -- Message Class structure
*
* See <design/message/#class.struct> (and <design/message/#message>,
@ -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; /* <design/message/#class.sig.double> */
@ -225,7 +166,7 @@ typedef struct MessageClassStruct {
typedef struct mps_message_s {
Sig sig; /* <design/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; /* <code/misc.h#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 <code/shield.c#def.depth> */
unsigned depth : ShieldDepthWIDTH; /* see design.mps.shield.def.depth */
BOOLFIELD(queued); /* in shield queue? */
AccessSet pm : AccessLIMIT; /* protection mode, <code/shield.c> */
AccessSet sm : AccessLIMIT; /* shield mode, <code/shield.c> */
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; /* <design/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; /* <design/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 <code/mps.h#ss> and <design/interface-c>.
@ -445,23 +402,21 @@ typedef struct ScanStateStruct {
Sig sig; /* <design/sig/> */
struct mps_ss_s ss_s; /* .ss <http://bash.org/?400459> */
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 (<code/pool.c>) */
RingStruct poolRing; /* ring of pools in arena */
Serial poolSerial; /* serial of next created pool */
Count systemPools; /* count of pools remaining at ArenaDestroy */
/* root fields (<code/root.c>) */
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; /* <design/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; /* <design/arena/#ld.epoch> */
RefSet prehistory; /* <design/arena/#ld.prehistory> */
RefSet history[LDHistoryLENGTH]; /* <design/arena/#ld.history> */
} HistoryStruct;
/* MVFFStruct -- MVFF (Manual Variable First Fit) pool outer structure
*
* The signature is placed at the end, see
* <design/pool/#outer-structure.sig>
*
* 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; /* <design/sig/> */
} MVFFStruct;
/* ArenaStruct -- generic arena
*
* See <code/arena.c>. */
* See <code/arena.c>.
*/
#define ArenaSig ((Sig)0x519A6E4A) /* SIGnature ARENA */
typedef struct mps_arena_s {
InstStruct instStruct;
GlobalsStruct globals; /* must be first, see <design/arena/#globals> */
Serial serial;
ArenaClass class; /* arena class structure */
Bool poolReady; /* <design/arena/#pool.ready> */
MVStruct controlPoolStruct; /* <design/arena/#pool> */
ReservoirStruct reservoirStruct; /* <design/reservoir/> */
MVFFStruct controlPoolStruct; /* <design/arena/#pool> */
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 <code/ref.c> */
Size grainSize; /* <design/arena/#grain> */
@ -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 (<code/shield.c>) */
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 (<code/trace.c>) */
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]; /* <design/message-gc/> */
/* 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 (<code/ld.c>) */
Epoch epoch; /* <design/arena/#ld.epoch> */
RefSet prehistory; /* <design/arena/#ld.prehistory> */
RefSet history[LDHistoryLENGTH]; /* <design/arena/#ld.history> */
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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

144
mps/code/mpmtypes.h
View file

@ -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: <design/type/>
@ -38,6 +38,7 @@ typedef Word Size; /* <design/type/#size> */
typedef Word Count; /* <design/type/#count> */
typedef Word Index; /* <design/type/#index> */
typedef Word Align; /* <design/type/#align> */
typedef Word Work; /* <design/type/#work> */
typedef unsigned Shift; /* <design/type/#shift> */
typedef unsigned Serial; /* <design/type/#serial> */
typedef Addr Ref; /* <design/type/#ref> */
@ -61,26 +62,19 @@ typedef unsigned TraceSet; /* <design/trace/> */
typedef unsigned TraceState; /* <design/trace/> */
typedef unsigned AccessSet; /* <design/type/#access-set> */
typedef unsigned Attr; /* <design/type/#attr> */
typedef int RootVar; /* <design/type/#rootvar> */
typedef unsigned RootVar; /* <design/type/#rootvar> */
typedef Word *BT; /* <design/bt/> */
typedef struct BootBlockStruct *BootBlock; /* <code/boot.c> */
typedef struct BufferStruct *Buffer; /* <design/buffer/> */
typedef struct SegBufStruct *SegBuf; /* <design/buffer/> */
typedef struct BufferClassStruct *BufferClass; /* <design/buffer/> */
typedef BufferClass SegBufClass; /* <design/buffer/> */
typedef BufferClass RankBufClass; /* <design/buffer/> */
typedef unsigned BufferMode; /* <design/buffer/> */
typedef unsigned FrameState; /* <design/alloc-frame/> */
typedef struct mps_fmt_s *Format; /* design.mps.format */
typedef struct LockStruct *Lock; /* <code/lock.c>* */
typedef struct mps_pool_s *Pool; /* <design/pool/> */
typedef Pool AbstractPool;
typedef struct mps_pool_class_s *PoolClass; /* <code/poolclas.c> */
typedef PoolClass AbstractPoolClass; /* <code/poolabs.c> */
typedef PoolClass AbstractBufferPoolClass; /* <code/poolabs.c> */
typedef PoolClass AbstractSegBufPoolClass; /* <code/poolabs.c> */
typedef PoolClass AbstractScanPoolClass; /* <code/poolabs.c> */
typedef PoolClass AbstractCollectPoolClass; /* <code/poolabs.c> */
typedef struct TraceStruct *Trace; /* <design/trace/> */
typedef struct ScanStateStruct *ScanState; /* <design/trace/> */
typedef struct mps_chain_s *Chain; /* <design/trace/> */
@ -91,35 +85,36 @@ typedef union PageUnion *Page; /* <code/tract.c> */
typedef struct SegStruct *Seg; /* <code/seg.c> */
typedef struct GCSegStruct *GCSeg; /* <code/seg.c> */
typedef struct SegClassStruct *SegClass; /* <code/seg.c> */
typedef SegClass GCSegClass; /* <code/seg.c> */
typedef struct LocusPrefStruct *LocusPref; /* <design/locus/>, <code/locus.c> */
typedef int LocusPrefKind; /* <design/locus/>, <code/locus.c> */
typedef unsigned LocusPrefKind; /* <design/locus/>, <code/locus.c> */
typedef struct mps_arena_class_s *ArenaClass; /* <design/arena/> */
typedef ArenaClass AbstractArenaClass; /* <code/arena.c> */
typedef struct mps_arena_s *Arena; /* <design/arena/> */
typedef Arena AbstractArena;
typedef struct GlobalsStruct *Globals; /* <design/arena/> */
typedef struct VMStruct *VM; /* <code/vm.c>* */
typedef struct RootStruct *Root; /* <code/root.c> */
typedef struct mps_thr_s *Thread; /* <code/th.c>* */
typedef struct MutatorFaultContextStruct
*MutatorFaultContext; /* <design/prot/> */
typedef struct MutatorContextStruct *MutatorContext; /* <design/prmc/> */
typedef struct PoolDebugMixinStruct *PoolDebugMixin;
typedef struct AllocPatternStruct *AllocPattern;
typedef struct AllocFrameStruct *AllocFrame; /* <design/alloc-frame/> */
typedef struct ReservoirStruct *Reservoir; /* <design/reservoir/> */
typedef struct StackContextStruct *StackContext;
typedef struct RangeStruct *Range; /* <design/range/> */
typedef struct RangeTreeStruct *RangeTree;
typedef struct LandStruct *Land; /* <design/land/> */
typedef struct LandClassStruct *LandClass; /* <design/land/> */
typedef unsigned FindDelete; /* <design/land/> */
typedef struct ShieldStruct *Shield; /* design.mps.shield */
typedef struct HistoryStruct *History; /* design.mps.arena.ld */
typedef struct PoolGenStruct *PoolGen; /* <design/strategy/> */
/* Arena*Method -- see <code/mpmst.h#ArenaClassStruct> */
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 <design/seg/> */
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 <design/buffer/> */
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 <design/class-interface/> */
/* Pool*Method -- see <design/pool/> */
/* Order of types corresponds to PoolClassStruct in <code/mpmst.h> */
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 <design/land/> */
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 */
/* <design/sig/> SIGnature IS BAD */
#define SigInvalid ((Sig)0x51915BAD)
/* <design/sig/> */
#define SigInvalid ((Sig)0x51915BAD) /* SIGnature IS BAD */
#define SizeMAX ((Size)-1)
#define AccessSetEMPTY ((AccessSet)0) /* <design/type/#access-set> */
@ -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)) /* <design/type/#attr> */
#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 <design/alloc-frame/#lw-frame.states> */
enum {
BufferFrameVALID = 1,
BufferFramePOP_PENDING,
BufferFrameDISABLED
};
/* Rank constants -- see <design/type/#rank> */
/* These definitions must match <code/mps.h#rank>. */
/* This is checked by <code/mpsi.c#check>. */
@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

133
mps/code/mps.c
View file

@ -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 <http://www.ravenbrook.com/>.
* Copyright (C) 2012-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

27
mps/code/mps.h
View file

@ -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 */

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

File diff suppressed because it is too large Load diff

236
mps/code/mpsi.c
View file

@ -1,7 +1,7 @@
/* mpsi.c: MEMORY POOL SYSTEM C INTERFACE LAYER
*
* $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.
*
* .purpose: This code bridges between the MPS interface to C,
@ -234,6 +234,25 @@ size_t mps_arena_spare_commit_limit(mps_arena_t arena)
return limit;
}
double mps_arena_pause_time(mps_arena_t arena)
{
double pause_time;
ArenaEnter(arena);
pause_time = ArenaPauseTime(arena);
ArenaLeave(arena);
return pause_time;
}
void mps_arena_pause_time_set(mps_arena_t arena, double pause_time)
{
ArenaEnter(arena);
ArenaSetPauseTime(arena, pause_time);
ArenaLeave(arena);
}
void mps_arena_clamp(mps_arena_t arena)
{
ArenaEnter(arena);
@ -245,7 +264,9 @@ void mps_arena_clamp(mps_arena_t arena)
void mps_arena_release(mps_arena_t arena)
{
ArenaEnter(arena);
ArenaRelease(ArenaGlobals(arena));
STACK_CONTEXT_BEGIN(arena) {
ArenaRelease(ArenaGlobals(arena));
} STACK_CONTEXT_END(arena);
ArenaLeave(arena);
}
@ -258,6 +279,15 @@ void mps_arena_park(mps_arena_t arena)
}
void mps_arena_postmortem(mps_arena_t arena)
{
/* Don't call ArenaEnter -- one of the purposes of this function is
* to release the arena lock if it's held */
AVER(TESTT(Arena, arena));
ArenaPostmortem(ArenaGlobals(arena));
}
void mps_arena_expose(mps_arena_t arena)
{
ArenaEnter(arena);
@ -285,7 +315,10 @@ mps_res_t mps_arena_start_collect(mps_arena_t arena)
{
Res res;
ArenaEnter(arena);
res = ArenaStartCollect(ArenaGlobals(arena), TraceStartWhyCLIENTFULL_INCREMENTAL);
STACK_CONTEXT_BEGIN(arena) {
res = ArenaStartCollect(ArenaGlobals(arena),
TraceStartWhyCLIENTFULL_INCREMENTAL);
} STACK_CONTEXT_END(arena);
ArenaLeave(arena);
return (mps_res_t)res;
}
@ -294,7 +327,9 @@ mps_res_t mps_arena_collect(mps_arena_t arena)
{
Res res;
ArenaEnter(arena);
res = ArenaCollect(ArenaGlobals(arena), TraceStartWhyCLIENTFULL_BLOCK);
STACK_CONTEXT_BEGIN(arena) {
res = ArenaCollect(ArenaGlobals(arena), TraceStartWhyCLIENTFULL_BLOCK);
} STACK_CONTEXT_END(arena);
ArenaLeave(arena);
return (mps_res_t)res;
}
@ -305,7 +340,9 @@ mps_bool_t mps_arena_step(mps_arena_t arena,
{
Bool b;
ArenaEnter(arena);
b = ArenaStep(ArenaGlobals(arena), interval, multiplier);
STACK_CONTEXT_BEGIN(arena) {
b = ArenaStep(ArenaGlobals(arena), interval, multiplier);
} STACK_CONTEXT_END(arena);
ArenaLeave(arena);
return b;
}
@ -372,6 +409,17 @@ void mps_arena_destroy(mps_arena_t arena)
}
/* mps_arena_busy -- is the arena part way through an operation? */
mps_bool_t mps_arena_busy(mps_arena_t arena)
{
/* Don't call ArenaEnter -- the purpose of this function is to
* determine if the arena lock is held */
AVER(TESTT(Arena, arena));
return ArenaBusy(arena);
}
/* mps_arena_has_addr -- is this address managed by this arena? */
mps_bool_t mps_arena_has_addr(mps_arena_t arena, mps_addr_t p)
@ -743,24 +791,24 @@ mps_res_t mps_alloc(mps_addr_t *p_o, mps_pool_t pool, size_t size)
Addr p;
Res res;
AVER(TESTT(Pool, pool));
AVER_CRITICAL(TESTT(Pool, pool));
arena = PoolArena(pool);
ArenaEnter(arena);
STACK_CONTEXT_BEGIN(arena) {
ArenaPoll(ArenaGlobals(arena)); /* .poll */
ArenaPoll(ArenaGlobals(arena)); /* .poll */
AVER(p_o != NULL);
AVERT(Pool, pool);
AVER(size > 0);
/* Note: class may allow unaligned size, see */
/* <design/class-interface/#alloc.size.align>. */
/* Rest ignored, see .varargs. */
AVER_CRITICAL(p_o != NULL);
AVERT_CRITICAL(Pool, pool);
AVER_CRITICAL(size > 0);
/* Note: class may allow unaligned size, see */
/* <design/pool/#method.alloc.size.align>. */
/* Rest ignored, see .varargs. */
/* @@@@ There is currently no requirement for reservoirs to work */
/* with unbuffered allocation. */
res = PoolAlloc(&p, pool, size, FALSE);
res = PoolAlloc(&p, pool, size);
} STACK_CONTEXT_END(arena);
ArenaLeave(arena);
if (res != ResOK)
@ -787,15 +835,15 @@ void mps_free(mps_pool_t pool, mps_addr_t p, size_t size)
{
Arena arena;
AVER(TESTT(Pool, pool));
AVER_CRITICAL(TESTT(Pool, pool));
arena = PoolArena(pool);
ArenaEnter(arena);
AVERT(Pool, pool);
AVER(size > 0);
AVERT_CRITICAL(Pool, pool);
AVER_CRITICAL(size > 0);
/* Note: class may allow unaligned size, see */
/* <design/class-interface/#alloc.size.align>. */
/* <design/pool/#method.free.size.align>. */
PoolFree(pool, (Addr)p, size);
ArenaLeave(arena);
@ -911,17 +959,7 @@ mps_res_t (mps_reserve)(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size)
mps_res_t mps_reserve_with_reservoir_permit(mps_addr_t *p_o,
mps_ap_t mps_ap, size_t size)
{
mps_res_t res;
AVER(p_o != NULL);
AVER(size > 0);
AVER(mps_ap != NULL);
AVER(TESTT(Buffer, BufferOfAP(mps_ap)));
AVER(mps_ap->init == mps_ap->alloc);
MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(res, *p_o, mps_ap, size);
return res;
return mps_reserve(p_o, mps_ap, size);
}
@ -968,7 +1006,7 @@ mps_res_t (mps_ap_frame_push)(mps_frame_t *frame_o, mps_ap_t mps_ap)
return MPS_RES_FAIL;
}
if (!mps_ap->_lwpoppending) {
if (mps_ap->init < mps_ap->limit) {
/* Valid state for a lightweight push */
*frame_o = (mps_frame_t)mps_ap->init;
return MPS_RES_OK;
@ -1001,6 +1039,9 @@ mps_res_t (mps_ap_frame_push)(mps_frame_t *frame_o, mps_ap_t mps_ap)
mps_res_t (mps_ap_frame_pop)(mps_ap_t mps_ap, mps_frame_t frame)
{
Buffer buf;
Pool pool;
AVER(mps_ap != NULL);
/* Can't check frame because it's an arbitrary value */
@ -1009,20 +1050,27 @@ mps_res_t (mps_ap_frame_pop)(mps_ap_t mps_ap, mps_frame_t frame)
return MPS_RES_FAIL;
}
if (mps_ap->_enabled) {
/* Valid state for a lightweight pop */
mps_ap->_frameptr = (mps_addr_t)frame; /* record pending pop */
mps_ap->_lwpoppending = TRUE;
mps_ap->limit = (mps_addr_t)0; /* trap the buffer */
buf = BufferOfAP(mps_ap);
AVER(TESTT(Buffer, buf));
pool = buf->pool;
AVER(TESTT(Pool, pool));
/* It's not thread-safe to read BufferBase here in an automatically
* managed pool (see job003947), so test AttrGC first. */
if (!PoolHasAttr(pool, AttrGC)
&& BufferBase(buf) <= (Addr)frame
&& (mps_addr_t)frame < mps_ap->init)
{
/* Lightweight pop to earlier address in same buffer in a manually
* managed pool. */
mps_ap->init = mps_ap->alloc = (mps_addr_t)frame;
return MPS_RES_OK;
} else {
/* Need a heavyweight pop */
Buffer buf = BufferOfAP(mps_ap);
Arena arena;
Res res;
AVER(TESTT(Buffer, buf));
arena = BufferArena(buf);
ArenaEnter(arena);
@ -1054,16 +1102,18 @@ mps_res_t mps_ap_fill(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size)
arena = BufferArena(buf);
ArenaEnter(arena);
STACK_CONTEXT_BEGIN(arena) {
ArenaPoll(ArenaGlobals(arena)); /* .poll */
ArenaPoll(ArenaGlobals(arena)); /* .poll */
AVER(p_o != NULL);
AVERT(Buffer, buf);
AVER(size > 0);
AVER(SizeIsAligned(size, BufferPool(buf)->alignment));
AVER(p_o != NULL);
AVERT(Buffer, buf);
AVER(size > 0);
AVER(SizeIsAligned(size, BufferPool(buf)->alignment)); /* <design/check/#.common> */
res = BufferFill(&p, buf, size, FALSE);
res = BufferFill(&p, buf, size);
} STACK_CONTEXT_END(arena);
ArenaLeave(arena);
if (res != ResOK)
@ -1076,32 +1126,7 @@ mps_res_t mps_ap_fill(mps_addr_t *p_o, mps_ap_t mps_ap, size_t size)
mps_res_t mps_ap_fill_with_reservoir_permit(mps_addr_t *p_o, mps_ap_t mps_ap,
size_t size)
{
Buffer buf = BufferOfAP(mps_ap);
Arena arena;
Addr p;
Res res;
AVER(mps_ap != NULL);
AVER(TESTT(Buffer, buf));
arena = BufferArena(buf);
ArenaEnter(arena);
ArenaPoll(ArenaGlobals(arena)); /* .poll */
AVER(p_o != NULL);
AVERT(Buffer, buf);
AVER(size > 0);
AVER(SizeIsAligned(size, BufferPool(buf)->alignment));
res = BufferFill(&p, buf, size, TRUE);
ArenaLeave(arena);
if (res != ResOK)
return (mps_res_t)res;
*p_o = (mps_addr_t)p;
return MPS_RES_OK;
return mps_ap_fill(p_o, mps_ap, size);
}
@ -1210,10 +1235,11 @@ mps_res_t mps_sac_fill(mps_addr_t *p_o, mps_sac_t mps_sac, size_t size,
AVER(p_o != NULL);
AVER(TESTT(SAC, sac));
arena = SACArena(sac);
UNUSED(has_reservoir_permit); /* deprecated */
ArenaEnter(arena);
res = SACFill(&p, sac, size, (has_reservoir_permit != 0));
res = SACFill(&p, sac, size);
ArenaLeave(arena);
@ -1553,7 +1579,7 @@ mps_res_t mps_root_create_thread_tagged(mps_root_t *mps_root_o,
/* See .root-mode. */
res = RootCreateThreadTagged(&root, arena, rank, thread,
scan_area, mask, pattern,
(Word *)cold);
cold);
ArenaLeave(arena);
@ -1703,7 +1729,7 @@ mps_res_t mps_fix(mps_ss_t mps_ss, mps_addr_t *ref_io)
mps_res_t res;
MPS_SCAN_BEGIN(mps_ss) {
res = MPS_FIX(mps_ss, ref_io);
res = MPS_FIX12(mps_ss, ref_io);
} MPS_SCAN_END(mps_ss);
return res;
@ -2035,56 +2061,56 @@ mps_res_t mps_ap_alloc_pattern_begin(mps_ap_t mps_ap,
mps_res_t mps_ap_alloc_pattern_end(mps_ap_t mps_ap,
mps_alloc_pattern_t alloc_pattern)
{
Buffer buf;
Arena arena;
Res res;
AVER(mps_ap != NULL);
buf = BufferOfAP(mps_ap);
AVER(TESTT(Buffer, buf));
AVER(TESTT(Buffer, BufferOfAP(mps_ap)));
UNUSED(alloc_pattern); /* .ramp.hack */
arena = BufferArena(buf);
arena = BufferArena(BufferOfAP(mps_ap));
ArenaEnter(arena);
res = BufferRampEnd(buf);
ArenaPoll(ArenaGlobals(arena)); /* .poll */
STACK_CONTEXT_BEGIN(arena) {
res = BufferRampEnd(BufferOfAP(mps_ap));
ArenaPoll(ArenaGlobals(arena)); /* .poll */
} STACK_CONTEXT_END(arena);
ArenaLeave(arena);
return (mps_res_t)res;
}
mps_res_t mps_ap_alloc_pattern_reset(mps_ap_t mps_ap)
{
Buffer buf;
Arena arena;
AVER(mps_ap != NULL);
buf = BufferOfAP(mps_ap);
AVER(TESTT(Buffer, buf));
AVER(TESTT(Buffer, BufferOfAP(mps_ap)));
arena = BufferArena(BufferOfAP(mps_ap));
arena = BufferArena(buf);
ArenaEnter(arena);
BufferRampReset(buf);
ArenaPoll(ArenaGlobals(arena)); /* .poll */
STACK_CONTEXT_BEGIN(arena) {
BufferRampReset(BufferOfAP(mps_ap));
ArenaPoll(ArenaGlobals(arena)); /* .poll */
} STACK_CONTEXT_END(arena);
ArenaLeave(arena);
return MPS_RES_OK;
}
/* Low memory reservoir */
/* Low memory reservoir (deprecated -- see job003985) */
/* mps_reservoir_limit_set -- set the reservoir size */
void mps_reservoir_limit_set(mps_arena_t arena, size_t size)
{
ArenaEnter(arena);
ReservoirSetLimit(ArenaReservoir(arena), size);
ArenaLeave(arena);
UNUSED(arena);
UNUSED(size);
NOOP;
}
@ -2092,14 +2118,8 @@ void mps_reservoir_limit_set(mps_arena_t arena, size_t size)
size_t mps_reservoir_limit(mps_arena_t arena)
{
Size size;
ArenaEnter(arena);
size = ReservoirLimit(ArenaReservoir(arena));
ArenaLeave(arena);
return size;
UNUSED(arena);
return 0;
}
@ -2107,14 +2127,8 @@ size_t mps_reservoir_limit(mps_arena_t arena)
size_t mps_reservoir_available(mps_arena_t arena)
{
Size size;
ArenaEnter(arena);
size = ReservoirAvailable(ArenaReservoir(arena));
ArenaLeave(arena);
return size;
UNUSED(arena);
return 0;
}
@ -2177,7 +2191,7 @@ void _mps_args_set_key(mps_arg_s args[MPS_ARGS_MAX], unsigned i,
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2015 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

165
mps/code/mpsicv.c
View file

@ -1,7 +1,7 @@
/* mpsicv.c: MPSI 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.
* Portions copyright (c) 2002 Global Graphics Software.
*/
@ -9,7 +9,7 @@
#include "mpslib.h"
#include "mpscamc.h"
#include "mpsavm.h"
#include "mpscmv.h"
#include "mpscmvff.h"
#include "fmthe.h"
#include "fmtdy.h"
#include "fmtdytst.h"
@ -96,9 +96,14 @@ static void alignmentTest(mps_arena_t arena)
int dummy = 0;
size_t j, size;
die(mps_pool_create(&pool, arena, mps_class_mv(),
(size_t)0x1000, (size_t)1024, (size_t)16384),
"alignment pool create");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, 0x1000);
MPS_ARGS_ADD(args, MPS_KEY_MEAN_SIZE, 1024);
MPS_ARGS_ADD(args, MPS_KEY_MAX_SIZE, 16384);
die(mps_pool_create_k(&pool, arena, mps_class_mvff(), args),
"alignment pool create");
} MPS_ARGS_END(args);
size = max(sizeof(double), sizeof(long));
#ifdef HAS_LONG_LONG
size = max(size, sizeof(long_long_t));
@ -143,31 +148,6 @@ static mps_addr_t make(void)
}
/* make_with_permit -- allocate an object, with reservoir permit */
static mps_addr_t make_with_permit(void)
{
size_t length = rnd() % 20;
size_t sizeCli = (length+2)*sizeof(mps_word_t);
size_t sizeMps = SizeCli2Mps(sizeCli);
mps_addr_t pMps, pCli;
mps_res_t res;
do {
MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK(res, pMps, ap, sizeMps);
if (res != MPS_RES_OK)
die(res, "MPS_RESERVE_WITH_RESERVOIR_PERMIT_BLOCK");
HeaderInit(pMps);
pCli = PtrMps2Cli(pMps);
res = dylan_init(pCli, sizeCli, exactRoots, exactRootsCOUNT);
if (res != MPS_RES_OK)
die(res, "dylan_init");
} while(!mps_commit(ap, pMps, sizeMps));
return pCli;
}
/* make_no_inline -- allocate an object, using non-inlined interface */
static mps_addr_t make_no_inline(void)
@ -325,7 +305,7 @@ static mps_res_t root_single(mps_ss_t ss, void *p, size_t s)
* incidentally tests:
* mps_alloc
* mps_arena_commit_limit_set
* mps_class_mv
* mps_class_mvff
* mps_pool_create
* mps_pool_destroy
*/
@ -339,9 +319,14 @@ static void arena_commit_test(mps_arena_t arena)
void *p;
mps_res_t res;
die(mps_pool_create(&pool, arena, mps_class_mv(),
(size_t)0x1000, (size_t)1024, (size_t)16384),
"commit pool create");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, 0x1000);
MPS_ARGS_ADD(args, MPS_KEY_MEAN_SIZE, 1024);
MPS_ARGS_ADD(args, MPS_KEY_MAX_SIZE, 16384);
die(mps_pool_create_k(&pool, arena, mps_class_mvff(), args),
"commit pool create");
} MPS_ARGS_END(args);
limit = mps_arena_commit_limit(arena);
committed = mps_arena_committed(arena);
reserved = mps_arena_reserved(arena);
@ -358,36 +343,13 @@ static void arena_commit_test(mps_arena_t arena)
}
/* reservoir_test -- Test the reservoir interface
*
* This has not been tuned to actually dip into the reservoir. See
* QA test 132 for that.
*/
#define reservoirSIZE ((size_t)128 * 1024)
static void reservoir_test(mps_arena_t arena)
{
(void)make_with_permit();
cdie(mps_reservoir_available(arena) == 0, "empty reservoir");
cdie(mps_reservoir_limit(arena) == 0, "no reservoir");
mps_reservoir_limit_set(arena, reservoirSIZE);
cdie(mps_reservoir_limit(arena) >= reservoirSIZE, "reservoir limit set");
cdie(mps_reservoir_available(arena) >= reservoirSIZE, "got reservoir");
(void)make_with_permit();
mps_reservoir_limit_set(arena, 0);
cdie(mps_reservoir_available(arena) == 0, "empty reservoir");
cdie(mps_reservoir_limit(arena) == 0, "no reservoir");
(void)make_with_permit();
}
static void *test(void *arg, size_t s)
{
mps_arena_t arena;
mps_fmt_t format;
mps_chain_t chain;
mps_root_t exactRoot, ambigRoot, singleRoot, fmtRoot;
mps_root_t exactAreaRoot, exactTableRoot, ambigAreaRoot, ambigTableRoot,
singleRoot, fmtRoot;
unsigned long i;
/* Leave arena clamped until we have allocated this many objects.
is 0 when arena has not been clamped. */
@ -418,9 +380,13 @@ static void *test(void *arg, size_t s)
die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create");
die(mps_pool_create(&mv, arena, mps_class_mv(),
(size_t)0x10000, (size_t)32, (size_t)0x10000),
"pool_create(mv)");
MPS_ARGS_BEGIN(args) {
MPS_ARGS_ADD(args, MPS_KEY_EXTEND_BY, 0x10000);
MPS_ARGS_ADD(args, MPS_KEY_MEAN_SIZE, 32);
MPS_ARGS_ADD(args, MPS_KEY_MAX_SIZE, 0x10000);
die(mps_pool_create_k(&mv, arena, mps_class_mvff(), args),
"pool_create(mv)");
} MPS_ARGS_END(args);
pool_create_v_test(arena, format, chain); /* creates amc pool */
@ -435,14 +401,29 @@ static void *test(void *arg, size_t s)
ambigRoots[j] = rnd_addr();
}
die(mps_root_create_table_masked(&exactRoot, arena,
die(mps_root_create_area_tagged(&exactAreaRoot, arena,
mps_rank_exact(), (mps_rm_t)0,
&exactRoots[0],
&exactRoots[exactRootsCOUNT / 2],
mps_scan_area_tagged,
MPS_WORD_CONST(1), 0),
"root_create_area_tagged(exact)");
die(mps_root_create_table_masked(&exactTableRoot, arena,
mps_rank_exact(), (mps_rm_t)0,
&exactRoots[0], exactRootsCOUNT,
&exactRoots[exactRootsCOUNT / 2],
(exactRootsCOUNT + 1) / 2,
MPS_WORD_CONST(1)),
"root_create_table(exact)");
die(mps_root_create_table(&ambigRoot, arena,
"root_create_table_masked(exact)");
die(mps_root_create_area(&ambigAreaRoot, arena,
mps_rank_ambig(), (mps_rm_t)0,
&ambigRoots[0],
&ambigRoots[ambigRootsCOUNT / 2],
mps_scan_area, NULL),
"root_create_area(ambig)");
die(mps_root_create_table(&ambigTableRoot, arena,
mps_rank_ambig(), (mps_rm_t)0,
&ambigRoots[0], ambigRootsCOUNT),
&ambigRoots[ambigRootsCOUNT / 2],
(ambigRootsCOUNT + 1) / 2),
"root_create_table(ambig)");
obj = objNULL;
@ -483,11 +464,13 @@ static void *test(void *arg, size_t s)
mps_word_t c;
size_t r;
Insist(!mps_arena_busy(arena));
c = mps_collections(arena);
if(collections != c) {
collections = c;
printf("\nCollection %"PRIuLONGEST", %lu objects.\n", (ulongest_t)c, i);
printf("Collection %"PRIuLONGEST", %lu objects.\n", (ulongest_t)c, i);
for(r = 0; r < exactRootsCOUNT; ++r) {
cdie(exactRoots[r] == objNULL || dylan_check(exactRoots[r]),
"all roots check");
@ -555,7 +538,6 @@ static void *test(void *arg, size_t s)
}
arena_commit_test(arena);
reservoir_test(arena);
alignmentTest(arena);
die(mps_arena_collect(arena), "collect");
@ -569,8 +551,10 @@ static void *test(void *arg, size_t s)
mps_ap_destroy(ap);
mps_root_destroy(fmtRoot);
mps_root_destroy(singleRoot);
mps_root_destroy(exactRoot);
mps_root_destroy(ambigRoot);
mps_root_destroy(exactAreaRoot);
mps_root_destroy(exactTableRoot);
mps_root_destroy(ambigAreaRoot);
mps_root_destroy(ambigTableRoot);
mps_pool_destroy(amcpool);
mps_chain_destroy(chain);
mps_fmt_destroy(format);
@ -592,25 +576,48 @@ int main(int argc, char *argv[])
testlib_init(argc, argv);
die(mps_arena_create(&arena, mps_arena_class_vm(), TEST_ARENA_SIZE),
"arena_create");
MPS_ARGS_BEGIN(args) {
/* Randomize pause time as a regression test for job004011. */
MPS_ARGS_ADD(args, MPS_KEY_PAUSE_TIME, rnd_pause_time());
MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, TEST_ARENA_SIZE);
die(mps_arena_create_k(&arena, mps_arena_class_vm(), args),
"arena_create");
} MPS_ARGS_END(args);
die(mps_thread_reg(&thread, arena), "thread_reg");
if (rnd() % 2) {
switch (rnd() % 3) {
default:
case 0:
die(mps_root_create_reg(&reg_root, arena,
mps_rank_ambig(), (mps_rm_t)0,
thread, &mps_stack_scan_ambig,
marker, (size_t)0),
"root_create_reg");
} else {
break;
case 1:
die(mps_root_create_thread(&reg_root, arena, thread, marker),
"root_create_thread");
break;
case 2:
die(mps_root_create_thread_scanned(&reg_root, arena, mps_rank_ambig(),
(mps_rm_t)0, thread, mps_scan_area,
NULL, marker),
"root_create_thread");
break;
}
mps_tramp(&r, test, arena, 0);
mps_root_destroy(reg_root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
switch (rnd() % 2) {
default:
case 0:
mps_root_destroy(reg_root);
mps_thread_dereg(thread);
mps_arena_destroy(arena);
break;
case 1:
mps_arena_postmortem(arena);
break;
}
printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
return 0;
@ -619,7 +626,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
* Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

10
mps/code/mpsiw3.c
View file

@ -2,12 +2,16 @@
*
* $Id$
*
* Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2001-2018 Ravenbrook Limited. See end of file for license.
*/
#include "mpm.h"
#include "mps.h"
#if !defined(MPS_OS_W3)
#error "mpsiw3.c is specific to MPS_OS_W3"
#endif
#include "mps.h"
#include "mpswin.h"
SRCID(mpsiw3, "$Id$");
@ -33,7 +37,7 @@ void mps_SEH_handler(void *p, size_t s)
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

4
mps/code/mpslib.h
View file

@ -1,7 +1,7 @@
/* mpslib.h: RAVENBROOK MEMORY POOL SYSTEM LIBRARY INTERFACE
*
* $Id$
* Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2001-2017 Ravenbrook Limited. See end of file for license.
*
* .readership: MPS client application developers, MPS developers.
* .sources: <design/lib/>
@ -78,7 +78,7 @@ extern unsigned long mps_lib_telemetry_control(void);
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2017 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

8
mps/code/mpsliban.c
View file

@ -1,7 +1,7 @@
/* mpsliban.c: RAVENBROOK MEMORY POOL SYSTEM LIBRARY INTERFACE (ANSI)
*
* $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.
*
* .purpose: The purpose of this code is
@ -81,8 +81,8 @@ static void mps_lib_assert_fail_default(const char *file, unsigned line,
static mps_lib_assert_fail_t mps_lib_assert_handler = mps_lib_assert_fail_default;
void mps_lib_assert_fail(const char *file,
unsigned line,
const char *condition)
unsigned line,
const char *condition)
{
mps_lib_assert_handler(file, line, condition);
}
@ -206,7 +206,7 @@ unsigned long mps_lib_telemetry_control(void)
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2017 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

25
mps/code/mpstd.h
View file

@ -142,6 +142,29 @@
#define MPS_PF_ALIGN 4 /* I'm just guessing. */
/* gcc-mp-4.7 (MacPorts gcc47 4.7.4_5) 4.7.4
* gcc -E -dM
* Note that Clang also defines __GNUC__ since it's generally GCC compatible,
* but that doesn't fit our system so we exclude Clang here.
*/
#elif defined(__APPLE__) && defined(__x86_64__) && defined(__MACH__) \
&& defined(__GNUC__) && !defined(__clang__)
#if defined(CONFIG_PF_STRING) && ! defined(CONFIG_PF_XCI6GC)
#error "specified CONFIG_PF_... inconsistent with detected xci6gc"
#endif
#define MPS_PF_XCI6GC
#define MPS_PF_STRING "xci6gc"
#define MPS_OS_XC
#define MPS_ARCH_I6
#define MPS_BUILD_GC
#define MPS_T_WORD unsigned long
#define MPS_T_ULONGEST unsigned long
#define MPS_WORD_WIDTH 64
#define MPS_WORD_SHIFT 6
#define MPS_PF_ALIGN 8
/* Apple clang version 3.1, clang -E -dM */
#elif defined(__APPLE__) && defined(__i386__) && defined(__MACH__) \
@ -306,7 +329,7 @@
#define MPS_ARCH_I6
#define MPS_BUILD_LL
#define MPS_T_WORD unsigned long
#define MPS_T_ULONGEST unsigned long /* FIXME: Check this for Clang */
#define MPS_T_ULONGEST unsigned long
#define MPS_WORD_WIDTH 64
#define MPS_WORD_SHIFT 6
#define MPS_PF_ALIGN 8

18
mps/code/mv2test.c
View file

@ -1,7 +1,7 @@
/* mv2test.c: POOLMVT 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.
*/
#include <math.h>
@ -102,13 +102,15 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
/* allocate a load of objects */
for(i=0; i<TEST_SET_SIZE; ++i) {
mps_addr_t obj;
ss[i] = (*size)(i);
res = make((mps_addr_t *)&ps[i], ap, ss[i], align);
if(res != MPS_RES_OK)
res = make(&obj, ap, ss[i], align);
if (res != MPS_RES_OK) {
ss[i] = 0;
else
} else {
ps[i]= obj;
*ps[i] = 1; /* Write something, so it gets swap. */
}
if (verbose) {
if (i && i%4==0)
@ -146,10 +148,12 @@ static mps_res_t stress(mps_arena_t arena, mps_align_t align,
}
/* allocate some new objects */
for(i=x; i<TEST_SET_SIZE; ++i) {
mps_addr_t obj;
size_t s = (*size)(i);
res = make((mps_addr_t *)&ps[i], ap, s, align);
res = make(&obj, ap, s, align);
if(res != MPS_RES_OK)
break;
ps[i] = obj;
ss[i] = s;
if (verbose) {
@ -218,7 +222,7 @@ int main(int argc, char *argv[])
/* C. COPYRIGHT AND LICENSE
*
* Copyright (c) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (c) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

2
mps/code/nailboard.c
View file

@ -127,7 +127,7 @@ Res NailboardCreate(Nailboard *boardReturn, Arena arena, Align alignment,
alignShift = SizeLog2((Size)alignment);
nails = AddrOffset(base, limit) >> alignShift;
levels = nailboardLevels(nails);
res = ControlAlloc(&p, arena, nailboardSize(nails, levels), FALSE);
res = ControlAlloc(&p, arena, nailboardSize(nails, levels));
if (res != ResOK)
return res;

8
mps/code/nailboardtest.c
View file

@ -1,7 +1,7 @@
/* nailboardtest.c: NAILBOARD 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-2018 Ravenbrook Limited. See end of file for license.
*
*/
@ -54,7 +54,7 @@ static void test(mps_arena_t arena)
die(NailboardDescribe(board, mps_lib_get_stdout(), 0), "NailboardDescribe");
}
int main(int argc, char **argv)
int main(int argc, char *argv[])
{
mps_arena_t arena;
@ -73,7 +73,7 @@ int main(int argc, char **argv)
/* C. COPYRIGHT AND LICENSE
*
* Copyright (c) 2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (c) 2014-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

204
mps/code/policy.c
View file

@ -1,7 +1,7 @@
/* policy.c: POLICY DECISIONS
*
* $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.
*
* This module collects the decision-making code for the MPS, so that
* policy can be maintained and adjusted.
@ -76,14 +76,14 @@ Res PolicyAlloc(Tract *tractReturn, Arena arena, LocusPref pref,
/* Plan C: Extend the arena, then try A and B again. */
if (moreZones != ZoneSetEMPTY) {
res = arena->class->grow(arena, pref, size);
res = Method(Arena, arena, grow)(arena, pref, size);
/* If we can't extend because we hit the commit limit, try purging
some spare committed memory and try again.*/
/* TODO: This would be a good time to *remap* VM instead of
returning it to the OS. */
if (res == ResCOMMIT_LIMIT) {
if (arena->class->purgeSpare(arena, size) >= size)
res = arena->class->grow(arena, pref, size);
if (Method(Arena, arena, purgeSpare)(arena, size) >= size)
res = Method(Arena, arena, grow)(arena, pref, size);
}
if (res == ResOK) {
if (zones != ZoneSetEMPTY) {
@ -144,9 +144,8 @@ static double policyCollectionTime(Arena arena)
collectableSize = ArenaCollectable(arena);
/* The condition arena->tracedTime >= 1.0 ensures that the division
* can't overflow. */
if (arena->tracedSize >= ARENA_MINIMUM_COLLECTABLE_SIZE
&& arena->tracedTime >= 1.0)
collectionRate = arena->tracedSize / arena->tracedTime;
if (arena->tracedTime >= 1.0)
collectionRate = arena->tracedWork / arena->tracedTime;
else
collectionRate = ARENA_DEFAULT_COLLECTION_RATE;
collectionTime = collectableSize / collectionRate;
@ -161,37 +160,41 @@ static double policyCollectionTime(Arena arena)
* Return TRUE if we should try collecting the world now, FALSE if
* not.
*
* This is the policy behind mps_arena_step, and so there the client
* must have provided us with be enough time to collect the world, and
* This is the policy behind mps_arena_step, and so the client
* must have provided us with enough time to collect the world, and
* enough time must have passed since the last time we did that
* opportunistically.
*/
Bool PolicyShouldCollectWorld(Arena arena, double interval, double multiplier,
Bool PolicyShouldCollectWorld(Arena arena, double availableTime,
Clock now, Clock clocks_per_sec)
{
/* don't collect the world if we're not given any time */
if ((interval > 0.0) && (multiplier > 0.0)) {
/* don't collect the world if we're already collecting. */
if (arena->busyTraces == TraceSetEMPTY) {
/* don't collect the world if it's very small */
Size collectableSize = ArenaCollectable(arena);
if (collectableSize > ARENA_MINIMUM_COLLECTABLE_SIZE) {
/* how long would it take to collect the world? */
double collectionTime = policyCollectionTime(arena);
Size collectableSize;
double collectionTime, sinceLastWorldCollect;
/* how long since we last collected the world? */
double sinceLastWorldCollect = ((now - arena->lastWorldCollect) /
(double) clocks_per_sec);
/* have to be offered enough time, and it has to be a long time
* since we last did it. */
if ((interval * multiplier > collectionTime) &&
sinceLastWorldCollect > collectionTime / ARENA_MAX_COLLECT_FRACTION)
return TRUE;
}
}
}
return FALSE;
AVERT(Arena, arena);
/* Can't collect the world if we're already collecting. */
AVER(arena->busyTraces == TraceSetEMPTY);
if (availableTime <= 0.0)
/* Can't collect the world if we're not given any time. */
return FALSE;
/* Don't collect the world if it's very small. */
collectableSize = ArenaCollectable(arena);
if (collectableSize < ARENA_MINIMUM_COLLECTABLE_SIZE)
return FALSE;
/* How long would it take to collect the world? */
collectionTime = policyCollectionTime(arena);
/* How long since we last collected the world? */
sinceLastWorldCollect = ((now - arena->lastWorldCollect) /
(double) clocks_per_sec);
/* Offered enough time, and long enough since we last did it? */
return availableTime > collectionTime
&& sinceLastWorldCollect > collectionTime / ARENA_MAX_COLLECT_FRACTION;
}
@ -207,12 +210,10 @@ Bool PolicyShouldCollectWorld(Arena arena, double interval, double multiplier,
static Res policyCondemnChain(double *mortalityReturn, Chain chain, Trace trace)
{
Res res;
size_t topCondemnedGen, i;
GenDesc gen;
ZoneSet condemnedSet = ZoneSetEMPTY;
Size condemnedSize = 0, survivorSize = 0, genNewSize, genTotalSize;
AVER(mortalityReturn != NULL);
AVERT(Chain, chain);
AVERT(Trace, trace);
@ -228,75 +229,78 @@ static Res policyCondemnChain(double *mortalityReturn, Chain chain, Trace trace)
-- topCondemnedGen;
gen = &chain->gens[topCondemnedGen];
AVERT(GenDesc, gen);
genNewSize = GenDescNewSize(gen);
if (genNewSize >= gen->capacity * (Size)1024)
if (GenDescNewSize(gen) >= gen->capacity)
break;
}
/* At this point, we've decided to condemn topCondemnedGen and all
* lower generations. */
TraceCondemnStart(trace);
for (i = 0; i <= topCondemnedGen; ++i) {
gen = &chain->gens[i];
AVERT(GenDesc, gen);
condemnedSet = ZoneSetUnion(condemnedSet, gen->zones);
genTotalSize = GenDescTotalSize(gen);
genNewSize = GenDescNewSize(gen);
condemnedSize += genTotalSize;
survivorSize += (Size)(genNewSize * (1.0 - gen->mortality))
/* predict survivors will survive again */
+ (genTotalSize - genNewSize);
GenDescStartTrace(gen, trace);
}
AVER(condemnedSet != ZoneSetEMPTY || condemnedSize == 0);
EVENT3(ChainCondemnAuto, chain, topCondemnedGen, chain->genCount);
/* Condemn everything in these zones. */
if (condemnedSet != ZoneSetEMPTY) {
res = TraceCondemnZones(trace, condemnedSet);
if (res != ResOK)
return res;
}
*mortalityReturn = 1.0 - (double)survivorSize / condemnedSize;
return ResOK;
return TraceCondemnEnd(mortalityReturn, trace);
}
/* PolicyStartTrace -- consider starting a trace
*
* If collectWorldAllowed is TRUE, consider starting a collection of
* the world. Otherwise, consider only starting collections of individual
* chains or generations.
*
* If a collection of the world was started, set *collectWorldReturn
* to TRUE. Otherwise leave it unchanged.
*
* If a trace was started, update *traceReturn and return TRUE.
* Otherwise, leave *traceReturn unchanged and return FALSE.
*/
Bool PolicyStartTrace(Trace *traceReturn, Arena arena)
Bool PolicyStartTrace(Trace *traceReturn, Bool *collectWorldReturn,
Arena arena, Bool collectWorldAllowed)
{
Res res;
Trace trace;
Size sFoundation, sCondemned, sSurvivors, sConsTrace;
double tTracePerScan; /* tTrace/cScan */
double dynamicDeferral;
double TraceWorkFactor = 0.25;
/* Fix the mortality of the world to avoid runaway feedback between the
dynamic criterion and the mortality of the arena's top generation,
leading to all traces collecting the world. This is a (hopefully)
temporary hack, pending an improved scheduling algorithm. */
double TraceWorldMortality = 0.5;
/* Compute dynamic criterion. See strategy.lisp-machine. */
AVER(arena->topGen.mortality >= 0.0);
AVER(arena->topGen.mortality <= 1.0);
sFoundation = (Size)0; /* condemning everything, only roots @@@@ */
/* @@@@ sCondemned should be scannable only */
sCondemned = ArenaCommitted(arena) - ArenaSpareCommitted(arena);
sSurvivors = (Size)(sCondemned * (1 - arena->topGen.mortality));
tTracePerScan = sFoundation + (sSurvivors * (1 + TraceCopyScanRATIO));
AVER(TraceWorkFactor >= 0);
AVER(sSurvivors + tTracePerScan * TraceWorkFactor <= (double)SizeMAX);
sConsTrace = (Size)(sSurvivors + tTracePerScan * TraceWorkFactor);
dynamicDeferral = (double)ArenaAvail(arena) - (double)sConsTrace;
AVER(traceReturn != NULL);
AVERT(Arena, arena);
if (dynamicDeferral < 0.0) {
/* Start full collection. */
res = TraceStartCollectAll(&trace, arena, TraceStartWhyDYNAMICCRITERION);
if (res != ResOK)
goto failStart;
*traceReturn = trace;
return TRUE;
} else {
if (collectWorldAllowed) {
Size sFoundation, sCondemned, sSurvivors, sConsTrace;
double tTracePerScan; /* tTrace/cScan */
double dynamicDeferral;
/* Compute dynamic criterion. See strategy.lisp-machine. */
sFoundation = (Size)0; /* condemning everything, only roots @@@@ */
/* @@@@ sCondemned should be scannable only */
sCondemned = ArenaCommitted(arena) - ArenaSpareCommitted(arena);
sSurvivors = (Size)(sCondemned * (1 - TraceWorldMortality));
tTracePerScan = sFoundation + (sSurvivors * (1 + TraceCopyScanRATIO));
AVER(TraceWorkFactor >= 0);
AVER(sSurvivors + tTracePerScan * TraceWorkFactor <= (double)SizeMAX);
sConsTrace = (Size)(sSurvivors + tTracePerScan * TraceWorkFactor);
dynamicDeferral = (double)ArenaAvail(arena) - (double)sConsTrace;
if (dynamicDeferral < 0.0) {
/* Start full collection. */
res = TraceStartCollectAll(&trace, arena, TraceStartWhyDYNAMICCRITERION);
if (res != ResOK)
goto failStart;
*collectWorldReturn = TRUE;
*traceReturn = trace;
return TRUE;
}
}
{
/* Find the chain most over its capacity. */
Ring node, nextNode;
double firstTime = 0.0;
@ -322,8 +326,8 @@ Bool PolicyStartTrace(Trace *traceReturn, Arena arena)
res = policyCondemnChain(&mortality, firstChain, trace);
if (res != ResOK) /* should try some other trace, really @@@@ */
goto failCondemn;
trace->chain = firstChain;
ChainStartGC(firstChain, trace);
if (TraceIsEmpty(trace))
goto nothingCondemned;
res = TraceStart(trace, mortality, trace->condemned * TraceWorkFactor);
/* We don't expect normal GC traces to fail to start. */
AVER(res == ResOK);
@ -333,11 +337,9 @@ Bool PolicyStartTrace(Trace *traceReturn, Arena arena)
} /* (dynamicDeferral > 0.0) */
return FALSE;
nothingCondemned:
failCondemn:
TraceDestroy(trace);
/* This is an unlikely case, but clear the emergency flag so the next attempt
starts normally. */
ArenaSetEmergency(arena, FALSE);
TraceDestroyInit(trace);
failStart:
return FALSE;
}
@ -364,37 +366,49 @@ Bool PolicyPoll(Arena arena)
* should return to the mutator.
*
* start is the clock time when the MPS was entered.
* tracedSize is the amount of work done by the last call to TracePoll.
* moreWork and tracedWork are the results of the last call to TracePoll.
*/
Bool PolicyPollAgain(Arena arena, Clock start, Size tracedSize)
Bool PolicyPollAgain(Arena arena, Clock start, Bool moreWork, Work tracedWork)
{
Bool moreTime;
Globals globals;
double nextPollThreshold;
AVERT(Arena, arena);
UNUSED(tracedWork);
if (ArenaEmergency(arena))
return TRUE;
/* Is there more work to do and more time to do it in? */
moreTime = (ClockNow() - start) < ArenaPauseTime(arena) * ClocksPerSec();
if (moreWork && moreTime)
return TRUE;
/* We're not going to do more work now, so calculate when to come back. */
globals = ArenaGlobals(arena);
UNUSED(start);
if (tracedSize == 0) {
/* No work was done. Sleep until NOW + a bit. */
nextPollThreshold = globals->fillMutatorSize + ArenaPollALLOCTIME;
} else {
if (moreWork) {
/* We did one quantum of work; consume one unit of 'time'. */
nextPollThreshold = globals->pollThreshold + ArenaPollALLOCTIME;
} else {
/* No more work to do. Sleep until NOW + a bit. */
nextPollThreshold = globals->fillMutatorSize + ArenaPollALLOCTIME;
}
/* Advance pollThreshold; check: enough precision? */
AVER(nextPollThreshold > globals->pollThreshold);
globals->pollThreshold = nextPollThreshold;
return PolicyPoll(arena);
return FALSE;
}
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2016 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2018 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

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