diff --git a/mps/code/.p4ignore b/mps/code/.p4ignore index 6cb34b80f0c..7db90ebb062 100644 --- a/mps/code/.p4ignore +++ b/mps/code/.p4ignore @@ -5,7 +5,9 @@ anangc ananll ananmv fri3gc +fri3ll fri6gc +fri6ll lii3gc lii6gc lii6ll @@ -49,3 +51,5 @@ tags 9 # Mac OS X Finder turds .DS_Store +# Emacs backups +*~ diff --git a/mps/code/airtest.c b/mps/code/airtest.c index c262cb31268..ad0ec456b99 100644 --- a/mps/code/airtest.c +++ b/mps/code/airtest.c @@ -127,8 +127,7 @@ static void test_main(void *marker, int interior, int stack) error("Couldn't register thread"); if (stack) { - res = mps_root_create_reg(®_root, scheme_arena, mps_rank_ambig(), 0, - thread, mps_stack_scan_ambig, marker, 0); + res = mps_root_create_thread(®_root, scheme_arena, thread, marker); if (res != MPS_RES_OK) error("Couldn't create root"); } diff --git a/mps/code/amcss.c b/mps/code/amcss.c index 294ce224b15..9888f9150f6 100644 --- a/mps/code/amcss.c +++ b/mps/code/amcss.c @@ -41,6 +41,7 @@ static mps_gen_param_s testChain[genCOUNT] = { #define objNULL ((mps_addr_t)MPS_WORD_CONST(0xDECEA5ED)) +static mps_arena_t arena; static mps_ap_t ap; static mps_addr_t exactRoots[exactRootsCOUNT]; static mps_addr_t ambigRoots[ambigRootsCOUNT]; @@ -51,7 +52,7 @@ static unsigned long nCollsDone; /* report -- report statistics from any messages */ -static void report(mps_arena_t arena) +static void report(void) { mps_message_type_t type; @@ -103,8 +104,10 @@ static mps_addr_t make(size_t rootsCount) do { MPS_RESERVE_BLOCK(res, p, ap, size); - if (res) + if (res) { + ArenaDescribe(arena, mps_lib_get_stderr(), 4); die(res, "MPS_RESERVE_BLOCK"); + } res = dylan_init(p, size, exactRoots, rootsCount); if (res) die(res, "dylan_init"); @@ -127,8 +130,7 @@ static void test_stepper(mps_addr_t object, mps_fmt_t fmt, mps_pool_t pool, /* test -- the body of the test */ -static void test(mps_arena_t arena, mps_pool_class_t pool_class, - size_t roots_count) +static void test(mps_pool_class_t pool_class, size_t roots_count) { mps_fmt_t format; mps_chain_t chain; @@ -180,7 +182,7 @@ static void test(mps_arena_t arena, mps_pool_class_t pool_class, while (collections < collectionsCOUNT) { size_t r; - report(arena); + report(); if (collections != nCollsStart) { if (!described) { die(ArenaDescribe(arena, mps_lib_get_stdout(), 0), "ArenaDescribe"); @@ -276,7 +278,7 @@ static void test(mps_arena_t arena, mps_pool_class_t pool_class, *(int*)busy_init = -1; /* check that the buffer is still there */ if (objs % 1024 == 0) { - report(arena); + report(); putchar('.'); (void)fflush(stdout); } @@ -299,7 +301,6 @@ static void test(mps_arena_t arena, mps_pool_class_t pool_class, int main(int argc, char *argv[]) { size_t i, grainSize; - mps_arena_t arena; mps_thr_t thread; testlib_init(argc, argv); @@ -312,16 +313,15 @@ int main(int argc, char *argv[]) MPS_ARGS_BEGIN(args) { MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, scale * testArenaSIZE); MPS_ARGS_ADD(args, MPS_KEY_ARENA_GRAIN_SIZE, grainSize); - MPS_ARGS_ADD(args, MPS_KEY_COMMIT_LIMIT, scale * 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()); mps_message_type_enable(arena, mps_message_type_gc_start()); die(mps_thread_reg(&thread, arena), "thread_reg"); - test(arena, mps_class_amc(), exactRootsCOUNT); - test(arena, mps_class_amcz(), 0); + test(mps_class_amc(), exactRootsCOUNT); + test(mps_class_amcz(), 0); mps_thread_dereg(thread); - report(arena); + report(); mps_arena_destroy(arena); printf("%s: Conclusion: Failed to find any defects.\n", argv[0]); diff --git a/mps/code/amcsshe.c b/mps/code/amcsshe.c index bd3ea73d068..a01354193cc 100644 --- a/mps/code/amcsshe.c +++ b/mps/code/amcsshe.c @@ -251,7 +251,6 @@ int main(int argc, char *argv[]) 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)); - MPS_ARGS_ADD(args, MPS_KEY_COMMIT_LIMIT, 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()); diff --git a/mps/code/amcssth.c b/mps/code/amcssth.c index 3eea28df075..596d818bc0b 100644 --- a/mps/code/amcssth.c +++ b/mps/code/amcssth.c @@ -139,8 +139,8 @@ static void *kid_thread(void *arg) closure_t cl = arg; die(mps_thread_reg(&thread, (mps_arena_t)arena), "thread_reg"); - die(mps_root_create_reg(®_root, arena, mps_rank_ambig(), 0, thread, - mps_stack_scan_ambig, marker, 0), "root_create"); + die(mps_root_create_thread(®_root, arena, thread, marker), + "root_create"); die(mps_ap_create(&ap, cl->pool, mps_rank_exact()), "BufferCreate(fooey)"); while(mps_collections(arena) < collectionsCOUNT) { @@ -316,8 +316,8 @@ static void test_arena(int mode) &ambigRoots[0], ambigRootsCOUNT), "root_create_table(ambig)"); die(mps_thread_reg(&thread, arena), "thread_reg"); - die(mps_root_create_reg(®_root, arena, mps_rank_ambig(), 0, thread, - mps_stack_scan_ambig, marker, 0), "root_create"); + die(mps_root_create_thread(®_root, arena, thread, marker), + "root_create"); die(mps_pool_create(&amc_pool, arena, mps_class_amc(), format, chain), "pool_create(amc)"); diff --git a/mps/code/amsss.c b/mps/code/amsss.c index 223bd205aea..8083123f482 100644 --- a/mps/code/amsss.c +++ b/mps/code/amsss.c @@ -209,7 +209,6 @@ int main(int argc, char *argv[]) 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)); - 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); diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c index f5666a1e7e6..9a0f43202f7 100644 --- a/mps/code/arenavm.c +++ b/mps/code/arenavm.c @@ -744,8 +744,8 @@ static Res VMArenaGrow(Arena arena, LocusPref pref, Size size) vmArenaGrow_Done: EVENT2(vmArenaExtendDone, chunkSize, ArenaReserved(VMArena2Arena(vmArena))); vmArena->extended(VMArena2Arena(vmArena), - newChunk->base, - AddrOffset(newChunk->base, newChunk->limit)); + newChunk->base, + AddrOffset(newChunk->base, newChunk->limit)); return res; } diff --git a/mps/code/awlut.c b/mps/code/awlut.c index 464a2dba91f..e31e157c14c 100644 --- a/mps/code/awlut.c +++ b/mps/code/awlut.c @@ -267,8 +267,7 @@ static void *setup(void *v, size_t s) arena = guff->arena; thr = guff->thr; - die(mps_root_create_reg(&stack, arena, mps_rank_ambig(), 0, thr, - mps_stack_scan_ambig, v, 0), + die(mps_root_create_thread(&stack, arena, thr, v), "Root Create\n"); die(mps_fmt_create_A(&dylanfmt, arena, dylan_fmt_A()), "Format Create\n"); diff --git a/mps/code/awluthe.c b/mps/code/awluthe.c index 6ea468977f1..a6653a3e23b 100644 --- a/mps/code/awluthe.c +++ b/mps/code/awluthe.c @@ -271,8 +271,7 @@ static void *setup(void *v, size_t s) arena = guff->arena; thr = guff->thr; - die(mps_root_create_reg(&stack, arena, mps_rank_ambig(), 0, thr, - mps_stack_scan_ambig, v, 0), + die(mps_root_create_thread(&stack, arena, thr, v), "Root Create\n"); die(EnsureHeaderFormat(&dylanfmt, arena), "EnsureHeaderFormat"); die(EnsureHeaderWeakFormat(&dylanweakfmt, arena), "EnsureHeaderWeakFormat"); diff --git a/mps/code/awlutth.c b/mps/code/awlutth.c index 2bfaddc3813..97d2c3f6a0f 100644 --- a/mps/code/awlutth.c +++ b/mps/code/awlutth.c @@ -254,8 +254,7 @@ static void *setup(void *v, size_t s) arena = guff->arena; thr = guff->thr; - die(mps_root_create_reg(&stack, arena, mps_rank_ambig(), 0, thr, - mps_stack_scan_ambig, v, 0), + die(mps_root_create_thread(&stack, arena, thr, v), "Root Create\n"); die(mps_fmt_create_A(&dylanfmt, arena, dylan_fmt_A()), "Format Create\n"); diff --git a/mps/code/clock.h b/mps/code/clock.h index 3bf2a6deed1..ec8ccc2bb80 100644 --- a/mps/code/clock.h +++ b/mps/code/clock.h @@ -1,7 +1,9 @@ /* clock.h -- Fast clocks and timers * - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * $Id$ + * + * .design: . */ #ifndef clock_h @@ -176,7 +178,7 @@ typedef mps_clock_t EventClock; /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk index dbd11f70d3b..e5af99266ae 100644 --- a/mps/code/comm.gmk +++ b/mps/code/comm.gmk @@ -3,7 +3,7 @@ # comm.gmk: COMMON GNUMAKEFILE FRAGMENT # # $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 # @@ -148,7 +148,7 @@ ARFLAGS=rc$(ARFLAGSPFM) # platforms. AMC = poolamc.c -AMS = poolams.c poolamsi.c +AMS = poolams.c AWL = poolawl.c LO = poollo.c SNC = poolsnc.c @@ -201,6 +201,7 @@ MPMCOMMON = \ root.c \ sa.c \ sac.c \ + scan.c \ seg.c \ shield.c \ splay.c \ @@ -284,6 +285,7 @@ TEST_TARGETS=\ sacss \ segsmss \ steptest \ + tagtest \ teletest \ walkt0 \ zcoll \ @@ -317,10 +319,24 @@ $(addprefix $(PFM)/$(VARIETY)/,$(TEST_SUITES)): $(TEST_TARGETS) ../tool/testrun.sh -s "$(notdir $@)" "$(PFM)/$(VARIETY)" +# == 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 + +$(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) + + # These convenience targets allow one to type "make foo" to build target # foo in selected varieties (or none, for the latter rule). -$(ALL_TARGETS) $(TEST_SUITES): phony +$(ALL_TARGETS) $(TEST_SUITES) testmmqa: phony ifdef VARIETY $(MAKE) -f $(PFM).gmk TARGET=$@ variety else @@ -511,6 +527,9 @@ $(PFM)/$(VARIETY)/sacss: $(PFM)/$(VARIETY)/sacss.o \ $(PFM)/$(VARIETY)/segsmss: $(PFM)/$(VARIETY)/segsmss.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 @@ -662,7 +681,7 @@ find-puns: phony # C. COPYRIGHT AND LICENSE # -# Copyright (c) 2001-2014 Ravenbrook Limited . +# Copyright (c) 2001-2016 Ravenbrook Limited . # All rights reserved. This is an open source license. Contact # Ravenbrook for commercial licensing options. # diff --git a/mps/code/commpre.nmk b/mps/code/commpre.nmk index eaaa46c84a0..e3d2443fe21 100644 --- a/mps/code/commpre.nmk +++ b/mps/code/commpre.nmk @@ -1,7 +1,7 @@ # commpre.nmk: FIRST COMMON FRAGMENT FOR PLATFORMS USING NMAKE -*- makefile -*-1 # # $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 # @@ -146,6 +146,7 @@ MPMCOMMON=\ [mpm] \ [mpsi] \ [nailboard] \ + [policy] \ [pool] \ [poolabs] \ [poolmfs] \ @@ -160,6 +161,7 @@ MPMCOMMON=\ [root] \ [sa] \ [sac] \ + [scan] \ [seg] \ [shield] \ [splay] \ @@ -174,7 +176,7 @@ MPMCOMMON=\ [walk] PLINTH = [mpsliban] [mpsioan] AMC = [poolamc] -AMS = [poolams] [poolamsi] +AMS = [poolams] AWL = [poolawl] LO = [poollo] MVFF = [poolmvff] @@ -330,7 +332,7 @@ LIBFLAGSCOOL = # C. COPYRIGHT AND LICENSE # -# Copyright (C) 2001-2014 Ravenbrook Limited . +# Copyright (C) 2001-2016 Ravenbrook Limited . # All rights reserved. This is an open source license. Contact # Ravenbrook for commercial licensing options. # diff --git a/mps/code/fmtscheme.h b/mps/code/fmtscheme.h index 95a62a53cef..1149d9496a1 100644 --- a/mps/code/fmtscheme.h +++ b/mps/code/fmtscheme.h @@ -40,55 +40,55 @@ typedef struct type_s { } type_s; typedef struct pair_s { - type_t type; /* TYPE_PAIR */ - obj_t car, cdr; /* first and second projections */ + type_t type; /* TYPE_PAIR */ + obj_t car, cdr; /* first and second projections */ } pair_s; typedef struct symbol_s { - type_t type; /* TYPE_SYMBOL */ - size_t length; /* length of symbol string (excl. NUL) */ - char string[1]; /* symbol string, NUL terminated */ + type_t type; /* TYPE_SYMBOL */ + size_t length; /* length of symbol string (excl. NUL) */ + char string[1]; /* symbol string, NUL terminated */ } symbol_s; typedef struct integer_s { - type_t type; /* TYPE_INTEGER */ - long integer; /* the integer */ + type_t type; /* TYPE_INTEGER */ + long integer; /* the integer */ } integer_s; typedef struct special_s { - type_t type; /* TYPE_SPECIAL */ - char *name; /* printed representation, NUL terminated */ + type_t type; /* TYPE_SPECIAL */ + char *name; /* printed representation, NUL terminated */ } special_s; typedef struct operator_s { - type_t type; /* TYPE_OPERATOR */ - char *name; /* printed name, NUL terminated */ - entry_t entry; /* entry point -- see eval() */ - obj_t arguments, body; /* function arguments and code */ - obj_t env, op_env; /* closure environments */ + type_t type; /* TYPE_OPERATOR */ + char *name; /* printed name, NUL terminated */ + entry_t entry; /* entry point -- see eval() */ + obj_t arguments, body; /* function arguments and code */ + obj_t env, op_env; /* closure environments */ } operator_s; typedef struct string_s { - type_t type; /* TYPE_STRING */ - size_t length; /* number of chars in string */ - char string[1]; /* string, NUL terminated */ + type_t type; /* TYPE_STRING */ + size_t length; /* number of chars in string */ + char string[1]; /* string, NUL terminated */ } string_s; typedef struct port_s { - type_t type; /* TYPE_PORT */ - obj_t name; /* name of stream */ + type_t type; /* TYPE_PORT */ + obj_t name; /* name of stream */ FILE *stream; } port_s; typedef struct character_s { - type_t type; /* TYPE_CHARACTER */ - char c; /* the character */ + type_t type; /* TYPE_CHARACTER */ + char c; /* the character */ } character_s; typedef struct vector_s { - type_t type; /* TYPE_VECTOR */ - size_t length; /* number of elements */ - obj_t vector[1]; /* vector elements */ + type_t type; /* TYPE_VECTOR */ + size_t length; /* number of elements */ + obj_t vector[1]; /* vector elements */ } vector_s; typedef struct table_s { @@ -134,7 +134,7 @@ typedef struct pad_s { typedef union obj_u { - type_s type; /* one of TYPE_* */ + type_s type; /* one of TYPE_* */ pair_s pair; symbol_s symbol; integer_s integer; @@ -154,17 +154,17 @@ typedef union obj_u { /* structure macros */ -#define TYPE(obj) ((obj)->type.type) -#define CAR(obj) ((obj)->pair.car) -#define CDR(obj) ((obj)->pair.cdr) -#define CAAR(obj) CAR(CAR(obj)) -#define CADR(obj) CAR(CDR(obj)) -#define CDAR(obj) CDR(CAR(obj)) -#define CDDR(obj) CDR(CDR(obj)) -#define CADDR(obj) CAR(CDDR(obj)) -#define CDDDR(obj) CDR(CDDR(obj)) -#define CDDAR(obj) CDR(CDAR(obj)) -#define CADAR(obj) CAR(CDAR(obj)) +#define TYPE(obj) ((obj)->type.type) +#define CAR(obj) ((obj)->pair.car) +#define CDR(obj) ((obj)->pair.cdr) +#define CAAR(obj) CAR(CAR(obj)) +#define CADR(obj) CAR(CDR(obj)) +#define CDAR(obj) CDR(CAR(obj)) +#define CDDR(obj) CDR(CDR(obj)) +#define CADDR(obj) CAR(CDDR(obj)) +#define CDDDR(obj) CDR(CDDR(obj)) +#define CDDAR(obj) CDR(CDAR(obj)) +#define CADAR(obj) CAR(CDAR(obj)) extern obj_t scheme_make_bool(int condition); diff --git a/mps/code/format.c b/mps/code/format.c index 07a8319082a..26b3e4bb751 100644 --- a/mps/code/format.c +++ b/mps/code/format.c @@ -190,6 +190,36 @@ Arena FormatArena(Format format) } +/* FormatScan -- scan formatted objects for references + * + * This is a wrapper for formatted objects scanning functions, which + * should not otherwise be called directly from within the MPS. This + * function checks arguments and takes care of accounting for the + * scanned memory. + * + * c.f. TraceScanArea() + */ + +Res FormatScan(Format format, ScanState ss, Addr base, Addr limit) +{ + /* TODO: How critical are these? */ + AVERT_CRITICAL(Format, format); + AVERT_CRITICAL(ScanState, ss); + AVER_CRITICAL(base != NULL); + AVER_CRITICAL(limit != NULL); + AVER_CRITICAL(base < limit); + + /* TODO: EVENT here? */ + + /* scannedSize is accumulated whether or not format->scan succeeds, + so it's safe to accumulate now so that we can tail-call + format->scan. */ + ss->scannedSize += AddrOffset(base, limit); + + return format->scan(&ss->ss_s, base, limit); +} + + /* FormatDescribe -- describe a format */ Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth) diff --git a/mps/code/fri3ll.gmk b/mps/code/fri3ll.gmk new file mode 100644 index 00000000000..8801830e757 --- /dev/null +++ b/mps/code/fri3ll.gmk @@ -0,0 +1,71 @@ +# -*- makefile -*- +# +# fri3ll.gmk: BUILD FOR FreeBSD/i386/GCC PLATFORM +# +# $Id$ +# Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + +PFM = fri3ll + +MPMPF = \ + lockix.c \ + prmcan.c \ + prmci3fr.c \ + protix.c \ + protsgix.c \ + pthrdext.c \ + span.c \ + ssixi3.c \ + thix.c \ + vmix.c + +LIBS = -lm -pthread + +include ll.gmk + +# For SQLite3. +LINKFLAGS += -L/usr/local/lib +CFLAGSCOMPILER += -I/usr/local/include + +include comm.gmk + + +# C. COPYRIGHT AND LICENSE +# +# Copyright (C) 2001-2014 Ravenbrook Limited . +# All rights reserved. This is an open source license. Contact +# Ravenbrook for commercial licensing options. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are +# met: +# +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# 3. Redistributions in any form must be accompanied by information on how +# to obtain complete source code for this software and any accompanying +# software that uses this software. The source code must either be +# included in the distribution or be available for no more than the cost +# of distribution plus a nominal fee, and must be freely redistributable +# under reasonable conditions. For an executable file, complete source +# code means the source code for all modules it contains. It does not +# include source code for modules or files that typically accompany the +# major components of the operating system on which the executable file +# runs. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +# PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE +# COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/mps/code/fri6ll.gmk b/mps/code/fri6ll.gmk new file mode 100644 index 00000000000..6595410c9a3 --- /dev/null +++ b/mps/code/fri6ll.gmk @@ -0,0 +1,68 @@ +# -*- makefile -*- +# +# fri6ll.gmk: BUILD FOR FreeBSD/x86-64/GCC 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 + +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 + + +# C. COPYRIGHT AND LICENSE +# +# Copyright (C) 2001-2016 Ravenbrook Limited . +# All rights reserved. This is an open source license. Contact +# Ravenbrook for commercial licensing options. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are +# met: +# +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# +# 3. Redistributions in any form must be accompanied by information on how +# to obtain complete source code for this software and any accompanying +# software that uses this software. The source code must either be +# included in the distribution or be available for no more than the cost +# of distribution plus a nominal fee, and must be freely redistributable +# under reasonable conditions. For an executable file, complete source +# code means the source code for all modules it contains. It does not +# include source code for modules or files that typically accompany the +# major components of the operating system on which the executable file +# runs. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR +# PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE +# COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF +# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/mps/code/gcbench.c b/mps/code/gcbench.c index 6d7f3339667..8624637da4a 100644 --- a/mps/code/gcbench.c +++ b/mps/code/gcbench.c @@ -176,10 +176,8 @@ static void *start(void *p) { gcthread_t thread = p; void *marker; RESMUST(mps_thread_reg(&thread->mps_thread, arena)); - RESMUST(mps_root_create_reg(&thread->reg_root, arena, - mps_rank_ambig(), (mps_rm_t)0, - thread->mps_thread, &mps_stack_scan_ambig, - &marker, (size_t)0)); + RESMUST(mps_root_create_thread(&thread->reg_root, arena, + thread->mps_thread, &marker)); RESMUST(mps_ap_create_k(&thread->ap, pool, mps_args_none)); thread->fn(thread); mps_ap_destroy(thread->ap); diff --git a/mps/code/getopt.h b/mps/code/getopt.h index fb9c789d235..ca1ae21db87 100644 --- a/mps/code/getopt.h +++ b/mps/code/getopt.h @@ -6,8 +6,8 @@ * in the Memory Pool System test programs. */ -/* $NetBSD: getopt.h,v 1.4 2000/07/07 10:43:54 ad Exp $ */ -/* $FreeBSD: src/include/getopt.h,v 1.6.30.1.8.1 2012/03/03 06:15:13 kensmith Exp $ */ +/* $NetBSD: getopt.h,v 1.4 2000/07/07 10:43:54 ad Exp $ */ +/* $FreeBSD: src/include/getopt.h,v 1.6.30.1.8.1 2012/03/03 06:15:13 kensmith Exp $ */ /*- * Copyright (c) 2000 The NetBSD Foundation, Inc. @@ -57,33 +57,33 @@ #define optional_argument 2 struct option { - /* name of long option */ - const char *name; - /* - * one of no_argument, required_argument, and optional_argument: - * whether option takes an argument - */ - int has_arg; - /* if not NULL, set *flag to val when option found */ - int *flag; - /* if flag not NULL, value to set *flag to; else return value */ - int val; + /* name of long option */ + const char *name; + /* + * one of no_argument, required_argument, and optional_argument: + * whether option takes an argument + */ + int has_arg; + /* if not NULL, set *flag to val when option found */ + int *flag; + /* if flag not NULL, value to set *flag to; else return value */ + int val; }; -int getopt_long(int, char * const *, const char *, - const struct option *, int *); -int getopt_long_only(int, char * const *, const char *, - const struct option *, int *); +int getopt_long(int, char * const *, const char *, + const struct option *, int *); +int getopt_long_only(int, char * const *, const char *, + const struct option *, int *); #ifndef _GETOPT_DECLARED -#define _GETOPT_DECLARED -int getopt(int, char * const [], const char *); +#define _GETOPT_DECLARED +int getopt(int, char * const [], const char *); -extern char *optarg; /* getopt(3) external variables */ +extern char *optarg; /* getopt(3) external variables */ extern int optind, opterr, optopt; #endif #ifndef _OPTRESET_DECLARED -#define _OPTRESET_DECLARED -extern int optreset; /* getopt(3) external variable */ +#define _OPTRESET_DECLARED +extern int optreset; /* getopt(3) external variable */ #endif #endif /* !_GETOPT_H_ */ diff --git a/mps/code/getoptl.c b/mps/code/getoptl.c index cd09bb98990..3564362ed6d 100644 --- a/mps/code/getoptl.c +++ b/mps/code/getoptl.c @@ -6,8 +6,8 @@ * in the Memory Pool System test programs. */ -/* $OpenBSD: getopt_long.c,v 1.21 2006/09/22 17:22:05 millert Exp $ */ -/* $NetBSD: getopt_long.c,v 1.15 2002/01/31 22:43:40 tv Exp $ */ +/* $OpenBSD: getopt_long.c,v 1.21 2006/09/22 17:22:05 millert Exp $ */ +/* $NetBSD: getopt_long.c,v 1.15 2002/01/31 22:43:40 tv Exp $ */ /* * Copyright (c) 2002 Todd C. Miller @@ -73,38 +73,38 @@ #include #include -#define GNU_COMPATIBLE /* Be more compatible, configure's use us! */ +#define GNU_COMPATIBLE /* Be more compatible, configure's use us! */ -int opterr = 1; /* if error message should be printed */ -int optind = 1; /* index into parent argv vector */ -int optopt = '?'; /* character checked for validity */ -int optreset; /* reset getopt */ -char *optarg; /* argument associated with option */ +int opterr = 1; /* if error message should be printed */ +int optind = 1; /* index into parent argv vector */ +int optopt = '?'; /* character checked for validity */ +int optreset; /* reset getopt */ +char *optarg; /* argument associated with option */ -#define PRINT_ERROR ((opterr) && (*options != ':')) +#define PRINT_ERROR ((opterr) && (*options != ':')) -#define FLAG_PERMUTE 0x01 /* permute non-options to the end of argv */ -#define FLAG_ALLARGS 0x02 /* treat non-options as args to option "-1" */ -#define FLAG_LONGONLY 0x04 /* operate as getopt_long_only */ +#define FLAG_PERMUTE 0x01 /* permute non-options to the end of argv */ +#define FLAG_ALLARGS 0x02 /* treat non-options as args to option "-1" */ +#define FLAG_LONGONLY 0x04 /* operate as getopt_long_only */ /* return values */ -#define BADCH (int)'?' -#define BADARG ((*options == ':') ? (int)':' : (int)'?') -#define INORDER (int)1 +#define BADCH (int)'?' +#define BADARG ((*options == ':') ? (int)':' : (int)'?') +#define INORDER (int)1 -#define EMSG "" +#define EMSG "" #ifdef GNU_COMPATIBLE -#define NO_PREFIX (-1) -#define D_PREFIX 0 -#define DD_PREFIX 1 -#define W_PREFIX 2 +#define NO_PREFIX (-1) +#define D_PREFIX 0 +#define DD_PREFIX 1 +#define W_PREFIX 2 #endif static int getopt_internal(int, char * const *, const char *, - const struct option *, int *, int); + const struct option *, int *, int); static int parse_long_options(char * const *, const char *, - const struct option *, int *, int, int); + const struct option *, int *, int, int); static int gcd(int, int); static void permute_args(int, int, int, char * const *); @@ -136,7 +136,7 @@ static const char illoptstring[] = "unknown option -- %s"; static void warnx(const char *fmt, ...) { - va_list varargs; + va_list varargs; va_start(varargs, fmt); vfprintf(stderr, fmt, varargs); fputc('\n', stderr); @@ -149,16 +149,16 @@ warnx(const char *fmt, ...) static int gcd(int a, int b) { - int c; + int c; - c = a % b; - while (c != 0) { - a = b; - b = c; - c = a % b; - } + c = a % b; + while (c != 0) { + a = b; + b = c; + c = a % b; + } - return (b); + return (b); } /* @@ -168,427 +168,427 @@ gcd(int a, int b) */ static void permute_args(int panonopt_start, int panonopt_end, int opt_end, - char * const *nargv) + char * const *nargv) { - int cstart, cyclelen, i, j, ncycle, nnonopts, nopts, pos; - char *swap; + int cstart, cyclelen, i, j, ncycle, nnonopts, nopts, pos; + char *swap; - /* - * compute lengths of blocks and number and size of cycles - */ - nnonopts = panonopt_end - panonopt_start; - nopts = opt_end - panonopt_end; - ncycle = gcd(nnonopts, nopts); - cyclelen = (opt_end - panonopt_start) / ncycle; + /* + * compute lengths of blocks and number and size of cycles + */ + nnonopts = panonopt_end - panonopt_start; + nopts = opt_end - panonopt_end; + ncycle = gcd(nnonopts, nopts); + cyclelen = (opt_end - panonopt_start) / ncycle; - for (i = 0; i < ncycle; i++) { - cstart = panonopt_end+i; - pos = cstart; - for (j = 0; j < cyclelen; j++) { - if (pos >= panonopt_end) - pos -= nnonopts; - else - pos += nopts; - swap = nargv[pos]; - /* LINTED const cast */ - ((char **) nargv)[pos] = nargv[cstart]; - /* LINTED const cast */ - ((char **)nargv)[cstart] = swap; - } - } + for (i = 0; i < ncycle; i++) { + cstart = panonopt_end+i; + pos = cstart; + for (j = 0; j < cyclelen; j++) { + if (pos >= panonopt_end) + pos -= nnonopts; + else + pos += nopts; + swap = nargv[pos]; + /* LINTED const cast */ + ((char **) nargv)[pos] = nargv[cstart]; + /* LINTED const cast */ + ((char **)nargv)[cstart] = swap; + } + } } /* * parse_long_options -- - * Parse long options in argc/argv argument vector. + * Parse long options in argc/argv argument vector. * Returns -1 if short_too is set and the option does not match long_options. */ static int parse_long_options(char * const *nargv, const char *options, - const struct option *long_options, int *idx, int short_too, int flags) + const struct option *long_options, int *idx, int short_too, int flags) { - char *current_argv, *has_equal; + char *current_argv, *has_equal; #ifdef GNU_COMPATIBLE - const char *current_dash; + const char *current_dash; #endif - size_t current_argv_len; - int i, match, exact_match, second_partial_match; + size_t current_argv_len; + int i, match, exact_match, second_partial_match; - current_argv = place; + current_argv = place; #ifdef GNU_COMPATIBLE - switch (dash_prefix) { - case D_PREFIX: - current_dash = "-"; - break; - case DD_PREFIX: - current_dash = "--"; - break; - case W_PREFIX: - current_dash = "-W "; - break; - default: - current_dash = ""; - break; - } + switch (dash_prefix) { + case D_PREFIX: + current_dash = "-"; + break; + case DD_PREFIX: + current_dash = "--"; + break; + case W_PREFIX: + current_dash = "-W "; + break; + default: + current_dash = ""; + break; + } #endif - match = -1; - exact_match = 0; - second_partial_match = 0; + match = -1; + exact_match = 0; + second_partial_match = 0; - optind++; + optind++; - if ((has_equal = strchr(current_argv, '=')) != NULL) { - /* argument found (--option=arg) */ + if ((has_equal = strchr(current_argv, '=')) != NULL) { + /* argument found (--option=arg) */ assert(has_equal > current_argv); - current_argv_len = (size_t)(has_equal - current_argv); - has_equal++; - } else - current_argv_len = strlen(current_argv); + current_argv_len = (size_t)(has_equal - current_argv); + has_equal++; + } else + current_argv_len = strlen(current_argv); - for (i = 0; long_options[i].name; i++) { - /* find matching long option */ - if (strncmp(current_argv, long_options[i].name, - current_argv_len)) - continue; + for (i = 0; long_options[i].name; i++) { + /* find matching long option */ + if (strncmp(current_argv, long_options[i].name, + current_argv_len)) + continue; - if (strlen(long_options[i].name) == current_argv_len) { - /* exact match */ - match = i; - exact_match = 1; - break; - } - /* - * If this is a known short option, don't allow - * a partial match of a single character. - */ - if (short_too && current_argv_len == 1) - continue; + if (strlen(long_options[i].name) == current_argv_len) { + /* exact match */ + match = i; + exact_match = 1; + break; + } + /* + * If this is a known short option, don't allow + * a partial match of a single character. + */ + if (short_too && current_argv_len == 1) + continue; - if (match == -1) /* first partial match */ - match = i; - else if ((flags & FLAG_LONGONLY) || - long_options[i].has_arg != - long_options[match].has_arg || - long_options[i].flag != long_options[match].flag || - long_options[i].val != long_options[match].val) - second_partial_match = 1; - } - if (!exact_match && second_partial_match) { - /* ambiguous abbreviation */ - if (PRINT_ERROR) - fprintf(stderr, + if (match == -1) /* first partial match */ + match = i; + else if ((flags & FLAG_LONGONLY) || + long_options[i].has_arg != + long_options[match].has_arg || + long_options[i].flag != long_options[match].flag || + long_options[i].val != long_options[match].val) + second_partial_match = 1; + } + if (!exact_match && second_partial_match) { + /* ambiguous abbreviation */ + if (PRINT_ERROR) + fprintf(stderr, ambig, #ifdef GNU_COMPATIBLE - current_dash, + current_dash, #endif - (int)current_argv_len, - current_argv); - optopt = 0; - return (BADCH); - } - if (match != -1) { /* option found */ - if (long_options[match].has_arg == no_argument - && has_equal) { - if (PRINT_ERROR) - warnx(noarg, + (int)current_argv_len, + current_argv); + optopt = 0; + return (BADCH); + } + if (match != -1) { /* option found */ + if (long_options[match].has_arg == no_argument + && has_equal) { + if (PRINT_ERROR) + warnx(noarg, #ifdef GNU_COMPATIBLE - current_dash, + current_dash, #endif - (int)current_argv_len, - current_argv); - /* - * XXX: GNU sets optopt to val regardless of flag - */ - if (long_options[match].flag == NULL) - optopt = long_options[match].val; - else - optopt = 0; + (int)current_argv_len, + current_argv); + /* + * XXX: GNU sets optopt to val regardless of flag + */ + if (long_options[match].flag == NULL) + optopt = long_options[match].val; + else + optopt = 0; #ifdef GNU_COMPATIBLE - return (BADCH); + return (BADCH); #else - return (BADARG); + return (BADARG); #endif - } - if (long_options[match].has_arg == required_argument || - long_options[match].has_arg == optional_argument) { - if (has_equal) - optarg = has_equal; - else if (long_options[match].has_arg == - required_argument) { - /* - * optional argument doesn't use next nargv - */ - optarg = nargv[optind++]; - } - } - if ((long_options[match].has_arg == required_argument) - && (optarg == NULL)) { - /* - * Missing argument; leading ':' indicates no error - * should be generated. - */ - if (PRINT_ERROR) - warnx(recargstring, + } + if (long_options[match].has_arg == required_argument || + long_options[match].has_arg == optional_argument) { + if (has_equal) + optarg = has_equal; + else if (long_options[match].has_arg == + required_argument) { + /* + * optional argument doesn't use next nargv + */ + optarg = nargv[optind++]; + } + } + if ((long_options[match].has_arg == required_argument) + && (optarg == NULL)) { + /* + * Missing argument; leading ':' indicates no error + * should be generated. + */ + if (PRINT_ERROR) + warnx(recargstring, #ifdef GNU_COMPATIBLE - current_dash, + current_dash, #endif - current_argv); - /* - * XXX: GNU sets optopt to val regardless of flag - */ - if (long_options[match].flag == NULL) - optopt = long_options[match].val; - else - optopt = 0; - --optind; - return (BADARG); - } - } else { /* unknown option */ - if (short_too) { - --optind; - return (-1); - } - if (PRINT_ERROR) - warnx(illoptstring, + current_argv); + /* + * XXX: GNU sets optopt to val regardless of flag + */ + if (long_options[match].flag == NULL) + optopt = long_options[match].val; + else + optopt = 0; + --optind; + return (BADARG); + } + } else { /* unknown option */ + if (short_too) { + --optind; + return (-1); + } + if (PRINT_ERROR) + warnx(illoptstring, #ifdef GNU_COMPATIBLE - current_dash, + current_dash, #endif - current_argv); - optopt = 0; - return (BADCH); - } - if (idx) - *idx = match; - if (long_options[match].flag) { - *long_options[match].flag = long_options[match].val; - return (0); - } else - return (long_options[match].val); + current_argv); + optopt = 0; + return (BADCH); + } + if (idx) + *idx = match; + if (long_options[match].flag) { + *long_options[match].flag = long_options[match].val; + return (0); + } else + return (long_options[match].val); } /* * getopt_internal -- - * Parse argc/argv argument vector. Called by user level routines. + * Parse argc/argv argument vector. Called by user level routines. */ static int getopt_internal(int nargc, char * const *nargv, const char *options, - const struct option *long_options, int *idx, int flags) + const struct option *long_options, int *idx, int flags) { - char *oli; /* option letter list index */ - int optchar, short_too; - int posixly_correct; /* no static, can be changed on the fly */ + char *oli; /* option letter list index */ + int optchar, short_too; + int posixly_correct; /* no static, can be changed on the fly */ - if (options == NULL) - return (-1); + if (options == NULL) + return (-1); - /* - * Disable GNU extensions if POSIXLY_CORRECT is set or options - * string begins with a '+'. - */ - posixly_correct = (getenv("POSIXLY_CORRECT") != NULL); + /* + * Disable GNU extensions if POSIXLY_CORRECT is set or options + * string begins with a '+'. + */ + posixly_correct = (getenv("POSIXLY_CORRECT") != NULL); #ifdef GNU_COMPATIBLE - if (*options == '-') - flags |= FLAG_ALLARGS; - else if (posixly_correct || *options == '+') - flags &= ~FLAG_PERMUTE; + if (*options == '-') + flags |= FLAG_ALLARGS; + else if (posixly_correct || *options == '+') + flags &= ~FLAG_PERMUTE; #else - if (posixly_correct || *options == '+') - flags &= ~FLAG_PERMUTE; - else if (*options == '-') - flags |= FLAG_ALLARGS; + if (posixly_correct || *options == '+') + flags &= ~FLAG_PERMUTE; + else if (*options == '-') + flags |= FLAG_ALLARGS; #endif - if (*options == '+' || *options == '-') - options++; + if (*options == '+' || *options == '-') + options++; - /* - * XXX Some GNU programs (like cvs) set optind to 0 instead of - * XXX using optreset. Work around this braindamage. - */ - if (optind == 0) - optind = optreset = 1; + /* + * XXX Some GNU programs (like cvs) set optind to 0 instead of + * XXX using optreset. Work around this braindamage. + */ + if (optind == 0) + optind = optreset = 1; - optarg = NULL; - if (optreset) - nonopt_start = nonopt_end = -1; + optarg = NULL; + if (optreset) + nonopt_start = nonopt_end = -1; start: - if (optreset || !*place) { /* update scanning pointer */ - optreset = 0; - if (optind >= nargc) { /* end of argument vector */ - place = emsg; - if (nonopt_end != -1) { - /* do permutation, if we have to */ - permute_args(nonopt_start, nonopt_end, - optind, nargv); - optind -= nonopt_end - nonopt_start; - } - else if (nonopt_start != -1) { - /* - * If we skipped non-options, set optind - * to the first of them. - */ - optind = nonopt_start; - } - nonopt_start = nonopt_end = -1; - return (-1); - } - if (*(place = nargv[optind]) != '-' || + if (optreset || !*place) { /* update scanning pointer */ + optreset = 0; + if (optind >= nargc) { /* end of argument vector */ + place = emsg; + if (nonopt_end != -1) { + /* do permutation, if we have to */ + permute_args(nonopt_start, nonopt_end, + optind, nargv); + optind -= nonopt_end - nonopt_start; + } + else if (nonopt_start != -1) { + /* + * If we skipped non-options, set optind + * to the first of them. + */ + optind = nonopt_start; + } + nonopt_start = nonopt_end = -1; + return (-1); + } + if (*(place = nargv[optind]) != '-' || #ifdef GNU_COMPATIBLE - place[1] == '\0') { + place[1] == '\0') { #else - (place[1] == '\0' && strchr(options, '-') == NULL)) { + (place[1] == '\0' && strchr(options, '-') == NULL)) { #endif - place = emsg; /* found non-option */ - if (flags & FLAG_ALLARGS) { - /* - * GNU extension: - * return non-option as argument to option 1 - */ - optarg = nargv[optind++]; - return (INORDER); - } - if (!(flags & FLAG_PERMUTE)) { - /* - * If no permutation wanted, stop parsing - * at first non-option. - */ - return (-1); - } - /* do permutation */ - if (nonopt_start == -1) - nonopt_start = optind; - else if (nonopt_end != -1) { - permute_args(nonopt_start, nonopt_end, - optind, nargv); - nonopt_start = optind - - (nonopt_end - nonopt_start); - nonopt_end = -1; - } - optind++; - /* process next argument */ - goto start; - } - if (nonopt_start != -1 && nonopt_end == -1) - nonopt_end = optind; + place = emsg; /* found non-option */ + if (flags & FLAG_ALLARGS) { + /* + * GNU extension: + * return non-option as argument to option 1 + */ + optarg = nargv[optind++]; + return (INORDER); + } + if (!(flags & FLAG_PERMUTE)) { + /* + * If no permutation wanted, stop parsing + * at first non-option. + */ + return (-1); + } + /* do permutation */ + if (nonopt_start == -1) + nonopt_start = optind; + else if (nonopt_end != -1) { + permute_args(nonopt_start, nonopt_end, + optind, nargv); + nonopt_start = optind - + (nonopt_end - nonopt_start); + nonopt_end = -1; + } + optind++; + /* process next argument */ + goto start; + } + if (nonopt_start != -1 && nonopt_end == -1) + nonopt_end = optind; - /* - * If we have "-" do nothing, if "--" we are done. - */ - if (place[1] != '\0' && *++place == '-' && place[1] == '\0') { - optind++; - place = emsg; - /* - * We found an option (--), so if we skipped - * non-options, we have to permute. - */ - if (nonopt_end != -1) { - permute_args(nonopt_start, nonopt_end, - optind, nargv); - optind -= nonopt_end - nonopt_start; - } - nonopt_start = nonopt_end = -1; - return (-1); - } - } + /* + * If we have "-" do nothing, if "--" we are done. + */ + if (place[1] != '\0' && *++place == '-' && place[1] == '\0') { + optind++; + place = emsg; + /* + * We found an option (--), so if we skipped + * non-options, we have to permute. + */ + if (nonopt_end != -1) { + permute_args(nonopt_start, nonopt_end, + optind, nargv); + optind -= nonopt_end - nonopt_start; + } + nonopt_start = nonopt_end = -1; + return (-1); + } + } - /* - * Check long options if: - * 1) we were passed some - * 2) the arg is not just "-" - * 3) either the arg starts with -- we are getopt_long_only() - */ - if (long_options != NULL && place != nargv[optind] && - (*place == '-' || (flags & FLAG_LONGONLY))) { - short_too = 0; + /* + * Check long options if: + * 1) we were passed some + * 2) the arg is not just "-" + * 3) either the arg starts with -- we are getopt_long_only() + */ + if (long_options != NULL && place != nargv[optind] && + (*place == '-' || (flags & FLAG_LONGONLY))) { + short_too = 0; #ifdef GNU_COMPATIBLE - dash_prefix = D_PREFIX; + dash_prefix = D_PREFIX; #endif - if (*place == '-') { - place++; /* --foo long option */ + if (*place == '-') { + place++; /* --foo long option */ #ifdef GNU_COMPATIBLE - dash_prefix = DD_PREFIX; + dash_prefix = DD_PREFIX; #endif - } else if (*place != ':' && strchr(options, *place) != NULL) - short_too = 1; /* could be short option too */ + } else if (*place != ':' && strchr(options, *place) != NULL) + short_too = 1; /* could be short option too */ - optchar = parse_long_options(nargv, options, long_options, - idx, short_too, flags); - if (optchar != -1) { - place = emsg; - return (optchar); - } - } + optchar = parse_long_options(nargv, options, long_options, + idx, short_too, flags); + if (optchar != -1) { + place = emsg; + return (optchar); + } + } - if ((optchar = (int)*place++) == (int)':' || - (optchar == (int)'-' && *place != '\0') || - (oli = strchr(options, optchar)) == NULL) { - /* - * If the user specified "-" and '-' isn't listed in - * options, return -1 (non-option) as per POSIX. - * Otherwise, it is an unknown option character (or ':'). - */ - if (optchar == (int)'-' && *place == '\0') - return (-1); - if (!*place) - ++optind; + if ((optchar = (int)*place++) == (int)':' || + (optchar == (int)'-' && *place != '\0') || + (oli = strchr(options, optchar)) == NULL) { + /* + * If the user specified "-" and '-' isn't listed in + * options, return -1 (non-option) as per POSIX. + * Otherwise, it is an unknown option character (or ':'). + */ + if (optchar == (int)'-' && *place == '\0') + return (-1); + if (!*place) + ++optind; #ifdef GNU_COMPATIBLE - if (PRINT_ERROR) - warnx(posixly_correct ? illoptchar : gnuoptchar, - optchar); + if (PRINT_ERROR) + warnx(posixly_correct ? illoptchar : gnuoptchar, + optchar); #else - if (PRINT_ERROR) - warnx(illoptchar, optchar); + if (PRINT_ERROR) + warnx(illoptchar, optchar); #endif - optopt = optchar; - return (BADCH); - } - if (long_options != NULL && optchar == 'W' && oli[1] == ';') { - /* -W long-option */ - if (*place) /* no space */ - /* NOTHING */; - else if (++optind >= nargc) { /* no arg */ - place = emsg; - if (PRINT_ERROR) - warnx(recargchar, optchar); - optopt = optchar; - return (BADARG); - } else /* white space */ - place = nargv[optind]; + optopt = optchar; + return (BADCH); + } + if (long_options != NULL && optchar == 'W' && oli[1] == ';') { + /* -W long-option */ + if (*place) /* no space */ + /* NOTHING */; + else if (++optind >= nargc) { /* no arg */ + place = emsg; + if (PRINT_ERROR) + warnx(recargchar, optchar); + optopt = optchar; + return (BADARG); + } else /* white space */ + place = nargv[optind]; #ifdef GNU_COMPATIBLE - dash_prefix = W_PREFIX; + dash_prefix = W_PREFIX; #endif - optchar = parse_long_options(nargv, options, long_options, - idx, 0, flags); - place = emsg; - return (optchar); - } - if (*++oli != ':') { /* doesn't take argument */ - if (!*place) - ++optind; - } else { /* takes (optional) argument */ - optarg = NULL; - if (*place) /* no white space */ - optarg = place; - else if (oli[1] != ':') { /* arg not optional */ - if (++optind >= nargc) { /* no arg */ - place = emsg; - if (PRINT_ERROR) - warnx(recargchar, optchar); - optopt = optchar; - return (BADARG); - } else - optarg = nargv[optind]; - } - place = emsg; - ++optind; - } - /* dump back option letter */ - return (optchar); + optchar = parse_long_options(nargv, options, long_options, + idx, 0, flags); + place = emsg; + return (optchar); + } + if (*++oli != ':') { /* doesn't take argument */ + if (!*place) + ++optind; + } else { /* takes (optional) argument */ + optarg = NULL; + if (*place) /* no white space */ + optarg = place; + else if (oli[1] != ':') { /* arg not optional */ + if (++optind >= nargc) { /* no arg */ + place = emsg; + if (PRINT_ERROR) + warnx(recargchar, optchar); + optopt = optchar; + return (BADARG); + } else + optarg = nargv[optind]; + } + place = emsg; + ++optind; + } + /* dump back option letter */ + return (optchar); } #ifdef REPLACE_GETOPT /* * getopt -- - * Parse argc/argv argument vector. + * Parse argc/argv argument vector. * * [eventually this will replace the BSD getopt] */ @@ -596,40 +596,40 @@ int getopt(int nargc, char * const *nargv, const char *options) { - /* - * We don't pass FLAG_PERMUTE to getopt_internal() since - * the BSD getopt(3) (unlike GNU) has never done this. - * - * Furthermore, since many privileged programs call getopt() - * before dropping privileges it makes sense to keep things - * as simple (and bug-free) as possible. - */ - return (getopt_internal(nargc, nargv, options, NULL, NULL, 0)); + /* + * We don't pass FLAG_PERMUTE to getopt_internal() since + * the BSD getopt(3) (unlike GNU) has never done this. + * + * Furthermore, since many privileged programs call getopt() + * before dropping privileges it makes sense to keep things + * as simple (and bug-free) as possible. + */ + return (getopt_internal(nargc, nargv, options, NULL, NULL, 0)); } #endif /* REPLACE_GETOPT */ /* * getopt_long -- - * Parse argc/argv argument vector. + * Parse argc/argv argument vector. */ int getopt_long(int nargc, char * const *nargv, const char *options, - const struct option *long_options, int *idx) + const struct option *long_options, int *idx) { - return (getopt_internal(nargc, nargv, options, long_options, idx, - FLAG_PERMUTE)); + return (getopt_internal(nargc, nargv, options, long_options, idx, + FLAG_PERMUTE)); } /* * getopt_long_only -- - * Parse argc/argv argument vector. + * Parse argc/argv argument vector. */ int getopt_long_only(int nargc, char * const *nargv, const char *options, - const struct option *long_options, int *idx) + const struct option *long_options, int *idx) { - return (getopt_internal(nargc, nargv, options, long_options, idx, - FLAG_PERMUTE|FLAG_LONGONLY)); + return (getopt_internal(nargc, nargv, options, long_options, idx, + FLAG_PERMUTE|FLAG_LONGONLY)); } diff --git a/mps/code/lo.h b/mps/code/lo.h deleted file mode 100644 index 55acbec0a8e..00000000000 --- a/mps/code/lo.h +++ /dev/null @@ -1,83 +0,0 @@ -/* lo.h: LEAF OBJECT POOL CLASS INTERFACE - * - * $Id$ - * - * Copyright (c) 2001 Ravenbrook Limited. See end of file for license. - * - * The Leaf Object PoolClass is an automatically managed (ie garbage - * collected) pool for managing "leaf" objects. Leaf objects are - * objects that have no references or no references that need tracing - * (ie the objects they refer too are non-moving and are manually - * managed). - * - * This Class has the following features: - * - * Approximately 6% (asymptotically) space overhead on managed objects. - * - * Automatically reclaims memory used by objects no longer reachable - * from the roots. - * - * Non-moving. References to objects in this pool will never change - * due to "fixing". - * - * Buffers will always "commit". When allocating using a buffer, - * commit will never fail. - * - * The following caveat applies: - * - * Space and time performance will degrade when fragmentation - * increases. - */ - -#ifndef lo_h -#define lo_h - -#include "mpm.h" - -typedef struct LOStruct *LO; - -extern PoolClass PoolClassLO(void); - -#endif /* lo_h */ - - -/* C. COPYRIGHT AND LICENSE - * - * Copyright (C) 2001-2002 Ravenbrook Limited . - * All rights reserved. This is an open source license. Contact - * Ravenbrook for commercial licensing options. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are - * met: - * - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Redistributions in any form must be accompanied by information on how - * to obtain complete source code for this software and any accompanying - * software that uses this software. The source code must either be - * included in the distribution or be available for no more than the cost - * of distribution plus a nominal fee, and must be freely redistributable - * under reasonable conditions. For an executable file, complete source - * code means the source code for all modules it contains. It does not - * include source code for modules or files that typically accompany the - * major components of the operating system on which the executable file - * runs. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS - * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED - * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR - * PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE - * COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, - * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT - * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF - * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON - * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT - * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF - * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - */ diff --git a/mps/code/locus.c b/mps/code/locus.c index e17ec3137c1..cc367b15a6c 100644 --- a/mps/code/locus.c +++ b/mps/code/locus.c @@ -1,7 +1,7 @@ /* locus.c: LOCUS MANAGER * * $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 * @@ -10,7 +10,7 @@ * collection strategy. */ -#include "chain.h" +#include "locus.h" #include "ring.h" #include "mpm.h" #include "mpstd.h" @@ -766,7 +766,7 @@ Bool LocusCheck(Arena arena) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/chain.h b/mps/code/locus.h similarity index 96% rename from mps/code/chain.h rename to mps/code/locus.h index 6dddf0f5e2f..d1d9716303e 100644 --- a/mps/code/chain.h +++ b/mps/code/locus.h @@ -1,11 +1,11 @@ -/* chain.h: GENERATION CHAINS +/* locus.h: GENERATION CHAINS * * $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. */ -#ifndef chain_h -#define chain_h +#ifndef locus_h +#define locus_h #include "mpmtypes.h" #include "ring.h" @@ -108,12 +108,12 @@ extern void PoolGenAccountForSegSplit(PoolGen pgen); extern void PoolGenAccountForSegMerge(PoolGen pgen); extern Res PoolGenDescribe(PoolGen gen, mps_lib_FILE *stream, Count depth); -#endif /* chain_h */ +#endif /* locus_h */ /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpm.h b/mps/code/mpm.h index 8efa22c155d..17ece35d524 100644 --- a/mps/code/mpm.h +++ b/mps/code/mpm.h @@ -473,10 +473,9 @@ extern double TraceWorkFactor; } \ END -extern Res TraceScanArea(ScanState ss, Addr *base, Addr *limit); -extern Res TraceScanAreaTagged(ScanState ss, Addr *base, Addr *limit); -extern Res TraceScanAreaMasked(ScanState ss, - Addr *base, Addr *limit, Word mask); +extern Res TraceScanArea(ScanState ss, Word *base, Word *limit, + mps_area_scan_t scan_area, + void *closure); extern void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena, Seg seg, Ref *refIO); @@ -860,6 +859,7 @@ extern Res FormatCreate(Format *formatReturn, Arena arena, ArgList args); extern void FormatDestroy(Format format); extern Arena FormatArena(Format format); extern Res FormatDescribe(Format format, mps_lib_FILE *stream, Count depth); +extern Res FormatScan(Format format, ScanState ss, Addr base, Addr limit); /* Reference Interface -- see */ @@ -962,17 +962,26 @@ extern void LDMerge(mps_ld_t ld, Arena arena, mps_ld_t from); /* Root Interface -- see */ -extern Res RootCreateTable(Root *rootReturn, Arena arena, - Rank rank, RootMode mode, - Addr *base, Addr *limit); -extern Res RootCreateTableMasked(Root *rootReturn, Arena arena, - Rank rank, RootMode mode, - Addr *base, Addr *limit, - Word mask); -extern Res RootCreateReg(Root *rootReturn, Arena arena, - Rank rank, Thread thread, - mps_reg_scan_t scan, - void *p, size_t s); +extern Res RootCreateArea(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, + Word *base, Word *limit, + mps_area_scan_t scan_area, + void *closure); +extern Res RootCreateAreaTagged(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, + Word *base, Word *limit, + mps_area_scan_t scan_area, + Word mask, Word pattern); +extern Res RootCreateThread(Root *rootReturn, Arena arena, + Rank rank, Thread thread, + mps_area_scan_t scan_area, + void *closure, + Word *stackCold); +extern Res RootCreateThreadTagged(Root *rootReturn, Arena arena, + Rank rank, Thread thread, + mps_area_scan_t scan_area, + Word mask, Word pattern, + Word *stackCold); extern Res RootCreateFmt(Root *rootReturn, Arena arena, Rank rank, RootMode mode, mps_fmt_scan_t scan, diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h index 26e45151155..354e6c06976 100644 --- a/mps/code/mpmst.h +++ b/mps/code/mpmst.h @@ -1,7 +1,7 @@ /* mpmst.h: MEMORY POOL MANAGER DATA STRUCTURES * * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. + * Copyright (c) 2001-2016 Ravenbrook Limited. See end of file for license. * Portions copyright (C) 2001 Global Graphics Software. * * .design: This header file crosses module boundaries. The relevant @@ -26,7 +26,7 @@ #include "protocol.h" #include "ring.h" -#include "chain.h" +#include "locus.h" #include "splay.h" #include "meter.h" @@ -798,7 +798,7 @@ typedef struct mps_arena_s { Bool emergency; /* garbage collect in emergency mode? */ - Addr *stackAtArenaEnter; /* NULL or top of client stack, in the thread */ + Word *stackAtArenaEnter; /* NULL or hot end of client stack, in the thread */ /* that then entered the MPS. */ Sig sig; @@ -815,7 +815,7 @@ typedef struct AllocPatternStruct { /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mpmtypes.h b/mps/code/mpmtypes.h index a6030e4c1e5..2571106984a 100644 --- a/mps/code/mpmtypes.h +++ b/mps/code/mpmtypes.h @@ -359,9 +359,10 @@ enum { enum { RootFUN, - RootTABLE, - RootTABLE_MASKED, - RootREG, + RootAREA, + RootAREA_TAGGED, + RootTHREAD, + RootTHREAD_TAGGED, RootFMT, RootLIMIT }; diff --git a/mps/code/mps.c b/mps/code/mps.c index 2f2e4f248e3..48028242a92 100644 --- a/mps/code/mps.c +++ b/mps/code/mps.c @@ -1,7 +1,7 @@ /* mps.c: MEMORY POOL SYSTEM ALL-IN-ONE TRANSLATION UNIT * * $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. * * .purpose: This file can be compiled to create the complete MPS library in * a single compilation, allowing the compiler to apply global optimizations @@ -45,6 +45,7 @@ #include "poolabs.c" #include "trace.c" #include "traceanc.c" +#include "scan.c" #include "root.c" #include "seg.c" #include "format.c" @@ -85,7 +86,6 @@ #include "poolamc.c" #include "poolams.c" -#include "poolamsi.c" #include "poolawl.c" #include "poollo.c" #include "poolsnc.c" @@ -139,9 +139,9 @@ #include "span.c" /* generic stack probe */ #include "ssixi6.c" /* Posix on 64-bit Intel stack scan */ -/* FreeBSD on 32-bit Intel built with GCC */ +/* FreeBSD on 32-bit Intel built with GCC or Clang */ -#elif defined(MPS_PF_FRI3GC) +#elif defined(MPS_PF_FRI3GC) || defined(MPS_PF_FRI3LL) #include "lockix.c" /* Posix locks */ #include "thix.c" /* Posix threading */ @@ -154,9 +154,9 @@ #include "span.c" /* generic stack probe */ #include "ssixi3.c" /* Posix on 32-bit Intel stack scan */ -/* FreeBSD on 64-bit Intel built with GCC */ +/* FreeBSD on 64-bit Intel built with GCC or Clang */ -#elif defined(MPS_PF_FRI6GC) +#elif defined(MPS_PF_FRI6GC) || defined(MPS_PF_FRI6LL) #include "lockix.c" /* Posix locks */ #include "thix.c" /* Posix threading */ @@ -269,7 +269,7 @@ /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2012-2014 Ravenbrook Limited . + * Copyright (C) 2012-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mps.h b/mps/code/mps.h index d9e750417e0..05b2644ec8e 100644 --- a/mps/code/mps.h +++ b/mps/code/mps.h @@ -1,7 +1,7 @@ /* mps.h: RAVENBROOK MEMORY POOL SYSTEM C INTERFACE * * $Id$ - * Copyright (c) 2001-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 HEADER IS NOT DOCUMENTATION. @@ -102,7 +102,14 @@ _mps_ENUM_DEF(_mps_RES_ENUM, MPS_RES_) /* see design.mps.root-interface */ /* see design.mps.format-interface */ +typedef struct mps_scan_tag_s *mps_scan_tag_t; +typedef struct mps_scan_tag_s { + mps_word_t mask; + mps_word_t pattern; +} mps_scan_tag_s; + typedef mps_res_t (*mps_root_scan_t)(mps_ss_t, void *, size_t); +typedef mps_res_t (*mps_area_scan_t)(mps_ss_t, void *, void *, void *); typedef mps_res_t (*mps_fmt_scan_t)(mps_ss_t, mps_addr_t, mps_addr_t); typedef mps_res_t (*mps_reg_scan_t)(mps_ss_t, mps_thr_t, void *, size_t); @@ -491,7 +498,7 @@ extern size_t mps_pool_free_size(mps_pool_t); /* Chains */ -/* .gen-param: This structure must match . */ +/* .gen-param: This structure must match . */ typedef struct mps_gen_param_s { size_t mps_capacity; double mps_mortality; @@ -671,6 +678,15 @@ extern mps_res_t mps_root_create_table_masked(mps_root_t *, mps_arena_t, mps_rank_t, mps_rm_t, mps_addr_t *, size_t, mps_word_t); +extern mps_res_t mps_root_create_area(mps_root_t *, mps_arena_t, + mps_rank_t, mps_rm_t, + void *, void *, + mps_area_scan_t, void *); +extern mps_res_t mps_root_create_area_tagged(mps_root_t *, mps_arena_t, + mps_rank_t, mps_rm_t, + void *, void *, + mps_area_scan_t, + mps_word_t, mps_word_t); extern mps_res_t mps_root_create_fmt(mps_root_t *, mps_arena_t, mps_rank_t, mps_rm_t, mps_fmt_scan_t, mps_addr_t, @@ -678,6 +694,18 @@ extern mps_res_t mps_root_create_fmt(mps_root_t *, mps_arena_t, extern mps_res_t mps_root_create_reg(mps_root_t *, mps_arena_t, mps_rank_t, mps_rm_t, mps_thr_t, mps_reg_scan_t, void *, size_t); +extern mps_res_t mps_root_create_thread(mps_root_t *, mps_arena_t, + mps_thr_t, void *); +extern mps_res_t mps_root_create_thread_scanned(mps_root_t *, mps_arena_t, + mps_rank_t, mps_rm_t, mps_thr_t, + mps_area_scan_t, + void *, + void *); +extern mps_res_t mps_root_create_thread_tagged(mps_root_t *, mps_arena_t, + mps_rank_t, mps_rm_t, mps_thr_t, + mps_area_scan_t, + mps_word_t, mps_word_t, + void *); extern void mps_root_destroy(mps_root_t); extern mps_res_t mps_stack_scan_ambig(mps_ss_t, mps_thr_t, @@ -791,6 +819,11 @@ extern void mps_pool_check_free_space(mps_pool_t); /* Scanner Support */ +extern mps_res_t mps_scan_area(mps_ss_t, void *, void *, void *); +extern mps_res_t mps_scan_area_masked(mps_ss_t, void *, void *, void *); +extern mps_res_t mps_scan_area_tagged(mps_ss_t, void *, void *, void *); +extern mps_res_t mps_scan_area_tagged_or_zero(mps_ss_t, void *, void *, void *); + extern mps_res_t mps_fix(mps_ss_t, mps_addr_t *); #define MPS_SCAN_BEGIN(ss) \ @@ -834,7 +867,7 @@ extern mps_res_t _mps_fix2(mps_ss_t, mps_addr_t *); /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/mps.xcodeproj/project.pbxproj b/mps/code/mps.xcodeproj/project.pbxproj index 30aad557d3b..e36b800455b 100644 --- a/mps/code/mps.xcodeproj/project.pbxproj +++ b/mps/code/mps.xcodeproj/project.pbxproj @@ -113,6 +113,7 @@ 22B2BC3B18B643B000C33E63 /* PBXTargetDependency */, 3104B04A156D3AE4000A585A /* PBXTargetDependency */, 31D6009D156D404B00337B26 /* PBXTargetDependency */, + 314CB6EB1C6D272A0073CA42 /* PBXTargetDependency */, 3114A62E156E94AA001E0AA3 /* PBXTargetDependency */, 3114A6B9156E9763001E0AA3 /* PBXTargetDependency */, 31D60063156D3F5C00337B26 /* PBXTargetDependency */, @@ -216,6 +217,9 @@ 3104B04F156D3B09000A585A /* fmtdy.c in Sources */ = {isa = PBXBuildFile; fileRef = 3124CAC6156BE48D00753214 /* fmtdy.c */; }; 3104B050156D3B09000A585A /* fmtdytst.c in Sources */ = {isa = PBXBuildFile; fileRef = 3124CAC7156BE48D00753214 /* fmtdytst.c */; }; 3104B051156D3B09000A585A /* fmtno.c in Sources */ = {isa = PBXBuildFile; fileRef = 3124CACC156BE4C200753214 /* fmtno.c */; }; + 31108A3E1C6B90E900E728EA /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; }; + 31108A411C6B90E900E728EA /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; }; + 31108A481C6B911B00E728EA /* tagtest.c in Sources */ = {isa = PBXBuildFile; fileRef = 31108A391C6B90D600E728EA /* tagtest.c */; }; 3114A59B156E914B001E0AA3 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; }; 3114A59C156E914F001E0AA3 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; }; 3114A5A2156E9168001E0AA3 /* locv.c in Sources */ = {isa = PBXBuildFile; fileRef = 3114A5A1156E9168001E0AA3 /* locv.c */; }; @@ -670,6 +674,13 @@ remoteGlobalIDString = 3104B03C156D3AD7000A585A; remoteInfo = segsmss; }; + 31108A3C1C6B90E900E728EA /* PBXContainerItemProxy */ = { + isa = PBXContainerItemProxy; + containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */; + proxyType = 1; + remoteGlobalIDString = 31EEABFA156AAF9D00714D05; + remoteInfo = mps; + }; 3114A59D156E9156001E0AA3 /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */; @@ -866,6 +877,13 @@ remoteGlobalIDString = 3114A6C5156E9815001E0AA3; remoteInfo = mpseventcnv; }; + 314CB6EA1C6D272A0073CA42 /* PBXContainerItemProxy */ = { + isa = PBXContainerItemProxy; + containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */; + proxyType = 1; + remoteGlobalIDString = 31108A3A1C6B90E900E728EA; + remoteInfo = tagtest; + }; 31A47BA9156C210D0039B1C2 /* PBXContainerItemProxy */ = { isa = PBXContainerItemProxy; containerPortal = 31EEABDA156AAE9E00714D05 /* Project object */; @@ -1152,6 +1170,15 @@ ); runOnlyForDeploymentPostprocessing = 1; }; + 31108A421C6B90E900E728EA /* CopyFiles */ = { + isa = PBXCopyFilesBuildPhase; + buildActionMask = 2147483647; + dstPath = /usr/share/man/man1/; + dstSubfolderSpec = 0; + files = ( + ); + runOnlyForDeploymentPostprocessing = 1; + }; 3114A58E156E913C001E0AA3 /* CopyFiles */ = { isa = PBXCopyFilesBuildPhase; buildActionMask = 2147483647; @@ -1471,6 +1498,8 @@ 3107DC4E173B03D100F705C8 /* arg.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = arg.h; sourceTree = ""; }; 310F5D7118B6675F007EFCBC /* tree.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = tree.c; sourceTree = ""; }; 310F5D7218B6675F007EFCBC /* tree.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = tree.h; sourceTree = ""; }; + 31108A391C6B90D600E728EA /* tagtest.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = tagtest.c; sourceTree = ""; }; + 31108A471C6B90E900E728EA /* tagtest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tagtest; sourceTree = BUILT_PRODUCTS_DIR; }; 3112ED3A18ABC57F00CC531A /* sa.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = sa.h; sourceTree = ""; }; 3112ED3B18ABC75200CC531A /* sa.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = sa.c; sourceTree = ""; }; 3114A590156E913C001E0AA3 /* locv */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = locv; sourceTree = BUILT_PRODUCTS_DIR; }; @@ -1540,7 +1569,6 @@ 31160DB61899540D0071EB17 /* poolmvff.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = poolmvff.txt; path = ../design/poolmvff.txt; sourceTree = ""; }; 31160DB71899540D0071EB17 /* poolmvt.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = poolmvt.txt; path = ../design/poolmvt.txt; sourceTree = ""; }; 31160DB81899540D0071EB17 /* prot.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = prot.txt; path = ../design/prot.txt; sourceTree = ""; }; - 31160DB91899540D0071EB17 /* protan.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = protan.txt; path = ../design/protan.txt; sourceTree = ""; }; 31160DBA1899540D0071EB17 /* protli.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = protli.txt; path = ../design/protli.txt; sourceTree = ""; }; 31160DBB1899540D0071EB17 /* protocol.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = protocol.txt; path = ../design/protocol.txt; sourceTree = ""; }; 31160DBC1899540D0071EB17 /* protsu.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = protsu.txt; path = ../design/protsu.txt; sourceTree = ""; }; @@ -1565,7 +1593,6 @@ 31160DCF1899540D0071EB17 /* version-library.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = "version-library.txt"; path = "../design/version-library.txt"; sourceTree = ""; }; 31160DD01899540D0071EB17 /* version.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = version.txt; path = ../design/version.txt; sourceTree = ""; }; 31160DD11899540D0071EB17 /* vm.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = vm.txt; path = ../design/vm.txt; sourceTree = ""; }; - 31160DD21899540D0071EB17 /* vman.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = vman.txt; path = ../design/vman.txt; sourceTree = ""; }; 31160DD31899540D0071EB17 /* vmo1.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = vmo1.txt; path = ../design/vmo1.txt; sourceTree = ""; }; 31160DD41899540D0071EB17 /* vmso.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = vmso.txt; path = ../design/vmso.txt; sourceTree = ""; }; 31160DD51899540D0071EB17 /* writef.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = writef.txt; path = ../design/writef.txt; sourceTree = ""; }; @@ -1577,7 +1604,6 @@ 311F2F5017398AD500C15B6A /* boot.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = boot.h; sourceTree = ""; }; 311F2F5117398AE900C15B6A /* bt.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = bt.h; sourceTree = ""; }; 311F2F5217398AE900C15B6A /* cbs.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = cbs.h; sourceTree = ""; }; - 311F2F5317398AE900C15B6A /* chain.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = chain.h; sourceTree = ""; }; 311F2F5417398AE900C15B6A /* check.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = check.h; sourceTree = ""; }; 311F2F5517398AE900C15B6A /* clock.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = clock.h; sourceTree = ""; }; 311F2F5617398AE900C15B6A /* config.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = config.h; sourceTree = ""; }; @@ -1586,7 +1612,6 @@ 311F2F5917398AE900C15B6A /* eventcom.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = eventcom.h; sourceTree = ""; }; 311F2F5A17398AE900C15B6A /* eventdef.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = eventdef.h; sourceTree = ""; }; 311F2F5C17398AE900C15B6A /* eventrep.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = eventrep.h; sourceTree = ""; }; - 311F2F5D17398B0400C15B6A /* lo.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = lo.h; sourceTree = ""; }; 311F2F5E17398B0E00C15B6A /* lock.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = lock.h; sourceTree = ""; }; 311F2F5F17398B0E00C15B6A /* meter.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = meter.h; sourceTree = ""; }; 311F2F6017398B0E00C15B6A /* misc.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = misc.h; sourceTree = ""; }; @@ -1628,11 +1653,62 @@ 3124CAE4156BE6D500753214 /* fmthe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = fmthe.c; sourceTree = ""; }; 3124CAEB156BE7F300753214 /* amcss */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = amcss; sourceTree = BUILT_PRODUCTS_DIR; }; 3124CAF5156BE81100753214 /* amcss.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = amcss.c; sourceTree = ""; }; + 314562191C72ABFA00D7A514 /* scan.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = scan.c; sourceTree = ""; }; 315B7AFC17834FDB00B097C4 /* proti3.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = proti3.c; sourceTree = ""; }; 315B7AFD17834FDB00B097C4 /* proti6.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = proti6.c; sourceTree = ""; }; 317B3C2A1731830100F9A469 /* arg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = arg.c; sourceTree = ""; }; 318DA8CD1892B0F30089718C /* djbench */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = djbench; sourceTree = BUILT_PRODUCTS_DIR; }; 318DA8CE1892B1210089718C /* djbench.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = djbench.c; sourceTree = ""; }; + 31942A671C8EC3FC001AAF32 /* locus.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = locus.h; sourceTree = ""; }; + 31942A681C8EC445001AAF32 /* abq.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = abq.txt; path = ../design/abq.txt; sourceTree = ""; }; + 31942A6A1C8EC445001AAF32 /* an.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = an.txt; path = ../design/an.txt; sourceTree = ""; }; + 31942A6B1C8EC445001AAF32 /* arena.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = arena.txt; path = ../design/arena.txt; sourceTree = ""; }; + 31942A6D1C8EC445001AAF32 /* boot.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = boot.txt; path = ../design/boot.txt; sourceTree = ""; }; + 31942A6E1C8EC445001AAF32 /* bootstrap.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = bootstrap.txt; path = ../design/bootstrap.txt; sourceTree = ""; }; + 31942A6F1C8EC445001AAF32 /* bt.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = bt.txt; path = ../design/bt.txt; sourceTree = ""; }; + 31942A711C8EC445001AAF32 /* cbs.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = cbs.txt; path = ../design/cbs.txt; sourceTree = ""; }; + 31942A731C8EC445001AAF32 /* class-interface.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = "class-interface.txt"; path = "../design/class-interface.txt"; sourceTree = ""; }; + 31942A741C8EC445001AAF32 /* clock.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = clock.txt; path = ../design/clock.txt; sourceTree = ""; }; + 31942A761C8EC445001AAF32 /* config.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = config.txt; path = ../design/config.txt; sourceTree = ""; }; + 31942A781C8EC445001AAF32 /* diag.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = diag.txt; path = ../design/diag.txt; sourceTree = ""; }; + 31942A791C8EC445001AAF32 /* exec-env.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = "exec-env.txt"; path = "../design/exec-env.txt"; sourceTree = ""; }; + 31942A7B1C8EC445001AAF32 /* finalize.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = finalize.txt; path = ../design/finalize.txt; sourceTree = ""; }; + 31942A7D1C8EC445001AAF32 /* freelist.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = freelist.txt; path = ../design/freelist.txt; sourceTree = ""; }; + 31942A7F1C8EC445001AAF32 /* guide.impl.c.format.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = guide.impl.c.format.txt; path = ../design/guide.impl.c.format.txt; sourceTree = ""; }; + 31942A801C8EC445001AAF32 /* guide.impl.c.naming.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = guide.impl.c.naming.txt; path = ../design/guide.impl.c.naming.txt; sourceTree = ""; }; + 31942A811C8EC445001AAF32 /* guide.review.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = guide.review.txt; path = ../design/guide.review.txt; sourceTree = ""; }; + 31942A831C8EC445001AAF32 /* interface-c.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = "interface-c.txt"; path = "../design/interface-c.txt"; sourceTree = ""; }; + 31942A851C8EC445001AAF32 /* keyword-arguments.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = "keyword-arguments.txt"; path = "../design/keyword-arguments.txt"; sourceTree = ""; }; + 31942A871C8EC445001AAF32 /* lib.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = lib.txt; path = ../design/lib.txt; sourceTree = ""; }; + 31942A891C8EC445001AAF32 /* locus.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = locus.txt; path = ../design/locus.txt; sourceTree = ""; }; + 31942A8B1C8EC446001AAF32 /* message.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = message.txt; path = ../design/message.txt; sourceTree = ""; }; + 31942A8C1C8EC446001AAF32 /* nailboard-1.svg */ = {isa = PBXFileReference; lastKnownFileType = text.xml; name = "nailboard-1.svg"; path = "../design/nailboard-1.svg"; sourceTree = ""; }; + 31942A8D1C8EC446001AAF32 /* nailboard-2.svg */ = {isa = PBXFileReference; lastKnownFileType = text.xml; name = "nailboard-2.svg"; path = "../design/nailboard-2.svg"; sourceTree = ""; }; + 31942A8E1C8EC446001AAF32 /* nailboard-3.svg */ = {isa = PBXFileReference; lastKnownFileType = text.xml; name = "nailboard-3.svg"; path = "../design/nailboard-3.svg"; sourceTree = ""; }; + 31942A8F1C8EC446001AAF32 /* nailboard.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = nailboard.txt; path = ../design/nailboard.txt; sourceTree = ""; }; + 31942A911C8EC446001AAF32 /* pool.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = pool.txt; path = ../design/pool.txt; sourceTree = ""; }; + 31942A931C8EC446001AAF32 /* poolams.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = poolams.txt; path = ../design/poolams.txt; sourceTree = ""; }; + 31942A951C8EC446001AAF32 /* poollo.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = poollo.txt; path = ../design/poollo.txt; sourceTree = ""; }; + 31942A971C8EC446001AAF32 /* poolmrg.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = poolmrg.txt; path = ../design/poolmrg.txt; sourceTree = ""; }; + 31942A991C8EC446001AAF32 /* poolmvff.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = poolmvff.txt; path = ../design/poolmvff.txt; sourceTree = ""; }; + 31942A9B1C8EC446001AAF32 /* prmc.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = prmc.txt; path = ../design/prmc.txt; sourceTree = ""; }; + 31942A9C1C8EC446001AAF32 /* prot.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = prot.txt; path = ../design/prot.txt; sourceTree = ""; }; + 31942A9E1C8EC446001AAF32 /* protocol.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = protocol.txt; path = ../design/protocol.txt; sourceTree = ""; }; + 31942AA01C8EC446001AAF32 /* pthreadext.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = pthreadext.txt; path = ../design/pthreadext.txt; sourceTree = ""; }; + 31942AA21C8EC446001AAF32 /* reservoir.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = reservoir.txt; path = ../design/reservoir.txt; sourceTree = ""; }; + 31942AA41C8EC446001AAF32 /* root.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = root.txt; path = ../design/root.txt; sourceTree = ""; }; + 31942AA61C8EC446001AAF32 /* seg.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = seg.txt; path = ../design/seg.txt; sourceTree = ""; }; + 31942AA81C8EC446001AAF32 /* sig.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = sig.txt; path = ../design/sig.txt; sourceTree = ""; }; + 31942AA91C8EC446001AAF32 /* sp.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = sp.txt; path = ../design/sp.txt; sourceTree = ""; }; + 31942AAB1C8EC446001AAF32 /* ss.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = ss.txt; path = ../design/ss.txt; sourceTree = ""; }; + 31942AAC1C8EC446001AAF32 /* sso1al.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = sso1al.txt; path = ../design/sso1al.txt; sourceTree = ""; }; + 31942AAE1C8EC446001AAF32 /* telemetry.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = telemetry.txt; path = ../design/telemetry.txt; sourceTree = ""; }; + 31942AB01C8EC446001AAF32 /* testthr.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = testthr.txt; path = ../design/testthr.txt; sourceTree = ""; }; + 31942AB11C8EC446001AAF32 /* thread-manager.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = "thread-manager.txt"; path = "../design/thread-manager.txt"; sourceTree = ""; }; + 31942AB31C8EC446001AAF32 /* trace.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = trace.txt; path = ../design/trace.txt; sourceTree = ""; }; + 31942AB51C8EC446001AAF32 /* version-library.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = "version-library.txt"; path = "../design/version-library.txt"; sourceTree = ""; }; + 31942AB71C8EC446001AAF32 /* vm.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = vm.txt; path = ../design/vm.txt; sourceTree = ""; }; + 31942AB91C8EC446001AAF32 /* vmso.txt */ = {isa = PBXFileReference; lastKnownFileType = text; name = vmso.txt; path = ../design/vmso.txt; sourceTree = ""; }; 31A47BA3156C1E130039B1C2 /* mps.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = mps.c; sourceTree = ""; }; 31A47BA5156C1E5E0039B1C2 /* ssixi3.c */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.c; path = ssixi3.c; sourceTree = ""; }; 31C83ADD1786281C0031A0DB /* protxc.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = protxc.h; sourceTree = ""; }; @@ -1866,6 +1942,14 @@ ); runOnlyForDeploymentPostprocessing = 0; }; + 31108A401C6B90E900E728EA /* Frameworks */ = { + isa = PBXFrameworksBuildPhase; + buildActionMask = 2147483647; + files = ( + 31108A411C6B90E900E728EA /* libmps.a in Frameworks */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; 3114A58D156E913C001E0AA3 /* Frameworks */ = { isa = PBXFrameworksBuildPhase; buildActionMask = 2147483647; @@ -2126,7 +2210,90 @@ 31160D90189953D50071EB17 /* Design */ = { isa = PBXGroup; children = ( + 31942A681C8EC445001AAF32 /* abq.txt */, + 31160D931899540D0071EB17 /* alloc-frame.txt */, + 31942A6A1C8EC445001AAF32 /* an.txt */, + 31942A6B1C8EC445001AAF32 /* arena.txt */, + 31160D951899540D0071EB17 /* arenavm.txt */, + 31942A6D1C8EC445001AAF32 /* boot.txt */, + 31942A6E1C8EC445001AAF32 /* bootstrap.txt */, + 31942A6F1C8EC445001AAF32 /* bt.txt */, + 31160D971899540D0071EB17 /* buffer.txt */, + 31942A711C8EC445001AAF32 /* cbs.txt */, + 31160D991899540D0071EB17 /* check.txt */, + 31942A731C8EC445001AAF32 /* class-interface.txt */, + 31942A741C8EC445001AAF32 /* clock.txt */, + 31160D9B1899540D0071EB17 /* collection.txt */, + 31942A761C8EC445001AAF32 /* config.txt */, + 31160D9D1899540D0071EB17 /* critical-path.txt */, + 31942A781C8EC445001AAF32 /* diag.txt */, + 31942A791C8EC445001AAF32 /* exec-env.txt */, + 22DD93E118ED815F00240DD2 /* failover.txt */, + 31942A7B1C8EC445001AAF32 /* finalize.txt */, + 31160DA01899540D0071EB17 /* fix.txt */, + 31942A7D1C8EC445001AAF32 /* freelist.txt */, + 31160DA21899540D0071EB17 /* guide.hex.trans.txt */, + 31942A7F1C8EC445001AAF32 /* guide.impl.c.format.txt */, + 31942A801C8EC445001AAF32 /* guide.impl.c.naming.txt */, + 31942A811C8EC445001AAF32 /* guide.review.txt */, + 31160DA41899540D0071EB17 /* index.txt */, + 31942A831C8EC445001AAF32 /* interface-c.txt */, + 31160DA61899540D0071EB17 /* io.txt */, + 31942A851C8EC445001AAF32 /* keyword-arguments.txt */, + 22DD93E218ED815F00240DD2 /* land.txt */, + 31942A871C8EC445001AAF32 /* lib.txt */, + 31160DA91899540D0071EB17 /* lock.txt */, + 31942A891C8EC445001AAF32 /* locus.txt */, + 31160DAB1899540D0071EB17 /* message-gc.txt */, + 31942A8B1C8EC446001AAF32 /* message.txt */, + 31942A8C1C8EC446001AAF32 /* nailboard-1.svg */, + 31942A8D1C8EC446001AAF32 /* nailboard-2.svg */, + 31942A8E1C8EC446001AAF32 /* nailboard-3.svg */, + 31942A8F1C8EC446001AAF32 /* nailboard.txt */, + 31160DAD1899540D0071EB17 /* object-debug.txt */, + 31942A911C8EC446001AAF32 /* pool.txt */, + 31160DAF1899540D0071EB17 /* poolamc.txt */, + 31942A931C8EC446001AAF32 /* poolams.txt */, + 31160DB11899540D0071EB17 /* poolawl.txt */, + 31942A951C8EC446001AAF32 /* poollo.txt */, + 31160DB31899540D0071EB17 /* poolmfs.txt */, + 31942A971C8EC446001AAF32 /* poolmrg.txt */, + 31160DB51899540D0071EB17 /* poolmv.txt */, + 31942A991C8EC446001AAF32 /* poolmvff.txt */, + 31160DB71899540D0071EB17 /* poolmvt.txt */, + 31942A9B1C8EC446001AAF32 /* prmc.txt */, + 31942A9C1C8EC446001AAF32 /* prot.txt */, + 31160DBA1899540D0071EB17 /* protli.txt */, + 31942A9E1C8EC446001AAF32 /* protocol.txt */, + 31160DBC1899540D0071EB17 /* protsu.txt */, + 31942AA01C8EC446001AAF32 /* pthreadext.txt */, + 31160DBE1899540D0071EB17 /* range.txt */, + 31942AA21C8EC446001AAF32 /* reservoir.txt */, + 31160DC01899540D0071EB17 /* ring.txt */, + 31942AA41C8EC446001AAF32 /* root.txt */, + 31160DC21899540D0071EB17 /* scan.txt */, + 31942AA61C8EC446001AAF32 /* seg.txt */, + 31160DC41899540D0071EB17 /* shield.txt */, + 31942AA81C8EC446001AAF32 /* sig.txt */, + 31942AA91C8EC446001AAF32 /* sp.txt */, + 31160DC61899540D0071EB17 /* splay.txt */, + 31942AAB1C8EC446001AAF32 /* ss.txt */, + 31942AAC1C8EC446001AAF32 /* sso1al.txt */, + 31160DC81899540D0071EB17 /* strategy.txt */, + 31942AAE1C8EC446001AAF32 /* telemetry.txt */, + 31160DCA1899540D0071EB17 /* tests.txt */, + 31942AB01C8EC446001AAF32 /* testthr.txt */, + 31942AB11C8EC446001AAF32 /* thread-manager.txt */, + 31160DCC1899540D0071EB17 /* thread-safety.txt */, + 31942AB31C8EC446001AAF32 /* trace.txt */, + 31160DCE1899540D0071EB17 /* type.txt */, + 31942AB51C8EC446001AAF32 /* version-library.txt */, + 31160DD01899540D0071EB17 /* version.txt */, + 31942AB71C8EC446001AAF32 /* vm.txt */, + 31160DD31899540D0071EB17 /* vmo1.txt */, + 31942AB91C8EC446001AAF32 /* vmso.txt */, 31160D921899540D0071EB17 /* abq.txt */, + 31160DD51899540D0071EB17 /* writef.txt */, 31160D931899540D0071EB17 /* alloc-frame.txt */, 31160D941899540D0071EB17 /* arena.txt */, 31160D951899540D0071EB17 /* arenavm.txt */, @@ -2167,7 +2334,6 @@ 31160DB61899540D0071EB17 /* poolmvff.txt */, 31160DB71899540D0071EB17 /* poolmvt.txt */, 31160DB81899540D0071EB17 /* prot.txt */, - 31160DB91899540D0071EB17 /* protan.txt */, 31160DBA1899540D0071EB17 /* protli.txt */, 31160DBB1899540D0071EB17 /* protocol.txt */, 31160DBC1899540D0071EB17 /* protsu.txt */, @@ -2192,7 +2358,6 @@ 31160DCF1899540D0071EB17 /* version-library.txt */, 31160DD01899540D0071EB17 /* version.txt */, 31160DD11899540D0071EB17 /* vm.txt */, - 31160DD21899540D0071EB17 /* vman.txt */, 31160DD31899540D0071EB17 /* vmo1.txt */, 31160DD41899540D0071EB17 /* vmso.txt */, 31160DD51899540D0071EB17 /* writef.txt */, @@ -2248,6 +2413,7 @@ 3104AFD6156D3602000A585A /* sacss.c */, 31D60006156D3C5F00337B26 /* segsmss.c */, 31D60098156D403C00337B26 /* steptest.c */, + 31108A391C6B90D600E728EA /* tagtest.c */, 3114A628156E949A001E0AA3 /* teletest.c */, 31EEAC9E156AB73400714D05 /* testlib.c */, 2291A5F0175CB7A4001D4920 /* testlib.h */, @@ -2345,6 +2511,7 @@ 22FACEED18880983000FDBC1 /* airtest */, 22C2ACAF18BE400A006B3677 /* nailboardtest */, 22F846BD18F437B900982BA7 /* lockut */, + 31108A471C6B90E900E728EA /* tagtest */, ); name = Products; sourceTree = ""; @@ -2352,6 +2519,7 @@ 31EEABF4156AAF6500714D05 /* MPM Core */ = { isa = PBXGroup; children = ( + 31942A671C8EC3FC001AAF32 /* locus.h */, 3114A645156E9525001E0AA3 /* abq.c */, 2291A5EA175CB503001D4920 /* abq.h */, 31EEAC05156AB27B00714D05 /* arena.c */, @@ -2366,7 +2534,6 @@ 31EEAC19156AB2B200714D05 /* buffer.c */, 31EEAC40156AB32500714D05 /* cbs.c */, 311F2F5217398AE900C15B6A /* cbs.h */, - 311F2F5317398AE900C15B6A /* chain.h */, 311F2F5417398AE900C15B6A /* check.h */, 311F2F5517398AE900C15B6A /* clock.h */, 311F2F5617398AE900C15B6A /* config.h */, @@ -2437,6 +2604,7 @@ 31EEAC31156AB2F200714D05 /* sac.c */, 311F2F7417398B7100C15B6A /* sac.h */, 311F2F7517398B8E00C15B6A /* sc.h */, + 314562191C72ABFA00D7A514 /* scan.c */, 31EEAC1D156AB2B200714D05 /* seg.c */, 31EEAC32156AB2F200714D05 /* shield.c */, 31EEAC43156AB32500714D05 /* splay.c */, @@ -2483,7 +2651,6 @@ 31EEAC5A156AB40800714D05 /* Extra pools */ = { isa = PBXGroup; children = ( - 311F2F5D17398B0400C15B6A /* lo.h */, 31F6CCA91739B0CF00C48748 /* mpscamc.h */, 31CD33BB173A9F1500524741 /* mpscams.h */, 31F6CCAA1739B0CF00C48748 /* mpscawl.h */, @@ -2873,6 +3040,24 @@ productReference = 3104B03D156D3AD7000A585A /* segsmss */; productType = "com.apple.product-type.tool"; }; + 31108A3A1C6B90E900E728EA /* tagtest */ = { + isa = PBXNativeTarget; + buildConfigurationList = 31108A431C6B90E900E728EA /* Build configuration list for PBXNativeTarget "tagtest" */; + buildPhases = ( + 31108A3D1C6B90E900E728EA /* Sources */, + 31108A401C6B90E900E728EA /* Frameworks */, + 31108A421C6B90E900E728EA /* CopyFiles */, + ); + buildRules = ( + ); + dependencies = ( + 31108A3B1C6B90E900E728EA /* PBXTargetDependency */, + ); + name = tagtest; + productName = teletest; + productReference = 31108A471C6B90E900E728EA /* tagtest */; + productType = "com.apple.product-type.tool"; + }; 3114A58F156E913C001E0AA3 /* locv */ = { isa = PBXNativeTarget; buildConfigurationList = 3114A599156E913C001E0AA3 /* Build configuration list for PBXNativeTarget "locv" */; @@ -3446,6 +3631,7 @@ 2D604B9B16514B1A003AAF46 /* mpseventtxt */, 31FCAE0917692403008C034C /* scheme */, 22B2BC2C18B6434F00C33E63 /* scheme-advanced */, + 31108A3A1C6B90E900E728EA /* tagtest */, ); }; /* End PBXProject section */ @@ -3725,6 +3911,15 @@ ); runOnlyForDeploymentPostprocessing = 0; }; + 31108A3D1C6B90E900E728EA /* Sources */ = { + isa = PBXSourcesBuildPhase; + buildActionMask = 2147483647; + files = ( + 31108A3E1C6B90E900E728EA /* testlib.c in Sources */, + 31108A481C6B911B00E728EA /* tagtest.c in Sources */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; 3114A58C156E913C001E0AA3 /* Sources */ = { isa = PBXSourcesBuildPhase; buildActionMask = 2147483647; @@ -4258,6 +4453,11 @@ target = 3104B03C156D3AD7000A585A /* segsmss */; targetProxy = 3104B049156D3AE4000A585A /* PBXContainerItemProxy */; }; + 31108A3B1C6B90E900E728EA /* PBXTargetDependency */ = { + isa = PBXTargetDependency; + target = 31EEABFA156AAF9D00714D05 /* mps */; + targetProxy = 31108A3C1C6B90E900E728EA /* PBXContainerItemProxy */; + }; 3114A59E156E9156001E0AA3 /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = 31EEABFA156AAF9D00714D05 /* mps */; @@ -4398,6 +4598,11 @@ target = 3114A6C5156E9815001E0AA3 /* mpseventcnv */; targetProxy = 3114A6D4156E9839001E0AA3 /* PBXContainerItemProxy */; }; + 314CB6EB1C6D272A0073CA42 /* PBXTargetDependency */ = { + isa = PBXTargetDependency; + target = 31108A3A1C6B90E900E728EA /* tagtest */; + targetProxy = 314CB6EA1C6D272A0073CA42 /* PBXContainerItemProxy */; + }; 31A47BAA156C210D0039B1C2 /* PBXTargetDependency */ = { isa = PBXTargetDependency; target = 31EEABFA156AAF9D00714D05 /* mps */; @@ -4903,6 +5108,27 @@ }; name = Release; }; + 31108A441C6B90E900E728EA /* Debug */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = "$(TARGET_NAME)"; + }; + name = Debug; + }; + 31108A451C6B90E900E728EA /* Release */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = "$(TARGET_NAME)"; + }; + name = Release; + }; + 31108A461C6B90E900E728EA /* RASH */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = "$(TARGET_NAME)"; + }; + name = RASH; + }; 3114A597156E913C001E0AA3 /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { @@ -5191,21 +5417,7 @@ SDKROOT = macosx; SYMROOT = xc; WARNING_CFLAGS = ( - "-pedantic", - "-Waggregate-return", - "-Wall", - "-Wcast-qual", - "-Wextra", - "-Winline", - "-Wmissing-prototypes", - "-Wnested-externs", - "-Wno-extended-offsetof", - "-Wpointer-arith", - "-Wshadow", - "-Wstrict-aliasing=2", - "-Wstrict-prototypes", - "-Wunreachable-code", - "-Wwrite-strings", + "-pedantic\n-Waggregate-return\n-Wall\n-Wcast-qual\n-Wconversion\n-Wduplicate-enum\n-Wextra\n-Winline\n-Wmissing-prototypes\n-Wmissing-variable-declarations\n-Wnested-externs\n-Wno-extended-offsetof\n-Wpointer-arith\n-Wshadow\n-Wstrict-aliasing=2\n-Wstrict-prototypes\n-Wunreachable-code\n-Wwrite-strings\n", ); }; name = RASH; @@ -5628,21 +5840,7 @@ SDKROOT = macosx; SYMROOT = xc; WARNING_CFLAGS = ( - "-pedantic", - "-Waggregate-return", - "-Wall", - "-Wcast-qual", - "-Wextra", - "-Winline", - "-Wmissing-prototypes", - "-Wnested-externs", - "-Wno-extended-offsetof", - "-Wpointer-arith", - "-Wshadow", - "-Wstrict-aliasing=2", - "-Wstrict-prototypes", - "-Wunreachable-code", - "-Wwrite-strings", + "-pedantic\n-Waggregate-return\n-Wall\n-Wcast-qual\n-Wconversion\n-Wduplicate-enum\n-Wextra\n-Winline\n-Wmissing-prototypes\n-Wmissing-variable-declarations\n-Wnested-externs\n-Wno-extended-offsetof\n-Wpointer-arith\n-Wshadow\n-Wstrict-aliasing=2\n-Wstrict-prototypes\n-Wunreachable-code\n-Wwrite-strings\n", ); }; name = Debug; @@ -5683,21 +5881,7 @@ SDKROOT = macosx; SYMROOT = xc; WARNING_CFLAGS = ( - "-pedantic", - "-Waggregate-return", - "-Wall", - "-Wcast-qual", - "-Wextra", - "-Winline", - "-Wmissing-prototypes", - "-Wnested-externs", - "-Wno-extended-offsetof", - "-Wpointer-arith", - "-Wshadow", - "-Wstrict-aliasing=2", - "-Wstrict-prototypes", - "-Wunreachable-code", - "-Wwrite-strings", + "-pedantic\n-Waggregate-return\n-Wall\n-Wcast-qual\n-Wconversion\n-Wduplicate-enum\n-Wextra\n-Winline\n-Wmissing-prototypes\n-Wmissing-variable-declarations\n-Wnested-externs\n-Wno-extended-offsetof\n-Wpointer-arith\n-Wshadow\n-Wstrict-aliasing=2\n-Wstrict-prototypes\n-Wunreachable-code\n-Wwrite-strings\n", ); }; name = Release; @@ -6022,6 +6206,16 @@ defaultConfigurationIsVisible = 0; defaultConfigurationName = Release; }; + 31108A431C6B90E900E728EA /* Build configuration list for PBXNativeTarget "tagtest" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + 31108A441C6B90E900E728EA /* Debug */, + 31108A451C6B90E900E728EA /* Release */, + 31108A461C6B90E900E728EA /* RASH */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Release; + }; 3114A599156E913C001E0AA3 /* Build configuration list for PBXNativeTarget "locv" */ = { isa = XCConfigurationList; buildConfigurations = ( diff --git a/mps/code/mpsi.c b/mps/code/mpsi.c index 283fbc6123e..a6e24f0c63a 100644 --- a/mps/code/mpsi.c +++ b/mps/code/mpsi.c @@ -40,13 +40,9 @@ * present. This is because the MPM doesn't ever try to protect them. * In future, it will. * - * .reg-scan: (rule.universal.complete) At present, we only support - * register scanning using our own ambiguous register and stack scanning - * method, mps_stack_scan_ambig. This may never change, but the way the - * interface is designed allows for the possibility of change. - * * .naming: (rule.impl.guide) The exported identifiers do not follow the - * normal MPS naming conventions. See . */ + * normal MPS naming conventions. See . + */ #include "mpm.h" #include "mps.h" @@ -1299,12 +1295,14 @@ mps_res_t mps_root_create_table(mps_root_t *mps_root_o, mps_arena_t arena, AVER(base != NULL); AVER(size > 0); - /* .root.table-size: size is the length of the array at base, not */ - /* the size in bytes. However, RootCreateTable expects base and */ - /* limit pointers. Be careful. */ + /* .root.table-size: size is the length of the array at base, not + the size in bytes. However, RootCreateArea expects base and limit + pointers. Be careful. Avoid type punning by casting through + void *. */ - res = RootCreateTable(&root, arena, rank, mode, - (Addr *)base, (Addr *)base + size); + res = RootCreateArea(&root, arena, rank, mode, + (void *)base, (void *)(base + size), + mps_scan_area, NULL); ArenaLeave(arena); @@ -1314,11 +1312,12 @@ mps_res_t mps_root_create_table(mps_root_t *mps_root_o, mps_arena_t arena, return MPS_RES_OK; } -mps_res_t mps_root_create_table_masked(mps_root_t *mps_root_o, - mps_arena_t arena, - mps_rank_t mps_rank, mps_rm_t mps_rm, - mps_addr_t *base, size_t size, - mps_word_t mask) +mps_res_t mps_root_create_area(mps_root_t *mps_root_o, + mps_arena_t arena, + mps_rank_t mps_rank, mps_rm_t mps_rm, + void *base, void *limit, + mps_area_scan_t scan_area, + void *closure) { Rank rank = (Rank)mps_rank; Root root; @@ -1329,14 +1328,14 @@ mps_res_t mps_root_create_table_masked(mps_root_t *mps_root_o, AVER(mps_root_o != NULL); AVER(base != NULL); - AVER(size > 0); - /* Can't check anything about mask */ + AVER(limit != NULL); + AVER(base < limit); + AVER(FUNCHECK(scan_area)); + /* Can't check anything about closure */ - /* See .root.table-size. */ - - res = RootCreateTableMasked(&root, arena, rank, mode, - (Addr *)base, (Addr *)base + size, - mask); + res = RootCreateArea(&root, arena, rank, mode, + base, limit, + scan_area, closure); ArenaLeave(arena); @@ -1346,6 +1345,56 @@ mps_res_t mps_root_create_table_masked(mps_root_t *mps_root_o, return MPS_RES_OK; } +mps_res_t mps_root_create_area_tagged(mps_root_t *mps_root_o, + mps_arena_t arena, + mps_rank_t mps_rank, + mps_rm_t mps_rm, + void *base, + void *limit, + mps_area_scan_t scan_area, + mps_word_t mask, + mps_word_t pattern) +{ + Rank rank = (Rank)mps_rank; + Root root; + RootMode mode = (RootMode)mps_rm; + Res res; + + ArenaEnter(arena); + + AVER(mps_root_o != NULL); + AVER(base != NULL); + AVER(limit != NULL); + AVER(base < limit); + AVER(FUNCHECK(scan_area)); + /* Can't check anything about mask or pattern, as they could mean + anything to scan_area. */ + + res = RootCreateAreaTagged(&root, arena, rank, mode, + base, limit, + scan_area, mask, pattern); + + ArenaLeave(arena); + + if (res != ResOK) + return (mps_res_t)res; + *mps_root_o = (mps_root_t)root; + return MPS_RES_OK; +} + + +mps_res_t mps_root_create_table_masked(mps_root_t *mps_root_o, + mps_arena_t arena, + mps_rank_t mps_rank, mps_rm_t mps_rm, + mps_addr_t *base, size_t size, + mps_word_t mask) +{ + return mps_root_create_area_tagged(mps_root_o, arena, mps_rank, mps_rm, + base, base + size, + mps_scan_area_tagged, + mask, 0); +} + mps_res_t mps_root_create_fmt(mps_root_t *mps_root_o, mps_arena_t arena, mps_rank_t mps_rank, mps_rm_t mps_rm, mps_fmt_scan_t scan, @@ -1372,7 +1421,7 @@ mps_res_t mps_root_create_fmt(mps_root_t *mps_root_o, mps_arena_t arena, mps_res_t mps_root_create_reg(mps_root_t *mps_root_o, mps_arena_t arena, mps_rank_t mps_rank, mps_rm_t mps_rm, mps_thr_t thread, mps_reg_scan_t mps_reg_scan, - void *reg_scan_p, size_t mps_size) + void *cold, size_t mps_size) { Rank rank = (Rank)mps_rank; Root root; @@ -1383,14 +1432,111 @@ mps_res_t mps_root_create_reg(mps_root_t *mps_root_o, mps_arena_t arena, AVER(mps_root_o != NULL); AVER(mps_reg_scan != NULL); AVER(mps_reg_scan == mps_stack_scan_ambig); /* .reg.scan */ - AVER(reg_scan_p != NULL); /* stackBot */ - AVER(AddrIsAligned(reg_scan_p, sizeof(Word))); + AVER(cold != NULL); + AVER(AddrIsAligned(cold, sizeof(Word))); AVER(rank == mps_rank_ambig()); AVER(mps_rm == (mps_rm_t)0); + UNUSED(mps_size); + /* See .root-mode. */ - res = RootCreateReg(&root, arena, rank, thread, - mps_reg_scan, reg_scan_p, mps_size); + res = RootCreateThreadTagged(&root, arena, rank, thread, + mps_scan_area_tagged, + sizeof(mps_word_t) - 1, 0, + (Word *)cold); + + ArenaLeave(arena); + + if (res != ResOK) + return (mps_res_t)res; + *mps_root_o = (mps_root_t)root; + return MPS_RES_OK; +} + + +mps_res_t mps_root_create_thread(mps_root_t *mps_root_o, + mps_arena_t arena, + mps_thr_t thread, + void *stack) +{ + return mps_root_create_thread_tagged(mps_root_o, + arena, + mps_rank_ambig(), + (mps_rm_t)0, + thread, + mps_scan_area_tagged, + sizeof(mps_word_t) - 1, + 0, + stack); +} + + +mps_res_t mps_root_create_thread_scanned(mps_root_t *mps_root_o, + mps_arena_t arena, + mps_rank_t mps_rank, + mps_rm_t mps_rm, + mps_thr_t thread, + mps_area_scan_t scan_area, + void *closure, + void *cold) +{ + Rank rank = (Rank)mps_rank; + Root root; + Res res; + + ArenaEnter(arena); + + AVER(mps_root_o != NULL); + AVER(cold != NULL); + AVER(AddrIsAligned(cold, sizeof(Word))); + AVER(rank == mps_rank_ambig()); + AVER(mps_rm == (mps_rm_t)0); + AVER(FUNCHECK(scan_area)); + /* Can't check anything about closure. */ + + /* See .root-mode. */ + res = RootCreateThread(&root, arena, rank, thread, + scan_area, closure, + (Word *)cold); + + ArenaLeave(arena); + + if (res != ResOK) + return (mps_res_t)res; + *mps_root_o = (mps_root_t)root; + return MPS_RES_OK; +} + + +mps_res_t mps_root_create_thread_tagged(mps_root_t *mps_root_o, + mps_arena_t arena, + mps_rank_t mps_rank, + mps_rm_t mps_rm, + mps_thr_t thread, + mps_area_scan_t scan_area, + mps_word_t mask, + mps_word_t pattern, + void *cold) +{ + Rank rank = (Rank)mps_rank; + Root root; + Res res; + + ArenaEnter(arena); + + AVER(mps_root_o != NULL); + AVER(cold != NULL); + AVER(AddrIsAligned(cold, sizeof(Word))); + AVER(rank == mps_rank_ambig()); + AVER(mps_rm == (mps_rm_t)0); + AVER(FUNCHECK(scan_area)); + /* Can't check anything about mask or pattern, as they could mean + anything to scan_area. */ + + /* See .root-mode. */ + res = RootCreateThreadTagged(&root, arena, rank, thread, + scan_area, mask, pattern, + (Word *)cold); ArenaLeave(arena); @@ -1403,14 +1549,22 @@ mps_res_t mps_root_create_reg(mps_root_t *mps_root_o, mps_arena_t arena, /* mps_stack_scan_ambig -- scan the thread state ambiguously * - * See .reg-scan. */ + * This is a helper function for the deprecated mps_root_create_reg + * and should no longer be reached since that has been reimplemented + * in terms of the more general RootCreateThreadTagged. + */ mps_res_t mps_stack_scan_ambig(mps_ss_t mps_ss, mps_thr_t thread, void *p, size_t s) { - ScanState ss = PARENT(ScanStateStruct, ss_s, mps_ss); + UNUSED(mps_ss); + UNUSED(thread); + UNUSED(p); UNUSED(s); - return ThreadScan(ss, thread, p); + + NOTREACHED; + + return ResUNIMPL; } diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c index 44036efead9..7eae7eb497c 100644 --- a/mps/code/mpsicv.c +++ b/mps/code/mpsicv.c @@ -596,11 +596,16 @@ int main(int argc, char *argv[]) "arena_create"); die(mps_thread_reg(&thread, arena), "thread_reg"); - die(mps_root_create_reg(®_root, arena, - mps_rank_ambig(), (mps_rm_t)0, - thread, &mps_stack_scan_ambig, - marker, (size_t)0), - "root_create_reg"); + if (rnd() % 2) { + die(mps_root_create_reg(®_root, arena, + mps_rank_ambig(), (mps_rm_t)0, + thread, &mps_stack_scan_ambig, + marker, (size_t)0), + "root_create_reg"); + } else { + die(mps_root_create_thread(®_root, arena, thread, marker), + "root_create_thread"); + } mps_tramp(&r, test, arena, 0); mps_root_destroy(reg_root); diff --git a/mps/code/mpstd.h b/mps/code/mpstd.h index 1306281224b..6147e2a40e7 100644 --- a/mps/code/mpstd.h +++ b/mps/code/mpstd.h @@ -261,6 +261,23 @@ #define MPS_PF_ALIGN 4 +#elif defined(__FreeBSD__) && defined (__i386__) && defined (__GNUC__) \ + && defined(__clang__) +#if defined(CONFIG_PF_STRING) && ! defined(CONFIG_PF_FRI3LL) +#error "specified CONFIG_PF_... inconsistent with detected fri3ll" +#endif +#define MPS_PF_FRI3LL +#define MPS_PF_STRING "fri3ll" +#define MPS_OS_FR +#define MPS_ARCH_I3 +#define MPS_BUILD_LL +#define MPS_T_WORD unsigned long +#define MPS_T_ULONGEST unsigned long +#define MPS_WORD_WIDTH 32 +#define MPS_WORD_SHIFT 5 +#define MPS_PF_ALIGN 4 + + #elif defined(__FreeBSD__) && defined (__x86_64__) && defined (__GNUC__) \ && !defined(__clang__) #if defined(CONFIG_PF_STRING) && ! defined(CONFIG_PF_FRI6GC) @@ -278,6 +295,23 @@ #define MPS_PF_ALIGN 8 +#elif defined(__FreeBSD__) && defined (__x86_64__) && defined (__GNUC__) \ + && defined(__clang__) +#if defined(CONFIG_PF_STRING) && ! defined(CONFIG_PF_FRI6LL) +#error "specified CONFIG_PF_... inconsistent with detected fri6ll" +#endif +#define MPS_PF_FRI6LL +#define MPS_PF_STRING "fri6ll" +#define MPS_OS_FR +#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_WORD_WIDTH 64 +#define MPS_WORD_SHIFT 6 +#define MPS_PF_ALIGN 8 + + #else #error "The MPS Kit does not have a configuration for this platform out of the box; see manual/build.txt" #endif diff --git a/mps/code/policy.c b/mps/code/policy.c index 541a29159f7..134b8236013 100644 --- a/mps/code/policy.c +++ b/mps/code/policy.c @@ -1,7 +1,7 @@ /* policy.c: POLICY DECISIONS * * $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. * * This module collects the decision-making code for the MPS, so that * policy can be maintained and adjusted. @@ -9,7 +9,7 @@ * .sources: . */ -#include "chain.h" +#include "locus.h" #include "mpm.h" SRCID(policy, "$Id$"); @@ -394,7 +394,7 @@ Bool PolicyPollAgain(Arena arena, Clock start, Size tracedSize) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolamc.c b/mps/code/poolamc.c index 774d2ccf8f7..7b625c4dac4 100644 --- a/mps/code/poolamc.c +++ b/mps/code/poolamc.c @@ -1,14 +1,14 @@ /* poolamc.c: AUTOMATIC MOSTLY-COPYING MEMORY POOL 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. * Portions copyright (C) 2002 Global Graphics Software. * * .sources: . */ #include "mpscamc.h" -#include "chain.h" +#include "locus.h" #include "bt.h" #include "mpm.h" #include "nailboard.h" @@ -1252,7 +1252,7 @@ static Res AMCWhiten(Pool pool, Trace trace, Seg seg) * limit have been scanned. It is not touched otherwise. */ static Res amcScanNailedRange(Bool *totalReturn, Bool *moreReturn, - Size *bytesScanned, ScanState ss, + ScanState ss, AMC amc, Nailboard board, Addr base, Addr limit) { @@ -1268,14 +1268,12 @@ static Res amcScanNailedRange(Bool *totalReturn, Bool *moreReturn, Addr q; q = (*format->skip)(p); if ((*amc->pinned)(amc, board, p, q)) { - Res res; - res = (*format->scan)(&ss->ss_s, p, q); + Res res = FormatScan(format, ss, p, q); if(res != ResOK) { *totalReturn = FALSE; *moreReturn = TRUE; return res; } - *bytesScanned += AddrOffset(p, q); } else { *totalReturn = FALSE; } @@ -1300,7 +1298,6 @@ static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn, ScanState ss, Seg seg, AMC amc) { Addr p, limit; - Size bytesScanned = 0; Nailboard board; Res res; @@ -1317,7 +1314,7 @@ static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn, AVER(p == limit); goto returnGood; } - res = amcScanNailedRange(totalReturn, moreReturn, &bytesScanned, + res = amcScanNailedRange(totalReturn, moreReturn, ss, amc, board, p, limit); if (res != ResOK) return res; @@ -1326,7 +1323,7 @@ static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn, limit = SegLimit(seg); /* @@@@ Shouldn't p be set to BufferLimit here?! */ - res = amcScanNailedRange(totalReturn, moreReturn, &bytesScanned, + res = amcScanNailedRange(totalReturn, moreReturn, ss, amc, board, p, limit); if (res != ResOK) return res; @@ -1334,8 +1331,6 @@ static Res amcScanNailedOnce(Bool *totalReturn, Bool *moreReturn, returnGood: EVENT3(AMCScanEnd, amc, seg, ss); /* TODO: consider using own event */ - AVER(bytesScanned <= SegSize(seg)); - ss->scannedSize += bytesScanned; *moreReturn = NailboardNewNails(board); return ResOK; } @@ -1426,12 +1421,11 @@ static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) *totalReturn = TRUE; return ResOK; } - res = (*format->scan)(&ss->ss_s, base, limit); + res = FormatScan(format, ss, base, limit); if(res != ResOK) { *totalReturn = FALSE; return res; } - ss->scannedSize += AddrOffset(base, limit); base = limit; } @@ -1440,14 +1434,13 @@ static Res AMCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) AVER(SegBase(seg) <= base); AVER(base <= AddrAdd(SegLimit(seg), format->headerSize)); if(base < limit) { - res = (*format->scan)(&ss->ss_s, base, limit); + res = FormatScan(format, ss, base, limit); if(res != ResOK) { *totalReturn = FALSE; return res; } } - ss->scannedSize += AddrOffset(base, limit); EVENT3(AMCScanEnd, amc, seg, ss); *totalReturn = TRUE; @@ -2261,7 +2254,7 @@ static Bool AMCCheck(AMC amc) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolams.c b/mps/code/poolams.c index 3f7f170ddbc..40ca5f65426 100644 --- a/mps/code/poolams.c +++ b/mps/code/poolams.c @@ -1,7 +1,7 @@ /* poolams.c: AUTOMATIC MARK & SWEEP POOL 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. * Portions copyright (c) 2002 Global Graphics Software. * * @@ -1318,12 +1318,12 @@ static Res amsScanObject(Seg seg, Index i, Addr p, Addr next, void *clos) /* @@@@ This isn't quite right for multiple traces. */ if (closure->scanAllObjects || AMS_IS_GREY(seg, i)) { - res = (*format->scan)(&closure->ss->ss_s, - AddrAdd(p, format->headerSize), - AddrAdd(next, format->headerSize)); + res = FormatScan(format, + closure->ss, + AddrAdd(p, format->headerSize), + AddrAdd(next, format->headerSize)); if (res != ResOK) return res; - closure->ss->scannedSize += AddrOffset(p, next); if (!closure->scanAllObjects) { Index j = AMS_ADDR_INDEX(seg, next); AVER(!AMS_IS_INVALID_COLOUR(seg, i)); @@ -1412,7 +1412,7 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) next = AddrAdd(p, alignment); } j = AMS_ADDR_INDEX(seg, next); - res = (*format->scan)(&ss->ss_s, clientP, clientNext); + res = FormatScan(format, ss, clientP, clientNext); if (res != ResOK) { /* */ amsseg->marksChanged = TRUE; @@ -1422,7 +1422,6 @@ Res AMSScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) /* Check that there haven't been any ambiguous fixes during the */ /* scan, because AMSFindGrey won't work otherwise. */ AVER_CRITICAL(!amsseg->ambiguousFixes); - ss->scannedSize += AddrOffset(p, next); AMS_GREY_BLACKEN(seg, i); if (i+1 < j) AMS_RANGE_WHITE_BLACKEN(seg, i+1, j); @@ -1809,6 +1808,22 @@ DEFINE_POOL_CLASS(AMSDebugPoolClass, this) } +/* mps_class_ams -- return the AMS pool class descriptor */ + +mps_pool_class_t mps_class_ams(void) +{ + return (mps_pool_class_t)AMSPoolClassGet(); +} + + +/* mps_class_ams_debug -- return the AMS (debug) pool class descriptor */ + +mps_pool_class_t mps_class_ams_debug(void) +{ + return (mps_pool_class_t)AMSDebugPoolClassGet(); +} + + /* AMSCheck -- the check method for an AMS */ Bool AMSCheck(AMS ams) @@ -1831,7 +1846,7 @@ Bool AMSCheck(AMS ams) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2014 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolamsi.c b/mps/code/poolamsi.c deleted file mode 100644 index 20ed01d6b39..00000000000 --- a/mps/code/poolamsi.c +++ /dev/null @@ -1,69 +0,0 @@ -/* poolamsi.c: AUTOMATIC MARK & SWEEP POOL CLASS C INTERFACE - * - * $Id$ - * Copyright (c) 2001-2014 Ravenbrook Limited. See end of file for license. - */ - -#include "mpscams.h" -#include "mps.h" -#include "poolams.h" - -SRCID(poolamsi, "$Id$"); - - -/* mps_class_ams -- return the AMS pool class descriptor */ - -mps_pool_class_t mps_class_ams(void) -{ - return (mps_pool_class_t)AMSPoolClassGet(); -} - - -/* mps_class_ams_debug -- return the AMS (debug) pool class descriptor */ - -mps_pool_class_t mps_class_ams_debug(void) -{ - return (mps_pool_class_t)AMSDebugPoolClassGet(); -} - - -/* C. COPYRIGHT AND LICENSE - * - * Copyright (C) 2001-2014 Ravenbrook Limited . - * All rights reserved. This is an open source license. Contact - * Ravenbrook for commercial licensing options. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are - * met: - * - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * 3. Redistributions in any form must be accompanied by information on how - * to obtain complete source code for this software and any accompanying - * software that uses this software. The source code must either be - * included in the distribution or be available for no more than the cost - * of distribution plus a nominal fee, and must be freely redistributable - * under reasonable conditions. For an executable file, complete source - * code means the source code for all modules it contains. It does not - * include source code for modules or files that typically accompany the - * major components of the operating system on which the executable file - * runs. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS - * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED - * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR - * PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE - * COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, - * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT - * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF - * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON - * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT - * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF - * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - */ diff --git a/mps/code/poolawl.c b/mps/code/poolawl.c index 5bb0e6b9025..6d7c4d6efb2 100644 --- a/mps/code/poolawl.c +++ b/mps/code/poolawl.c @@ -1,7 +1,7 @@ /* poolawl.c: AUTOMATIC WEAK LINKED POOL CLASS * * $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. * * * DESIGN @@ -41,7 +41,7 @@ #include "mpscawl.h" #include "mpm.h" -#include "chain.h" +#include "locus.h" SRCID(poolawl, "$Id$"); @@ -901,9 +901,7 @@ static Res awlScanObject(Arena arena, AWL awl, ScanState ss, SegSetSummary(dependentSeg, RefSetUNIV); } - res = (*format->scan)(&ss->ss_s, base, limit); - if (res == ResOK) - ss->scannedSize += AddrOffset(base, limit); + res = FormatScan(format, ss, base, limit); if (dependent) ShieldCover(arena, dependentSeg); @@ -1376,7 +1374,7 @@ static Bool AWLCheck(AWL awl) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/poolsnc.c b/mps/code/poolsnc.c index f507d41222b..ef295fc7d9a 100644 --- a/mps/code/poolsnc.c +++ b/mps/code/poolsnc.c @@ -527,7 +527,7 @@ static Res SNCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) } if (base < limit) { - res = (*format->scan)(&ss->ss_s, base, limit); + res = FormatScan(format, ss, base, limit); if (res != ResOK) { *totalReturn = FALSE; return res; @@ -536,8 +536,6 @@ static Res SNCScan(Bool *totalReturn, ScanState ss, Pool pool, Seg seg) AVER(base == limit); } - ss->scannedSize += AddrOffset(base, limit); - *totalReturn = TRUE; return ResOK; } diff --git a/mps/code/prmci3fr.c b/mps/code/prmci3fr.c index 75cf94e871f..87ec5f436dc 100644 --- a/mps/code/prmci3fr.c +++ b/mps/code/prmci3fr.c @@ -38,17 +38,20 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc) } -Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) +Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc, + mps_area_scan_t scan_area, + void *closure) { Res res; /* This scans the root registers (.context.regroots). It also unnecessarily scans the rest of the context. The optimisation to scan only relevant parts would be machine dependent. */ - res = TraceScanAreaTagged( + res = TraceScanArea( ss, - (Addr *)mfc->ucontext, - (Addr *)((char *)mfc->ucontext + sizeof(*(mfc->ucontext))) + (Word *)mfc->ucontext, + (Word *)((char *)mfc->ucontext + sizeof(*(mfc->ucontext))), + scan_area, closure ); return res; diff --git a/mps/code/prmci3li.c b/mps/code/prmci3li.c index 08737d363c3..da04ac4810b 100644 --- a/mps/code/prmci3li.c +++ b/mps/code/prmci3li.c @@ -101,7 +101,9 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc) } -Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) +Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc, + mps_area_scan_t scan_area, + void *closure) { mcontext_t *mc; Res res; @@ -110,9 +112,10 @@ Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) unnecessarily scans the rest of the context. The optimisation to scan only relevant parts would be machine dependent. */ mc = &mfc->ucontext->uc_mcontext; - res = TraceScanAreaTagged(ss, - (Addr *)mc, - (Addr *)((char *)mc + sizeof(*mc))); + res = TraceScanArea(ss, + (Word *)mc, + (Word *)((char *)mc + sizeof(*mc)), + scan_area, closure); return res; } diff --git a/mps/code/prmci3xc.c b/mps/code/prmci3xc.c index 67f3f5822df..8eda902c244 100644 --- a/mps/code/prmci3xc.c +++ b/mps/code/prmci3xc.c @@ -96,7 +96,9 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc) } -Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) +Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc, + mps_area_scan_t scan_area, + void *closure) { x86_thread_state32_t *mc; Res res; @@ -105,9 +107,10 @@ Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) unnecessarily scans the rest of the context. The optimisation to scan only relevant parts would be machine dependent. */ mc = mfc->threadState; - res = TraceScanAreaTagged(ss, - (Addr *)mc, - (Addr *)((char *)mc + sizeof(*mc))); + res = TraceScanArea(ss, + (Word *)mc, + (Word *)((char *)mc + sizeof(*mc)), + scan_area, closure); return res; } diff --git a/mps/code/prmci6fr.c b/mps/code/prmci6fr.c index db20d01216b..b1c1a67590f 100644 --- a/mps/code/prmci6fr.c +++ b/mps/code/prmci6fr.c @@ -32,17 +32,20 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc) } -Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) +Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc, + mps_area_scan_t scan_area, + void *closure) { Res res; /* This scans the root registers (.context.regroots). It also unnecessarily scans the rest of the context. The optimisation to scan only relevant parts would be machine dependent. */ - res = TraceScanAreaTagged( + res = TraceScanArea( ss, - (Addr *)mfc->ucontext, - (Addr *)((char *)mfc->ucontext + sizeof(*(mfc->ucontext))) + (Word *)mfc->ucontext, + (Word *)((char *)mfc->ucontext + sizeof(*(mfc->ucontext))), + scan_area, closure ); return res; diff --git a/mps/code/prmci6li.c b/mps/code/prmci6li.c index 38b11c3a627..67354c99414 100644 --- a/mps/code/prmci6li.c +++ b/mps/code/prmci6li.c @@ -105,7 +105,9 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc) } -Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) +Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc, + mps_area_scan_t scan_area, + void *closure) { mcontext_t *mc; Res res; @@ -114,9 +116,10 @@ Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) unnecessarily scans the rest of the context. The optimisation to scan only relevant parts would be machine dependent. */ mc = &mfc->ucontext->uc_mcontext; - res = TraceScanAreaTagged(ss, - (Addr *)mc, - (Addr *)((char *)mc + sizeof(*mc))); + res = TraceScanArea(ss, + (Word *)mc, + (Word *)((char *)mc + sizeof(*mc)), + scan_area, closure); return res; } diff --git a/mps/code/prmci6xc.c b/mps/code/prmci6xc.c index 4d3a5afe156..ae8ef06f739 100644 --- a/mps/code/prmci6xc.c +++ b/mps/code/prmci6xc.c @@ -99,7 +99,9 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc) } -Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) +Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc, + mps_area_scan_t scan_area, + void *closure) { x86_thread_state64_t *mc; Res res; @@ -108,9 +110,10 @@ Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc) unnecessarily scans the rest of the context. The optimisation to scan only relevant parts would be machine dependent. */ mc = mfc->threadState; - res = TraceScanAreaTagged(ss, - (Addr *)mc, - (Addr *)((char *)mc + sizeof(*mc))); + res = TraceScanArea(ss, + (Word *)mc, + (Word *)((char *)mc + sizeof(*mc)), + scan_area, closure); return res; } diff --git a/mps/code/prot.h b/mps/code/prot.h index 7191cd01e86..f3104cb27b7 100644 --- a/mps/code/prot.h +++ b/mps/code/prot.h @@ -30,7 +30,9 @@ extern void ProtSync(Arena arena); extern Bool ProtCanStepInstruction(MutatorFaultContext context); extern Res ProtStepInstruction(MutatorFaultContext context); extern Addr MutatorFaultContextSP(MutatorFaultContext mfc); -extern Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc); +extern Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc, + mps_area_scan_t scan, + void *closure); #endif /* prot_h */ diff --git a/mps/code/root.c b/mps/code/root.c index 7a3e1205be2..63445f0ef21 100644 --- a/mps/code/root.c +++ b/mps/code/root.c @@ -1,7 +1,7 @@ /* root.c: ROOT IMPLEMENTATION * * $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: This is the implementation of the root datatype. * @@ -17,6 +17,11 @@ SRCID(root, "$Id$"); #define RootSig ((Sig)0x51960029) /* SIGnature ROOT */ +typedef union AreaScanUnion { + void *closure; + mps_scan_tag_s tag; /* tag for scanning */ +} AreaScanUnion; + typedef struct RootStruct { Sig sig; Serial serial; /* from arena->rootSerial */ @@ -34,24 +39,21 @@ typedef struct RootStruct { union RootUnion { struct { mps_root_scan_t scan; /* the function which does the scanning */ - void *p; /* environment for scan */ - size_t s; /* environment for scan */ + void *p; /* closure for scan function */ + size_t s; /* closure for scan function */ } fun; struct { - Addr *base; /* beginning of table */ - Addr *limit; /* one off end of table */ - } table; + Word *base; /* base of area to be scanned */ + Word *limit; /* limit of area to be scanned */ + mps_area_scan_t scan_area;/* area scanning function */ + AreaScanUnion the; + } area; struct { - Addr *base; /* beginning of table */ - Addr *limit; /* one off end of table */ - Word mask; /* tag mask for scanning */ - } tableMasked; - struct { - mps_reg_scan_t scan; /* function for scanning registers */ Thread thread; /* passed to scan */ - void *p; /* passed to scan */ - size_t s; /* passed to scan */ - } reg; + mps_area_scan_t scan_area;/* area scanner for stack and registers */ + AreaScanUnion the; + Word *stackCold; /* cold end of stack */ + } thread; struct { mps_fmt_scan_t scan; /* format-like scanner */ Addr base, limit; /* passed to scan */ @@ -66,8 +68,10 @@ typedef struct RootStruct { Bool RootVarCheck(RootVar rootVar) { - CHECKL(rootVar == RootTABLE || rootVar == RootTABLE_MASKED - || rootVar == RootFUN || rootVar == RootFMT || rootVar == RootREG); + CHECKL(rootVar == RootAREA || rootVar == RootAREA_TAGGED + || rootVar == RootFUN || rootVar == RootFMT + || rootVar == RootTHREAD + || rootVar == RootTHREAD_TAGGED); UNUSED(rootVar); return TRUE; } @@ -104,33 +108,42 @@ Bool RootCheck(Root root) /* Don't need to check var here, because of the switch below */ switch(root->var) { - case RootTABLE: - CHECKL(root->the.table.base != 0); - CHECKL(root->the.table.base < root->the.table.limit); + case RootAREA: + CHECKL(root->the.area.base != 0); + CHECKL(root->the.area.base < root->the.area.limit); + CHECKL(FUNCHECK(root->the.area.scan_area)); + /* Can't check anything about closure */ break; - case RootTABLE_MASKED: - CHECKL(root->the.tableMasked.base != 0); - CHECKL(root->the.tableMasked.base < root->the.tableMasked.limit); - /* Can't check anything about the mask. */ + case RootAREA_TAGGED: + CHECKL(root->the.area.base != 0); + CHECKL(root->the.area.base < root->the.area.limit); + CHECKL(FUNCHECK(root->the.area.scan_area)); + /* Can't check anything about tag as it could mean anything to + scan_area. */ break; - case RootFUN: + case RootFUN: CHECKL(root->the.fun.scan != NULL); + /* Can't check anything about closure as it could mean anything to + scan. */ break; - case RootREG: - CHECKL(root->the.reg.scan != NULL); - CHECKD_NOSIG(Thread, root->the.reg.thread); /* */ + case RootTHREAD_TAGGED: + CHECKD_NOSIG(Thread, root->the.thread.thread); /* */ + CHECKL(FUNCHECK(root->the.thread.scan_area)); + /* Can't check anything about tag as it could mean anything to + scan_area. */ + /* Can't check anything about stackCold. */ break; - case RootFMT: + case RootFMT: CHECKL(root->the.fmt.scan != NULL); CHECKL(root->the.fmt.base != 0); CHECKL(root->the.fmt.base < root->the.fmt.limit); break; - default: + default: NOTREACHED; } CHECKL(RootModeCheck(root->mode)); @@ -149,7 +162,7 @@ Bool RootCheck(Root root) } -/* rootCreate, RootCreateTable, RootCreateReg, RootCreateFmt, RootCreateFun +/* rootCreate, RootCreateArea, RootCreateThread, RootCreateFmt, RootCreateFun * * RootCreate* set up the appropriate union member, and call the generic * create function to do the actual creation @@ -168,6 +181,7 @@ static Res rootCreate(Root *rootReturn, Arena arena, AVER(rootReturn != NULL); AVERT(Arena, arena); AVERT(Rank, rank); + AVERT(RootMode, mode); AVERT(RootVar, type); globals = ArenaGlobals(arena); @@ -253,8 +267,11 @@ static Res rootCreateProtectable(Root *rootReturn, Arena arena, return ResOK; } -Res RootCreateTable(Root *rootReturn, Arena arena, - Rank rank, RootMode mode, Addr *base, Addr *limit) +Res RootCreateArea(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, + Word *base, Word *limit, + mps_area_scan_t scan_area, + void *closure) { Res res; union RootUnion theUnion; @@ -262,43 +279,54 @@ Res RootCreateTable(Root *rootReturn, Arena arena, AVER(rootReturn != NULL); AVERT(Arena, arena); AVERT(Rank, rank); + AVERT(RootMode, mode); AVER(base != 0); AVER(AddrIsAligned(base, sizeof(Word))); AVER(base < limit); AVER(AddrIsAligned(limit, sizeof(Word))); + AVER(FUNCHECK(scan_area)); + /* Can't check anything about closure */ - theUnion.table.base = base; - theUnion.table.limit = limit; + theUnion.area.base = base; + theUnion.area.limit = limit; + theUnion.area.scan_area = scan_area; + theUnion.area.the.closure = closure; res = rootCreateProtectable(rootReturn, arena, rank, mode, - RootTABLE, (Addr)base, (Addr)limit, &theUnion); + RootAREA, (Addr)base, (Addr)limit, &theUnion); return res; } -Res RootCreateTableMasked(Root *rootReturn, Arena arena, - Rank rank, RootMode mode, Addr *base, Addr *limit, - Word mask) +Res RootCreateAreaTagged(Root *rootReturn, Arena arena, + Rank rank, RootMode mode, Word *base, Word *limit, + mps_area_scan_t scan_area, Word mask, Word pattern) { union RootUnion theUnion; AVER(rootReturn != NULL); AVERT(Arena, arena); AVERT(Rank, rank); + AVERT(RootMode, mode); AVER(base != 0); AVER(base < limit); - /* Can't check anything about mask. */ + /* Can't check anything about mask or pattern, as they could mean + anything to scan_area. */ - theUnion.tableMasked.base = base; - theUnion.tableMasked.limit = limit; - theUnion.tableMasked.mask = mask; + theUnion.area.base = base; + theUnion.area.limit = limit; + theUnion.area.scan_area = scan_area; + theUnion.area.the.tag.mask = mask; + theUnion.area.the.tag.pattern = pattern; - return rootCreateProtectable(rootReturn, arena, rank, mode, RootTABLE_MASKED, + return rootCreateProtectable(rootReturn, arena, rank, mode, RootAREA_TAGGED, (Addr)base, (Addr)limit, &theUnion); } -Res RootCreateReg(Root *rootReturn, Arena arena, - Rank rank, Thread thread, - mps_reg_scan_t scan, void *p, size_t s) +Res RootCreateThread(Root *rootReturn, Arena arena, + Rank rank, Thread thread, + mps_area_scan_t scan_area, + void *closure, + Word *stackCold) { union RootUnion theUnion; @@ -307,14 +335,43 @@ Res RootCreateReg(Root *rootReturn, Arena arena, AVERT(Rank, rank); AVERT(Thread, thread); AVER(ThreadArena(thread) == arena); - AVER(scan != NULL); + AVER(FUNCHECK(scan_area)); + /* Can't check anything about closure. */ - theUnion.reg.scan = scan; - theUnion.reg.thread = thread; - theUnion.reg.p = p; - theUnion.reg.s = s; + theUnion.thread.thread = thread; + theUnion.thread.scan_area = scan_area; + theUnion.thread.the.closure = closure; + theUnion.thread.stackCold = stackCold; - return rootCreate(rootReturn, arena, rank, (RootMode)0, RootREG, &theUnion); + return rootCreate(rootReturn, arena, rank, (RootMode)0, RootTHREAD, + &theUnion); +} + +Res RootCreateThreadTagged(Root *rootReturn, Arena arena, + Rank rank, Thread thread, + mps_area_scan_t scan_area, + Word mask, Word pattern, + Word *stackCold) +{ + union RootUnion theUnion; + + AVER(rootReturn != NULL); + AVERT(Arena, arena); + AVERT(Rank, rank); + AVERT(Thread, thread); + AVER(ThreadArena(thread) == arena); + AVER(FUNCHECK(scan_area)); + /* Can't check anything about mask or pattern, as they could mean + anything to scan_area. */ + + theUnion.thread.thread = thread; + theUnion.thread.scan_area = scan_area; + theUnion.thread.the.tag.mask = mask; + theUnion.thread.the.tag.pattern = pattern; + theUnion.thread.stackCold = stackCold; + + return rootCreate(rootReturn, arena, rank, (RootMode)0, RootTHREAD_TAGGED, + &theUnion); } /* RootCreateFmt -- create root from block of formatted objects @@ -333,6 +390,7 @@ Res RootCreateFmt(Root *rootReturn, Arena arena, AVER(rootReturn != NULL); AVERT(Arena, arena); AVERT(Rank, rank); + AVERT(RootMode, mode); AVER(FUNCHECK(scan)); AVER(base != 0); AVER(base < limit); @@ -470,44 +528,60 @@ Res RootScan(ScanState ss, Root root) } switch(root->var) { - case RootTABLE: - res = TraceScanArea(ss, root->the.table.base, root->the.table.limit); - ss->scannedSize += AddrOffset(root->the.table.base, root->the.table.limit); + case RootAREA: + res = TraceScanArea(ss, + root->the.area.base, + root->the.area.limit, + root->the.area.scan_area, + root->the.area.the.closure); if (res != ResOK) goto failScan; break; - case RootTABLE_MASKED: - res = TraceScanAreaMasked(ss, - root->the.tableMasked.base, - root->the.tableMasked.limit, - root->the.tableMasked.mask); - ss->scannedSize += AddrOffset(root->the.table.base, root->the.table.limit); + case RootAREA_TAGGED: + res = TraceScanArea(ss, + root->the.area.base, + root->the.area.limit, + root->the.area.scan_area, + &root->the.area.the.tag); if (res != ResOK) goto failScan; break; - case RootFUN: - res = (*root->the.fun.scan)(&ss->ss_s, root->the.fun.p, root->the.fun.s); + case RootFUN: + res = root->the.fun.scan(&ss->ss_s, + root->the.fun.p, + root->the.fun.s); if (res != ResOK) goto failScan; break; - case RootREG: - res = (*root->the.reg.scan)(&ss->ss_s, root->the.reg.thread, - root->the.reg.p, root->the.reg.s); + case RootTHREAD: + res = ThreadScan(ss, root->the.thread.thread, + root->the.thread.stackCold, + root->the.thread.scan_area, + root->the.thread.the.closure); if (res != ResOK) goto failScan; break; - case RootFMT: + case RootTHREAD_TAGGED: + res = ThreadScan(ss, root->the.thread.thread, + root->the.thread.stackCold, + root->the.thread.scan_area, + &root->the.thread.the.tag); + if (res != ResOK) + goto failScan; + break; + + case RootFMT: res = (*root->the.fmt.scan)(&ss->ss_s, root->the.fmt.base, root->the.fmt.limit); ss->scannedSize += AddrOffset(root->the.fmt.base, root->the.fmt.limit); if (res != ResOK) goto failScan; break; - default: + default: NOTREACHED; res = ResUNIMPL; goto failScan; @@ -624,47 +698,63 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth) return res; switch(root->var) { - case RootTABLE: + case RootAREA: res = WriteF(stream, depth + 2, - "table base $A limit $A\n", - (WriteFA)root->the.table.base, - (WriteFA)root->the.table.limit, + "area base $A limit $A scan_area closure $P\n", + (WriteFA)root->the.area.base, + (WriteFA)root->the.area.limit, + (WriteFP)root->the.area.the.closure, NULL); if (res != ResOK) return res; break; - case RootTABLE_MASKED: + case RootAREA_TAGGED: res = WriteF(stream, depth + 2, - "table base $A limit $A mask $B\n", - (WriteFA)root->the.tableMasked.base, - (WriteFA)root->the.tableMasked.limit, - (WriteFB)root->the.tableMasked.mask, + "area base $A limit $A scan_area mask $B pattern $B\n", + (WriteFA)root->the.area.base, + (WriteFA)root->the.area.limit, + (WriteFB)root->the.area.the.tag.mask, + (WriteFB)root->the.area.the.tag.pattern, NULL); if (res != ResOK) return res; break; - case RootFUN: + case RootFUN: res = WriteF(stream, depth + 2, "scan function $F\n", (WriteFF)root->the.fun.scan, "environment p $P s $W\n", - (WriteFP)root->the.fun.p, (WriteFW)root->the.fun.s, + (WriteFP)root->the.fun.p, + (WriteFW)root->the.fun.s, NULL); if (res != ResOK) return res; break; - case RootREG: + case RootTHREAD: res = WriteF(stream, depth + 2, - "thread $P\n", (WriteFP)root->the.reg.thread, - "environment p $P", (WriteFP)root->the.reg.p, + "thread $P\n", (WriteFP)root->the.thread.thread, + "closure $P\n", + (WriteFP)root->the.thread.the.closure, + "stackCold $P\n", (WriteFP)root->the.thread.stackCold, NULL); if (res != ResOK) return res; break; - case RootFMT: + case RootTHREAD_TAGGED: + res = WriteF(stream, depth + 2, + "thread $P\n", (WriteFP)root->the.thread.thread, + "mask $B\n", (WriteFB)root->the.thread.the.tag.mask, + "pattern $B\n", (WriteFB)root->the.thread.the.tag.pattern, + "stackCold $P\n", (WriteFP)root->the.thread.stackCold, + NULL); + if (res != ResOK) + return res; + break; + + case RootFMT: res = WriteF(stream, depth + 2, "scan function $F\n", (WriteFF)root->the.fmt.scan, "format base $A limit $A\n", @@ -674,7 +764,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth) return res; break; - default: + default: NOTREACHED; } @@ -707,7 +797,7 @@ Res RootsDescribe(Globals arenaGlobals, mps_lib_FILE *stream, Count depth) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited . + * Copyright (C) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/sc.h b/mps/code/sc.h index 765c4ccb033..da4a9c8eac5 100644 --- a/mps/code/sc.h +++ b/mps/code/sc.h @@ -38,7 +38,7 @@ * setjmp magic. */ -/* StackContextStackTop - return the stack top from the stack context. +/* StackContextStackHot - return the hot end of the stack from the stack context * * We assume the stack is full. In other words the stack top points at * a word that contains a potential Ref. @@ -68,7 +68,7 @@ typedef struct StackContextStruct { * which we assume to be stored on the stack because it is no longer * needed once we have _longjmp()ed back. So take the minimum of the * SP and the base of the StackContext structure. */ -#define StackContextStackTop(sc) \ +#define StackContextStackHot(sc) \ (StackContextSP(sc) < (Addr*)(sc) ? StackContextSP(sc) : (Addr*)(sc)) @@ -103,7 +103,7 @@ typedef struct StackContextStruct { * which we assume to be stored on the stack because it is no longer * needed once we have _longjmp()ed back. So take the minimum of the * SP and the base of the StackContext structure. */ -#define StackContextStackTop(sc) \ +#define StackContextStackHot(sc) \ (StackContextSP(sc) < (Addr*)(sc) ? StackContextSP(sc) : (Addr*)(sc)) @@ -119,7 +119,7 @@ typedef struct StackContextStruct { #define STACK_CONTEXT_SAVE(sc) ((void)setjmp((sc)->jumpBuffer)) -#define StackContextStackTop(sc) \ +#define StackContextStackHot(sc) \ ((Addr *)((_JUMP_BUFFER *)(sc)->jumpBuffer)->Esp) @@ -135,7 +135,7 @@ typedef struct StackContextStruct { #define STACK_CONTEXT_SAVE(sc) ((void)setjmp((sc)->jumpBuffer)) -#define StackContextStackTop(sc) \ +#define StackContextStackHot(sc) \ ((Addr *)((_JUMP_BUFFER *)(sc)->jumpBuffer)->Rsp) @@ -155,7 +155,7 @@ typedef struct StackContextStruct { #define STACK_CONTEXT_SAVE(sc) ((void)setjmp((sc)->jumpBuffer)) -#define StackContextStackTop(sc) ((Addr *)(sc)->jumpBuffer) +#define StackContextStackHot(sc) ((Addr *)(sc)->jumpBuffer) #endif /* platform defines */ diff --git a/mps/code/scan.c b/mps/code/scan.c new file mode 100644 index 00000000000..b4c4eceae3f --- /dev/null +++ b/mps/code/scan.c @@ -0,0 +1,187 @@ +/* scan.c: SCANNING FUNCTIONS + * + * $Id$ + * Copyright (c) 2001-2016 Ravenbrook Limited. + * See end of file for license. + * + * .outside: The code in this file is written as if *outside* the MPS, + * and so is restricted to facilities in the MPS interface. MPS users + * are invited to read this code and use it as a basis for their own + * scanners. See topic "Area Scanners" in the MPS manual. + * + * TODO: Design document. + */ + +#include "mps.h" +#include "mpstd.h" /* for MPS_BUILD_MV */ + + +#ifdef MPS_BUILD_MV +/* MSVC warning 4127 = conditional expression is constant */ +/* Objects to: MPS_SCAN_AREA(1). */ +#pragma warning( disable : 4127 ) +#endif + + +#define MPS_SCAN_AREA(test) \ + MPS_SCAN_BEGIN(ss) { \ + mps_word_t *p = base; \ + while (p < (mps_word_t *)limit) { \ + mps_word_t word = *p; \ + mps_word_t tag_bits = word & mask; \ + if (test) { \ + mps_addr_t ref = (mps_addr_t)(word ^ tag_bits); \ + if (MPS_FIX1(ss, ref)) { \ + mps_res_t res = MPS_FIX2(ss, &ref); \ + if (res != MPS_RES_OK) \ + return res; \ + *p = (mps_word_t)ref | tag_bits; \ + } \ + } \ + ++p; \ + } \ + } MPS_SCAN_END(ss); + + +/* mps_scan_area -- scan contiguous area of references + * + * This is a convenience function for scanning the contiguous area + * [base, limit). I.e., it calls Fix on all words from base up to + * limit, inclusive of base and exclusive of limit. + * + * This scanner is appropriate for use when all words in the area are + * simple untagged references. + */ + +mps_res_t mps_scan_area(mps_ss_t ss, + void *base, void *limit, + void *closure) +{ + mps_word_t mask = 0; + + (void)closure; /* unused */ + + MPS_SCAN_AREA(1); + + return MPS_RES_OK; +} + + +/* mps_scan_area_masked -- scan area masking off tag bits + * + * Like mps_scan_area, but removes tag bits before fixing references, + * and restores them afterwards. + * + * For example, if mask is 7, then this scanner will clear the bottom + * three bits of each word before fixing. + * + * This scanner is useful when all words in the area must be treated + * as references no matter what tag they have. + */ + +mps_res_t mps_scan_area_masked(mps_ss_t ss, + void *base, void *limit, + void *closure) +{ + mps_scan_tag_t tag = closure; + mps_word_t mask = tag->mask; + + MPS_SCAN_AREA(1); + + return MPS_RES_OK; +} + + +/* mps_scan_area_tagged -- scan area selecting by tag + * + * Like mps_scan_area_masked, except only references whose masked bits + * match a particular tag pattern are fixed. + * + * For example, if mask is 7 and pattern is 5, then this scanner will + * only fix words whose low order bits are 0b101. + */ + +mps_res_t mps_scan_area_tagged(mps_ss_t ss, + void *base, void *limit, + void *closure) +{ + mps_scan_tag_t tag = closure; + mps_word_t mask = tag->mask; + mps_word_t pattern = tag->pattern; + + MPS_SCAN_AREA(tag_bits == pattern); + + return MPS_RES_OK; +} + + +/* mps_scan_area_tagged_or_zero -- scan area selecting by tag or zero + * + * Like mps_scan_area_tagged, except references whose masked bits are + * zero are fixed in addition to those that match the pattern. + * + * For example, if mask is 7 and pattern is 3, then this scanner will + * fix words whose low order bits are 0b011 and words whose low order + * bits are 0b000, but not any others. + * + * This scanner is most useful for ambiguously scanning the stack and + * registers when using an optimising C compiler and non-zero tags on + * references, since the compiler is likely to leave untagged + * addresses of objects around which must not be ignored. + */ + +mps_res_t mps_scan_area_tagged_or_zero(mps_ss_t ss, + void *base, void *limit, + void *closure) +{ + mps_scan_tag_t tag = closure; + mps_word_t mask = tag->mask; + mps_word_t pattern = tag->pattern; + + MPS_SCAN_AREA(tag_bits == 0 || tag_bits == pattern); + + return MPS_RES_OK; +} + + +/* C. COPYRIGHT AND LICENSE + * + * Copyright (C) 2001-2016 Ravenbrook Limited + * . + * All rights reserved. This is an open source license. Contact + * Ravenbrook for commercial licensing options. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are + * met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * 3. Redistributions in any form must be accompanied by information on how + * to obtain complete source code for this software and any accompanying + * software that uses this software. The source code must either be + * included in the distribution or be available for no more than the cost + * of distribution plus a nominal fee, and must be freely redistributable + * under reasonable conditions. For an executable file, complete source + * code means the source code for all modules it contains. It does not + * include source code for modules or files that typically accompany the + * major components of the operating system on which the executable file + * runs. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS + * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED + * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR + * PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF + * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON + * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ diff --git a/mps/code/segsmss.c b/mps/code/segsmss.c index a271a582f7c..73f3f79461b 100644 --- a/mps/code/segsmss.c +++ b/mps/code/segsmss.c @@ -1,7 +1,7 @@ /* segsmss.c: Segment splitting and merging 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 amsss.c (because AMS already supports @@ -17,7 +17,7 @@ #include "fmtdytst.h" #include "testlib.h" #include "mpslib.h" -#include "chain.h" +#include "locus.h" #include "mpscams.h" #include "mpsavm.h" #include "mpstd.h" @@ -885,7 +885,7 @@ int main(int argc, char *argv[]) /* C. COPYRIGHT AND LICENSE * - * Copyright (c) 2001-2014 Ravenbrook Limited . + * Copyright (c) 2001-2016 Ravenbrook Limited . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. * diff --git a/mps/code/ss.c b/mps/code/ss.c index 8c5bc44b022..506001d04d2 100644 --- a/mps/code/ss.c +++ b/mps/code/ss.c @@ -24,20 +24,24 @@ SRCID(ss, "$Id$"); * scanning. */ -Res StackScanInner(ScanState ss, - Addr *stackBot, - Addr *stackTop, - Count nSavedRegs) +Res StackScanInner(ScanState ss, Word *stackCold, Word *stackHot, + Count nSavedRegs, + mps_area_scan_t scan_area, void *closure) { Arena arena; Res res; AVERT(ScanState, ss); - AVER(stackTop < stackBot); - AVER(AddrIsAligned((Addr)stackTop, sizeof(Addr))); /* .assume.align */ AVER(0 < nSavedRegs); AVER(nSavedRegs < 128); /* sanity check */ + /* .assume.stack: This implementation assumes that the stack grows + * downwards, so that the address of the jmp_buf is the base of the + * part of the stack that needs to be scanned. (StackScanInner makes + * the same assumption.) + */ + AVER(stackHot < stackCold); + arena = ss->arena; /* If a stack pointer was stored when we entered the arena (through the @@ -47,16 +51,19 @@ Res StackScanInner(ScanState ss, (trans.c). Otherwise, scan the whole stack. */ if (arena->stackAtArenaEnter != NULL) { - AVER(stackTop < arena->stackAtArenaEnter); - AVER(arena->stackAtArenaEnter < stackBot); - res = TraceScanAreaTagged(ss, stackTop, stackTop + nSavedRegs); + AVER(stackHot < arena->stackAtArenaEnter); /* .assume.stack */ + AVER(arena->stackAtArenaEnter < stackCold); /* .assume.stack */ + res = TraceScanArea(ss, stackHot, stackHot + nSavedRegs, + scan_area, closure); if (res != ResOK) return res; - res = TraceScanAreaTagged(ss, arena->stackAtArenaEnter, stackBot); + res = TraceScanArea(ss, arena->stackAtArenaEnter, stackCold, + scan_area, closure); if (res != ResOK) return res; } else { - res = TraceScanAreaTagged(ss, stackTop, stackBot); + res = TraceScanArea(ss, stackHot, stackCold, + scan_area, closure); if (res != ResOK) return res; } diff --git a/mps/code/ss.h b/mps/code/ss.h index 831ad98aea8..75d939194e2 100644 --- a/mps/code/ss.h +++ b/mps/code/ss.h @@ -14,31 +14,29 @@ /* StackScan -- scan the current thread's stack * - * StackScan scans the stack of the current thread, Between stackBot and the - * current top of stack. It also fixes any roots which may be in callee-save - * registers. + * StackScan scans the stack of the current thread, Between stackCold + * and the current hot end of the stack. It also fixes any roots which + * may be in callee-save registers. * * See the specific implementation for the exact registers which are scanned. * * If a stack pointer has been stashed at arena entry (through the MPS * interface in mpsi*.c) then only the registers and the stack between - * stackAtArenaEnter and stackBot is scanned, to avoid scanning false + * stackAtArenaEnter and stackCold is scanned, to avoid scanning false * ambiguous references on the MPS's own stack. This is particularly * important for transforms (trans.c). * - * The word pointed to by stackBot is fixed if the stack is by convention + * The word pointed to by stackCold is fixed if the stack is by convention * empty, and not fixed if it is full. Where empty means sp points to first * free word beyond the top of stack. Full means sp points to the top of * stack itself. */ -extern Res StackScan(ScanState ss, Addr *stackBot); - - -extern Res StackScanInner(ScanState ss, - Addr *stackBot, - Addr *stackTop, - Count nSavedRegs); +extern Res StackScan(ScanState ss, Word *stackCold, + mps_area_scan_t scan_area, void *closure); +extern Res StackScanInner(ScanState ss, Word *stackCold, Word *stackHot, + Count nSavedRegs, + mps_area_scan_t scan_area, void *closure); #endif /* ss_h */ diff --git a/mps/code/ssan.c b/mps/code/ssan.c index 27233e7b9f6..fc3c0ec84df 100644 --- a/mps/code/ssan.c +++ b/mps/code/ssan.c @@ -21,21 +21,17 @@ SRCID(ssan, "$Id$"); -Res StackScan(ScanState ss, Addr *stackBot) +Res StackScan(ScanState ss, Word *stackCold, + mps_area_scan_t scan_area, + void *closure) { jmp_buf jb; - void *stackTop = &jb; - - /* .assume.stack: This implementation assumes that the stack grows - * downwards, so that the address of the jmp_buf is the limit of the - * part of the stack that needs to be scanned. (StackScanInner makes - * the same assumption.) - */ - AVER(stackTop < (void *)stackBot); + Word *stackHot = (void *)&jb; (void)setjmp(jb); - return StackScanInner(ss, stackBot, stackTop, sizeof jb / sizeof(Addr*)); + return StackScanInner(ss, stackCold, stackHot, sizeof jb / sizeof(Word), + scan_area, closure); } diff --git a/mps/code/ssixi3.c b/mps/code/ssixi3.c index 8cc1f8cbd45..a922cabc5a6 100644 --- a/mps/code/ssixi3.c +++ b/mps/code/ssixi3.c @@ -49,9 +49,11 @@ SRCID(ssixi3, "$Id$"); #define ASMV(x) __asm__ volatile (x) -Res StackScan(ScanState ss, Addr *stackBot) +Res StackScan(ScanState ss, Word *stackCold, + mps_area_scan_t scan_area, + void *closure) { - Addr calleeSaveRegs[4]; + Word calleeSaveRegs[4]; /* .assume.asm.stack */ /* Store the callee save registers on the stack so they get scanned @@ -62,7 +64,8 @@ Res StackScan(ScanState ss, Addr *stackBot) ASMV("mov %%edi, %0" : "=m" (calleeSaveRegs[2])); ASMV("mov %%ebp, %0" : "=m" (calleeSaveRegs[3])); - return StackScanInner(ss, stackBot, calleeSaveRegs, NELEMS(calleeSaveRegs)); + return StackScanInner(ss, stackCold, calleeSaveRegs, NELEMS(calleeSaveRegs), + scan_area, closure); } diff --git a/mps/code/ssixi6.c b/mps/code/ssixi6.c index e61af2ee961..2d70d62697c 100644 --- a/mps/code/ssixi6.c +++ b/mps/code/ssixi6.c @@ -47,9 +47,11 @@ SRCID(ssixi6, "$Id$"); #define ASMV(x) __asm__ volatile (x) -Res StackScan(ScanState ss, Addr *stackBot) +Res StackScan(ScanState ss, Word *stackCold, + mps_area_scan_t scan_area, + void *closure) { - Addr calleeSaveRegs[6]; + Word calleeSaveRegs[6]; /* .assume.asm.stack */ /* Store the callee save registers on the stack so they get scanned @@ -62,7 +64,8 @@ Res StackScan(ScanState ss, Addr *stackBot) ASMV("mov %%r14, %0" : "=m" (calleeSaveRegs[4])); ASMV("mov %%r15, %0" : "=m" (calleeSaveRegs[5])); - return StackScanInner(ss, stackBot, calleeSaveRegs, NELEMS(calleeSaveRegs)); + return StackScanInner(ss, stackCold, calleeSaveRegs, NELEMS(calleeSaveRegs), + scan_area, closure); } diff --git a/mps/code/ssw3i3mv.c b/mps/code/ssw3i3mv.c index d879780734a..2b2d0bd4d08 100644 --- a/mps/code/ssw3i3mv.c +++ b/mps/code/ssw3i3mv.c @@ -22,7 +22,9 @@ SRCID(ssw3i3mv, "$Id$"); -Res StackScan(ScanState ss, Addr *stackBot) +Res StackScan(ScanState ss, Word *stackCold, + mps_area_scan_t scan_area, + void *closure) { jmp_buf jb; @@ -33,16 +35,17 @@ Res StackScan(ScanState ss, Addr *stackBot) /* These checks will just serve to warn us at compile-time if the setjmp.h header changes to indicate that the registers we want aren't saved any more. */ - AVER(sizeof(((_JUMP_BUFFER *)jb)->Edi) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->Esi) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->Ebx) == sizeof(Addr)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Ebx) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Edi) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Esi) == sizeof(Word)); /* Ensure that the callee-save registers will be found by StackScanInner when it's passed the address of the Ebx field. */ AVER(offsetof(_JUMP_BUFFER, Edi) == offsetof(_JUMP_BUFFER, Ebx) + 4); AVER(offsetof(_JUMP_BUFFER, Esi) == offsetof(_JUMP_BUFFER, Ebx) + 8); - return StackScanInner(ss, stackBot, (Addr *)&((_JUMP_BUFFER *)jb)->Ebx, 3); + return StackScanInner(ss, stackCold, (Word *)&((_JUMP_BUFFER *)jb)->Ebx, 3, + scan_area, closure); } /* C. COPYRIGHT AND LICENSE diff --git a/mps/code/ssw3i3pc.c b/mps/code/ssw3i3pc.c index e03754c7eba..bead20fe898 100644 --- a/mps/code/ssw3i3pc.c +++ b/mps/code/ssw3i3pc.c @@ -46,19 +46,29 @@ typedef struct __JUMP_BUFFER { } _JUMP_BUFFER; -Res StackScan(ScanState ss, Addr *stackBot) +Res StackScan(ScanState ss, Word *stackCold, + mps_area_scan_t scan_area, + void *closure) { jmp_buf jb; /* .assume.ms-compat */ (void)setjmp(jb); + /* These checks, on the _JUMP_BUFFER defined above, are mainly here + * to maintain similarity to the matching code on the MPS_BUILD_MV + * version of this code. */ + AVER(sizeof(((_JUMP_BUFFER *)jb)->Ebx) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Edi) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Esi) == sizeof(Word)); + /* Ensure that the callee-save registers will be found by StackScanInner when it's passed the address of the Ebx field. */ AVER(offsetof(_JUMP_BUFFER, Edi) == offsetof(_JUMP_BUFFER, Ebx) + 4); AVER(offsetof(_JUMP_BUFFER, Esi) == offsetof(_JUMP_BUFFER, Ebx) + 8); - return StackScanInner(ss, stackBot, (Addr *)&((_JUMP_BUFFER *)jb)->Ebx, 3); + return StackScanInner(ss, stackCold, (Word *)&((_JUMP_BUFFER *)jb)->Ebx, 3, + scan_area, closure); } diff --git a/mps/code/ssw3i6mv.c b/mps/code/ssw3i6mv.c index 16c33e3fb74..c95f8c30608 100644 --- a/mps/code/ssw3i6mv.c +++ b/mps/code/ssw3i6mv.c @@ -30,7 +30,8 @@ SRCID(ssw3i6mv, "$Id$"); -Res StackScan(ScanState ss, Addr *stackBot) +Res StackScan(ScanState ss, Word *stackCold, + mps_area_scan_t scan_area, void *closure) { jmp_buf jb; @@ -41,13 +42,15 @@ Res StackScan(ScanState ss, Addr *stackBot) /* These checks will just serve to warn us at compile-time if the setjmp.h header changes to indicate that the registers we want aren't saved any more. */ - AVER(sizeof(((_JUMP_BUFFER *)jb)->Rdi) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->Rsi) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->Rbp) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->R12) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->R13) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->R14) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->R15) == sizeof(Addr)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rbx) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rsp) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rbp) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rsi) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rdi) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->R12) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->R13) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->R14) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->R15) == sizeof(Word)); /* The layout of the jmp_buf forces us to harmlessly scan Rsp as well. */ AVER(offsetof(_JUMP_BUFFER, Rsp) == offsetof(_JUMP_BUFFER, Rbx) + 8); @@ -59,7 +62,8 @@ Res StackScan(ScanState ss, Addr *stackBot) AVER(offsetof(_JUMP_BUFFER, R14) == offsetof(_JUMP_BUFFER, Rbx) + 56); AVER(offsetof(_JUMP_BUFFER, R15) == offsetof(_JUMP_BUFFER, Rbx) + 64); - return StackScanInner(ss, stackBot, (Addr *)&((_JUMP_BUFFER *)jb)->Rbx, 9); + return StackScanInner(ss, stackCold, (Word *)&((_JUMP_BUFFER *)jb)->Rbx, 9, + scan_area, closure); } /* C. COPYRIGHT AND LICENSE diff --git a/mps/code/ssw3i6pc.c b/mps/code/ssw3i6pc.c index 89fbbeac420..5e8818282ac 100644 --- a/mps/code/ssw3i6pc.c +++ b/mps/code/ssw3i6pc.c @@ -68,7 +68,7 @@ typedef struct _JUMP_BUFFER { } _JUMP_BUFFER; -Res StackScan(ScanState ss, Addr *stackBot) +Res StackScan(ScanState ss, Word *stackCold, Word mask, Word pattern) { jmp_buf jb; @@ -76,16 +76,18 @@ Res StackScan(ScanState ss, Addr *stackBot) registers in the jmp_buf. */ (void)setjmp(jb); - /* These checks will just serve to warn us at compile-time if the - setjmp.h header changes to indicate that the registers we want aren't - saved any more. */ - AVER(sizeof(((_JUMP_BUFFER *)jb)->Rdi) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->Rsi) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->Rbp) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->R12) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->R13) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->R14) == sizeof(Addr)); - AVER(sizeof(((_JUMP_BUFFER *)jb)->R15) == sizeof(Addr)); + /* These checks, on the _JUMP_BUFFER defined above, are mainly here + * to maintain similarity to the matching code on the MPS_BUILD_MV + * version of this code. */ + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rbx) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rsp) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rbp) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rsi) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->Rdi) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->R12) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->R13) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->R14) == sizeof(Word)); + AVER(sizeof(((_JUMP_BUFFER *)jb)->R15) == sizeof(Word)); /* The layout of the jmp_buf forces us to harmlessly scan Rsp as well. */ AVER(offsetof(_JUMP_BUFFER, Rsp) == offsetof(_JUMP_BUFFER, Rbx) + 8); @@ -97,7 +99,8 @@ Res StackScan(ScanState ss, Addr *stackBot) AVER(offsetof(_JUMP_BUFFER, R14) == offsetof(_JUMP_BUFFER, Rbx) + 56); AVER(offsetof(_JUMP_BUFFER, R15) == offsetof(_JUMP_BUFFER, Rbx) + 64); - return StackScanInner(ss, stackBot, (Addr *)&((_JUMP_BUFFER *)jb)->Rbx, 9); + return StackScanInner(ss, stackCold, (Word *)&((_JUMP_BUFFER *)jb)->Rbx, 9, + mask, pattern); } diff --git a/mps/code/tagtest.c b/mps/code/tagtest.c new file mode 100644 index 00000000000..fda27efd9b7 --- /dev/null +++ b/mps/code/tagtest.c @@ -0,0 +1,307 @@ +/* tagtest.c: TAGGED POINTER TEST + * + * $Id$ + * Copyright (c) 2015 Ravenbrook Limited. See end of file for license. + * + * .overview: This test case checks that the MPS correctly handles + * tagged pointers via the object format and tagged area scanning. + */ + +#include /* printf */ + +#include "mpm.h" +#include "mps.h" +#include "mpsavm.h" +#include "mpscamc.h" +#include "testlib.h" + +#define OBJCOUNT 1000 /* Number of conses to allocate */ + +typedef struct cons_s { + mps_word_t car, cdr; +} cons_s, *cons_t; + +typedef mps_word_t imm_t; /* Immediate value. */ +typedef mps_word_t fwd_t; /* Fowarding pointer. */ + +static mps_word_t tag_bits; /* Number of tag bits */ +static mps_word_t tag_cons; /* Tag bits indicating pointer to cons */ +static mps_word_t tag_fwd; /* Tag bits indicating forwarding pointer */ +static mps_word_t tag_imm; /* Tag bits indicating immediate value */ +static mps_word_t tag_invalid; /* Invalid tag bits */ +static mps_addr_t refs[OBJCOUNT]; /* Tagged references to objects */ + +#define TAG_COUNT ((mps_word_t)1 << tag_bits) /* Number of distinct tags */ +#define TAG_MASK (TAG_COUNT - 1) /* Tag mask */ +#define TAG(word) ((mps_word_t)(word) & TAG_MASK) +#define TAGGED(value, type) (((mps_word_t)(value) & ~TAG_MASK) + tag_ ## type) +#define UNTAGGED(word, type) ((type ## _t)((mps_word_t)(word) & ~TAG_MASK)) + +static mps_word_t make_cons(mps_ap_t ap, mps_word_t car, mps_word_t cdr) +{ + cons_t obj; + mps_addr_t addr; + size_t size = sizeof(cons_s); + do { + mps_res_t res = mps_reserve(&addr, ap, size); + if (res != MPS_RES_OK) error("out of memory in cons"); + obj = addr; + obj->car = car; + obj->cdr = cdr; + } while (!mps_commit(ap, addr, size)); + return TAGGED(obj, cons); +} + +static void fwd(mps_addr_t old, mps_addr_t new) +{ + cons_t cons = old; + cons->car = TAGGED(0, fwd); + cons->cdr = (mps_word_t)new; +} + +static mps_addr_t isfwd(mps_addr_t addr) +{ + cons_t cons = addr; + if (TAG(cons->car) != tag_fwd) + return NULL; + return (mps_addr_t)cons->cdr; +} + +static void pad(mps_addr_t addr, size_t size) +{ + mps_word_t *word = addr; + mps_word_t *limit = (mps_word_t *)((char *)addr + size); + while (word < limit) { + *word = TAGGED(0, imm); + ++ word; + } +} + +static mps_res_t scan(mps_ss_t ss, mps_addr_t base, + mps_addr_t limit) +{ + MPS_SCAN_BEGIN(ss) { + mps_word_t *p = base; + while (p < (mps_word_t *)limit) { + mps_word_t word = *p; + mps_word_t tag = TAG(word); + if (tag == tag_cons) { + mps_addr_t ref = UNTAGGED(word, cons); + if (MPS_FIX1(ss, ref)) { + mps_res_t res = MPS_FIX2(ss, &ref); + if (res != MPS_RES_OK) + return res; + *p = TAGGED(ref, cons); + } + } + ++p; + } + } MPS_SCAN_END(ss); + return MPS_RES_OK; +} + +static mps_addr_t skip(mps_addr_t addr) +{ + return (mps_addr_t)((char *)addr + sizeof(cons_s)); +} + + +static void collect(mps_arena_t arena, size_t expected) +{ + size_t finalized = 0; + mps_arena_collect(arena); + while (mps_message_poll(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); + Insist(TAG(objaddr) == 0); + mps_message_discard(arena, message); + ++ finalized; + } + printf("finalized=%lu expected=%lu\n", + (unsigned long)finalized, (unsigned long)expected); + Insist(finalized == expected); +} + + +/* test -- Run the test case in the specified mode. */ + +#define MODES(R, X) \ + R(X, CONS, "Scan words tagged \"cons\".") \ + R(X, INVALID, "Scan words tagged \"invalid\".") + +#define MODES_ENUM(X, id, comment) MODE_ ## id, + +enum { + MODES(MODES_ENUM, X) + MODE_LIMIT +}; + +#define MODES_NAME(X, id, comment) #id, + +static const char *mode_name[] = { + MODES(MODES_NAME, X) +}; + + +static void test(int mode) +{ + mps_arena_t arena; + mps_thr_t thread; + mps_root_t root; + mps_fmt_t fmt; + mps_pool_t pool; + mps_ap_t ap; + size_t expected = 0; + size_t i; + + printf("test(%s)\n", mode_name[mode]); + + die(mps_arena_create(&arena, mps_arena_class_vm(), mps_args_none), "arena"); + mps_message_type_enable(arena, mps_message_type_finalization()); + die(mps_thread_reg(&thread, arena), "thread"); + + switch (mode) { + default: + Insist(0); + /* fall through */ + case MODE_CONS: + /* Scan words tagged "cons" -- everything will live. */ + die(mps_root_create_area_tagged(&root, arena, mps_rank_ambig(), 0, + refs, refs + OBJCOUNT, + mps_scan_area_tagged, TAG_MASK, tag_cons), + "root"); + expected = 0; + break; + case MODE_INVALID: + /* Scan words tagged "invalid" -- everything will die. */ + die(mps_root_create_area_tagged(&root, arena, mps_rank_ambig(), 0, + refs, refs + OBJCOUNT, + mps_scan_area_tagged, TAG_MASK, tag_invalid), + "root"); + expected = OBJCOUNT; + break; + } + + MPS_ARGS_BEGIN(args) { + MPS_ARGS_ADD(args, MPS_KEY_FMT_SCAN, scan); + MPS_ARGS_ADD(args, MPS_KEY_FMT_SKIP, skip); + MPS_ARGS_ADD(args, MPS_KEY_FMT_FWD, fwd); + MPS_ARGS_ADD(args, MPS_KEY_FMT_ISFWD, isfwd); + MPS_ARGS_ADD(args, MPS_KEY_FMT_PAD, pad); + die(mps_fmt_create_k(&fmt, arena, args), "fmt"); + } MPS_ARGS_END(args); + + MPS_ARGS_BEGIN(args) { + MPS_ARGS_ADD(args, MPS_KEY_FORMAT, fmt); + die(mps_pool_create_k(&pool, arena, mps_class_amc(), args), "pool"); + } MPS_ARGS_END(args); + + die(mps_ap_create_k(&ap, pool, mps_args_none), "ap"); + + for (i = 0; i < OBJCOUNT; ++i) { + mps_word_t p, r; + mps_word_t q = TAGGED(i << tag_bits, imm); + mps_addr_t addr; + p = make_cons(ap, q, q); + Insist(TAG(p) == tag_cons); + r = TAGGED(p, imm); + UNTAGGED(p, cons)->cdr = r; + refs[i] = (mps_addr_t)p; + addr = (mps_addr_t)UNTAGGED(p, cons); + die(mps_finalize(arena, &addr), "finalize"); + } + + collect(arena, expected); + + mps_arena_park(arena); + mps_ap_destroy(ap); + mps_pool_destroy(pool); + mps_fmt_destroy(fmt); + mps_root_destroy(root); + mps_thread_dereg(thread); + mps_arena_destroy(arena); +} + +int main(int argc, char *argv[]) +{ + mps_word_t tags[sizeof(mps_word_t)]; + size_t i; + int mode; + + testlib_init(argc, argv); + + /* Work out how many tags to use. */ + tag_bits = SizeLog2(sizeof(mps_word_t)); + Insist(TAG_COUNT <= NELEMS(tags)); + + /* Shuffle the tags. */ + for (i = 0; i < TAG_COUNT; ++i) { + tags[i] = i; + } + for (i = 0; i < TAG_COUNT; ++i) { + size_t j = i + rnd() % (TAG_COUNT - i); + mps_word_t t = tags[i]; + tags[i] = tags[j]; + tags[j] = t; + } + tag_cons = tags[0]; + tag_fwd = tags[1]; + tag_imm = tags[2]; + tag_invalid = tags[3]; + + printf("tags: cons = %u, fwd = %u, imm = %u, invalid = %u\n", + (unsigned)tag_cons, (unsigned)tag_fwd, + (unsigned)tag_imm, (unsigned)tag_invalid); + + for (mode = 0; mode < MODE_LIMIT; ++mode) { + test(mode); + } + + printf("%s: Conclusion: Failed to find any defects.\n", argv[0]); + return 0; +} + + +/* C. COPYRIGHT AND LICENSE + * + * Copyright (c) 2015 Ravenbrook Limited . + * All rights reserved. This is an open source license. Contact + * Ravenbrook for commercial licensing options. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are + * met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * 3. Redistributions in any form must be accompanied by information on how + * to obtain complete source code for this software and any accompanying + * software that uses this software. The source code must either be + * included in the distribution or be available for no more than the cost + * of distribution plus a nominal fee, and must be freely redistributable + * under reasonable conditions. For an executable file, complete source + * code means the source code for all modules it contains. It does not + * include source code for modules or files that typically accompany the + * major components of the operating system on which the executable file + * runs. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS + * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED + * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR + * PURPOSE, OR NON-INFRINGEMENT, ARE DISCLAIMED. IN NO EVENT SHALL THE + * COPYRIGHT HOLDERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF + * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON + * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ diff --git a/mps/code/testlib.h b/mps/code/testlib.h index 6f059abcbb9..0b5b7160165 100644 --- a/mps/code/testlib.h +++ b/mps/code/testlib.h @@ -47,9 +47,13 @@ */ #define ATTRIBUTE_FORMAT(ARGLIST) __attribute__((__format__ ARGLIST)) +/* GCC: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html */ +#define ATTRIBUTE_NOINLINE __attribute__((__noinline__)) + #else #define ATTRIBUTE_FORMAT(ARGLIST) +#define ATTRIBUTE_NOINLINE #endif diff --git a/mps/code/th.h b/mps/code/th.h index 8f7996cc0b5..29a4d243d1d 100644 --- a/mps/code/th.h +++ b/mps/code/th.h @@ -68,7 +68,9 @@ extern Thread ThreadRingThread(Ring threadRing); extern Arena ThreadArena(Thread thread); -extern Res ThreadScan(ScanState ss, Thread thread, void *stackBot); +extern Res ThreadScan(ScanState ss, Thread thread, Word *stackCold, + mps_area_scan_t scan_area, + void *closure); #endif /* th_h */ diff --git a/mps/code/than.c b/mps/code/than.c index f1fb21006d8..3e2dbaa81a0 100644 --- a/mps/code/than.c +++ b/mps/code/than.c @@ -117,10 +117,12 @@ Arena ThreadArena(Thread thread) } -Res ThreadScan(ScanState ss, Thread thread, void *stackBot) +Res ThreadScan(ScanState ss, Thread thread, Word *stackCold, + mps_area_scan_t scan_area, + void *closure) { UNUSED(thread); - return StackScan(ss, stackBot); + return StackScan(ss, stackCold, scan_area, closure); } diff --git a/mps/code/thix.c b/mps/code/thix.c index c1a31c6e902..219ae33bcdd 100644 --- a/mps/code/thix.c +++ b/mps/code/thix.c @@ -239,7 +239,9 @@ Arena ThreadArena(Thread thread) /* ThreadScan -- scan the state of a thread (stack and regs) */ -Res ThreadScan(ScanState ss, Thread thread, void *stackBot) +Res ThreadScan(ScanState ss, Thread thread, Word *stackCold, + mps_area_scan_t scan_area, + void *closure) { pthread_t self; Res res; @@ -249,32 +251,34 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) if(pthread_equal(self, thread->id)) { /* scan this thread's stack */ AVER(thread->alive); - res = StackScan(ss, stackBot); + res = StackScan(ss, stackCold, scan_area, closure); if(res != ResOK) return res; } else if (thread->alive) { MutatorFaultContext mfc; - Addr *stackBase, *stackLimit, stackPtr; + Word *stackBase, *stackLimit; + Addr stackPtr; mfc = thread->mfc; AVER(mfc != NULL); stackPtr = MutatorFaultContextSP(mfc); /* .stack.align */ - stackBase = (Addr *)AddrAlignUp(stackPtr, sizeof(Addr)); - stackLimit = (Addr *)stackBot; + stackBase = (Word *)AddrAlignUp(stackPtr, sizeof(Word)); + stackLimit = stackCold; if (stackBase >= stackLimit) return ResOK; /* .stack.below-bottom */ /* scan stack inclusive of current sp and exclusive of - * stackBot (.stack.full-descend) + * stackCold (.stack.full-descend) */ - res = TraceScanAreaTagged(ss, stackBase, stackLimit); + res = TraceScanArea(ss, stackBase, stackLimit, + scan_area, closure); if(res != ResOK) return res; /* scan the registers in the mutator fault context */ - res = MutatorFaultContextScan(ss, mfc); + res = MutatorFaultContextScan(ss, mfc, scan_area, closure); if(res != ResOK) return res; } diff --git a/mps/code/thw3i3.c b/mps/code/thw3i3.c index 20e694ddc82..03675ed46b2 100644 --- a/mps/code/thw3i3.c +++ b/mps/code/thw3i3.c @@ -67,23 +67,19 @@ SRCID(thw3i3, "$Id$"); -Res ThreadScan(ScanState ss, Thread thread, void *stackBot) +Res ThreadScan(ScanState ss, Thread thread, Word *stackCold, + mps_area_scan_t scan_area, void *closure) { DWORD id; Res res; id = GetCurrentThreadId(); - if (id == thread->id) { /* .thread.id */ - /* scan this thread's stack */ - AVER(thread->alive); - res = StackScan(ss, stackBot); - if(res != ResOK) - return res; - } else if (thread->alive) { + if (id != thread->id) { /* .thread.id */ CONTEXT context; BOOL success; - Addr *stackBase, *stackLimit, stackPtr; + Word *stackBase, *stackLimit; + Addr stackPtr; /* scan stack and register roots in other threads */ @@ -101,15 +97,16 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) stackPtr = (Addr)context.Esp; /* .i3.sp */ /* .stack.align */ - stackBase = (Addr *)AddrAlignUp(stackPtr, sizeof(Addr)); - stackLimit = (Addr *)stackBot; + stackBase = (Word *)AddrAlignUp(stackPtr, sizeof(Word)); + stackLimit = stackCold; if (stackBase >= stackLimit) return ResOK; /* .stack.below-bottom */ /* scan stack inclusive of current sp and exclusive of - * stackBot (.stack.full-descend) + * stackCold (.stack.full-descend) */ - res = TraceScanAreaTagged(ss, stackBase, stackLimit); + res = TraceScanArea(ss, stackBase, stackLimit, + scan_area, closure); if(res != ResOK) return res; @@ -118,8 +115,14 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) * unnecessarily scans the rest of the context. The optimisation * to scan only relevant parts would be machine dependent. */ - res = TraceScanAreaTagged(ss, (Addr *)&context, - (Addr *)((char *)&context + sizeof(CONTEXT))); + res = TraceScanArea(ss, (Word *)&context, + (Word *)((char *)&context + sizeof(CONTEXT)), + scan_area, closure); + if(res != ResOK) + return res; + + } else { /* scan this thread's stack */ + res = StackScan(ss, stackCold, scan_area, closure); if(res != ResOK) return res; } diff --git a/mps/code/thw3i6.c b/mps/code/thw3i6.c index a13a031ec22..67350022ad6 100644 --- a/mps/code/thw3i6.c +++ b/mps/code/thw3i6.c @@ -67,23 +67,20 @@ SRCID(thw3i6, "$Id$"); -Res ThreadScan(ScanState ss, Thread thread, void *stackBot) +Res ThreadScan(ScanState ss, Thread thread, Word *stackCold, + mps_area_scan_t scan_area, + void *closure) { DWORD id; Res res; id = GetCurrentThreadId(); - if (id == thread->id) { /* .thread.id */ - /* scan this thread's stack */ - AVER(thread->alive); - res = StackScan(ss, stackBot); - if(res != ResOK) - return res; - } else if (thread->alive) { + if (id != thread->id) { /* .thread.id */ CONTEXT context; BOOL success; - Addr *stackBase, *stackLimit, stackPtr; + Word *stackBase, *stackLimit; + Addr stackPtr; /* scan stack and register roots in other threads */ @@ -101,15 +98,16 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) stackPtr = (Addr)context.Rsp; /* .i6.sp */ /* .stack.align */ - stackBase = (Addr *)AddrAlignUp(stackPtr, sizeof(Addr)); - stackLimit = (Addr *)stackBot; + stackBase = (Word *)AddrAlignUp(stackPtr, sizeof(Word)); + stackLimit = stackCold; if (stackBase >= stackLimit) return ResOK; /* .stack.below-bottom */ /* scan stack inclusive of current sp and exclusive of - * stackBot (.stack.full-descend) + * stackCold (.stack.full-descend) */ - res = TraceScanAreaTagged(ss, stackBase, stackLimit); + res = TraceScanArea(ss, stackBase, stackLimit, + scan_area, closure); if(res != ResOK) return res; @@ -118,8 +116,14 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) * unnecessarily scans the rest of the context. The optimisation * to scan only relevant parts would be machine dependent. */ - res = TraceScanAreaTagged(ss, (Addr *)&context, - (Addr *)((char *)&context + sizeof(CONTEXT))); + res = TraceScanArea(ss, (Word *)&context, + (Word *)((char *)&context + sizeof(CONTEXT)), + scan_area, closure); + if(res != ResOK) + return res; + + } else { /* scan this thread's stack */ + res = StackScan(ss, stackCold, scan_area, closure); if(res != ResOK) return res; } diff --git a/mps/code/thxc.c b/mps/code/thxc.c index 6ecc1ea726e..3bb449d46fe 100644 --- a/mps/code/thxc.c +++ b/mps/code/thxc.c @@ -210,7 +210,8 @@ Arena ThreadArena(Thread thread) #include "prmcxc.h" -Res ThreadScan(ScanState ss, Thread thread, void *stackBot) +Res ThreadScan(ScanState ss, Thread thread, Word *stackCold, + mps_area_scan_t scan_area, void *closure) { mach_port_t self; Res res; @@ -221,13 +222,14 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) if (thread->port == self) { /* scan this thread's stack */ AVER(thread->alive); - res = StackScan(ss, stackBot); + res = StackScan(ss, stackCold, scan_area, closure); if(res != ResOK) return res; } else if (thread->alive) { MutatorFaultContextStruct mfcStruct; THREAD_STATE_S threadState; - Addr *stackBase, *stackLimit, stackPtr; + Word *stackBase, *stackLimit; + Addr stackPtr; mach_msg_type_number_t count; kern_return_t kern_return; @@ -249,20 +251,21 @@ Res ThreadScan(ScanState ss, Thread thread, void *stackBot) stackPtr = MutatorFaultContextSP(&mfcStruct); /* .stack.align */ - stackBase = (Addr *)AddrAlignUp(stackPtr, sizeof(Addr)); - stackLimit = (Addr *)stackBot; + stackBase = (Word *)AddrAlignUp(stackPtr, sizeof(Word)); + stackLimit = stackCold; if (stackBase >= stackLimit) return ResOK; /* .stack.below-bottom */ /* scan stack inclusive of current sp and exclusive of - * stackBot (.stack.full-descend) + * stackCold (.stack.full-descend) */ - res = TraceScanAreaTagged(ss, stackBase, stackLimit); + res = TraceScanArea(ss, stackBase, stackLimit, + scan_area, closure); if(res != ResOK) return res; /* scan the registers in the mutator fault context */ - res = MutatorFaultContextScan(ss, &mfcStruct); + res = MutatorFaultContextScan(ss, &mfcStruct, scan_area, closure); if(res != ResOK) return res; } diff --git a/mps/code/trace.c b/mps/code/trace.c index 5542c2064e4..5ce3e3617ad 100644 --- a/mps/code/trace.c +++ b/mps/code/trace.c @@ -1,13 +1,13 @@ /* trace.c: GENERIC TRACER IMPLEMENTATION * * $Id$ - * Copyright (c) 2001-2015 Ravenbrook Limited. + * Copyright (c) 2001-2016 Ravenbrook Limited. * See end of file for license. * Portions copyright (C) 2002 Global Graphics Software. * * .design: . */ -#include "chain.h" +#include "locus.h" #include "mpm.h" #include /* for LONG_MAX */ @@ -1420,108 +1420,33 @@ void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena, } -/* TraceScanArea -- scan contiguous area of references +/* TraceScanArea -- scan an area of memory for references * - * This is a convenience function for scanning the contiguous area - * [base, limit). I.e., it calls Fix on all words from base up to - * limit, inclusive of base and exclusive of limit. */ + * This is a wrapper for area scanning functions, which should not + * otherwise be called directly from within the MPS. This function + * checks arguments and takes care of accounting for the scanned + * memory. + * + * c.f. FormatScan() + */ -Res TraceScanArea(ScanState ss, Addr *base, Addr *limit) +Res TraceScanArea(ScanState ss, Word *base, Word *limit, + mps_area_scan_t scan_area, + void *closure) { - Res res; - Addr *p; - Ref ref; - + AVERT(ScanState, ss); AVER(base != NULL); AVER(limit != NULL); AVER(base < limit); EVENT3(TraceScanArea, ss, base, limit); - TRACE_SCAN_BEGIN(ss) { - p = base; - loop: - if (p >= limit) - goto out; - ref = *p++; - if(!TRACE_FIX1(ss, ref)) - goto loop; - res = TRACE_FIX2(ss, p-1); - if(res == ResOK) - goto loop; - return res; - out: - AVER(p == limit); - } TRACE_SCAN_END(ss); - - return ResOK; -} - - -/* TraceScanAreaTagged -- scan contiguous area of tagged references - * - * .tagging: This is as TraceScanArea except words are only fixed they are - * tagged as zero according to the alignment of a Word. - * - * See also PoolSingleAccess . - * - * TODO: Generalise the handling of tags so that pools can decide how - * their objects are tagged. This may use the user defined format - * to describe how tags are done */ -Res TraceScanAreaTagged(ScanState ss, Addr *base, Addr *limit) -{ - Word mask; + /* scannedSize is accumulated whether or not scan_area succeeds, so + it's safe to accumulate now so that we can tail-call + scan_area. */ + ss->scannedSize += AddrOffset(base, limit); - /* NOTE: An optimisation that maybe worth considering is setting some of the - * top bits in the mask as an early catch of addresses outside the arena. - * This might help slightly on 64-bit windows. However these are picked up - * soon afterwards by later checks. The bottom bits are more important - * to check as we ignore them in AMCFix, so the non-reference could - * otherwise end up pinning an object. */ - mask = sizeof(Word) - 1; - AVER(WordIsP2(mask + 1)); - return TraceScanAreaMasked(ss, base, limit, mask); -} - - -/* TraceScanAreaMasked -- scan contiguous area of filtered references - * - * This is as TraceScanArea except words are only fixed if they are zero - * when masked with a mask. */ - -ATTRIBUTE_NO_SANITIZE_ADDRESS -Res TraceScanAreaMasked(ScanState ss, Addr *base, Addr *limit, Word mask) -{ - Res res; - Addr *p; - Ref ref; - - AVERT(ScanState, ss); - AVER(base != NULL); - AVER(limit != NULL); - AVER(base < limit); - - EVENT3(TraceScanAreaTagged, ss, base, limit); - - TRACE_SCAN_BEGIN(ss) { - p = base; - loop: - if (p >= limit) - goto out; - ref = *p++; - if (((Word)ref & mask) - != 0) goto loop; - if (!TRACE_FIX1(ss, ref)) - goto loop; - res = TRACE_FIX2(ss, p-1); - if(res == ResOK) - goto loop; - return res; - out: - AVER(p == limit); - } TRACE_SCAN_END(ss); - - return ResOK; + return scan_area(&ss->ss_s, base, limit, closure); } @@ -1900,7 +1825,7 @@ Res TraceDescribe(Trace trace, mps_lib_FILE *stream, Count depth) /* C. COPYRIGHT AND LICENSE * - * Copyright (C) 2001-2015 Ravenbrook Limited + * Copyright (C) 2001-2016 Ravenbrook Limited * . * All rights reserved. This is an open source license. Contact * Ravenbrook for commercial licensing options. diff --git a/mps/code/zcoll.c b/mps/code/zcoll.c index a5d7a0e0d22..459f87595f5 100644 --- a/mps/code/zcoll.c +++ b/mps/code/zcoll.c @@ -574,9 +574,8 @@ static void StackScan(mps_arena_t arena, int on) { if(on) { Insist(root_stackreg == NULL); - die(mps_root_create_reg(&root_stackreg, arena, - mps_rank_ambig(), (mps_rm_t)0, stack_thr, - mps_stack_scan_ambig, stack_start, 0), + die(mps_root_create_thread(&root_stackreg, arena, + stack_thr, stack_start), "root_stackreg"); Insist(root_stackreg != NULL); } else { @@ -762,9 +761,8 @@ static void *testscriptB(void *arg, size_t s) /* root_stackreg: stack & registers are ambiguous roots = mutator's workspace */ stack_start = &stack_starts_here; stack_thr = thr; - die(mps_root_create_reg(&root_stackreg, arena, - mps_rank_ambig(), (mps_rm_t)0, stack_thr, - mps_stack_scan_ambig, stack_start, 0), + die(mps_root_create_thread(&root_stackreg, arena, + stack_thr, stack_start), "root_stackreg"); diff --git a/mps/code/zmess.c b/mps/code/zmess.c index 53aea545801..afa6c0b128d 100644 --- a/mps/code/zmess.c +++ b/mps/code/zmess.c @@ -330,9 +330,8 @@ static void *testscriptB(void *arg, size_t s) die(mps_ap_create(&ap, amc, mps_rank_exact()), "ap_create"); /* root_stackreg: stack & registers are ambiguous roots = mutator's workspace */ - die(mps_root_create_reg(&root_stackreg, arena, - mps_rank_ambig(), (mps_rm_t)0, thr, - mps_stack_scan_ambig, &stack_starts_here, 0), + die(mps_root_create_thread(&root_stackreg, arena, + thr, &stack_starts_here), "root_stackreg"); /* Make myrootCOUNT registered-for-finalization objects. */ diff --git a/mps/configure b/mps/configure index edbc7320304..2aa767cd2d5 100755 --- a/mps/configure +++ b/mps/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for Memory Pool System Kit release/1.114.0. +# Generated by GNU Autoconf 2.69 for Memory Pool System Kit release/1.115.0. # # Report bugs to . # @@ -580,8 +580,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='Memory Pool System Kit' PACKAGE_TARNAME='mps-kit' -PACKAGE_VERSION='release/1.114.0' -PACKAGE_STRING='Memory Pool System Kit release/1.114.0' +PACKAGE_VERSION='release/1.115.0' +PACKAGE_STRING='Memory Pool System Kit release/1.115.0' PACKAGE_BUGREPORT='mps-questions@ravenbrook.com' PACKAGE_URL='http://www.ravenbrook.com/project/mps/' @@ -1245,7 +1245,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures Memory Pool System Kit release/1.114.0 to adapt to many kinds of systems. +\`configure' configures Memory Pool System Kit release/1.115.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1310,7 +1310,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of Memory Pool System Kit release/1.114.0:";; + short | recursive ) echo "Configuration of Memory Pool System Kit release/1.115.0:";; esac cat <<\_ACEOF @@ -1391,7 +1391,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -Memory Pool System Kit configure release/1.114.0 +Memory Pool System Kit configure release/1.115.0 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -1693,7 +1693,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by Memory Pool System Kit $as_me release/1.114.0, which was +It was created by Memory Pool System Kit $as_me release/1.115.0, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -3524,6 +3524,28 @@ $as_echo "FreeBSD x86_64" >&6; } CPP="$CC -I/usr/local/include -E" PFMCFLAGS="$CFLAGS_GC" ;; + i*86-*-freebsd*/yes) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: FreeBSD x86" >&5 +$as_echo "FreeBSD x86" >&6; } + MPS_OS_NAME=fr + MPS_ARCH_NAME=i3 + MPS_BUILD_NAME=ll + # Need /usr/local/include in order to find sqlite3.h + CFLAGS="-I/usr/local/include" + CPP="$CC -I/usr/local/include -E" + PFMCFLAGS="$CFLAGS_LL" + ;; + amd64-*-freebsd*/no | x86_64-*-freebsd*/no) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: FreeBSD x86_64" >&5 +$as_echo "FreeBSD x86_64" >&6; } + MPS_OS_NAME=fr + MPS_ARCH_NAME=i6 + MPS_BUILD_NAME=ll + # Need /usr/local/include in order to find sqlite3.h + CFLAGS="-I/usr/local/include" + CPP="$CC -I/usr/local/include -E" + PFMCFLAGS="$CFLAGS_LL" + ;; *) as_fn_error $? "MPS does not support this platform out of the box. See manual/build.txt" "$LINENO" 5 esac @@ -4144,7 +4166,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by Memory Pool System Kit $as_me release/1.114.0, which was +This file was extended by Memory Pool System Kit $as_me release/1.115.0, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -4198,7 +4220,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -Memory Pool System Kit config.status release/1.114.0 +Memory Pool System Kit config.status release/1.115.0 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/mps/configure.ac b/mps/configure.ac index f564f047d5e..940ca852cc2 100644 --- a/mps/configure.ac +++ b/mps/configure.ac @@ -98,6 +98,15 @@ case $host/$CLANG in CPP="$CC -I/usr/local/include -E" PFMCFLAGS="$CFLAGS_GC" ;; + amd64-*-freebsd*/yes | x86_64-*-freebsd*/yes) + AC_MSG_RESULT([FreeBSD x86_64]) + MPS_OS_NAME=fr + MPS_ARCH_NAME=i6 + MPS_BUILD_NAME=ll + # Need /usr/local/include in order to find sqlite3.h + CFLAGS="-I/usr/local/include" + CPP="$CC -I/usr/local/include -E" + PFMCFLAGS="$CFLAGS_GC" amd64-*-freebsd*/no | x86_64-*-freebsd*/no) AC_MSG_RESULT([FreeBSD x86_64]) MPS_OS_NAME=fr @@ -108,6 +117,26 @@ case $host/$CLANG in CPP="$CC -I/usr/local/include -E" PFMCFLAGS="$CFLAGS_GC" ;; + i*86-*-freebsd*/yes) + AC_MSG_RESULT([FreeBSD x86]) + MPS_OS_NAME=fr + MPS_ARCH_NAME=i3 + MPS_BUILD_NAME=ll + # Need /usr/local/include in order to find sqlite3.h + CFLAGS="-I/usr/local/include" + CPP="$CC -I/usr/local/include -E" + PFMCFLAGS="$CFLAGS_LL" + ;; + amd64-*-freebsd*/no | x86_64-*-freebsd*/no) + AC_MSG_RESULT([FreeBSD x86_64]) + MPS_OS_NAME=fr + MPS_ARCH_NAME=i6 + MPS_BUILD_NAME=ll + # Need /usr/local/include in order to find sqlite3.h + CFLAGS="-I/usr/local/include" + CPP="$CC -I/usr/local/include -E" + PFMCFLAGS="$CFLAGS_LL" + ;; *) AC_MSG_ERROR([MPS does not support this platform out of the box. See manual/build.txt]) esac diff --git a/mps/design/abq.txt b/mps/design/abq.txt index ec3c944355c..e3bd56a9bc8 100644 --- a/mps/design/abq.txt +++ b/mps/design/abq.txt @@ -9,6 +9,7 @@ Fixed-length queues :Status: complete design :Revision: $Id$ :Copyright: See section `Copyright and License`_. +:Index terms: pair: fixed-length queues; design Introduction @@ -119,7 +120,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited. All rights reserved. +Copyright © 2013-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/bootstrap.txt b/mps/design/bootstrap.txt index 8615aee0f99..3a8dd8fde64 100644 --- a/mps/design/bootstrap.txt +++ b/mps/design/bootstrap.txt @@ -9,7 +9,7 @@ Bootstrapping :Status: incomplete design :Revision: $Id$ :Copyright: See section `Copyright and License`_. -:Index terms: pair: bootsrap; design +:Index terms: pair: bootstrap; design Introduction diff --git a/mps/design/cbs.txt b/mps/design/cbs.txt index 34c2eedd4cd..f004eedd90a 100644 --- a/mps/design/cbs.txt +++ b/mps/design/cbs.txt @@ -9,6 +9,7 @@ Coalescing block structures :Status: complete design :Revision: $Id$ :Copyright: See section `Copyright and License`_. +:Index terms: pair: coalescing block structures; design Introduction @@ -281,7 +282,7 @@ Document History Copyright and License --------------------- -Copyright © 1998-2014 Ravenbrook Limited. All rights reserved. +Copyright © 1998-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/clock.txt b/mps/design/clock.txt new file mode 100644 index 00000000000..9cb4c683049 --- /dev/null +++ b/mps/design/clock.txt @@ -0,0 +1,133 @@ +.. mode: -*- rst -*- + +Fast high-resolution clock +========================== + +:Tag: design.mps.clock +:Author: Gareth Rees +:Date: 2016-03-06 +:Status: complete design +:Revision: $Id: //info.ravenbrook.com/project/mps/master/design/abq.txt#5 $ +:Copyright: See section `Copyright and License`_. +:Index terms: pair: clock; design + + +Introduction +------------ + +_`.intro`: This is the design of the clock module, which implements a +fast high-resolution clock for use by the telemetry system. + +_`.readership`: This document is intended for any MPS developer. + + +Requirements +------------ + +_`.req.monotonic`: Successive calls to ``EVENT_CLOCK()`` must yield +values that are monotonically increasing. (So that comparing the +timestamp on two events never gives false positives.) + +_`.req.fast`: ``EVENT_CLOCK()`` should take very little time; it +should not require a system call. (So that programs that use the MPS +remain usable when telemetry is turned on.) + +_`.req.high-resolution`: Successive calls to ``EVENT_CLOCK()`` should +yield values that are strictly monotonically increasing (so that +sorting the telemetry stream puts the events in the order they +happened). + + +Interface +--------- + +``EventClock`` + +_`.if.type`: The type of timestamps. It must be an unsigned 64-bit +integral type, for example a ``typedef`` for ``uint64_t`` or +``unsigned __int64``. + +``EVENT_CLOCK_MAKE(lvalue, low, high)`` + +_`.if.make`: Construct an ``EventClock`` timestamp from its two +halves. The first parameter is an lvalue with type ``EventClock``, and +the second and third parameters are 32-bit unsigned integers. The +macro must assign a timestamp to ``lvalue`` with the value ``(high +<< 32) + low``. + +``EVENT_CLOCK(lvalue)`` + +_`.if.get`: Assign an ``EventClock`` timestamp for the current time to +``lvalue``, which is an lvalue with type ``EventClock``. + +``EVENT_CLOCK_PRINT(FILE *stream, EventClock clock)`` + +_`.if.print`: Write the value of ``clock`` to the standard C output +file handle ``stream`` as 16 hexadecimal digits (with leading zeros, +and capital letters A to F). + +``EVENT_CLOCK_WRITE(mps_lib_FILE *stream, EventClock clock)`` + +_`.if.write`: Write the value of ``clock`` to the output stream +``stream`` as 16 hexadecimal digits (with leading zeros, and capital +letters A to F). The macro should be implemented using ``WriteF()``. + + +Implementation +-------------- + +_`.impl.tsc`: On IA-32 and x86-64, the `Time Stamp Counter +`_ returned by the +RDTSC instruction is a suitable clock for single-core CPUs, but on +multiple-core CPUs, different cores may have different values or tick at different speeds, and so it may fail to meet `.req.monotonic`_. + + +Document History +---------------- + +- 2016-03-06 GDR_ Created. + +.. _GDR: http://www.ravenbrook.com/consultants/gdr/ + + +Copyright and License +--------------------- + +Copyright © 2016 Ravenbrook Limited. All rights reserved. +. This is an open source license. Contact +Ravenbrook for commercial licensing options. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +#. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +#. 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. + +#. Redistributions in any form must be accompanied by information on how + to obtain complete source code for this software and any + accompanying software that uses this software. The source code must + either be included in the distribution or be available for no more than + the cost of distribution plus a nominal fee, and must be freely + redistributable under reasonable conditions. For an executable file, + complete source code means the source code for all modules it contains. + It does not include source code for modules or files that typically + accompany the major components of the operating system on which the + executable file runs. + +**This software is provided by the copyright holders and contributors +"as is" and any express or implied warranties, including, but not +limited to, the implied warranties of merchantability, fitness for a +particular purpose, or non-infringement, are disclaimed. In no event +shall the copyright holders and contributors be liable for any direct, +indirect, incidental, special, exemplary, or consequential damages +(including, but not limited to, procurement of substitute goods or +services; loss of use, data, or profits; or business interruption) +however caused and on any theory of liability, whether in contract, +strict liability, or tort (including negligence or otherwise) arising in +any way out of the use of this software, even if advised of the +possibility of such damage.** diff --git a/mps/design/config.txt b/mps/design/config.txt index eff74388489..9d49a5889ce 100644 --- a/mps/design/config.txt +++ b/mps/design/config.txt @@ -75,7 +75,7 @@ _`.def.platform`: A *platform* is a combination of an architecture _`.def.arch`: An *architecture* is processor type with associated calling conventions and other binary interface stuff these days often called the -`ABI `_. +`ABI `_. Most importantly for the MPS it determines the layout of the register file, thread context, and thread stack. @@ -610,7 +610,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited. All rights reserved. +Copyright © 2013-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/failover.txt b/mps/design/failover.txt index 1787da261a9..cdb7cf3a613 100644 --- a/mps/design/failover.txt +++ b/mps/design/failover.txt @@ -9,6 +9,7 @@ Fail-over allocator :Status: complete design :Revision: $Id$ :Copyright: See section `Copyright and License`_. +:Index terms: pair: fail-over allocator; design Introduction @@ -110,7 +111,7 @@ Document History Copyright and License --------------------- -Copyright © 2014 Ravenbrook Limited. All rights reserved. +Copyright © 2014-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/index.txt b/mps/design/index.txt index 7e48b625319..9e0a1090cda 100644 --- a/mps/design/index.txt +++ b/mps/design/index.txt @@ -50,6 +50,7 @@ buffer_ Allocation buffers and allocation points cbs_ Coalescing block structures check_ Checking class-interface_ Pool class interface +clock_ Fast high-resolution clock collection_ Collection framework config_ MPS configuration critical-path_ The critical path through the MPS @@ -128,6 +129,7 @@ writef_ The WriteF function .. _buffer: buffer .. _cbs: cbs .. _check: check +.. _clock: clock .. _class-interface: class-interface .. _collection: collection .. _config: config @@ -237,7 +239,7 @@ Document History Copyright and License --------------------- -Copyright © 2002-2015 Ravenbrook Limited. All rights reserved. +Copyright © 2002-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/land.txt b/mps/design/land.txt index df16fc922b9..15c1454882d 100644 --- a/mps/design/land.txt +++ b/mps/design/land.txt @@ -9,6 +9,7 @@ Lands :Status: complete design :Revision: $Id$ :Copyright: See section `Copyright and License`_. +:Index terms: pair: lands; design Introduction @@ -321,7 +322,7 @@ Document History Copyright and License --------------------- -Copyright © 2014-2015 Ravenbrook Limited. All rights reserved. +Copyright © 2014-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/poolmv.txt b/mps/design/poolmv.txt index 628489b9cb0..1b25c441a27 100644 --- a/mps/design/poolmv.txt +++ b/mps/design/poolmv.txt @@ -9,6 +9,9 @@ MV pool class :Status: incomplete design :Revision: $Id$ :Copyright: See `Copyright and License`_. +:Index terms: + pair: MV pool class; design + single: pool class; MV design Implementation @@ -44,7 +47,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited. All rights reserved. +Copyright © 2013-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/poolmvt.txt b/mps/design/poolmvt.txt index 73f289017b7..59939535604 100644 --- a/mps/design/poolmvt.txt +++ b/mps/design/poolmvt.txt @@ -10,6 +10,9 @@ Manual Variable Temporal (MVT) pool design :Status: incomplete design :Revision: $Id$ :Copyright: See section `C. Copyright and License`_. +:Index terms: + pair: MVT pool class; design + single: pool class; MVT design Introduction @@ -1021,7 +1024,7 @@ B. Document History C. Copyright and License ------------------------ -Copyright (C) 2002-2014 Ravenbrook Limited. All rights reserved. +Copyright (C) 2002-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/prmc.txt b/mps/design/prmc.txt index 0822e709527..c7aaad52d57 100644 --- a/mps/design/prmc.txt +++ b/mps/design/prmc.txt @@ -104,11 +104,11 @@ instruction which was caused the fault to be re-executed. Return This function is only called if ``ProtCanStepInstruction(context)`` returned ``TRUE``. -``Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext context)`` +``Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext context, mps_area_scan_t scan, void *closure)`` _`.if.context.scan`: Scan all roots found in ``context`` using the -given scan state (typically by calling ``TraceScanAreaTagged()``), and -return the result code from the scanner. +given scan state by calling ``scan``, and return the result code from +the scanner. ``Addr MutatorFaultContextSP(MutatorFaultContext context)`` diff --git a/mps/design/sig.txt b/mps/design/sig.txt index 992d0ba52d9..23f55a881a1 100644 --- a/mps/design/sig.txt +++ b/mps/design/sig.txt @@ -34,7 +34,7 @@ checking and dynamic scope checking. They are a simplified form of "Structure Marking", a technique used in the Multics filesystem [THVV_1995]_. -.. _`magic numbers`: http://en.wikipedia.org/wiki/Magic_number_(programming) +.. _`magic numbers`: https://en.wikipedia.org/wiki/Magic_number_(programming) Definitions @@ -177,7 +177,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited. All rights reserved. +Copyright © 2013-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/ss.txt b/mps/design/ss.txt index 60b5c2817fa..8ecd6a18153 100644 --- a/mps/design/ss.txt +++ b/mps/design/ss.txt @@ -66,21 +66,23 @@ been spilled onto the stack by the time the MPS is entered, so will be scanned by the stack scan. Floating-point registers and debugging registers do not, as far as we are aware, contain pointers. -_`.sol.inner`: Having located the top of the stack (``stackTop``), and -spilled the root registers into the next ``n`` words, implementations -call the generic function ``StackScanInner(ss, stackBot, stackTop, -n)`` to actually do the scanning. +_`.sol.inner`: Having located the hot end of the stack (``stackHot``), +and spilled the root registers into the next ``n`` words, +implementations call the generic higher-order function +``StackScanInner(ss, stackCold, stackHot, n, scan_area, closure)`` to actually do the scanning. Interface --------- -``Res StackScan(ScanState ss, Addr *stackBot)`` +``Res StackScan(ScanState ss, Word *stackCold, + mps_area_scan_t scan_area, + void *closure)`` _`.if.scan`: Scan the root registers of the current thread, and the -control stack between ``stackBot`` and the top of the stack, in the -context of the given scan state. Return ``ResOK`` if successful, or -another result code if not. +control stack between ``stackCold`` and the hot end of the stack, in +the context of the given scan state, using ``scan_area``. Return +``ResOK`` if successful, or another result code if not. Issue diff --git a/mps/design/strategy.txt b/mps/design/strategy.txt index 695813bed87..6e0472b04f5 100644 --- a/mps/design/strategy.txt +++ b/mps/design/strategy.txt @@ -9,6 +9,7 @@ MPS Strategy :Date: 2013-06-04 :Revision: $Id$ :Copyright: See section `Copyright and License`_. +:Index terms: pair: strategy; design Introduction @@ -555,7 +556,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited. All rights reserved. +Copyright © 2013-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/tests.txt b/mps/design/tests.txt index f7cfb17a431..e1e9eb51e83 100644 --- a/mps/design/tests.txt +++ b/mps/design/tests.txt @@ -9,6 +9,7 @@ Tests :Status: incomplete design :Revision: $Id$ :Copyright: See `Copyright and License`_. +:Index terms: pair: tests; design Introduction @@ -75,7 +76,7 @@ Document History Copyright and License --------------------- -Copyright © 2013-2014 Ravenbrook Limited. All rights reserved. +Copyright © 2013-2016 Ravenbrook Limited. All rights reserved. . This is an open source license. Contact Ravenbrook for commercial licensing options. diff --git a/mps/design/thread-manager.txt b/mps/design/thread-manager.txt index 48cbb912533..88f2b2478fa 100644 --- a/mps/design/thread-manager.txt +++ b/mps/design/thread-manager.txt @@ -153,15 +153,15 @@ threads are discovered to have terminated, move them to ``deadRing``. _`.if.ring.thread`: Return the thread that owns the given element of the thread ring. -``Res ThreadScan(ScanState ss, Thread thread, void *stackBot)`` +``Res ThreadScan(ScanState ss, Thread thread, Word *stackCold, mps_area_scan_t scan_area, void *closure)`` -_`.if.scan`: Scan the stacks and root registers of ``thread``, -treating each value found as an ambiguous reference. ``stackBot`` -points to the "bottom" of the thread's stack---this is the value that -was supplied by the client program when it called -``mps_root_create_reg()``. In the common case, where the stack grows -downwards, ``stackBot`` is actually the highest stack address. Return -``ResOK`` if successful, another result code otherwise. +_`.if.scan`: Scan the stacks and root registers of ``thread``, using +``ss`` and ``scan_area``. ``stackCold`` points to the cold end of the +thread's stack---this is the value that was supplied by the client +program when it called ``mps_root_create_thread()``. In the common +case, where the stack grows downwards, ``stackCold`` is the highest +stack address. Return ``ResOK`` if successful, another result code +otherwise. Implementations diff --git a/mps/example/scheme/scheme-advanced.c b/mps/example/scheme/scheme-advanced.c index 830b5b9da33..707390b2962 100644 --- a/mps/example/scheme/scheme-advanced.c +++ b/mps/example/scheme/scheme-advanced.c @@ -53,17 +53,17 @@ /* LANGUAGE EXTENSION */ -#define unless(c) if(!(c)) -#define LENGTH(array) (sizeof(array) / sizeof(array[0])) +#define unless(c) if(!(c)) +#define LENGTH(array) (sizeof(array) / sizeof(array[0])) #define UNUSED(var) ((void)var) /* CONFIGURATION PARAMETERS */ -#define SYMMAX ((size_t)255) /* max length of a symbol */ -#define MSGMAX ((size_t)255) /* max length of error message */ -#define STRMAX ((size_t)255) /* max length of a string */ +#define SYMMAX ((size_t)255) /* max length of a symbol */ +#define MSGMAX ((size_t)255) /* max length of error message */ +#define STRMAX ((size_t)255) /* max length of a string */ /* DATA TYPES */ @@ -116,54 +116,54 @@ typedef struct type_s { } type_s; typedef struct pair_s { - type_t type; /* TYPE_PAIR */ - obj_t car, cdr; /* first and second projections */ + type_t type; /* TYPE_PAIR */ + obj_t car, cdr; /* first and second projections */ } pair_s; typedef struct symbol_s { - type_t type; /* TYPE_SYMBOL */ + type_t type; /* TYPE_SYMBOL */ obj_t name; /* its name (a string) */ } symbol_s; typedef struct integer_s { - type_t type; /* TYPE_INTEGER */ - long integer; /* the integer */ + type_t type; /* TYPE_INTEGER */ + long integer; /* the integer */ } integer_s; typedef struct special_s { - type_t type; /* TYPE_SPECIAL */ - const char *name; /* printed representation, NUL terminated */ + type_t type; /* TYPE_SPECIAL */ + const char *name; /* printed representation, NUL terminated */ } special_s; typedef struct operator_s { - type_t type; /* TYPE_OPERATOR */ - const char *name; /* printed name, NUL terminated */ - entry_t entry; /* entry point -- see eval() */ - obj_t arguments, body; /* function arguments and code */ - obj_t env, op_env; /* closure environments */ + type_t type; /* TYPE_OPERATOR */ + const char *name; /* printed name, NUL terminated */ + entry_t entry; /* entry point -- see eval() */ + obj_t arguments, body; /* function arguments and code */ + obj_t env, op_env; /* closure environments */ } operator_s; typedef struct string_s { - type_t type; /* TYPE_STRING */ - size_t length; /* number of chars in string */ - char string[1]; /* string, NUL terminated */ + type_t type; /* TYPE_STRING */ + size_t length; /* number of chars in string */ + char string[1]; /* string, NUL terminated */ } string_s; typedef struct port_s { - type_t type; /* TYPE_PORT */ - obj_t name; /* name of stream */ + type_t type; /* TYPE_PORT */ + obj_t name; /* name of stream */ FILE *stream; } port_s; typedef struct character_s { - type_t type; /* TYPE_CHARACTER */ - char c; /* the character */ + type_t type; /* TYPE_CHARACTER */ + char c; /* the character */ } character_s; typedef struct vector_s { - type_t type; /* TYPE_VECTOR */ - size_t length; /* number of elements */ - obj_t vector[1]; /* vector elements */ + type_t type; /* TYPE_VECTOR */ + size_t length; /* number of elements */ + obj_t vector[1]; /* vector elements */ } vector_s; /* %%MPS: Objects in AWL pools must be formatted so that aligned @@ -241,7 +241,7 @@ typedef struct pad_s { typedef union obj_u { - type_s type; /* one of TYPE_* */ + type_s type; /* one of TYPE_* */ pair_s pair; symbol_s symbol; integer_s integer; @@ -260,17 +260,17 @@ typedef union obj_u { /* structure macros */ -#define TYPE(obj) ((obj)->type.type) -#define CAR(obj) ((obj)->pair.car) -#define CDR(obj) ((obj)->pair.cdr) -#define CAAR(obj) CAR(CAR(obj)) -#define CADR(obj) CAR(CDR(obj)) -#define CDAR(obj) CDR(CAR(obj)) -#define CDDR(obj) CDR(CDR(obj)) -#define CADDR(obj) CAR(CDDR(obj)) -#define CDDDR(obj) CDR(CDDR(obj)) -#define CDDAR(obj) CDR(CDAR(obj)) -#define CADAR(obj) CAR(CDAR(obj)) +#define TYPE(obj) ((obj)->type.type) +#define CAR(obj) ((obj)->pair.car) +#define CDR(obj) ((obj)->pair.cdr) +#define CAAR(obj) CAR(CAR(obj)) +#define CADR(obj) CAR(CDR(obj)) +#define CDAR(obj) CDR(CAR(obj)) +#define CDDR(obj) CDR(CDR(obj)) +#define CADDR(obj) CAR(CDDR(obj)) +#define CDDDR(obj) CDR(CDDR(obj)) +#define CDDAR(obj) CDR(CDAR(obj)) +#define CADAR(obj) CAR(CDAR(obj)) /* GLOBAL DATA */ @@ -305,12 +305,12 @@ static mps_root_t symtab_root; * See `globals_scan`. */ -static obj_t obj_empty; /* (), the empty list */ -static obj_t obj_eof; /* end of file */ -static obj_t obj_error; /* error indicator */ -static obj_t obj_true; /* #t, boolean true */ -static obj_t obj_false; /* #f, boolean false */ -static obj_t obj_undefined; /* undefined result indicator */ +static obj_t obj_empty; /* (), the empty list */ +static obj_t obj_eof; /* end of file */ +static obj_t obj_error; /* error indicator */ +static obj_t obj_true; /* #t, boolean true */ +static obj_t obj_false; /* #f, boolean false */ +static obj_t obj_undefined; /* undefined result indicator */ static obj_t obj_tail; /* tail recursion indicator */ static obj_t obj_deleted; /* deleted key in hashtable */ static obj_t obj_unused; /* unused entry in hashtable */ @@ -323,13 +323,13 @@ static obj_t obj_unused; /* unused entry in hashtable */ * Scheme language, and are used by the evaluator to parse code. */ -static obj_t obj_quote; /* "quote" symbol */ -static obj_t obj_quasiquote; /* "quasiquote" symbol */ -static obj_t obj_lambda; /* "lambda" symbol */ -static obj_t obj_begin; /* "begin" symbol */ -static obj_t obj_else; /* "else" symbol */ -static obj_t obj_unquote; /* "unquote" symbol */ -static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */ +static obj_t obj_quote; /* "quote" symbol */ +static obj_t obj_quasiquote; /* "quasiquote" symbol */ +static obj_t obj_lambda; /* "lambda" symbol */ +static obj_t obj_begin; /* "begin" symbol */ +static obj_t obj_else; /* "else" symbol */ +static obj_t obj_unquote; /* "unquote" symbol */ +static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */ /* error handler @@ -1322,13 +1322,13 @@ static obj_t read_special(FILE *stream, int c) switch(tolower(c)) { case 't': return obj_true; case 'f': return obj_false; - case '\\': { /* character (R4RS 6.6) */ + case '\\': { /* character (R4RS 6.6) */ c = getc(stream); if(c == EOF) error("read: end of file reading character literal"); return make_character((char)c); } - case '(': { /* vector (R4RS 6.8) */ + case '(': { /* vector (R4RS 6.8) */ obj_t list = read_list(stream, c); obj_t vector = list_to_vector(list); if(vector == obj_error) @@ -1429,7 +1429,7 @@ static obj_t lookup(obj_t env, obj_t symbol) static void define(obj_t env, obj_t symbol, obj_t value) { obj_t binding; - assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */ + assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */ binding = lookup_in_frame(CAR(env), symbol); if(binding != obj_undefined) CDR(binding) = value; @@ -1848,7 +1848,7 @@ static obj_t entry_let(obj_t env, obj_t op_env, obj_t operator, obj_t operands) unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -1875,7 +1875,7 @@ static obj_t entry_let_star(obj_t env, obj_t op_env, obj_t operator, obj_t opera unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -1902,7 +1902,7 @@ static obj_t entry_letrec(obj_t env, obj_t op_env, obj_t operator, obj_t operand unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -2626,7 +2626,7 @@ static obj_t entry_divide(obj_t env, obj_t op_env, obj_t operator, obj_t operand if(args == obj_empty) { if(result == 0) error("%s: reciprocal of zero", operator->operator.name); - result = 1/result; /* TODO: pretty meaningless for integers */ + result = 1/result; /* TODO: pretty meaningless for integers */ } else { while(TYPE(args) == TYPE_PAIR) { unless(TYPE(CAR(args)) == TYPE_INTEGER) @@ -4311,7 +4311,6 @@ static int start(int argc, char *argv[]) size_t i; volatile obj_t env, op_env, obj; jmp_buf jb; - mps_addr_t ref; mps_res_t res; mps_root_t globals_root; int exit_code = EXIT_SUCCESS; @@ -4325,13 +4324,14 @@ static int start(int argc, char *argv[]) /* We must register the global variable 'symtab' as a root before creating the symbol table, otherwise the symbol table might be - collected in the interval between creation and registration. But - we must also ensure that 'symtab' is valid before registration - (in this case, by setting it to NULL). See topic/root. */ + collected in the interval between creation and + registration. But we must also ensure that 'symtab' is valid + before registration (in this case, by setting it to NULL). See + topic/root. */ symtab = NULL; - ref = &symtab; - res = mps_root_create_table(&symtab_root, arena, mps_rank_exact(), 0, - ref, 1); + res = mps_root_create_area(&symtab_root, arena, mps_rank_exact(), 0, + &symtab, &symtab + 1, + mps_scan_area, NULL); if(res != MPS_RES_OK) error("Couldn't register symtab root"); /* The symbol table is strong-key weak-value. */ @@ -4582,14 +4582,7 @@ int main(int argc, char *argv[]) need to be scanned by the MPS because we are passing references to objects around in C parameters, return values, and keeping them in automatic local variables. See topic/root. */ - res = mps_root_create_reg(®_root, - arena, - mps_rank_ambig(), - 0, - thread, - mps_stack_scan_ambig, - marker, - 0); + res = mps_root_create_thread(®_root, arena, thread, marker); if (res != MPS_RES_OK) error("Couldn't create root"); /* Make sure we can pick up finalization messages. */ diff --git a/mps/example/scheme/scheme-boehm.c b/mps/example/scheme/scheme-boehm.c index 43e8967fb21..a5d39fa7dd5 100644 --- a/mps/example/scheme/scheme-boehm.c +++ b/mps/example/scheme/scheme-boehm.c @@ -25,16 +25,16 @@ /* LANGUAGE EXTENSION */ -#define unless(c) if(!(c)) -#define LENGTH(array) (sizeof(array) / sizeof(array[0])) +#define unless(c) if(!(c)) +#define LENGTH(array) (sizeof(array) / sizeof(array[0])) /* CONFIGURATION PARAMETERS */ -#define SYMMAX ((size_t)255) /* max length of a symbol */ -#define MSGMAX ((size_t)255) /* max length of error message */ -#define STRMAX ((size_t)255) /* max length of a string */ +#define SYMMAX ((size_t)255) /* max length of a symbol */ +#define MSGMAX ((size_t)255) /* max length of error message */ +#define STRMAX ((size_t)255) /* max length of a string */ /* DATA TYPES */ @@ -84,55 +84,55 @@ typedef struct type_s { } type_s; typedef struct pair_s { - type_t type; /* TYPE_PAIR */ - obj_t car, cdr; /* first and second projections */ + type_t type; /* TYPE_PAIR */ + obj_t car, cdr; /* first and second projections */ } pair_s; typedef struct symbol_s { - type_t type; /* TYPE_SYMBOL */ - size_t length; /* length of symbol string (excl. NUL) */ - char string[1]; /* symbol string, NUL terminated */ + type_t type; /* TYPE_SYMBOL */ + size_t length; /* length of symbol string (excl. NUL) */ + char string[1]; /* symbol string, NUL terminated */ } symbol_s; typedef struct integer_s { - type_t type; /* TYPE_INTEGER */ - long integer; /* the integer */ + type_t type; /* TYPE_INTEGER */ + long integer; /* the integer */ } integer_s; typedef struct special_s { - type_t type; /* TYPE_SPECIAL */ - char *name; /* printed representation, NUL terminated */ + type_t type; /* TYPE_SPECIAL */ + char *name; /* printed representation, NUL terminated */ } special_s; typedef struct operator_s { - type_t type; /* TYPE_OPERATOR */ - char *name; /* printed name, NUL terminated */ - entry_t entry; /* entry point -- see eval() */ - obj_t arguments, body; /* function arguments and code */ - obj_t env, op_env; /* closure environments */ + type_t type; /* TYPE_OPERATOR */ + char *name; /* printed name, NUL terminated */ + entry_t entry; /* entry point -- see eval() */ + obj_t arguments, body; /* function arguments and code */ + obj_t env, op_env; /* closure environments */ } operator_s; typedef struct string_s { - type_t type; /* TYPE_STRING */ - size_t length; /* number of chars in string */ - char string[1]; /* string, NUL terminated */ + type_t type; /* TYPE_STRING */ + size_t length; /* number of chars in string */ + char string[1]; /* string, NUL terminated */ } string_s; typedef struct port_s { - type_t type; /* TYPE_PORT */ - obj_t name; /* name of stream */ + type_t type; /* TYPE_PORT */ + obj_t name; /* name of stream */ FILE *stream; } port_s; typedef struct character_s { - type_t type; /* TYPE_CHARACTER */ - char c; /* the character */ + type_t type; /* TYPE_CHARACTER */ + char c; /* the character */ } character_s; typedef struct vector_s { - type_t type; /* TYPE_VECTOR */ - size_t length; /* number of elements */ - obj_t vector[1]; /* vector elements */ + type_t type; /* TYPE_VECTOR */ + size_t length; /* number of elements */ + obj_t vector[1]; /* vector elements */ } vector_s; typedef unsigned long (*hash_t)(obj_t obj); @@ -156,7 +156,7 @@ typedef struct buckets_s { } buckets_s; typedef union obj_u { - type_s type; /* one of TYPE_* */ + type_s type; /* one of TYPE_* */ pair_s pair; symbol_s symbol; integer_s integer; @@ -173,17 +173,17 @@ typedef union obj_u { /* structure macros */ -#define TYPE(obj) ((obj)->type.type) -#define CAR(obj) ((obj)->pair.car) -#define CDR(obj) ((obj)->pair.cdr) -#define CAAR(obj) CAR(CAR(obj)) -#define CADR(obj) CAR(CDR(obj)) -#define CDAR(obj) CDR(CAR(obj)) -#define CDDR(obj) CDR(CDR(obj)) -#define CADDR(obj) CAR(CDDR(obj)) -#define CDDDR(obj) CDR(CDDR(obj)) -#define CDDAR(obj) CDR(CDAR(obj)) -#define CADAR(obj) CAR(CDAR(obj)) +#define TYPE(obj) ((obj)->type.type) +#define CAR(obj) ((obj)->pair.car) +#define CDR(obj) ((obj)->pair.cdr) +#define CAAR(obj) CAR(CAR(obj)) +#define CADR(obj) CAR(CDR(obj)) +#define CDAR(obj) CDR(CAR(obj)) +#define CDDR(obj) CDR(CDR(obj)) +#define CADDR(obj) CAR(CDDR(obj)) +#define CDDDR(obj) CDR(CDDR(obj)) +#define CDDAR(obj) CDR(CDAR(obj)) +#define CADAR(obj) CAR(CDAR(obj)) /* GLOBAL DATA */ @@ -213,12 +213,12 @@ static size_t symtab_size; * special purposes. */ -static obj_t obj_empty; /* (), the empty list */ -static obj_t obj_eof; /* end of file */ -static obj_t obj_error; /* error indicator */ -static obj_t obj_true; /* #t, boolean true */ -static obj_t obj_false; /* #f, boolean false */ -static obj_t obj_undefined; /* undefined result indicator */ +static obj_t obj_empty; /* (), the empty list */ +static obj_t obj_eof; /* end of file */ +static obj_t obj_error; /* error indicator */ +static obj_t obj_true; /* #t, boolean true */ +static obj_t obj_false; /* #f, boolean false */ +static obj_t obj_undefined; /* undefined result indicator */ static obj_t obj_tail; /* tail recursion indicator */ static obj_t obj_deleted; /* deleted key in hashtable */ @@ -230,13 +230,13 @@ static obj_t obj_deleted; /* deleted key in hashtable */ * Scheme language, and are used by the evaluator to parse code. */ -static obj_t obj_quote; /* "quote" symbol */ -static obj_t obj_quasiquote; /* "quasiquote" symbol */ -static obj_t obj_lambda; /* "lambda" symbol */ -static obj_t obj_begin; /* "begin" symbol */ -static obj_t obj_else; /* "else" symbol */ -static obj_t obj_unquote; /* "unquote" symbol */ -static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */ +static obj_t obj_quote; /* "quote" symbol */ +static obj_t obj_quasiquote; /* "quasiquote" symbol */ +static obj_t obj_lambda; /* "lambda" symbol */ +static obj_t obj_begin; /* "begin" symbol */ +static obj_t obj_else; /* "else" symbol */ +static obj_t obj_unquote; /* "unquote" symbol */ +static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */ /* error handler @@ -545,8 +545,8 @@ static void rehash(void) { for(i = 0; i < old_symtab_size; ++i) if(old_symtab[i] != NULL) { obj_t *where = find(old_symtab[i]->symbol.string); - assert(where != NULL); /* new table shouldn't be full */ - assert(*where == NULL); /* shouldn't be in new table */ + assert(where != NULL); /* new table shouldn't be full */ + assert(*where == NULL); /* shouldn't be in new table */ *where = old_symtab[i]; } } @@ -560,10 +560,10 @@ static obj_t intern(char *string) { if(where == NULL) { rehash(); where = find(string); - assert(where != NULL); /* shouldn't be full after rehash */ + assert(where != NULL); /* shouldn't be full after rehash */ } - if(*where == NULL) /* symbol not found in table */ + if(*where == NULL) /* symbol not found in table */ *where = make_symbol(strlen(string), string); return *where; @@ -673,8 +673,8 @@ static void table_rehash(obj_t tbl) struct bucket_s *old_b = &tbl->table.buckets->buckets.bucket[i]; if (old_b->key != NULL && old_b->key != obj_deleted) { struct bucket_s *b = buckets_find(tbl, new_buckets, old_b->key); - assert(b != NULL); /* new table shouldn't be full */ - assert(b->key == NULL); /* shouldn't be in new table */ + assert(b != NULL); /* new table shouldn't be full */ + assert(b->key == NULL); /* shouldn't be in new table */ *b = *old_b; ++ new_buckets->buckets.used; } @@ -1052,13 +1052,13 @@ static obj_t read_special(FILE *stream, int c) switch(tolower(c)) { case 't': return obj_true; case 'f': return obj_false; - case '\\': { /* character (R4RS 6.6) */ + case '\\': { /* character (R4RS 6.6) */ c = getc(stream); if(c == EOF) error("read: end of file reading character literal"); return make_character(c); } - case '(': { /* vector (R4RS 6.8) */ + case '(': { /* vector (R4RS 6.8) */ obj_t list = read_list(stream, c); obj_t vector = list_to_vector(list); if(vector == obj_error) @@ -1159,7 +1159,7 @@ static obj_t lookup(obj_t env, obj_t symbol) static void define(obj_t env, obj_t symbol, obj_t value) { obj_t binding; - assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */ + assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */ binding = lookup_in_frame(CAR(env), symbol); if(binding != obj_undefined) CDR(binding) = value; @@ -1572,7 +1572,7 @@ static obj_t entry_let(obj_t env, obj_t op_env, obj_t operator, obj_t operands) unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -1599,7 +1599,7 @@ static obj_t entry_let_star(obj_t env, obj_t op_env, obj_t operator, obj_t opera unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -1626,7 +1626,7 @@ static obj_t entry_letrec(obj_t env, obj_t op_env, obj_t operator, obj_t operand unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -2350,7 +2350,7 @@ static obj_t entry_divide(obj_t env, obj_t op_env, obj_t operator, obj_t operand if(args == obj_empty) { if(result == 0) error("%s: reciprocal of zero", operator->operator.name); - result = 1/result; /* TODO: pretty meaningless for integers */ + result = 1/result; /* TODO: pretty meaningless for integers */ } else { while(TYPE(args) == TYPE_PAIR) { unless(TYPE(CAR(args)) == TYPE_INTEGER) diff --git a/mps/example/scheme/scheme-malloc.c b/mps/example/scheme/scheme-malloc.c index af619f9c15c..b09bd253fc1 100644 --- a/mps/example/scheme/scheme-malloc.c +++ b/mps/example/scheme/scheme-malloc.c @@ -23,16 +23,16 @@ /* LANGUAGE EXTENSION */ -#define unless(c) if(!(c)) -#define LENGTH(array) (sizeof(array) / sizeof(array[0])) +#define unless(c) if(!(c)) +#define LENGTH(array) (sizeof(array) / sizeof(array[0])) /* CONFIGURATION PARAMETERS */ -#define SYMMAX ((size_t)255) /* max length of a symbol */ -#define MSGMAX ((size_t)255) /* max length of error message */ -#define STRMAX ((size_t)255) /* max length of a string */ +#define SYMMAX ((size_t)255) /* max length of a symbol */ +#define MSGMAX ((size_t)255) /* max length of error message */ +#define STRMAX ((size_t)255) /* max length of a string */ /* DATA TYPES */ @@ -82,55 +82,55 @@ typedef struct type_s { } type_s; typedef struct pair_s { - type_t type; /* TYPE_PAIR */ - obj_t car, cdr; /* first and second projections */ + type_t type; /* TYPE_PAIR */ + obj_t car, cdr; /* first and second projections */ } pair_s; typedef struct symbol_s { - type_t type; /* TYPE_SYMBOL */ - size_t length; /* length of symbol string (excl. NUL) */ - char string[1]; /* symbol string, NUL terminated */ + type_t type; /* TYPE_SYMBOL */ + size_t length; /* length of symbol string (excl. NUL) */ + char string[1]; /* symbol string, NUL terminated */ } symbol_s; typedef struct integer_s { - type_t type; /* TYPE_INTEGER */ - long integer; /* the integer */ + type_t type; /* TYPE_INTEGER */ + long integer; /* the integer */ } integer_s; typedef struct special_s { - type_t type; /* TYPE_SPECIAL */ - char *name; /* printed representation, NUL terminated */ + type_t type; /* TYPE_SPECIAL */ + char *name; /* printed representation, NUL terminated */ } special_s; typedef struct operator_s { - type_t type; /* TYPE_OPERATOR */ - char *name; /* printed name, NUL terminated */ - entry_t entry; /* entry point -- see eval() */ - obj_t arguments, body; /* function arguments and code */ - obj_t env, op_env; /* closure environments */ + type_t type; /* TYPE_OPERATOR */ + char *name; /* printed name, NUL terminated */ + entry_t entry; /* entry point -- see eval() */ + obj_t arguments, body; /* function arguments and code */ + obj_t env, op_env; /* closure environments */ } operator_s; typedef struct string_s { - type_t type; /* TYPE_STRING */ - size_t length; /* number of chars in string */ - char string[1]; /* string, NUL terminated */ + type_t type; /* TYPE_STRING */ + size_t length; /* number of chars in string */ + char string[1]; /* string, NUL terminated */ } string_s; typedef struct port_s { - type_t type; /* TYPE_PORT */ - obj_t name; /* name of stream */ + type_t type; /* TYPE_PORT */ + obj_t name; /* name of stream */ FILE *stream; } port_s; typedef struct character_s { - type_t type; /* TYPE_CHARACTER */ - char c; /* the character */ + type_t type; /* TYPE_CHARACTER */ + char c; /* the character */ } character_s; typedef struct vector_s { - type_t type; /* TYPE_VECTOR */ - size_t length; /* number of elements */ - obj_t vector[1]; /* vector elements */ + type_t type; /* TYPE_VECTOR */ + size_t length; /* number of elements */ + obj_t vector[1]; /* vector elements */ } vector_s; typedef unsigned long (*hash_t)(obj_t obj); @@ -154,7 +154,7 @@ typedef struct buckets_s { } buckets_s; typedef union obj_u { - type_s type; /* one of TYPE_* */ + type_s type; /* one of TYPE_* */ pair_s pair; symbol_s symbol; integer_s integer; @@ -171,17 +171,17 @@ typedef union obj_u { /* structure macros */ -#define TYPE(obj) ((obj)->type.type) -#define CAR(obj) ((obj)->pair.car) -#define CDR(obj) ((obj)->pair.cdr) -#define CAAR(obj) CAR(CAR(obj)) -#define CADR(obj) CAR(CDR(obj)) -#define CDAR(obj) CDR(CAR(obj)) -#define CDDR(obj) CDR(CDR(obj)) -#define CADDR(obj) CAR(CDDR(obj)) -#define CDDDR(obj) CDR(CDDR(obj)) -#define CDDAR(obj) CDR(CDAR(obj)) -#define CADAR(obj) CAR(CDAR(obj)) +#define TYPE(obj) ((obj)->type.type) +#define CAR(obj) ((obj)->pair.car) +#define CDR(obj) ((obj)->pair.cdr) +#define CAAR(obj) CAR(CAR(obj)) +#define CADR(obj) CAR(CDR(obj)) +#define CDAR(obj) CDR(CAR(obj)) +#define CDDR(obj) CDR(CDR(obj)) +#define CADDR(obj) CAR(CDDR(obj)) +#define CDDDR(obj) CDR(CDDR(obj)) +#define CDDAR(obj) CDR(CDAR(obj)) +#define CADAR(obj) CAR(CDAR(obj)) /* GLOBAL DATA */ @@ -211,12 +211,12 @@ static size_t symtab_size; * special purposes. */ -static obj_t obj_empty; /* (), the empty list */ -static obj_t obj_eof; /* end of file */ -static obj_t obj_error; /* error indicator */ -static obj_t obj_true; /* #t, boolean true */ -static obj_t obj_false; /* #f, boolean false */ -static obj_t obj_undefined; /* undefined result indicator */ +static obj_t obj_empty; /* (), the empty list */ +static obj_t obj_eof; /* end of file */ +static obj_t obj_error; /* error indicator */ +static obj_t obj_true; /* #t, boolean true */ +static obj_t obj_false; /* #f, boolean false */ +static obj_t obj_undefined; /* undefined result indicator */ static obj_t obj_tail; /* tail recursion indicator */ static obj_t obj_deleted; /* deleted key in hashtable */ @@ -228,13 +228,13 @@ static obj_t obj_deleted; /* deleted key in hashtable */ * Scheme language, and are used by the evaluator to parse code. */ -static obj_t obj_quote; /* "quote" symbol */ -static obj_t obj_quasiquote; /* "quasiquote" symbol */ -static obj_t obj_lambda; /* "lambda" symbol */ -static obj_t obj_begin; /* "begin" symbol */ -static obj_t obj_else; /* "else" symbol */ -static obj_t obj_unquote; /* "unquote" symbol */ -static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */ +static obj_t obj_quote; /* "quote" symbol */ +static obj_t obj_quasiquote; /* "quasiquote" symbol */ +static obj_t obj_lambda; /* "lambda" symbol */ +static obj_t obj_begin; /* "begin" symbol */ +static obj_t obj_else; /* "else" symbol */ +static obj_t obj_unquote; /* "unquote" symbol */ +static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */ /* error handler @@ -543,8 +543,8 @@ static void rehash(void) { for(i = 0; i < old_symtab_size; ++i) if(old_symtab[i] != NULL) { obj_t *where = find(old_symtab[i]->symbol.string); - assert(where != NULL); /* new table shouldn't be full */ - assert(*where == NULL); /* shouldn't be in new table */ + assert(where != NULL); /* new table shouldn't be full */ + assert(*where == NULL); /* shouldn't be in new table */ *where = old_symtab[i]; } @@ -560,10 +560,10 @@ static obj_t intern(char *string) { if(where == NULL) { rehash(); where = find(string); - assert(where != NULL); /* shouldn't be full after rehash */ + assert(where != NULL); /* shouldn't be full after rehash */ } - if(*where == NULL) /* symbol not found in table */ + if(*where == NULL) /* symbol not found in table */ *where = make_symbol(strlen(string), string); return *where; @@ -673,8 +673,8 @@ static void table_rehash(obj_t tbl) struct bucket_s *old_b = &tbl->table.buckets->buckets.bucket[i]; if (old_b->key != NULL && old_b->key != obj_deleted) { struct bucket_s *b = buckets_find(tbl, new_buckets, old_b->key); - assert(b != NULL); /* new table shouldn't be full */ - assert(b->key == NULL); /* shouldn't be in new table */ + assert(b != NULL); /* new table shouldn't be full */ + assert(b->key == NULL); /* shouldn't be in new table */ *b = *old_b; ++ new_buckets->buckets.used; } @@ -1052,13 +1052,13 @@ static obj_t read_special(FILE *stream, int c) switch(tolower(c)) { case 't': return obj_true; case 'f': return obj_false; - case '\\': { /* character (R4RS 6.6) */ + case '\\': { /* character (R4RS 6.6) */ c = getc(stream); if(c == EOF) error("read: end of file reading character literal"); return make_character(c); } - case '(': { /* vector (R4RS 6.8) */ + case '(': { /* vector (R4RS 6.8) */ obj_t list = read_list(stream, c); obj_t vector = list_to_vector(list); if(vector == obj_error) @@ -1159,7 +1159,7 @@ static obj_t lookup(obj_t env, obj_t symbol) static void define(obj_t env, obj_t symbol, obj_t value) { obj_t binding; - assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */ + assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */ binding = lookup_in_frame(CAR(env), symbol); if(binding != obj_undefined) CDR(binding) = value; @@ -1572,7 +1572,7 @@ static obj_t entry_let(obj_t env, obj_t op_env, obj_t operator, obj_t operands) unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -1599,7 +1599,7 @@ static obj_t entry_let_star(obj_t env, obj_t op_env, obj_t operator, obj_t opera unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -1626,7 +1626,7 @@ static obj_t entry_letrec(obj_t env, obj_t op_env, obj_t operator, obj_t operand unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -2350,7 +2350,7 @@ static obj_t entry_divide(obj_t env, obj_t op_env, obj_t operator, obj_t operand if(args == obj_empty) { if(result == 0) error("%s: reciprocal of zero", operator->operator.name); - result = 1/result; /* TODO: pretty meaningless for integers */ + result = 1/result; /* TODO: pretty meaningless for integers */ } else { while(TYPE(args) == TYPE_PAIR) { unless(TYPE(CAR(args)) == TYPE_INTEGER) diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c index fb43e62e344..4a10b5c9b10 100644 --- a/mps/example/scheme/scheme.c +++ b/mps/example/scheme/scheme.c @@ -54,17 +54,17 @@ /* LANGUAGE EXTENSION */ -#define unless(c) if(!(c)) -#define LENGTH(array) (sizeof(array) / sizeof(array[0])) +#define unless(c) if(!(c)) +#define LENGTH(array) (sizeof(array) / sizeof(array[0])) #define UNUSED(var) ((void)var) /* CONFIGURATION PARAMETERS */ -#define SYMMAX ((size_t)255) /* max length of a symbol */ -#define MSGMAX ((size_t)255) /* max length of error message */ -#define STRMAX ((size_t)255) /* max length of a string */ +#define SYMMAX ((size_t)255) /* max length of a symbol */ +#define MSGMAX ((size_t)255) /* max length of error message */ +#define STRMAX ((size_t)255) /* max length of a string */ /* DATA TYPES */ @@ -118,55 +118,55 @@ typedef struct type_s { } type_s; typedef struct pair_s { - type_t type; /* TYPE_PAIR */ - obj_t car, cdr; /* first and second projections */ + type_t type; /* TYPE_PAIR */ + obj_t car, cdr; /* first and second projections */ } pair_s; typedef struct symbol_s { - type_t type; /* TYPE_SYMBOL */ - size_t length; /* length of symbol string (excl. NUL) */ - char string[1]; /* symbol string, NUL terminated */ + type_t type; /* TYPE_SYMBOL */ + size_t length; /* length of symbol string (excl. NUL) */ + char string[1]; /* symbol string, NUL terminated */ } symbol_s; typedef struct integer_s { - type_t type; /* TYPE_INTEGER */ - long integer; /* the integer */ + type_t type; /* TYPE_INTEGER */ + long integer; /* the integer */ } integer_s; typedef struct special_s { - type_t type; /* TYPE_SPECIAL */ - const char *name; /* printed representation, NUL terminated */ + type_t type; /* TYPE_SPECIAL */ + const char *name; /* printed representation, NUL terminated */ } special_s; typedef struct operator_s { - type_t type; /* TYPE_OPERATOR */ - const char *name; /* printed name, NUL terminated */ - entry_t entry; /* entry point -- see eval() */ - obj_t arguments, body; /* function arguments and code */ - obj_t env, op_env; /* closure environments */ + type_t type; /* TYPE_OPERATOR */ + const char *name; /* printed name, NUL terminated */ + entry_t entry; /* entry point -- see eval() */ + obj_t arguments, body; /* function arguments and code */ + obj_t env, op_env; /* closure environments */ } operator_s; typedef struct string_s { - type_t type; /* TYPE_STRING */ - size_t length; /* number of chars in string */ - char string[1]; /* string, NUL terminated */ + type_t type; /* TYPE_STRING */ + size_t length; /* number of chars in string */ + char string[1]; /* string, NUL terminated */ } string_s; typedef struct port_s { - type_t type; /* TYPE_PORT */ - obj_t name; /* name of stream */ + type_t type; /* TYPE_PORT */ + obj_t name; /* name of stream */ FILE *stream; } port_s; typedef struct character_s { - type_t type; /* TYPE_CHARACTER */ - char c; /* the character */ + type_t type; /* TYPE_CHARACTER */ + char c; /* the character */ } character_s; typedef struct vector_s { - type_t type; /* TYPE_VECTOR */ - size_t length; /* number of elements */ - obj_t vector[1]; /* vector elements */ + type_t type; /* TYPE_VECTOR */ + size_t length; /* number of elements */ + obj_t vector[1]; /* vector elements */ } vector_s; typedef unsigned long (*hash_t)(obj_t obj, mps_ld_t ld); @@ -238,7 +238,7 @@ typedef struct pad_s { typedef union obj_u { - type_s type; /* one of TYPE_* */ + type_s type; /* one of TYPE_* */ pair_s pair; symbol_s symbol; integer_s integer; @@ -258,17 +258,17 @@ typedef union obj_u { /* structure macros */ -#define TYPE(obj) ((obj)->type.type) -#define CAR(obj) ((obj)->pair.car) -#define CDR(obj) ((obj)->pair.cdr) -#define CAAR(obj) CAR(CAR(obj)) -#define CADR(obj) CAR(CDR(obj)) -#define CDAR(obj) CDR(CAR(obj)) -#define CDDR(obj) CDR(CDR(obj)) -#define CADDR(obj) CAR(CDDR(obj)) -#define CDDDR(obj) CDR(CDDR(obj)) -#define CDDAR(obj) CDR(CDAR(obj)) -#define CADAR(obj) CAR(CDAR(obj)) +#define TYPE(obj) ((obj)->type.type) +#define CAR(obj) ((obj)->pair.car) +#define CDR(obj) ((obj)->pair.cdr) +#define CAAR(obj) CAR(CAR(obj)) +#define CADR(obj) CAR(CDR(obj)) +#define CDAR(obj) CDR(CAR(obj)) +#define CDDR(obj) CDR(CDR(obj)) +#define CADDR(obj) CAR(CDDR(obj)) +#define CDDDR(obj) CDR(CDDR(obj)) +#define CDDAR(obj) CDR(CDAR(obj)) +#define CADAR(obj) CAR(CDAR(obj)) /* GLOBAL DATA */ @@ -308,12 +308,12 @@ static mps_root_t symtab_root; * See `globals_scan`. */ -static obj_t obj_empty; /* (), the empty list */ -static obj_t obj_eof; /* end of file */ -static obj_t obj_error; /* error indicator */ -static obj_t obj_true; /* #t, boolean true */ -static obj_t obj_false; /* #f, boolean false */ -static obj_t obj_undefined; /* undefined result indicator */ +static obj_t obj_empty; /* (), the empty list */ +static obj_t obj_eof; /* end of file */ +static obj_t obj_error; /* error indicator */ +static obj_t obj_true; /* #t, boolean true */ +static obj_t obj_false; /* #f, boolean false */ +static obj_t obj_undefined; /* undefined result indicator */ static obj_t obj_tail; /* tail recursion indicator */ static obj_t obj_deleted; /* deleted key in hashtable */ @@ -325,13 +325,13 @@ static obj_t obj_deleted; /* deleted key in hashtable */ * Scheme language, and are used by the evaluator to parse code. */ -static obj_t obj_quote; /* "quote" symbol */ -static obj_t obj_quasiquote; /* "quasiquote" symbol */ -static obj_t obj_lambda; /* "lambda" symbol */ -static obj_t obj_begin; /* "begin" symbol */ -static obj_t obj_else; /* "else" symbol */ -static obj_t obj_unquote; /* "unquote" symbol */ -static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */ +static obj_t obj_quote; /* "quote" symbol */ +static obj_t obj_quasiquote; /* "quasiquote" symbol */ +static obj_t obj_lambda; /* "lambda" symbol */ +static obj_t obj_begin; /* "begin" symbol */ +static obj_t obj_else; /* "else" symbol */ +static obj_t obj_unquote; /* "unquote" symbol */ +static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */ /* error handler @@ -759,7 +759,6 @@ static void rehash(void) { size_t old_symtab_size = symtab_size; mps_root_t old_symtab_root = symtab_root; unsigned i; - mps_addr_t ref; mps_res_t res; symtab_size *= 2; @@ -770,21 +769,22 @@ static void rehash(void) { for(i = 0; i < symtab_size; ++i) symtab[i] = NULL; - /* Once the symbol table is initialized with scannable references (NULL - in this case) we must register it as a root before we copy objects - across from the old symbol table. The MPS might be moving objects - in memory at any time, and will arrange that both copies are updated - atomically to the mutator (this interpreter). */ - ref = symtab; - res = mps_root_create_table(&symtab_root, arena, mps_rank_exact(), 0, - ref, symtab_size); + /* %%MPS: Once the symbol table is initialized with scannable + references (NULL in this case) we must register it as a root + before we copy objects across from the old symbol table. The MPS + might be moving objects in memory at any time, and will arrange + that both copies are updated atomically to the mutator (this + interpreter). */ + res = mps_root_create_area(&symtab_root, arena, mps_rank_exact(), 0, + symtab, symtab + symtab_size, + mps_scan_area, NULL); if(res != MPS_RES_OK) error("Couldn't register new symtab root"); for(i = 0; i < old_symtab_size; ++i) if(old_symtab[i] != NULL) { obj_t *where = find(old_symtab[i]->symbol.string); - assert(where != NULL); /* new table shouldn't be full */ - assert(*where == NULL); /* shouldn't be in new table */ + assert(where != NULL); /* new table shouldn't be full */ + assert(*where == NULL); /* shouldn't be in new table */ *where = old_symtab[i]; } @@ -801,10 +801,10 @@ static obj_t intern(const char *string) { if(where == NULL) { rehash(); where = find(string); - assert(where != NULL); /* shouldn't be full after rehash */ + assert(where != NULL); /* shouldn't be full after rehash */ } - if(*where == NULL) /* symbol not found in table */ + if(*where == NULL) /* symbol not found in table */ *where = make_symbol(strlen(string), string); return *where; @@ -928,8 +928,8 @@ static struct bucket_s *table_rehash(obj_t tbl, size_t new_length, obj_t key) struct bucket_s *old_b = &tbl->table.buckets->buckets.bucket[i]; if (old_b->key != NULL && old_b->key != obj_deleted) { struct bucket_s *b = buckets_find(tbl, new_buckets, old_b->key, 1); - assert(b != NULL); /* new table shouldn't be full */ - assert(b->key == NULL); /* shouldn't be in new table */ + assert(b != NULL); /* new table shouldn't be full */ + assert(b->key == NULL); /* shouldn't be in new table */ *b = *old_b; if (b->key == key) key_bucket = b; ++ new_buckets->buckets.used; @@ -1352,13 +1352,13 @@ static obj_t read_special(FILE *stream, int c) switch(tolower(c)) { case 't': return obj_true; case 'f': return obj_false; - case '\\': { /* character (R4RS 6.6) */ + case '\\': { /* character (R4RS 6.6) */ c = getc(stream); if(c == EOF) error("read: end of file reading character literal"); return make_character((char)c); } - case '(': { /* vector (R4RS 6.8) */ + case '(': { /* vector (R4RS 6.8) */ obj_t list = read_list(stream, c); obj_t vector = list_to_vector(list); if(vector == obj_error) @@ -1459,7 +1459,7 @@ static obj_t lookup(obj_t env, obj_t symbol) static void define(obj_t env, obj_t symbol, obj_t value) { obj_t binding; - assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */ + assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */ binding = lookup_in_frame(CAR(env), symbol); if(binding != obj_undefined) CDR(binding) = value; @@ -1878,7 +1878,7 @@ static obj_t entry_let(obj_t env, obj_t op_env, obj_t operator, obj_t operands) unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -1905,7 +1905,7 @@ static obj_t entry_let_star(obj_t env, obj_t op_env, obj_t operator, obj_t opera unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -1932,7 +1932,7 @@ static obj_t entry_letrec(obj_t env, obj_t op_env, obj_t operator, obj_t operand unless(TYPE(operands) == TYPE_PAIR && TYPE(CDR(operands)) == TYPE_PAIR) error("%s: illegal syntax", operator->operator.name); - inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ + inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */ bindings = CAR(operands); while(TYPE(bindings) == TYPE_PAIR) { obj_t binding = CAR(bindings); @@ -2656,7 +2656,7 @@ static obj_t entry_divide(obj_t env, obj_t op_env, obj_t operator, obj_t operand if(args == obj_empty) { if(result == 0) error("%s: reciprocal of zero", operator->operator.name); - result = 1/result; /* TODO: pretty meaningless for integers */ + result = 1/result; /* TODO: pretty meaningless for integers */ } else { while(TYPE(args) == TYPE_PAIR) { unless(TYPE(CAR(args)) == TYPE_INTEGER) @@ -4243,7 +4243,6 @@ static int start(int argc, char *argv[]) size_t i; volatile obj_t env, op_env, obj; jmp_buf jb; - mps_addr_t ref; mps_res_t res; mps_root_t globals_root; int exit_code = EXIT_SUCCESS; @@ -4261,9 +4260,9 @@ static int start(int argc, char *argv[]) pointers -- NULL in this case. Random values look like false references into MPS memory and cause undefined behaviour (most likely assertion failures). See topic/root. */ - ref = symtab; - res = mps_root_create_table(&symtab_root, arena, mps_rank_exact(), 0, - ref, symtab_size); + res = mps_root_create_area(&symtab_root, arena, mps_rank_exact(), 0, + symtab, symtab + symtab_size, + mps_scan_area, NULL); if(res != MPS_RES_OK) error("Couldn't register symtab root"); error_handler = &jb; @@ -4477,14 +4476,7 @@ int main(int argc, char *argv[]) need to be scanned by the MPS because we are passing references to objects around in C parameters, return values, and keeping them in automatic local variables. See topic/root. */ - res = mps_root_create_reg(®_root, - arena, - mps_rank_ambig(), - 0, - thread, - mps_stack_scan_ambig, - marker, - 0); + res = mps_root_create_thread(®_root, arena, thread, marker); if (res != MPS_RES_OK) error("Couldn't create root"); /* Make sure we can pick up finalization messages. */ diff --git a/mps/manual/source/code-index.rst b/mps/manual/source/code-index.rst new file mode 100644 index 00000000000..c38dff4a9cf --- /dev/null +++ b/mps/manual/source/code-index.rst @@ -0,0 +1,449 @@ +.. _code-index: + +Index to source code +==================== + + +External MPS interface +---------------------- + +The external MPS interface consists of header files that the +:term:`client program` is expected to include, plus the single-file +source code (mps.c). See design.mps.interface-c_. + +=========== ================================================================== +File Description +=========== ================================================================== +mps.h Public MPS interface. +mps.c Single-file source code. See :ref:`guide-build`. +mpsacl.h :ref:`topic-arena-client` external interface. +mpsavm.h :ref:`topic-arena-vm` external interface. +mpscamc.h :ref:`pool-amc` pool class external interface. +mpscams.h :ref:`pool-ams` pool class external interface. +mpscawl.h :ref:`pool-awl` pool class external interface. +mpsclo.h :ref:`pool-lo` pool class external interface. +mpscmfs.h :ref:`pool-mfs` pool class external interface. +mpscmv.h :ref:`pool-mv` pool class external interface. +mpscmv2.h Former (deprecated) :ref:`pool-mvt` pool class interface. +mpscmvff.h :ref:`pool-mvff` pool class external interface. +mpscmvt.h :ref:`pool-mvt` pool class external interface. +mpscsnc.h :ref:`pool-snc` pool class external interface. +mpsio.h :ref:`topic-plinth-io` interface. +mpslib.h :ref:`topic-plinth-lib` interface. +=========== ================================================================== + + +Plinth +------ + +The :term:`plinth` provides an interface between the MPS and the +execution environment, to help support :term:`freestanding` +implementations. See :ref:`topic-plinth`. + +=========== ================================================================== +File Description +=========== ================================================================== +mpsioan.c :ref:`topic-plinth-io` for "ANSI" (hosted) environments. +mpsliban.c :ref:`topic-plinth-lib` for "ANSI" (hosted) environments. +=========== ================================================================== + + +Configuration +------------- + +These header files provide platform-specific constants, type +declarations, and macros. See :ref:`topic-porting` and +design.mps.config_. + +=========== ================================================================== +File Description +=========== ================================================================== +clock.h Fast high-resolution clocks. +config.h MPS configuration header. +mpstd.h Target detection header. +=========== ================================================================== + + +Core MPS +-------- + +============ ================================================================= +File Description +============ ================================================================= +abq.c Fixed-length queue implementation. See design.mps.abq_. +abq.h Fixed-length queue interface. See design.mps.abq_. +arena.c Arena implementation. See design.mps.arena_. +arenacl.c :ref:`topic-arena-client` implementation. +arenavm.c :ref:`topic-arena-vm` implementation. +arg.c :ref:`topic-keyword` implementation. +arg.h :ref:`topic-keyword` interface. +boot.c Bootstrap allocator implementation. See design.mps.bootstrap_. +boot.h Bootstrap allocator interface. See design.mps.bootstrap_. +bt.c Bit table implementation. See design.mps.bt_. +bt.h Bit table interface. See design.mps.bt_. +buffer.c Buffer implementation. See design.mps.buffer_. +cbs.c Coalescing block implementation. See design.mps.cbs_. +cbs.h Coalescing block interface. See design.mps.cbs_. +check.h Assertion interface. See design.mps.check_. +dbgpool.c :ref:`topic-debugging` implementation. +dbgpool.h :ref:`topic-debugging` interface. +dbgpooli.c :ref:`topic-debugging` external interface. +event.c :ref:`topic-telemetry` implementation. +event.h :ref:`topic-telemetry` interface (internal). +eventcom.h :ref:`topic-telemetry` interface (auxiliary programs). +eventdef.h :ref:`topic-telemetry` event definitions. +failover.c Fail-over allocator implementation. See design.mps.failover_. +failover.h Fail-over allocator interface. See design.mps.failover_. +format.c :ref:`topic-format` implementation. +freelist.c Freelist allocator implementation. See design.mps.freelist_. +freelist.h Freelist allocator interface. See design.mps.freelist_. +global.c Global arena implementation. +land.c Land implementation. See design.mps.land_. +ld.c :ref:`topic-location` implementation. +locus.c Locus manager implementation. See design.mps.locus_. +locus.h Locus manager interface. See design.mps.locus_. +message.c :ref:`topic-message` implementation. +meter.c Debugging accumulator implementation. +meter.h Debugging accumulator interface. +misc.h Miscellaneous constant and macro definitions. +mpm.c Miscellaneous support functions. See design.mps.writef_. +mpm.h Core MPS interface. ("MPM" = "Memory Pool Manager") +mpmst.h Core data structure declarations. +mpmtypes.h Core type declarations. +mpsi.c External interface implementation. See design.mps.interface-c_. +mpsiw3.c Additional external interface implementation for Windows. +mpswin.h Wrapper for windows.h. +nailboard.c Nailboard implementation. See design.mps.nailboard_. +nailboard.h Nailboard interface. See design.mps.nailboard_. +policy.c Collection policy decisions. See design.mps.strategy_. +pool.c Pool implementation. See design.mps.pool_. +poolabs.c Abstract pool classes. +poolmrg.c Manual Rank Guardian pool implementation. See design.mps.poolmrg_. +poolmrg.h Manual Rank Guardian pool interface. See design.mps.poolmrg_. +protocol.c Inheritance protocol implementation. See design.mps.protocol_. +protocol.h Inheritance protocol interface. See design.mps.protocol_. +range.c Address ranges implementation. See design.mps.range_. +range.h Address ranges interface. See design.mps.range_. +ref.c Ranks and zones implementation. +reserv.c Reservoir pool implementation. See design.mps.reservoir_. +ring.c Ring implementation. See design.mps.ring_. +ring.h Ring interface. See design.mps.ring_. +root.c :ref:`topic-root` implementation. +sa.c Sparse array implementation. +sa.h Sparse array interface. +sac.c :ref:`topic-cache` implementation. +sac.h :ref:`topic-cache` interface. +sc.h Stack context interface. +scan.c :ref:`topic-scanning` functions. +seg.c Segment implementation. See design.mps.seg_. +shield.c Shield implementation. See design.mps.shield_. +splay.c Splay tree implementation. See design.mps.splay_. +splay.h Splay tree interface. See design.mps.splay_. +trace.c Trace implementation. See design.mps.trace_. +traceanc.c More trace implementation. See design.mps.trace_. +tract.c Chunk and tract implementation. See design.mps.arena_. +tract.h Chunk and tract interface. See design.mps.arena_. +tree.c Binary tree implementation. +tree.h Binary tree interface. +version.c MPS version implementation. See design.mps.version_. +walk.c Formatted object walker. +============ ================================================================= + + +Platform interfaces +------------------- + +These modules provide interfaces to features that are not available in +standard C, and so may need to be ported to new platforms. See +:ref:`topic-porting`. + +============ ================================================================= +File Description +============ ================================================================= +lock.h Lock interface. See design.mps.lock_. +lockan.c Lock implementation for standard C. +lockix.c Lock implementation for POSIX. +lockli.c Lock implementation for Linux. +lockw3.c Lock implementation for Windows. +prmcan.c Mutator context implementation for standard C. +prmci3.h Mutator context interface for IA-32. +prmci3fr.c Mutator context implementation for FreeBSD, IA-32. +prmci3li.c Mutator context implementation for Linux, IA-32. +prmci3w3.c Mutator context implementation for Windows, IA-32. +prmci3xc.c Mutator context implementation for OS X, IA-32. +prmci6.h Mutator context interface for x86-64. +prmci6fr.c Mutator context implementation for FreeBSD, x86-64. +prmci6li.c Mutator context implementation for Linux, x86-64. +prmci6w3.c Mutator context implementation for Windows, x86-64. +prmci6xc.c Mutator context implementation for OS X, x86-64. +prmcix.h Mutator context interface for POSIX. +prmcw3.h Mutator context interface for Windows. +prmcxc.h Mutator context interface for OS X. +prot.h Protection interface. See design.mps.prot_. +protan.c Protection implementation for standard C. +proti3.c Protection implementation for IA-32. +proti6.c Protection implementation for x86-64. +protix.c Protection implementation for POSIX. +protli.c Protection implementation for Linux. +protsgix.c Protection implementation for POSIX (signals part). +protw3.c Protection implementation for Windows. +protxc.c Protection implementation for OS X. +protxc.h Protection interface for OS X. +pthrdext.c Protection implementation for POSIX (threads part). +pthrdext.h Protection interface for POSIX (threads part). +sp.h Stack probe interface. See design.mps.sp_. +span.c Stack probe implementation for standard C. +spw3i3.c Stack probe implementation for Windows, IA-32. +spw3i6.c Stack probe implementation for Windows, x86-64. +ss.c Stack scanning implementation (common part). +ss.h Stack scanning interface. See design.mps.ss_. +ssan.c Stack scanning implementation for standard C. +ssixi3.c Stack scanning implementation for POSIX, IA-32. +ssixi6.c Stack scanning implementation for POSIX, x86-64. +ssw3i3mv.c Stack scanning implementation for Windows, IA-32, Visual C. +ssw3i3pc.c Stack scanning implementation for Windows, x86-64, Pelles C. +ssw3i6mv.c Stack scanning implementation for Windows, IA-32, Visual C. +ssw3i6pc.c Stack scanning implementation for Windows, x86-64, Pelles C. +th.h Threads interface. See design.mps.thread-manager_. +than.c Threads implementation for standard C. +thix.c Threads implementation for POSIX. +thw3.c Threads implementation for Windows. +thw3.h Threads interface for Windows. +thw3i3.c Threads implementation for Windows, IA-32. +thw3i6.c Threads implementation for Windows, x86-64. +thxc.c Threads implementation for OS X. +vm.c Virtual memory implementation (common part). +vm.h Virtual memory interface. See design.mps.vm_. +vman.c Virtual memory implementation for standard C. +vmix.c Virtual memory implementation for POSIX. +vmw3.c Virtual memory implementation for Windows. +============ ================================================================= + + +Pool classes +------------ + +These files implement the supported :term:`pool classes`. Some of +these (MFS, MV) are used internally by the MPS; the others are +available for :term:`client programs` only. See :ref:`pool`. + +=========== ================================================================== +File Description +=========== ================================================================== +poolamc.c :ref:`pool-amc` implementation. +poolams.c :ref:`pool-ams` implementation. +poolams.h :ref:`pool-ams` internal interface. +poolawl.c :ref:`pool-awl` implementation. +poollo.c :ref:`pool-lo` implementation. +poolmfs.c :ref:`pool-mfs` implementation. +poolmfs.h :ref:`pool-mfs` internal interface. +poolmv.c :ref:`pool-mv` implementation. +poolmv.h :ref:`pool-mv` internal interface. +poolmv2.c :ref:`pool-amc` implementation. +poolmv2.h :ref:`pool-mvt` internal interface. +poolmvff.c :ref:`pool-mvff` implementation. +poolsnc.c :ref:`pool-snc` implementation. +=========== ================================================================== + + +Auxiliary programs +------------------ + +These files implement auxiliary programs. See +:ref:`topic-telemetry-utilities`. + +=========== ================================================================== +File Description +=========== ================================================================== +eventcnv.c :ref:`telemetry-mpseventcnv`. +eventrep.c Event replaying implementation (broken). +eventrep.h Event replaying interface (broken). +eventsql.c :ref:`telemetry-mpseventsql`. +eventtxt.c :ref:`telemetry-mpseventtxt`. +getopt.h Command-line option interface. Adapted from FreeBSD. +getoptl.c Command-line option implementation. Adapted from FreeBSD. +replay.c Event replaying program (broken). +table.c Address-based hash table implementation. +table.h Address-based hash table interface. +=========== ================================================================== + + +Benchmarks +---------- + +=========== ================================================================== +File Description +=========== ================================================================== +djbench.c Benchmark for manually managed pool classes. +gcbench.c Benchmark for automatically managed pool classes. +=========== ================================================================== + + +Test support +------------ + +This is code that's shared between test cases. + +============ ================================================================= +File Description +============ ================================================================= +fmtdy.c Dylan object format implementation. +fmtdy.h Dylan object format interface. +fmtdytst.c Dylan object constructor implementation. +fmtdytst.h Dylan object constructor interface. +fmthe.c Dylan-like object format with headers (implementation). +fmthe.h Dylan-like object format with headers (interface). +fmtno.c Null object format implementation. +fmtno.h Null object format interface. +fmtscheme.c Scheme object format implementation. +fmtscheme.h Scheme object format interface. +pooln.c Null pool implementation. +pooln.h Null pool interface. +testlib.c Test utilities implementation. +testlib.h Test utilities interface. +testthr.h Test threads interface. See design.mps.testthr_. +testthrix.c Test threads implementation for POSIX. +testthrw3.c Test threads implementation for Windows. +============ ================================================================= + + +Interactive test cases +---------------------- + +These test cases provide harness for interacting with parts of the +MPS, for exploring the interface and testing by hand. These predate +the use of continuous integration: we wouldn't write this kind of test +case now. + +=========== ================================================================== +File Description +=========== ================================================================== +bttest.c Interactive bit tables test harness. +teletest.c Interactive telemetry test harness. +=========== ================================================================== + + +Automated test cases +-------------------- + +These are test cases that run automatically and form the main test +suite. See design.mps.tests_. + +================ ============================================================= +File Description +================ ============================================================= +abqtest.c Fixed-length queue test. +airtest.c Ambiguous interior reference test. +amcss.c :ref:`pool-amc` stress test. +amcsshe.c :ref:`pool-amc` stress test (using in-band headers). +amcssth.c :ref:`pool-amc` stress test (using multiple threads). +amsss.c :ref:`pool-ams` stress test. +amssshe.c :ref:`pool-ams` stress test (using in-band headers). +apss.c :ref:`topic-allocation-point` stress test. +arenacv.c Arena coverage test. +awlut.c :ref:`pool-awl` unit test. +awluthe.c :ref:`pool-awl` unit test (using in-band headers). +awlutth.c :ref:`pool-awl` unit test (using multiple threads). +btcv.c Bit table coverage test. +exposet0.c :c:func:`mps_arena_expose` test. +expt825.c Regression test for job000825_. +fbmtest.c Free block manager (CBS and Freelist) test. +finalcv.c :ref:`topic-finalization` coverage test. +finaltest.c :ref:`topic-finalization` test. +fotest.c Failover allocator test. +landtest.c Land test. +locbwcss.c Locus backwards compatibility stress test. +lockcov.c Lock coverage test. +lockut.c Lock unit test. +locusss.c Locus stress test. +locv.c :ref:`pool-lo` coverage test. +messtest.c :ref:`topic-message` test. +mpmss.c Manual allocation stress test. +mpsicv.c External interface coverage test. +mv2test.c :ref:`pool-mvt` test. +nailboardtest.c Nailboard test. +poolncv.c Null pool class test. +qs.c Quicksort test. +sacss.c :ref:`topic-cache` stress test. +segsmss.c Segment splitting and merging stress test. +steptest.c :c:func:`mps_arena_step` test. +tagtest.c Tagged pointer scanning test. +walkt0.c Formatted object walking test. +zcoll.c Garbage collection progress test. +zmess.c Garbage collection and finalization message test. +================ ============================================================= + + +Build infrastructure +-------------------- + +These are makefiles (and makefile fragments) used to build the MPS. +See :ref:`topic-porting`. + +============= ================================================================ +File Description +============= ================================================================ +anangc.gmk GNU makefile for platform ANANGC. +ananll.gmk GNU makefile for platform ANANLL. +ananmv.nmk NMAKE file for platform ANANMV. +comm.gmk Common GNU make fragment. +commpost.nmk Common NMAKE fragment (included before the compiler fragment). +commpre.nmk Common NMAKE fragment (included after the compiler fragment). +fri3gc.gmk GNU makefile for platform FRI3GC. +fri3ll.gmk GNU makefile for platform FRI3LL. +fri6gc.gmk GNU makefile for platform FRI6GC. +fri6ll.gmk GNU makefile for platform FRI6LL. +gc.gmk GNU make fragment for GCC. +gp.gmk GNU make fragment for GCC/GProf (broken). +lii3gc.gmk GNU makefile for platform LII3GC. +lii6gc.gmk GNU makefile for platform LII6GC. +lii6ll.gmk GNU makefile for platform LII6LL. +ll.gmk GNU make fragment for Clang/LLVM. +mv.nmk NMAKE fragment for Microsoft Visual C. +pc.nmk NMAKE fragment for Pelles C. +w3i3mv.nmk NMAKE file for platform W3I3MV. +w3i3pc.nmk NMAKE file for platform W3I3PC. +w3i6mv.nmk NMAKE file for platform W3I6MV. +w3i6pc.nmk NMAKE file for platform W3I6PC. +xci3gc.gmk GNU makefile for platform XCI3GC. +xci6ll.gmk GNU makefile for platform XCI6LL. +============= ================================================================ + + +.. _design.mps.abq: design/abq.html +.. _design.mps.arena: design/arena.html +.. _design.mps.bootstrap: design/bootstrap.html +.. _design.mps.bt: design/bt.html +.. _design.mps.buffer: design/buffer.html +.. _design.mps.cbs: design/cbs.html +.. _design.mps.check: design/check.html +.. _design.mps.config: design/config.html +.. _design.mps.failover: design/failover.html +.. _design.mps.freelist: design/freelist.html +.. _design.mps.interface-c: design/interface-c.html +.. _design.mps.land: design/land.html +.. _design.mps.lock: design/lock.html +.. _design.mps.locus: design/locus.html +.. _design.mps.nailboard: design/nailboard.html +.. _design.mps.pool: design/pool.html +.. _design.mps.poolmrg: design/poolmrg.html +.. _design.mps.prmc: design/prmc.html +.. _design.mps.protocol: design/protocol.html +.. _design.mps.prot: design/prot.html +.. _design.mps.range: design/range.html +.. _design.mps.reservoir: design/reservoir.html +.. _design.mps.ring: design/ring.html +.. _design.mps.seg: design/seg.html +.. _design.mps.shield: design/shield.html +.. _design.mps.sp: design/sp.html +.. _design.mps.splay: design/splay.html +.. _design.mps.ss: design/ss.html +.. _design.mps.strategy: design/strategy.html +.. _design.mps.tests: design/tests.html +.. _design.mps.testthr: design/testthr.html +.. _design.mps.thread-manager: design/thread-manager.html +.. _design.mps.trace: design/trace.html +.. _design.mps.version: design/version.html +.. _design.mps.vm: design/vm.html +.. _design.mps.writef: design/writef.html +.. _job000825: https://www.ravenbrook.com/project/mps/issue/job000825 diff --git a/mps/manual/source/design/index.rst b/mps/manual/source/design/index.rst index b8da67a4333..1cea6c4861b 100644 --- a/mps/manual/source/design/index.rst +++ b/mps/manual/source/design/index.rst @@ -10,6 +10,7 @@ Design an bootstrap cbs + clock config critical-path exec-env diff --git a/mps/manual/source/extensions/mps/designs.py b/mps/manual/source/extensions/mps/designs.py index 42acd049d62..ff991612fc5 100644 --- a/mps/manual/source/extensions/mps/designs.py +++ b/mps/manual/source/extensions/mps/designs.py @@ -20,9 +20,9 @@ TYPES = ''' AccessSet Accumulation Addr Align AllocFrame AllocPattern AP Arg Arena Attr Bool BootBlock BT Buffer BufferMode Byte Chain Chunk - Clock Compare Count Epoch FindDelete Format FrameState Fun GenDesc - Globals Index Land LD Lock LocusPref LocusPrefKind Message - MessageType MutatorFaultContext Page Pointer Pool PoolGen + Clock Compare Count Epoch EventClock FindDelete Format FrameState + Fun GenDesc Globals Index Land LD Lock LocusPref LocusPrefKind + Message MessageType MutatorFaultContext Page Pointer Pool PoolGen PThreadext Range Rank RankSet ReadonlyAddr Ref RefSet Res Reservoir Ring Root RootMode RootVar ScanState Seg SegBuf Serial Shift Sig Size Space SplayNode SplayTree StackContext Thread Trace @@ -121,6 +121,8 @@ def convert_file(name, source, dest): s = design_ref.sub(r'\1.html', s) s = design_frag_ref.sub(r'\1.html#design.mps.\2.\3', s) s = history.sub('', s) + # Don't try to format all the quoted code blocks as C. + s = '.. highlight:: none\n\n' + s try: os.makedirs(os.path.dirname(dest)) except: diff --git a/mps/manual/source/glossary/c.rst b/mps/manual/source/glossary/c.rst index ffdf1899243..2165bac2394 100644 --- a/mps/manual/source/glossary/c.rst +++ b/mps/manual/source/glossary/c.rst @@ -131,7 +131,7 @@ Memory Management Glossary: C A cactus stack is a :term:`stack` with branches. When diagrammed, its shape resembles that of a `saguaro cactus - `_. + `_. In languages that support :term:`continuations`, :term:`activation records` can have :term:`indefinite extent`. @@ -285,6 +285,25 @@ Memory Management Glossary: C fragmentation, and which coalescing strategies are effective under what circumstances. + cold end + + .. opposite:: :term:`hot end` + + A :term:`control stack` has two ends: the oldest items are at + the *cold end* and the newest items are at the *hot end*. + Sometimes the cold end is called the "bottom" of the stack, + but that is misleading when the stack grows downwards, as it + does on common computing platforms. + + .. mps:specific:: + + In order for the MPS to be able to :term:`scan` + :term:`references` on the stack, the :term:`client + program` must pass the location of the cold end of the + stack (or the part of the stack that might contain + references to memory managed by the MPS) to + :c:func:`mps_root_create_thread`. + collect An :term:`object` is collected when it is :term:`reclaimed` by @@ -570,7 +589,7 @@ Memory Management Glossary: C .. similar:: :term:`stack`. - .. seealso:: :term:`data stack`. + .. seealso:: :term:`cold end`, :term:`data stack`, :term:`hot end`. cool diff --git a/mps/manual/source/glossary/h.rst b/mps/manual/source/glossary/h.rst index 8d292f98379..fa76ad7add7 100644 --- a/mps/manual/source/glossary/h.rst +++ b/mps/manual/source/glossary/h.rst @@ -118,6 +118,16 @@ Memory Management Glossary: H Select it by defining :c:macro:`CONFIG_VAR_HOT`. Compare :term:`cool` and :term:`rash`. + hot end + + .. opposite:: :term:`cold end` + + A :term:`control stack` has two ends: the oldest items are at + the *cold end* and the newest items are at the *hot end*. + Sometimes the hot end is called the "top" of the stack, but + that is misleading when the stack grows downwards, as it does + on common computing platforms. + huge page .. aka:: *large page*, *superpage*. diff --git a/mps/manual/source/glossary/r.rst b/mps/manual/source/glossary/r.rst index cbab9a255fe..1b0f7d51813 100644 --- a/mps/manual/source/glossary/r.rst +++ b/mps/manual/source/glossary/r.rst @@ -339,10 +339,10 @@ Memory Management Glossary: R register - A *register* is a small unit of :term:`memory (2)` that is - attached to a processor and accessible very quickly. Registers - typically form the highest level of a computer's - :term:`storage hierarchy`. + A *register* is a small unit of :term:`memory (2)` that is + attached to a processor and accessible very quickly. Registers + typically form the highest level of a computer's + :term:`storage hierarchy`. .. relevance:: diff --git a/mps/manual/source/glossary/t.rst b/mps/manual/source/glossary/t.rst index a91b656d89f..1b4411a8e6c 100644 --- a/mps/manual/source/glossary/t.rst +++ b/mps/manual/source/glossary/t.rst @@ -123,6 +123,13 @@ Memory Management Glossary: T stream can be configured by setting the :term:`telemetry filter`. See :ref:`topic-telemetry`. + telemetry system + + .. mps:specific:: + + The subsystem of the MPS that outputs the :term:`telemetry + stream`. See :ref:`topic-telemetry`. + tenuring .. see:: :term:`promotion`. @@ -181,9 +188,9 @@ Memory Management Glossary: T Threads are represented by values of type :c:type:`mps_thr_t`, created by calling :c:func:`mps_thread_reg`. In order for the MPS to find - references on the control of the thread, the thread must - be also be registered as a root by calling - :c:func:`mps_root_create_reg`. See :ref:`topic-thread`. + references on the control stack of the thread, the thread + must be also be registered as a :term:`root` by calling + :c:func:`mps_root_create_thread`. See :ref:`topic-thread`. threatened set diff --git a/mps/manual/source/glossary/v.rst b/mps/manual/source/glossary/v.rst index dd7b4fcaa27..14e24bb7f1b 100644 --- a/mps/manual/source/glossary/v.rst +++ b/mps/manual/source/glossary/v.rst @@ -54,7 +54,7 @@ Memory Management Glossary: V variety - .. mps:specific:: + .. mps:specific:: A behaviour of the MPS that must be selected at compilation time. There are three varieties: :term:`cool`, diff --git a/mps/manual/source/guide/build.rst b/mps/manual/source/guide/build.rst index 2fe95eb888f..9c97e9a3bb3 100644 --- a/mps/manual/source/guide/build.rst +++ b/mps/manual/source/guide/build.rst @@ -1,3 +1,5 @@ +.. highlight:: none + .. index:: single: building single: compiling diff --git a/mps/manual/source/guide/debug.rst b/mps/manual/source/guide/debug.rst index 060928c2ba6..3c1678e660b 100644 --- a/mps/manual/source/guide/debug.rst +++ b/mps/manual/source/guide/debug.rst @@ -398,16 +398,16 @@ And here's how it shows up in the debugger: #3 0x00000001000014e3 in obj_skip (base=0x1003f9b88) at scheme.c:2940 2940 assert(0); (gdb) list - 2935 break; - 2936 case TYPE_PAD1: - 2937 base = (char *)base + ALIGN_OBJ(sizeof(pad1_s)); - 2938 break; - 2939 default: - 2940 assert(0); - 2941 fprintf(stderr, "Unexpected object on the heap\n"); - 2942 abort(); - 2943 return NULL; - 2944 } + 2935 break; + 2936 case TYPE_PAD1: + 2937 base = (char *)base + ALIGN_OBJ(sizeof(pad1_s)); + 2938 break; + 2939 default: + 2940 assert(0); + 2941 fprintf(stderr, "Unexpected object on the heap\n"); + 2942 abort(); + 2943 return NULL; + 2944 } The object being skipped is corrupt:: diff --git a/mps/manual/source/guide/lang.rst b/mps/manual/source/guide/lang.rst index 88c7ec93eb5..6ae1ce60aaf 100644 --- a/mps/manual/source/guide/lang.rst +++ b/mps/manual/source/guide/lang.rst @@ -971,29 +971,21 @@ You register a thread with an :term:`arena` by calling res = mps_thread_reg(&thread, arena); if (res != MPS_RES_OK) error("Couldn't register thread"); -You register the thread's registers and control stack as a root by -calling :c:func:`mps_root_create_reg` and passing -:c:func:`mps_stack_scan_ambig`:: +You register the thread's :term:`registers` and :term:`control stack` +as a root by calling :c:func:`mps_root_create_thread`:: void *marker = ▮ - mps_root_t reg_root; - res = mps_root_create_reg(®_root, - arena, - mps_rank_ambig(), - 0, - thread, - mps_stack_scan_ambig, - marker, - 0); + mps_root_t stack_root; + res = mps_root_create_thread(®_root, arena, thread, marker); if (res != MPS_RES_OK) error("Couldn't create root"); In order to scan the control stack, the MPS needs to know where the -bottom of the stack is, and that's the role of the ``marker`` -variable: the compiler places it on the stack, so its address is a -position within the stack. As long as you don't exit from this -function while the MPS is running, your program's active local -variables will always be higher up on the stack than ``marker``, and -so will be scanned for references by the MPS. +:term:`cold end` of the stack is, and that's the role of the +``marker`` variable: the compiler places it on the stack, so its +address is a position within the stack. As long as you don't exit from +this function while the MPS is running, your program's active local +variables will always be placed on the stack after ``marker``, and so +will be scanned for references by the MPS. .. topics:: diff --git a/mps/manual/source/guide/vector.rst b/mps/manual/source/guide/vector.rst index 8b9452ac1f6..bd09e0ade09 100644 --- a/mps/manual/source/guide/vector.rst +++ b/mps/manual/source/guide/vector.rst @@ -64,8 +64,8 @@ solved: This can solved by storing the new array in a :term:`root` until the header has been updated. If the thread's stack has been - registered as a root by calling :c:func:`mps_root_create_reg` then - any local variable will do. + registered as a root by calling :c:func:`mps_root_create_thread` + then any local variable will do. 2. References in the new array must not be scanned until they have been copied or cleared. (Otherwise they will be invalid.) diff --git a/mps/manual/source/index.rst b/mps/manual/source/index.rst index 57758fea8ef..5d61d583c2d 100644 --- a/mps/manual/source/index.rst +++ b/mps/manual/source/index.rst @@ -19,6 +19,7 @@ Appendices bib glossary/index + code-index copyright contact contributing diff --git a/mps/manual/source/mmref/credit.rst b/mps/manual/source/mmref/credit.rst index 0ce0bd0c8b3..e6298f9b841 100644 --- a/mps/manual/source/mmref/credit.rst +++ b/mps/manual/source/mmref/credit.rst @@ -9,7 +9,7 @@ The Memory Management Reference is maintained by `Ravenbrook Limited`_. Most of it was originally written by memory management experts in the Adaptive Memory Management Group at `Harlequin Limited -`_: +`_: * Nick Barnes * Richard Brooksby diff --git a/mps/manual/source/mmref/lang.rst b/mps/manual/source/mmref/lang.rst index d00ffa49c37..7462f89742b 100644 --- a/mps/manual/source/mmref/lang.rst +++ b/mps/manual/source/mmref/lang.rst @@ -147,8 +147,8 @@ Memory management in various languages is reclaimed by the memory manager), and :term:`weak references (1)` (via the ``WeakReference`` class). - The :term:`garbage collector` in the .NET Framework is - configurable to run in soft real time, or in batch mode. + The :term:`garbage collector` in the .NET Framework is + configurable to run in soft real time, or in batch mode. The Mono runtime comes with two collectors: the Boehm–Demers–Weiser :term:`conservative collector @@ -233,7 +233,7 @@ Memory management in various languages Dylan is a modern programming language invented by Apple around 1993 and developed by `Harlequin - `_ + `_ and other partners. The language is a distillation of the best ideas in dynamic and object-oriented programming. Its ancestors include :term:`Lisp`, :term:`Smalltalk`, and @@ -583,7 +583,7 @@ Memory management in various languages .. link:: - `Harlequin RIP `_. + `Harlequin RIP `_. Prolog @@ -607,10 +607,10 @@ Memory management in various languages Python is a "duck-typed" object-oriented language created in the early 1990s by Guido van Rossum. - There are several implementations running on a variety of - virtual machines: the original "CPython" implementation runs - on its own virtual machine; IronPython runs on the Common - Language Runtime; Jython on the Java Virtual Machine. + There are several implementations running on a variety of + virtual machines: the original "CPython" implementation runs + on its own virtual machine; IronPython runs on the Common + Language Runtime; Jython on the Java Virtual Machine. CPython manages memory using a mixture of :term:`reference counting` and :term:`non-moving ` diff --git a/mps/manual/source/release.rst b/mps/manual/source/release.rst index a7e028fae2a..f95aaba331e 100644 --- a/mps/manual/source/release.rst +++ b/mps/manual/source/release.rst @@ -23,6 +23,23 @@ New features :c:macro:`MPS_KEY_SPARE_COMMIT_LIMIT` sets the :term:`spare commit limit` for the arena. +#. New area scanning functions :c:func:`mps_scan_area`, + :c:func:`mps_scan_area_masked`, :c:func:`mps_scan_area_tagged`, + :c:func:`mps_scan_area_tagged_or_zero` for use when scanning, + especially when scanning threads and :term:`tagged references`. + +#. New thread root functions :c:func:`mps_root_create_thread`, + :c:func:`mps_root_create_thread_tagged`, and + :c:func:`mps_root_create_thread_scanned` allow flexible scanning of + thread stacks and registers in any format, with convenient + implementations provided for :term:`tagged references`. + +#. New function :c:func:`mps_root_create_table_tagged` for tables of roots + containing :term:`tagged references`. + +#. New area root functions :c:func:`mps_root_create_area` and + :c:func:`mps_root_create_area_tagged` for areas of memory + that can be scanned by area scanning functions. Interface changes ................. @@ -37,6 +54,12 @@ Interface changes deprecated in favour of the generic functions :c:func:`mps_pool_free_size` and :c:func:`mps_pool_total_size`. +#. The function :c:func:`mps_root_create_reg` is deprecated in favour + of :c:func:`mps_root_create_thread_tagged`. + +#. The function :c:func:`mps_root_create_table_masked` is deprecated in + favour of :c:func:`mps_root_create_table_tagged`. + Other changes ............. diff --git a/mps/manual/source/topic/allocation.rst b/mps/manual/source/topic/allocation.rst index 4075cfe006a..aaf8fc60a78 100644 --- a/mps/manual/source/topic/allocation.rst +++ b/mps/manual/source/topic/allocation.rst @@ -79,6 +79,8 @@ Manual allocation .. index:: single: allocation point +.. _topic-allocation-point: + Allocation points ----------------- @@ -151,11 +153,11 @@ least) two steps, a *reserve* followed by a *commit*. The description of the protocol assumes that you have declared your threads' :term:`control stacks` and :term:`registers` to be - :term:`ambiguous roots`, by passing :c:func:`mps_stack_scan_ambig` - to :c:func:`mps_root_create_reg`. This is the simplest way to - write a client, but other scenarios are possible. Please - :ref:`contact us ` if your use case is not covered here - (for example, if you need an exact collector). + :term:`ambiguous roots`, by calling + :c:func:`mps_root_create_thread`. This is the simplest way to write + a client, but other scenarios are possible. Please :ref:`contact + us ` if your use case is not covered here (for example, + if you need an exact collector). When the client program is initializing a newly allocated object, you can think of it as being "in a race" with the MPS. Until the object is diff --git a/mps/manual/source/topic/deprecated.rst b/mps/manual/source/topic/deprecated.rst index dfd4d8d74cb..2bdced17215 100644 --- a/mps/manual/source/topic/deprecated.rst +++ b/mps/manual/source/topic/deprecated.rst @@ -118,6 +118,240 @@ Deprecated in version 1.115 is the sum of allocated space and free space. +.. c:function:: mps_res_t mps_root_create_reg(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_thr_t thr, mps_reg_scan_t reg_scan, void *p, size_t s) + + .. deprecated:: + + Use :c:func:`mps_root_create_thread` instead. + + Register a :term:`root` that consists of the :term:`references` + fixed in a :term:`thread's ` registers and stack by a + scanning function. + + ``root_o`` points to a location that will hold the address of the + new root description. + + ``arena`` is the arena. + + ``rank`` is the :term:`rank` of references in the root. + + ``rm`` is the :term:`root mode`. + + ``thr`` is the thread. + + ``reg_scan`` is a scanning function. See :c:type:`mps_reg_scan_t`. + + ``p`` and ``s`` are arguments that will be passed to ``reg_scan`` each + time it is called. This is intended to make it easy to pass, for + example, an array and its size as parameters. + + Returns :c:macro:`MPS_RES_OK` if the root was registered + successfully, :c:macro:`MPS_RES_MEMORY` if the new root + description could not be allocated, or another :term:`result code` + if there was another error. + + The registered root description persists until it is destroyed by + calling :c:func:`mps_root_destroy`. + + .. note:: + + It is not supported for :term:`client programs` to pass their + own scanning functions to this function. The built-in MPS + function :c:func:`mps_stack_scan_ambig` must be used. In this + case the ``p`` argument must be a pointer to the :term:`cold + end` of the thread's stack (or the part of the stack + containing references to memory managed by the MPS). The ``s`` + argument is ignored. + +.. c:function:: mps_res_t mps_root_create_table(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_addr_t *base, size_t count) + + .. deprecated:: + + This function is equivalent to:: + + mps_root_create_area(root_o, arena, rank, mode, + base, base + count, + mps_scan_area, NULL, 0) + + Register a :term:`root` that consists of a vector of + :term:`references`. + + ``root_o`` points to a location that will hold the address of the + new root description. + + ``arena`` is the arena. + + ``rank`` is the :term:`rank` of references in the root. + + ``rm`` is the :term:`root mode`. + + ``base`` points to a vector of references. + + ``count`` is the number of references in the vector. + + Returns :c:macro:`MPS_RES_OK` if the root was registered + successfully, :c:macro:`MPS_RES_MEMORY` if the new root + description could not be allocated, or another :term:`result code` + if there was another error. + + The registered root description persists until it is destroyed by + calling :c:func:`mps_root_destroy`. + + .. _topic-root-type-pun: + + .. warning:: + + The ``base`` argument has type ``mps_addr_t *`` (a typedef for + ``void **``) but the table of references most likely has some + other pointer type, ``my_object *`` say. It is tempting to + write:: + + mps_root_create_table(..., (mps_addr_t *)my_table, ...) + + but this is :term:`type punning`, and its behaviour is not + defined in ANSI/ISO Standard C. (GCC and Clang have a warning + flag ``-Wstrict-aliasing`` which detects some errors of this + form.) + + To ensure well-defined behaviour, the pointer must be + converted via ``void *`` (or via :c:type:`mps_addr_t`, which + is a typedef for ``void *``), like this:: + + mps_addr_t base = my_table; + mps_root_create_table(..., base, ...) + +.. c:function:: mps_res_t mps_root_create_table_tagged(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_addr_t *base, size_t count, mps_area_scan_t scan_area, mps_word_t mask, mps_word_t pattern) + + .. deprecated:: + + This function is equivalent to:: + + mps_root_create_area_tagged(root_o, arena, rank, mode, + base, base + size, + scan_area, mask, pattern) + + Register a :term:`root` that consists of a vector of :term:`tagged + references`. + + ``root_o`` points to a location that will hold the address of the + new root description. + + ``arena`` is the arena. + + ``rank`` is the :term:`rank` of references in the root. + + ``rm`` is the :term:`root mode`. + + ``base`` points to a vector of tagged references. + + ``count`` is the number of tagged references in the vector. + + ``scan_area`` is an tagged area scanning function that will be + used to scan the table, for example :c:func:`mps_scan_area_tagged` + or :c:func:`mps_scan_area_tagged_or_zero`. See + :ref:`topic-scanning-area`. + + ``mask`` is a :term:`bitmask` that is passed to ``scan_area`` to + be applied to the words in the vector to locate the :term:`tag`. + + ``pattern`` is passed to ``scan_area`` to determine whether to + consider a word as a reference. For example, + :c:func:`mps_scan_area_tagged` will not consider any word that is + unequal to this (after masking with ``mask``) to be a reference. + + Returns :c:macro:`MPS_RES_OK` if the root was registered + successfully, :c:macro:`MPS_RES_MEMORY` if the new root + description could not be allocated, or another :term:`result code` + if there was another error. + + The registered root description persists until it is destroyed by + calling :c:func:`mps_root_destroy`. + + .. warning:: + + See the warning for :c:func:`mps_root_create_table` above. + +.. c:function:: mps_res_t mps_root_create_table_masked(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_addr_t *base, size_t count, mps_word_t mask) + + .. deprecated:: + + This function is equivalent to:: + + mps_root_create_area_tagged(root_o, arena, rank, rm, + base, base + size, + mps_scan_area_tagged, + mask, 0) + + Use :c:func:`mps_root_create_area_masked` instead, passing + zero for the ``pattern`` argument. + + Register a :term:`root` that consists of a vector of :term:`tagged + references` whose pattern is zero. + +.. c:type:: mps_res_t (*mps_reg_scan_t)(mps_ss_t ss, mps_thr_t thr, void *p, size_t s) + + .. deprecated:: + + Use :c:func:`mps_root_create_thread` instead. + + The type of a root scanning function for roots created with + :c:func:`mps_root_create_reg`. + + ``ss`` is the :term:`scan state`. It must be passed to + :c:func:`MPS_SCAN_BEGIN` and :c:func:`MPS_SCAN_END` to delimit a + sequence of fix operations, and to the functions + :c:func:`MPS_FIX1` and :c:func:`MPS_FIX2` when fixing a + :term:`reference`. + + ``thr`` is the :term:`thread`. + + ``p`` and ``s`` are the corresponding values that were passed to + :c:func:`mps_root_create_reg`. + + Returns a :term:`result code`. If a fix function returns a value + other than :c:macro:`MPS_RES_OK`, the scan method must return that + value, and may return without fixing any further references. + Generally, it is better if it returns as soon as possible. If the + scanning is completed successfully, the function should return + :c:macro:`MPS_RES_OK`. + + A root scan method is called whenever the MPS needs to scan the + root. It must then indicate references within the root by calling + :c:func:`MPS_FIX1` and :c:func:`MPS_FIX2`. + + .. seealso:: + + :ref:`topic-scanning`. + + .. note:: + + :term:`Client programs` are not expected to + write scanning functions of this type. The built-in MPS + function :c:func:`mps_stack_scan_ambig` must be used. + + +.. c:function:: mps_reg_scan_t mps_stack_scan_ambig + + .. deprecated:: + + Use :c:func:`mps_root_create_thread` instead, passing + ``sizeof(mps_word_t) - 1`` for the ``mask`` argument, and + ``0`` for the ``pattern`` argument. + + A root scanning function for :term:`ambiguous ` scanning of :term:`threads`, suitable for + passing to :c:func:`mps_root_create_reg`. + + It scans all integer registers and everything on the stack of the + thread given, and can therefore only be used with :term:`ambiguous + roots`. It scans locations that are more recently added to the + stack than the location that was passed in the ``p`` argument to + :c:func:`mps_root_create_reg`. + + References are assumed to be represented as machine words, and are + required to be word-aligned; unaligned values are ignored. + + .. index:: single: deprecated interfaces; in version 1.113 diff --git a/mps/manual/source/topic/error.rst b/mps/manual/source/topic/error.rst index 7ae2900fed4..9afbb22ebe0 100644 --- a/mps/manual/source/topic/error.rst +++ b/mps/manual/source/topic/error.rst @@ -90,7 +90,7 @@ Result codes .. c:macro:: MPS_RES_IO A :term:`result code` indicating that an input/output error - occurred in the :term:`telemetry` system. + occurred in the :term:`telemetry system`. .. c:macro:: MPS_RES_LIMIT diff --git a/mps/manual/source/topic/porting.rst b/mps/manual/source/topic/porting.rst index 26c663f58f9..0d04c04f3a4 100644 --- a/mps/manual/source/topic/porting.rst +++ b/mps/manual/source/topic/porting.rst @@ -31,6 +31,17 @@ partially functional or non-functional, but can be used as a starting point for a new port if none of the existing implementations is usable. +#. The **clock** module provides fast high-resolution clocks for use + by the :term:`telemetry system`. + + See :ref:`design-clock` for the design, and ``clock.h`` for the + interface. The interface consists only of type declarations and + macro definitions, so there is no implementation. + + The header falls back to the clock functions from the + :term:`plinth` if there is no platform-specific interface. See + :c:func:`mps_clock` and :c:func:`mps_clocks_per_sec`. + #. The **lock** module provides binary locks that ensure that only a single :term:`thread` may be running with a lock held, and recursive locks, where the same thread may safely take the lock @@ -211,7 +222,9 @@ define ``PFM`` to be the platform code, ``MPMPF`` to be the list of platform modules (the same files included by ``mps.c``), and ``LIBS`` to be the linker options for any libraries required by the test cases. Then it must include the compiler-specific makefile and ``comm.gmk``. -For example, ``lii6ll.gmk`` looks like this:: +For example, ``lii6ll.gmk`` looks like this: + +.. code-block:: make PFM = lii6ll @@ -245,7 +258,9 @@ On Windows, the makefile must be named ``osarct.nmk``, and must define platform modules (the same files included by ``mps.c``) in square brackets. Then it must include ``commpre.nmk``, the compiler-specific makefile and ``commpost.nmk``. For example, ``w3i6mv.nmk`` looks like -this:: +this: + +.. code-block:: none PFM = w3i6mv @@ -266,13 +281,14 @@ this:: !INCLUDE commpost.nmk - Porting strategy ---------------- Start the port by selecting existing implementations of the functional modules, using the generic implementations where nothing else will do. -Then check that the "smoke tests" pass, by running:: +Then check that the "smoke tests" pass, by running: + +.. code-block:: none make -f osarct.gmk testrun # Unix nmake /f osarct.nmk testrun # Windows diff --git a/mps/manual/source/topic/root.rst b/mps/manual/source/topic/root.rst index 4a1e06686ae..c174568b446 100644 --- a/mps/manual/source/topic/root.rst +++ b/mps/manual/source/topic/root.rst @@ -83,7 +83,7 @@ Roots can be deregistered at any time by calling :c:func:`mps_root_destroy`. All roots registered in an :term:`arena` must be deregistered before the arena is destroyed. -There are five ways to register a root, depending on how you need to +There are four ways to register a root, depending on how you need to scan it for references: #. :c:func:`mps_root_create` if you need a custom root scanning @@ -94,16 +94,15 @@ scan it for references: by the format's :term:`scan method` (of type :c:type:`mps_fmt_scan_t`); -#. :c:func:`mps_root_create_table` if the root consists of a table of - references; +#. :c:func:`mps_root_create_area` if the root consists of an area + of memory; -#. :c:func:`mps_root_create_table_masked` if the root consists of a - table of :term:`tagged references`; - -#. :c:func:`mps_root_create_reg` if the root consists of the +#. :c:func:`mps_root_create_thread` if the root consists of the :term:`registers` and :term:`control stack` of a thread. See :ref:`topic-root-thread` below. +Several of these categories of roots have variants for dealing with +:term:`tagged references`. See :ref:`topic-scanning-tag`. .. index:: pair: root; cautions @@ -145,20 +144,17 @@ So the typical sequence of operations when creating a root is: Thread roots ------------ -Every thread's registers and control stack potentially contain -references to allocated objects, so should be registered as a root by -calling :c:func:`mps_root_create_reg`. It's not easy to write a -scanner for the registers and the stack: it depends on the operating -system, the processor architecture, and in some cases on the compiler. -For this reason, the MPS provides :c:func:`mps_stack_scan_ambig` (and -in fact, this is the only supported stack scanner). +Every thread's :term:`registers` and :term:`control stack` potentially +contain references to allocated objects, so should be registered as a +root by calling :c:func:`mps_root_create_thread`. -A stack scanner needs to know how to find the bottom of the part of the -stack to scan. The bottom of the relevant part of stack can be found by -taking the address of a local variable in the function that calls the -main work function of your thread. You should take care to ensure that -the work function is not inlined so that the address is definitely in -the stack frame below any potential roots. +The MPS's stack scanner needs to know how to find the :term:`cold end` +of the part of the stack to scan. The :term:`cold end` of the relevant +part of the stack can be found by taking the address of a local +variable in the function that calls the main work function of your +thread. You should take care to ensure that the work function is not +inlined so that the address is definitely in the stack frame below any +potential roots. .. index:: single: Scheme; thread root @@ -167,26 +163,19 @@ For example, here's the code from the toy Scheme interpreter that registers a thread root and then calls the program:: mps_thr_t thread; - mps_root_t reg_root; + mps_root_t stack_root; int exit_code; - void *marker = ▮ + void *cold = &cold; res = mps_thread_reg(&thread, arena); if (res != MPS_RES_OK) error("Couldn't register thread"); - res = mps_root_create_reg(®_root, - arena, - mps_rank_ambig(), - 0, - thread, - mps_stack_scan_ambig, - marker, - 0); + res = mps_root_create_thread(&stack_root, arena, thread, cold); if (res != MPS_RES_OK) error("Couldn't create root"); exit_code = start(argc, argv); - mps_root_destroy(reg_root); + mps_root_destroy(stack_root); mps_thread_dereg(thread); @@ -264,7 +253,7 @@ allowing the MPS to detect whether they have changed. the :term:`root` after it is registered: that is, scanning the root will produce the same set of :term:`references` every time. Furthermore, for roots registered by - :c:func:`mps_root_create_fmt` and :c:func:`mps_root_create_table`, + :c:func:`mps_root_create_fmt` and :c:func:`mps_root_create_area`, the client program will not write to the root at all. .. c:macro:: MPS_RM_PROT @@ -341,6 +330,10 @@ Root interface The registered root description persists until it is destroyed by calling :c:func:`mps_root_destroy`. + This is the most general kind of root, but gives the MPS the least + information to use for optimisation. Use a more specialized kind + of root whenever possible. + .. c:type:: mps_res_t (*mps_root_scan_t)(mps_ss_t ss, void *p, size_t s) @@ -393,10 +386,30 @@ Root interface The registered root description persists until it is destroyed by calling :c:func:`mps_root_destroy`. -.. c:function:: mps_res_t mps_root_create_reg(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_thr_t thr, mps_reg_scan_t reg_scan, void *p, size_t s) - Register a :term:`root` that consists of the :term:`references` - fixed in a :term:`thread's ` stack by a scanning function. +.. c:function:: mps_res_t mps_root_create_thread(mps_root_t *root_o, mps_arena_t arena, mps_thr_t thr, void *cold) + + Register a :term:`root` that consists of the :term:`references` in + a :term:`thread's ` registers and stack that are word aligned. + This is the most common kind of thread root. + + This function is equivalent to calling:: + + mps_root_create_thread_tagged(root_o, + arena, + mps_rank_ambig(), + (mps_rm_t)0, + thr, + mps_scan_area_tagged, + sizeof(mps_word_t) - 1, + 0, + cold); + +.. c:function:: mps_res_t mps_root_create_thread_tagged(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_thr_t thr, mps_area_scan_t scan_area, mps_word_t mask, mps_word_t pattern, void *cold) + + Register a :term:`root` that consists of the :term:`references` in + a :term:`thread's ` registers and stack that match a + binary pattern, for instance tagged as pointers. ``root_o`` points to a location that will hold the address of the new root description. @@ -409,11 +422,25 @@ Root interface ``thr`` is the thread. - ``reg_scan`` is a scanning function. See :c:type:`mps_reg_scan_t`. + ``scan_area`` is an tagged area scanning function that will be used + to scan the threads registers and stack, for example + :c:func:`mps_scan_area_tagged` or + :c:func:`mps_scan_area_tagged_or_zero`. See + :ref:`topic-scanning-area`. - ``p`` and ``s`` are arguments that will be passed to ``reg_scan`` each - time it is called. This is intended to make it easy to pass, for - example, an array and its size as parameters. + ``mask`` is a :term:`bitmask` that is passed to ``scan_area`` to + be applied to the thread's registers and stack to locate the + :term:`tag`. + + ``pattern`` is passed to ``scan_area`` to determine whether to + consider a word as a reference. For example, + :c:func:`mps_scan_area_tagged` will not consider any word that is + unequal to this (after masking with ``mask``) to be a reference. + + ``cold`` is a pointer to the :term:`cold end` of stack to be + scanned. On platforms where the stack grows downwards (currently, + all supported platforms), locations below this address will be + scanned. Returns :c:macro:`MPS_RES_OK` if the root was registered successfully, :c:macro:`MPS_RES_MEMORY` if the new root @@ -423,83 +450,50 @@ Root interface The registered root description persists until it is destroyed by calling :c:func:`mps_root_destroy`. - .. note:: + .. warning:: - It is not supported for :term:`client programs` to pass their - own scanning functions to this function. The built-in MPS - function :c:func:`mps_stack_scan_ambig` must be used. + A risk of using tagged pointers in registers and on the stack + is that in some circumstances, an optimizing compiler might + optimize away the tagged pointer, keeping only the untagged + version of the pointer. In this situation the pointer would be + ignored and if it was the last reference to the object the MPS + might incorrectly determine that it was dead. - This function is intended as a hook should we ever need to - allow client-specific extension or customization of stack and - register scanning. If you're in a position where you need - this, for example, if you're writing a compiler and have - control over what goes in the registers, :ref:`contact us - `. + You can avoid this risk in several ways: + #. Choose to tag pointers with zero, setting ``scan_area`` to + :c:func:`mps_scan_area_tagged` and setting ``pattern`` to + zero. -.. c:type:: mps_res_t (*mps_reg_scan_t)(mps_ss_t ss, mps_thr_t thr, void *p, size_t s) + #. Set ``scan_area`` to :c:func:`mps_scan_area_tagged_or_zero` + so that untagged pointers are scanned. This may lead to + some additional scanning and retention. - The type of a root scanning function for roots created with - :c:func:`mps_root_create_reg`. + #. Use :c:func:`mps_root_create_thread_scanned` and set + ``scan_area`` to :c:func:`mps_scan_area`: in this case all + words in registers and on the stack are scanned, leading to + possible additional scanning and retention. - ``ss`` is the :term:`scan state`. It must be passed to - :c:func:`MPS_SCAN_BEGIN` and :c:func:`MPS_SCAN_END` to delimit a - sequence of fix operations, and to the functions - :c:func:`MPS_FIX1` and :c:func:`MPS_FIX2` when fixing a - :term:`reference`. + #. Write your own compiler with complete control over register + contents and stack format, use + :c:func:`mps_root_create_thread_scanned` and set + ``scan_area`` to your own custom scanner, derived from the + source code of :c:func:`mps_scan_area`, that knows the + format. - ``thr`` is the :term:`thread`. + .. note:: - ``p`` and ``s`` are the corresponding values that were passed to - :c:func:`mps_root_create_reg`. + An optimization that may be worth considering is setting some + of the top bits in ``mask`` and ``pattern`` so that addresses + that cannot be allocated by the MPS are rejected quickly. This + requires expertise with the platform's virtual memory + interface. - Returns a :term:`result code`. If a fix function returns a value - other than :c:macro:`MPS_RES_OK`, the scan method must return that - value, and may return without fixing any further references. - Generally, it is better if it returns as soon as possible. If the - scanning is completed successfully, the function should return - :c:macro:`MPS_RES_OK`. +.. c:function:: mps_res_t mps_root_create_thread_scanned(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_thr_t thread, mps_area_scan_t scan_area, void *closure, void *cold) - A root scan method is called whenever the MPS needs to scan the - root. It must then indicate references within the root by calling - :c:func:`MPS_FIX1` and :c:func:`MPS_FIX2`. - - .. seealso:: - - :ref:`topic-scanning`. - - .. note:: - - :term:`Client programs` are not expected to - write scanning functions of this type. The built-in MPS - function :c:func:`mps_stack_scan_ambig` must be used. - - -.. c:function:: mps_reg_scan_t mps_stack_scan_ambig - - A root scanning function for :term:`ambiguous ` scanning of :term:`threads`, suitable for - passing to :c:func:`mps_root_create_reg`. - - It scans all integer registers and everything on the stack of the - thread given, and can therefore only be used with :term:`ambiguous - roots`. It only scans locations that are at, or higher on the - stack (that is, more recently added), the stack bottom that was - passed to :c:func:`mps_thread_reg`. References are assumed to be - represented as machine words, and are required to be - 4-byte-aligned; unaligned values are ignored. - - .. note:: - - The MPS provides this function because it's hard to write: it - depends on the operating system, the processor architecture, - and in some cases on the compiler. - - -.. c:function:: mps_res_t mps_root_create_table(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_addr_t *base, size_t count) - - Register a :term:`root` that consists of a vector of - :term:`references`. + Register a :term:`root` that consists of the :term:`references` in + a :term:`thread's ` registers and stack, scanned by an + arbitrary area scanning function. ``root_o`` points to a location that will hold the address of the new root description. @@ -510,9 +504,20 @@ Root interface ``rm`` is the :term:`root mode`. - ``base`` points to a vector of references. + ``thr`` is the thread. - ``count`` is the number of references in the vector. + ``scan_area`` is an area scanning function that will be used to + scan the threads registers and stack, for example + :c:func:`mps_scan_area`, or a similar user-defined function. See + :ref:`topic-scanning-area`. + + ``closure`` is an arbitrary pointer that will be passed to ``scan_area`` + and intended to point to any parameters it needs. + + ``cold`` is a pointer to the :term:`cold end` of stack to be + scanned. On platforms where the stack grows downwards (currently, + all supported platforms), locations below this address will be + scanned. Returns :c:macro:`MPS_RES_OK` if the root was registered successfully, :c:macro:`MPS_RES_MEMORY` if the new root @@ -522,33 +527,43 @@ Root interface The registered root description persists until it is destroyed by calling :c:func:`mps_root_destroy`. - .. _topic-root-type-pun: +.. c:function:: mps_res_t mps_root_create_area(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, void *base, void *limit, mps_area_scan_t scan_area, void *closure) - .. warning:: + Register a :term:`root` that consists of an area of memory scanned + by an area scanning function. - The ``base`` argument has type ``mps_addr_t *`` (a typedef for - ``void **``) but the table of references most likely has some - other pointer type, ``my_object *`` say. It is tempting to - write:: + ``root_o`` points to a location that will hold the address of the + new root description. - mps_root_create_table(..., (mps_addr_t *)my_table, ...) + ``arena`` is the arena. - but this is :term:`type punning`, and its behaviour is not - defined in ANSI/ISO Standard C. (GCC and Clang have a warning - flag ``-Wstrict-aliasing`` which detects some errors of this - form.) + ``rank`` is the :term:`rank` of references in the root. - To ensure well-defined behaviour, the pointer must be - converted via ``void *`` (or via :c:type:`mps_addr_t`, which - is a typedef for ``void *``), like this:: + ``rm`` is the :term:`root mode`. - mps_addr_t base = my_table; - mps_root_create_table(..., base, ...) + ``base`` points to the first word to be scanned. -.. c:function:: mps_res_t mps_root_create_table_masked(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_addr_t *base, size_t count, mps_word_t mask) + ``limit`` points to the location just beyond the end of the area to be scanned. - Register a :term:`root` that consists of a vector of :term:`tagged - references`. + ``scan_area`` is an area scanning function, for example + :c:func:`mps_scan_area`, or a similar user-defined function. See + :ref:`topic-scanning-area`. + + ``closure`` is an arbitrary pointer that will be passed to + ``scan_area`` and intended to point to any parameters it needs. + + Returns :c:macro:`MPS_RES_OK` if the root was registered + successfully, :c:macro:`MPS_RES_MEMORY` if the new root + description could not be allocated, or another :term:`result code` + if there was another error. + + The registered root description persists until it is destroyed by + calling :c:func:`mps_root_destroy`. + +.. c:function:: mps_res_t mps_root_create_area_tagged(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, void *base, void *limit, mps_area_scan_t scan_area, mps_word_t mask, mps_word_t pattern) + + Register a :term:`root` that consists of an area of memory scanned by + a tagged area scanning function. ``root_o`` points to a location that will hold the address of the new root description. @@ -563,9 +578,18 @@ Root interface ``count`` is the number of tagged references in the vector. - ``mask`` is a :term:`bitmask` whose set bits specify the location of - the :term:`tag`. References are assumed to have a tag of zero: any - value in the vector with a non-zero tag is ignored. + ``scan_area`` is an tagged area scanning function that will be + used to scan the area, for example :c:func:`mps_scan_area_tagged` + or :c:func:`mps_scan_area_tagged_or_zero`. See + :ref:`topic-scanning-area`. + + ``mask`` is a :term:`bitmask` that is passed to ``scan_area`` to + be applied to the words in the vector to locate the :term:`tag`. + + ``pattern`` is passed to ``scan_area`` to determine whether to + consider a word as a reference. For example, + :c:func:`mps_scan_area_tagged` will not consider any word that is + unequal to this (after masking with ``mask``) to be a reference. Returns :c:macro:`MPS_RES_OK` if the root was registered successfully, :c:macro:`MPS_RES_MEMORY` if the new root @@ -578,6 +602,7 @@ Root interface For example:: #define TAG_MASK 0x3 /* bottom two bits */ + #define TAG_PATTERN 0x1 /* bottom bit set for references */ /* Global symbol table. */ size_t symtab_size; @@ -588,17 +613,13 @@ Root interface mps_res_t res; mps_root_t root; - mps_addr_t base = symtab; - res = mps_root_create_table_masked(&root, arena, - mps_rank_exact(), - (mps_rm_t)0, - base, symtab_size * 2, - (mps_word_t)TAG_MASK); - if (res != MPS_RES_OK) errror("can't create symtab root"); - - .. warning:: - - See the warning for :c:func:`mps_root_create_table` above. + res = mps_root_create_area_tagged(&root, arena, + mps_rank_exact(), + 0, + symtab, symtab + symtab_size, + mps_scan_area_tagged, + TAG_MASK, TAG_PATTERN); + if (res != MPS_RES_OK) error("can't create symtab root"); .. c:function:: void mps_root_destroy(mps_root_t root) diff --git a/mps/manual/source/topic/scanning.rst b/mps/manual/source/topic/scanning.rst index 6b4c4a1d396..b842240995f 100644 --- a/mps/manual/source/topic/scanning.rst +++ b/mps/manual/source/topic/scanning.rst @@ -501,3 +501,138 @@ Fixing interface In the case where the scan method does not need to do anything between :c:func:`MPS_FIX1` and :c:func:`MPS_FIX2`, you can use the convenience macro :c:func:`MPS_FIX12`. + + +.. index:: + single: scanning; area scanners + single: area; scanning + +.. _topic-scanning-area: + +Area scanners +------------- + +An area scanner :term:`scans` an area of memory for +:term:`references`. Various functions in the MPS interface, such as +:c:func:`mps_root_create_thread_tagged`, accept area scanners as +arguments so that the :term:`client program` can specify how to scan +special areas such as the :term:`control stack`. + +The MPS provides some area scanners for common situations (such as an +area which is a vector of words with references identified by +:term:`tag bits `) but the :term:`client program` can provide +its own. + +If you want to develop your own area scanner you can start by adapting +the scanners, found in ``scan.c`` in the MPS source code. + +.. c:type:: mps_area_scan_t + + The type of area scanning functions, which are all of the form:: + + mps_res_t scan(mps_ss_t ss, + void *base, void *limit, + void *closure); + + ``ss`` is the :term:`scan state`. + + ``base`` points to the first location to be scanned. + + ``limit`` points to the location just beyond the end of the area to be scanned. + + ``closure`` is a pointer to an arbitrary :term:`closure` object that + contains parameters for the scan. The object passed depends on the + context. For example, if the scanner was originally registered with + :c:func:`mps_root_create_thread_tagged` then it is the value of + the ``closure`` argument originally passed to that function. + +.. c:function:: mps_res_t mps_scan_area(mps_ss_t ss, void *base, void *limit, void *closure) + + Scan an area of memory :term:`fixing ` every word. + ``closure`` is ignored. Expects ``base`` and ``limit`` to be + word-aligned. + + This scanner is appropriate for use when all words in the area are + simple untagged references. + +.. c:type:: mps_scan_tag_t + + The type of a scan closure that is passed to the tagged area + scanners in order to specify the format of the :term:`tagged + references` in the area. + + It is a pointer to a :c:type:`mps_scan_tag_s` structure. + +.. c:type:: mps_scan_tag_s + + The type of the structure used to represent :term:`tag bits ` in :term:`tagged references` :: + + typedef struct mps_scan_tag_s { + mps_word_t mask; + mps_word_t pattern; + } mps_scan_tag_s; + + ``mask`` is bit mask that is applied to words in the area to find + the tag. For example, a mask of 0b111 (decimal 7) specifies that + the tag is stored in the least-significant three bits of the word. + + ``pattern`` is a bit pattern that is compared to the bits extracted + by the ``mask`` to determine if the word is a reference. The exact + interpretation depends on which area scanner it is passed to. See + the documentation for the individual area scanners. + +.. c:function:: mps_res_t mps_scan_area_masked(mps_ss_t ss, void *base, void *limit, void *closure) + + Scan an area of memory :term:`fixing ` every word, but remove + tag bits before fixing references, and restore them afterwards. + ``closure`` must point to an :c:type:`mps_scan_tag_s`. Expects + ``base`` and ``limit`` to be word-aligned. + + For example, if ``mask`` is 0b111 (decimal 7), then this scanner + will clear the bottom three bits of each word before fixing. A word + such as 0xC1374823 would be detagged to 0xC1374820 before fixing. + If it were fixed to 0xC812BC88 then it would be tagged back to + 0xC812BC8B before being stored. + + This scanner is useful when all words in the area must be treated as + references no matter what tag they have. This can be especially + useful if you are debugging your tagging scheme. + +.. c:function:: mps_res_t mps_scan_area_tagged(mps_ss_t ss, void *base, void *limit, void *closure) + + Scan an area of memory :term:`fixing ` only words whose + masked bits match a particular tag pattern. ``closure`` must + point to a :c:type:`mps_scan_tag_s`. Expects ``base`` and + ``limit`` to be word-aligned. + + For example, if ``mask`` is 7 and ``pattern`` is 5, then this + scanner will only fix words whose low order bits are 0b101. + + Tags are masked off and restored as in :c:func:`mps_scan_area_masked`. + + This scanner is useful when you have a single tag pattern that + distinguishes references, especially when that pattern is zero. + + .. warning:: + + A risk of using tagged pointers in registers and on the stack is + that in some circumstances, an optimizing compiler might + optimize away the tagged pointer, keeping only the untagged + version of the pointer. See + :c:func:`mps_root_create_thread_tagged`. + +.. c:function:: mps_res_t mps_scan_area_tagged_or_zero(mps_ss_t ss, void *base, void *limit, void *closure) + + Scan an area of memory :term:`fixing ` only words whose + masked bits are zero or match a particular tag pattern. + ``closure`` must point to a :c:type:`mps_scan_tag_s`. Expects + ``base`` and ``limit`` to be word-aligned. + + For example, if ``mask`` is 7 and ``pattern`` is 3, then this + scanner will fix words whose low order bits are 0b011 and words + whose low order bits are 0b000, but not any others. + + This scanner is most useful for ambiguously scanning the stack and + registers when using an optimising C compiler and non-zero tags on + references, since the compiler is likely to leave untagged addresses + of objects around which must not be ignored. diff --git a/mps/manual/source/topic/telemetry.rst b/mps/manual/source/topic/telemetry.rst index e25e71e4c59..5ee6bb000e1 100644 --- a/mps/manual/source/topic/telemetry.rst +++ b/mps/manual/source/topic/telemetry.rst @@ -6,16 +6,16 @@ Telemetry ========= In its :term:`cool` and :term:`hot` :term:`varieties`, the MPS is -capable of outputting a configurable stream of events to assist with -debugging and profiling. +capable of outputting a configurable stream of events (the +:term:`telemetry stream`) to assist with debugging and profiling. The selection of events that appear in the stream is controlled by the environment variable :envvar:`MPS_TELEMETRY_CONTROL` (by default none), and the stream is written to the file named by the environment variable :envvar:`MPS_TELEMETRY_FILENAME` (by default ``mpsio.log``). -The telemetry system writes blocks of binary output, and is fast -enough to be left turned on in production code (the :term:`hot` +The :term:`telemetry system` writes blocks of binary output, and is +fast enough to be left turned on in production code (the :term:`hot` variety avoids emitting events on the :term:`critical path`), which can be useful for diagnosing memory management problems in production environments. @@ -49,6 +49,8 @@ demonstration of :term:`Lisp` in an appendix to his paper .. index:: single: telemetry; utilities +.. _topic-telemetry-utilities: + Telemetry utilities ------------------- @@ -120,7 +122,7 @@ second column, and then addresses or other data related to the event in the remaining columns. The source of the timestamp depends on the platform; it may be a low-cost high-resolution processor timer, such as the `Time Stamp Counter -`_ on IA-32 and +`_ on IA-32 and x86-64, if one is available. All numbers are given in hexadecimal. :: 000AE03973336E3C 002B VMCreate vm:00000001003FC000 base:00000001003FD000 limit:00000001003FE000 diff --git a/mps/manual/source/topic/thread.rst b/mps/manual/source/topic/thread.rst index 9417c473b04..0697daac301 100644 --- a/mps/manual/source/topic/thread.rst +++ b/mps/manual/source/topic/thread.rst @@ -47,8 +47,8 @@ see :ref:`topic-root-thread`). For simplicity, we recommend that a thread must be registered with an :term:`arena` if: -* its registers and control stack form a root (this is enforced by - :c:func:`mps_root_create_reg`); or +* its :term:`control stack` and :term:`registers` form a root (this is + enforced by :c:func:`mps_root_create_thread`); or * it reads or writes from a location in an :term:`automatically managed ` :term:`pool` in the arena. @@ -117,8 +117,9 @@ Thread interface as necessary in order to have exclusive access to their state. Even in a single-threaded environment it may be necessary to - register a thread with the MPS so that its stack can be registered - as a :term:`root` by calling :c:func:`mps_root_create_reg`. + register a thread with the MPS so that its :term:`control stack` + and :term:`registers` can be registered as a :term:`root` by + calling :c:func:`mps_root_create_thread`. .. c:function:: mps_res_t mps_thread_reg(mps_thr_t *thr_o, mps_arena_t arena) diff --git a/mps/procedure/branch-merge.rst b/mps/procedure/branch-merge.rst index a29a6daa197..2645d3385f4 100644 --- a/mps/procedure/branch-merge.rst +++ b/mps/procedure/branch-merge.rst @@ -52,7 +52,7 @@ the parent branch. So a typical invocation looks like this:: The specification should look like this:: - Branch: mps/branch/2013-08-21/lii6ll + Branch: mps/branch/2013-08-21/lii6ll Description: Adding new supported platform lii6ll (job003596). diff --git a/mps/procedure/release-build.rst b/mps/procedure/release-build.rst index cf07cee0620..66a56fba2f8 100644 --- a/mps/procedure/release-build.rst +++ b/mps/procedure/release-build.rst @@ -147,7 +147,7 @@ On a Unix (including OS X) machine: View: //info.ravenbrook.com/project/mps/version/$VERSION/... //$CLIENT/mps-kit-$RELEASE/... //info.ravenbrook.com/project/mps/release/$RELEASE/... //$CLIENT/release/$RELEASE/... - END + END #. Sync this client to *CHANGELEVEL*:: @@ -169,7 +169,7 @@ On a Unix (including OS X) machine: #. Sync the version sources again:: rm -rf /tmp/$CLIENT/version/$VERSION - p4 -c $CLIENT sync -f @$CHANGELEVEL + p4 -c $CLIENT sync -f @$CHANGELEVEL #. Create a zip file containing the MPS sources, and open it for add:: diff --git a/mps/procedure/version-create.rst b/mps/procedure/version-create.rst index 3f743639fdf..e92e93535d3 100644 --- a/mps/procedure/version-create.rst +++ b/mps/procedure/version-create.rst @@ -145,8 +145,8 @@ the parent branch. A typical invocation looks like this:: p4 client -i < argerr/127.c diff --git a/mps/test/testsets/conerr b/mps/test/testsets/conerr index 12966b681a0..1bf93cd0712 100644 --- a/mps/test/testsets/conerr +++ b/mps/test/testsets/conerr @@ -1,3 +1,7 @@ +% This testset contains all the "argerr" test cases that pass in +% both the cool and hot varieties, together with comments explaining +% why the other test cases fail. + conerr/0.c conerr/1.c conerr/2.c @@ -15,13 +19,13 @@ conerr/13.c conerr/14.c conerr/15.c conerr/16.c -conerr/17.c +% conerr/17.c -- fails in hot variety (assertion is on the critical path) conerr/18.c conerr/19.c conerr/20.c conerr/21.c -conerr/22.c -conerr/23.c +% conerr/22.c -- segfaults in hot variety (assertion is on the critical path) +% conerr/23.c -- segfaults in hot variety (assertion is on the critical path) conerr/24.c conerr/25.c conerr/26.c diff --git a/mps/test/testsets/coolonly b/mps/test/testsets/coolonly new file mode 100644 index 00000000000..3125dcbedb5 --- /dev/null +++ b/mps/test/testsets/coolonly @@ -0,0 +1,34 @@ +% This testset contains all the test cases that pass only in the cool +% variety, together with comments explaining why they fail in the hot +% variety. + +% Assertion in different place in the hot variety. +argerr/16.c + +% Rank is not a structure type, so AVERT(Rank) does nothing. +argerr/49.c +argerr/50.c +argerr/51.c +argerr/94.c +argerr/95.c +argerr/96.c +argerr/104.c +argerr/105.c +argerr/106.c +argerr/119.c +argerr/120.c +argerr/121.c + +% RootMode is not a structure type, so AVERT(Rootmode) does nothing. +argerr/107.c +argerr/108.c +argerr/109.c +argerr/122.c +argerr/123.c +argerr/124.c + +% Assertion is on the critical path. +conerr/17.c +conerr/22.c +conerr/23.c +function/72.c diff --git a/mps/test/testsets/passing b/mps/test/testsets/passing index c6893a54c30..85f880b07ce 100644 --- a/mps/test/testsets/passing +++ b/mps/test/testsets/passing @@ -1,5 +1,6 @@ -% Test status on OS X -% $Id$ +% This testset contains all the "function" test cases that pass in +% both the cool and hot varieties, together with comments explaining +% why the other test cases fail. function/0.c function/1.c @@ -72,7 +73,7 @@ function/67.c function/69.c function/70.c function/71.c -function/72.c +% function/72.c -- fails in hot variety (assertion is on the critical path) function/73.c function/74.c function/75.c diff --git a/mps/tool/testcases.txt b/mps/tool/testcases.txt index 0b45b8cc548..b867b67acfc 100644 --- a/mps/tool/testcases.txt +++ b/mps/tool/testcases.txt @@ -38,6 +38,7 @@ qs sacss segsmss steptest =P +tagtest teletest =N interactive walkt0 zcoll =L