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.

2012-11-06  Tristan Gingold  <gingold@adacore.com>

	* bindgen.adb (System_Interrupts_Used): New variable.
	(Gen_Adainit): Declare and call
	Install_Restricted_Handlers_Sequential if System.Interrupts is
	used when elaboration policy is sequential.

2012-11-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb: Complete previous change.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@193225 138bc75d-0d04-0410-961f-82ee72b054a4

7 files changed, 116 insertions, 17 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a08aa1464c1..7ca698e339c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+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.
+
+2012-11-06  Tristan Gingold  <gingold@adacore.com>
+
+	* bindgen.adb (System_Interrupts_Used): New variable.
+	(Gen_Adainit): Declare and call
+	Install_Restricted_Handlers_Sequential if System.Interrupts is
+	used when elaboration policy is sequential.
+
+2012-11-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb: Complete previous change.
+
 2012-11-06  Tristan Gingold  <gingold@adacore.com>
 
 	* fe.h (Get_Vax_Real_Literal_As_Signed): Declare.
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index f4260a3ded1..bcc01c3d299 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -82,7 +82,13 @@ package body Bindgen is
    --  Flag indicating whether the unit System.Tasking.Restricted.Stages is in
    --  the closure of the partition. This is set by Resolve_Binder_Options,
    --  and it used to call a routine to active all the tasks at the end of
-   --  the elaboration.
+   --  the elaboration when partition elaboration policy is sequential.
+
+   System_Interrupts_Used : Boolean := False;
+   --  Flag indicating whether the unit System.Interrups is in the closure of
+   --  the partition. This is set by Resolve_Binder_Options, and it used to
+   --  attach interrupt handlers at the end of the elaboration when partition
+   --  elaboration policy is sequential.
 
    Lib_Final_Built : Boolean := False;
    --  Flag indicating whether the finalize_library rountine has been built
@@ -488,6 +494,16 @@ package body Bindgen is
             WBI ("");
          end if;
 
+         if System_Interrupts_Used
+           and then Partition_Elaboration_Policy_Specified = 'S'
+         then
+            WBI ("      procedure Install_Restricted_Handlers_Sequential;");
+            WBI ("      pragma Import (C,"
+                   & "Install_Restricted_Handlers_Sequential," &
+                   " ""__gnat_attach_all_handlers"");");
+            WBI ("");
+         end if;
+
          if System_Tasking_Restricted_Stages_Used
            and then Partition_Elaboration_Policy_Specified = 'S'
          then
@@ -601,7 +617,21 @@ package body Bindgen is
          WBI ("      pragma Import (C, Handler_Installed, " &
               """__gnat_handler_installed"");");
 
-         --  Import task activation procedure for ravenscar
+         --  Import handlers attach procedure for sequential elaboration
+         --  policy.
+
+         if System_Interrupts_Used
+           and then Partition_Elaboration_Policy_Specified = 'S'
+         then
+            WBI ("      procedure Install_Restricted_Handlers_Sequential;");
+            WBI ("      pragma Import (C,"
+                   & "Install_Restricted_Handlers_Sequential," &
+                   " ""__gnat_attach_all_handlers"");");
+            WBI ("");
+         end if;
+
+         --  Import task activation procedure for sequential elaboration
+         --  policy.
 
          if System_Tasking_Restricted_Stages_Used
            and then Partition_Elaboration_Policy_Specified = 'S'
@@ -944,10 +974,16 @@ package body Bindgen is
          WBI ("      Freeze_Dispatching_Domains;");
       end if;
 
-      if System_Tasking_Restricted_Stages_Used
-        and then Partition_Elaboration_Policy_Specified = 'S'
-      then
-         WBI ("      Activate_All_Tasks_Sequential;");
+      --  Sequential partition elaboration policy
+
+      if Partition_Elaboration_Policy_Specified = 'S' then
+         if System_Interrupts_Used then
+            WBI ("      Install_Restricted_Handlers_Sequential;");
+         end if;
+
+         if System_Tasking_Restricted_Stages_Used then
+            WBI ("      Activate_All_Tasks_Sequential;");
+         end if;
       end if;
 
       --  Case of main program is CIL function or procedure
@@ -2896,6 +2932,10 @@ package body Bindgen is
            (System_Tasking_Restricted_Stages_Used,
             "system.tasking.restricted.stages%s");
 
+         --  Ditto for the use of interrupts
+
+         Check_Package (System_Interrupts_Used, "system.interrupts%s");
+
          --  Ditto for the use of dispatching domains
 
          Check_Package
diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb
index 5ff748dfbe7..d1c9d74859a 100644
--- a/gcc/ada/eval_fat.adb
+++ b/gcc/ada/eval_fat.adb
@@ -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 @@ package body Eval_Fat is
             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 @@ package body Eval_Fat is
                   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 @@ package body Eval_Fat is
       --  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;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 4118087d5f6..1b9ebcb1ffe 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6517,7 +6517,7 @@ package body Sem_Attr is
 
       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 @@ package body Sem_Attr is
 
       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 --
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index d2bd01d9ba4..479798044a0 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -709,6 +709,7 @@ package body Sem_Ch8 is
       ------------------------------
 
       procedure Check_Constrained_Object is
+         Typ  : constant Entity_Id := Etype (Nam);
          Subt : Entity_Id;
 
       begin
@@ -728,16 +729,20 @@ package body Sem_Ch8 is
             --  A renaming of an unchecked union does not have an
             --  actual subtype.
 
-            elsif Is_Unchecked_Union (Etype (Nam)) then
+            elsif Is_Unchecked_Union (Typ) then
                null;
 
             --  If a record is limited its size is invariant. This is the case
             --  in particular with record types with an access discirminant
             --  that are used in iterators. This is an optimization, but it
             --  also prevents typing anomalies when the prefix is further
-            --  expanded.
+            --  expanded. Limited types with discriminants are included.
 
-            elsif Is_Limited_Record (Etype (Nam)) then
+            elsif Is_Limited_Record (Typ)
+              or else (Ekind (Typ) = E_Limited_Private_Type
+                and then Has_Discriminants (Typ)
+                and then Is_Access_Type (Etype (First_Discriminant (Typ))))
+            then
                null;
 
             else
@@ -747,7 +752,7 @@ package body Sem_Ch8 is
                  Make_Subtype_Declaration (Loc,
                    Defining_Identifier => Subt,
                    Subtype_Indication  =>
-                     Make_Subtype_From_Expr (Nam, Etype (Nam))));
+                     Make_Subtype_From_Expr (Nam, Typ)));
                Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));
                Set_Etype (Nam, Subt);
             end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 690e30fe5f4..8fa7c3747a3 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5398,6 +5398,17 @@ package body Sem_Util is
                                   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 @@ package body Sem_Util is
       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 --
    -----------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index bf6486d464f..b4ce100cb98 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -674,6 +674,10 @@ package Sem_Util is
    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 @@ package Sem_Util is
    --  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