Commit b887f1a0 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r193225
parent 436d9f92
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.
......
......@@ -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
......
......@@ -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;
......
......@@ -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 --
......
......@@ -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;
......
......@@ -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 --
-----------------------------
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment