| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197 |
- 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
|