diff options
Diffstat (limited to 'gcc/ada/s-fatgen.adb')
| -rw-r--r-- | gcc/ada/s-fatgen.adb | 121 |
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; |