------------------------------------------------------------------------------
--                                                                          --
--                         GNAT RUNTIME COMPONENTS                          --
--                                                                          --
--                  A D A . N U M E R I C S _ R A N D O M                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.2 $                              --
--                                                                          --
--           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
--                                                                          --
------------------------------------------------------------------------------

--  This implementation is derived from LSN 1055 written by Ken Dritz.

with Calendar; use Calendar;
with Unchecked_Deallocation;

package body Ada.Numerics.Random_Numbers is

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Destroy_State is
      new Unchecked_Deallocation (Internal_State, Access_State);

   function Make_Internal_State (Starter : Integer) return Internal_State;
   --  This function is used in this implementation to produce a valid
   --  internal state for the Fibonacci generator based on an integer
   --  that is a valid internal state for a linear congruential generator
   --  It uses the latter to generate random bits with which to initialize
   --  the state vector.

   -------------------------
   -- Make_Internal_State --
   -------------------------

   function Make_Internal_State (Starter : Integer) return Internal_State is
      Bit_Value      : Float;
      T              : State_Vector;
      LCG_State      : Float;
      LCG_Multiplier : constant := 16_807.0;
      LCG_Modulus    : constant := 2_147_483_647.0;

      function LCG_Random return Uniformly_Distributed is
         T : Float;
         I : Integer;

      begin
         T := LCG_State * LCG_Multiplier;
         I := Integer (T / LCG_Modulus);
         LCG_State := T - Float (I) * LCG_Modulus;

         if LCG_State < 0.0 then
            LCG_State := LCG_State + LCG_Modulus;
         end if;

         return LCG_State / LCG_Modulus;
      end LCG_Random;

   --  Start of processing for Make_Internal_State

   begin
      LCG_State := Float (Starter);

      for I in Lag_Range loop
         T (I) := 0.0;
         Bit_Value := 1.0;

         for J in 1 .. 24 loop
            Bit_Value := Bit_Value * 0.5;

            if LCG_Random >= 0.5 then
               T (I) := T (I) + Bit_Value;
            end if;
         end loop;
      end loop;

      return (Lagged_Outputs => T,
              Borrow         => 0.0,  -- arbitrary
              R              => Larger_Lag - 1,
              S              => Smaller_Lag - 1);
   end Make_Internal_State;

   ------------
   -- Random --
   ------------

   function Random (Gen : Generator) return Uniformly_Distributed is
      U : Float;

   begin
      U := Gen.State.Lagged_Outputs (Gen.State.R) -
           Gen.State.Lagged_Outputs (Gen.State.S) -
           Gen.State.Borrow;

      if U < 0.0 then
         U := U + 1.0;
         Gen.State.Borrow := 2#1.0#e-24;
      else
         Gen.State.Borrow := 0.0;
      end if;

      Gen.State.Lagged_Outputs (Gen.State.R) := U;
      Gen.State.R := Gen.State.R - 1;
      Gen.State.S := Gen.State.S - 1;
      return U;
   end Random;

   --------------------
   -- Random_Integer --
   --------------------

   function Random_Integer
     (Gen       : Generator;
      Low, High : Integer)
      return    Integer
   is
      Spread : constant Positive := High - Low + 1;
      --  Propagate Constraint_Error if overflow or if Low > High.

   begin
      return Low + Integer (Float (Spread) * Random (Gen)) mod Spread;
   end Random_Integer;

   -----------
   -- Reset --
   -----------

   procedure Reset (Gen : in Generator; Initiator : in Integer) is
   begin
      Gen.State.all :=
        Make_Internal_State (Initiator mod 2_147_483_646 + 1);
   end Reset;

   procedure Reset (Gen : in Generator) is
      Yr  : Year_Number;
      Mo  : Month_Number;
      Dy  : Day_Number;
      Se  : Day_Duration;
      S   : Natural range 0 .. 86_400;
      Sec : Natural range 0 .. 59;
      Min : Natural range 0 .. 59;
      Hr  : Natural range 0 .. 23;
      T   : Natural;

   begin
      Split (Clock, Yr, Mo, Dy, Se);
      S   := Natural (Se);
      Sec := S mod 60;
      S   := S / 60;
      Min := S mod 60;
      Hr  := S / 60;
      T   := ((((Sec * 60 + Min) * 24 + Hr) * 32 + Dy) * 13 + Mo) * 50 +
             (Yr mod 50) + 26_000_000;
      Gen.State.all := Make_Internal_State (T);
   end Reset;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (Gen : in out Generator) is
   begin
      Destroy_State (Gen.State);
   end Finalize;

--  Package initialization initializes Initial_State

begin

   Initial_State := Make_Internal_State (30_000_000);

end Ada.Numerics.Random_Numbers;
