Listing: 1 (*# check(stack=>off, 2 index=>off, 3 range=>off, 4 overflow=>off, 5 nil_ptr=>off) *) 6 IMPLEMENTATION MODULE Rand; 7 (******************************************************************************) 8 (* Modify by John McMonagle 4/19/88 *) 9 (* MODULA-2 Library *) 10 (* *) 11 (* LOGITECH SA, CH-1111 Romanel (Switzerland) *) 12 (* LOGITECH Inc, Fremont, CA 94555 (USA) *) 13 (* *) 14 (* Module : Random, random number generator *) 15 (* *) 16 (* Release : 3.0 - July 87 *) 17 (* *) 18 (* Copyright (C) 1987 Logitech, All rights reserved *) 19 (* *) 20 (* Permission is hereby granted to registered users to use or abstract *) 21 (* the following program in the implementation of customized versions. *) 22 (* This permission does not include the right to redistribute the *) 23 (* source code of this program. *) 24 (* *) 25 (******************************************************************************) 26 27 (*---------------------------------------------------------------------------- 28 Algorithm: Additive congruential method (D.Knuth) 29 ----------------------------------------------------------------------------*) 30 (*/NOCHECK:O *) 31 FROM EnvironUtils IMPORT 32 GetTime; 33 FROM NumTypes IMPORT 34 Real8; 35 36 CONST 37 C = 53;(* was54 *) 38 R = 65536.0; 39 40 VAR 41 a : ARRAY [0 .. C] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 42 j, k : [0 .. C]; ***** ^ not supported yet 43 44 45 PROCEDURE Next (): CARDINAL; 46 BEGIN 47 INC(a [k], a [j]); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 49 IF k = 0 THEN ***** ^ not supported yet 50 k := C; ***** ^ not supported yet 51 ELSE 52 DEC(k); ***** ^ undeclared identifier ***** ^ not supported yet 53 END; 54 IF j = 0 THEN ***** ^ not supported yet 55 j := C; ***** ^ not supported yet 56 ELSE 57 DEC(j); ***** ^ undeclared identifier ***** ^ not supported yet 58 END; 59 60 RETURN a [k]; ***** ^ not supported yet ***** ^ not supported yet 61 END Next; ***** ^ not supported yet 62 63 PROCEDURE RandomInit (seed : CARDINAL); 64 VAR 65 i, dummy : CARDINAL; 66 BEGIN 67 j := 23;(* was 24 *) ***** ^ not supported yet 68 k := 0; ***** ^ not supported yet 69 FOR i := 0 TO C DO 70 a [i] := 0; ***** ^ not supported yet ***** ^ not supported yet 71 END; 72 a [k] := 31415 + seed; ***** ^ not supported yet ***** ^ not supported yet 73 IF a [k] = 0 THEN ***** ^ not supported yet ***** ^ not supported yet 74 a [k] := 31415; ***** ^ not supported yet ***** ^ not supported yet 75 END; 76 (* added 4/19/88 make sure seed is odd or all will be even *) 77 IF NOT ODD(a[k]) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 78 THEN 79 INC(a[k]); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 80 END; 81 FOR i := 0 TO 1219 DO(* was 1999 reduced as precision is not required *) 82 dummy := Next (); ***** ^ not supported yet ***** ^ not supported yet 83 END; 84 END RandomInit; ***** ^ not supported yet 85 86 PROCEDURE RandomCard (bound : CARDINAL): CARDINAL; 87 BEGIN 88 IF bound = 0 THEN 89 RETURN Next (); ***** ^ not supported yet ***** ^ not supported yet 90 ELSE 91 RETURN Next() MOD bound; ***** ^ not supported yet ***** ^ not supported yet 92 (* RETURN TRUNC (FLOAT (bound) * FLOAT (Next ()) / R); *) 93 END; 94 END RandomCard; ***** ^ not supported yet 95 96 PROCEDURE RandomInt (bound : INTEGER): INTEGER; 97 BEGIN 98 RETURN INTEGER (RandomCard (CARDINAL (ABS (bound)))); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 99 END RandomInt; ***** ^ not supported yet 100 (* 101 PROCEDURE RandomReal () : Real8; 102 BEGIN 103 RETURN VAL(Real8,RandomCard (10000)) * 1.0E-16 + 104 VAL(Real8,RandomCard (10000)) * 1.0E-12 + 105 VAL(Real8,RandomCard (10000)) * 1.0E-08 + 106 VAL(Real8,RandomCard (10000)) * 1.0E-04; 107 END RandomReal; 108 109 *) 110 PROCEDURE Randomize; 111 VAR 112 minute,second,hundredths, 113 i, j : CARDINAL; 114 dummy: CARDINAL; 115 str: ARRAY[0..40] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 116 BEGIN 117 GetTime(dummy,minute,second,hundredths,str); ***** ^ not supported yet ***** ^ not supported yet 118 RandomInit (hundredths*second); ***** ^ not supported yet ***** ^ not supported yet 119 j := minute; 120 FOR i := 0 TO j DO 121 dummy := Next (); ***** ^ not supported yet ***** ^ not supported yet 122 END; 123 END Randomize; ***** ^ not supported yet 124 125 126 BEGIN 127 Randomize; ***** ^ not supported yet 128 (* FOR j:=0 TO C DO 129 a[j]:=0; 130 END; 131 j:=0; 132 k:=0; *) 133 END Rand. ***** ^ not supported yet 58 errors