From fec62a3e2c9c83176666203e809d3f2b20255a94 Mon Sep 17 00:00:00 2001 From: Gareth Rees Date: Fri, 4 Sep 2015 16:51:59 +0100 Subject: [PATCH] First draft of tagged pointer test case (runs, but doesn't test anything yet). Copied from Perforce Change: 188244 ServerID: perforce.ravenbrook.com --- mps/code/comm.gmk | 4 + mps/code/comm.nmk | 4 + mps/code/mpsicv.c | 17 ++-- mps/code/tagtest.c | 197 +++++++++++++++++++++++++++++++++++++++++ mps/tool/testcases.txt | 1 + 5 files changed, 218 insertions(+), 5 deletions(-) create mode 100644 mps/code/tagtest.c diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk index c82caa4576e..f00e636ea08 100644 --- a/mps/code/comm.gmk +++ b/mps/code/comm.gmk @@ -283,6 +283,7 @@ TEST_TARGETS=\ sacss \ segsmss \ steptest \ + tagtest \ teletest \ walkt0 \ zcoll \ @@ -510,6 +511,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 diff --git a/mps/code/comm.nmk b/mps/code/comm.nmk index a59132ff354..523a6831ec5 100644 --- a/mps/code/comm.nmk +++ b/mps/code/comm.nmk @@ -94,6 +94,7 @@ TEST_TARGETS=\ sacss.exe \ segsmss.exe \ steptest.exe \ + tagtest.exe \ teletest.exe \ walkt0.exe \ zcoll.exe \ @@ -610,6 +611,9 @@ $(PFM)\$(VARIETY)\segsmss.exe: $(PFM)\$(VARIETY)\segsmss.obj \ $(PFM)\$(VARIETY)\steptest.exe: $(PFM)\$(VARIETY)\steptest.obj \ $(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ) +$(PFM)\$(VARIETY)\tagtest.exe: $(PFM)\$(VARIETY)\tagtest.obj \ + $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ) + $(PFM)\$(VARIETY)\teletest.exe: $(PFM)\$(VARIETY)\teletest.obj \ $(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ) diff --git a/mps/code/mpsicv.c b/mps/code/mpsicv.c index a6b23f00578..80085d2f8ad 100644 --- a/mps/code/mpsicv.c +++ b/mps/code/mpsicv.c @@ -591,11 +591,18 @@ 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_reg_masked(®_root, arena, + mps_rank_ambig(), (mps_rm_t)0, + thread, 0, 0, marker), + "root_create_reg_masked"); + } mps_tramp(&r, test, arena, 0); mps_root_destroy(reg_root); diff --git a/mps/code/tagtest.c b/mps/code/tagtest.c new file mode 100644 index 00000000000..4da62f01c80 --- /dev/null +++ b/mps/code/tagtest.c @@ -0,0 +1,197 @@ +/* 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 via stack and register + * scanning. + */ + +#include /* printf */ + +#include "mps.h" +#include "mpsavm.h" +#include "mpscamc.h" +#include "testlib.h" + +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 size_t tag_bits = 3; /* Number of tag bits */ +static mps_word_t tag_cons = 5; /* Tag bits indicating pointer to cons */ +static mps_word_t tag_fwd = 2; /* Tag bits indicating forwarding pointer */ +static mps_word_t tag_imm = 6; /* Tag bits indicating immediate value */ + +#define TAG_MASK ((((mps_word_t)1 << tag_bits) - 1)) +#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 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; + Insist(TAG(old) == tag_cons); + cons = UNTAGGED(old, cons); + cons->car = TAGGED(0, fwd); + cons->cdr = (mps_word_t)new; +} + +static mps_addr_t isfwd(mps_addr_t addr) +{ + cons_t cons; + if (TAG(addr) != tag_cons) + return NULL; + cons = UNTAGGED(addr, cons); + 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) { + while (base < limit) { + mps_word_t *word = base; + if (MPS_FIX1(ss, *word)) { + mps_word_t tag = TAG(*word); + if (tag == tag_cons) { + mps_addr_t addr = UNTAGGED(*word, cons); + mps_res_t res = MPS_FIX2(ss, &addr); + if (res != MPS_RES_OK) + return res; + *word = TAGGED(addr, cons); + } + base = (mps_addr_t)((char *)base + sizeof(cons_s)); + } + } + } 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)); +} + +int main(int argc, char *argv[]) +{ + void *marker = ▮ + mps_arena_t arena; + mps_thr_t thread; + mps_root_t root; + mps_fmt_t fmt; + mps_pool_t pool; + mps_ap_t ap; + mps_word_t nil = TAGGED(NULL, cons); + + testlib_init(argc, argv); + + die(mps_arena_create(&arena, mps_arena_class_vm(), mps_args_none), "arena"); + die(mps_thread_reg(&thread, arena), "thread"); + + die(mps_root_create_reg_masked(&root, arena, mps_rank_ambig(), 0, thread, + TAG_MASK, tag_cons, marker), "root"); + + MPS_ARGS_BEGIN(args) { + MPS_ARGS_ADD(args, MPS_KEY_FMT_HEADER_SIZE, tag_cons); + MPS_ARGS_ADD(args, MPS_KEY_FMT_ALIGN, sizeof(cons_s)); + 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"); + + cons(ap, nil, nil); + + 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); + + 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/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