mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-22 22:51:32 +08:00
Code Issues Packages Projects Releases Wiki Activity

Make-lang.in: Remove ttypef.ads

Browse Source 
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.

From-SVN: r165808
This commit is contained in:
Geert Bosch 2010-10-22 09:28:24 +00:00 committed by Arnaud Charlet
parent 8110ee3b63
commit d32e3ceeb2
18 changed files with 346 additions and 763 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
gcc/ada/ChangeLog
View File

@ -1,3 +1,52 @@
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

4
gcc/ada/checks.adb
View File

@ -1564,8 +1564,8 @@ package body Checks is
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

133
gcc/ada/cstand.adb
View File

@ -36,7 +36,6 @@ with Output; use Output;
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;
@ -1670,61 +1669,11 @@ package body CStand is
-------------------
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;
@ -1908,81 +1857,29 @@ package body CStand is
----------------------
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.
-- 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;
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);

163
gcc/ada/einfo.adb
View File

@ -32,11 +32,12 @@
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
@ -520,6 +521,12 @@ package body Einfo is
-- (unused) Flag253
-- (unused) Flag254
-----------------
-- Local types --
-----------------
type Float_Rep_Kind is (IEEE_Binary, VAX_Native, AAMP);
-----------------------
-- Local subprograms --
-----------------------
@ -528,6 +535,25 @@ package body Einfo is
-- 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 --
----------------
@ -2185,12 +2211,84 @@ package body Einfo is
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));
@ -2208,6 +2306,28 @@ package body Einfo is
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));
@ -2540,6 +2660,38 @@ package body Einfo is
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);
@ -6549,7 +6701,6 @@ package body Einfo is
-- of analyzing default expressions.
P := Id;
loop
P := Next_Entity (P);

22
gcc/ada/einfo.ads
View File

@ -5094,6 +5094,17 @@ package Einfo is
-- 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)
@ -6334,6 +6345,14 @@ package Einfo is
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;
@ -6347,6 +6366,9 @@ package Einfo is
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;

135
gcc/ada/eval_fat.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -25,8 +25,6 @@
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
@ -67,13 +65,11 @@ 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 --
@ -155,7 +151,7 @@ package body Eval_Fat is
Fraction := UR_From_Components
(Num => Int_F,
Den => UI_From_Int (Machine_Mantissa (RT)),
Den => Machine_Mantissa_Value (RT),
Rbase => Radix,
Negative => False);
@ -192,7 +188,7 @@ package body Eval_Fat is
-- 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
@ -475,7 +471,7 @@ package body Eval_Fat is
------------------
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
@ -496,7 +492,7 @@ package body Eval_Fat is
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);
@ -513,9 +509,8 @@ package body Eval_Fat is
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
@ -569,108 +564,6 @@ package body Eval_Fat is
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 --
-----------
@ -818,8 +711,8 @@ package body Eval_Fat is
----------
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;

6
gcc/ada/eval_fat.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -65,10 +65,6 @@ package Eval_Fat is
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;

7
gcc/ada/exp_vfpt.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -32,12 +32,15 @@ with Sem_Res; use Sem_Res;
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 --
----------------------

13
gcc/ada/gcc-interface/Make-lang.in
View File

@ -328,7 +328,6 @@ GNAT_ADA_OBJS = \
ada/tree_io.o \
ada/treepr.o \
ada/treeprs.o \
ada/ttypef.o \
ada/ttypes.o \
ada/types.o \
ada/uintp.o \
@ -1549,7 +1548,7 @@ ada/cstand.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
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
@ -1643,7 +1642,7 @@ ada/eval_fat.o : ada/ada.ads ada/a-except.ads ada/a-unccon.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
@ -2388,7 +2387,7 @@ ada/exp_vfpt.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
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
@ -3351,7 +3350,7 @@ ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
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
@ -4120,7 +4119,7 @@ ada/sem_vfpt.o : ada/ada.ads ada/a-except.ads ada/a-unccon.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 \
@ -4434,8 +4433,6 @@ ada/treeprs.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

8
gcc/ada/gnat_rm.texi
View File

@ -6450,9 +6450,7 @@ 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
@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:
@ -9181,8 +9179,8 @@ random numbers is one microsecond.
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

247
gcc/ada/sem_attr.adb
View File

@ -66,7 +66,6 @@ with Style;
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;
@ -4922,35 +4921,6 @@ package body Sem_Attr is
-- 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.
@ -5052,103 +5022,6 @@ package body Sem_Attr is
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 --
----------------
@ -6402,45 +6275,21 @@ package body Sem_Attr is
------------------
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 --
@ -6731,60 +6580,28 @@ package body Sem_Attr is
----------------
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 --
@ -7002,30 +6819,14 @@ package body Sem_Attr is
---------------
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 --
@ -7036,15 +6837,7 @@ package body Sem_Attr is
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;
---------------
@ -7052,15 +6845,7 @@ package body Sem_Attr is
---------------
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 --
@ -7078,15 +6863,7 @@ package body Sem_Attr is
-- 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;
-----------

15
gcc/ada/sem_attr.ads
View File

@ -502,15 +502,12 @@ package Sem_Attr is
------------------------------
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 --

41
gcc/ada/sem_util.adb
View File

@ -41,8 +41,6 @@ with Nlists; use Nlists;
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;
@ -10164,45 +10162,6 @@ package body Sem_Util is
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 --
------------------------------------

4
gcc/ada/sem_util.ads
View File

@ -1096,10 +1096,6 @@ package Sem_Util is
-- 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.

13
gcc/ada/sem_vfpt.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -28,7 +28,6 @@ with Einfo; use Einfo;
with Opt; use Opt;
with Stand; use Stand;
with Targparm; use Targparm;
with Ttypef; use Ttypef;
package body Sem_VFpt is
@ -37,6 +36,8 @@ 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));
@ -55,6 +56,8 @@ package body Sem_VFpt is
-----------------
procedure Set_F_Float (E : Entity_Id) is
VAXFF_Digits : constant := 6;
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
@ -73,6 +76,8 @@ package body Sem_VFpt is
-----------------
procedure Set_G_Float (E : Entity_Id) is
VAXGF_Digits : constant := 15;
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
@ -91,6 +96,8 @@ package body Sem_VFpt is
-------------------
procedure Set_IEEE_Long (E : Entity_Id) is
IEEEL_Digits : constant := 15;
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
@ -109,6 +116,8 @@ package body Sem_VFpt is
--------------------
procedure Set_IEEE_Short (E : Entity_Id) is
IEEES_Digits : constant := 6;
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));

36
gcc/ada/tbuild.adb
View File

@ -36,7 +36,7 @@ with Sem_Aux; use Sem_Aux;
with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Uintp; use Uintp;
with Urealp; use Urealp;
package body Tbuild is
@ -198,6 +198,40 @@ 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 --
-------------------------------------

9
gcc/ada/tbuild.ads
View File

@ -29,6 +29,7 @@
with Namet; use Namet;
with Sinfo; use Sinfo;
with Types; use Types;
with Uintp; use Uintp;
package Tbuild is
@ -75,6 +76,14 @@ 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;

204
gcc/ada/ttypef.ads
View File

@ -1,204 +0,0 @@
------------------------------------------------------------------------------
-- --
-- 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;