2005-11-14 Robert Dewar <dewar@adacore.com>

	    Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb: Implement Machine_Rounding attribute
	(Analyze_Access_Attribute): The access attribute may appear within an
	aggregate that has been expanded into a loop.
	(Check_Task_Prefix): Add semantic check for attribute 'Callable and
	'Terminated whenever the prefix is of a task interface class-wide type.
	(Analyze_Attribute): Add semantic check for attribute 'Identity whenever
	the prefix is of a task interface class-wide type.

	* s-vaflop-vms-alpha.adb: Valid_D, Valid_F, Valid_G: Make Val constant
	to avoid warnings.

	* s-fatgen.ads, s-fatgen.adb (Machine_Rounding): New function
	Remove pragma Inline for [Unaligned_]Valid.
	Add comments that Valid routines do not work for Vax_Float

	* exp_attr.adb: Implement Machine_Rounding attribute

	* snames.h: Add entry for Machine_Rounding attribute



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@106970 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 73 insertions, 48 deletions

diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb
index 2bdb9363bc3..9d4b5042d69 100644
--- a/gcc/ada/s-fatgen.adb
+++ b/gcc/ada/s-fatgen.adb
@@ -99,10 +99,8 @@ package body System.Fat_Gen is
    begin
       if Towards = X then
          return X;
-
       elsif Towards > X then
          return Succ (X);
-
       else
          return Pred (X);
       end if;
@@ -114,14 +112,11 @@ package body System.Fat_Gen is
 
    function Ceiling (X : T) return T is
       XT : constant T := Truncation (X);
-
    begin
       if X <= 0.0 then
          return XT;
-
       elsif X = XT then
          return X;
-
       else
          return XT + 1.0;
       end if;
@@ -175,7 +170,7 @@ package body System.Fat_Gen is
          --  T'Machine_Emin - T'Machine_Mantissa, which would preserve
          --  monotonicity of the exponent function ???
 
-      --  Check for infinities, transfinites, whatnot.
+      --  Check for infinities, transfinites, whatnot
 
       elsif X > T'Safe_Last then
          Frac := Invrad;
@@ -193,7 +188,7 @@ package body System.Fat_Gen is
             Ax : T  := abs X;
             Ex : UI := 0;
 
-         --  Ax * Rad ** Ex is invariant.
+         --  Ax * Rad ** Ex is invariant
 
          begin
             if Ax >= 1.0 then
@@ -256,7 +251,6 @@ package body System.Fat_Gen is
    function Exponent (X : T) return UI is
       X_Frac : T;
       X_Exp  : UI;
-
    begin
       Decompose (X, X_Frac, X_Exp);
       return X_Exp;
@@ -268,14 +262,11 @@ package body System.Fat_Gen is
 
    function Floor (X : T) return T is
       XT : constant T := Truncation (X);
-
    begin
       if X >= 0.0 then
          return XT;
-
       elsif XT = X then
          return X;
-
       else
          return XT - 1.0;
       end if;
@@ -288,7 +279,6 @@ package body System.Fat_Gen is
    function Fraction (X : T) return T is
       X_Frac : T;
       X_Exp  : UI;
-
    begin
       Decompose (X, X_Frac, X_Exp);
       return X_Frac;
@@ -366,6 +356,38 @@ package body System.Fat_Gen is
       return Temp;
    end Machine;
 
+   ----------------------
+   -- Machine_Rounding --
+   ----------------------
+
+   --  For now, the implementation is identical to that of Rounding, which is
+   --  a permissible behavior, but is not the most efficient possible approach.
+
+   function Machine_Rounding (X : T) return T is
+      Result : T;
+      Tail   : T;
+
+   begin
+      Result := Truncation (abs X);
+      Tail   := abs X - Result;
+
+      if Tail >= 0.5  then
+         Result := Result + 1.0;
+      end if;
+
+      if X > 0.0 then
+         return Result;
+
+      elsif X < 0.0 then
+         return -Result;
+
+      --  For zero case, make sure sign of zero is preserved
+
+      else
+         return X;
+      end if;
+   end Machine_Rounding;
+
    -----------
    -- Model --
    -----------
@@ -542,7 +564,7 @@ package body System.Fat_Gen is
          return X;
       end if;
 
-      --  Nonzero x. essentially, just multiply repeatedly by Rad ** (+-2**n).
+      --  Nonzero x. essentially, just multiply repeatedly by Rad ** (+-2**n)
 
       declare
          Y  : T  := X;
@@ -587,6 +609,7 @@ package body System.Fat_Gen is
                end if;
 
                --  0 <= Ex < Log_Power (N)
+
             end loop;
 
             --  Ex = 0
@@ -652,7 +675,7 @@ package body System.Fat_Gen is
 
    --  The basic approach is to compute
 
-   --    T'Machine (RM1 + N) - RM1.
+   --    T'Machine (RM1 + N) - RM1
 
    --  where N >= 0.0 and RM1 = radix ** (mantissa - 1)
 
@@ -693,7 +716,6 @@ package body System.Fat_Gen is
             return X;
          end if;
       end if;
-
    end Truncation;
 
    -----------------------
@@ -727,13 +749,16 @@ package body System.Fat_Gen is
       else
          return X;
       end if;
-
    end Unbiased_Rounding;
 
    -----------
    -- Valid --
    -----------
 
+   --  Note: this routine does not work for VAX float. We compensate for this
+   --  in Exp_Attr by using the Valid functions in Vax_Float_Operations rather
+   --  than the corresponding instantiation of this function.
+
    function Valid (X : access T) return Boolean is
 
       IEEE_Emin : constant Integer := T'Machine_Emin - 1;
@@ -744,17 +769,17 @@ package body System.Fat_Gen is
       subtype IEEE_Exponent_Range is
         Integer range IEEE_Emin - 1 .. IEEE_Emax + 1;
 
-      --  The implementation of this floating point attribute uses
-      --  a representation type Float_Rep that allows direct access to
-      --  the exponent and mantissa parts of a floating point number.
+      --  The implementation of this floating point attribute uses a
+      --  representation type Float_Rep that allows direct access to the
+      --  exponent and mantissa parts of a floating point number.
 
       --  The Float_Rep type is an array of Float_Word elements. This
-      --  representation is chosen to make it possible to size the
-      --  type based on a generic parameter. Since the array size is
-      --  known at compile-time, efficient code can still be generated.
-      --  The size of Float_Word elements should be large enough to allow
-      --  accessing the exponent in one read, but small enough so that all
-      --  floating point object sizes are a multiple of the Float_Word'Size.
+      --  representation is chosen to make it possible to size the type based
+      --  on a generic parameter. Since the array size is known at compile
+      --  time, efficient code can still be generated. The size of Float_Word
+      --  elements should be large enough to allow accessing the exponent in
+      --  one read, but small enough so that all floating point object sizes
+      --  are a multiple of the Float_Word'Size.
 
       --  The following conditions must be met for all possible
       --  instantiations of the attributes package:
@@ -764,9 +789,9 @@ package body System.Fat_Gen is
       --    - The exponent and sign are completely contained in a single
       --      component of Float_Rep, named Most_Significant_Word (MSW).
 
-      --    - The sign occupies the most significant bit of the MSW
-      --      and the exponent is in the following bits.
-      --      Unused bits (if any) are in the least significant part.
+      --    - The sign occupies the most significant bit of the MSW and the
+      --      exponent is in the following bits. Unused bits (if any) are in
+      --      the least significant part.
 
       type Float_Word is mod 2**Positive'Min (System.Word_Size, 32);
       type Rep_Index is range 0 .. 7;
@@ -775,12 +800,12 @@ package body System.Fat_Gen is
          (T'Size + Float_Word'Size - 1) / Float_Word'Size;
       Rep_Last  : constant Rep_Index := Rep_Index'Min
         (Rep_Index (Rep_Words - 1), (T'Mantissa + 16) / Float_Word'Size);
-      --  Determine the number of Float_Words needed for representing
-      --  the entire floating-poinit value. Do not take into account
-      --  excessive padding, as occurs on IA-64 where 80 bits floats get
-      --  padded to 128 bits. In general, the exponent field cannot
-      --  be larger than 15 bits, even for 128-bit floating-poin t types,
-      --  so the final format size won't be larger than T'Mantissa + 16.
+      --  Determine the number of Float_Words needed for representing the
+      --  entire floating-point value. Do not take into account excessive
+      --  padding, as occurs on IA-64 where 80 bits floats get padded to 128
+      --  bits. In general, the exponent field cannot be larger than 15 bits,
+      --  even for 128-bit floating-poin t types, so the final format size
+      --  won't be larger than T'Mantissa + 16.
 
       type Float_Rep is
          array (Rep_Index range 0 .. Rep_Index (Rep_Words - 1)) of Float_Word;
@@ -794,26 +819,26 @@ package body System.Fat_Gen is
 
       Most_Significant_Word : constant Rep_Index :=
                                 Rep_Last * Standard'Default_Bit_Order;
-      --  Finding the location of the Exponent_Word is a bit tricky.
-      --  In general we assume Word_Order = Bit_Order.
-      --  This expression needs to be refined for VMS.
+      --  Finding the location of the Exponent_Word is a bit tricky. In general
+      --  we assume Word_Order = Bit_Order. This expression needs to be refined
+      --  for VMS.
 
       Exponent_Factor : constant Float_Word :=
                           2**(Float_Word'Size - 1) /
                             Float_Word (IEEE_Emax - IEEE_Emin + 3) *
                               Boolean'Pos (Most_Significant_Word /= 2) +
                                 Boolean'Pos (Most_Significant_Word = 2);
-      --  Factor that the extracted exponent needs to be divided by
-      --  to be in range 0 .. IEEE_Emax - IEEE_Emin + 2.
-      --  Special kludge: Exponent_Factor is 1 for x86/IA64 double extended
-      --  as GCC adds unused bits to the type.
+      --  Factor that the extracted exponent needs to be divided by to be in
+      --  range 0 .. IEEE_Emax - IEEE_Emin + 2. Special kludge: Exponent_Factor
+      --  is 1 for x86/IA64 double extended as GCC adds unused bits to the
+      --  type.
 
       Exponent_Mask : constant Float_Word :=
                         Float_Word (IEEE_Emax - IEEE_Emin + 2) *
                           Exponent_Factor;
-      --  Value needed to mask out the exponent field.
-      --  This assumes that the range IEEE_Emin - 1 .. IEEE_Emax + 1
-      --  contains 2**N values, for some N in Natural.
+      --  Value needed to mask out the exponent field. This assumes that the
+      --  range IEEE_Emin - 1 .. IEEE_Emax + contains 2**N values, for some N
+      --  in Natural.
 
       function To_Float is new Ada.Unchecked_Conversion (Float_Rep, T);
 
@@ -834,8 +859,8 @@ package body System.Fat_Gen is
              Integer ((R (Most_Significant_Word) and Exponent_Mask) /
                                                         Exponent_Factor)
                - IEEE_Bias;
-      --  Mask/Shift T to only get bits from the exponent
-      --  Then convert biased value to integer value.
+      --  Mask/Shift T to only get bits from the exponent. Then convert biased
+      --  value to integer value.
 
       SR : Float_Rep;
       --  Float_Rep representation of significant of X.all
@@ -843,8 +868,8 @@ package body System.Fat_Gen is
    begin
       if T'Denorm then
 
-         --  All denormalized numbers are valid, so only invalid numbers
-         --  are overflows and NaN's, both with exponent = Emax + 1.
+         --  All denormalized numbers are valid, so only invalid numbers are
+         --  overflows and NaN's, both with exponent = Emax + 1.
 
          return E /= IEEE_Emax + 1;