65300 #include "rundecs.h"
65310    (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
65320 (**)
65330 PROCEDURE ERRORR(N: INTEGER);EXTERN;
65340 PROCEDURE GARBAGE(ANOBJECT: OBJECTP);EXTERN;
65350 FUNCTION SAFEACCESS(LOCATION: OBJECTP): UNDRESSP; EXTERN;
65360 (**)
65370 (**)
65380 FUNCTION RAND(VAR SEED: INTEGER): REAL;
65390   CONST
65400 (*+11()
65410       MULTIPLIER=16777215;
65420       PRIMEMODULUS=281474976710597;
65430       (*N=48, L=24, M=24*)
65440       TWOL=16777216;
65450       TWOM=16777216;
65460       PRIMEDIFF=59; (*2^N - PRIMEMODULUS*)
65470       SHRINKER=4614343880501.61;
65480       STRETCHER=4614343880502.55;
65490 ()+11*)
65500 (*+12()
65510       MULTIPLIER=176;
65520       PRIMEMODULUS=32749;
65530       (*N=15, L=7, M=8*)
65540       TWOL=128;
65550       TWOM=256;
65560       PRIMEDIFF=19; (*2^N - PRIMEMODULUS*)
65570       SHRINKER=1560.381;
65580       STRETCHER=1559.381;
65590 ()+12*)
65600 (*+13()
65610       MULTIPLIER=46340;
65620       PRIMEMODULUS=2147483647;
65630       (*N=31, L=15, M=16*)
65640       TWOL=32768;
65650       TWOM=65536;
65660       PRIMEDIFF=1; (*2^N - PRIMEMODULUS*)
65670       SHRINKER=715827882.334;
65680       STRETCHER=715827881.667;
65690 ()+13*)
65700   VAR HIBITS,MIDBITS,LOBITS: INTEGER;
65710       LSHALFOFRAND: REAL;
65720     BEGIN
65730     SEED := SEED+(1-TRUNC(SEED/SHRINKER));
65740     LSHALFOFRAND := SEED/PRIMEMODULUS;
65750     LSHALFOFRAND := LSHALFOFRAND/PRIMEMODULUS;
65760     LOBITS := SEED MOD TWOL * MULTIPLIER;
65770     MIDBITS := (SEED DIV TWOL - TWOL)*MULTIPLIER + LOBITS DIV TWOL;
65780     IF MIDBITS>=0 THEN
65790       BEGIN
65800       HIBITS := MIDBITS DIV TWOM;
65810       MIDBITS := MIDBITS MOD TWOM + MULTIPLIER*TWOL;
65820       END
65830     ELSE
65840       BEGIN
65850       HIBITS := (MIDBITS+1) DIV TWOM -1;
65860       MIDBITS := MIDBITS MOD TWOM;
65870       MIDBITS := MIDBITS + ORD(MIDBITS<0)*TWOM + MULTIPLIER*TWOL;
65880                  (*IN CASE PASCAL COMPILER DOES NOT IMPLEMENT MOD CORRECTLY*)
65890       END;
65900     HIBITS := HIBITS + MIDBITS DIV TWOM;
65910     MIDBITS := MIDBITS MOD TWOM;
65920     LOBITS := LOBITS MOD TWOL + MIDBITS*TWOL;
65930     SEED := LOBITS - PRIMEMODULUS + HIBITS*PRIMEDIFF;
65940     IF SEED<0 THEN SEED := SEED + PRIMEMODULUS;
65950     RAND := SEED/PRIMEMODULUS+LSHALFOFRAND;
65960     SEED := SEED+TRUNC((SEED-1)/STRETCHER)-1
65970     END;
65980 (**)
65990 (**)
66000 FUNCTION RANDOM: REAL;
66010     BEGIN
66020     RANDOM := RAND(LASTRANDOM)
66030     END;
66040 (**)
66050 (**)
66060 FUNCTION NEXTRAN(SEEDP: OBJECTP): REAL;
66070   VAR PTR: UNDRESSP;
66080     BEGIN
66090     PTR := SAFEACCESS(SEEDP);
66100     NEXTRAN := RAND(PTR^.FIRSTWORD);
66110     IF FPTST(SEEDP^) THEN GARBAGE(SEEDP);
66120     END;
66130 (**)
66140 (**)
66150 (*-02()
66160 BEGIN (* OF A68 *)
66170 END (* OF A68 *);
66180 ()-02*)
66190 (*+01()
66200 BEGIN (* OF MAIN PROGRAM  *)
66210 END (* OF MAIN PROGRAM  *).
66220 ()+01*)