diff --git a/mps/code/djbench.c b/mps/code/djbench.c new file mode 100644 index 00000000000..4e23a3a6bc1 --- /dev/null +++ b/mps/code/djbench.c @@ -0,0 +1,375 @@ +/* djbench.c -- "DJ" Benchmark on ANSI C library + * + * $Id$ + * Copyright 2013 Ravenbrook Limited. See end of file for license. + * + * This is an allocation stress benchmark test for manual variable pools + * and also for stdlib malloc/free (for comparison). + * + * It repeatedly runs over an array of blocks and allocates or frees them + * with some probability, then frees all the remaining blocks at the end. + * This test can be iterated. + */ + +#include +#include +#include +#include +#include +#include "getopt.h" +#include "testlib.h" + +#include "mps.c" + + +#define MUST(expr) \ + do { \ + mps_res_t res = (expr); \ + if (res != MPS_RES_OK) { \ + fprintf(stderr, #expr " returned %d\n", res); \ + exit(EXIT_FAILURE); \ + } \ + } while(0) + +static mps_arena_t arena; +static mps_pool_t pool; + + +/* The benchmark behaviour is defined as a macro in order to give realistic + opportunities for compiler optimisation and the intended inlining of the + MPS functions. */ + +static rnd_state_t seed = 0; /* random number seed */ +static unsigned nthreads = 1; /* threads */ +static unsigned niter = 50; /* iterations */ +static unsigned npass = 100; /* passes over blocks */ +static unsigned nblocks = 64; /* number of blocks */ +static unsigned sshift = 18; /* log2 max block size in words */ +static double pact = 0.2; /* probability per pass of acting */ +static unsigned rinter = 75; /* pass interval for recursion */ +static unsigned rmax = 10; /* maximum recursion depth */ + +#define DJRUN(fname, alloc, free) \ + static unsigned fname##_inner(mps_ap_t ap, unsigned depth, unsigned r) { \ + struct {void *p; size_t s;} *blocks = alloca(sizeof(blocks[0]) * nblocks); \ + unsigned j, k; \ + \ + for (k = 0; k < nblocks; ++k) { \ + blocks[k].p = NULL; \ + } \ + \ + for (j = 0; j < npass; ++j) { \ + for (k = 0; k < nblocks; ++k) { \ + if (rnd() % 16384 < pact * 16384) { \ + if (blocks[k].p == NULL) { \ + size_t s = rnd() % ((sizeof(void *) << (rnd() % sshift)) - 1); \ + void *p = NULL; \ + if (s > 0) alloc(p, s); \ + blocks[k].p = p; \ + blocks[k].s = s; \ + } else { \ + free(blocks[k].p, blocks[k].s); \ + blocks[k].p = NULL; \ + } \ + } \ + } \ + if (rinter > 0 && depth > 0 && ++r % rinter == 0) { \ + /* putchar('>'); fflush(stdout); */ \ + r = fname##_inner(ap, depth - 1, r); \ + /* putchar('<'); fflush(stdout); */ \ + } \ + } \ + \ + for (k = 0; k < nblocks; ++k) { \ + if (blocks[k].p) { \ + free(blocks[k].p, blocks[k].s); \ + blocks[k].p = NULL; \ + } \ + } \ + return r; \ + } \ + \ + static void *fname(void *p) { \ + unsigned i; \ + mps_ap_t ap = NULL; \ + if (pool != NULL) \ + MUST(mps_ap_create_k(&ap, pool, mps_args_none)); \ + for (i = 0; i < niter; ++i) \ + (void)fname##_inner(ap, rmax, 0); \ + if (ap != NULL) \ + mps_ap_destroy(ap); \ + return p; \ + } + + +/* malloc/free benchmark */ + +#define MALLOC_ALLOC(p, s) do { p = malloc(s); } while(0) +#define MALLOC_FREE(p, s) do { free(p); } while(0) + +DJRUN(dj_malloc, MALLOC_ALLOC, MALLOC_FREE) + + +/* mps_alloc/mps_free benchmark */ + +#define MPS_ALLOC(p, s) do { mps_alloc(&p, pool, s); } while(0) +#define MPS_FREE(p, s) do { mps_free(pool, p, s); } while(0) + +DJRUN(dj_alloc, MPS_ALLOC, MPS_FREE) + + +/* reserve/free benchmark */ + +#define ALIGN_UP(s, a) (((s) + ((a) - 1)) & ~((a) - 1)) +#define RESERVE_ALLOC(p, s) \ + do { \ + size_t _s = ALIGN_UP(s, (size_t)MPS_PF_ALIGN); \ + mps_reserve(&p, ap, _s); \ + mps_commit(ap, p, _s); \ + } while(0) +#define RESERVE_FREE(p, s) do { mps_free(pool, p, s); } while(0) + +DJRUN(dj_reserve, RESERVE_ALLOC, RESERVE_FREE) + +typedef void *(*dj_t)(void *); + +static void weave(dj_t dj) +{ + pthread_t *threads = alloca(sizeof(threads[0]) * nthreads); + unsigned t; + + for (t = 0; t < nthreads; ++t) { + int err = pthread_create(&threads[t], NULL, dj, NULL); + if (err != 0) { + fprintf(stderr, "Unable to create thread: %d\n", err); + exit(EXIT_FAILURE); + } + } + + for (t = 0; t < nthreads; ++t) { + int err = pthread_join(threads[t], NULL); + if (err != 0) { + fprintf(stderr, "Unable to join thread: %d\n", err); + exit(EXIT_FAILURE); + } + } +} + + +static void watch(dj_t dj, const char *name) +{ + clock_t start, finish; + + start = clock(); + if (nthreads == 1) + dj(NULL); + else + weave(dj); + finish = clock(); + + printf("%s: %g\n", name, (double)(finish - start) / CLOCKS_PER_SEC); +} + + +/* Wrap a call to dj benchmark that doesn't require MPS setup */ + +static void wrap(dj_t dj, mps_class_t dummy, const char *name) +{ + (void)dummy; + pool = NULL; + watch(dj, name); +} + + +/* Wrap a call to a dj benchmark that requires MPS setup */ + +static void arena_wrap(dj_t dj, mps_class_t pool_class, const char *name) +{ + MPS_ARGS_BEGIN(args) { + MPS_ARGS_ADD(args, MPS_KEY_ARENA_SIZE, 256ul * 1024 * 1024); /* FIXME: Why is there no default? */ + MPS_ARGS_DONE(args); + MUST(mps_arena_create_k(&arena, mps_arena_class_vm(), args)); + } MPS_ARGS_END(args); + MUST(mps_pool_create_k(&pool, arena, pool_class, mps_args_none)); + watch(dj, name); + mps_pool_destroy(pool); + mps_arena_destroy(arena); +} + + +/* Command-line options definitions. See getopt_long(3). */ + +static struct option longopts[] = { + {"help", no_argument, NULL, 'h'}, + {"nthreads",required_argument, NULL, 't'}, + {"niter", required_argument, NULL, 'i'}, + {"npass", required_argument, NULL, 'p'}, + {"nblocks", required_argument, NULL, 'b'}, + {"sshift", required_argument, NULL, 's'}, + {"pact", required_argument, NULL, 'a'}, + {"rinter", required_argument, NULL, 'r'}, + {"rmax", required_argument, NULL, 'd'}, + {"seed", required_argument, NULL, 'x'}, + {NULL, 0, NULL, 0} +}; + + +/* Test definitions. */ + +static mps_class_t dummy_class(void) +{ + return NULL; +} + +static struct { + const char *name; + void (*wrap)(dj_t, mps_class_t, const char *name); + dj_t dj; + mps_class_t (*pool_class)(void); +} pools[] = { + {"mvt", arena_wrap, dj_reserve, mps_class_mvt}, + {"mvff", arena_wrap, dj_reserve, mps_class_mvff}, + {"mv", arena_wrap, dj_alloc, mps_class_mv}, + {"mvb", arena_wrap, dj_reserve, mps_class_mv}, /* mv with buffers */ + {"an", wrap, dj_malloc, dummy_class}, +}; + + +/* Command-line driver */ + +int main(int argc, char *argv[]) { + int ch; + unsigned i; + + seed = rnd_seed(); + + while ((ch = getopt_long(argc, argv, "ht:i:p:b:s:a:r:d:x:", longopts, NULL)) != -1) + switch (ch) { + case 't': + nthreads = (unsigned)strtoul(optarg, NULL, 10); + break; + case 'i': + niter = (unsigned)strtoul(optarg, NULL, 10); + break; + case 'p': + npass = (unsigned)strtoul(optarg, NULL, 10); + break; + case 'b': + nblocks = (unsigned)strtoul(optarg, NULL, 10); + break; + case 's': + sshift = (unsigned)strtoul(optarg, NULL, 10); + break; + case 'a': + pact = strtod(optarg, NULL); + break; + case 'r': + rinter = (unsigned)strtoul(optarg, NULL, 10); + break; + case 'd': + rmax = (unsigned)strtoul(optarg, NULL, 10); + break; + case 'x': + seed = strtoul(optarg, NULL, 10); + break; + default: + fprintf(stderr, + "Usage: %s [option...] [test...]\n" + "Options:\n" + " -t n, --nthreads=n\n" + " Launch n threads each running the test\n" + " -i n, --niter=n\n" + " Iterate each test n times (default %u).\n" + " -p n, --npass=n\n" + " Pass over the block array n times (default %u).\n" + " -b n, --nblocks=n\n" + " Length of the block array (default %u).\n" + " -s n, --sshift=n\n" + " Log2 max block size in words (default %u).\n" + " -a p, --pact=p\n" + " Probability of acting on a block (default %g).\n", + argv[0], + niter, + npass, + nblocks, + sshift, + pact); + fprintf(stderr, + " -r n, --rinter=n\n" + " Recurse every n passes if n > 0 (default %u).\n" + " -d n, --rmax=n\n" + " Maximum recursion depth (default %u).\n" + " -x n, --seed=n\n" + " Random number seed (default from entropy).\n" + "Tests:\n" + " mvt pool class MVT\n" + " mvff pool class MVFF\n" + " mv pool class MV\n" + " mvb pool class MV with buffers\n" + " an malloc\n", + rinter, + rmax); + return EXIT_FAILURE; + } + argc -= optind; + argv += optind; + + printf("seed: %lu\n", seed); + + while (argc > 0) { + for (i = 0; i < sizeof(pools) / sizeof(pools[0]); ++i) + if (strcmp(argv[0], pools[i].name) == 0) + goto found; + fprintf(stderr, "unknown pool test \"%s\"\n", argv[0]); + return EXIT_FAILURE; + found: + rnd_state_set(seed); + pools[i].wrap(pools[i].dj, pools[i].pool_class(), pools[i].name); + --argc; + ++argv; + } + + return EXIT_SUCCESS; +} + + +/* C. COPYRIGHT AND LICENSE + * + * Copyright (c) 2001-2013 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/mps.xcodeproj/project.pbxproj b/mps/code/mps.xcodeproj/project.pbxproj index 137f5a2fbac..acee1944ed3 100644 --- a/mps/code/mps.xcodeproj/project.pbxproj +++ b/mps/code/mps.xcodeproj/project.pbxproj @@ -204,6 +204,9 @@ 3124CAFB156BE82000753214 /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; }; 3124CAFC156BE82900753214 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; }; 3150AE53156ABA2500A6E22A /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; }; + 318DA8CF1892B1210089718C /* djbench.c in Sources */ = {isa = PBXBuildFile; fileRef = 318DA8CE1892B1210089718C /* djbench.c */; }; + 318DA8D21892B13B0089718C /* getoptl.c in Sources */ = {isa = PBXBuildFile; fileRef = 318DA8D11892B13B0089718C /* getoptl.c */; }; + 318DA8D31892B27E0089718C /* testlib.c in Sources */ = {isa = PBXBuildFile; fileRef = 31EEAC9E156AB73400714D05 /* testlib.c */; }; 31A47BA4156C1E130039B1C2 /* mps.c in Sources */ = {isa = PBXBuildFile; fileRef = 31A47BA3156C1E130039B1C2 /* mps.c */; }; 31D60007156D3C6200337B26 /* segsmss.c in Sources */ = {isa = PBXBuildFile; fileRef = 31D60006156D3C5F00337B26 /* segsmss.c */; }; 31D60008156D3C7400337B26 /* libmps.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 31EEABFB156AAF9D00714D05 /* libmps.a */; }; @@ -1037,6 +1040,15 @@ ); runOnlyForDeploymentPostprocessing = 1; }; + 318DA8C81892B0F30089718C /* CopyFiles */ = { + isa = PBXCopyFilesBuildPhase; + buildActionMask = 2147483647; + dstPath = /usr/share/man/man1/; + dstSubfolderSpec = 0; + files = ( + ); + runOnlyForDeploymentPostprocessing = 1; + }; 31D6000B156D3CB200337B26 /* CopyFiles */ = { isa = PBXCopyFilesBuildPhase; buildActionMask = 2147483647; @@ -1208,7 +1220,6 @@ 311F2F6917398B3B00C15B6A /* mpstd.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = mpstd.h; sourceTree = ""; }; 311F2F6A17398B4C00C15B6A /* mpsw3.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = mpsw3.h; sourceTree = ""; }; 311F2F6B17398B4C00C15B6A /* mpswin.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = mpswin.h; sourceTree = ""; }; - 311F2F6C17398B5800C15B6A /* osxc.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = osxc.h; sourceTree = ""; }; 311F2F6D17398B6300C15B6A /* prmci3.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = prmci3.h; sourceTree = ""; }; 311F2F6E17398B6300C15B6A /* prmci6.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = prmci6.h; sourceTree = ""; }; 311F2F6F17398B6300C15B6A /* prmcix.h */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.c.h; path = prmcix.h; sourceTree = ""; }; @@ -1240,6 +1251,10 @@ 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 = ""; }; + 318DA8D01892B13B0089718C /* getopt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = getopt.h; sourceTree = ""; }; + 318DA8D11892B13B0089718C /* getoptl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = getoptl.c; 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 = ""; }; @@ -1560,6 +1575,13 @@ ); runOnlyForDeploymentPostprocessing = 0; }; + 318DA8C71892B0F30089718C /* Frameworks */ = { + isa = PBXFrameworksBuildPhase; + buildActionMask = 2147483647; + files = ( + ); + runOnlyForDeploymentPostprocessing = 0; + }; 31D6000A156D3CB200337B26 /* Frameworks */ = { isa = PBXFrameworksBuildPhase; buildActionMask = 2147483647; @@ -1714,6 +1736,16 @@ name = Tests; sourceTree = ""; }; + 318DA8C21892B0B20089718C /* Benchmarks */ = { + isa = PBXGroup; + children = ( + 318DA8D01892B13B0089718C /* getopt.h */, + 318DA8D11892B13B0089718C /* getoptl.c */, + 318DA8CE1892B1210089718C /* djbench.c */, + ); + name = Benchmarks; + sourceTree = ""; + }; 31A47BA8156C1E930039B1C2 /* MPS */ = { isa = PBXGroup; children = ( @@ -1733,6 +1765,7 @@ 3114A6D6156E9846001E0AA3 /* Tools */, 31A47BA8156C1E930039B1C2 /* MPS */, 3124CAB3156BE1B700753214 /* Tests */, + 318DA8C21892B0B20089718C /* Benchmarks */, 31FCAE171769247F008C034C /* Scheme */, 31EEABEF156AAF5C00714D05 /* Products */, ); @@ -1780,6 +1813,7 @@ 2291A5E3175CB05F001D4920 /* exposet0 */, 224CC799175E1821002FF81B /* fotest */, 31FCAE0A17692403008C034C /* scheme */, + 318DA8CD1892B0F30089718C /* djbench */, ); name = Products; sourceTree = ""; @@ -1838,7 +1872,6 @@ 311F2F6917398B3B00C15B6A /* mpstd.h */, 311F2F6A17398B4C00C15B6A /* mpsw3.h */, 311F2F6B17398B4C00C15B6A /* mpswin.h */, - 311F2F6C17398B5800C15B6A /* osxc.h */, 31EEAC09156AB27B00714D05 /* pool.c */, 31EEAC0A156AB27B00714D05 /* poolabs.c */, 31EEAC2D156AB2F200714D05 /* poolmfs.c */, @@ -2491,6 +2524,23 @@ productReference = 3124CAEB156BE7F300753214 /* amcss */; productType = "com.apple.product-type.tool"; }; + 318DA8C31892B0F30089718C /* djbench */ = { + isa = PBXNativeTarget; + buildConfigurationList = 318DA8C91892B0F30089718C /* Build configuration list for PBXNativeTarget "djbench" */; + buildPhases = ( + 318DA8C41892B0F30089718C /* Sources */, + 318DA8C71892B0F30089718C /* Frameworks */, + 318DA8C81892B0F30089718C /* CopyFiles */, + ); + buildRules = ( + ); + dependencies = ( + ); + name = djbench; + productName = scheme; + productReference = 318DA8CD1892B0F30089718C /* djbench */; + productType = "com.apple.product-type.tool"; + }; 31D6000C156D3CB200337B26 /* awluthe */ = { isa = PBXNativeTarget; buildConfigurationList = 31D60014156D3CB200337B26 /* Build configuration list for PBXNativeTarget "awluthe" */; @@ -2712,6 +2762,7 @@ 2D604B9B16514B1A003AAF46 /* mpseventtxt */, 22CDE8EF16E9E97D00366D0A /* testrun */, 31FCAE0917692403008C034C /* scheme */, + 318DA8C31892B0F30089718C /* djbench */, ); }; /* End PBXProject section */ @@ -3049,6 +3100,16 @@ ); runOnlyForDeploymentPostprocessing = 0; }; + 318DA8C41892B0F30089718C /* Sources */ = { + isa = PBXSourcesBuildPhase; + buildActionMask = 2147483647; + files = ( + 318DA8D31892B27E0089718C /* testlib.c in Sources */, + 318DA8D21892B13B0089718C /* getoptl.c in Sources */, + 318DA8CF1892B1210089718C /* djbench.c in Sources */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; 31D60009156D3CB200337B26 /* Sources */ = { isa = PBXSourcesBuildPhase; buildActionMask = 2147483647; @@ -4496,6 +4557,30 @@ }; name = WE; }; + 318DA8CA1892B0F30089718C /* Debug */ = { + isa = XCBuildConfiguration; + buildSettings = { + GCC_TREAT_WARNINGS_AS_ERRORS = NO; + PRODUCT_NAME = djbench; + }; + name = Debug; + }; + 318DA8CB1892B0F30089718C /* Release */ = { + isa = XCBuildConfiguration; + buildSettings = { + GCC_TREAT_WARNINGS_AS_ERRORS = NO; + PRODUCT_NAME = djbench; + }; + name = Release; + }; + 318DA8CC1892B0F30089718C /* WE */ = { + isa = XCBuildConfiguration; + buildSettings = { + GCC_TREAT_WARNINGS_AS_ERRORS = NO; + PRODUCT_NAME = djbench; + }; + name = WE; + }; 31D60015156D3CB200337B26 /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { @@ -5108,6 +5193,16 @@ defaultConfigurationIsVisible = 0; defaultConfigurationName = Release; }; + 318DA8C91892B0F30089718C /* Build configuration list for PBXNativeTarget "djbench" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + 318DA8CA1892B0F30089718C /* Debug */, + 318DA8CB1892B0F30089718C /* Release */, + 318DA8CC1892B0F30089718C /* WE */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Release; + }; 31D60014156D3CB200337B26 /* Build configuration list for PBXNativeTarget "awluthe" */ = { isa = XCConfigurationList; buildConfigurations = ( diff --git a/mps/code/testlib.c b/mps/code/testlib.c index bcb0801f3e1..e9dd48e050b 100644 --- a/mps/code/testlib.c +++ b/mps/code/testlib.c @@ -236,6 +236,16 @@ double rnd_double(void) } +rnd_state_t rnd_seed(void) +{ + /* Initialize seed based on seconds since epoch and on processor + * cycle count. */ + EventClock t2; + EVENT_CLOCK(t2); + return 1 + ((unsigned long)time(NULL) + (unsigned long)t2) % (R_m - 1); +} + + /* randomize -- randomize the generator, or initialize to replay * * There have been 3 versions of the rnd-states reported by this @@ -270,11 +280,7 @@ void randomize(int argc, char *argv[]) argv[0], seed0); rnd_state_set(seed0); } else { - /* Initialize seed based on seconds since epoch and on processor - * cycle count. */ - EventClock t2; - EVENT_CLOCK(t2); - seed0 = 1 + ((unsigned long)time(NULL) + (unsigned long)t2) % (R_m - 1); + seed0 = rnd_seed(); printf("%s: randomize(): choosing initial state (v3): %lu.\n", argv[0], seed0); rnd_state_set(seed0); diff --git a/mps/code/testlib.h b/mps/code/testlib.h index a56e8840a96..d58655ca246 100644 --- a/mps/code/testlib.h +++ b/mps/code/testlib.h @@ -197,6 +197,7 @@ typedef unsigned long rnd_state_t; extern rnd_state_t rnd_state(void); extern void rnd_state_set(rnd_state_t state_v3); extern void rnd_state_set_v2(rnd_state_t seed0_v2); /* legacy */ +extern rnd_state_t rnd_seed(void); /* rnd_verify() -- checks behaviour of rnd() */ diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c index e7fe547e490..f790a9d1e03 100644 --- a/mps/example/scheme/scheme.c +++ b/mps/example/scheme/scheme.c @@ -133,12 +133,12 @@ typedef struct integer_s { typedef struct special_s { type_t type; /* TYPE_SPECIAL */ - char *name; /* printed representation, NUL terminated */ + const char *name; /* printed representation, NUL terminated */ } special_s; typedef struct operator_s { type_t type; /* TYPE_OPERATOR */ - char *name; /* printed name, NUL terminated */ + 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 */ @@ -389,7 +389,7 @@ static mps_ap_t obj_ap; /* allocation point used to allocate objects */ * message. */ -static void error(char *format, ...) +static void error(const char *format, ...) { va_list args; @@ -484,7 +484,7 @@ static obj_t make_integer(long integer) return obj; } -static obj_t make_symbol(size_t length, char string[]) +static obj_t make_symbol(size_t length, const char string[]) { obj_t obj; mps_addr_t addr; @@ -519,7 +519,7 @@ static obj_t make_string(size_t length, char string[]) return obj; } -static obj_t make_special(char *string) +static obj_t make_special(const char *string) { obj_t obj; mps_addr_t addr; @@ -535,7 +535,7 @@ static obj_t make_special(char *string) return obj; } -static obj_t make_operator(char *name, +static obj_t make_operator(const char *name, entry_t entry, obj_t arguments, obj_t body, obj_t env, obj_t op_env) { @@ -732,7 +732,7 @@ static unsigned long hash(const char *s, size_t length) { * is full. */ -static obj_t *find(char *string) { +static obj_t *find(const char *string) { unsigned long i, h, probe; h = hash(string, strlen(string)); @@ -791,7 +791,7 @@ static void rehash(void) { } /* union-find string in symbol table, rehashing if necessary */ -static obj_t intern(char *string) { +static obj_t intern(const char *string) { obj_t *where; where = find(string); @@ -1549,7 +1549,7 @@ static obj_t load(obj_t env, obj_t op_env, obj_t filename) { * using the message given. */ -static obj_t eval_list(obj_t env, obj_t op_env, obj_t list, char *message) +static obj_t eval_list(obj_t env, obj_t op_env, obj_t list, const char *message) { obj_t result, end, pair; result = obj_empty; @@ -1574,7 +1574,7 @@ static obj_t eval_list(obj_t env, obj_t op_env, obj_t list, char *message) * See eval_args and eval_args_rest for usage. */ -static obj_t eval_args1(char *name, obj_t env, obj_t op_env, +static obj_t eval_args1(const char *name, obj_t env, obj_t op_env, obj_t operands, unsigned n, va_list args) { unsigned i; @@ -1599,7 +1599,7 @@ static obj_t eval_args1(char *name, obj_t env, obj_t op_env, * eval_args("foo", env, op_env, operands, 2, &arg1, &arg2); */ -static void eval_args(char *name, obj_t env, obj_t op_env, +static void eval_args(const char *name, obj_t env, obj_t op_env, obj_t operands, unsigned n, ...) { va_list args; @@ -1623,7 +1623,7 @@ static void eval_args(char *name, obj_t env, obj_t op_env, * eval_args_rest("foo", env, op_env, operands, &rest, 2, &arg1, &arg2); */ -static void eval_args_rest(char *name, obj_t env, obj_t op_env, +static void eval_args_rest(const char *name, obj_t env, obj_t op_env, obj_t operands, obj_t *restp, unsigned n, ...) { va_list args; @@ -3731,7 +3731,7 @@ static obj_t entry_gc(obj_t env, obj_t op_env, obj_t operator, obj_t operands) /* special table */ -static struct {char *name; obj_t *varp;} sptab[] = { +static struct {const char *name; obj_t *varp;} sptab[] = { {"()", &obj_empty}, {"#[eof]", &obj_eof}, {"#[error]", &obj_error}, @@ -3745,7 +3745,7 @@ static struct {char *name; obj_t *varp;} sptab[] = { /* initial symbol table */ -static struct {char *name; obj_t *varp;} isymtab[] = { +static struct {const char *name; obj_t *varp;} isymtab[] = { {"quote", &obj_quote}, {"lambda", &obj_lambda}, {"begin", &obj_begin}, @@ -3758,7 +3758,7 @@ static struct {char *name; obj_t *varp;} isymtab[] = { /* operator table */ -static struct {char *name; entry_t entry;} optab[] = { +static struct {const char *name; entry_t entry;} optab[] = { {"quote", entry_quote}, {"define", entry_define}, {"set!", entry_set}, @@ -3779,7 +3779,7 @@ static struct {char *name; entry_t entry;} optab[] = { /* function table */ -static struct {char *name; entry_t entry;} funtab[] = { +static struct {const char *name; entry_t entry;} funtab[] = { {"not", entry_not}, {"boolean?", entry_booleanp}, {"eqv?", entry_eqvp},