Commit 8f66cda7 by Arnaud Charlet

[multiple changes]

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

	* sem_type.adb, einfo.ads, freeze.adb, exp_ch4.adb, sem_ch13.adb:
	Minor reformatting.

2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean, Boolean)):
	Correct the check which involves the freeze node of a controlled or
	access-to-controlled type.

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

	* sem_warn.adb (Check_Code_Statement): Remove check for consecutive Asm
	statements.
	* s-vaflop-vms-alpha.adb: Remove bogus Volatile => True arguments from
	Asm statements.

From-SVN: r178160
parent cf161d66
2011-08-29 Robert Dewar <dewar@adacore.com>
* sem_type.adb, einfo.ads, freeze.adb, exp_ch4.adb, sem_ch13.adb:
Minor reformatting.
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb (Requires_Cleanup_Actions (List_Id, Boolean, Boolean)):
Correct the check which involves the freeze node of a controlled or
access-to-controlled type.
2011-08-29 Geert Bosch <bosch@adacore.com>
* sem_warn.adb (Check_Code_Statement): Remove check for consecutive Asm
statements.
* s-vaflop-vms-alpha.adb: Remove bogus Volatile => True arguments from
Asm statements.
2011-08-29 Yannick Moy <moy@adacore.com> 2011-08-29 Yannick Moy <moy@adacore.com>
* sem_ch3.adb (Array_Type_Declaration): Insert a subtype declaration * sem_ch3.adb (Array_Type_Declaration): Insert a subtype declaration
......
...@@ -3515,12 +3515,12 @@ package Einfo is ...@@ -3515,12 +3515,12 @@ package Einfo is
-- by-reference-type or because it uses explicitly the secondary stack. -- by-reference-type or because it uses explicitly the secondary stack.
-- Reverse_Bit_Order (Flag164) [base type only] -- Reverse_Bit_Order (Flag164) [base type only]
-- Present in all record type entities. Set if a valid pragma an -- Present in all record type entities. Set if entity has a Bit_Order
-- attribute representation clause for Bit_Order has reversed the order -- aspect (set by an aspect clause or attribute definition clause) that
-- of bits from the default value. When this flag is set, a component -- has reversed the order of bits from the default value. When this flag
-- clause must specify a set of bits entirely contained in a single -- is set, a component clause must specify a set of bits entirely within
-- storage unit (Ada 95) or a single machine scalar (see Ada 2005 -- a single storage unit (Ada 95) or within a single machine scalar (see
-- AI-133), or must occupy in integral number of storage units. -- Ada 2005 AI-133), or must occupy an integral number of storage units.
-- RM_Size (Uint13) -- RM_Size (Uint13)
-- Present in all type and subtype entities. Contains the value of -- Present in all type and subtype entities. Contains the value of
......
...@@ -6193,6 +6193,12 @@ package body Exp_Ch4 is ...@@ -6193,6 +6193,12 @@ package body Exp_Ch4 is
begin begin
Binary_Op_Validity_Checks (N); Binary_Op_Validity_Checks (N);
-- CodePeer and GNATprove want to see the unexpanded N_Op_Expon node
if CodePeer_Mode or ALFA_Mode then
return;
end if;
-- If either operand is of a private type, then we have the use of an -- If either operand is of a private type, then we have the use of an
-- intrinsic operator, and we get rid of the privateness, by using root -- intrinsic operator, and we get rid of the privateness, by using root
-- types of underlying types for the actual operation. Otherwise the -- types of underlying types for the actual operation. Otherwise the
...@@ -6200,18 +6206,10 @@ package body Exp_Ch4 is ...@@ -6200,18 +6206,10 @@ package body Exp_Ch4 is
-- shifts etc. We also do this transformation if the result type is -- shifts etc. We also do this transformation if the result type is
-- different from the base type. -- different from the base type.
if CodePeer_Mode or ALFA_Mode then
-- CodePeer and GNATprove want to see the unexpanded N_Op_Expon node
return;
end if;
if Is_Private_Type (Etype (Base)) if Is_Private_Type (Etype (Base))
or else or else Is_Private_Type (Typ)
Is_Private_Type (Typ) or else Is_Private_Type (Exptyp)
or else or else Rtyp /= Root_Type (Bastyp)
Is_Private_Type (Exptyp)
or else
Rtyp /= Root_Type (Bastyp)
then then
declare declare
Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp)); Bt : constant Entity_Id := Root_Type (Underlying_Type (Bastyp));
......
...@@ -6430,13 +6430,15 @@ package body Exp_Util is ...@@ -6430,13 +6430,15 @@ package body Exp_Util is
then then
Typ := Entity (Decl); Typ := Entity (Decl);
if (Is_Access_Type (Typ) if ((Is_Access_Type (Typ)
and then not Is_Access_Subprogram_Type (Typ) and then not Is_Access_Subprogram_Type (Typ)
and then Needs_Finalization and then Needs_Finalization
(Available_View (Designated_Type (Typ)))) (Available_View (Designated_Type (Typ))))
or else or else
(Is_Type (Typ) (Is_Type (Typ)
and then Needs_Finalization (Typ)) and then Needs_Finalization (Typ)))
and then Requires_Cleanup_Actions
(Actions (Decl), For_Package, Nested_Constructs)
then then
return True; return True;
end if; end if;
......
...@@ -2029,8 +2029,7 @@ package body Freeze is ...@@ -2029,8 +2029,7 @@ package body Freeze is
Next_Entity (Comp); Next_Entity (Comp);
end loop; end loop;
-- Deal with Bit_Order attribute definition specifying a non-default -- Deal with Bit_Order aspect specifying a non-default bit order
-- bit order.
if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then
if not Placed_Component then if not Placed_Component then
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1997-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1997-2011, Free Software Foundation, Inc. --
-- (Version for Alpha OpenVMS) -- -- (Version for Alpha OpenVMS) --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
...@@ -67,12 +67,9 @@ package body System.Vax_Float_Operations is ...@@ -67,12 +67,9 @@ package body System.Vax_Float_Operations is
A, B : T; A, B : T;
C : G; C : G;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X), Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X));
Volatile => True); Asm ("cvtdg %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
Asm ("cvtdg %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));
Volatile => True);
Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B),
Volatile => True);
return C; return C;
end D_To_G; end D_To_G;
...@@ -84,10 +81,8 @@ package body System.Vax_Float_Operations is ...@@ -84,10 +81,8 @@ package body System.Vax_Float_Operations is
A : T; A : T;
B : G; B : G;
begin begin
Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X), Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
Volatile => True); Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A),
Volatile => True);
return B; return B;
end F_To_G; end F_To_G;
...@@ -103,8 +98,7 @@ package body System.Vax_Float_Operations is ...@@ -103,8 +98,7 @@ package body System.Vax_Float_Operations is
-- Because converting to a wider FP format is a no-op, we say -- Because converting to a wider FP format is a no-op, we say
-- A is 64-bit even though we are loading 32 bits into it. -- A is 64-bit even though we are loading 32 bits into it.
Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X), Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
Volatile => True);
B := S (Cvt_G_T (A)); B := S (Cvt_G_T (A));
return B; return B;
...@@ -118,12 +112,9 @@ package body System.Vax_Float_Operations is ...@@ -118,12 +112,9 @@ package body System.Vax_Float_Operations is
A, B : T; A, B : T;
C : D; C : D;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X), Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Volatile => True); Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A), Asm ("stg %1,%0", D'Asm_Output ("=m", C), T'Asm_Input ("f", B));
Volatile => True);
Asm ("stg %1,%0", D'Asm_Output ("=m", C), T'Asm_Input ("f", B),
Volatile => True);
return C; return C;
end G_To_D; end G_To_D;
...@@ -136,12 +127,9 @@ package body System.Vax_Float_Operations is ...@@ -136,12 +127,9 @@ package body System.Vax_Float_Operations is
B : S; B : S;
C : F; C : F;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X), Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Volatile => True); Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A));
Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A), Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
Volatile => True);
Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B),
Volatile => True);
return C; return C;
end G_To_F; end G_To_F;
...@@ -153,10 +141,8 @@ package body System.Vax_Float_Operations is ...@@ -153,10 +141,8 @@ package body System.Vax_Float_Operations is
A : T; A : T;
B : Q; B : Q;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X), Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Volatile => True); Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A));
Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A),
Volatile => True);
return B; return B;
end G_To_Q; end G_To_Q;
...@@ -167,8 +153,7 @@ package body System.Vax_Float_Operations is ...@@ -167,8 +153,7 @@ package body System.Vax_Float_Operations is
function G_To_T (X : G) return T is function G_To_T (X : G) return T is
A, B : T; A, B : T;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X), Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Volatile => True);
B := Cvt_G_T (A); B := Cvt_G_T (A);
return B; return B;
end G_To_T; end G_To_T;
...@@ -190,10 +175,8 @@ package body System.Vax_Float_Operations is ...@@ -190,10 +175,8 @@ package body System.Vax_Float_Operations is
A : S; A : S;
B : F; B : F;
begin begin
Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X), Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
Volatile => True); Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A),
Volatile => True);
return B; return B;
end Q_To_F; end Q_To_F;
...@@ -205,10 +188,8 @@ package body System.Vax_Float_Operations is ...@@ -205,10 +188,8 @@ package body System.Vax_Float_Operations is
A : T; A : T;
B : G; B : G;
begin begin
Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X), Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
Volatile => True); Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A),
Volatile => True);
return B; return B;
end Q_To_G; end Q_To_G;
...@@ -221,8 +202,7 @@ package body System.Vax_Float_Operations is ...@@ -221,8 +202,7 @@ package body System.Vax_Float_Operations is
B : F; B : F;
begin begin
A := Cvt_T_F (T (X)); A := Cvt_T_F (T (X));
Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A), Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
Volatile => True);
return B; return B;
end S_To_F; end S_To_F;
...@@ -244,8 +224,7 @@ package body System.Vax_Float_Operations is ...@@ -244,8 +224,7 @@ package body System.Vax_Float_Operations is
B : G; B : G;
begin begin
A := Cvt_T_G (X); A := Cvt_T_G (X);
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A), Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
Volatile => True);
return B; return B;
end T_To_G; end T_To_G;
...@@ -257,12 +236,9 @@ package body System.Vax_Float_Operations is ...@@ -257,12 +236,9 @@ package body System.Vax_Float_Operations is
A, B : S; A, B : S;
C : F; C : F;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X), Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
Volatile => True); Asm ("cpys $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
Asm ("cpys $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));
Volatile => True);
Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B),
Volatile => True);
return C; return C;
end Abs_F; end Abs_F;
...@@ -275,10 +251,8 @@ package body System.Vax_Float_Operations is ...@@ -275,10 +251,8 @@ package body System.Vax_Float_Operations is
C : G; C : G;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A), Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
Volatile => True); Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B),
Volatile => True);
return C; return C;
end Abs_G; end Abs_G;
...@@ -291,13 +265,10 @@ package body System.Vax_Float_Operations is ...@@ -291,13 +265,10 @@ package body System.Vax_Float_Operations is
R1 : F; R1 : F;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y), Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
Volatile => True);
Asm ("addf %1,%2,%0", S'Asm_Output ("=f", R), Asm ("addf %1,%2,%0", S'Asm_Output ("=f", R),
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)), (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
Volatile => True); Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R),
Volatile => True);
return R1; return R1;
end Add_F; end Add_F;
...@@ -310,13 +281,10 @@ package body System.Vax_Float_Operations is ...@@ -310,13 +281,10 @@ package body System.Vax_Float_Operations is
R1 : G; R1 : G;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y), Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
Volatile => True);
Asm ("addg %1,%2,%0", T'Asm_Output ("=f", R), Asm ("addg %1,%2,%0", T'Asm_Output ("=f", R),
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)), (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
Volatile => True); Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R),
Volatile => True);
return R1; return R1;
end Add_G; end Add_G;
...@@ -392,13 +360,10 @@ package body System.Vax_Float_Operations is ...@@ -392,13 +360,10 @@ package body System.Vax_Float_Operations is
R1 : F; R1 : F;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y), Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
Volatile => True);
Asm ("divf %1,%2,%0", S'Asm_Output ("=f", R), Asm ("divf %1,%2,%0", S'Asm_Output ("=f", R),
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)), (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
Volatile => True); Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R),
Volatile => True);
return R1; return R1;
end Div_F; end Div_F;
...@@ -411,13 +376,10 @@ package body System.Vax_Float_Operations is ...@@ -411,13 +376,10 @@ package body System.Vax_Float_Operations is
R1 : G; R1 : G;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y), Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
Volatile => True);
Asm ("divg %1,%2,%0", T'Asm_Output ("=f", R), Asm ("divg %1,%2,%0", T'Asm_Output ("=f", R),
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)), (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
Volatile => True); Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R),
Volatile => True);
return R1; return R1;
end Div_G; end Div_G;
...@@ -429,11 +391,9 @@ package body System.Vax_Float_Operations is ...@@ -429,11 +391,9 @@ package body System.Vax_Float_Operations is
X1, Y1, R : S; X1, Y1, R : S;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y), Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
Volatile => True);
Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R), Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)), (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
Volatile => True);
return R /= 0.0; return R /= 0.0;
end Eq_F; end Eq_F;
...@@ -445,11 +405,9 @@ package body System.Vax_Float_Operations is ...@@ -445,11 +405,9 @@ package body System.Vax_Float_Operations is
X1, Y1, R : T; X1, Y1, R : T;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y), Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
Volatile => True);
Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R), Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)), (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
Volatile => True);
return R /= 0.0; return R /= 0.0;
end Eq_G; end Eq_G;
...@@ -461,11 +419,9 @@ package body System.Vax_Float_Operations is ...@@ -461,11 +419,9 @@ package body System.Vax_Float_Operations is
X1, Y1, R : S; X1, Y1, R : S;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y), Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
Volatile => True);
Asm ("cmpgle %1,%2,%0", S'Asm_Output ("=f", R), Asm ("cmpgle %1,%2,%0", S'Asm_Output ("=f", R),
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)), (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
Volatile => True);
return R /= 0.0; return R /= 0.0;
end Le_F; end Le_F;
...@@ -477,11 +433,9 @@ package body System.Vax_Float_Operations is ...@@ -477,11 +433,9 @@ package body System.Vax_Float_Operations is
X1, Y1, R : T; X1, Y1, R : T;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y), Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
Volatile => True);
Asm ("cmpgle %1,%2,%0", T'Asm_Output ("=f", R), Asm ("cmpgle %1,%2,%0", T'Asm_Output ("=f", R),
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)), (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
Volatile => True);
return R /= 0.0; return R /= 0.0;
end Le_G; end Le_G;
...@@ -493,11 +447,9 @@ package body System.Vax_Float_Operations is ...@@ -493,11 +447,9 @@ package body System.Vax_Float_Operations is
X1, Y1, R : S; X1, Y1, R : S;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y), Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
Volatile => True);
Asm ("cmpglt %1,%2,%0", S'Asm_Output ("=f", R), Asm ("cmpglt %1,%2,%0", S'Asm_Output ("=f", R),
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)), (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
Volatile => True);
return R /= 0.0; return R /= 0.0;
end Lt_F; end Lt_F;
...@@ -509,11 +461,9 @@ package body System.Vax_Float_Operations is ...@@ -509,11 +461,9 @@ package body System.Vax_Float_Operations is
X1, Y1, R : T; X1, Y1, R : T;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y), Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
Volatile => True);
Asm ("cmpglt %1,%2,%0", T'Asm_Output ("=f", R), Asm ("cmpglt %1,%2,%0", T'Asm_Output ("=f", R),
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)), (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
Volatile => True);
return R /= 0.0; return R /= 0.0;
end Lt_G; end Lt_G;
...@@ -526,13 +476,10 @@ package body System.Vax_Float_Operations is ...@@ -526,13 +476,10 @@ package body System.Vax_Float_Operations is
R1 : F; R1 : F;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y), Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
Volatile => True);
Asm ("mulf %1,%2,%0", S'Asm_Output ("=f", R), Asm ("mulf %1,%2,%0", S'Asm_Output ("=f", R),
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)), (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
Volatile => True); Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R),
Volatile => True);
return R1; return R1;
end Mul_F; end Mul_F;
...@@ -545,13 +492,10 @@ package body System.Vax_Float_Operations is ...@@ -545,13 +492,10 @@ package body System.Vax_Float_Operations is
R1 : G; R1 : G;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y), Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
Volatile => True);
Asm ("mulg %1,%2,%0", T'Asm_Output ("=f", R), Asm ("mulg %1,%2,%0", T'Asm_Output ("=f", R),
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)), (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
Volatile => True); Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R),
Volatile => True);
return R1; return R1;
end Mul_G; end Mul_G;
...@@ -563,11 +507,9 @@ package body System.Vax_Float_Operations is ...@@ -563,11 +507,9 @@ package body System.Vax_Float_Operations is
X1, Y1, R : S; X1, Y1, R : S;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y), Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
Volatile => True);
Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R), Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)), (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
Volatile => True);
return R = 0.0; return R = 0.0;
end Ne_F; end Ne_F;
...@@ -579,11 +521,9 @@ package body System.Vax_Float_Operations is ...@@ -579,11 +521,9 @@ package body System.Vax_Float_Operations is
X1, Y1, R : T; X1, Y1, R : T;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y), Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
Volatile => True);
Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R), Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)), (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
Volatile => True);
return R = 0.0; return R = 0.0;
end Ne_G; end Ne_G;
...@@ -596,10 +536,8 @@ package body System.Vax_Float_Operations is ...@@ -596,10 +536,8 @@ package body System.Vax_Float_Operations is
C : F; C : F;
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X)); 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 ("cpysn %1,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
Volatile => True); Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B));
Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B),
Volatile => True);
return C; return C;
end Neg_F; end Neg_F;
...@@ -612,10 +550,8 @@ package body System.Vax_Float_Operations is ...@@ -612,10 +550,8 @@ package body System.Vax_Float_Operations is
C : G; C : G;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X)); 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 ("cpysn %1,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
Volatile => True); Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B));
Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B),
Volatile => True);
return C; return C;
end Neg_G; end Neg_G;
...@@ -652,11 +588,9 @@ package body System.Vax_Float_Operations is ...@@ -652,11 +588,9 @@ package body System.Vax_Float_Operations is
function Return_D (X : D) return D is function Return_D (X : D) return D is
R : D; R : D;
begin begin
-- The return value is already in $f0 so we need to trick the compiler -- The return value is already in $f0 so we need to trick the compiler
-- into thinking that we're moving X to $f0. -- into thinking that we're moving X to $f0.
Asm ("cvtdg $f0,$f0", Inputs => D'Asm_Input ("g", X), Clobber => "$f0", Asm ("cvtdg $f0,$f0", Inputs => D'Asm_Input ("g", X), Clobber => "$f0",
Volatile => True); Volatile => True);
Asm ("stg $f0,%0", D'Asm_Output ("=m", R), Volatile => True); Asm ("stg $f0,%0", D'Asm_Output ("=m", R), Volatile => True);
...@@ -669,11 +603,9 @@ package body System.Vax_Float_Operations is ...@@ -669,11 +603,9 @@ package body System.Vax_Float_Operations is
function Return_F (X : F) return F is function Return_F (X : F) return F is
R : F; R : F;
begin begin
-- The return value is already in $f0 so we need to trick the compiler -- The return value is already in $f0 so we need to trick the compiler
-- into thinking that we're moving X to $f0. -- into thinking that we're moving X to $f0.
Asm ("stf $f0,%0", F'Asm_Output ("=m", R), F'Asm_Input ("g", X), Asm ("stf $f0,%0", F'Asm_Output ("=m", R), F'Asm_Input ("g", X),
Clobber => "$f0", Volatile => True); Clobber => "$f0", Volatile => True);
return R; return R;
...@@ -685,11 +617,9 @@ package body System.Vax_Float_Operations is ...@@ -685,11 +617,9 @@ package body System.Vax_Float_Operations is
function Return_G (X : G) return G is function Return_G (X : G) return G is
R : G; R : G;
begin begin
-- The return value is already in $f0 so we need to trick the compiler -- The return value is already in $f0 so we need to trick the compiler
-- into thinking that we're moving X to $f0. -- into thinking that we're moving X to $f0.
Asm ("stg $f0,%0", G'Asm_Output ("=m", R), G'Asm_Input ("g", X), Asm ("stg $f0,%0", G'Asm_Output ("=m", R), G'Asm_Input ("g", X),
Clobber => "$f0", Volatile => True); Clobber => "$f0", Volatile => True);
return R; return R;
...@@ -705,13 +635,10 @@ package body System.Vax_Float_Operations is ...@@ -705,13 +635,10 @@ package body System.Vax_Float_Operations is
begin begin
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y), Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
Volatile => True);
Asm ("subf %1,%2,%0", S'Asm_Output ("=f", R), Asm ("subf %1,%2,%0", S'Asm_Output ("=f", R),
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)), (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
Volatile => True); Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R));
Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R),
Volatile => True);
return R1; return R1;
end Sub_F; end Sub_F;
...@@ -724,13 +651,10 @@ package body System.Vax_Float_Operations is ...@@ -724,13 +651,10 @@ package body System.Vax_Float_Operations is
R1 : G; R1 : G;
begin begin
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y), Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
Volatile => True);
Asm ("subg %1,%2,%0", T'Asm_Output ("=f", R), Asm ("subg %1,%2,%0", T'Asm_Output ("=f", R),
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)), (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
Volatile => True); Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R));
Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R),
Volatile => True);
return R1; return R1;
end Sub_G; end Sub_G;
......
...@@ -235,7 +235,7 @@ package body Sem_Ch13 is ...@@ -235,7 +235,7 @@ package body Sem_Ch13 is
-- Processing depends on version of Ada -- Processing depends on version of Ada
-- For Ada 95, we just renumber bits within a storage unit. We do the -- For Ada 95, we just renumber bits within a storage unit. We do the
-- same for Ada 83 mode, since we recognize attribute Bit_Order in -- same for Ada 83 mode, since we recognize the Bit_Order attribute in
-- Ada 83, and are free to add this extension. -- Ada 83, and are free to add this extension.
if Ada_Version < Ada_2005 then if Ada_Version < Ada_2005 then
......
...@@ -211,18 +211,6 @@ package body Sem_Warn is ...@@ -211,18 +211,6 @@ package body Sem_Warn is
("?code statement with no outputs should usually be Volatile!", N); ("?code statement with no outputs should usually be Volatile!", N);
return; return;
end if; end if;
-- Check multiple code statements in a row
if Is_List_Member (N)
and then Present (Prev (N))
and then Nkind (Prev (N)) = N_Code_Statement
then
Error_Msg_F
("?code statements in sequence should usually be Volatile!", N);
Error_Msg_F
("\?(suggest using template with multiple instructions)!", N);
end if;
end Check_Code_Statement; end Check_Code_Statement;
--------------------------------- ---------------------------------
......
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