+2010-10-22 Geert Bosch <bosch@adacore.com>
+
+ * gcc-interface/Make-lang.in: Remove ttypef.ads
+ * checks.adb: Use Machine_Mantissa_Value and Machine_Radix_Value instead
+ of Machine_Mantissa and Machine_Radix.
+ * cstand.adb (P_Float_Range): Directly print the Type_Low_Bound and
+ Type_High_Bound of the type, instead of choosing constants from Ttypef.
+ (Set_Float_Bounds): Compute the bounds based on Machine_Radix_Value,
+ Machine_Emax_Value and Machine_Mantissa_Value instead of special-casing
+ each type.
+ * einfo.ads (Machine_Emax_Value, Machine_Emin_Value,
+ Machine_Mantissa_Value, Machine_Radix_Value, Model_Emin_Value,
+ Model_Epsilon_Value, Model_Mantissa_Value, Model_Small_Value,
+ Safe_Emax_Value, Safe_First_Value, Safe_Last_Value): Add new
+ synthesized floating point attributes.
+ * einfo.adb (Float_Rep): Determine the kind of floating point
+ representation used for a given type.
+ (Machine_Emax_Value, Machine_Emin_Value, Machine_Mantissa_Value,
+ Machine_Radix_Value): Implement based on Float_Rep_Kind of a type and
+ the number of digits in the type.
+ (Model_Emin_Value, Model_Epsilon_Value, Model_Mantissa_Value,
+ Model_Small_Value, Safe_Emax_Value, Safe_First_Value, Safe_Last_Value):
+ Implement new synthesized floating point attributes based on the various
+ machine attributes.
+ * eval_fat.ads: Remove Machine_Mantissa and Machine_Radix.
+ * eval_fat.adb (Machine_Mantissa, Machine_Radix): Remove. Use the
+ Machine_Mantissa_Value and Machine_Radix_Value functions instead.
+ * exp_vfpt.adb (VAXFF_Digits, VAXDF_Digits, VAXFG_Digits): Define local
+ constants, instead of using constants from Ttypef.
+ * gnat_rm.texi: Reword comments referencing Ttypef.
+ * sem_attr.ads: Reword comment referencing Ttypef.
+ * sem_attr.adb (Float_Attribute_Universal_Integer,
+ Float_Attribute_Universal_Real): Remove.
+ (Attribute_Machine_Emax, Attribute_Machine_Emin,
+ Attribute_Machine_Mantissa, Attribute_Model_Epsilon,
+ Attribute_Model_Mantissa, Attribute_Model_Small, Attribute_Safe_Emax,
+ Attribute_Safe_First, Attribute_Safe_Last, Model_Small_Value): Use
+ attributes in Einfo instead of Float_Attribute_Universal_Real and
+ Float_Attribute_Universal_Integer and all explicit constants.
+ * sem_util.ads, sem_util.adb (Real_Convert): Remove.
+ * sem_vfpt.adb (VAXDF_Digits, VAXFF_Digits, VAXGF_Digits, IEEEL_Digits,
+ IEEES_Digits): New local constants, in order to remove dependency on
+ Ttypef.
+ * tbuild.ads (Make_Float_Literal): New function.
+ * tbuild.adb (Make_Float_Literal): New function to create a new
+ N_Real_Literal, constructing it as simple as possible for best
+ output of constants in -gnatS.
+ * ttypef.ads: Remove.
+
2010-10-22 Robert Dewar <dewar@adacore.com>
* checks.adb (Apply_Predicate_Check): Remove attempt at optimization
Truncate : constant Boolean := Float_Truncate (Par);
Max_Bound : constant Uint :=
UI_Expon
- (Machine_Radix (Expr_Type),
- Machine_Mantissa (Expr_Type) - 1) - 1;
+ (Machine_Radix_Value (Expr_Type),
+ Machine_Mantissa_Value (Expr_Type) - 1) - 1;
-- Largest bound, so bound plus or minus half is a machine number of F
with Targparm; use Targparm;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
-with Ttypef; use Ttypef;
with Scn;
with Sem_Mech; use Sem_Mech;
with Sem_Util; use Sem_Util;
-------------------
procedure P_Float_Range (Id : Entity_Id) is
- Digs : constant Nat := UI_To_Int (Digits_Value (Id));
-
begin
Write_Str (" range ");
-
- if Vax_Float (Id) then
- if Digs = VAXFF_Digits then
- Write_Str (VAXFF_First'Universal_Literal_String);
- Write_Str (" .. ");
- Write_Str (VAXFF_Last'Universal_Literal_String);
-
- elsif Digs = VAXDF_Digits then
- Write_Str (VAXDF_First'Universal_Literal_String);
- Write_Str (" .. ");
- Write_Str (VAXDF_Last'Universal_Literal_String);
-
- else
- pragma Assert (Digs = VAXGF_Digits);
-
- Write_Str (VAXGF_First'Universal_Literal_String);
- Write_Str (" .. ");
- Write_Str (VAXGF_Last'Universal_Literal_String);
- end if;
-
- elsif Is_AAMP_Float (Id) then
- if Digs = AAMPS_Digits then
- Write_Str (AAMPS_First'Universal_Literal_String);
- Write_Str (" .. ");
- Write_Str (AAMPS_Last'Universal_Literal_String);
-
- else
- pragma Assert (Digs = AAMPL_Digits);
- Write_Str (AAMPL_First'Universal_Literal_String);
- Write_Str (" .. ");
- Write_Str (AAMPL_Last'Universal_Literal_String);
- end if;
-
- elsif Digs = IEEES_Digits then
- Write_Str (IEEES_First'Universal_Literal_String);
- Write_Str (" .. ");
- Write_Str (IEEES_Last'Universal_Literal_String);
-
- elsif Digs = IEEEL_Digits then
- Write_Str (IEEEL_First'Universal_Literal_String);
- Write_Str (" .. ");
- Write_Str (IEEEL_Last'Universal_Literal_String);
-
- else
- pragma Assert (Digs = IEEEX_Digits);
-
- Write_Str (IEEEX_First'Universal_Literal_String);
- Write_Str (" .. ");
- Write_Str (IEEEX_Last'Universal_Literal_String);
- end if;
-
+ UR_Write (Realval (Type_Low_Bound (Id)));
+ Write_Str (" .. ");
+ UR_Write (Realval (Type_High_Bound (Id)));
Write_Str (";");
Write_Eol;
end P_Float_Range;
----------------------
procedure Set_Float_Bounds (Id : Entity_Id) is
- L : Node_Id;
+ L : Node_Id;
-- Low bound of literal value
- H : Node_Id;
+ H : Node_Id;
-- High bound of literal value
- R : Node_Id;
+ R : Node_Id;
-- Range specification
- Digs : constant Nat := UI_To_Int (Digits_Value (Id));
- -- Digits value, used to select bounds
+ Radix : constant Uint := Machine_Radix_Value (Id);
+ Mantissa : constant Uint := Machine_Mantissa_Value (Id);
+ Emax : constant Uint := Machine_Emax_Value (Id);
+ Significand : constant Uint := Radix ** Mantissa - 1;
+ Exponent : constant Uint := Emax - Mantissa;
begin
-- Note: for the call from Cstand to initially create the types in
-- Standard, Vax_Float will always be False. Circuitry in Sem_Vfpt
- -- will adjust these types appropriately in the Vax_Float case if
- -- a pragma Float_Representation (VAX_Float) is used.
-
- if Vax_Float (Id) then
- if Digs = VAXFF_Digits then
- L := Real_Convert
- (VAXFF_First'Universal_Literal_String);
- H := Real_Convert
- (VAXFF_Last'Universal_Literal_String);
-
- elsif Digs = VAXDF_Digits then
- L := Real_Convert
- (VAXDF_First'Universal_Literal_String);
- H := Real_Convert
- (VAXDF_Last'Universal_Literal_String);
-
- else
- pragma Assert (Digs = VAXGF_Digits);
-
- L := Real_Convert
- (VAXGF_First'Universal_Literal_String);
- H := Real_Convert
- (VAXGF_Last'Universal_Literal_String);
- end if;
-
- elsif Is_AAMP_Float (Id) then
- if Digs = AAMPS_Digits then
- L := Real_Convert
- (AAMPS_First'Universal_Literal_String);
- H := Real_Convert
- (AAMPS_Last'Universal_Literal_String);
-
- else
- pragma Assert (Digs = AAMPL_Digits);
- L := Real_Convert
- (AAMPL_First'Universal_Literal_String);
- H := Real_Convert
- (AAMPL_Last'Universal_Literal_String);
- end if;
+ -- will adjust these types appropriately in the Vax_Float case if a
+ -- pragma Float_Representation (VAX_Float) is used.
- elsif Digs = IEEES_Digits then
- L := Real_Convert
- (IEEES_First'Universal_Literal_String);
- H := Real_Convert
- (IEEES_Last'Universal_Literal_String);
-
- elsif Digs = IEEEL_Digits then
- L := Real_Convert
- (IEEEL_First'Universal_Literal_String);
- H := Real_Convert
- (IEEEL_Last'Universal_Literal_String);
-
- else
- pragma Assert (Digs = IEEEX_Digits);
-
- L := Real_Convert
- (IEEEX_First'Universal_Literal_String);
- H := Real_Convert
- (IEEEX_Last'Universal_Literal_String);
- end if;
+ H := Make_Float_Literal (Stloc, Radix, Significand, Exponent);
+ L := Make_Float_Literal (Stloc, Radix, -Significand, Exponent);
Set_Etype (L, Id);
Set_Is_Static_Expression (L);
pragma Style_Checks (All_Checks);
-- Turn off subprogram ordering, not used for this unit
-with Atree; use Atree;
-with Nlists; use Nlists;
-with Output; use Output;
-with Sinfo; use Sinfo;
-with Stand; use Stand;
+with Atree; use Atree;
+with Nlists; use Nlists;
+with Output; use Output;
+with Sinfo; use Sinfo;
+with Stand; use Stand;
+with Targparm; use Targparm;
package body Einfo is
-- (unused) Flag253
-- (unused) Flag254
+ -----------------
+ -- Local types --
+ -----------------
+
+ type Float_Rep_Kind is (IEEE_Binary, VAX_Native, AAMP);
+
-----------------------
-- Local subprograms --
-----------------------
-- Returns the attribute definition clause for Id whose name is Rep_Name.
-- Returns Empty if no matching attribute definition clause found for Id.
+ function Float_Rep (Id : E) return Float_Rep_Kind;
+ -- Returns the floating point representation used for the given type
+
+ ---------------
+ -- Float_Rep --
+ ---------------
+
+ function Float_Rep (Id : E) return Float_Rep_Kind is
+ pragma Assert (Is_Floating_Point_Type (Id));
+ begin
+ if AAMP_On_Target then
+ return AAMP;
+ elsif Vax_Float (Id) then
+ return VAX_Native;
+ else
+ return IEEE_Binary;
+ end if;
+ end Float_Rep;
+
----------------
-- Rep_Clause --
----------------
return Flag205 (Id);
end Low_Bound_Tested;
+ function Machine_Emax_Value (Id : E) return Uint is
+ Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
+
+ begin
+ case Float_Rep (Id) is
+ when IEEE_Binary =>
+ case Digs is
+ when 1 .. 6 => return Uint_128;
+ when 7 .. 15 => return 2**10;
+ when 16 .. 18 => return 2**14;
+ when others => return No_Uint;
+ end case;
+
+ when VAX_Native =>
+ case Digs is
+ when 1 .. 9 => return 2**7 - 1;
+ when 10 .. 15 => return 2**10 - 1;
+ when others => return No_Uint;
+ end case;
+
+ when AAMP =>
+ return Uint_2 ** Uint_7 - Uint_1;
+ end case;
+ end Machine_Emax_Value;
+
+ function Machine_Emin_Value (Id : E) return Uint is
+ begin
+ case Float_Rep (Id) is
+ when IEEE_Binary => return Uint_3 - Machine_Emax_Value (Id);
+ when VAX_Native => return -Machine_Emax_Value (Id);
+ when AAMP => return -Machine_Emax_Value (Id);
+ end case;
+ end Machine_Emin_Value;
+
+ function Machine_Mantissa_Value (Id : E) return Uint is
+ Digs : constant Pos := UI_To_Int (Digits_Value (Base_Type (Id)));
+
+ begin
+ case Float_Rep (Id) is
+ when IEEE_Binary =>
+ case Digs is
+ when 1 .. 6 => return Uint_24;
+ when 7 .. 15 => return UI_From_Int (53);
+ when 16 .. 18 => return Uint_64;
+ when others => return No_Uint;
+ end case;
+
+ when VAX_Native =>
+ case Digs is
+ when 1 .. 6 => return Uint_24;
+ when 7 .. 9 => return UI_From_Int (56);
+ when 10 .. 15 => return UI_From_Int (53);
+ when others => return No_Uint;
+ end case;
+
+ when AAMP =>
+ case Digs is
+ when 1 .. 6 => return Uint_24;
+ when 7 .. 9 => return UI_From_Int (40);
+ when others => return No_Uint;
+ end case;
+ end case;
+ end Machine_Mantissa_Value;
+
function Machine_Radix_10 (Id : E) return B is
begin
pragma Assert (Is_Decimal_Fixed_Point_Type (Id));
return Flag84 (Id);
end Machine_Radix_10;
+ function Machine_Radix_Value (Id : E) return U is
+ begin
+ case Float_Rep (Id) is
+ when IEEE_Binary | VAX_Native | AAMP =>
+ return Uint_2;
+ end case;
+ end Machine_Radix_Value;
+
function Master_Id (Id : E) return E is
begin
pragma Assert (Is_Access_Type (Id));
return UI_To_Int (Uint8 (Id));
end Mechanism;
+ function Model_Emin_Value (Id : E) return Uint is
+ begin
+ return Machine_Emin_Value (Id);
+ end Model_Emin_Value;
+
+ function Model_Epsilon_Value (Id : E) return Ureal is
+ Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
+ begin
+ return Radix ** (1 - Model_Mantissa_Value (Id));
+ end Model_Epsilon_Value;
+
+ function Model_Mantissa_Value (Id : E) return Uint is
+ begin
+ return Machine_Mantissa_Value (Id);
+ end Model_Mantissa_Value;
+
+ function Model_Small_Value (Id : E) return Ureal is
+ Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id));
+ begin
+ return Radix ** (Model_Emin_Value (Id) - 1);
+ end Model_Small_Value;
+
function Modulus (Id : E) return Uint is
begin
pragma Assert (Is_Modular_Integer_Type (Id));
return Uint13 (Id);
end RM_Size;
+ function Safe_Emax_Value (Id : E) return Uint is
+ begin
+ return Machine_Emax_Value (Id);
+ end Safe_Emax_Value;
+
+ function Safe_First_Value (Id : E) return Ureal is
+ begin
+ return -Safe_Last_Value (Id);
+ end Safe_First_Value;
+
+ function Safe_Last_Value (Id : E) return Ureal is
+ Radix : constant Uint := Machine_Radix_Value (Id);
+ Mantissa : constant Uint := Machine_Mantissa_Value (Id);
+ Emax : constant Uint := Safe_Emax_Value (Id);
+ Significand : constant Uint := Radix ** Mantissa - 1;
+ Exponent : constant Uint := Emax - Mantissa;
+ begin
+ if Radix = 2 then
+ return
+ UR_From_Components
+ (Num => Significand * 2 ** (Exponent mod 4),
+ Den => -Exponent / 4,
+ Rbase => 16);
+ else
+ return
+ UR_From_Components
+ (Num => Significand,
+ Den => -Exponent,
+ Rbase => 16);
+ end if;
+ end Safe_Last_Value;
+
function Scalar_Range (Id : E) return N is
begin
return Node20 (Id);
-- of analyzing default expressions.
P := Id;
-
loop
P := Next_Entity (P);
-- E_Floating_Point_Type
-- E_Floating_Point_Subtype
-- Digits_Value (Uint17)
+ -- Machine_Emax_Value (synth)
+ -- Machine_Emin_Value (synth)
+ -- Machine_Mantissa_Value (synth)
+ -- Machine_Radix_Value (synth)
+ -- Model_Emin_Value (synth)
+ -- Model_Epsilon_Value (synth)
+ -- Model_Mantissa_Value (synth)
+ -- Model_Small_Value (synth)
+ -- Safe_Emax_Value (synth)
+ -- Safe_First_Value (synth)
+ -- Safe_Last_Value (synth)
-- Scalar_Range (Node20)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
function Is_Task_Record_Type (Id : E) return B;
function Is_Wrapper_Package (Id : E) return B;
function Last_Formal (Id : E) return E;
+ function Machine_Emax_Value (Id : E) return U;
+ function Machine_Emin_Value (Id : E) return U;
+ function Machine_Mantissa_Value (Id : E) return U;
+ function Machine_Radix_Value (Id : E) return U;
+ function Model_Emin_Value (Id : E) return U;
+ function Model_Epsilon_Value (Id : E) return R;
+ function Model_Mantissa_Value (Id : E) return U;
+ function Model_Small_Value (Id : E) return R;
function Next_Component (Id : E) return E;
function Next_Component_Or_Discriminant (Id : E) return E;
function Next_Discriminant (Id : E) return E;
function Parameter_Mode (Id : E) return Formal_Kind;
function Primitive_Operations (Id : E) return L;
function Root_Type (Id : E) return E;
+ function Safe_Emax_Value (Id : E) return U;
+ function Safe_First_Value (Id : E) return R;
+ function Safe_Last_Value (Id : E) return R;
function Scope_Depth_Set (Id : E) return B;
function Size_Clause (Id : E) return N;
function Stream_Size_Clause (Id : E) return N;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
with Einfo; use Einfo;
with Errout; use Errout;
-with Sem_Util; use Sem_Util;
-with Ttypef; use Ttypef;
with Targparm; use Targparm;
package body Eval_Fat is
Mode : Rounding_Mode);
-- This is similar to Decompose, except that the Fraction value returned
-- is an integer representing the value Fraction * Scale, where Scale is
- -- the value (Radix ** Machine_Mantissa (RT)). The value is obtained by
- -- using biased rounding (halfway cases round away from zero), round to
- -- even, a floor operation or a ceiling operation depending on the setting
- -- of Mode (see corresponding descriptions in Urealp).
-
- function Machine_Emin (RT : R) return Int;
- -- Return value of the Machine_Emin attribute
+ -- the value (Machine_Radix_Value (RT) ** Machine_Mantissa_Value (RT)). The
+ -- value is obtained by using biased rounding (halfway cases round away
+ -- from zero), round to even, a floor operation or a ceiling operation
+ -- depending on the setting of Mode (see corresponding descriptions in
+ -- Urealp).
--------------
-- Adjacent --
Fraction := UR_From_Components
(Num => Int_F,
- Den => UI_From_Int (Machine_Mantissa (RT)),
+ Den => Machine_Mantissa_Value (RT),
Rbase => Radix,
Negative => False);
-- True iff Fraction is even
Most_Significant_Digit : constant UI :=
- Radix ** (Machine_Mantissa (RT) - 1);
+ Radix ** (Machine_Mantissa_Value (RT) - 1);
Uintp_Mark : Uintp.Save_Mark;
-- The code is divided into blocks that systematically release
------------------
function Leading_Part (RT : R; X : T; Radix_Digits : UI) return T is
- RD : constant UI := UI_Min (Radix_Digits, Machine_Mantissa (RT));
+ RD : constant UI := UI_Min (Radix_Digits, Machine_Mantissa_Value (RT));
L : UI;
Y : T;
begin
is
X_Frac : T;
X_Exp : UI;
- Emin : constant UI := UI_From_Int (Machine_Emin (RT));
+ Emin : constant UI := Machine_Emin_Value (RT);
begin
Decompose (RT, X, X_Frac, X_Exp, Mode);
if X_Exp < Emin then
declare
- Emin_Den : constant UI :=
- UI_From_Int
- (Machine_Emin (RT) - Machine_Mantissa (RT) + 1);
+ Emin_Den : constant UI := Machine_Emin_Value (RT)
+ - Machine_Mantissa_Value (RT) + Uint_1;
begin
if X_Exp < Emin_Den or not Denorm_On_Target then
if UR_Is_Negative (X) then
return Scaling (RT, X_Frac, X_Exp);
end Machine;
- ------------------
- -- Machine_Emin --
- ------------------
-
- function Machine_Emin (RT : R) return Int is
- Digs : constant UI := Digits_Value (RT);
- Emin : Int;
-
- begin
- if Vax_Float (RT) then
- if Digs = VAXFF_Digits then
- Emin := VAXFF_Machine_Emin;
-
- elsif Digs = VAXDF_Digits then
- Emin := VAXDF_Machine_Emin;
-
- else
- pragma Assert (Digs = VAXGF_Digits);
- Emin := VAXGF_Machine_Emin;
- end if;
-
- elsif Is_AAMP_Float (RT) then
- if Digs = AAMPS_Digits then
- Emin := AAMPS_Machine_Emin;
-
- else
- pragma Assert (Digs = AAMPL_Digits);
- Emin := AAMPL_Machine_Emin;
- end if;
-
- else
- if Digs = IEEES_Digits then
- Emin := IEEES_Machine_Emin;
-
- elsif Digs = IEEEL_Digits then
- Emin := IEEEL_Machine_Emin;
-
- else
- pragma Assert (Digs = IEEEX_Digits);
- Emin := IEEEX_Machine_Emin;
- end if;
- end if;
-
- return Emin;
- end Machine_Emin;
-
- ----------------------
- -- Machine_Mantissa --
- ----------------------
-
- function Machine_Mantissa (RT : R) return Nat is
- Digs : constant UI := Digits_Value (RT);
- Mant : Nat;
-
- begin
- if Vax_Float (RT) then
- if Digs = VAXFF_Digits then
- Mant := VAXFF_Machine_Mantissa;
-
- elsif Digs = VAXDF_Digits then
- Mant := VAXDF_Machine_Mantissa;
-
- else
- pragma Assert (Digs = VAXGF_Digits);
- Mant := VAXGF_Machine_Mantissa;
- end if;
-
- elsif Is_AAMP_Float (RT) then
- if Digs = AAMPS_Digits then
- Mant := AAMPS_Machine_Mantissa;
-
- else
- pragma Assert (Digs = AAMPL_Digits);
- Mant := AAMPL_Machine_Mantissa;
- end if;
-
- else
- if Digs = IEEES_Digits then
- Mant := IEEES_Machine_Mantissa;
-
- elsif Digs = IEEEL_Digits then
- Mant := IEEEL_Machine_Mantissa;
-
- else
- pragma Assert (Digs = IEEEX_Digits);
- Mant := IEEEX_Machine_Mantissa;
- end if;
- end if;
-
- return Mant;
- end Machine_Mantissa;
-
- -------------------
- -- Machine_Radix --
- -------------------
-
- function Machine_Radix (RT : R) return Nat is
- pragma Warnings (Off, RT);
- begin
- return Radix;
- end Machine_Radix;
-
-----------
-- Model --
-----------
----------
function Succ (RT : R; X : T) return T is
- Emin : constant UI := UI_From_Int (Machine_Emin (RT));
- Mantissa : constant UI := UI_From_Int (Machine_Mantissa (RT));
+ Emin : constant UI := Machine_Emin_Value (RT);
+ Mantissa : constant UI := Machine_Mantissa_Value (RT);
Exp : UI := UI_Max (Emin, Exponent (RT, X));
Frac : T;
New_Frac : T;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
function Leading_Part (RT : R; X : T; Radix_Digits : UI) return T;
- function Machine_Mantissa (RT : R) return Nat;
-
- function Machine_Radix (RT : R) return Nat;
-
function Model (RT : R; X : T) return T;
function Pred (RT : R; X : T) return T;
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2010, 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- --
with Sinfo; use Sinfo;
with Stand; use Stand;
with Tbuild; use Tbuild;
-with Ttypef; use Ttypef;
with Uintp; use Uintp;
with Urealp; use Urealp;
package body Exp_VFpt is
+ VAXFF_Digits : constant := 6;
+ VAXDF_Digits : constant := 9;
+ VAXGF_Digits : constant := 15;
+
----------------------
-- Expand_Vax_Arith --
----------------------
ada/tree_io.o \
ada/treepr.o \
ada/treeprs.o \
- ada/ttypef.o \
ada/ttypes.o \
ada/types.o \
ada/uintp.o \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads ada/types.ads \
+ ada/tree_io.ads ada/ttypes.ads ada/types.ads \
ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
- ada/tree_io.ads ada/ttypef.ads ada/types.ads ada/uintp.ads \
+ ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
ada/urealp.adb
ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
- ada/tbuild.ads ada/tree_io.ads ada/ttypef.ads ada/types.ads \
+ ada/tbuild.ads ada/tree_io.ads ada/types.ads \
ada/uintp.ads ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads ada/urealp.adb
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tbuild.adb ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads \
+ ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
ada/types.ads ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
ada/validsw.ads ada/widechar.ads
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
- ada/tree_io.ads ada/ttypef.ads ada/types.ads ada/uintp.ads \
+ ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
ada/sem_warn.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/treeprs.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads
-ada/ttypef.o : ada/system.ads ada/ttypef.ads
-
ada/ttypes.o : ada/ada.ads ada/a-unccon.ads ada/get_targ.ads \
ada/system.ads ada/s-exctab.ads ada/s-stalib.ads ada/s-unstyp.ads \
ada/ttypes.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads
the number as defined in the original source. This allows the user
program to access the actual text of named numbers without intermediate
conversions and without the need to enclose the strings in quotes (which
-would preclude their use as numbers). This is used internally for the
-construction of values of the floating-point attributes from the file
-@file{ttypef.ads}, but may also be used by user programs.
+would preclude their use as numbers).
For example, the following program prints the first 50 digits of pi:
Annex is not supported. See A.5.3(72).
@end cartouche
@noindent
-See the source file @file{ttypef.ads} for the values of all numeric
-attributes.
+Run the compiler with @option{-gnatS} to produce a listing of package
+@code{Standard}, has the values of all numeric attributes.
@sp 1
@cartouche
with Stylesw; use Stylesw;
with Targparm; use Targparm;
with Ttypes; use Ttypes;
-with Ttypef; use Ttypef;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
with Urealp; use Urealp;
-- but compile time known value given by Val. It includes the
-- necessary checks for out of range values.
- procedure Float_Attribute_Universal_Integer
- (IEEES_Val : Int;
- IEEEL_Val : Int;
- IEEEX_Val : Int;
- VAXFF_Val : Int;
- VAXDF_Val : Int;
- VAXGF_Val : Int;
- AAMPS_Val : Int;
- AAMPL_Val : Int);
- -- This procedure evaluates a float attribute with no arguments that
- -- returns a universal integer result. The parameters give the values
- -- for the possible floating-point root types. See ttypef for details.
- -- The prefix type is a float type (and is thus not a generic type).
-
- procedure Float_Attribute_Universal_Real
- (IEEES_Val : String;
- IEEEL_Val : String;
- IEEEX_Val : String;
- VAXFF_Val : String;
- VAXDF_Val : String;
- VAXGF_Val : String;
- AAMPS_Val : String;
- AAMPL_Val : String);
- -- This procedure evaluates a float attribute with no arguments that
- -- returns a universal real result. The parameters give the values
- -- required for the possible floating-point root types in string
- -- format as real literals with a possible leading minus sign.
- -- The prefix type is a float type (and is thus not a generic type).
-
function Fore_Value return Nat;
-- Computes the Fore value for the current attribute prefix, which is
-- known to be a static fixed-point type. Used by Fore and Width.
Compile_Time_Known_Value (Type_High_Bound (Typ));
end Compile_Time_Known_Bounds;
- ---------------------------------------
- -- Float_Attribute_Universal_Integer --
- ---------------------------------------
-
- procedure Float_Attribute_Universal_Integer
- (IEEES_Val : Int;
- IEEEL_Val : Int;
- IEEEX_Val : Int;
- VAXFF_Val : Int;
- VAXDF_Val : Int;
- VAXGF_Val : Int;
- AAMPS_Val : Int;
- AAMPL_Val : Int)
- is
- Val : Int;
- Digs : constant Nat := UI_To_Int (Digits_Value (P_Base_Type));
-
- begin
- if Vax_Float (P_Base_Type) then
- if Digs = VAXFF_Digits then
- Val := VAXFF_Val;
- elsif Digs = VAXDF_Digits then
- Val := VAXDF_Val;
- else pragma Assert (Digs = VAXGF_Digits);
- Val := VAXGF_Val;
- end if;
-
- elsif Is_AAMP_Float (P_Base_Type) then
- if Digs = AAMPS_Digits then
- Val := AAMPS_Val;
- else pragma Assert (Digs = AAMPL_Digits);
- Val := AAMPL_Val;
- end if;
-
- else
- if Digs = IEEES_Digits then
- Val := IEEES_Val;
- elsif Digs = IEEEL_Digits then
- Val := IEEEL_Val;
- else pragma Assert (Digs = IEEEX_Digits);
- Val := IEEEX_Val;
- end if;
- end if;
-
- Fold_Uint (N, UI_From_Int (Val), True);
- end Float_Attribute_Universal_Integer;
-
- ------------------------------------
- -- Float_Attribute_Universal_Real --
- ------------------------------------
-
- procedure Float_Attribute_Universal_Real
- (IEEES_Val : String;
- IEEEL_Val : String;
- IEEEX_Val : String;
- VAXFF_Val : String;
- VAXDF_Val : String;
- VAXGF_Val : String;
- AAMPS_Val : String;
- AAMPL_Val : String)
- is
- Val : Node_Id;
- Digs : constant Nat := UI_To_Int (Digits_Value (P_Base_Type));
-
- begin
- if Vax_Float (P_Base_Type) then
- if Digs = VAXFF_Digits then
- Val := Real_Convert (VAXFF_Val);
- elsif Digs = VAXDF_Digits then
- Val := Real_Convert (VAXDF_Val);
- else pragma Assert (Digs = VAXGF_Digits);
- Val := Real_Convert (VAXGF_Val);
- end if;
-
- elsif Is_AAMP_Float (P_Base_Type) then
- if Digs = AAMPS_Digits then
- Val := Real_Convert (AAMPS_Val);
- else pragma Assert (Digs = AAMPL_Digits);
- Val := Real_Convert (AAMPL_Val);
- end if;
-
- else
- if Digs = IEEES_Digits then
- Val := Real_Convert (IEEES_Val);
- elsif Digs = IEEEL_Digits then
- Val := Real_Convert (IEEEL_Val);
- else pragma Assert (Digs = IEEEX_Digits);
- Val := Real_Convert (IEEEX_Val);
- end if;
- end if;
-
- Set_Sloc (Val, Loc);
- Rewrite (N, Val);
- Set_Is_Static_Expression (N, Static);
- Analyze_And_Resolve (N, C_Type);
- end Float_Attribute_Universal_Real;
-
----------------
-- Fore_Value --
----------------
------------------
when Attribute_Machine_Emax =>
- Float_Attribute_Universal_Integer (
- IEEES_Machine_Emax,
- IEEEL_Machine_Emax,
- IEEEX_Machine_Emax,
- VAXFF_Machine_Emax,
- VAXDF_Machine_Emax,
- VAXGF_Machine_Emax,
- AAMPS_Machine_Emax,
- AAMPL_Machine_Emax);
+ Fold_Uint (N, Machine_Emax_Value (P_Type), Static);
------------------
-- Machine_Emin --
------------------
when Attribute_Machine_Emin =>
- Float_Attribute_Universal_Integer (
- IEEES_Machine_Emin,
- IEEEL_Machine_Emin,
- IEEEX_Machine_Emin,
- VAXFF_Machine_Emin,
- VAXDF_Machine_Emin,
- VAXGF_Machine_Emin,
- AAMPS_Machine_Emin,
- AAMPL_Machine_Emin);
+ Fold_Uint (N, Machine_Emin_Value (P_Type), Static);
----------------------
-- Machine_Mantissa --
----------------------
when Attribute_Machine_Mantissa =>
- Float_Attribute_Universal_Integer (
- IEEES_Machine_Mantissa,
- IEEEL_Machine_Mantissa,
- IEEEX_Machine_Mantissa,
- VAXFF_Machine_Mantissa,
- VAXDF_Machine_Mantissa,
- VAXGF_Machine_Mantissa,
- AAMPS_Machine_Mantissa,
- AAMPL_Machine_Mantissa);
+ Fold_Uint (N, Machine_Mantissa_Value (P_Type), Static);
-----------------------
-- Machine_Overflows --
----------------
when Attribute_Model_Emin =>
- Float_Attribute_Universal_Integer (
- IEEES_Model_Emin,
- IEEEL_Model_Emin,
- IEEEX_Model_Emin,
- VAXFF_Model_Emin,
- VAXDF_Model_Emin,
- VAXGF_Model_Emin,
- AAMPS_Model_Emin,
- AAMPL_Model_Emin);
+ Fold_Uint (N, Model_Emin_Value (P_Base_Type), Static);
-------------------
-- Model_Epsilon --
-------------------
when Attribute_Model_Epsilon =>
- Float_Attribute_Universal_Real (
- IEEES_Model_Epsilon'Universal_Literal_String,
- IEEEL_Model_Epsilon'Universal_Literal_String,
- IEEEX_Model_Epsilon'Universal_Literal_String,
- VAXFF_Model_Epsilon'Universal_Literal_String,
- VAXDF_Model_Epsilon'Universal_Literal_String,
- VAXGF_Model_Epsilon'Universal_Literal_String,
- AAMPS_Model_Epsilon'Universal_Literal_String,
- AAMPL_Model_Epsilon'Universal_Literal_String);
+ Fold_Ureal (N, Model_Epsilon_Value (P_Base_Type), Static);
--------------------
-- Model_Mantissa --
--------------------
when Attribute_Model_Mantissa =>
- Float_Attribute_Universal_Integer (
- IEEES_Model_Mantissa,
- IEEEL_Model_Mantissa,
- IEEEX_Model_Mantissa,
- VAXFF_Model_Mantissa,
- VAXDF_Model_Mantissa,
- VAXGF_Model_Mantissa,
- AAMPS_Model_Mantissa,
- AAMPL_Model_Mantissa);
+ Fold_Uint (N, Model_Mantissa_Value (P_Base_Type), Static);
-----------------
-- Model_Small --
-----------------
when Attribute_Model_Small =>
- Float_Attribute_Universal_Real (
- IEEES_Model_Small'Universal_Literal_String,
- IEEEL_Model_Small'Universal_Literal_String,
- IEEEX_Model_Small'Universal_Literal_String,
- VAXFF_Model_Small'Universal_Literal_String,
- VAXDF_Model_Small'Universal_Literal_String,
- VAXGF_Model_Small'Universal_Literal_String,
- AAMPS_Model_Small'Universal_Literal_String,
- AAMPL_Model_Small'Universal_Literal_String);
+ Fold_Ureal (N, Model_Small_Value (P_Base_Type), Static);
-------------
-- Modulus --
---------------
when Attribute_Safe_Emax =>
- Float_Attribute_Universal_Integer (
- IEEES_Safe_Emax,
- IEEEL_Safe_Emax,
- IEEEX_Safe_Emax,
- VAXFF_Safe_Emax,
- VAXDF_Safe_Emax,
- VAXGF_Safe_Emax,
- AAMPS_Safe_Emax,
- AAMPL_Safe_Emax);
+ Fold_Uint (N, Safe_Emax_Value (P_Type), Static);
----------------
-- Safe_First --
----------------
when Attribute_Safe_First =>
- Float_Attribute_Universal_Real (
- IEEES_Safe_First'Universal_Literal_String,
- IEEEL_Safe_First'Universal_Literal_String,
- IEEEX_Safe_First'Universal_Literal_String,
- VAXFF_Safe_First'Universal_Literal_String,
- VAXDF_Safe_First'Universal_Literal_String,
- VAXGF_Safe_First'Universal_Literal_String,
- AAMPS_Safe_First'Universal_Literal_String,
- AAMPL_Safe_First'Universal_Literal_String);
+ Fold_Ureal (N, Safe_First_Value (P_Type), Static);
----------------
-- Safe_Large --
Fold_Ureal
(N, Expr_Value_R (Type_High_Bound (P_Base_Type)), Static);
else
- Float_Attribute_Universal_Real (
- IEEES_Safe_Large'Universal_Literal_String,
- IEEEL_Safe_Large'Universal_Literal_String,
- IEEEX_Safe_Large'Universal_Literal_String,
- VAXFF_Safe_Large'Universal_Literal_String,
- VAXDF_Safe_Large'Universal_Literal_String,
- VAXGF_Safe_Large'Universal_Literal_String,
- AAMPS_Safe_Large'Universal_Literal_String,
- AAMPL_Safe_Large'Universal_Literal_String);
+ Fold_Ureal (N, Safe_Last_Value (P_Type), Static);
end if;
---------------
---------------
when Attribute_Safe_Last =>
- Float_Attribute_Universal_Real (
- IEEES_Safe_Last'Universal_Literal_String,
- IEEEL_Safe_Last'Universal_Literal_String,
- IEEEX_Safe_Last'Universal_Literal_String,
- VAXFF_Safe_Last'Universal_Literal_String,
- VAXDF_Safe_Last'Universal_Literal_String,
- VAXGF_Safe_Last'Universal_Literal_String,
- AAMPS_Safe_Last'Universal_Literal_String,
- AAMPL_Safe_Last'Universal_Literal_String);
+ Fold_Ureal (N, Safe_Last_Value (P_Type), Static);
----------------
-- Safe_Small --
-- Ada 83 Safe_Small for floating-point cases
else
- Float_Attribute_Universal_Real (
- IEEES_Safe_Small'Universal_Literal_String,
- IEEEL_Safe_Small'Universal_Literal_String,
- IEEEX_Safe_Small'Universal_Literal_String,
- VAXFF_Safe_Small'Universal_Literal_String,
- VAXDF_Safe_Small'Universal_Literal_String,
- VAXGF_Safe_Small'Universal_Literal_String,
- AAMPS_Safe_Small'Universal_Literal_String,
- AAMPL_Safe_Small'Universal_Literal_String);
+ Fold_Ureal (N, Model_Small_Value (P_Type), Static);
end if;
-----------
------------------------------
Attribute_Universal_Literal_String => True,
- -- The prefix of 'Universal_Literal_String must be a named number. The
- -- static result is the string consisting of the characters of the
- -- number as defined in the original source. This allows the user
- -- program to access the actual text of named numbers without
- -- intermediate conversions and without the need to enclose the strings
- -- in quotes (which would preclude their use as numbers). This is used
- -- internally for the construction of values of the floating-point
- -- attributes from the file ttypef.ads, but may also be used by user
- -- programs.
+ -- The prefix of 'Universal_Literal_String must be a named number.
+ -- The static result is the string consisting of the characters of
+ -- the number as defined in the original source. This allows the
+ -- user program to access the actual text of named numbers without
+ -- intermediate conversions and without the need to enclose the
+ -- strings in quotes (which would preclude their use as numbers).
-------------------------
-- Unrestricted_Access --
with Output; use Output;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
-with Scans; use Scans;
-with Scn; use Scn;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Attr; use Sem_Attr;
Set_Sloc (Endl, Loc);
end Process_End_Label;
- ------------------
- -- Real_Convert --
- ------------------
-
- -- We do the conversion to get the value of the real string by using
- -- the scanner, see Sinput for details on use of the internal source
- -- buffer for scanning internal strings.
-
- function Real_Convert (S : String) return Node_Id is
- Save_Src : constant Source_Buffer_Ptr := Source;
- Negative : Boolean;
-
- begin
- Source := Internal_Source_Ptr;
- Scan_Ptr := 1;
-
- for J in S'Range loop
- Source (Source_Ptr (J)) := S (J);
- end loop;
-
- Source (S'Length + 1) := EOF;
-
- if Source (Scan_Ptr) = '-' then
- Negative := True;
- Scan_Ptr := Scan_Ptr + 1;
- else
- Negative := False;
- end if;
-
- Scan;
-
- if Negative then
- Set_Realval (Token_Node, UR_Negate (Realval (Token_Node)));
- end if;
-
- Source := Save_Src;
- return Token_Node;
- end Real_Convert;
-
------------------------------------
-- References_Generic_Formal_Type --
------------------------------------
-- parameter Ent gives the entity to which the End_Label refers,
-- and to which cross-references are to be generated.
- function Real_Convert (S : String) return Node_Id;
- -- S is a possibly signed syntactically valid real literal. The result
- -- returned is an N_Real_Literal node representing the literal value.
-
function References_Generic_Formal_Type (N : Node_Id) return Boolean;
-- Returns True if the expression Expr contains any references to a
-- generic type. This can only happen within a generic template.
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2010, 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- --
with Opt; use Opt;
with Stand; use Stand;
with Targparm; use Targparm;
-with Ttypef; use Ttypef;
package body Sem_VFpt is
-----------------
procedure Set_D_Float (E : Entity_Id) is
+ VAXDF_Digits : constant := 9;
+
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
-----------------
procedure Set_F_Float (E : Entity_Id) is
+ VAXFF_Digits : constant := 6;
+
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
-----------------
procedure Set_G_Float (E : Entity_Id) is
+ VAXGF_Digits : constant := 15;
+
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
-------------------
procedure Set_IEEE_Long (E : Entity_Id) is
+ IEEEL_Digits : constant := 15;
+
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
--------------------
procedure Set_IEEE_Short (E : Entity_Id) is
+ IEEES_Digits : constant := 6;
+
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
-with Uintp; use Uintp;
+with Urealp; use Urealp;
package body Tbuild is
New_Reference_To (First_Tag_Component (Full_Type), Loc)));
end Make_DT_Access;
+ ------------------------
+ -- Make_Float_Literal --
+ ------------------------
+
+ function Make_Float_Literal
+ (Loc : Source_Ptr;
+ Radix : Uint;
+ Significand : Uint;
+ Exponent : Uint) return Node_Id
+ is
+ begin
+ if Radix = 2 and then abs Significand /= 1 then
+ return
+ Make_Float_Literal
+ (Loc, Uint_16,
+ Significand * Radix**(Exponent mod 4),
+ Exponent / 4);
+
+ else
+ declare
+ N : constant Node_Id := New_Node (N_Real_Literal, Loc);
+
+ begin
+ Set_Realval (N,
+ UR_From_Components
+ (Num => abs Significand,
+ Den => -Exponent,
+ Rbase => UI_To_Int (Radix),
+ Negative => Significand < 0));
+ return N;
+ end;
+ end if;
+ end Make_Float_Literal;
+
-------------------------------------
-- Make_Implicit_Exception_Handler --
-------------------------------------
with Namet; use Namet;
with Sinfo; use Sinfo;
with Types; use Types;
+with Uintp; use Uintp;
package Tbuild is
-- Create an access to the Dispatch Table by using the Tag field of a
-- tagged record : Acc_Dt (Rec.tag).all
+ function Make_Float_Literal
+ (Loc : Source_Ptr;
+ Radix : Uint;
+ Significand : Uint;
+ Exponent : Uint) return Node_Id;
+ -- Create a real literal for the floating point expression value
+ -- Significand * Radix ** Exponent. Radix must be greater than 1.
+
function Make_Implicit_Exception_Handler
(Sloc : Source_Ptr;
Choice_Parameter : Node_Id := Empty;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- T T Y P E F --
--- --
--- S p e c --
--- --
--- Copyright (C) 1992-2010, 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 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 COPYING3. If not, go to --
--- http://www.gnu.org/licenses for a complete copy of the license. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This module contains values for the predefined floating-point attributes.
--- All references to these attribute values in a program being compiled must
--- use the values in this package, not the values returned by referencing
--- the corresponding attributes (since that would give host machine values).
--- Boolean-valued attributes are defined in System.Parameters, because they
--- need a finer control than what is provided by the formats described below.
-
--- The codes for the eight floating-point formats supported are:
-
--- IEEES - IEEE Single Float
--- IEEEL - IEEE Double Float
--- IEEEX - IEEE Double Extended Float
--- VAXFF - VAX F Float
--- VAXDF - VAX D Float
--- VAXGF - VAX G Float
--- AAMPS - AAMP 32-bit Float
--- AAMPL - AAMP 48-bit Float
-
-package Ttypef is
-
- ----------------------------------
- -- Universal Integer Attributes --
- ----------------------------------
-
- -- Note that the constant declarations below specify values
- -- using the Ada model, so IEEES_Machine_Emax does not specify
- -- the IEEE definition of the single precision float type,
- -- but the value of the Ada attribute which is one higher
- -- as the binary point is at a different location.
-
- IEEES_Digits : constant := 6;
- IEEEL_Digits : constant := 15;
- IEEEX_Digits : constant := 18;
- VAXFF_Digits : constant := 6;
- VAXDF_Digits : constant := 9;
- VAXGF_Digits : constant := 15;
- AAMPS_Digits : constant := 6;
- AAMPL_Digits : constant := 9;
-
- IEEES_Machine_Emax : constant := 128;
- IEEEL_Machine_Emax : constant := 1024;
- IEEEX_Machine_Emax : constant := 16384;
- VAXFF_Machine_Emax : constant := 127;
- VAXDF_Machine_Emax : constant := 127;
- VAXGF_Machine_Emax : constant := 1023;
- AAMPS_Machine_Emax : constant := 127;
- AAMPL_Machine_Emax : constant := 127;
-
- IEEES_Machine_Emin : constant := -125;
- IEEEL_Machine_Emin : constant := -1021;
- IEEEX_Machine_Emin : constant := -16381;
- VAXFF_Machine_Emin : constant := -127;
- VAXDF_Machine_Emin : constant := -127;
- VAXGF_Machine_Emin : constant := -1023;
- AAMPS_Machine_Emin : constant := -127;
- AAMPL_Machine_Emin : constant := -127;
-
- IEEES_Machine_Mantissa : constant := 24;
- IEEEL_Machine_Mantissa : constant := 53;
- IEEEX_Machine_Mantissa : constant := 64;
- VAXFF_Machine_Mantissa : constant := 24;
- VAXDF_Machine_Mantissa : constant := 56;
- VAXGF_Machine_Mantissa : constant := 53;
- AAMPS_Machine_Mantissa : constant := 24;
- AAMPL_Machine_Mantissa : constant := 40;
-
- IEEES_Model_Emin : constant := -125;
- IEEEL_Model_Emin : constant := -1021;
- IEEEX_Model_Emin : constant := -16381;
- VAXFF_Model_Emin : constant := -127;
- VAXDF_Model_Emin : constant := -127;
- VAXGF_Model_Emin : constant := -1023;
- AAMPS_Model_Emin : constant := -127;
- AAMPL_Model_Emin : constant := -127;
-
- IEEES_Model_Mantissa : constant := 24;
- IEEEL_Model_Mantissa : constant := 53;
- IEEEX_Model_Mantissa : constant := 64;
- VAXFF_Model_Mantissa : constant := 24;
- VAXDF_Model_Mantissa : constant := 56;
- VAXGF_Model_Mantissa : constant := 53;
- AAMPS_Model_Mantissa : constant := 24;
- AAMPL_Model_Mantissa : constant := 40;
-
- IEEES_Safe_Emax : constant := 128;
- IEEEL_Safe_Emax : constant := 1024;
- IEEEX_Safe_Emax : constant := 16384;
- VAXFF_Safe_Emax : constant := 127;
- VAXDF_Safe_Emax : constant := 127;
- VAXGF_Safe_Emax : constant := 1023;
- AAMPS_Safe_Emax : constant := 127;
- AAMPL_Safe_Emax : constant := 127;
-
- -------------------------------
- -- Universal Real Attributes --
- -------------------------------
-
- IEEES_Model_Epsilon : constant := 2#1.0#E-23;
- IEEEL_Model_Epsilon : constant := 2#1.0#E-52;
- IEEEX_Model_Epsilon : constant := 2#1.0#E-63;
- VAXFF_Model_Epsilon : constant := 2#1.0#E-23;
- VAXDF_Model_Epsilon : constant := 2#1.0#E-55;
- VAXGF_Model_Epsilon : constant := 2#1.0#E-52;
- AAMPS_Model_Epsilon : constant := 2#1.0#E-23;
- AAMPL_Model_Epsilon : constant := 2#1.0#E-39;
-
- IEEES_Model_Small : constant := 2#1.0#E-126;
- IEEEL_Model_Small : constant := 2#1.0#E-1022;
- IEEEX_Model_Small : constant := 2#1.0#E-16382;
- VAXFF_Model_Small : constant := 2#1.0#E-128;
- VAXDF_Model_Small : constant := 2#1.0#E-128;
- VAXGF_Model_Small : constant := 2#1.0#E-1024;
- AAMPS_Model_Small : constant := 2#1.0#E-128;
- AAMPL_Model_Small : constant := 2#1.0#E-128;
-
- IEEES_Safe_First : constant := -16#0.FFFF_FF#E+32;
- IEEEL_Safe_First : constant := -16#0.FFFF_FFFF_FFFF_F8#E+256;
- IEEEX_Safe_First : constant := -16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
- VAXFF_Safe_First : constant := -16#0.7FFF_FF8#E+32;
- VAXDF_Safe_First : constant := -16#0.7FFF_FFFF_FFFF_FF8#E+32;
- VAXGF_Safe_First : constant := -16#0.7FFF_FFFF_FFFF_FC#E+256;
- AAMPS_Safe_First : constant := -16#0.7FFF_FF8#E+32;
- AAMPL_Safe_First : constant := -16#0.7FFF_FFFF_FF8#E+32;
-
- IEEES_Safe_Large : constant := 16#0.FFFF_FF#E+32;
- IEEEL_Safe_Large : constant := 16#0.FFFF_FFFF_FFFF_F8#E+256;
- IEEEX_Safe_Large : constant := 16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
- VAXFF_Safe_Large : constant := 16#0.7FFF_FF8#E+32;
- VAXDF_Safe_Large : constant := 16#0.7FFF_FFFF_FFFF_FF8#E+32;
- VAXGF_Safe_Large : constant := 16#0.7FFF_FFFF_FFFF_FC#E+256;
- AAMPS_Safe_Large : constant := 16#0.7FFF_FF8#E+32;
- AAMPL_Safe_Large : constant := 16#0.7FFF_FFFF_FF8#E+32;
-
- IEEES_Safe_Last : constant := 16#0.FFFF_FF#E+32;
- IEEEL_Safe_Last : constant := 16#0.FFFF_FFFF_FFFF_F8#E+256;
- IEEEX_Safe_Last : constant := 16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
- VAXFF_Safe_Last : constant := 16#0.7FFF_FF8#E+32;
- VAXDF_Safe_Last : constant := 16#0.7FFF_FFFF_FFFF_FF8#E+32;
- VAXGF_Safe_Last : constant := 16#0.7FFF_FFFF_FFFF_FC#E+256;
- AAMPS_Safe_Last : constant := 16#0.7FFF_FF8#E+32;
- AAMPL_Safe_Last : constant := 16#0.7FFF_FFFF_FF8#E+32;
-
- IEEES_Safe_Small : constant := 2#1.0#E-126;
- IEEEL_Safe_Small : constant := 2#1.0#E-1022;
- IEEEX_Safe_Small : constant := 2#1.0#E-16382;
- VAXFF_Safe_Small : constant := 2#1.0#E-128;
- VAXDF_Safe_Small : constant := 2#1.0#E-128;
- VAXGF_Safe_Small : constant := 2#1.0#E-1024;
- AAMPS_Safe_Small : constant := 2#1.0#E-128;
- AAMPL_Safe_Small : constant := 2#1.0#E-128;
-
- ----------------------
- -- Typed Attributes --
- ----------------------
-
- -- The attributes First and Last are typed attributes in Ada, and yield
- -- values of the appropriate float type. However we still describe them
- -- as universal real values in this file, since we are talking about the
- -- target floating-point types, not the host floating-point types.
-
- IEEES_First : constant := -16#0.FFFF_FF#E+32;
- IEEEL_First : constant := -16#0.FFFF_FFFF_FFFF_F8#E+256;
- IEEEX_First : constant := -16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
- VAXFF_First : constant := -16#0.7FFF_FF8#E+32;
- VAXDF_First : constant := -16#0.7FFF_FFFF_FFFF_FF8#E+32;
- VAXGF_First : constant := -16#0.7FFF_FFFF_FFFF_FC#E+256;
- AAMPS_First : constant := -16#0.7FFF_FF8#E+32;
- AAMPL_First : constant := -16#0.7FFF_FFFF_FF8#E+32;
-
- IEEES_Last : constant := 16#0.FFFF_FF#E+32;
- IEEEL_Last : constant := 16#0.FFFF_FFFF_FFFF_F8#E+256;
- IEEEX_Last : constant := 16#0.FFFF_FFFF_FFFF_FFFF#E+4096;
- VAXFF_Last : constant := 16#0.7FFF_FF8#E+32;
- VAXDF_Last : constant := 16#0.7FFF_FFFF_FFFF_FF8#E+32;
- VAXGF_Last : constant := 16#0.7FFF_FFFF_FFFF_FC#E+256;
- AAMPS_Last : constant := 16#0.7FFF_FF8#E+32;
- AAMPL_Last : constant := 16#0.7FFF_FFFF_FF8#E+32;
-
-end Ttypef;
projects / platform / upstream / linaro-gcc.git / commitdiff