-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
Invrad : constant T := 1.0 / Rad;
subtype Expbits is Integer range 0 .. 6;
- -- 2 ** (2 ** 7) might overflow. how big can radix-16 exponents get?
+ -- 2 ** (2 ** 7) might overflow. How big can radix-16 exponents get?
Log_Power : constant array (Expbits) of Integer := (1, 2, 4, 8, 16, 32, 64);
begin
if Towards = X then
return X;
-
elsif Towards > X then
return Succ (X);
-
else
return Pred (X);
end if;
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;
function Compose (Fraction : T; Exponent : UI) return T is
Arg_Frac : T;
Arg_Exp : UI;
+ pragma Unreferenced (Arg_Exp);
begin
Decompose (Fraction, Arg_Frac, Arg_Exp);
return Scaling (Arg_Frac, Exponent);
-- 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;
Ax : T := abs X;
Ex : UI := 0;
- -- Ax * Rad ** Ex is invariant.
+ -- Ax * Rad ** Ex is invariant
begin
if Ax >= 1.0 then
function Exponent (X : T) return UI is
X_Frac : T;
X_Exp : UI;
-
+ pragma Unreferenced (X_Frac);
begin
Decompose (X, X_Frac, X_Exp);
return X_Exp;
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;
function Fraction (X : T) return T is
X_Frac : T;
X_Exp : UI;
-
+ pragma Unreferenced (X_Exp);
begin
Decompose (X, X_Frac, X_Exp);
return X_Frac;
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 --
-----------
B : T;
Arg : T;
P : T;
- Arg_Frac : T;
P_Frac : T;
Sign_X : T;
IEEE_Rem : T;
K : UI;
P_Even : Boolean;
+ Arg_Frac : T;
+ pragma Unreferenced (Arg_Frac);
+
begin
if Y = 0.0 then
raise Constraint_Error;
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;
end if;
-- 0 <= Ex < Log_Power (N)
+
end loop;
-- Ex = 0
-- since the exponent is going to be reduced.
-- Note that X_Frac has the same sign as X, so if X_Frac is -0.5,
- -- then we know that we have a ngeative number (and hence a
+ -- then we know that we have a negative number (and hence a
-- negative power of 2).
if X_Frac = -0.5 then
-- 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)
return X;
end if;
end if;
-
end Truncation;
-----------------------
else
return X;
end if;
-
end Unbiased_Rounding;
-----------
-- Valid --
-----------
- function Valid (X : access T) return Boolean is
+ -- 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 : not null access T) return Boolean is
IEEE_Emin : constant Integer := T'Machine_Emin - 1;
IEEE_Emax : constant Integer := T'Machine_Emax - 1;
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:
-- - 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;
(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-point 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;
pragma Suppress_Initialization (Float_Rep);
- -- This pragma supresses the generation of an initialization procedure
+ -- This pragma suppresses the generation of an initialization procedure
-- for type Float_Rep when operating in Initialize/Normalize_Scalars
-- mode. This is not just a matter of efficiency, but of functionality,
-- since Valid has a pragma Inline_Always, which is not permitted if
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);
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
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 the only invalid numbers
+ -- are overflows and NaNs, both with exponent = Emax + 1.
return E /= IEEE_Emax + 1;
Local_T : aliased T;
begin
+ -- Note that we have to be sure that we do not load the value into a
+ -- floating-point register, since a signalling NaN may cause a trap.
+ -- The following assignment is what does the actual alignment, since
+ -- we know that the target Local_T is aligned.
+
To_FSP (Local_T'Address).all := To_FSP (A).all;
+
+ -- Now that we have an aligned value, we can use the normal aligned
+ -- version of Valid to obtain the required result.
+
return Valid (Local_T'Access);
end Unaligned_Valid;
OSDN Git Service
