Commit 545cb5be by Arnaud Charlet

[multiple changes]

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.

From-SVN: r161213
parent 879e23f0
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> 2010-06-22 Doug Rupp <rupp@adacore.com>
* system-vms.ads, system-vms-zcx.ads: Remove old unused VMS system * system-vms.ads, system-vms-zcx.ads: Remove old unused VMS system
......
...@@ -60,15 +60,16 @@ package body Ada.Numerics.Generic_Complex_Types is ...@@ -60,15 +60,16 @@ package body Ada.Numerics.Generic_Complex_Types is
if not Standard'Fast_Math then if not Standard'Fast_Math then
-- ??? the test below is weird, it needs a comment, otherwise I or -- Note that the test below is written as a negation. This is to
-- someone else will change it back to R'Last > abs (X) ??? -- 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 if not (abs (X) <= R'Last) then
X := Scale**2 * ((Left.Re / Scale) * (Right.Re / Scale) - X := Scale**2 * ((Left.Re / Scale) * (Right.Re / Scale) -
(Left.Im / Scale) * (Right.Im / Scale)); (Left.Im / Scale) * (Right.Im / Scale));
end if; end if;
-- ??? same weird test ???
if not (abs (Y) <= R'Last) then if not (abs (Y) <= R'Last) then
Y := Scale**2 * ((Left.Re / Scale) * (Right.Im / Scale) Y := Scale**2 * ((Left.Re / Scale) * (Right.Im / Scale)
+ (Left.Im / Scale) * (Right.Re / Scale)); + (Left.Im / Scale) * (Right.Re / Scale));
......
...@@ -37,13 +37,14 @@ package body Ada.Numerics.Discrete_Random is ...@@ -37,13 +37,14 @@ package body Ada.Numerics.Discrete_Random is
-- Implementation Note -- -- 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 -- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only -- 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, -- solution would be to add a self-referential component to the generator
-- controlled types. -- 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 -- 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. -- Generator is a limited type and will thus always be passed by reference.
......
...@@ -39,13 +39,14 @@ package body Ada.Numerics.Float_Random is ...@@ -39,13 +39,14 @@ package body Ada.Numerics.Float_Random is
-- Implementation Note -- -- 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 -- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only -- 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, -- solution would be to add a self-referential component to the generator
-- controlled types. -- 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 -- 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. -- Generator is a limited type and will thus always be passed by reference.
......
...@@ -4378,9 +4378,12 @@ package body Exp_Ch4 is ...@@ -4378,9 +4378,12 @@ package body Exp_Ch4 is
-- Check case of explicit test for an expression in range of its -- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid -- 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)) 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 Nkind (Rop) in N_Has_Entity
and then Etype (Lop) = Entity (Rop) and then Etype (Lop) = Entity (Rop)
and then Comes_From_Source (N) and then Comes_From_Source (N)
......
...@@ -1381,6 +1381,19 @@ package body Exp_Pakd is ...@@ -1381,6 +1381,19 @@ package body Exp_Pakd is
Analyze_And_Resolve (Rhs, Ctyp); Analyze_And_Resolve (Rhs, Ctyp);
end if; 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 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. -- case. These are the cases for which we can inline the code.
...@@ -1933,6 +1946,19 @@ package body Exp_Pakd is ...@@ -1933,6 +1946,19 @@ package body Exp_Pakd is
Ctyp := Component_Type (Atyp); Ctyp := Component_Type (Atyp);
Csiz := UI_To_Int (Component_Size (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 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. -- case. These are the cases for which we can inline the code.
......
...@@ -39,13 +39,14 @@ package body GNAT.MBBS_Discrete_Random is ...@@ -39,13 +39,14 @@ package body GNAT.MBBS_Discrete_Random is
-- Implementation Note -- -- 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 -- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only -- 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, -- solution would be to add a self-referential component to the generator
-- controlled types. -- 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 -- 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. -- Generator is a limited type and will thus always be passed by reference.
......
...@@ -37,13 +37,14 @@ package body GNAT.MBBS_Float_Random is ...@@ -37,13 +37,14 @@ package body GNAT.MBBS_Float_Random is
-- Implementation Note -- -- 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 -- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only -- 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, -- solution would be to add a self-referential component to the generator
-- controlled types. -- 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 -- 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. -- Generator is a limited type and will thus always be passed by reference.
......
...@@ -861,42 +861,28 @@ begin ...@@ -861,42 +861,28 @@ begin
if Subunits_Missing then if Subunits_Missing then
Write_Str (" (missing subunits)"); Write_Str (" (missing subunits)");
Write_Eol; Write_Eol;
Write_Str ("to check parent unit");
elsif Main_Kind = N_Subunit then elsif Main_Kind = N_Subunit then
Write_Str (" (subunit)"); Write_Str (" (subunit)");
Write_Eol; Write_Eol;
Write_Str ("to check subunit");
elsif Main_Kind = N_Subprogram_Declaration then elsif Main_Kind = N_Subprogram_Declaration then
Write_Str (" (subprogram spec)"); Write_Str (" (subprogram spec)");
Write_Eol; Write_Eol;
Write_Str ("to check subprogram spec");
-- Generic package body in GNAT implementation mode -- Generic package body in GNAT implementation mode
elsif Main_Kind = N_Package_Body and then GNAT_Mode then elsif Main_Kind = N_Package_Body and then GNAT_Mode then
Write_Str (" (predefined generic)"); Write_Str (" (predefined generic)");
Write_Eol; Write_Eol;
Write_Str ("to check predefined generic");
-- Only other case is a package spec -- Only other case is a package spec
else else
Write_Str (" (package spec)"); Write_Str (" (package spec)");
Write_Eol; Write_Eol;
Write_Str ("to check package spec");
end if; 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; Set_Standard_Output;
Sem_Ch13.Validate_Unchecked_Conversions; Sem_Ch13.Validate_Unchecked_Conversions;
......
...@@ -99,30 +99,71 @@ package body System.Random_Numbers is ...@@ -99,30 +99,71 @@ package body System.Random_Numbers is
-- Implementation Note -- -- 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, -- permitting in-out parameters for function formals (most naturally
-- Generator values would be passed this way). In pure Ada 95, the only -- 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, -- solution would be to add a self-referential component to the generator
-- controlled types. -- 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 -- 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. -- 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 := Y2K : constant Calendar.Time :=
Calendar.Time_Of Calendar.Time_Of
(Year => 2000, Month => 1, Day => 1, Seconds => 0.0); (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; Image_Numeral_Length : constant := Max_Image_Width / N;
subtype Image_String is String (1 .. Max_Image_Width); 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 -- -- Local Subprograms --
----------------------- -----------------------
...@@ -153,40 +194,40 @@ package body System.Random_Numbers is ...@@ -153,40 +194,40 @@ package body System.Random_Numbers is
function Random (Gen : Generator) return Unsigned_32 is function Random (Gen : Generator) return Unsigned_32 is
G : Generator renames Gen'Unrestricted_Access.all; G : Generator renames Gen'Unrestricted_Access.all;
Y : State_Val; Y : State_Val;
I : Integer; I : Integer; -- should avoid use of identifier I ???
begin begin
I := G.I; I := G.I;
if I < N - M then if I < N - M 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) xor Shift_Right (Y, 1) xor Matrix_A_X (Y and 1); Y := G.S (I + M) xor Shift_Right (Y, 1) xor Matrix_A (Y and 1);
I := I + 1; I := I + 1;
elsif I < N - 1 then 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)) Y := G.S (I + (M - N))
xor Shift_Right (Y, 1) xor Shift_Right (Y, 1)
xor Matrix_A_X (Y and 1); xor Matrix_A (Y and 1);
I := I + 1; I := I + 1;
elsif I = N - 1 then elsif I = N - 1 then
Y := (G.S (I) and Bit31_Mask) or (G.S (0) and Low31_Mask); 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_X (Y and 1); Y := G.S (M - 1) xor Shift_Right (Y, 1) xor Matrix_A (Y and 1);
I := 0; I := 0;
else else
Init (G, 5489); Init (G, Seed0);
return Random (Gen); return Random (Gen);
end if; end if;
G.S (G.I) := Y; G.S (G.I) := Y;
G.I := I; G.I := I;
Y := Y xor Shift_Right (Y, 11); Y := Y xor Shift_Right (Y, U);
Y := Y xor (Shift_Left (Y, 7) and 16#9d2c5680#); Y := Y xor (Shift_Left (Y, S) and B_Mask);
Y := Y xor (Shift_Left (Y, 15) and 16#efc60000#); Y := Y xor (Shift_Left (Y, T) and C_Mask);
Y := Y xor Shift_Right (Y, 18); Y := Y xor Shift_Right (Y, L);
return Y; return Y;
end Random; end Random;
...@@ -265,17 +306,10 @@ package body System.Random_Numbers is ...@@ -265,17 +306,10 @@ package body System.Random_Numbers is
Mantissa : Unsigned; Mantissa : Unsigned;
X : Real; X : Real; -- Scaled mantissa
-- Scaled mantissa R : Unsigned_32; -- Supply of random bits
R_Bits : Natural; -- Number of bits left in R
R : Unsigned_32; K : Bit_Count; -- Next decrement to exponent
-- Supply of random bits
R_Bits : Natural;
-- Number of bits left in R
K : Bit_Count;
-- Next decrement to exponent
begin begin
Mantissa := Random (Gen) / 2**Extra_Bits; Mantissa := Random (Gen) / 2**Extra_Bits;
...@@ -388,7 +422,7 @@ package body System.Random_Numbers is ...@@ -388,7 +422,7 @@ package body System.Random_Numbers is
declare declare
-- In the 64-bit case, we have to be careful, since not all 64-bit -- 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. -- 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. -- is correct.
pragma Warnings ("Z"); -- better to use msg string! ??? pragma Warnings ("Z"); -- better to use msg string! ???
...@@ -482,7 +516,7 @@ package body System.Random_Numbers is ...@@ -482,7 +516,7 @@ package body System.Random_Numbers is
procedure Reset (Gen : out Generator; Initiator : Integer) is procedure Reset (Gen : out Generator; Initiator : Integer) is
begin begin
pragma Warnings ("C"); pragma Warnings (Off, "condition is always *");
-- This is probably an unnecessary precaution against future change, but -- This is probably an unnecessary precaution against future change, but
-- since the test is a static expression, no extra code is involved. -- since the test is a static expression, no extra code is involved.
...@@ -502,14 +536,14 @@ package body System.Random_Numbers is ...@@ -502,14 +536,14 @@ package body System.Random_Numbers is
end; end;
end if; end if;
pragma Warnings ("c"); pragma Warnings (On, "condition is always *");
end Reset; end Reset;
procedure Reset (Gen : out Generator; Initiator : Initialization_Vector) is procedure Reset (Gen : out Generator; Initiator : Initialization_Vector) is
I, J : Integer; I, J : Integer;
begin begin
Init (Gen, 19650218); -- please give this constant a name ??? Init (Gen, Seed1);
I := 1; I := 1;
J := 0; J := 0;
...@@ -517,8 +551,8 @@ package body System.Random_Numbers is ...@@ -517,8 +551,8 @@ package body System.Random_Numbers is
for K in reverse 1 .. Integer'Max (N, Initiator'Length) loop for K in reverse 1 .. Integer'Max (N, Initiator'Length) loop
Gen.S (I) := Gen.S (I) :=
(Gen.S (I) (Gen.S (I)
xor ((Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30)) xor ((Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30))
* 1664525)) * Mult1))
+ Initiator (J + Initiator'First) + Unsigned_32 (J); + Initiator (J + Initiator'First) + Unsigned_32 (J);
I := I + 1; I := I + 1;
...@@ -538,7 +572,7 @@ package body System.Random_Numbers is ...@@ -538,7 +572,7 @@ package body System.Random_Numbers is
for K in reverse 1 .. N - 1 loop for K in reverse 1 .. N - 1 loop
Gen.S (I) := Gen.S (I) :=
(Gen.S (I) xor ((Gen.S (I - 1) (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); - Unsigned_32 (I);
I := I + 1; I := I + 1;
...@@ -548,7 +582,7 @@ package body System.Random_Numbers is ...@@ -548,7 +582,7 @@ package body System.Random_Numbers is
end if; end if;
end loop; end loop;
Gen.S (0) := Bit31_Mask; Gen.S (0) := Upper_Mask;
end Reset; end Reset;
procedure Reset (Gen : out Generator; From_State : Generator) is procedure Reset (Gen : out Generator; From_State : Generator) is
...@@ -612,7 +646,6 @@ package body System.Random_Numbers is ...@@ -612,7 +646,6 @@ package body System.Random_Numbers is
begin begin
Result := (others => ' '); Result := (others => ' ');
for J in 0 .. N - 1 loop for J in 0 .. N - 1 loop
Insert_Image (Result, J, Gen.S ((J + Gen.I) mod N)); Insert_Image (Result, J, Gen.S ((J + Gen.I) mod N));
end loop; end loop;
...@@ -643,9 +676,8 @@ package body System.Random_Numbers is ...@@ -643,9 +676,8 @@ package body System.Random_Numbers is
for I in 1 .. N - 1 loop for I in 1 .. N - 1 loop
Gen.S (I) := Gen.S (I) :=
1812433253 Mult0 * (Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30)) +
* (Gen.S (I - 1) xor Shift_Right (Gen.S (I - 1), 30)) Unsigned_32 (I);
+ Unsigned_32 (I);
end loop; end loop;
Gen.I := 0; Gen.I := 0;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -140,7 +140,7 @@ private ...@@ -140,7 +140,7 @@ private
-- The shift register, a circular buffer -- The shift register, a circular buffer
I : Integer := N; I : Integer := N;
-- Current starting position in shift register S -- Current starting position in shift register S (N means uninitialized)
end record; end record;
end System.Random_Numbers; end System.Random_Numbers;
...@@ -215,10 +215,10 @@ package body Switch.M is ...@@ -215,10 +215,10 @@ package body Switch.M is
-- One-letter switches -- One-letter switches
when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' | when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' | 'F' |
'F' | 'g' | 'h' | 'H' | 'k' | 'l' | 'L' | 'n' | 'N' | 'g' | 'h' | 'H' | 'l' | 'L' | 'n' | 'N' | 'o' |
'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
'u' | 'U' | 'v' | 'x' | 'X' | 'Z' => 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
Storing (First_Stored) := C; Storing (First_Stored) := C;
Add_Switch_Component Add_Switch_Component
(Storing (Storing'First .. First_Stored)); (Storing (Storing'First .. First_Stored));
...@@ -226,7 +226,7 @@ package body Switch.M is ...@@ -226,7 +226,7 @@ package body Switch.M is
-- One-letter switches followed by a positive number -- One-letter switches followed by a positive number
when 'm' | 'T' => when 'k' | 'm' | 'T' =>
Storing (First_Stored) := C; Storing (First_Stored) := C;
Last_Stored := First_Stored; Last_Stored := First_Stored;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment