raw
mt_prng                 1  -- Ada implementation of the Mersenne Twister Pseudo-Random number generator
mt_prng                 2  -- S.MG, 2018
mt_prng                 3 
mt_prng                 4 
mt_prng                 5 package body MT is
mt_prng                 6 
mt_prng                 7   procedure Init_Genrand(Seed : in U32) is
mt_prng                 8   begin
mt_prng                 9     State(0) := Seed;
mt_prng                10     for I in State'First + 1 .. State'Last loop
mt_prng                11       State(I) := U32(1812433253) *
mt_prng                12                   ( State(I - 1) xor 
mt_prng                13                     ( Shift_Right(State(I - 1), 30) ) 
mt_prng                14                   ) + U32(I) ;
mt_prng                15     end loop;
mt_prng                16     Mti_Flag := N;
mt_prng                17   end Init_Genrand;
mt_prng                18 
mt_prng                19   procedure Init_Genrand(Seed : in Init_Array_Type) is
mt_prng                20     Default_Seed: constant U32 := U32(19650218); -- magic value!
mt_prng                21     I, J, K : Integer;
mt_prng                22   begin
mt_prng                23     Init_Genrand(Default_Seed);
mt_prng                24     I := 1;
mt_prng                25     J := 0;
mt_prng                26     if N > Seed'Length then
mt_prng                27       K := N;
mt_prng                28     else
mt_prng                29       K := Seed'Length;
mt_prng                30     end if;
mt_prng                31 
mt_prng                32     while K > 0 loop
mt_prng                33       State(I) := (State(I) xor 
mt_prng                34                   ( (State(I-1) xor 
mt_prng                35                      Shift_Right(State(I-1), 30)
mt_prng                36                     ) * U32(1664525)
mt_prng                37                   )) + Seed(J) + U32(J);
mt_prng                38       I := I + 1;
mt_prng                39       J := J + 1;
mt_prng                40       if I >= N then
mt_prng                41         State(0) := State(N-1);
mt_prng                42         I := 1;
mt_prng                43       end if;
mt_prng                44       if J >= Seed'Length then
mt_prng                45         J := 0;
mt_prng                46       end if;
mt_prng                47       K := K - 1;               
mt_prng                48     end loop;
mt_prng                49 
mt_prng                50     K := N -1;
mt_prng                51     while K > 0 loop
mt_prng                52       State(I) := (State(I) xor 
mt_prng                53                   ( (State(I-1) xor 
mt_prng                54                      Shift_Right(State(I-1), 30)
mt_prng                55                     ) * U32(1566083941)
mt_prng                56                   )) - U32(I); 
mt_prng                57       I := I + 1;
mt_prng                58       if I >= N then
mt_prng                59         State(0) := State(N-1);
mt_prng                60         I := 1;
mt_prng                61       end if;     
mt_prng                62       K := K - 1;
mt_prng                63     end loop;
mt_prng                64     State(0) := 16#8000_0000#; -- MSB is 1 to ensure non-zero initial state
mt_prng                65   end Init_Genrand;
mt_prng                66 
mt_prng                67   function Gen_U32 return U32 is
mt_prng                68     Y     : U32;
mt_prng                69     MASK1 : constant U32 := U32(1);
mt_prng                70     Mag01 : Array ( 0 .. 1 ) of U32;
mt_prng                71   begin
mt_prng                72     -- Mag01[x] is x * Matrix_A of the algorithm for x 0 or 1
mt_prng                73     Mag01(0) := U32(0);
mt_prng                74     Mag01(1) := MATRIX_MASK;
mt_prng                75 
mt_prng                76     -- if no numbers available, generate another set of N words
mt_prng                77     if Mti_Flag >= N then
mt_prng                78 
mt_prng                79       -- check it's not a non-initialised generator
mt_prng                80       if Mti_Flag = (N + 1) then
mt_prng                81          -- Generator was NOT initialised!
mt_prng                82          -- Original C code initialises with default seed 5489
mt_prng                83          -- This code will simply raise exception and abort
mt_prng                84          raise No_Init_Exception;
mt_prng                85       end if;
mt_prng                86 
mt_prng                87       for K in 0 .. N - M - 1 loop
mt_prng                88         Y := ( State(K)   and UPPER_MASK ) or
mt_prng                89              ( State(K+1) and LOWER_MASK );
mt_prng                90         State(K) := State(K+M) xor 
mt_prng                91                       Shift_Right(Y, 1) xor 
mt_prng                92                         Mag01(Integer(Y and MASK1));
mt_prng                93       end loop;
mt_prng                94       for K in N-M .. N - 2 loop
mt_prng                95         Y := ( State(K)   and UPPER_MASK  ) or
mt_prng                96              ( State(K+1) and LOWER_MASK);
mt_prng                97         State(K) := State(K + M - N) xor
mt_prng                98                       Shift_Right(Y, 1) xor 
mt_prng                99                         Mag01(Integer(Y and MASK1));
mt_prng               100       end loop;
mt_prng               101       Y := (State(N-1) and UPPER_MASK ) or
mt_prng               102              (State(0) and LOWER_MASK );
mt_prng               103       State(N - 1) := State(M-1) xor 
mt_prng               104                         Shift_Right(Y, 1) xor
mt_prng               105                           Mag01(Integer(Y and MASK1));
mt_prng               106       Mti_Flag := 0;
mt_prng               107     end if;
mt_prng               108 
mt_prng               109     -- retrieve next available number
mt_prng               110     Y        := State(Integer(Mti_Flag));
mt_prng               111     Mti_Flag := Mti_Flag + 1;
mt_prng               112 
mt_prng               113     -- tempering
mt_prng               114     Y := Y xor Shift_Right(Y, 11);
mt_prng               115     Y := Y xor (Shift_Left(Y, 7) and 16#9d2c_5680#);
mt_prng               116     Y := Y xor (Shift_Left(Y, 15) and 16#efc6_0000#);
mt_prng               117     Y := Y xor Shift_Right(Y, 18);
mt_prng               118 
mt_prng               119     -- return tempered number
mt_prng               120     return Y;
mt_prng               121   end Gen_U32;
mt_prng               122 
mt_prng               123   function Get_State return State_Type is
mt_prng               124   begin
mt_prng               125     return State;
mt_prng               126   end Get_State;
mt_prng               127 
mt_prng               128 end MT;