+2010-06-22 Robert Dewar <dewar@adacore.com>
+
+ * freeze.adb: Minor reformatting
+ Minor code reorganization (use Nkind_In and Ekind_In).
+
+2010-06-22 Bob Duff <duff@adacore.com>
+
+ * gnat1drv.adb (Gnat1drv): Remove the messages that recommend using
+ -gnatc when a file is compiled that we cannot generate code for, not
+ helpful and confusing.
+
+2010-06-22 Vincent Celier <celier@adacore.com>
+
+ * switch-m.adb (Normalize_Compiler_Switches): Process correctly
+ switches -gnatknn.
+
+2010-06-22 Paul Hilfinger <hilfinger@adacore.com>
+
+ * s-rannum.adb: Replace constants with commented symbols.
+ * s-rannum.ads: Explain significance of the initial value of the data
+ structure.
+
+2010-06-22 Ed Schonberg <schonberg@adacore.com>
+
+ * a-ngcoty.adb: Clarify comment.
+
+2010-06-22 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_pakd.adb (Expand_Bit_Packed_Element_Set): Return without
+ expansion for indexing packed arrays with small power-of-2 component
+ sizes when the target is AAMP.
+ (Expand_Packed_Element_Reference): Return without expansion for
+ indexing packed arrays with small power-of-2 component sizes when the
+ target is AAMP.
+
+2010-06-22 Geert Bosch <bosch@adacore.com>
+
+ * exp_ch4.adb (Expand_N_In): Do not substitute a valid check for X in
+ Float'Range.
+
+2010-06-22 Robert Dewar <dewar@adacore.com>
+
+ * g-mbdira.adb, g-mbflra.adb, a-nuflra.adb, a-nudira.adb: Minor comment
+ updates.
+
2010-06-22 Doug Rupp <rupp@adacore.com>
* system-vms.ads, system-vms-zcx.ads: Remove old unused VMS system
if not Standard'Fast_Math then
- -- ??? the test below is weird, it needs a comment, otherwise I or
- -- someone else will change it back to R'Last > abs (X) ???
+ -- Note that the test below is written as a negation. This is to
+ -- account for the fact that X and Y may be NaNs, because both of
+ -- their operands could overflow. Given that all operations on NaNs
+ -- return false, the test can only be written thus.
if not (abs (X) <= R'Last) then
X := Scale**2 * ((Left.Re / Scale) * (Right.Re / Scale) -
(Left.Im / Scale) * (Right.Im / Scale));
end if;
- -- ??? same weird test ???
if not (abs (Y) <= R'Last) then
Y := Scale**2 * ((Left.Re / Scale) * (Right.Im / Scale)
+ (Left.Im / Scale) * (Right.Re / Scale));
-- Implementation Note --
-------------------------
- -- The design of this spec is very awkward, as a result of Ada 95 not
+ -- The design of this spec is a bit awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
- -- solution is to use the heap and pointers, and, to avoid memory leaks,
- -- controlled types.
+ -- solution would be to add a self-referential component to the generator
+ -- allowing access to the generator object from inside the function. This
+ -- would work because the generator is limited, which prevents any copy.
- -- This is awfully heavy, so what we do is to use Unrestricted_Access to
+ -- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
-- Implementation Note --
-------------------------
- -- The design of this spec is very awkward, as a result of Ada 95 not
+ -- The design of this spec is a bit awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
- -- solution is to use the heap and pointers, and, to avoid memory leaks,
- -- controlled types.
+ -- solution would be to add a self-referential component to the generator
+ -- allowing access to the generator object from inside the function. This
+ -- would work because the generator is limited, which prevents any copy.
- -- This is awfully heavy, so what we do is to use Unrestricted_Access to
+ -- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
-- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid
- -- test and give a warning.
+ -- test and give a warning. For floating point types however, this
+ -- is a standard way to check for finite numbers, and using 'Valid
+ -- would typically be a pessimization
if Is_Scalar_Type (Etype (Lop))
+ and then not Is_Floating_Point_Type (Etype (Lop))
and then Nkind (Rop) in N_Has_Entity
and then Etype (Lop) = Entity (Rop)
and then Comes_From_Source (N)
Analyze_And_Resolve (Rhs, Ctyp);
end if;
+ -- For the AAMP target, indexing of certain packed array is passed
+ -- through to the back end without expansion, because the expansion
+ -- results in very inefficient code on that target. This allows the
+ -- GNAAMP back end to generate specialized macros that support more
+ -- efficient indexing of packed arrays with components having sizes
+ -- that are small powers of two.
+
+ if AAMP_On_Target
+ and then (Csiz = 1 or else Csiz = 2 or else Csiz = 4)
+ then
+ return;
+ end if;
+
-- Case of component size 1,2,4 or any component size for the modular
-- case. These are the cases for which we can inline the code.
Ctyp := Component_Type (Atyp);
Csiz := UI_To_Int (Component_Size (Atyp));
+ -- For the AAMP target, indexing of certain packed array is passed
+ -- through to the back end without expansion, because the expansion
+ -- results in very inefficient code on that target. This allows the
+ -- GNAAMP back end to generate specialized macros that support more
+ -- efficient indexing of packed arrays with components having sizes
+ -- that are small powers of two.
+
+ if AAMP_On_Target
+ and then (Csiz = 1 or else Csiz = 2 or else Csiz = 4)
+ then
+ return;
+ end if;
+
-- Case of component size 1,2,4 or any component size for the modular
-- case. These are the cases for which we can inline the code.
Renamed_Subp : Entity_Id;
begin
-
-- If the renamed subprogram is intrinsic, there is no need for a
-- wrapper body: we set the alias that will be called and expanded which
-- completes the declaration. This transformation is only legal if the
-- is frozen. See RM 8.5.4 (5).
if Nkind (Body_Decl) = N_Subprogram_Renaming_Declaration
- and then Is_Entity_Name (Name (Body_Decl))
+ and then Is_Entity_Name (Name (Body_Decl))
then
Renamed_Subp := Entity (Name (Body_Decl));
else
and then
(not In_Same_Source_Unit (Renamed_Subp, Ent)
or else Sloc (Renamed_Subp) < Sloc (Ent))
- and then
- -- We can make the renaming entity intrisic if the renamed function
- -- has an interface name, or it is one of the shift/rotate operations
- -- known to the compiler.
+ -- We can make the renaming entity intrisic if the renamed function
+ -- has an interface name, or if it is one of the shift/rotate
+ -- operations known to the compiler.
- (Present (Interface_Name (Renamed_Subp))
- or else Chars (Renamed_Subp) = Name_Rotate_Left
- or else Chars (Renamed_Subp) = Name_Rotate_Right
- or else Chars (Renamed_Subp) = Name_Shift_Left
- or else Chars (Renamed_Subp) = Name_Shift_Right
- or else Chars (Renamed_Subp) = Name_Shift_Right_Arithmetic)
+ and then (Present (Interface_Name (Renamed_Subp))
+ or else Chars (Renamed_Subp) = Name_Rotate_Left
+ or else Chars (Renamed_Subp) = Name_Rotate_Right
+ or else Chars (Renamed_Subp) = Name_Shift_Left
+ or else Chars (Renamed_Subp) = Name_Shift_Right
+ or else Chars (Renamed_Subp) = Name_Shift_Right_Arithmetic)
then
Set_Interface_Name (Ent, Interface_Name (Renamed_Subp));
+
if Present (Alias (Renamed_Subp)) then
Set_Alias (Ent, Alias (Renamed_Subp));
else
New_S : Entity_Id) return Node_Id
is
Loc : constant Source_Ptr := Sloc (New_S);
- -- We use for the source location of the renamed body, the location
- -- of the spec entity. It might seem more natural to use the location
- -- of the renaming declaration itself, but that would be wrong, since
- -- then the body we create would look as though it was created far
- -- too late, and this could cause problems with elaboration order
- -- analysis, particularly in connection with instantiations.
+ -- We use for the source location of the renamed body, the location of
+ -- the spec entity. It might seem more natural to use the location of
+ -- the renaming declaration itself, but that would be wrong, since then
+ -- the body we create would look as though it was created far too late,
+ -- and this could cause problems with elaboration order analysis,
+ -- particularly in connection with instantiations.
N : constant Node_Id := Unit_Declaration_Node (New_S);
Nam : constant Node_Id := Name (N);
Call_Name := New_Copy (Name (N));
end if;
- -- The original name may have been overloaded, but
- -- is fully resolved now.
+ -- Original name may have been overloaded, but is fully resolved now
Set_Is_Overloaded (Call_Name, False);
end if;
-- calls to the renamed entity. The body must be generated in any case
-- for calls that may appear elsewhere.
- if (Ekind (Old_S) = E_Function
- or else Ekind (Old_S) = E_Procedure)
+ if Ekind_In (Old_S, E_Function, E_Procedure)
and then Nkind (Decl) = N_Subprogram_Declaration
then
Set_Body_To_Inline (Decl, Old_S);
Form_Type : constant Entity_Id := Etype (First_Formal (Old_S));
begin
-
-- The controlling formal may be an access parameter, or the
-- actual may be an access value, so adjust accordingly.
if Present (Formal) then
O_Formal := First_Formal (Old_S);
Param_Spec := First (Parameter_Specifications (Spec));
-
while Present (Formal) loop
if Is_Entry (Old_S) then
-
if Nkind (Parameter_Type (Param_Spec)) /=
N_Access_Definition
then
Make_Defining_Identifier (Loc, Chars => Chars (New_S)));
Param_Spec := First (Parameter_Specifications (Spec));
-
while Present (Param_Spec) loop
Set_Defining_Identifier (Param_Spec,
Make_Defining_Identifier (Loc,
if (No (Expression (Decl))
and then not Needs_Finalization (Typ)
- and then
- (not Has_Non_Null_Base_Init_Proc (Typ)
- or else Is_Imported (E)))
-
- or else
- (Present (Expression (Decl))
- and then Is_Scalar_Type (Typ))
-
- or else
- Is_Access_Type (Typ)
-
+ and then (not Has_Non_Null_Base_Init_Proc (Typ)
+ or else Is_Imported (E)))
+ or else (Present (Expression (Decl)) and then Is_Scalar_Type (Typ))
+ or else Is_Access_Type (Typ)
or else
(Is_Bit_Packed_Array (Typ)
- and then
- Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
+ and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
then
null;
-- Otherwise, we require the address clause to be constant because
-- the call to the initialization procedure (or the attach code) has
-- to happen at the point of the declaration.
+
-- Actually the IP call has been moved to the freeze actions
-- anyway, so maybe we can relax this restriction???
and then Present (Parent (T))
and then Nkind (Parent (T)) = N_Full_Type_Declaration
and then Nkind (Type_Definition (Parent (T))) =
- N_Record_Definition
+ N_Record_Definition
and then not Null_Present (Type_Definition (Parent (T)))
and then Present (Variant_Part
(Component_List (Type_Definition (Parent (T)))))
if not Is_Constrained (T)
and then
- No (Discriminant_Default_Value
- (First_Discriminant (T)))
+ No (Discriminant_Default_Value (First_Discriminant (T)))
and then Unknown_Esize (T)
then
return False;
-- Freeze_All_Ent --
--------------------
- procedure Freeze_All_Ent
- (From : Entity_Id;
- After : in out Node_Id)
- is
+ procedure Freeze_All_Ent (From : Entity_Id; After : in out Node_Id) is
E : Entity_Id;
Flist : List_Id;
Lastn : Node_Id;
begin
Prim := First_Elmt (Prim_List);
-
while Present (Prim) loop
Subp := Node (Prim);
Bod : constant Node_Id := Next (After);
begin
- if (Nkind (Bod) = N_Subprogram_Body
- or else Nkind (Bod) = N_Entry_Body
- or else Nkind (Bod) = N_Package_Body
- or else Nkind (Bod) = N_Protected_Body
- or else Nkind (Bod) = N_Task_Body
+ if (Nkind_In (Bod, N_Subprogram_Body,
+ N_Entry_Body,
+ N_Package_Body,
+ N_Protected_Body,
+ N_Task_Body)
or else Nkind (Bod) in N_Body_Stub)
and then
List_Containing (After) = List_Containing (Parent (E))
then
declare
Ent : Entity_Id;
+
begin
Ent := First_Entity (E);
-
while Present (Ent) loop
-
if Is_Entry (Ent)
and then not Default_Expressions_Processed (Ent)
then
-- If the component is an Itype with Delayed_Freeze and is either
-- a record or array subtype and its base type has not yet been
- -- frozen, we must remove this from the entity list of this
- -- record and put it on the entity list of the scope of its base
- -- type. Note that we know that this is not the type of a
- -- component since we cleared Has_Delayed_Freeze for it in the
- -- previous loop. Thus this must be the Designated_Type of an
- -- access type, which is the type of a component.
+ -- frozen, we must remove this from the entity list of this record
+ -- and put it on the entity list of the scope of its base type.
+ -- Note that we know that this is not the type of a component
+ -- since we cleared Has_Delayed_Freeze for it in the previous
+ -- loop. Thus this must be the Designated_Type of an access type,
+ -- which is the type of a component.
if Is_Itype (Comp)
and then Is_Type (Scope (Comp))
S : Entity_Id := Current_Scope;
begin
+
while Present (S) loop
if Is_Overloadable (S) then
if Comes_From_Source (S)
-- Skip this if the entity is stubbed, since we don't need a name
-- for any stubbed routine. For the case on intrinsics, if no
-- external name is specified, then calls will be handled in
- -- Exp_Intr.Expand_Intrinsic_Call, and no name is needed; if
- -- an external name is provided, then Expand_Intrinsic_Call leaves
+ -- Exp_Intr.Expand_Intrinsic_Call, and no name is needed. If an
+ -- external name is provided, then Expand_Intrinsic_Call leaves
-- calls in place for expansion by GIGI.
if (Is_Imported (E) or else Is_Exported (E))
-- Implementation Note --
-------------------------
- -- The design of this spec is very awkward, as a result of Ada 95 not
+ -- The design of this spec is a bit awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
- -- solution is to use the heap and pointers, and, to avoid memory leaks,
- -- controlled types.
+ -- solution would be to add a self-referential component to the generator
+ -- allowing access to the generator object from inside the function. This
+ -- would work because the generator is limited, which prevents any copy.
- -- This is awfully heavy, so what we do is to use Unrestricted_Access to
+ -- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
-- Implementation Note --
-------------------------
- -- The design of this spec is very awkward, as a result of Ada 95 not
+ -- The design of this spec is a bit awkward, as a result of Ada 95 not
-- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
- -- solution is to use the heap and pointers, and, to avoid memory leaks,
- -- controlled types.
+ -- solution would be to add a self-referential component to the generator
+ -- allowing access to the generator object from inside the function. This
+ -- would work because the generator is limited, which prevents any copy.
- -- This is awfully heavy, so what we do is to use Unrestricted_Access to
+ -- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
if Subunits_Missing then
Write_Str (" (missing subunits)");
Write_Eol;
- Write_Str ("to check parent unit");
elsif Main_Kind = N_Subunit then
Write_Str (" (subunit)");
Write_Eol;
- Write_Str ("to check subunit");
elsif Main_Kind = N_Subprogram_Declaration then
Write_Str (" (subprogram spec)");
Write_Eol;
- Write_Str ("to check subprogram spec");
-- Generic package body in GNAT implementation mode
elsif Main_Kind = N_Package_Body and then GNAT_Mode then
Write_Str (" (predefined generic)");
Write_Eol;
- Write_Str ("to check predefined generic");
-- Only other case is a package spec
else
Write_Str (" (package spec)");
Write_Eol;
- Write_Str ("to check package spec");
end if;
- Write_Str (" for errors, use ");
-
- if Hostparm.OpenVMS then
- Write_Str ("/NOLOAD");
- else
- Write_Str ("-gnatc");
- end if;
-
- Write_Eol;
Set_Standard_Output;
Sem_Ch13.Validate_Unchecked_Conversions;
-- Implementation Note --
-------------------------
- -- The design of this spec is very awkward, as a result of Ada 95 not
- -- permitting in-out parameters for function formals (most naturally,
+ -- The design of this spec is a bit awkward, as a result of Ada 95 not
+ -- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only
- -- solution is to use the heap and pointers, and, to avoid memory leaks,
- -- controlled types.
+ -- solution would be to add a self-referential component to the generator
+ -- allowing access to the generator object from inside the function. This
+ -- would work because the generator is limited, which prevents any copy.
- -- This is awfully heavy, so what we do is to use Unrestricted_Access to
+ -- This is a bit heavy, so what we do is to use Unrestricted_Access to
-- get a pointer to the state in the passed Generator. This works because
-- Generator is a limited type and will thus always be passed by reference.
- Low31_Mask : constant := 2**31-1;
- Bit31_Mask : constant := 2**31;
-
- Matrix_A_X : constant array (State_Val range 0 .. 1) of State_Val :=
- (0, 16#9908b0df#);
-
Y2K : constant Calendar.Time :=
Calendar.Time_Of
(Year => 2000, Month => 1, Day => 1, Seconds => 0.0);
- -- First Year 2000 day
+ -- First day of Year 2000 (what is this for???)
Image_Numeral_Length : constant := Max_Image_Width / N;
subtype Image_String is String (1 .. Max_Image_Width);
+ ----------------------------
+ -- Algorithmic Parameters --
+ ----------------------------
+
+ Lower_Mask : constant := 2**31-1;
+ Upper_Mask : constant := 2**31;
+
+ Matrix_A : constant array (State_Val range 0 .. 1) of State_Val
+ := (0, 16#9908b0df#);
+ -- The twist transformation is represented by a matrix of the form
+ --
+ -- [ 0 I(31) ]
+ -- [ _a ]
+ --
+ -- where 0 is a 31x31 block of 0s, I(31) is the 31x31 identity matrix and
+ -- _a is a particular bit row-vector, represented here by a 32-bit integer.
+ -- If integer x represents a row vector of bits (with x(0), the units bit,
+ -- last), then
+ -- x * A = [0 x(31..1)] xor Matrix_A(x(0)).
+
+ U : constant := 11;
+ S : constant := 7;
+ B_Mask : constant := 16#9d2c5680#;
+ T : constant := 15;
+ C_Mask : constant := 16#efc60000#;
+ L : constant := 18;
+ -- The tempering shifts and bit masks, in the order applied
+
+ Seed0 : constant := 5489;
+ -- Default seed, used to initialize the state vector when Reset not called
+
+ Seed1 : constant := 19650218;
+ -- Seed used to initialize the state vector when calling Reset with an
+ -- initialization vector.
+
+ Mult0 : constant := 1812433253;
+ -- Multiplier for a modified linear congruential generator used to
+ -- initialize the state vector when calling Reset with a single integer
+ -- seed.
+
+ Mult1 : constant := 1664525;
+ Mult2 : constant := 1566083941;
+ -- Multipliers for two modified linear congruential generators used to
+ -- initialize the state vector when calling Reset with an initialization
+ -- vector.
+
-----------------------
-- Local Subprograms --
-----------------------
function Random (Gen : Generator) return Unsigned_32 is
G : Generator renames Gen'Unrestricted_Access.all;
Y : State_Val;
- I : Integer;
+ I : Integer; -- should avoid use of identifier I ???
begin
I := G.I;
if I < N - M then
- Y := (G.S (I) and Bit31_Mask) or (G.S (I + 1) and Low31_Mask);
- Y := G.S (I + M) xor Shift_Right (Y, 1) xor Matrix_A_X (Y and 1);
+ Y := (G.S (I) and Upper_Mask) or (G.S (I + 1) and Lower_Mask);
+ Y := G.S (I + M) xor Shift_Right (Y, 1) xor Matrix_A (Y and 1);
I := I + 1;
elsif I < N - 1 then
- Y := (G.S (I) and Bit31_Mask) or (G.S (I + 1) and Low31_Mask);
+ Y := (G.S (I) and Upper_Mask) or (G.S (I + 1) and Lower_Mask);
Y := G.S (I + (M - N))
xor Shift_Right (Y, 1)
- xor Matrix_A_X (Y and 1);
+ xor Matrix_A (Y and 1);
I := I + 1;
elsif I = N - 1 then
- Y := (G.S (I) and Bit31_Mask) or (G.S (0) and Low31_Mask);
- Y := G.S (M - 1) xor Shift_Right (Y, 1) xor Matrix_A_X (Y and 1);
+ Y := (G.S (I) and Upper_Mask) or (G.S (0) and Lower_Mask);
+ Y := G.S (M - 1) xor Shift_Right (Y, 1) xor Matrix_A (Y and 1);
I := 0;
else
- Init (G, 5489);
+ Init (G, Seed0);
return Random (Gen);
end if;
G.S (G.I) := Y;
G.I := I;
- Y := Y xor Shift_Right (Y, 11);
- Y := Y xor (Shift_Left (Y, 7) and 16#9d2c5680#);
- Y := Y xor (Shift_Left (Y, 15) and 16#efc60000#);
- Y := Y xor Shift_Right (Y, 18);
+ Y := Y xor Shift_Right (Y, U);
+ Y := Y xor (Shift_Left (Y, S) and B_Mask);
+ Y := Y xor (Shift_Left (Y, T) and C_Mask);
+ Y := Y xor Shift_Right (Y, L);
return Y;
end Random;
Mantissa : Unsigned;
- X : Real;
- -- Scaled mantissa
-
- R : Unsigned_32;
- -- Supply of random bits
-
- R_Bits : Natural;
- -- Number of bits left in R
-
- K : Bit_Count;
- -- Next decrement to exponent
+ X : Real; -- Scaled mantissa
+ R : Unsigned_32; -- Supply of random bits
+ R_Bits : Natural; -- Number of bits left in R
+ K : Bit_Count; -- Next decrement to exponent
begin
Mantissa := Random (Gen) / 2**Extra_Bits;
declare
-- In the 64-bit case, we have to be careful, since not all 64-bit
-- unsigned values are representable in GNAT's root_integer type.
- -- Ignore different-size warnings here; since GNAT's handling
+ -- Ignore different-size warnings here since GNAT's handling
-- is correct.
pragma Warnings ("Z"); -- better to use msg string! ???
procedure Reset (Gen : out Generator; Initiator : Integer) is
begin
- pragma Warnings ("C");
+ pragma Warnings (Off, "condition is always *");
-- This is probably an unnecessary precaution against future change, but
-- since the test is a static expression, no extra code is involved.
end;
end if;
- pragma Warnings ("c");
+ pragma Warnings (On, "condition is always *");
end Reset;
procedure Reset (Gen : out Generator; Initiator : Initialization_Vector) is
I, J : Integer;
begin
- Init (Gen, 19650218); -- please give this constant a name ???
+ Init (Gen, Seed1);
I := 1;
J := 0;
for K in reverse 1 .. Integer'Max (N, Initiator'Length) loop
Gen.S (I) :=
(Gen.S (I)
- xor ((Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30))
- * 1664525))
+ xor ((Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30))
+ * Mult1))
+ Initiator (J + Initiator'First) + Unsigned_32 (J);
I := I + 1;
for K in reverse 1 .. N - 1 loop
Gen.S (I) :=
(Gen.S (I) xor ((Gen.S (I - 1)
- xor Shift_Right (Gen.S (I - 1), 30)) * 1566083941))
+ xor Shift_Right (Gen.S (I - 1), 30)) * Mult2))
- Unsigned_32 (I);
I := I + 1;
end if;
end loop;
- Gen.S (0) := Bit31_Mask;
+ Gen.S (0) := Upper_Mask;
end Reset;
procedure Reset (Gen : out Generator; From_State : Generator) is
begin
Result := (others => ' ');
-
for J in 0 .. N - 1 loop
Insert_Image (Result, J, Gen.S ((J + Gen.I) mod N));
end loop;
for I in 1 .. N - 1 loop
Gen.S (I) :=
- 1812433253
- * (Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30))
- + Unsigned_32 (I);
+ Mult0 * (Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30)) +
+ Unsigned_32 (I);
end loop;
Gen.I := 0;
-- --
-- S p e c --
-- --
--- Copyright (C) 2007,2009 Free Software Foundation, Inc. --
+-- Copyright (C) 2007-2010, Free Software Foundation, Inc. --
-- --
-- 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- --
-- The shift register, a circular buffer
I : Integer := N;
- -- Current starting position in shift register S
+ -- Current starting position in shift register S (N means uninitialized)
end record;
end System.Random_Numbers;
-- One-letter switches
- when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' |
- 'F' | 'g' | 'h' | 'H' | 'k' | 'l' | 'L' | 'n' | 'N' |
- 'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
- 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
+ when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' | 'F' |
+ 'g' | 'h' | 'H' | 'l' | 'L' | 'n' | 'N' | 'o' |
+ 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
+ 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
Storing (First_Stored) := C;
Add_Switch_Component
(Storing (Storing'First .. First_Stored));
-- One-letter switches followed by a positive number
- when 'm' | 'T' =>
+ when 'k' | 'm' | 'T' =>
Storing (First_Stored) := C;
Last_Stored := First_Stored;
OSDN Git Service
