Commit 1197ddb1 by Arnaud Charlet

[multiple changes]

2011-08-29  Geert Bosch  <bosch@adacore.com>

	* s-vaflop-vms-alpha.adb (Neg_F): Use subtraction instead of negation
	instruction, as the latter may produce -0.0, which is not a valid VAX
	F float number.
	(Neg_G): Likewise for VAX F float.

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb: Minor reformatting.

2011-08-29  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb: Minor comment update.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* checks.adb (Apply_Type_Conversion_Checks): Use the Underlying_Type of
	the operand type.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb (Traverse_Declarations_Or_Statements): Do not flush
	current statement sequence on a generic instantiation or a subprogram
	declaration.

From-SVN: r178161
parent 8f66cda7
2011-08-29 Geert Bosch <bosch@adacore.com>
* s-vaflop-vms-alpha.adb (Neg_F): Use subtraction instead of negation
instruction, as the latter may produce -0.0, which is not a valid VAX
F float number.
(Neg_G): Likewise for VAX F float.
2011-08-29 Robert Dewar <dewar@adacore.com>
* exp_util.adb: Minor reformatting.
2011-08-29 Yannick Moy <moy@adacore.com>
* sem_ch3.adb: Minor comment update.
2011-08-29 Thomas Quinot <quinot@adacore.com>
* checks.adb (Apply_Type_Conversion_Checks): Use the Underlying_Type of
the operand type.
2011-08-29 Thomas Quinot <quinot@adacore.com>
* par_sco.adb (Traverse_Declarations_Or_Statements): Do not flush
current statement sequence on a generic instantiation or a subprogram
declaration.
2011-08-29 Robert Dewar <dewar@adacore.com>
* sem_type.adb, einfo.ads, freeze.adb, exp_ch4.adb, sem_ch13.adb:
......
......@@ -1545,7 +1545,7 @@ package body Checks is
-- Lo_OK be True.
-- (3) If I'Last < 0, then let Hi be F'Succ (I'Last) and let Hi_OK
-- be False. Otherwise let Hi be F'Pred (I'Last + 1) and let
-- Hi_OK be False
-- Hi_OK be True.
procedure Apply_Float_Conversion_Check
(Ck_Node : Node_Id;
......@@ -2325,7 +2325,10 @@ package body Checks is
Target_Type : constant Entity_Id := Etype (N);
Target_Base : constant Entity_Id := Base_Type (Target_Type);
Expr : constant Node_Id := Expression (N);
Expr_Type : constant Entity_Id := Etype (Expr);
Expr_Type : constant Entity_Id := Underlying_Type (Etype (Expr));
-- Note: if Etype (Expr) is a private type without discriminants, its
-- full view might have discriminants with defaults, so we need the
-- full view here to retrieve the constraints.
begin
if Inside_A_Generic then
......@@ -2383,7 +2386,7 @@ package body Checks is
and then not Is_Constrained (Target_Type)
and then Present (Stored_Constraint (Target_Type))
then
-- An unconstrained derived type may have inherited discriminant
-- An unconstrained derived type may have inherited discriminant.
-- Build an actual discriminant constraint list using the stored
-- constraint, to verify that the expression of the parent type
-- satisfies the constraints imposed by the (unconstrained!)
......
......@@ -6431,12 +6431,12 @@ package body Exp_Util is
Typ := Entity (Decl);
if ((Is_Access_Type (Typ)
and then not Is_Access_Subprogram_Type (Typ)
and then Needs_Finalization
(Available_View (Designated_Type (Typ))))
and then not Is_Access_Subprogram_Type (Typ)
and then Needs_Finalization
(Available_View (Designated_Type (Typ))))
or else
(Is_Type (Typ)
and then Needs_Finalization (Typ)))
(Is_Type (Typ)
and then Needs_Finalization (Typ)))
and then Requires_Cleanup_Actions
(Actions (Decl), For_Package, Nested_Constructs)
then
......
......@@ -1204,7 +1204,6 @@ package body Par_SCO is
when N_Subprogram_Declaration =>
Process_Decisions_Defer
(Parameter_Specifications (Specification (N)), 'X');
Set_Statement_Entry;
-- Generic subprogram declaration
......@@ -1213,7 +1212,6 @@ package body Par_SCO is
(Generic_Formal_Declarations (N), 'X');
Process_Decisions_Defer
(Parameter_Specifications (Specification (N)), 'X');
Set_Statement_Entry;
-- Task or subprogram body
......
......@@ -536,7 +536,7 @@ package body System.Vax_Float_Operations is
C : F;
begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
Asm ("cpysn %1,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
Asm ("subf $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
return C;
end Neg_F;
......@@ -550,7 +550,7 @@ package body System.Vax_Float_Operations is
C : G;
begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Asm ("cpysn %1,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
Asm ("subg $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
return C;
end Neg_G;
......
......@@ -4743,7 +4743,8 @@ package body Sem_Ch3 is
-- In formal verification mode, create an explicit subtype for every
-- index if not already a subtype_mark, and replace the existing type
-- of index by this new type. Why are we doing this ???
-- of index by this new type. Having a declaration for all type
-- entities facilitates the task of the formal verification back-end.
if ALFA_Mode
and then not Nkind_In (Index, N_Identifier, N_Expanded_Name)
......@@ -4799,7 +4800,9 @@ package body Sem_Ch3 is
if Present (Component_Typ) then
-- In formal verification mode, create an explicit subtype for the
-- component type if not already a subtype_mark. Why do this ???
-- component type if not already a subtype_mark. Having a declaration
-- for all type entities facilitates the task of the formal
-- verification back-end.
if ALFA_Mode
and then Nkind (Component_Typ) = N_Subtype_Indication
......
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