From 2181c4c807ba5b7d7833ea780fc2e07bc76101fb Mon Sep 17 00:00:00 2001 From: David Jones Date: Wed, 19 Nov 2003 13:55:41 +0000 Subject: [PATCH] Mps: test for bug in job000825 Copied from Perforce Change: 64980 ServerID: perforce.ravenbrook.com --- mps/code/comm.gmk | 4 + mps/code/expt825.c | 305 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 309 insertions(+) create mode 100644 mps/code/expt825.c diff --git a/mps/code/comm.gmk b/mps/code/comm.gmk index d4ee97c25da..b9057e678dc 100644 --- a/mps/code/comm.gmk +++ b/mps/code/comm.gmk @@ -292,6 +292,7 @@ testrun: mpmss apss sacss amcss amcsshe amsss amssshe segsmss awlut awluthe \ mpmss sacss amcss amcssth amcsshe amsss amssshe segsmss awlut awlutth \ awluthe mpsicv lockcov poolncv locv qs apss \ finalcv finaltest arenacv bttest teletest \ + expt825 \ abqtest cbstest btcv mv2test \ messtest steptest \ walkt0 \ @@ -353,6 +354,9 @@ $(PFM)/$(VARIETY)/finalcv: $(PFM)/$(VARIETY)/finalcv.o \ $(PFM)/$(VARIETY)/finaltest: $(PFM)/$(VARIETY)/finaltest.o \ $(FMTDYTSTOBJ) $(MPMOBJ) $(AMCOBJ) $(TESTLIBOBJ) +$(PFM)/$(VARIETY)/expt825: $(PFM)/$(VARIETY)/expt825.o \ + $(FMTDYTSTOBJ) $(MPMOBJ) $(AMCOBJ) $(TESTLIBOBJ) + $(PFM)/$(VARIETY)/locv: $(PFM)/$(VARIETY)/locv.o \ $(MPMOBJ) $(LOOBJ) $(TESTLIBOBJ) diff --git a/mps/code/expt825.c b/mps/code/expt825.c new file mode 100644 index 00000000000..458e0c0870f --- /dev/null +++ b/mps/code/expt825.c @@ -0,0 +1,305 @@ +/* expt825.c: Test for bug described in job000825 + * + * $Id$ + * Copyright (c) 2001,2003 Ravenbrook Limited. See end of file for license. + * Portions copyright (C) 2002 Global Graphics Software. + * + * DESIGN + * + * DEPENDENCIES + * + * This test uses the dylan object format, but the reliance on this + * particular format is not great and could be removed. + * + * NOTES + * + * This code was created by first copying + * and then further by copying + */ + +#include "testlib.h" +#include "mps.h" +#include "mpscamc.h" +#include "mpsavm.h" +#include "fmtdy.h" +#include "fmtdytst.h" +#include "mpstd.h" +#ifdef MPS_OS_W3 +#include "mpsw3.h" +#endif +#include + + +#define testArenaSIZE ((size_t)16<<20) +#define rootCOUNT 20 +#define maxtreeDEPTH 2 +#define collectionCOUNT 10 +#define genCOUNT 2 + +/* testChain -- generation parameters for the test */ + +static mps_gen_param_s testChain[genCOUNT] = { + { 150, 0.85 }, { 170, 0.45 } }; + + +/* global object counter */ + +static mps_word_t object_count = 0; + +static mps_word_t make_numbered_cons(mps_word_t car, mps_word_t cdr, + mps_ap_t ap) +{ + mps_word_t cons; + die(make_dylan_vector(&cons, ap, 3), "make_dylan_vector"); + DYLAN_VECTOR_SLOT(cons, 0) = car; + DYLAN_VECTOR_SLOT(cons, 1) = cdr; + DYLAN_VECTOR_SLOT(cons, 2) = DYLAN_INT(object_count); + ++ object_count; + return cons; +} + +static mps_word_t make_numbered_tree(mps_word_t depth, + mps_ap_t ap) +{ + mps_word_t left, right; + if (depth < 2) { + left = DYLAN_INT(object_count); + right = DYLAN_INT(object_count); + } else { + left = make_numbered_tree(depth-1, ap); + right = make_numbered_tree(depth-1, ap); + } + return make_numbered_cons(left, right, ap); +} + +static void register_numbered_tree(mps_word_t tree, mps_arena_t arena) +{ + /* don't finalize ints */ + if ((tree & 1) == 0) { + mps_finalize(arena, (mps_addr_t *)&tree); + register_numbered_tree(DYLAN_VECTOR_SLOT(tree, 0), arena); + register_numbered_tree(DYLAN_VECTOR_SLOT(tree, 1), arena); + } +} + +static mps_word_t make_indirect_cons(mps_word_t car, mps_word_t cdr, + mps_ap_t ap) +{ + mps_word_t cons, indirect; + die(make_dylan_vector(&indirect, ap, 1), "make_dylan_vector"); + DYLAN_VECTOR_SLOT(indirect, 0) = DYLAN_INT(object_count); + die(make_dylan_vector(&cons, ap, 3), "make_dylan_vector"); + DYLAN_VECTOR_SLOT(cons, 0) = car; + DYLAN_VECTOR_SLOT(cons, 1) = cdr; + DYLAN_VECTOR_SLOT(cons, 2) = indirect; + ++ object_count; + return cons; +} + +static mps_word_t make_indirect_tree(mps_word_t depth, + mps_ap_t ap) +{ + mps_word_t left, right; + if (depth < 2) { + left = DYLAN_INT(object_count); + right = DYLAN_INT(object_count); + } else { + left = make_indirect_tree(depth-1, ap); + right = make_indirect_tree(depth-1, ap); + } + return make_indirect_cons(left, right, ap); +} + +static void register_indirect_tree(mps_word_t tree, mps_arena_t arena) +{ + /* don't finalize ints */ + if ((tree & 1) == 0) { + mps_word_t indirect = DYLAN_VECTOR_SLOT(tree,2); + mps_finalize(arena, (mps_addr_t *)&indirect); + register_indirect_tree(DYLAN_VECTOR_SLOT(tree, 0), arena); + register_indirect_tree(DYLAN_VECTOR_SLOT(tree, 1), arena); + } +} + + +static void *root[rootCOUNT]; + +static void *test(void *arg, size_t s) +{ + mps_ap_t ap; + mps_fmt_t fmt; + mps_chain_t chain; + mps_word_t finals; + mps_pool_t amc; + mps_root_t mps_root; + mps_arena_t arena; + mps_message_t message; + size_t i; + + arena = (mps_arena_t)arg; + (void)s; + + die(mps_fmt_create_A(&fmt, arena, dylan_fmt_A()), "fmt_create\n"); + die(mps_chain_create(&chain, arena, genCOUNT, testChain), "chain_create"); + die(mps_pool_create(&amc, arena, mps_class_amc(), fmt, chain), + "pool_create amc\n"); + die(mps_root_create_table(&mps_root, arena, MPS_RANK_EXACT, (mps_rm_t)0, + root, (size_t)rootCOUNT), + "root_create\n"); + die(mps_ap_create(&ap, amc, MPS_RANK_EXACT), "ap_create\n"); + + mps_message_type_enable(arena, mps_message_type_finalization()); + + mps_arena_park(arena); + + object_count = 0; + + printf("Making some finalized trees of objects.\n"); + /* make some trees */ + for(i = 0; i < rootCOUNT; ++i) { + root[i] = (void *)make_numbered_tree(maxtreeDEPTH, ap); + register_numbered_tree((mps_word_t)root[i], arena); + } + + mps_arena_unsafe_expose_remember_protection(arena); + mps_arena_unsafe_restore_protection(arena); + + printf("Losing all pointers to the trees.\n"); + /* clean out the roots */ + for(i = 0; i < rootCOUNT; ++i) { + root[i] = 0; + } + + finals = 0; + + while ((finals < object_count) && + (mps_collections(arena) < collectionCOUNT)) { + mps_word_t final_this_time = 0; + printf("Collecting..."); + fflush(stdout); + die(mps_arena_collect(arena), "collect"); + printf(" Done.\n"); + while (mps_message_poll(arena)) { + mps_word_t obj; + mps_addr_t objaddr; + cdie(mps_message_get(&message, arena, + mps_message_type_finalization()), + "get"); + mps_message_finalization_ref(&objaddr, arena, message); + obj = (mps_word_t)objaddr; + mps_message_discard(arena, message); + ++ final_this_time; + } + finals += final_this_time; + printf("%lu objects finalized: total %lu of %lu\n", + final_this_time, finals, object_count); + } + + object_count = 0; + + printf("Making some indirectly finalized trees of objects.\n"); + /* make some trees */ + for(i = 0; i < rootCOUNT; ++i) { + root[i] = (void *)make_indirect_tree(maxtreeDEPTH, ap); + register_indirect_tree((mps_word_t)root[i], arena); + } + + printf("Losing all pointers to the trees.\n"); + /* clean out the roots */ + for(i = 0; i < rootCOUNT; ++i) { + root[i] = 0; + } + + finals = 0; + + while ((finals < object_count) && + (mps_collections(arena) < collectionCOUNT)) { + mps_word_t final_this_time = 0; + printf("Collecting..."); + fflush(stdout); + die(mps_arena_collect(arena), "collect"); + printf(" Done.\n"); + while (mps_message_poll(arena)) { + mps_word_t obj; + mps_addr_t objaddr; + cdie(mps_message_get(&message, arena, + mps_message_type_finalization()), + "get"); + mps_message_finalization_ref(&objaddr, arena, message); + obj = (mps_word_t)objaddr; + mps_message_discard(arena, message); + ++ final_this_time; + } + finals += final_this_time; + printf("%lu objects finalized: total %lu of %lu\n", + final_this_time, finals, object_count); + } + + mps_ap_destroy(ap); + mps_root_destroy(mps_root); + mps_pool_destroy(amc); + mps_chain_destroy(chain); + mps_fmt_destroy(fmt); + + return NULL; +} + + +int main(int argc, char **argv) +{ + mps_arena_t arena; + mps_thr_t thread; + void *r; + + die(mps_arena_create(&arena, mps_arena_class_vm(), testArenaSIZE), + "arena_create\n"); + die(mps_thread_reg(&thread, arena), "thread_reg\n"); + mps_tramp(&r, test, arena, 0); + mps_thread_dereg(thread); + mps_arena_destroy(arena); + + fflush(stdout); /* synchronize */ + return 0; +} + + +/* C. COPYRIGHT AND LICENSE + * + * Copyright (C) 2001-2003 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. + */