1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
/* testlib.c: TEST LIBRARY
 *
 * $Id: //info.ravenbrook.com/project/mps/master/code/testlib.c#42 $
 * Copyright (c) 2001-2020 Ravenbrook Limited.  See end of file for license.
 * Portions copyright (C) 2002 Global Graphics Software.
 *
 * .purpose: A library of functions that may be of use to unit tests.
 */

#include "testlib.h"
#include "clock.h" /* for EVENT_CLOCK */
#include "mps.h"
#include "misc.h" /* for NOOP */

#include <math.h> /* fmod, log, HUGE_VAL */
#include <stdio.h> /* fflush, printf, stderr, sscanf, vfprintf */
#include <stdlib.h> /* abort, exit, getenv */
#include <time.h> /* time */


/* fail -- like assert, but (notionally) returns a value, so usable in an expression */

int fail(void)
{
  Insist(FALSE);
  return 1111UL;
}


/* rnd -- a random number generator
 *
 * We use the (Multiplicative) Linear Congruential Generator
 *   Xn = a * Xn-1 mod m
 * with: m = 2147483647 (2^31 - 1, a Mersenne prime), and a = 48271.
 * This is a 'full-period' generator: all values in [1..(mod-1)]
 * (ie. 0x00000001 to 0x7ffffffe inclusive) are returned once, and then
 * the cycle begins again.  The value 0 is not part of the cycle and
 * is never returned.  So the period = mod-1, ie. 2147483646.
 *
 * This generator is extremely simple and has been very well studied.
 * It is free of major vices we might care about for this application.
 * In particular, as m is prime, low order bits are random.  Therefore
 * to roll an N-sided die (N << m), "rnd() % N" is acceptable, giving
 * a value in [0..N-1].
 *
 * It was popularised by the much-cited Park & Miller paper:
 *   Stephen K Park & Keith W Miller (1988). Random number generators:
 *   good ones are hard to find.  Communications of the ACM,
 *   31:1192-1201.
 * The recommended multiplier a was later updated from 16807 to 48271:
 *   Stephen K Park, Keith W Miller, Paul K. Stockmeyer (1993).
 *   Technical Correspondence.  Communications of the ACM, 36:105-110.
 *
 * (Many more elaborate generators have been invented.  The next simple
 * step would be to combine with the MLCG m = 2147483399 a = 40692, to
 * make the period "about 74 quadrillion".  See the summary of chapter
 * 3 in Knuth's "The Art of Computer Programming".)
 *
 * This (fast) implementation uses the identity:
 *   0x80000000 == 0x7FFFFFFF + 0x00000001
 * noted by David Carta (1990), where 0x7FFFFFFF == 2^31-1 == m, which
 * means that bits above the first 31 can simply be shifted >> 31 and
 * added, preserving Xn mod m.  To remain within 32-bit unsigned
 * arithmetic when multiplying the previous seed (31 bits) by a (16
 * bits), the seed is split into bottom and top halves; bits above
 * the first 31 are simply "top >> 16".  (Code by RHSK, inspired by
 * Robin Whittle's article at "http://www.firstpr.com.au/dsp/rand31/").
 *
 * Slower implementations, used for verification:
 * rnd_verify_schrage uses the method of L. Schrage (1979 & 1983),
 *   namely splitting the seed by q, where q = m div a.
 * rnd_verify_float simply uses floating point arithmetic.
 */

static unsigned long seed = 1;
#define R_m 2147483647UL
#define R_a 48271UL
unsigned long rnd(void)
{
  /* requires m == 2^31-1, a < 2^16 */
  unsigned long bot = R_a * (seed & 0x7FFF);
  unsigned long top = R_a * (seed >> 15);
  seed = bot + ((top & 0xFFFF) << 15) + (top >> 16);
  if(seed > R_m)
    seed -= R_m;
  return seed;
  /* Have you modified this code?  Run rnd_verify(3) please!  RHSK */
}

static unsigned long seed_verify_schrage = 1;
#define R_q (R_m / R_a)
#define R_r (R_m % R_a)
static unsigned long rnd_verify_schrage(void)
{
  /* requires m < 2^31, q > r; see Park & Miller (1988) */
  unsigned long alpha = R_a * (seed_verify_schrage % R_q);  /* < m */
  unsigned long beta = R_r * (seed_verify_schrage / R_q);  /* < m */
  seed_verify_schrage = alpha - beta;
  if(alpha < beta)
    seed_verify_schrage += R_m;
  return seed_verify_schrage;
}

static unsigned long seed_verify_float = 1;
#define R_m_float 2147483647.0
#define R_a_float 48271.0
static unsigned long rnd_verify_float(void)
{
  double s;
  s = (double)seed_verify_float;
  s *= R_a_float;
  s = fmod(s, R_m_float);
  seed_verify_float = (unsigned long)s;
  return seed_verify_float;
}

/* rnd_verify -- verify that rnd() returns the correct results
 *
 * depth = how much time to spend verifying
 * 0: very quick -- just verify the next rnd() value
 * 1: quick -- verify the first 10000 calls from seed = 1
 * 2: slow (~ 1 minute) -- run the fast generator for a full cycle
 * 3: very slow (several minutes) -- verify a full cycle
 */
void rnd_verify(int depth)
{
  unsigned long orig_seed = seed;
  unsigned long i;
  unsigned long r = 0;

  /* 0: the next value from rnd() matches rnd_verify_*() */
  if(depth >= 0) {
    seed_verify_schrage = seed;
    seed_verify_float = seed;
    r = rnd();
    Insist(rnd_verify_schrage() == r);
    Insist(rnd_verify_float() == r);
  }

  /* 1: first 10000 (from Park & Miller, note: 1-based indexing!) */
  if(depth >= 1) {
    i = 1;
    seed = 1;
    seed_verify_schrage = seed;
    seed_verify_float = seed;
    for(i = 2; i <= 10001; i += 1) {
      r = rnd();
      Insist(rnd_verify_schrage() == r);
      Insist(rnd_verify_float() == r);
    }
    /* Insist(r == 1043618065UL); -- correct value for a = 16807 */
    Insist(r == 399268537UL);  /* correct for a = 48271 */
  }

  /* 1: observe wrap-around (note: 0-based indexing) */
  if(depth >= 1) {
    /* set-up seed value for i = 2147483645 */
    /* seed = 1407677000UL; -- correct value for a = 16807 */
    seed = 1899818559UL;  /* correct for a = 48271 */
    seed_verify_schrage = seed;
    seed_verify_float = seed;
    r = rnd();
    Insist(rnd_verify_schrage() == r);
    Insist(rnd_verify_float() == r);
    Insist(r == 1);  /* wrap-around */
  }

  /* 2 & 3: Full cycle (3 => verifying each value) */
  if(depth >= 2) {
    int verify = (depth >= 3);
    unsigned long r1 = 1;

    i = 0;
    seed = 1;
    seed_verify_schrage = seed;
    seed_verify_float = seed;
    while(1) {
      i += 1;
      r = rnd();
      if(verify) {
        Insist(rnd_verify_schrage() == r);
        Insist(rnd_verify_float() == r);
      }
      if(r == 1) {
        printf("Full cycle complete%s:\n",
               verify ? " (verifying every value)"
                      : " (fast implementation only)" );
        printf("Wrapped at i=%lu, r=%lu, r(i-1)=%lu.\n",
               i, r, r1);
        break;
      } else {
        r1 = r;
      }
    }
  }

  seed = orig_seed;
}

/* rnd_addr -- a random address generator
 *
 * rnd gives 31 random bits, we run it repeatedly to get enough bits.
 */

#define ADDR_BITS (sizeof(mps_addr_t) * CHAR_BIT)

mps_addr_t rnd_addr(void)
{
  mps_word_t res = 0;
  unsigned bits;

  for (bits = 0; bits < ADDR_BITS; bits += 31)
    res = res << 31 | (mps_word_t)rnd();
  return (mps_addr_t)res;
}

double rnd_double(void)
{
  return (double)rnd() / R_m_float;
}

static unsigned sizelog2(size_t size)
{
  return (unsigned)(log((double)size) / log(2.0));
}

size_t rnd_grain(size_t arena_size)
{
  /* The grain size must be small enough to allow for a complete set
     of zones in the initial chunk, but bigger than one word. */
  Insist(arena_size >> MPS_WORD_SHIFT >= sizeof(void *));
  return rnd_align(sizeof(void *), (size_t)1 << sizelog2(arena_size >> MPS_WORD_SHIFT));
}

size_t rnd_align(size_t min, size_t max)
{
  unsigned log2min = sizelog2(min);
  unsigned log2max = sizelog2(max);
  Insist(min <= max);
  Insist((size_t)1 << log2min == min);
  Insist((size_t)1 << log2max == max);
  if (log2min < log2max)
    return min << (rnd() % (log2max - log2min + 1));
  else
    return min;
}

double rnd_pause_time(void)
{
  double t = rnd_double();
  if (t == 0.0)
    return HUGE_VAL; /* Would prefer to use INFINITY but it's not in C89. */
  else
    return 1 / t - 1;
}

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
 * function:
 *
 * 1. before RHSK got his hands on rnd(), ie. pre-2008.  These seed
 *    values are not currently supported, but it might be easy to
 *    add support.
 *
 * 2. v2 states: the published "seed" (state) value was the seed
 *    *before* the 10 rnds to churn up and separate nearby values
 *    from time().  This was unfortunate: you can't write a rnd_state
 *    getter, because it would have to go 10 steps backwards, and
 *    that's impossible.
 *    (2008..2010-03-22)
 *
 * 3. v3 states: the published state is the state *after* all
 *    initialization is complete. Therefore you can easily store and
 *    re-use the published state. (From 2010-03-22, changelist
 *    170093).
 */

void randomize(int argc, char *argv[])
{
  int n;
  unsigned long seed0;

  if (argc > 1) {
    n = sscanf(argv[1], "%lu", &seed0);
    Insist(n == 1);
    printf("%s: randomize(): resetting initial state (v3) to: %lu.\n",
           argv[0], seed0);
    rnd_state_set(seed0);
  } else {
    seed0 = rnd_seed();
    printf("%s: randomize(): choosing initial state (v3): %lu.\n",
           argv[0], seed0);
    rnd_state_set(seed0);
  }
  (void)fflush(stdout); /* ensure seed is not lost in case of failure */
}

unsigned long rnd_state(void)
{
  return seed;
}

void rnd_state_set(unsigned long seed0)
{
  Insist(seed0 < R_m);
  Insist(seed0 != 0);
  seed = seed0;

  rnd_verify(0);
  Insist(seed == seed0);
}

/* rnd_state_set_2 -- legacy support for v2 rnd states
 *
 * In v2, the published "seed" (state) value was the seed *before*
 * the 10 rnds to churn up and separate nearby values from time().
 *
 * Set the seed, then convert it to a v3 state by doing those 10 rnds.
 */
void rnd_state_set_v2(unsigned long seed0_v2)
{
  int i;
  unsigned long seed0;

  rnd_state_set(seed0_v2);
  for(i = 0; i < 10; i += 1) {
    (void)rnd();
  }

  seed0 = rnd_state();
  printf("rnd_state_set_v2(): seed0_v2 = %lu, converted to state_v3 = %lu.\n", seed0_v2, seed0);
  rnd_state_set(seed0);
}


/* res_strings -- human readable MPS result codes */

static struct {
  const char *ident;
  const char *doc;
} const res_strings[] = {
#define RES_STRINGS_ROW(X, ident, doc) {#ident, doc},
  _mps_RES_ENUM(RES_STRINGS_ROW, X)
};


/* verror -- die with message */

ATTRIBUTE_FORMAT((printf, 1, 0))
void verror(const char *format, va_list args)
{
  (void)fflush(stdout); /* synchronize */
  (void)vfprintf(stderr, format, args);
  (void)fprintf(stderr, "\n");
  (void)fflush(stderr); /* make sure the message is output */
  mps_telemetry_flush();
  /* On Windows, the abort signal pops up a dialog box. This suspends
   * the test suite until a button is pressed, which is not acceptable
   * for offline testing, so if the MPS_TESTLIB_NOABORT environment
   * variable is set, then the test case exits instead of aborting.
   */
  if (getenv("MPS_TESTLIB_NOABORT")) {
    exit(EXIT_FAILURE);
  } else {
    abort();
  }
}


/* error -- die with message */

ATTRIBUTE_FORMAT((printf, 1, 2))
void error(const char *format, ...)
{
 va_list args;

 va_start(args, format);
 verror(format, args);
 /* va_end(args); */ /* provokes "unreachable code" error from MSVC */
}


/* die_expect -- Test a return code, and exit on unexpected result */

void die_expect(mps_res_t res, mps_res_t expected, const char *s)
{
  if (res != expected) {
    if (0 <= res && (unsigned)res < NELEMS(res_strings))
      error("\n%s: %s: %s\n", s, res_strings[res].ident, res_strings[res].doc);
    else
      error("\n%s: %d: unknown result code\n", s, res);
  }
}


/* die -- Test a return code, and exit on error */

void die(mps_res_t res, const char *s)
{
  die_expect(res, MPS_RES_OK, s);
}


/* cdie -- Test a C boolean, and exit on error */

void cdie(int res, const char *s)
{
  if (!res) {
    error("\n%s: %d\n", s, res);
  }
}


/* assert_die -- always die on assertion */

void assert_die(const char *file, unsigned line, const char *condition)
{
  error("%s:%u: MPS ASSERTION FAILED: %s\n", file, line, condition);
}


/* testlib_init -- install assertion handler and seed RNG */

void testlib_init(int argc, char *argv[])
{
  (void)mps_lib_assert_fail_install(assert_die);
  randomize(argc, argv);
}


/* C. COPYRIGHT AND LICENSE
 *
 * Copyright (C) 2001-2020 Ravenbrook Limited <https://www.ravenbrook.com/>.
 *
 * 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.
 *
 * 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 AND FITNESS FOR A
 * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * HOLDER OR 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.
 */