mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-27 16:51:06 -07:00
Code Issues Projects Releases Wiki Activity

Catch-up merge from master sources @185999 to branch/2014-04-17/describe.

Browse source 
Copied from Perforce
 Change: 186003
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Gareth Rees 2014-05-11 18:33:02 +01:00
commit 2b41ec58db
63 changed files with 570 additions and 482 deletions
Download patch file Download diff file Expand all files Collapse all files

4
mps/Makefile.in
View file

@ -1,7 +1,7 @@
# Makefile.in -- source for autoconf Makefile
#
# $Id$
# Copyright (C) 2012-2013 Ravenbrook Limited. See end of file for license.
# Copyright (C) 2012-2014 Ravenbrook Limited. See end of file for license.
#
# YOU DON'T NEED AUTOCONF TO BUILD THE MPS
# This is just here for people who want or expect a configure script.
@ -17,7 +17,7 @@ MPS_TARGET_NAME=@MPS_TARGET_NAME@
EXTRA_TARGETS=@EXTRA_TARGETS@
prefix=$(DESTDIR)@prefix@
TARGET_OPTS=-C code -f $(MPS_TARGET_NAME).gmk EXTRA_TARGETS="$(EXTRA_TARGETS)"
XCODEBUILD=xcodebuild -project code/mps.xcodeproj
XCODEBUILD=xcrun xcodebuild -project code/mps.xcodeproj
all: @BUILD_TARGET@

7
mps/code/airtest.c
View file

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

89
mps/code/amsss.c
View file

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

2
mps/code/arenacl.c
View file

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

2
mps/code/arenavm.c
View file

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

1
mps/code/arg.c
View file

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

3
mps/code/awlut.c
View file

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

3
mps/code/awluthe.c
View file

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

7
mps/code/buffer.c
View file

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

1
mps/code/cbs.c
View file

@ -80,6 +80,7 @@ Bool CBSCheck(CBS cbs)
}
ATTRIBUTE_UNUSED
static Bool CBSBlockCheck(CBSBlock block)
{
/* See .enter-leave.simple. */

1
mps/code/chain.h
View file

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

1
mps/code/clock.h
View file

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

11
mps/code/config.h
View file

@ -241,6 +241,15 @@
#define ATTRIBUTE_NORETURN
#endif
/* Attribute for functions that may be unused in some build configurations.
* GCC: <http://gcc.gnu.org/onlinedocs/gcc/Function-Attributes.html>
*/
#if defined(MPS_BUILD_GC) || defined(MPS_BUILD_LL)
#define ATTRIBUTE_UNUSED __attribute__((__unused__))
#else
#define ATTRIBUTE_UNUSED
#endif
/* EPVMDefaultSubsequentSegSIZE is a default for the alignment of
* subsequent segments (non-initial at each save level) in EPVM. See
@ -281,7 +290,7 @@
/* Pool AMS Configuration -- see <code/poolams.c> */
#define AMS_SUPPORT_AMBIGUOUS_DEFAULT FALSE
#define AMS_SUPPORT_AMBIGUOUS_DEFAULT TRUE
#define AMS_GEN_DEFAULT 0

104
mps/code/finaltest.c
View file

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

69
mps/code/fmtscheme.c
View file

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

26
mps/code/fmtscheme.h
View file

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

5
mps/code/freelist.c
View file

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

2
mps/code/global.c
View file

@ -1152,7 +1152,7 @@ void ArenaSetEmergency(Arena arena, Bool emergency)
AVERT(Arena, arena);
AVERT(Bool, emergency);
EVENT2(ArenaSetEmergency, arena, BOOL(emergency));
EVENT2(ArenaSetEmergency, arena, BOOLOF(emergency));
arena->emergency = emergency;
}

102
mps/code/locus.c
View file

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

4
mps/code/misc.h
View file

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

2
mps/code/mpm.h
View file

@ -923,8 +923,6 @@ extern void (ShieldFlush)(Arena arena);
extern void ProtSetup(void);
extern void ProtSet(Addr base, Addr limit, AccessSet mode);
extern void ProtTramp(void **resultReturn, void *(*f)(void *, size_t),
void *p, size_t s);
extern void ProtSync(Arena arena);
extern Bool ProtCanStepInstruction(MutatorFaultContext context);
extern Res ProtStepInstruction(MutatorFaultContext context);

19
mps/code/mps.h
View file

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

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

@ -2644,7 +2644,7 @@
22FACEE118880983000FDBC1 /* PBXTargetDependency */,
);
name = airtest;
productName = mv2test;
productName = airtest;
productReference = 22FACEED18880983000FDBC1 /* airtest */;
productType = "com.apple.product-type.tool";
};
@ -4322,42 +4322,42 @@
2231BB5618CA97D8002D6322 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locbwcss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
2231BB5718CA97D8002D6322 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locbwcss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
2231BB5818CA97D8002D6322 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locbwcss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
2231BB6418CA97DC002D6322 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locusss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
2231BB6518CA97DC002D6322 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locusss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
2231BB6618CA97DC002D6322 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = locusss;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -4421,7 +4421,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = "scheme-advanced";
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@ -4429,7 +4429,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = "scheme-advanced";
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@ -4437,41 +4437,35 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = "scheme-advanced";
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
22C2ACA118BE3FEC006B3677 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = mv2test;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
22C2ACAC18BE400A006B3677 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = YES;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES;
PRODUCT_NAME = nailboardtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
22C2ACAD18BE400A006B3677 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = NO;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = NO;
PRODUCT_NAME = nailboardtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
22C2ACAE18BE400A006B3677 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = NO;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = NO;
PRODUCT_NAME = nailboardtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -4492,21 +4486,21 @@
22F846BA18F437B900982BA7 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = lockut;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
22F846BB18F437B900982BA7 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = lockut;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
22F846BC18F437B900982BA7 /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
PRODUCT_NAME = lockut;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -4527,30 +4521,17 @@
22FACEEA18880983000FDBC1 /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = YES;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES;
PRODUCT_NAME = airtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
22FACEEB18880983000FDBC1 /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = NO;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = NO;
PRODUCT_NAME = airtest;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
22FACEEC18880983000FDBC1 /* WE */ = {
isa = XCBuildConfiguration;
buildSettings = {
GCC_GENERATE_TEST_COVERAGE_FILES = NO;
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = NO;
PRODUCT_NAME = airtest;
};
name = WE;
};
2D07B9751636FC9900DB751B /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
@ -4626,7 +4607,6 @@
3104AFF3156D37A0000A585A /* Debug */ = {
isa = XCBuildConfiguration;
buildSettings = {
COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
@ -4634,7 +4614,6 @@
3104AFF4156D37A0000A585A /* Release */ = {
isa = XCBuildConfiguration;
buildSettings = {
COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
@ -4923,7 +4902,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = djbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@ -4931,7 +4910,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = djbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@ -4991,7 +4970,6 @@
318DA8D51892C0D00089718C /* RASH */ = {
isa = XCBuildConfiguration;
buildSettings = {
COMBINE_HIDPI_IMAGES = YES;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
@ -5000,7 +4978,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@ -5285,7 +5262,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = djbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -5484,7 +5461,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@ -5494,7 +5470,6 @@
isa = XCBuildConfiguration;
buildSettings = {
ALWAYS_SEARCH_USER_PATHS = NO;
COMBINE_HIDPI_IMAGES = YES;
EXECUTABLE_PREFIX = lib;
PRODUCT_NAME = "$(TARGET_NAME)";
};
@ -5534,7 +5509,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = gcbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Debug;
};
@ -5542,7 +5517,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = gcbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = Release;
};
@ -5550,7 +5525,7 @@
isa = XCBuildConfiguration;
buildSettings = {
GCC_TREAT_WARNINGS_AS_ERRORS = NO;
PRODUCT_NAME = gcbench;
PRODUCT_NAME = "$(TARGET_NAME)";
};
name = RASH;
};
@ -5672,7 +5647,6 @@
buildConfigurations = (
22FACEEA18880983000FDBC1 /* Debug */,
22FACEEB18880983000FDBC1 /* Release */,
22FACEEC18880983000FDBC1 /* WE */,
22C2ACA118BE3FEC006B3677 /* RASH */,
);
defaultConfigurationIsVisible = 0;

21
mps/code/mpsi.c
View file

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

5
mps/code/poolamc.c
View file

@ -96,6 +96,7 @@ typedef struct amcSegStruct {
#define amcSeg2Seg(amcseg) ((Seg)(amcseg))
ATTRIBUTE_UNUSED
static Bool amcSegCheck(amcSeg amcseg)
{
CHECKS(amcSeg, amcseg);
@ -476,6 +477,7 @@ typedef struct AMCStruct { /* <design/poolamc/#struct> */
/* amcGenCheck -- check consistency of a generation structure */
ATTRIBUTE_UNUSED
static Bool amcGenCheck(amcGen gen)
{
Arena arena;
@ -525,6 +527,7 @@ typedef struct amcBufStruct {
/* amcBufCheck -- check consistency of an amcBuf */
ATTRIBUTE_UNUSED
static Bool amcBufCheck(amcBuf amcbuf)
{
CHECKS(amcBuf, amcbuf);
@ -2442,6 +2445,8 @@ void mps_amc_apply(mps_pool_t mps_pool,
*
* See <design/poolamc/#check>.
*/
ATTRIBUTE_UNUSED
static Bool AMCCheck(AMC amc)
{
CHECKS(AMC, amc);

2
mps/code/poolams.c
View file

@ -172,7 +172,7 @@ static Res amsCreateTables(AMS ams, BT *allocReturn,
goto failWhite;
}
#if defined(AVER_AND_CHECK)
#if defined(AVER_AND_CHECK_ALL)
/* Invalidate the colour tables in checking varieties. The algorithm
* is designed not to depend on the initial values of these tables,
* so by invalidating them we get some checking of this.

2
mps/code/poolawl.c
View file

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

3
mps/code/poollo.c
View file

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

2
mps/code/poolmfs.c
View file

@ -136,7 +136,7 @@ static Res MFSInit(Pool pool, ArgList args)
mfs->sig = MFSSig;
AVERT(MFS, mfs);
EVENT5(PoolInitMFS, pool, arena, extendBy, BOOL(extendSelf), unitSize);
EVENT5(PoolInitMFS, pool, arena, extendBy, BOOLOF(extendSelf), unitSize);
return ResOK;
}

4
mps/code/poolmrg.c
View file

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

2
mps/code/poolmv.c
View file

@ -72,6 +72,7 @@ typedef struct MVBlockStruct {
/* MVBlockCheck -- check the consistency of a block structure */
ATTRIBUTE_UNUSED
static Bool MVBlockCheck(MVBlock block)
{
AVER(block != NULL);
@ -130,6 +131,7 @@ typedef struct MVSpanStruct {
/* MVSpanCheck -- check the consistency of a span structure */
ATTRIBUTE_UNUSED
static Bool MVSpanCheck(MVSpan span)
{
Addr addr, base, limit;

1
mps/code/poolmv2.c
View file

@ -356,6 +356,7 @@ failCBS:
/* MVTCheck -- validate an MVT Pool */
ATTRIBUTE_UNUSED
static Bool MVTCheck(MVT mvt)
{
CHECKS(MVT, mvt);

3
mps/code/poolmvff.c
View file

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

3
mps/code/poolsnc.c
View file

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

17
mps/code/protan.c
View file

@ -1,7 +1,7 @@
/* protan.c: ANSI MEMORY PROTECTION
*
* $Id$
* Copyright (c) 2001 Ravenbrook Limited. See end of file for license.
* Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license.
*
*
* DESIGN
@ -65,22 +65,9 @@ void ProtSync(Arena arena)
}
/* ProtTramp -- protection trampoline */
void ProtTramp(void **rReturn, void *(*f)(void *, size_t),
void *p, size_t s)
{
AVER(rReturn != NULL);
AVER(FUNCHECK(f));
/* Can't check p and s as they are interpreted by the client */
*(rReturn) = (*(f))(p, s);
}
/* C. COPYRIGHT AND LICENSE
*
* Copyright (C) 2001-2002 Ravenbrook Limited <http://www.ravenbrook.com/>.
* Copyright (C) 2001-2014 Ravenbrook Limited <http://www.ravenbrook.com/>.
* All rights reserved. This is an open source license. Contact
* Ravenbrook for commercial licensing options.
*

23
mps/code/protix.c
View file

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

22
mps/code/protw3.c
View file

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

1
mps/code/reserv.c
View file

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

1
mps/code/sac.c
View file

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

29
mps/code/seg.c
View file

@ -595,7 +595,7 @@ Res SegMerge(Seg *mergedSegReturn, Seg segLo, Seg segHi,
if (ResOK != res)
goto failMerge;
EVENT3(SegMerge, segLo, segHi, BOOL(withReservoirPermit));
EVENT3(SegMerge, segLo, segHi, BOOLOF(withReservoirPermit));
/* Deallocate segHi object */
ControlFree(arena, segHi, class->size);
AVERT(Seg, segLo);
@ -680,10 +680,8 @@ failControl:
Bool SegCheck(Seg seg)
{
Tract tract;
Arena arena;
Pool pool;
Addr addr;
Size align;
CHECKS(Seg, seg);
@ -702,16 +700,25 @@ Bool SegCheck(Seg seg)
CHECKL(AddrIsAligned(seg->limit, align));
CHECKL(seg->limit > TractBase(seg->firstTract));
/* Each tract of the segment must agree about white traces */
TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, seg->limit) {
Seg trseg = NULL; /* suppress compiler warning */
/* Each tract of the segment must agree about white traces. Note
* that even if the CHECKs are compiled away there is still a
* significant cost in looping over the tracts, hence the guard. See
* job003778. */
#if defined(AVER_AND_CHECK_ALL)
{
Tract tract;
Addr addr;
TRACT_TRACT_FOR(tract, addr, arena, seg->firstTract, seg->limit) {
Seg trseg = NULL; /* suppress compiler warning */
CHECKD_NOSIG(Tract, tract);
CHECKL(TRACT_SEG(&trseg, tract) && (trseg == seg));
CHECKL(TractWhite(tract) == seg->white);
CHECKL(TractPool(tract) == pool);
CHECKD_NOSIG(Tract, tract);
CHECKL(TRACT_SEG(&trseg, tract) && (trseg == seg));
CHECKL(TractWhite(tract) == seg->white);
CHECKL(TractPool(tract) == pool);
}
CHECKL(addr == seg->limit);
}
CHECKL(addr == seg->limit);
#endif /* AVER_AND_CHECK_ALL */
/* The segment must belong to some pool, so it should be on a */
/* pool's segment ring. (Actually, this isn't true just after */

2
mps/code/segsmss.c
View file

@ -59,6 +59,7 @@ typedef struct AMSTStruct *AMST;
/* AMSTCheck -- the check method for an AMST */
ATTRIBUTE_UNUSED
static Bool AMSTCheck(AMST amst)
{
CHECKS(AMST, amst);
@ -96,6 +97,7 @@ typedef struct AMSTSegStruct {
/* AMSTSegCheck -- check the AMST segment */
ATTRIBUTE_UNUSED
static Bool AMSTSegCheck(AMSTSeg amstseg)
{
CHECKS(AMSTSeg, amstseg);

47
mps/code/trace.c
View file

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

2
mps/code/walk.c
View file

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

4
mps/design/prot.txt
View file

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

5
mps/design/protli.txt
View file

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

5
mps/design/protsu.txt
View file

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

2
mps/design/range.txt
View file

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

45
mps/design/type.txt
View file

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

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

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

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

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

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

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

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

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

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

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

25
mps/manual/source/topic/collection.rst
View file

@ -57,9 +57,9 @@ Create a generation chain by preparing an array of
kilobytes) and *predicted mortality* (between 0 and 1) of each
generation, and passing them to :c:func:`mps_chain_create`.
When the size of the generation exceeds the capacity, the MPS will be
prepared to start collecting the generation. See
:ref:`topic-collection-schedule` below.
When the *new size* of a generation exceeds its capacity, the MPS will
be prepared to start collecting the chain to which the generation
belongs. See :ref:`topic-collection-schedule` below.
For example::
@ -163,20 +163,19 @@ size* of each generation (other than the topmost) is the same as its
total size, but in pools like :ref:`pool-ams` where survivors do not
get promoted, the two sizes can be different.
The first generation in a pool's chain is the :term:`nursery space`.
When the nursery's *new size* exceeds its capacity, the MPS considers
collecting the pool. (How long it takes to get around to it depends on
which other collections on other pools are in progress.)
When a generation's *new size* exceeds its capacity, the MPS considers
collecting the chain to which the generation belongs. (How long it
takes to get around to it depends on which other collections are in
progress.)
.. note::
You can affect the decision as to when to collect the nursery
space by using the :ref:`ramp allocation pattern
<topic-pattern-ramp>`.
You can affect the decision as to when to collect the chain by
using the :ref:`ramp allocation pattern <topic-pattern-ramp>`.
If the MPS decides to collect a pool at all, all generations are
collected below the first generation whose *new size* is less than its
capacity.
If the MPS decides to collect a chain, all generations are collected
up to, and including, the highest generation whose *new size* exceeds
its capacity.
In pools such as :ref:`pool-amc`, blocks in generation *g* that
survive collection get promoted to generation *g*\+1. If the last

26
mps/manual/source/topic/error.rst
View file

@ -232,13 +232,6 @@ assertion that is listed here but for which you discovered a different
cause), please :ref:`let us know <contact>` so that we can improve
this documentation.
``sa.c: BTIsResRange(sa->mapped, 0, sa->length)``
The client program called :c:func:`mps_arena_destroy` without
having destroyed all pools in that arena first. (The assertion is
from the virtual memory manager which is checking that all pages
have been unmapped.)
``dbgpool.c: fencepost check on free``
@ -293,6 +286,25 @@ this documentation.
condition?
``ring.c: ring->next == ring``
The client program destroyed an object without having destroyed
all the objects that it owns first. For example, it destroyed an
arena without first destroying all pools in that arena, or it
destroyed a pool without first destroying all allocation points
created on that pool.
``trace.c: RefSetSub(ScanStateUnfixedSummary(ss), SegSummary(seg))``
The client program's :term:`scan method` failed to update a
reference to an object that moved. See
:ref:`topic-scanning-protocol`, which says, "If :c:func:`MPS_FIX2`
returns :c:macro:`MPS_RES_OK`, it may have updated the reference.
If necessary, make sure that the updated reference is stored back
to the region being scanned."
.. index::
single: error handling; varieties
single: variety

21
mps/manual/source/topic/finalization.rst
View file

@ -85,6 +85,15 @@ calling :c:func:`mps_message_discard`.
will cause it to be finalized again should all strong references
disappear again.
.. note::
Calling :c:func:`mps_message_discard` does not reclaim the space
occupied by the finalized block (that happens at the next
collection, if the block is found to be dead at that point), and
so the block must remain validly formatted (:term:`scannable <scan
method>`, :term:`skippable <skip method>`, and so on). It might
make sense to replace it with a :term:`padding object`.
See :ref:`topic-message` for details of the message mechanism.
@ -123,12 +132,12 @@ Cautions
finalization. The MPS does not finalize a block until it
determines that the block is finalizable, which may require a full
garbage collection in the worst case, and such a collection may
not :ref:`scheduled <topic-collection-schedule>` for some time. Or
the block may never become finalizable because it is incorrectly
determined to be reachable due to an :term:`ambiguous reference`
pointing to it. Or the block may never become finalizable because
it remains reachable through a reference, even if that reference
might never be used.
not be :ref:`scheduled <topic-collection-schedule>` for some time.
Or the block may never become finalizable because it is
incorrectly determined to be reachable due to an :term:`ambiguous
reference` pointing to it. Or the block may never become
finalizable because it remains reachable through a reference, even
if that reference might never be used.
#. Even when blocks are finalized in a reasonably timely fashion, the
client needs to process the finalization messages in time to avoid

2
mps/manual/source/topic/interface.rst
View file

@ -226,7 +226,7 @@ Macros
implemented as a macro defined in the header, so a library
function should not be declared explicitly if its header is
included. Any macro definition of a function can be suppressed
locally be enclosing the name of the function in parentheses,
locally by enclosing the name of the function in parentheses,
because the name is then not followed by the left parenthesis
that indicates expansion of a macro function name. [...] Any
invocation of a library function that is implemented as a

16
mps/manual/source/topic/pattern.rst
View file

@ -110,10 +110,22 @@ cutoff and decline in the live size.
This pattern is useful if you are building a structure that involves
temporarily allocating much more memory than will fit into your
:term:`nursery generation`. The ramp allocation pattern causes the
collection of the nursery generation to be deferred until the ramp
:term:`nursery generation`. By applying the ramp allocation pattern,
the collection of that generation can be deferred until the ramp
allocation is over.
In detail: if the ramp allocation pattern is applied to an
:term:`allocation point`, then allocation on that AP is ignored by the
MPS when it is deciding whether to schedule a collection of the chain
containing the generation into which the AP is allocating. See :ref:`topic-collection-schedule`.
.. note::
This does not prevent the generation from being collected
altogether: there may be other APs allocating into the generation,
or the MPS may have to collect the generation in order to avoid
running out of memory.
.. note::
Ramp allocation is only supported by :ref:`pool-amc`.

6
mps/procedure/release-build.rst
View file

@ -47,7 +47,7 @@ All relative paths are relative to
1.111.0), where *VERSION* is the number of the version you’re
releasing, and *N* is the first unused release number (starting at
zero). Look in the index of releases (``release/index.html``) for
existing release numbers for your version::
existing release numbers for your version. ::
VERSION=A.BBB
RELEASE=$VERSION.N
@ -111,7 +111,7 @@ Run the script ``tool/release``, passing the options:
* ``-P mps`` — project name
* ``-b BRANCH`` — branch to make the release from: for example ``version/1.113``
* ``-C CHANGELEVEL`` — changelevel at which to make the release
* ``-d "DESCRIPTION"`` — changelevel at which to make the release
* ``-d "DESCRIPTION"`` — description of the release
* ``-y`` — yes, really make the release
If omitted, the project and branch are deduced from the current
@ -231,8 +231,6 @@ A. References
Ravenbrook Limited; 2008-10-16;
http://info.ravenbrook.com/mail/2008/10/16/13-08-20/0.txt
.. [Sphinx] "Sphinx: Python document generator"; http://sphinx-doc.org/
B. Document History
-------------------

6
mps/tool/branch
View file

@ -46,10 +46,10 @@ CHILD_RE = r'(?:{}|{})$'.format(TASK_BRANCH_RE, VERSION_BRANCH_RE)
TASK_BRANCH_ENTRY = '''
<tr valign="top">
<td><code><a href="{child}/">{date}/{task}</a></code></td>
<td><code><a href="{date}/{task}/">{date}/{task}</a></code></td>
<td><a href="https://info.ravenbrook.com/infosys/cgi/perfbrowse.cgi?@changes+{depot}/project/{project}/{child}/...">Changes</a></td>
<td>{desc_html}</td>
<td>Active (<a href="https://info.ravenbrook.com/infosys/cgi/perfbrowse.cgi?@diff2+{depot}/project/{project}/{child}/...@{base}+{depot}/project/{project}/{child}/...">diffs</a>).</td>
<td><a href="https://info.ravenbrook.com/infosys/cgi/perfbrowse.cgi?@diff2+{depot}/project/{project}/{child}/...@{base}+{depot}/project/{project}/{child}/...">Diffs</a></td>
</tr>
'''
@ -154,7 +154,7 @@ def main(argv):
m = re.match(CHILD_RE, args.child)
if not m:
raise Error(fmt("Invalid child: {child}"))
if args.customer != m.group(3):
if not args.task and args.customer != m.group(3):
raise Error(fmt("Customer mismatch between {parent} and {child}."))
args.date, args.task, _, args.version = m.groups()

4
mps/tool/p4-bisect
View file

@ -130,7 +130,9 @@ def run(args):
exit(result)
def main(argv):
parser = argparse.ArgumentParser(prog='p4-bisect')
parser = argparse.ArgumentParser(
prog='p4-bisect', epilog='For help on CMD, use p4-bisect CMD -h')
parser.set_defaults(func=partial(help, parser))
subparsers = parser.add_subparsers()
a = subparsers.add_parser

6
mps/tool/testcoverage
View file

@ -26,14 +26,14 @@ case "$ARCH-$OS" in
CONFIGURATION=Debug
(
cd -- "$CODE"
xcodebuild -config "$CONFIGURATION" clean
xcodebuild -config "$CONFIGURATION" -target testrun \
xcrun xcodebuild -config "$CONFIGURATION" clean
xcrun xcodebuild -config "$CONFIGURATION" -target testrun \
GCC_GENERATE_TEST_COVERAGE_FILES=YES \
GCC_INSTRUMENT_PROGRAM_FLOW_ARCS=YES
)
(
cd -- "$CODE/xc/$PROJECT.build/$CONFIGURATION/$PROJECT.build/Objects-normal/$ARCH"
gcov mps.c 2> /dev/null
xcrun gcov mps.c 2> /dev/null
) | "$TOOL/gcovfmt"
;;
*)

21
mps/tool/testopendylan
View file

@ -20,8 +20,21 @@
# 2. CONFIGURATION
# MPS sources we are testing against
MPS=$(cd -- "$(dirname "$0")/.." && pwd)
# Check command-line argument
GC=$1
case "$GC" in
mps)
# MPS sources we are testing against
CONFIGURE=--with-gc-path=$(cd -- "$(dirname "$0")/.." && pwd)
;;
boehm)
CONFIGURE=
;;
*)
echo "Backend '$GC' not supported: choose mps or boehm."
exit 1
esac
# OpenDylan version for bootstrapping
VERSION=2013.2
@ -30,7 +43,7 @@ VERSION=2013.2
REMOTE=https://github.com/dylan-lang/opendylan.git
# Directory to put everything in
TESTDIR="$PWD/.test"
TESTDIR="$PWD/.test/$GC"
mkdir -p -- "$TESTDIR"
cd -- "$TESTDIR"
@ -104,7 +117,7 @@ if [ -f "$REPO/Makefile" ]; then
else (
cd -- "$REPO" &&
./autogen.sh &&
./configure --with-gc=mps --with-gc-path="$MPS" --prefix="$PREFIX"
./configure --with-gc="$GC" --prefix="$PREFIX" $CONFIGURE
) fi
(
cd -- "$REPO" &&