This patch allows the Ada front end to properly support static
evaluation of both VAX and IEEE floating point attributes on a single target.
Before we use a global setting from system.ads to determine wether a
floating point type supported denormals and signed zeros, but in order to
properly support static evaluation of VAX float literals, we need to
allow types-ecific values.
On VMS, the following should compile quietly:
package vms is
type f is digits 6;
pragma Float_Representation (Vax_Float, f);
subtype Truth is Boolean range True .. True;
T : Truth := not F'Signed_Zeros;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-11-06 Geert Bosch <bo...@adacore.com>
* eval_fat.adb (Machine, Succ): Fix front end to support static
evaluation of attributes on targets with both VAX and IEEE float.
* sem_util.ads, sem_util.adb (Has_Denormals, Has_Signed_Zeros):
New type-specific functions. Previously we used Denorm_On_Target
and Signed_Zeros_On_Target directly, but that doesn't work well
for OpenVMS where a single target supports both floating point
with and without signed zeros.
* sem_attr.adb (Attribute_Denorm, Attribute_Signed_Zeros): Use
new Has_Denormals and Has_Signed_Zeros functions to support both
IEEE and VAX floating point on a single target.
Index: eval_fat.adb
===================================================================
--- eval_fat.adb (revision 193224)
+++ eval_fat.adb (working copy)
@@ -25,7 +25,7 @@
with Einfo; use Einfo;
with Errout; use Errout;
-with Targparm; use Targparm;
+with Sem_Util; use Sem_Util;
package body Eval_Fat is
@@ -505,8 +505,8 @@
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 Signed_Zeros_On_Target and then UR_Is_Negative (X) then
+ if X_Exp < Emin_Den or not Has_Denormals (RT) then
+ if Has_Signed_Zeros (RT) and then UR_Is_Negative (X) then
Error_Msg_N
("floating-point value underflows to -0.0?", Enode);
return Ureal_M_0;
@@ -517,7 +517,7 @@
return Ureal_0;
end if;
- elsif Denorm_On_Target then
+ elsif Has_Denormals (RT) then
-- Emin - Mant <= X_Exp < Emin, so result is denormal. Handle
-- gradual underflow by first computing the number of
@@ -718,7 +718,7 @@
-- Set exponent such that the radix point will be directly following the
-- mantissa after scaling.
- if Denorm_On_Target or Exp /= Emin then
+ if Has_Denormals (RT) or Exp /= Emin then
Exp := Exp - Mantissa;
else
Exp := Exp - 1;
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 193215)
+++ sem_util.adb (working copy)
@@ -5398,6 +5398,17 @@
N_Package_Specification);
end Has_Declarations;
+ -------------------
+ -- Has_Denormals --
+ -------------------
+
+ function Has_Denormals (E : Entity_Id) return Boolean is
+ begin
+ return Is_Floating_Point_Type (E)
+ and then Denorm_On_Target
+ and then not Vax_Float (E);
+ end Has_Denormals;
+
-------------------------------------------
-- Has_Discriminant_Dependent_Constraint --
-------------------------------------------
@@ -6076,6 +6087,17 @@
end if;
end Has_Private_Component;
+ ----------------------
+ -- Has_Signed_Zeros --
+ ----------------------
+
+ function Has_Signed_Zeros (E : Entity_Id) return Boolean is
+ begin
+ return Is_Floating_Point_Type (E)
+ and then Signed_Zeros_On_Target
+ and then not Vax_Float (E);
+ end Has_Signed_Zeros;
+
-----------------------------
-- Has_Static_Array_Bounds --
-----------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 193215)
+++ sem_util.ads (working copy)
@@ -674,6 +674,10 @@
function Has_Declarations (N : Node_Id) return Boolean;
-- Determines if the node can have declarations
+ function Has_Denormals (E : Entity_Id) return Boolean;
+ -- Determines if the floating-point type E supports denormal numbers.
+ -- Returns False if E is not a floating-point type.
+
function Has_Discriminant_Dependent_Constraint
(Comp : Entity_Id) return Boolean;
-- Returns True if and only if Comp has a constrained subtype that depends
@@ -708,6 +712,10 @@
-- Check if a type has a (sub)component of a private type that has not
-- yet received a full declaration.
+ function Has_Signed_Zeros (E : Entity_Id) return Boolean;
+ -- Determines if the floating-point type E supports signed zeros.
+ -- Returns False if E is not a floating-point type.
+
function Has_Static_Array_Bounds (Typ : Node_Id) return Boolean;
-- Return whether an array type has static bounds
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 193215)
+++ sem_attr.adb (working copy)
@@ -6517,7 +6517,7 @@
when Attribute_Denorm =>
Fold_Uint
- (N, UI_From_Int (Boolean'Pos (Denorm_On_Target)), True);
+ (N, UI_From_Int (Boolean'Pos (Has_Denormals (P_Type))), True);
---------------------
-- Descriptor_Size --
@@ -7631,7 +7631,7 @@
when Attribute_Signed_Zeros =>
Fold_Uint
- (N, UI_From_Int (Boolean'Pos (Signed_Zeros_On_Target)), Static);
+ (N, UI_From_Int (Boolean'Pos (Has_Signed_Zeros (P_Type))), Static);
----------
-- Size --
