/* Copyright (c) 1995 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */
/* Structured Programming". Permission is given to reproduce and to use these procedures */
/* as part of a program, and to include them as part of a larger work to be sold for profit. */
/* However, the user is not permitted to sell the procedures separately. Provided always */
/* that these procedures and this copyright notice are reproduced in full. */
DECLARE RANDOM GENERIC (
RANDOM0 WHEN ( ),
RANDOM1 WHEN (*) );
/* The function RANDOM0 with no arguments is called when it is desired to generate */
/* a sequence of random numbers. Each call on RANDOM0 generates one random number. */
/* A default seed of 1 is used when RANDOM0 is called without first calling RANDOM1. */
/* When it is desired to reset the random number generator, or to specify a particular */
/* seed for the first call, RANDOM1 should be called with one argument. */
/* To generate random numbers that are different for each run, we suggest first */
/* calling generic procedure RANDOM using a seed derived from the built-in function */
/* TIME. e.g. R = RANDOM(TIME( ) ); and thereafter calling RANDOM with no arguments. */
RANDOM0:
PROCEDURE RETURNS (FLOAT BINARY (53) );
DECLARE R_Seed EXTERNAL STATIC FIXED BINARY (31) INITIAL (1);
RETURN (RANDOM(R_Seed));
END RANDOM0;
/* GIVEN AN INTEGER PRIMER, THIS FUNCTION RETURNS A RANDOM NUMBER */
/* IN THE RANGE 0 < RANDOM NUMBER < 1.0 */
(NOSIZE, NOFIXEDOVERFLOW):
RANDOM1:
PROCEDURE (SEED) RETURNS (FLOAT BINARY (53));
DECLARE SEED FIXED BINARY (31);
DECLARE R_Seed EXTERNAL STATIC FIXED BINARY (31) INITIAL (1);
DECLARE (UNSPEC, ABS) BUILTIN;
DECLARE CHOPPER FIXED BINARY (31) STATIC INITIAL (2147483647);
/* OUTGOING: SEED = A new seed computed from the incoming value, */
/* ready for the next invocation. */
IF SEED <= 0 THEN SIGNAL ERROR;
IF SEED >= 2147483646 THEN SIGNAL ERROR; /* For compatability with OS/2 version. */
SEED = SEED * 5 - 3;
IF SEED < 0 THEN
SEED = (SEED + CHOPPER) + 1; /* To strip the most significant bit. */
IF SEED < 0 THEN /* Just in case our machine has > 32-bit words */
UNSPEC (SEED) = UNSPEC (SEED) & UNSPEC (CHOPPER);
IF SEED < 0 THEN
SEED = ABS(SEED); /* Machine has < 32-bit words. */
R_Seed = SEED; /* Save the seed for the next call on RAMDOM. */
RETURN (SEED/2147483648E0);
END RANDOM1;