-- RT_C132A5A1 : Lecture des 20 premieres valeurs
--               du GPA Mersenne Twister
-- Adaptation from Adrian Hoe 2002
-- Coyright Jacques-Deric Rouault
-- Version 1.1 du 20120305
              
WITH Text_io, Interfaces, Unchecked_Deallocation;
USE  Text_io, Interfaces;

PROCEDURE RT_C132A5A1 IS
      
  PACKAGE  IIO IS NEW Integer_io (Integer);
  PACKAGE  FIO IS NEW Float_io (Float);
  
  -- Types et variables
  n : CONSTANT := 624;                   -- Length of state vector
  m : CONSTANT := 397;                   -- Period parameter
  invalid : CONSTANT := n+1;
  
  Upper_Mask   : CONSTANT := 16#80000000#;          -- Most significant w-r bits
  Lower_Mask   : CONSTANT := 16#7FFFFFFF#;          -- Least significant r bits
  
  TYPE vector        IS ARRAY (Integer RANGE <>) OF Unsigned_32;
  TYPE access_vector IS ACCESS vector;
  
  TYPE state_record IS RECORD
    vector_n  : vector (0..n);
    condition : Integer := invalid;
  END RECORD;

  TYPE generator IS RECORD
    state  : state_record;
    seed   : Unsigned_32 := 19_650_218;
    keys   : access_vector;
  END RECORD;

  TYPE access_generator IS ACCESS ALL generator;
  TYPE access_state     IS ACCESS ALL state_record;
    
  g    : generator;
  keys : access_vector := NEW vector (1 .. 4);
  
  val : Float;
  probleme : EXCEPTION;

   -----------------------------------------------------------------------------
   
   PROCEDURE init_by_seed (g : IN generator) IS
   
      state : access_state   := g.state'Unrestricted_Access;
      
   BEGIN
   
      state.vector_n (0) := g.seed AND 16#FFFFFFFF#;
      FOR i IN 1..N LOOP
         state.vector_n (i) := (1_812_433_253 * (state.vector_n(i-1) XOR 
           Shift_Right (state.vector_n(i-1), 30)) + Unsigned_32(i));
         state.vector_n (i) := state.vector_n(i) AND 16#FFFFFFFF#;
         state.condition := i;
      END LOOP;
      
   END init_by_seed;

   -----------------------------------------------------------------------------
   
   PROCEDURE init_by_keys (g : IN generator) IS
   
      state      : access_state := g.state'Unrestricted_Access;
      i          : Integer := 1;
      j          : Integer := 0;
      k, l       : Integer;
      key_length : Integer;
      
   BEGIN
   
      init_by_seed (g);

      IF g.keys /= NULL THEN
      
         k := g.keys'First;

         IF    g.keys'First=0 THEN key_length := g.keys'Last + 1;
         ELSIF g.keys'First>0 THEN key_length := g.keys'Last;
         END IF;

         IF n>key_length THEN l := n; ELSE l := key_length; END IF;

         FOR x IN REVERSE 1..l LOOP
            state.vector_n(i):=(state.vector_n(i) XOR ((state.vector_n(i-1) XOR 
              Shift_Right(state.vector_n(i-1),30)) * 1_664_525)) + g.keys (j+k) + Unsigned_32(j);
            state.vector_n(i):= state.vector_n(i) AND 16#FFFFFFFF#;
            i := i + 1;
            j := j + 1;
            IF i>=n THEN state.vector_n(0) := state.vector_n(n-1); i:=1; END IF;
            IF j>=key_length THEN j:=0; END IF;
         END LOOP;

         FOR x IN REVERSE 1..n-1 LOOP
            state.vector_n(i):= (state.vector_n(i) XOR ((state.vector_n(i-1) XOR 
              Shift_Right (state.vector_n(i-1),30)) * 1_566_083_941)) - Unsigned_32 (i);
            i := i + 1;
            IF i>=n THEN state.vector_n(0) := state.vector_n(n-1); i := 1; END IF;
         END LOOP;

         state.vector_n(0) := Upper_Mask;
      END IF; 
      
   END init_by_keys;

   -----------------------------------------------------------------------------
   
   PROCEDURE reset (g : IN generator; new_keys : IN access_vector) IS
   
     gen : access_generator := g'Unrestricted_Access;
  
     PROCEDURE free IS NEW Unchecked_Deallocation (vector, access_vector);
      
   BEGIN
   
      free (gen.keys);
      gen.keys := new_keys;
      init_by_keys (g);
      
   END reset;
   
-----------------------------------------------------------------------------

   FUNCTION mersenne_twister (g : IN Generator) RETURN Float IS
  --  Version 1.1 du 5 Mars 2012
  --  Adapte de Adrian Hoe 2002
    
    state : access_state := g.state'Unrestricted_Access;
    s     : Unsigned_32;
    TYPE flt IS DIGITS 14;
      
   -----------------------------------------------------------------------------
   
   FUNCTION magic (s : in Unsigned_32) RETURN Unsigned_32 IS
   
     ss : Unsigned_32 := s AND 16#1#;
      
   BEGIN
   
     IF SS = 1 THEN RETURN 16#9908B0DF#;
               ELSE RETURN 0;
     END IF;
      
   END magic;

   -----------------------------------------------------------------------------
      
   BEGIN
   
      IF state.condition>=n THEN
         IF state.condition = invalid THEN
--            Reset (G);
           RAISE probleme;
         END IF;

         FOR j IN 0..(n-m-1) LOOP
            s := (state.vector_n(j) and upper_mask) OR (state.vector_n(j+1) and lower_mask);
            state.vector_n(j) := state.vector_n(j+m) XOR Shift_Right (s,1) XOR magic(s);
         END LOOP;

         FOR j IN 227..(n-2) LOOP
            s := (state.vector_n(j) AND Upper_Mask) OR (state.vector_n(j+1) AND lower_mask);
            state.vector_n(j) := state.vector_n (j+(m-n)) XOR Shift_Right (s,1) XOR magic(s);
         END LOOP;

         s := (state.vector_n(n-1) AND upper_mask) OR (state.vector_n(0) AND lower_mask);
         state.vector_n(n-1) := state.vector_n(m-1) XOR Shift_Right (s,1) XOR magic(s);
         state.condition := 0;
      END IF;

      s := state.vector_n(state.condition);
      state.condition := state.condition+1;

      s := s XOR  Shift_Right(S,11);
      s := s XOR (Shift_Left (S, 7) AND 16#9D2C5680#);
      s := s XOR (Shift_Left (S,15) AND 16#EFC60000#);
      s := s XOR  Shift_Right(S,18);

    RETURN Float ((flt (Unsigned_32'(s)) + 0.5) * (1.0 / 4_294_967_296.0));

  END mersenne_twister;

------------------------------------------------------------------------------
  
BEGIN

  keys.all := (16#123#, 16#234#, 16#345#, 16#456#);
  reset (g, keys);

  Put_line ("Debut d'execution du programme Ada RT_C132A5A1");
  
  FOR n IN 1..20 LOOP
    val:=mersenne_twister(g);
    iio.put (n,4);
    put (" - ");
    fio.put (val,3,7,0); 
    new_line;  
  END LOOP;  
  
  Put_line ("Fin   d'execution du programme Ada RT_C132A5A1");
  
  EXCEPTION
    WHEN probleme =>
      Put_line ("ERREUR : PROBLEME CALCUL Generateur_Pseudo_Aleatoire");
  
END RT_C132A5A1;