diff mbox

[Ada] Support target with both VAX and IEEE float

Message ID 20121106101432.GA17904@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Nov. 6, 2012, 10:14 a.m. UTC 
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  <bosch@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.
diff mbox

Patch

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 --