From b887f1a033ac9c5daae593722a985e3dc79457c7 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 6 Nov 2012 11:14:13 +0100 Subject: [PATCH] [multiple changes] 2012-11-06 Geert Bosch * 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 * 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 * sem_ch8.adb: Complete previous change. From-SVN: r193225 --- gcc/ada/ChangeLog | 24 ++++++++++++++++++++++++ gcc/ada/bindgen.adb | 52 ++++++++++++++++++++++++++++++++++++++++++++++------ gcc/ada/eval_fat.adb | 10 +++++----- gcc/ada/sem_attr.adb | 4 ++-- gcc/ada/sem_ch8.adb | 13 +++++++++---- gcc/ada/sem_util.adb | 22 ++++++++++++++++++++++ gcc/ada/sem_util.ads | 8 ++++++++ 7 files changed, 116 insertions(+), 17 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a08aa14..7ca698e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2012-11-06 Geert Bosch + + * 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 + + * 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 + + * sem_ch8.adb: Complete previous change. + 2012-11-06 Tristan Gingold * fe.h (Get_Vax_Real_Literal_As_Signed): Declare. diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index f4260a3..bcc01c3 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 5ff748d..d1c9d74 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 4118087..1b9ebcb 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 d2bd01d..4797980 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 690e30f..8fa7c37 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 bf6486d..b4ce100 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 -- 2.7.4