+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.
-- 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
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
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'
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
(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
with Einfo; use Einfo;
with Errout; use Errout;
-with Targparm; use Targparm;
+with Sem_Util; use Sem_Util;
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;
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
-- 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;
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 --
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 --
------------------------------
procedure Check_Constrained_Object is
+ Typ : constant Entity_Id := Etype (Nam);
Subt : Entity_Id;
begin
-- 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
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;
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 --
-------------------------------------------
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 --
-----------------------------
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
-- 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
projects / platform / upstream / gcc.git / commitdiff