Skip to content

R
riscv-gcc-1
Commit 1c612f29 by Robert Dewar Committed by Arnaud Charlet
Options

s-rannum.adb, [...]: Minor reformatting. 

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* s-rannum.adb, a-nudira.adb, types.ads, freeze.adb, sem_aggr.adb,
	exp_aggr.adb: Minor reformatting.
	* gnat_rm.texi: Document GNAT.MBBS_Discrete_Random and
	GNAT.MBSS_Float_Random.
	* g-mbdira.adb, g-mbflra.adb, g-mbdira.ads, g-mbflra.ads: Fix header.

From-SVN: r161194
parent 82c2f1bb
Showing with 99 additions and 62 deletions
gcc/ada/ChangeLog
2010-06-22 Robert Dewar <dewar@adacore.com>
* s-rannum.adb, a-nudira.adb, types.ads, freeze.adb, sem_aggr.adb,
exp_aggr.adb: Minor reformatting.
* gnat_rm.texi: Document GNAT.MBBS_Discrete_Random and
GNAT.MBSS_Float_Random.
* g-mbdira.adb, g-mbflra.adb, g-mbdira.ads, g-mbflra.ads: Fix header.
2010-06-22 Paul Hilfinger <hilfinger@adacore.com>
* a-nudira.adb, a-nudira.ads, a-nuflra.adb, a-nuflra.ads,
......
gcc/ada/a-nudira.adb
......@@ -58,33 +58,39 @@ package body Ada.Numerics.Discrete_Random is
return Rep_Random (Gen.Rep);
end Random;
procedure Reset (Gen : Generator;
Initiator : Integer) is
procedure Reset
(Gen : Generator;
Initiator : Integer)
is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G, Initiator);
end Reset;
procedure Reset (Gen : Generator) is
procedure Reset (Gen : Generator) is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G);
end Reset;
procedure Save (Gen : Generator;
To_State : out State) is
procedure Save
(Gen : Generator;
To_State : out State)
is
begin
Save (Gen.Rep, State (To_State));
end Save;
procedure Reset (Gen : Generator;
From_State : State) is
procedure Reset
(Gen : Generator;
From_State : State)
is
G : Rep_Generator renames Gen.Rep'Unrestricted_Access.all;
begin
Reset (G, From_State);
end Reset;
function Image (Of_State : State) return String is
function Image (Of_State : State) return String is
begin
return Image (Rep_State (Of_State));
end Image;
......
gcc/ada/exp_aggr.adb
......@@ -2861,14 +2861,14 @@ package body Exp_Aggr is
if Is_CPP_Constructor_Call (Expression (Comp)) then
Append_List_To (L,
Build_Initialization_Call (Loc,
Id_Ref => Make_Selected_Component (Loc,
Prefix => New_Copy_Tree (Target),
Selector_Name => New_Occurrence_Of (Selector,
Loc)),
Typ => Etype (Selector),
Enclos_Type => Typ,
Id_Ref => Make_Selected_Component (Loc,
Prefix => New_Copy_Tree (Target),
Selector_Name =>
New_Occurrence_Of (Selector, Loc)),
Typ => Etype (Selector),
Enclos_Type => Typ,
With_Default_Init => True,
Constructor_Ref => Expression (Comp)));
Constructor_Ref => Expression (Comp)));
-- Ada 2005 (AI-287): For each default-initialized component generate
-- a call to the corresponding IP subprogram if available.
......@@ -2887,8 +2887,8 @@ package body Exp_Aggr is
declare
Ctype : constant Entity_Id := Etype (Selector);
Inside_Allocator : Boolean := False;
P : Node_Id := Parent (N);
Inside_Allocator : Boolean := False;
P : Node_Id := Parent (N);
begin
if Is_Task_Type (Ctype) or else Has_Task (Ctype) then
......@@ -2909,12 +2909,12 @@ package body Exp_Aggr is
Append_List_To (L,
Build_Initialization_Call (Loc,
Id_Ref => Make_Selected_Component (Loc,
Prefix => New_Copy_Tree (Target),
Selector_Name => New_Occurrence_Of (Selector,
Loc)),
Typ => Etype (Selector),
Enclos_Type => Typ,
Id_Ref => Make_Selected_Component (Loc,
Prefix => New_Copy_Tree (Target),
Selector_Name =>
New_Occurrence_Of (Selector, Loc)),
Typ => Etype (Selector),
Enclos_Type => Typ,
With_Default_Init => True));
-- Prepare for component assignment
......
gcc/ada/freeze.adb
......@@ -211,10 +211,10 @@ package body Freeze is
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 renamed entity has already been elaborated.
-- 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
-- renamed entity has already been elaborated.
-- Note that it is legal for a renaming_as_body to rename an intrinsic
-- subprogram, as long as the renaming occurs before the new entity
......
gcc/ada/g-mbdira.adb
......@@ -2,7 +2,7 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . M B S S _ D I S C R E T E _ R A N D O M --
-- G N A T . M B B S _ D I S C R E T E _ R A N D O M --
-- --
-- B o d y --
-- --
......
gcc/ada/g-mbdira.ads
......@@ -2,7 +2,7 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . M B S S _ D I S C R E T E _ R A N D O M --
-- G N A T . M B B S _ D I S C R E T E _ R A N D O M --
-- --
-- S p e c --
-- --
......
gcc/ada/g-mbflra.adb
......@@ -2,7 +2,7 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . M B S S _ F L O A T _ R A N D O M --
-- G N A T . M B B S _ F L O A T _ R A N D O M --
-- --
-- B o d y --
-- --
......
gcc/ada/g-mbflra.ads
......@@ -2,7 +2,7 @@
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . M B S S _ F L O A T _ R A N D O M --
-- G N A T . M B B S _ F L O A T _ R A N D O M --
-- --
-- S p e c --
-- --
......
gcc/ada/gnat_rm.texi
......@@ -363,6 +363,8 @@ The GNAT Library
* GNAT.IO (g-io.ads)::
* GNAT.IO_Aux (g-io_aux.ads)::
* GNAT.Lock_Files (g-locfil.ads)::
* GNAT.MBBS_Discrete_Random (g-mbdira.ads)::
* GNAT.MBBS_Float_Random (g-mbflra.ads)::
* GNAT.MD5 (g-md5.ads)::
* GNAT.Memory_Dump (g-memdum.ads)::
* GNAT.Most_Recent_Exception (g-moreex.ads)::
......@@ -13547,6 +13549,8 @@ of GNAT, and will generate a warning message.
* GNAT.IO (g-io.ads)::
* GNAT.IO_Aux (g-io_aux.ads)::
* GNAT.Lock_Files (g-locfil.ads)::
* GNAT.MBBS_Discrete_Random (g-mbdira.ads)::
* GNAT.MBBS_Float_Random (g-mbflra.ads)::
* GNAT.MD5 (g-md5.ads)::
* GNAT.Memory_Dump (g-memdum.ads)::
* GNAT.Most_Recent_Exception (g-moreex.ads)::
......@@ -14431,6 +14435,24 @@ for whether a file exists, and functions for reading a line of text.
Provides a general interface for using files as locks. Can be used for
providing program level synchronization.
@node GNAT.MBBS_Discrete_Random (g-mbdira.ads)
@section @code{GNAT.MBBS_Discrete_Random} (@file{g-mbdira.ads})
@cindex @code{GNAT.MBBS_Discrete_Random} (@file{g-mbdira.ads})
@cindex Random number generation
@noindent
The original implementation of @code{Ada.Numerics.Discrete_Random}. Uses
a modified version of the Blum-Blum-Shub generator.
@node GNAT.MBBS_Float_Random (g-mbflra.ads)
@section @code{GNAT.MBBS_Float_Random} (@file{g-mbflra.ads})
@cindex @code{GNAT.MBBS_Float_Random} (@file{g-mbflra.ads})
@cindex Random number generation
@noindent
The original implementation of @code{Ada.Numerics.Float_Random}. Uses
a modified version of the Blum-Blum-Shub generator.
@node GNAT.MD5 (g-md5.ads)
@section @code{GNAT.MD5} (@file{g-md5.ads})
@cindex @code{GNAT.MD5} (@file{g-md5.ads})
......
gcc/ada/s-rannum.adb
......@@ -203,33 +203,32 @@ package body System.Random_Numbers is
function Random_Float_Template (Gen : Generator) return Real is
-- This code generates random floating-point numbers from unsigned
-- integers. Assuming that Real'Machine_Radix = 2, it can deliver
-- all machine values of type Real (at least as implied by
-- Real'Machine_Mantissa and Real'Machine_Emin), which is not true
-- of the standard method (to which we fall back for non-binary
-- radix): computing Real(<random integer>) / (<max random integer>+1).
-- To do so, we first extract an (M-1)-bit significand (where M
-- is Real'Machine_Mantissa), and then decide on a normalized
-- exponent by repeated coin flips, decrementing from 0 as long as
-- we flip heads (1 bits). This yields the proper geometric
-- distribution for the exponent: in a uniformly distributed set of
-- floating-point numbers, 1/2 of them will be in [0.5, 1), 1/4 will
-- be in [0.25, 0.5), and so forth. If the process reaches
-- Machine_Emin (an extremely rare event), it uses the selected
-- mantissa bits as an unnormalized fraction with Machine_Emin as
-- exponent. Otherwise, it adds a leading bit to the selected
-- mantissa bits (thus giving a normalized fraction) and adjusts by
-- the chosen exponent. The algorithm attempts to be stingy with
-- random integers. In the worst case, it can consume roughly
-- -Real'Machine_Emin/32 32-bit integers, but this case occurs with
-- probability 2**Machine_Emin, and the expected number of calls to
-- integer-valued Random is 1.
-- integers. Assuming that Real'Machine_Radix = 2, it can deliver all
-- machine values of type Real (as implied by Real'Machine_Mantissa and
-- Real'Machine_Emin), which is not true of the standard method (to
-- which we fall back for non-binary radix): computing Real(<random
-- integer>) / (<max random integer>+1). To do so, we first extract an
-- (M-1)-bit significand (where M is Real'Machine_Mantissa), and then
-- decide on a normalized exponent by repeated coin flips, decrementing
-- from 0 as long as we flip heads (1 bits). This yields the proper
-- geometric distribution for the exponent: in a uniformly distributed
-- set of floating-point numbers, 1/2 of them will be in [0.5, 1), 1/4
-- will be in [0.25, 0.5), and so forth. If the process reaches
-- Machine_Emin (an extremely rare event), it uses the selected mantissa
-- bits as an unnormalized fraction with Machine_Emin as exponent.
-- Otherwise, it adds a leading bit to the selected mantissa bits (thus
-- giving a normalized fraction) and adjusts by the chosen exponent. The
-- algorithm attempts to be stingy with random integers. In the worst
-- case, it can consume roughly -Real'Machine_Emin/32 32-bit integers,
-- but this case occurs with probability 2**Machine_Emin, and the
-- expected number of calls to integer-valued Random is 1.
begin
if Real'Machine_Radix /= 2 then
declare
Val : constant Real := Real'Machine
(Real (Unsigned'(Random (Gen))) * 2.0**(-Unsigned'Size));
Val : constant Real :=
Real'Machine
(Real (Unsigned'(Random (Gen))) * 2.0**(-Unsigned'Size));
begin
if Val < 1.0 then
return Real'Base (Val);
......@@ -237,20 +236,21 @@ package body System.Random_Numbers is
return Real'Pred (1.0);
end if;
end;
else
declare
Mant_Bits : constant Integer := Real'Machine_Mantissa - 1;
Mant_Mask : constant Unsigned := 2**Mant_Bits - 1;
Adjust32 : constant Integer := Real'Size - Unsigned_32'Size;
Leftover : constant Integer :=
Unsigned'Size - Real'Machine_Mantissa + 1;
Unsigned'Size - Real'Machine_Mantissa + 1;
V : constant Unsigned := Random (Gen);
Mant : constant Unsigned := V and Mant_Mask;
Rand_Bits : Unsigned_32;
Exp : Integer;
Bits_Left : Integer;
Result : Real;
begin
Rand_Bits := Unsigned_32 (Shift_Right (V, Adjust32));
Exp := 0;
......@@ -271,6 +271,7 @@ package body System.Random_Numbers is
Rand_Bits := Random (Gen);
end if;
end loop;
return Result;
end;
end if;
......
gcc/ada/sem_aggr.adb
......@@ -1800,8 +1800,8 @@ package body Sem_Aggr is
elsif Is_Tagged_Type (Etype (Expression (Assoc))) then
Check_Dynamically_Tagged_Expression
(Expr => Expression (Assoc),
Typ => Component_Type (Etype (N)),
(Expr => Expression (Assoc),
Typ => Component_Type (Etype (N)),
Related_Nod => N);
end if;
......
gcc/ada/types.ads
......@@ -503,10 +503,10 @@ package Types is
-- The type Char is used for character data internally in the compiler, but
-- character codes in the source are represented by the Char_Code type.
-- Each character literal in the source is interpreted as being one of the
-- 16#7FFF_FFFF possible Wide_Wide_Character codes, and a unique Integer
-- Value is assigned, corresponding to the UTF_32 value, which also
-- corresponds to the POS value in the Wide_Wide_Character type, and also
-- corresponds to the POS value in the Wide_Character and Character types
-- 16#7FFF_FFFF# possible Wide_Wide_Character codes, and a unique Integer
-- value is assigned, corresponding to the UTF-32 value, which also
-- corresponds to the Pos value in the Wide_Wide_Character type, and also
-- corresponds to the Pos value in the Wide_Character and Character types
-- for values that are in appropriate range. String literals are similarly
-- interpreted as a sequence of such codes.
......
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