/* 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;