-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 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- --
package body System.Fat_Gen is
Float_Radix : constant T := T (T'Machine_Radix);
- Float_Radix_Inv : constant T := 1.0 / Float_Radix;
Radix_To_M_Minus_1 : constant T := Float_Radix ** (T'Machine_Mantissa - 1);
pragma Assert (T'Machine_Radix = 2);
-----------------------
procedure Decompose (XX : T; Frac : out T; Expo : out UI);
- -- Decomposes a floating-point number into fraction and exponent parts
+ -- Decomposes a floating-point number into fraction and exponent parts.
+ -- Both results are signed, with Frac having the sign of XX, and UI has
+ -- the sign of the exponent. The absolute value of Frac is in the range
+ -- 0.0 <= Frac < 1.0. If Frac = 0.0 or -0.0, then Expo is always zero.
function Gradual_Scaling (Adjustment : UI) return T;
-- Like Scaling with a first argument of 1.0, but returns the smallest
function Compose (Fraction : T; Exponent : UI) return T is
Arg_Frac : T;
Arg_Exp : UI;
-
begin
Decompose (Fraction, Arg_Frac, Arg_Exp);
return Scaling (Arg_Frac, Exponent);
---------------
procedure Decompose (XX : T; Frac : out T; Expo : out UI) is
- X : T := T'Machine (XX);
+ X : constant T := T'Machine (XX);
begin
if X = 0.0 then
Ex : UI := Adjustment;
begin
- if Adjustment < T'Machine_Emin then
+ if Adjustment < T'Machine_Emin - 1 then
Y := 2.0 ** T'Machine_Emin;
Y1 := Y;
Ex := Ex - T'Machine_Emin;
-
- while Ex <= 0 loop
+ while Ex < 0 loop
Y := T'Machine (Y / 2.0);
if Y = 0.0 then
if Radix_Digits >= T'Machine_Mantissa then
return X;
+ elsif Radix_Digits <= 0 then
+ raise Constraint_Error;
+
else
L := Exponent (X) - Radix_Digits;
Y := Truncation (Scaling (X, -L));
Z := Scaling (Y, L);
return Z;
end if;
-
end Leading_Part;
-------------
function Machine (X : T) return T is
Temp : T;
pragma Volatile (Temp);
-
begin
Temp := X;
return Temp;
-- two, then we want to subtract half of what we would otherwise
-- subtract, since the exponent is going to be reduced.
- if X_Frac = 0.5 and then X > 0.0 then
+ -- Note that X_Frac has the same sign as X, so if X_Frac is 0.5,
+ -- then we know that we have a positive number (and hence a
+ -- positive power of 2).
+
+ if X_Frac = 0.5 then
return X - Gradual_Scaling (X_Exp - T'Machine_Mantissa - 1);
- -- Otherwise the exponent stays the same
+ -- Otherwise the exponent is unchanged
else
return X - Gradual_Scaling (X_Exp - T'Machine_Mantissa);
P_Even : Boolean;
begin
+ if Y = 0.0 then
+ raise Constraint_Error;
+ end if;
+
if X > 0.0 then
Sign_X := 1.0;
Arg := X;
end if;
return Sign_X * IEEE_Rem;
-
end Remainder;
--------------
else
return X;
end if;
-
end Rounding;
-------------
-- Ex = 0
end if;
+
return Y;
end;
end Scaling;
-- two, then we want to add half of what we would otherwise add,
-- since the exponent is going to be reduced.
- if X_Frac = 0.5 and then X < 0.0 then
+ -- 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
+ -- negative power of 2).
+
+ if X_Frac = -0.5 then
return X + Gradual_Scaling (X_Exp - T'Machine_Mantissa - 1);
- -- Otherwise the exponent stays the same
+ -- Otherwise the exponent is unchanged
else
return X + Gradual_Scaling (X_Exp - T'Machine_Mantissa);
-- 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.
+ -- 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:
-- and the exponent is in the following bits.
-- Unused bits (if any) are in the least significant part.
- type Float_Word is mod 2**32;
+ type Float_Word is mod 2**Positive'Min (System.Word_Size, 32);
type Rep_Index is range 0 .. 7;
- Rep_Last : constant Rep_Index := (T'Size - 1) / Float_Word'Size;
-
- type Float_Rep is array (Rep_Index range 0 .. Rep_Last) of Float_Word;
+ Rep_Words : constant Positive :=
+ (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.
+
+ 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
+ -- 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
+ -- there are nested subprograms present.
Most_Significant_Word : constant Rep_Index :=
Rep_Last * Standard'Default_Bit_Order;
Exponent_Factor : constant Float_Word :=
2**(Float_Word'Size - 1) /
Float_Word (IEEE_Emax - IEEE_Emin + 3) *
- Boolean'Pos (T'Size /= 96) +
- Boolean'Pos (T'Size = 96);
+ 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 0 for x86 double extended
- -- as GCC adds 16 unused bits to the type.
+ -- 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) *
((E = IEEE_Emin - 1) and then abs To_Float (SR) = 1.0);
end Valid;
+ ---------------------
+ -- Unaligned_Valid --
+ ---------------------
+
+ function Unaligned_Valid (A : System.Address) return Boolean is
+ subtype FS is String (1 .. T'Size / Character'Size);
+ type FSP is access FS;
+
+ function To_FSP is new Ada.Unchecked_Conversion (Address, FSP);
+
+ Local_T : aliased T;
+
+ begin
+ To_FSP (Local_T'Address).all := To_FSP (A).all;
+ return Valid (Local_T'Access);
+ end Unaligned_Valid;
+
end System.Fat_Gen;
projects / thirdparty / gcc.git / blobdiff