OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR ada/54125 (s-atopri.adb:40:10: "Support_Atomic_Primitives" is undefined broke Ada on multiple platforms) 

2012-08-06  Vincent Pucci  <pucci@adacore.com>

PR ada/54125
	* exp_attr.adb (Expand_N_Attribute_Reference): Expand new
	Atomic_Always_Lock_Free attribute.
	* sem_attr.adb (Analyze_Attribute): Analyze new
	Atomic_Always_Lock_Free attribute.
	(Eval_Attribute): Nothing to do with new Atomic_Always_Lock_Free
	attribute.
	* sem_ch9.adb (Allows_Lock_Free_Implementation):
	Support_Atomic_Primitives check replaces previous erroneous
	size check.
	* sem_util.adb, sem_util.ads (Support_Atomic_Primitives):
	New routine.
	* snames.ads-tmpl: New name Name_Atomic_Always_Lock_Free and
	new attribute Attribute_Atomic_Always_Lock_Free defined.
	* s-atopri.adb: Support_Atomic_Primitives checks replaced by
	Atomic_Always_Lock_Free queries.
	* system-aix64.ads, system-aix.ads, system-darwin-ppc.ads,
	system-hpux.ads, system-linux-alpha.ads, system-linux-hppa.ads,
	system-linux-ppc.ads, system-linux-s390.ads,
	system-linux-s390x.ads, system-linux-sh4.ads,
	system-linux-sparc.ads, system-lynxos178-ppc.ads,
	system-lynxos-ppc.ads, system-mingw.ads,
	system-vxworks-arm.ads, system-solaris-sparc.ads,
	system-solaris-sparcv9.ads, system-vms_64.ads,
	system-vxworks-m68k.ads, system-vxworks-mips.ads,
	system-vxworks-ppc.ads, system-vxworks-sparcv9.ads: Flag
	Support_Atomic_Primitives removed.

From-SVN: r190163
This commit is contained in:
Vincent Pucci 2012-08-06 10:12:10 +02:00 committed by Arnaud Charlet
parent a39a553eac
commit 0ebc109a5e
28 changed files with 136 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/exp_attr.adb
View File

@ -3100,19 +3100,6 @@ package body Exp_Attr is
end if;
end;
---------------
-- Lock_Free --
---------------
-- Rewrite the attribute reference with the value of Uses_Lock_Free
when Attribute_Lock_Free => Lock_Free : declare
V : constant Entity_Id := Boolean_Literals (Uses_Lock_Free (Ptyp));
begin
Rewrite (N, New_Occurrence_Of (V, Loc));
Analyze_And_Resolve (N, Standard_Boolean);
end Lock_Free;
-------------
-- Machine --
-------------
@ -6018,6 +6005,7 @@ package body Exp_Attr is
when Attribute_Abort_Signal |
Attribute_Address_Size |
Attribute_Atomic_Always_Lock_Free |
Attribute_Base |
Attribute_Class |
Attribute_Compiler_Version |
@ -6035,6 +6023,7 @@ package body Exp_Attr is
Attribute_Has_Tagged_Values |
Attribute_Large |
Attribute_Last_Valid |
Attribute_Lock_Free |
Attribute_Machine_Emax |
Attribute_Machine_Emin |
Attribute_Machine_Mantissa |

16
gcc/ada/s-atopri.adb
View File

@ -37,7 +37,7 @@ package body System.Atomic_Primitives is
function Lock_Free_Read_8 (Ptr : Address) return uint8 is
begin
if Support_Atomic_Primitives then
if uint8'Atomic_Always_Lock_Free then
return Atomic_Load_8 (Ptr, Acquire);
else
raise Program_Error;
@ -50,7 +50,7 @@ package body System.Atomic_Primitives is
function Lock_Free_Read_16 (Ptr : Address) return uint16 is
begin
if Support_Atomic_Primitives then
if uint16'Atomic_Always_Lock_Free then
return Atomic_Load_16 (Ptr, Acquire);
else
raise Program_Error;
@ -63,7 +63,7 @@ package body System.Atomic_Primitives is
function Lock_Free_Read_32 (Ptr : Address) return uint32 is
begin
if Support_Atomic_Primitives then
if uint32'Atomic_Always_Lock_Free then
return Atomic_Load_32 (Ptr, Acquire);
else
raise Program_Error;
@ -76,7 +76,7 @@ package body System.Atomic_Primitives is
function Lock_Free_Read_64 (Ptr : Address) return uint64 is
begin
if Support_Atomic_Primitives then
if uint64'Atomic_Always_Lock_Free then
return Atomic_Load_64 (Ptr, Acquire);
else
raise Program_Error;
@ -97,7 +97,7 @@ package body System.Atomic_Primitives is
begin
if Expected /= Desired then
if Support_Atomic_Primitives then
if uint8'Atomic_Always_Lock_Free then
Actual := Sync_Compare_And_Swap_8 (Ptr, Expected, Desired);
else
raise Program_Error;
@ -126,7 +126,7 @@ package body System.Atomic_Primitives is
begin
if Expected /= Desired then
if Support_Atomic_Primitives then
if uint16'Atomic_Always_Lock_Free then
Actual := Sync_Compare_And_Swap_16 (Ptr, Expected, Desired);
else
raise Program_Error;
@ -155,7 +155,7 @@ package body System.Atomic_Primitives is
begin
if Expected /= Desired then
if Support_Atomic_Primitives then
if uint32'Atomic_Always_Lock_Free then
Actual := Sync_Compare_And_Swap_32 (Ptr, Expected, Desired);
else
raise Program_Error;
@ -184,7 +184,7 @@ package body System.Atomic_Primitives is
begin
if Expected /= Desired then
if Support_Atomic_Primitives then
if uint64'Atomic_Always_Lock_Free then
Actual := Sync_Compare_And_Swap_64 (Ptr, Expected, Desired);
else
raise Program_Error;

78
gcc/ada/sem_attr.adb
View File

@ -2573,6 +2573,15 @@ package body Sem_Attr is
Set_Etype (N, RTE (RE_AST_Handler));
end AST_Entry;
-----------------------------
-- Atomic_Always_Lock_Free --
-----------------------------
when Attribute_Atomic_Always_Lock_Free =>
Check_E0;
Check_Type;
Set_Etype (N, Standard_Boolean);
----------
-- Base --
----------
@ -5956,6 +5965,13 @@ package body Sem_Attr is
return;
end if;
-- For Lock_Free, we apply the attribute to the type of the object.
-- This is allowed since we have already verified that the type is a
-- protected type.
elsif Id = Attribute_Lock_Free then
P_Entity := Etype (P);
-- No other attributes for objects are folded
else
@ -6021,10 +6037,13 @@ package body Sem_Attr is
-- Definite must be folded if the prefix is not a generic type,
-- that is to say if we are within an instantiation. Same processing
-- applies to the GNAT attributes Has_Discriminants, Type_Class,
-- Has_Tagged_Value, and Unconstrained_Array.
-- applies to the GNAT attributes Atomic_Always_Lock_Free,
-- Has_Discriminants, Lock_Free, Type_Class, Has_Tagged_Value, and
-- Unconstrained_Array.
elsif (Id = Attribute_Definite
elsif (Id = Attribute_Atomic_Always_Lock_Free
or else
Id = Attribute_Definite
or else
Id = Attribute_Has_Access_Values
or else
@ -6032,6 +6051,8 @@ package body Sem_Attr is
or else
Id = Attribute_Has_Tagged_Values
or else
Id = Attribute_Lock_Free
or else
Id = Attribute_Type_Class
or else
Id = Attribute_Unconstrained_Array
@ -6136,16 +6157,19 @@ package body Sem_Attr is
-- since we can't do anything with unconstrained arrays. In addition,
-- only the First, Last and Length attributes are possibly static.
-- Definite, Has_Access_Values, Has_Discriminants, Has_Tagged_Values,
-- Type_Class, and Unconstrained_Array are again exceptions, because
-- they apply as well to unconstrained types.
-- Atomic_Always_Lock_Free, Definite, Has_Access_Values,
-- Has_Discriminants, Has_Tagged_Values, Lock_Free, Type_Class, and
-- Unconstrained_Array are again exceptions, because they apply as well
-- to unconstrained types.
-- In addition Component_Size is an exception since it is possibly
-- foldable, even though it is never static, and it does apply to
-- unconstrained arrays. Furthermore, it is essential to fold this
-- in the packed case, since otherwise the value will be incorrect.
elsif Id = Attribute_Definite
elsif Id = Attribute_Atomic_Always_Lock_Free
or else
Id = Attribute_Definite
or else
Id = Attribute_Has_Access_Values
or else
@ -6153,6 +6177,8 @@ package body Sem_Attr is
or else
Id = Attribute_Has_Tagged_Values
or else
Id = Attribute_Lock_Free
or else
Id = Attribute_Type_Class
or else
Id = Attribute_Unconstrained_Array
@ -6381,6 +6407,30 @@ package body Sem_Attr is
null;
end if;
-----------------------------
-- Atomic_Always_Lock_Free --
-----------------------------
-- Atomic_Always_Lock_Free attribute is a Boolean, thus no need to fold
-- here.
when Attribute_Atomic_Always_Lock_Free => Atomic_Always_Lock_Free :
declare
V : constant Entity_Id :=
Boolean_Literals
(Support_Atomic_Primitives_On_Target
and then Support_Atomic_Primitives (P_Type));
begin
Rewrite (N, New_Occurrence_Of (V, Loc));
-- Analyze and resolve as boolean. Note that this attribute is a
-- static attribute in GNAT.
Analyze_And_Resolve (N, Standard_Boolean);
Static := True;
end Atomic_Always_Lock_Free;
---------
-- Bit --
---------
@ -6801,10 +6851,18 @@ package body Sem_Attr is
-- Lock_Free --
---------------
-- Lock_Free attribute is a Boolean, thus no need to fold here.
when Attribute_Lock_Free => Lock_Free : declare
V : constant Entity_Id := Boolean_Literals (Uses_Lock_Free (P_Type));
when Attribute_Lock_Free =>
null;
begin
Rewrite (N, New_Occurrence_Of (V, Loc));
-- Analyze and resolve as boolean. Note that this attribute is a
-- static attribute in GNAT.
Analyze_And_Resolve (N, Standard_Boolean);
Static := True;
end Lock_Free;
----------
-- Last --

44
gcc/ada/sem_ch9.adb
View File

@ -557,7 +557,6 @@ package body Sem_Ch9 is
Id : constant Entity_Id := Entity (N);
Comp_Decl : Node_Id;
Comp_Id : Entity_Id := Empty;
Comp_Size : Int := 0;
Comp_Type : Entity_Id;
begin
@ -591,40 +590,19 @@ package body Sem_Ch9 is
Layout_Type (Comp_Type);
if Known_Static_Esize (Comp_Type) then
Comp_Size := UI_To_Int (Esize (Comp_Type));
if not
Support_Atomic_Primitives (Comp_Type)
then
if Lock_Free_Given then
Error_Msg_NE
("type of& must support atomic " &
"operations",
N, Comp_Id);
return Skip;
end if;
-- If the Esize (Object_Size) is unknown at
-- compile-time, look at the RM_Size
-- (Value_Size) since it may have been set by
-- an explicit representation clause.
elsif Known_Static_RM_Size (Comp_Type) then
Comp_Size :=
UI_To_Int (RM_Size (Comp_Type));
-- Worrisome missing else raise PE???
return Abandon;
end if;
-- Check that the size of the component is 8,
-- 16, 32 or 64 bits.
-- What about AAMP here???
case Comp_Size is
when 8 | 16 | 32 | 64 =>
null;
when others =>
if Lock_Free_Given then
Error_Msg_NE
("type of& must support atomic " &
"operations",
N, Comp_Id);
return Skip;
end if;
return Abandon;
end case;
end if;
-- Check if another protected component has

41
gcc/ada/sem_util.adb
View File

@ -12833,6 +12833,47 @@ package body Sem_Util is
end if;
end Subprogram_Access_Level;
-------------------------------
-- Support_Atomic_Primitives --
-------------------------------
function Support_Atomic_Primitives (Typ : Entity_Id) return Boolean is
Size : Int;
begin
-- Verify the alignment of Typ is known
if not Known_Alignment (Typ) then
return False;
end if;
if Known_Static_Esize (Typ) then
Size := UI_To_Int (Esize (Typ));
-- If the Esize (Object_Size) is unknown at compile-time, look at the
-- RM_Size (Value_Size) since it may have been set by an explicit rep
-- item.
elsif Known_Static_RM_Size (Typ) then
Size := UI_To_Int (RM_Size (Typ));
-- Otherwise, the size is considered to be unknown.
else
return False;
end if;
-- Check that the size of the component is 8, 16, 32 or 64 bits and that
-- Typ is properly aligned.
case Size is
when 8 | 16 | 32 | 64 =>
return Size = UI_To_Int (Alignment (Typ)) * 8;
when others =>
return False;
end case;
end Support_Atomic_Primitives;
-----------------
-- Trace_Scope --
-----------------

4
gcc/ada/sem_util.ads
View File

@ -1477,6 +1477,10 @@ package Sem_Util is
function Subprogram_Access_Level (Subp : Entity_Id) return Uint;
-- Return the accessibility level of the view denoted by Subp
function Support_Atomic_Primitives (Typ : Entity_Id) return Boolean;
-- Return True if Typ supports the GCC built-in atomic operations (i.e. if
-- Typ is properly sized and aligned).
procedure Trace_Scope (N : Node_Id; E : Entity_Id; Msg : String);
-- Print debugging information on entry to each unit being analyzed

2
gcc/ada/snames.ads-tmpl
View File

@ -766,6 +766,7 @@ package Snames is
Name_Asm_Input : constant Name_Id := N + $; -- GNAT
Name_Asm_Output : constant Name_Id := N + $; -- GNAT
Name_AST_Entry : constant Name_Id := N + $; -- VMS
Name_Atomic_Always_Lock_Free : constant Name_Id := N + $; -- GNAT
Name_Bit : constant Name_Id := N + $; -- GNAT
Name_Bit_Order : constant Name_Id := N + $;
Name_Bit_Position : constant Name_Id := N + $; -- GNAT
@ -1363,6 +1364,7 @@ package Snames is
Attribute_Asm_Input,
Attribute_Asm_Output,
Attribute_AST_Entry,
Attribute_Atomic_Always_Lock_Free,
Attribute_Bit,
Attribute_Bit_Order,
Attribute_Bit_Position,

1
gcc/ada/system-aix.ads
View File

@ -142,7 +142,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-aix64.ads
View File

@ -142,7 +142,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-darwin-ppc.ads
View File

@ -158,7 +158,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-hpux.ads
View File

@ -132,7 +132,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-linux-alpha.ads
View File

@ -130,7 +130,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-linux-hppa.ads
View File

@ -132,7 +132,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-linux-ppc.ads
View File

@ -140,7 +140,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-linux-s390.ads
View File

@ -130,7 +130,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-linux-s390x.ads
View File

@ -130,7 +130,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-linux-sh4.ads
View File

@ -140,7 +140,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-linux-sparc.ads
View File

@ -130,7 +130,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-lynxos-ppc.ads
View File

@ -146,7 +146,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-mingw.ads
View File

@ -132,7 +132,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-solaris-sparc.ads
View File

@ -132,7 +132,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-solaris-sparcv9.ads
View File

@ -132,7 +132,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-vms_64.ads
View File

@ -150,7 +150,6 @@ private
Stack_Check_Probes : constant Boolean := True;
Stack_Check_Limits : constant Boolean := False;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-vxworks-arm.ads
View File

@ -145,7 +145,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-vxworks-m68k.ads
View File

@ -145,7 +145,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-vxworks-mips.ads
View File

@ -145,7 +145,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-vxworks-ppc.ads
View File

@ -154,7 +154,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;

1
gcc/ada/system-vxworks-sparcv9.ads
View File

@ -147,7 +147,6 @@ private
Stack_Check_Probes : constant Boolean := False;
Stack_Check_Limits : constant Boolean := True;
Support_Aggregates : constant Boolean := True;
Support_Atomic_Primitives : constant Boolean := False;
Support_Composite_Assign : constant Boolean := True;
Support_Composite_Compare : constant Boolean := True;
Support_Long_Shifts : constant Boolean := True;