[multiple changes]

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

	* s-rannum.adb: Minor reformatting.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* sem_aux.adb, sem_aux.ads, sem_util.adb, sem_util.ads, sem_elim.adb,
	exp_cg.adb: Minor code reorganization: Move routine Ultimate_Alias from
	package Sem_Util to package Sem_Aux.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Make_Secondary_DT, Make_DT): Minor code cleanup:
	remove useless restriction on imported routines when building the
	dispatch tables.

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

	* cstand.adb (Create_Standard): Set Has_Pragma_Pack for standard string
	types.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* sem_ch4.adb (Collect_Generic_Type_Ops): Protect code that handles
	generic subprogram declarations to ensure proper context. Add missing
	support for generic actuals.
	(Try_Primitive_Operation): Add missing support for concurrent types that
	have no Corresponding_Record_Type. Required to diagnose errors compiling
	generics or when compiling with no code generation (-gnatc).
	* sem_ch9.adb (Analyze_Protected_Type, Analyze_Task_Type): Do not build
	the corresponding record type.
	* sem_disp.ads, sem_disp.adb (Check_Dispatching_Operation): Complete
	documentation. Do minimum decoration when processing a primitive of a
	concurrent tagged type that covers interfaces. Required to diagnose
	errors in the Object.Operation notation compiling generics or under
	-gnatc.
	* exp_ch9.ads, exp_ch9.adb (Build_Corresponding_Record): Add missing
	propagation of attribute Interface_List to the corresponding record.
	(Expand_N_Task_Type_Declaration): Code cleanup.
	(Expand_N_Protected_Type_Declaration): Code cleanup.

From-SVN: r161203

1 files changed, 40 insertions, 20 deletions

diff --git a/gcc/ada/s-rannum.adb b/gcc/ada/s-rannum.adb
index aa61913..227949d 100644
--- a/gcc/ada/s-rannum.adb
+++ b/gcc/ada/s-rannum.adb
@@ -86,9 +86,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Calendar;              use Ada.Calendar;
+with Ada.Calendar;             use Ada.Calendar;
 with Ada.Unchecked_Conversion;
-with Interfaces;                use Interfaces;
+
+with Interfaces; use Interfaces;
 
 use Ada;
 
@@ -122,7 +123,9 @@ package body System.Random_Numbers is
    Image_Numeral_Length : constant := Max_Image_Width / N;
    subtype Image_String is String (1 .. Max_Image_Width);
 
-   --  Utility functions
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
 
    procedure Init (Gen : out Generator; Initiator : Unsigned_32);
    --  Perform a default initialization of the state of Gen. The resulting
@@ -199,6 +202,10 @@ package body System.Random_Numbers is
    --  assuming that Unsigned is large enough to hold the bits of a mantissa
    --  for type Real.
 
+   ---------------------------
+   -- Random_Float_Template --
+   ---------------------------
+
    function Random_Float_Template (Gen : Generator) return Real is
 
       pragma Compile_Time_Error
@@ -232,6 +239,7 @@ package body System.Random_Numbers is
       if Real'Machine_Radix /= 2 then
          return Real'Machine
            (Real (Unsigned'(Random (Gen))) * 2.0**(-Unsigned'Size));
+
       else
          declare
             type Bit_Count is range 0 .. 4;
@@ -239,8 +247,8 @@ package body System.Random_Numbers is
             subtype T is Real'Base;
 
             Trailing_Ones : constant array (Unsigned_32 range 0 .. 15)
-              of Bit_Count
-              :=  (2#00000# => 0, 2#00001# => 1, 2#00010# => 0, 2#00011# => 2,
+              of Bit_Count :=
+                  (2#00000# => 0, 2#00001# => 1, 2#00010# => 0, 2#00011# => 2,
                    2#00100# => 0, 2#00101# => 1, 2#00110# => 0, 2#00111# => 3,
                    2#01000# => 0, 2#01001# => 1, 2#01010# => 0, 2#01011# => 2,
                    2#01100# => 0, 2#01101# => 1, 2#01110# => 0, 2#01111# => 4);
@@ -255,21 +263,30 @@ package body System.Random_Numbers is
                          (Unsigned'Size - T'Machine_Mantissa + 1);
             --  Random bits left over after selecting mantissa
 
-            Mantissa   : Unsigned;
-            X          : Real;            -- Scaled mantissa
-            R          : Unsigned_32;     -- Supply of random bits
-            R_Bits     : Natural;         -- Number of bits left in R
+            Mantissa : Unsigned;
 
-            K          : Bit_Count;       -- Next decrement to exponent
-         begin
+            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;
             R := Unsigned_32 (Mantissa mod 2**Extra_Bits);
             R_Bits := Extra_Bits;
             X := Real (2**(T'Machine_Mantissa - 1) + Mantissa); -- Exact
 
-            if Extra_Bits < 4 and then R < 2**Extra_Bits - 1 then
+            if Extra_Bits < 4 and then R < 2 ** Extra_Bits - 1 then
+
                --  We got lucky and got a zero in our few extra bits
+
                K := Trailing_Ones (R);
 
             else
@@ -305,12 +322,11 @@ package body System.Random_Numbers is
                end loop Find_Zero;
             end if;
 
-            --  K has the count of trailing ones not reflected yet in X.
-            --  The following multiplication takes care of that, as well
-            --  as the correction to move the radix point to the left of
-            --  the mantissa. Doing it at the end avoids repeated rounding
-            --  errors in the exceedingly unlikely case of ever having
-            --  a subnormal result.
+            --  K has the count of trailing ones not reflected yet in X. The
+            --  following multiplication takes care of that, as well as the
+            --  correction to move the radix point to the left of the mantissa.
+            --  Doing it at the end avoids repeated rounding errors in the
+            --  exceedingly unlikely case of ever having a subnormal result.
 
             X := X * Pow_Tab (K);
 
@@ -330,6 +346,10 @@ package body System.Random_Numbers is
       end if;
    end Random_Float_Template;
 
+   ------------
+   -- Random --
+   ------------
+
    function Random (Gen : Generator) return Float is
       function F is new Random_Float_Template (Unsigned_32, Float);
    begin
@@ -371,7 +391,7 @@ package body System.Random_Numbers is
             --  Ignore different-size warnings here; since GNAT's handling
             --  is correct.
 
-            pragma Warnings ("Z");
+            pragma Warnings ("Z");  -- better to use msg string! ???
             function Conv_To_Unsigned is
                new Unchecked_Conversion (Result_Subtype'Base, Unsigned_64);
             function Conv_To_Result is
@@ -489,7 +509,7 @@ package body System.Random_Numbers is
       I, J : Integer;
 
    begin
-      Init (Gen, 19650218);
+      Init (Gen, 19650218); -- please give this constant a name ???
       I := 1;
       J := 0;