93 lines
2.9 KiB
OpenEdge ABL
93 lines
2.9 KiB
OpenEdge ABL
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*)
|