Index: switch-c.adb =================================================================== --- switch-c.adb (revision 180365) +++ switch-c.adb (working copy) @@ -440,6 +440,11 @@ -- Ptr := Ptr + 1; -- Generate_SCIL := True; + -- -gnated switch (disable atomic synchronization) + + when 'd' => + Suppress_Options (Atomic_Synchronization) := True; + -- -gnateD switch (preprocessing symbol definition) when 'D' => @@ -743,10 +748,14 @@ -- Set all specific options as well as All_Checks in the -- Suppress_Options array, excluding Elaboration_Check, -- since this is treated specially because we do not want - -- -gnatp to disable static elaboration processing. + -- -gnatp to disable static elaboration processing. Also + -- exclude Atomic_Synchronization, since this is not a real + -- check. for J in Suppress_Options'Range loop - if J /= Elaboration_Check then + if J /= Elaboration_Check + and then J /= Atomic_Synchronization + then Suppress_Options (J) := True; end if; end loop; Index: sinfo.adb =================================================================== --- sinfo.adb (revision 180365) +++ sinfo.adb (working copy) @@ -249,6 +249,15 @@ return Node3 (N); end Ancestor_Part; + function Atomic_Sync_Required + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Expanded_Name + or else NT (N).Nkind = N_Identifier); + return Flag14 (N); + end Atomic_Sync_Required; + function Array_Aggregate (N : Node_Id) return Node_Id is begin @@ -3309,6 +3318,15 @@ Set_Node3_With_Parent (N, Val); end Set_Ancestor_Part; + procedure Set_Atomic_Sync_Required + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Expanded_Name + or else NT (N).Nkind = N_Identifier); + Set_Flag14 (N, Val); + end Set_Atomic_Sync_Required; + procedure Set_Array_Aggregate (N : Node_Id; Val : Node_Id) is begin Index: sinfo.ads =================================================================== --- sinfo.ads (revision 180365) +++ sinfo.ads (working copy) @@ -605,6 +605,12 @@ -- Since the back end is expected to ignore generic templates, this is -- harmless. + -- Atomic_Sync_Required (Flag14-Sem) + -- This flag is set in an identifier or expanded name node if the + -- corresponding reference (or assignment when on the left side of + -- an assignment) requires atomic synchronization, as a result of + -- Atomic_Synchronization being enabled for the corresponding entity. + -- At_End_Proc (Node1) -- This field is present in an N_Handled_Sequence_Of_Statements node. -- It contains an identifier reference for the cleanup procedure to be @@ -1917,6 +1923,7 @@ -- Associated_Node (Node4-Sem) -- Original_Discriminant (Node2-Sem) -- Redundant_Use (Flag13-Sem) + -- Atomic_Sync_Required (Flag14-Sem) -- Has_Private_View (Flag11-Sem) (set in generic units) -- plus fields for expression @@ -6982,8 +6989,9 @@ -- Selector_Name (Node2) -- Entity (Node4-Sem) -- Associated_Node (Node4-Sem) + -- Has_Private_View (Flag11-Sem) set in generic units. -- Redundant_Use (Flag13-Sem) - -- Has_Private_View (Flag11-Sem) set in generic units. + -- Atomic_Sync_Required (Flag14-Sem) -- plus fields for expression ----------------------------- @@ -8121,6 +8129,9 @@ function Ancestor_Part (N : Node_Id) return Node_Id; -- Node3 + function Atomic_Sync_Required + (N : Node_Id) return Boolean; -- Flag14 + function Array_Aggregate (N : Node_Id) return Node_Id; -- Node3 @@ -9096,6 +9107,9 @@ procedure Set_Ancestor_Part (N : Node_Id; Val : Node_Id); -- Node3 + procedure Set_Atomic_Sync_Required + (N : Node_Id; Val : Boolean := True); -- Flag14 + procedure Set_Array_Aggregate (N : Node_Id; Val : Node_Id); -- Node3 @@ -11764,6 +11778,7 @@ pragma Inline (All_Present); pragma Inline (Alternatives); pragma Inline (Ancestor_Part); + pragma Inline (Atomic_Sync_Required); pragma Inline (Array_Aggregate); pragma Inline (Aspect_Rep_Item); pragma Inline (Assignment_OK); @@ -12086,6 +12101,7 @@ pragma Inline (Set_All_Present); pragma Inline (Set_Alternatives); pragma Inline (Set_Ancestor_Part); + pragma Inline (Set_Atomic_Sync_Required); pragma Inline (Set_Array_Aggregate); pragma Inline (Set_Aspect_Rep_Item); pragma Inline (Set_Assignment_OK); Index: usage.adb =================================================================== --- usage.adb (revision 180365) +++ usage.adb (working copy) @@ -172,6 +172,11 @@ Write_Switch_Char ("ec=?"); Write_Line ("Specify configuration pragmas file, e.g. -gnatec=/x/f.adc"); + -- Line for -gnated switch + + Write_Switch_Char ("ed"); + Write_Line ("Disable synchronization of atomic variables"); + -- Line for -gnateD switch Write_Switch_Char ("eD?"); Index: debug.adb =================================================================== --- debug.adb (revision 180365) +++ debug.adb (working copy) @@ -94,8 +94,8 @@ -- d.a Force Target_Strict_Alignment mode to True -- d.b Dump backend types -- d.c Generate inline concatenation, do not call procedure - -- d.d - -- d.e + -- d.d Disable atomic synchronization + -- d.e Enable atomic synchronization -- d.f Inhibit folding of static expressions -- d.g Enable conversion of raise into goto -- d.h @@ -513,6 +513,13 @@ -- System.Concat_n.Str_Concat_n routines in cases where the latter -- routines would normally be called. + -- d.d Disable atomic synchronization for all atomic variable references. + -- Pragma Enable_Atomic_Synchronization is ignored. + + -- d.e Enable atomic synchronization for all atomic variable references. + -- Pragma Disable_Atomic_Synchronization is ignored, and also the + -- compiler switch -gnated is ignored. + -- d.f Suppress folding of static expressions. This of course results -- in seriously non-conforming behavior, but is useful sometimes -- when tracking down handling of complex expressions. Index: types.ads =================================================================== --- types.ads (revision 180365) +++ types.ads (working copy) @@ -660,22 +660,25 @@ No_Check_Id : constant := 0; -- Check_Id value used to indicate no check - Access_Check : constant := 1; - Accessibility_Check : constant := 2; - Alignment_Check : constant := 3; - Discriminant_Check : constant := 4; - Division_Check : constant := 5; - Elaboration_Check : constant := 6; - Index_Check : constant := 7; - Length_Check : constant := 8; - Overflow_Check : constant := 9; - Range_Check : constant := 10; - Storage_Check : constant := 11; - Tag_Check : constant := 12; - Validity_Check : constant := 13; - -- Values used to represent individual predefined checks + Access_Check : constant := 1; + Accessibility_Check : constant := 2; + Alignment_Check : constant := 3; + Atomic_Synchronization : constant := 4; + Discriminant_Check : constant := 5; + Division_Check : constant := 6; + Elaboration_Check : constant := 7; + Index_Check : constant := 8; + Length_Check : constant := 9; + Overflow_Check : constant := 10; + Range_Check : constant := 11; + Storage_Check : constant := 12; + Tag_Check : constant := 13; + Validity_Check : constant := 14; + -- Values used to represent individual predefined checks (including the + -- setting of Atomic_Synchronization, which is implemented internally using + -- a "check" whose name is Atomic_Synchronization. - All_Checks : constant := 14; + All_Checks : constant := 15; -- Value used to represent All_Checks value subtype Predefined_Check_Id is Check_Id range 1 .. All_Checks; Index: checks.adb =================================================================== --- checks.adb (revision 180365) +++ checks.adb (working copy) @@ -2555,6 +2555,23 @@ end if; end Apply_Universal_Integer_Attribute_Checks; + ------------------------------------- + -- Atomic_Synchronization_Disabled -- + ------------------------------------- + + -- Note: internally Disable/Enable_Atomic_Synchronization is implemented + -- using a bogus check called Atomic_Synchronization. This is to make it + -- more convenient to get exactly the same semantics as [Un]Suppress. + + function Atomic_Synchronization_Disabled (E : Entity_Id) return Boolean is + begin + if Present (E) and then Checks_May_Be_Suppressed (E) then + return Is_Check_Suppressed (E, Atomic_Synchronization); + else + return Scope_Suppress (Atomic_Synchronization); + end if; + end Atomic_Synchronization_Disabled; + ------------------------------- -- Build_Discriminant_Checks -- ------------------------------- Index: checks.ads =================================================================== --- checks.ads (revision 180365) +++ checks.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -46,19 +46,20 @@ -- Called for each new main source program, to initialize internal -- variables used in the package body of the Checks unit. - function Access_Checks_Suppressed (E : Entity_Id) return Boolean; - function Accessibility_Checks_Suppressed (E : Entity_Id) return Boolean; - function Alignment_Checks_Suppressed (E : Entity_Id) return Boolean; - function Discriminant_Checks_Suppressed (E : Entity_Id) return Boolean; - function Division_Checks_Suppressed (E : Entity_Id) return Boolean; - function Elaboration_Checks_Suppressed (E : Entity_Id) return Boolean; - function Index_Checks_Suppressed (E : Entity_Id) return Boolean; - function Length_Checks_Suppressed (E : Entity_Id) return Boolean; - function Overflow_Checks_Suppressed (E : Entity_Id) return Boolean; - function Range_Checks_Suppressed (E : Entity_Id) return Boolean; - function Storage_Checks_Suppressed (E : Entity_Id) return Boolean; - function Tag_Checks_Suppressed (E : Entity_Id) return Boolean; - function Validity_Checks_Suppressed (E : Entity_Id) return Boolean; + function Access_Checks_Suppressed (E : Entity_Id) return Boolean; + function Accessibility_Checks_Suppressed (E : Entity_Id) return Boolean; + function Alignment_Checks_Suppressed (E : Entity_Id) return Boolean; + function Atomic_Synchronization_Disabled (E : Entity_Id) return Boolean; + function Discriminant_Checks_Suppressed (E : Entity_Id) return Boolean; + function Division_Checks_Suppressed (E : Entity_Id) return Boolean; + function Elaboration_Checks_Suppressed (E : Entity_Id) return Boolean; + function Index_Checks_Suppressed (E : Entity_Id) return Boolean; + function Length_Checks_Suppressed (E : Entity_Id) return Boolean; + function Overflow_Checks_Suppressed (E : Entity_Id) return Boolean; + function Range_Checks_Suppressed (E : Entity_Id) return Boolean; + function Storage_Checks_Suppressed (E : Entity_Id) return Boolean; + function Tag_Checks_Suppressed (E : Entity_Id) return Boolean; + function Validity_Checks_Suppressed (E : Entity_Id) return Boolean; -- These functions check to see if the named check is suppressed, either -- by an active scope suppress setting, or because the check has been -- specifically suppressed for the given entity. If no entity is relevant Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 180365) +++ sem_prag.adb (working copy) @@ -750,6 +750,10 @@ -- convention value in the specified entity or entities. On return -- C is the convention, Ent is the referenced entity. + procedure Process_Disable_Enable_Atomic_Sync (Nam : Name_Id); + -- Common processing for Disable/Enable_Atomic_Synchronization. Nam is + -- Name_Suppress for Disable and Name_Unsuppress for Enable. + procedure Process_Extended_Import_Export_Exception_Pragma (Arg_Internal : Node_Id; Arg_External : Node_Id; @@ -3566,6 +3570,35 @@ end if; end Process_Convention; + ---------------------------------------- + -- Process_Disable_Enable_Atomic_Sync -- + ---------------------------------------- + + procedure Process_Disable_Enable_Atomic_Sync (Nam : Name_Id) is + begin + GNAT_Pragma; + Check_No_Identifiers; + Check_At_Most_N_Arguments (1); + + -- Modeled internally as + -- pragma Unsuppress (Atomic_Synchronization [,Entity]) + + Rewrite (N, + Make_Pragma (Loc, + Pragma_Identifier => + Make_Identifier (Loc, Nam), + Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => + Make_Identifier (Loc, Name_Atomic_Synchronization))))); + + if Present (Arg1) then + Append_To (Pragma_Argument_Associations (N), New_Copy (Arg1)); + end if; + + Analyze (N); + end Process_Disable_Enable_Atomic_Sync; + ----------------------------------------------------- -- Process_Extended_Import_Export_Exception_Pragma -- ----------------------------------------------------- @@ -5305,8 +5338,15 @@ -- H.4(12). Restriction_Warnings never affects generated code -- so this is done only in the real restriction case. + -- Atomic_Synchronization is not a real check, so it is not + -- affected by this processing). + if R_Id = No_Exceptions and then not Warn then - Scope_Suppress := (others => True); + for J in Scope_Suppress'Range loop + if J /= Atomic_Synchronization then + Scope_Suppress (J) := True; + end if; + end loop; end if; -- Case of No_Dependence => unit-name. Note that the parser @@ -5418,6 +5458,17 @@ procedure Suppress_Unsuppress_Echeck (E : Entity_Id; C : Check_Id) is begin + -- Check for error of trying to set atomic synchronization for + -- a non-atomic variable. + + if C = Atomic_Synchronization + and then not Is_Atomic (E) + then + Error_Msg_N + ("pragma & requires atomic variable", + Pragma_Identifier (Original_Node (N))); + end if; + Set_Checks_May_Be_Suppressed (E); if In_Package_Spec then @@ -5425,7 +5476,6 @@ (Entity => E, Check => C, Suppress => Suppress_Case); - else Push_Local_Suppress_Stack_Entry (Entity => E, @@ -5493,18 +5543,26 @@ -- the exception of Elaboration_Check, which is handled -- specially because of not wanting All_Checks to have the -- effect of deactivating static elaboration order processing. + -- Atomic_Synchronization is also not affected, since this is + -- not a real check. for J in Scope_Suppress'Range loop - if J /= Elaboration_Check then + if J /= Elaboration_Check + and then J /= Atomic_Synchronization + then Scope_Suppress (J) := Suppress_Case; end if; end loop; -- If not All_Checks, and predefined check, then set appropriate -- scope entry. Note that we will set Elaboration_Check if this - -- is explicitly specified. + -- is explicitly specified. Atomic_Synchronization is allowed + -- only if internally generated and entity is atomic. - elsif C in Predefined_Check_Id then + elsif C in Predefined_Check_Id + and then (not Comes_From_Source (N) + or else C /= Atomic_Synchronization) + then Scope_Suppress (C) := Suppress_Case; end if; @@ -6918,7 +6976,6 @@ Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1); end if; end Atomic_Components; - -------------------- -- Attach_Handler -- -------------------- @@ -7942,6 +7999,15 @@ Check_Arg_Is_Static_Expression (Arg3, Standard_Integer); Check_Arg_Is_Static_Expression (Arg4, Standard_Integer); + ------------------------------------ + -- Disable_Atomic_Synchronization -- + ------------------------------------ + + -- pragma Disable_Atomic_Synchronization [(Entity)]; + + when Pragma_Disable_Atomic_Synchronization => + Process_Disable_Enable_Atomic_Sync (Name_Suppress); + ------------------- -- Discard_Names -- ------------------- @@ -8364,6 +8430,15 @@ Source_Location); end Eliminate; + ----------------------------------- + -- Enable_Atomic_Synchronization -- + ----------------------------------- + + -- pragma Enable_Atomic_Synchronization [(Entity)]; + + when Pragma_Enable_Atomic_Synchronization => + Process_Disable_Enable_Atomic_Sync (Name_Unsuppress); + ------------ -- Export -- ------------ @@ -14152,16 +14227,12 @@ end; elsif Nkind (A) = N_Identifier then - if Chars (A) = Name_All_Checks then Set_Validity_Check_Options ("a"); - elsif Chars (A) = Name_On then Validity_Checks_On := True; - elsif Chars (A) = Name_Off then Validity_Checks_On := False; - end if; end if; end Validity_Checks; @@ -14678,194 +14749,196 @@ -- 99 special processing required (e.g. for pragma Check) Sig_Flags : constant array (Pragma_Id) of Int := - (Pragma_AST_Entry => -1, - Pragma_Abort_Defer => -1, - Pragma_Ada_83 => -1, - Pragma_Ada_95 => -1, - Pragma_Ada_05 => -1, - Pragma_Ada_2005 => -1, - Pragma_Ada_12 => -1, - Pragma_Ada_2012 => -1, - Pragma_All_Calls_Remote => -1, - Pragma_Annotate => -1, - Pragma_Assert => -1, - Pragma_Assertion_Policy => 0, - Pragma_Assume_No_Invalid_Values => 0, - Pragma_Asynchronous => -1, - Pragma_Atomic => 0, - Pragma_Atomic_Components => 0, - Pragma_Attach_Handler => -1, - Pragma_Check => 99, - Pragma_Check_Name => 0, - Pragma_Check_Policy => 0, - Pragma_CIL_Constructor => -1, - Pragma_CPP_Class => 0, - Pragma_CPP_Constructor => 0, - Pragma_CPP_Virtual => 0, - Pragma_CPP_Vtable => 0, - Pragma_CPU => -1, - Pragma_C_Pass_By_Copy => 0, - Pragma_Comment => 0, - Pragma_Common_Object => -1, - Pragma_Compile_Time_Error => -1, - Pragma_Compile_Time_Warning => -1, - Pragma_Compiler_Unit => 0, - Pragma_Complete_Representation => 0, - Pragma_Complex_Representation => 0, - Pragma_Component_Alignment => -1, - Pragma_Controlled => 0, - Pragma_Convention => 0, - Pragma_Convention_Identifier => 0, - Pragma_Debug => -1, - Pragma_Debug_Policy => 0, - Pragma_Detect_Blocking => -1, - Pragma_Default_Storage_Pool => -1, - Pragma_Dimension => -1, - Pragma_Discard_Names => 0, - Pragma_Dispatching_Domain => -1, - Pragma_Elaborate => -1, - Pragma_Elaborate_All => -1, - Pragma_Elaborate_Body => -1, - Pragma_Elaboration_Checks => -1, - Pragma_Eliminate => -1, - Pragma_Export => -1, - Pragma_Export_Exception => -1, - Pragma_Export_Function => -1, - Pragma_Export_Object => -1, - Pragma_Export_Procedure => -1, - Pragma_Export_Value => -1, - Pragma_Export_Valued_Procedure => -1, - Pragma_Extend_System => -1, - Pragma_Extensions_Allowed => -1, - Pragma_External => -1, - Pragma_Favor_Top_Level => -1, - Pragma_External_Name_Casing => -1, - Pragma_Fast_Math => -1, - Pragma_Finalize_Storage_Only => 0, - Pragma_Float_Representation => 0, - Pragma_Ident => -1, - Pragma_Implementation_Defined => -1, - Pragma_Implemented => -1, - Pragma_Implicit_Packing => 0, - Pragma_Import => +2, - Pragma_Import_Exception => 0, - Pragma_Import_Function => 0, - Pragma_Import_Object => 0, - Pragma_Import_Procedure => 0, - Pragma_Import_Valued_Procedure => 0, - Pragma_Independent => 0, - Pragma_Independent_Components => 0, - Pragma_Initialize_Scalars => -1, - Pragma_Inline => 0, - Pragma_Inline_Always => 0, - Pragma_Inline_Generic => 0, - Pragma_Inspection_Point => -1, - Pragma_Interface => +2, - Pragma_Interface_Name => +2, - Pragma_Interrupt_Handler => -1, - Pragma_Interrupt_Priority => -1, - Pragma_Interrupt_State => -1, - Pragma_Invariant => -1, - Pragma_Java_Constructor => -1, - Pragma_Java_Interface => -1, - Pragma_Keep_Names => 0, - Pragma_License => -1, - Pragma_Link_With => -1, - Pragma_Linker_Alias => -1, - Pragma_Linker_Constructor => -1, - Pragma_Linker_Destructor => -1, - Pragma_Linker_Options => -1, - Pragma_Linker_Section => -1, - Pragma_List => -1, - Pragma_Locking_Policy => -1, - Pragma_Long_Float => -1, - Pragma_Machine_Attribute => -1, - Pragma_Main => -1, - Pragma_Main_Storage => -1, - Pragma_Memory_Size => -1, - Pragma_No_Return => 0, - Pragma_No_Body => 0, - Pragma_No_Run_Time => -1, - Pragma_No_Strict_Aliasing => -1, - Pragma_Normalize_Scalars => -1, - Pragma_Obsolescent => 0, - Pragma_Optimize => -1, - Pragma_Optimize_Alignment => -1, - Pragma_Ordered => 0, - Pragma_Pack => 0, - Pragma_Page => -1, - Pragma_Passive => -1, - Pragma_Preelaborable_Initialization => -1, - Pragma_Polling => -1, - Pragma_Persistent_BSS => 0, - Pragma_Postcondition => -1, - Pragma_Precondition => -1, - Pragma_Predicate => -1, - Pragma_Preelaborate => -1, - Pragma_Preelaborate_05 => -1, - Pragma_Priority => -1, - Pragma_Priority_Specific_Dispatching => -1, - Pragma_Profile => 0, - Pragma_Profile_Warnings => 0, - Pragma_Propagate_Exceptions => -1, - Pragma_Psect_Object => -1, - Pragma_Pure => -1, - Pragma_Pure_05 => -1, - Pragma_Pure_Function => -1, - Pragma_Queuing_Policy => -1, - Pragma_Ravenscar => -1, - Pragma_Relative_Deadline => -1, - Pragma_Remote_Call_Interface => -1, - Pragma_Remote_Types => -1, - Pragma_Restricted_Run_Time => -1, - Pragma_Restriction_Warnings => -1, - Pragma_Restrictions => -1, - Pragma_Reviewable => -1, - Pragma_Short_Circuit_And_Or => -1, - Pragma_Share_Generic => -1, - Pragma_Shared => -1, - Pragma_Shared_Passive => -1, - Pragma_Short_Descriptors => 0, - Pragma_Source_File_Name => -1, - Pragma_Source_File_Name_Project => -1, - Pragma_Source_Reference => -1, - Pragma_Storage_Size => -1, - Pragma_Storage_Unit => -1, - Pragma_Static_Elaboration_Desired => -1, - Pragma_Stream_Convert => -1, - Pragma_Style_Checks => -1, - Pragma_Subtitle => -1, - Pragma_Suppress => 0, - Pragma_Suppress_Exception_Locations => 0, - Pragma_Suppress_All => -1, - Pragma_Suppress_Debug_Info => 0, - Pragma_Suppress_Initialization => 0, - Pragma_System_Name => -1, - Pragma_Task_Dispatching_Policy => -1, - Pragma_Task_Info => -1, - Pragma_Task_Name => -1, - Pragma_Task_Storage => 0, - Pragma_Test_Case => -1, - Pragma_Thread_Local_Storage => 0, - Pragma_Time_Slice => -1, - Pragma_Title => -1, - Pragma_Unchecked_Union => 0, - Pragma_Unimplemented_Unit => -1, - Pragma_Universal_Aliasing => -1, - Pragma_Universal_Data => -1, - Pragma_Unmodified => -1, - Pragma_Unreferenced => -1, - Pragma_Unreferenced_Objects => -1, - Pragma_Unreserve_All_Interrupts => -1, - Pragma_Unsuppress => 0, - Pragma_Use_VADS_Size => -1, - Pragma_Validity_Checks => -1, - Pragma_Volatile => 0, - Pragma_Volatile_Components => 0, - Pragma_Warnings => -1, - Pragma_Weak_External => -1, - Pragma_Wide_Character_Encoding => 0, - Unknown_Pragma => 0); + (Pragma_AST_Entry => -1, + Pragma_Abort_Defer => -1, + Pragma_Ada_83 => -1, + Pragma_Ada_95 => -1, + Pragma_Ada_05 => -1, + Pragma_Ada_2005 => -1, + Pragma_Ada_12 => -1, + Pragma_Ada_2012 => -1, + Pragma_All_Calls_Remote => -1, + Pragma_Annotate => -1, + Pragma_Assert => -1, + Pragma_Assertion_Policy => 0, + Pragma_Assume_No_Invalid_Values => 0, + Pragma_Asynchronous => -1, + Pragma_Atomic => 0, + Pragma_Atomic_Components => 0, + Pragma_Attach_Handler => -1, + Pragma_Check => 99, + Pragma_Check_Name => 0, + Pragma_Check_Policy => 0, + Pragma_CIL_Constructor => -1, + Pragma_CPP_Class => 0, + Pragma_CPP_Constructor => 0, + Pragma_CPP_Virtual => 0, + Pragma_CPP_Vtable => 0, + Pragma_CPU => -1, + Pragma_C_Pass_By_Copy => 0, + Pragma_Comment => 0, + Pragma_Common_Object => -1, + Pragma_Compile_Time_Error => -1, + Pragma_Compile_Time_Warning => -1, + Pragma_Compiler_Unit => 0, + Pragma_Complete_Representation => 0, + Pragma_Complex_Representation => 0, + Pragma_Component_Alignment => -1, + Pragma_Controlled => 0, + Pragma_Convention => 0, + Pragma_Convention_Identifier => 0, + Pragma_Debug => -1, + Pragma_Debug_Policy => 0, + Pragma_Detect_Blocking => -1, + Pragma_Default_Storage_Pool => -1, + Pragma_Dimension => -1, + Pragma_Disable_Atomic_Synchronization => -1, + Pragma_Discard_Names => 0, + Pragma_Dispatching_Domain => -1, + Pragma_Elaborate => -1, + Pragma_Elaborate_All => -1, + Pragma_Elaborate_Body => -1, + Pragma_Elaboration_Checks => -1, + Pragma_Eliminate => -1, + Pragma_Enable_Atomic_Synchronization => -1, + Pragma_Export => -1, + Pragma_Export_Exception => -1, + Pragma_Export_Function => -1, + Pragma_Export_Object => -1, + Pragma_Export_Procedure => -1, + Pragma_Export_Value => -1, + Pragma_Export_Valued_Procedure => -1, + Pragma_Extend_System => -1, + Pragma_Extensions_Allowed => -1, + Pragma_External => -1, + Pragma_Favor_Top_Level => -1, + Pragma_External_Name_Casing => -1, + Pragma_Fast_Math => -1, + Pragma_Finalize_Storage_Only => 0, + Pragma_Float_Representation => 0, + Pragma_Ident => -1, + Pragma_Implementation_Defined => -1, + Pragma_Implemented => -1, + Pragma_Implicit_Packing => 0, + Pragma_Import => +2, + Pragma_Import_Exception => 0, + Pragma_Import_Function => 0, + Pragma_Import_Object => 0, + Pragma_Import_Procedure => 0, + Pragma_Import_Valued_Procedure => 0, + Pragma_Independent => 0, + Pragma_Independent_Components => 0, + Pragma_Initialize_Scalars => -1, + Pragma_Inline => 0, + Pragma_Inline_Always => 0, + Pragma_Inline_Generic => 0, + Pragma_Inspection_Point => -1, + Pragma_Interface => +2, + Pragma_Interface_Name => +2, + Pragma_Interrupt_Handler => -1, + Pragma_Interrupt_Priority => -1, + Pragma_Interrupt_State => -1, + Pragma_Invariant => -1, + Pragma_Java_Constructor => -1, + Pragma_Java_Interface => -1, + Pragma_Keep_Names => 0, + Pragma_License => -1, + Pragma_Link_With => -1, + Pragma_Linker_Alias => -1, + Pragma_Linker_Constructor => -1, + Pragma_Linker_Destructor => -1, + Pragma_Linker_Options => -1, + Pragma_Linker_Section => -1, + Pragma_List => -1, + Pragma_Locking_Policy => -1, + Pragma_Long_Float => -1, + Pragma_Machine_Attribute => -1, + Pragma_Main => -1, + Pragma_Main_Storage => -1, + Pragma_Memory_Size => -1, + Pragma_No_Return => 0, + Pragma_No_Body => 0, + Pragma_No_Run_Time => -1, + Pragma_No_Strict_Aliasing => -1, + Pragma_Normalize_Scalars => -1, + Pragma_Obsolescent => 0, + Pragma_Optimize => -1, + Pragma_Optimize_Alignment => -1, + Pragma_Ordered => 0, + Pragma_Pack => 0, + Pragma_Page => -1, + Pragma_Passive => -1, + Pragma_Preelaborable_Initialization => -1, + Pragma_Polling => -1, + Pragma_Persistent_BSS => 0, + Pragma_Postcondition => -1, + Pragma_Precondition => -1, + Pragma_Predicate => -1, + Pragma_Preelaborate => -1, + Pragma_Preelaborate_05 => -1, + Pragma_Priority => -1, + Pragma_Priority_Specific_Dispatching => -1, + Pragma_Profile => 0, + Pragma_Profile_Warnings => 0, + Pragma_Propagate_Exceptions => -1, + Pragma_Psect_Object => -1, + Pragma_Pure => -1, + Pragma_Pure_05 => -1, + Pragma_Pure_Function => -1, + Pragma_Queuing_Policy => -1, + Pragma_Ravenscar => -1, + Pragma_Relative_Deadline => -1, + Pragma_Remote_Call_Interface => -1, + Pragma_Remote_Types => -1, + Pragma_Restricted_Run_Time => -1, + Pragma_Restriction_Warnings => -1, + Pragma_Restrictions => -1, + Pragma_Reviewable => -1, + Pragma_Short_Circuit_And_Or => -1, + Pragma_Share_Generic => -1, + Pragma_Shared => -1, + Pragma_Shared_Passive => -1, + Pragma_Short_Descriptors => 0, + Pragma_Source_File_Name => -1, + Pragma_Source_File_Name_Project => -1, + Pragma_Source_Reference => -1, + Pragma_Storage_Size => -1, + Pragma_Storage_Unit => -1, + Pragma_Static_Elaboration_Desired => -1, + Pragma_Stream_Convert => -1, + Pragma_Style_Checks => -1, + Pragma_Subtitle => -1, + Pragma_Suppress => 0, + Pragma_Suppress_Exception_Locations => 0, + Pragma_Suppress_All => -1, + Pragma_Suppress_Debug_Info => 0, + Pragma_Suppress_Initialization => 0, + Pragma_System_Name => -1, + Pragma_Task_Dispatching_Policy => -1, + Pragma_Task_Info => -1, + Pragma_Task_Name => -1, + Pragma_Task_Storage => 0, + Pragma_Test_Case => -1, + Pragma_Thread_Local_Storage => 0, + Pragma_Time_Slice => -1, + Pragma_Title => -1, + Pragma_Unchecked_Union => 0, + Pragma_Unimplemented_Unit => -1, + Pragma_Universal_Aliasing => -1, + Pragma_Universal_Data => -1, + Pragma_Unmodified => -1, + Pragma_Unreferenced => -1, + Pragma_Unreferenced_Objects => -1, + Pragma_Unreserve_All_Interrupts => -1, + Pragma_Unsuppress => 0, + Pragma_Use_VADS_Size => -1, + Pragma_Validity_Checks => -1, + Pragma_Volatile => 0, + Pragma_Volatile_Components => 0, + Pragma_Warnings => -1, + Pragma_Weak_External => -1, + Pragma_Wide_Character_Encoding => 0, + Unknown_Pragma => 0); function Is_Non_Significant_Pragma_Reference (N : Node_Id) return Boolean is Id : Pragma_Id; Index: warnsw.adb =================================================================== --- warnsw.adb (revision 180372) +++ warnsw.adb (working copy) @@ -67,6 +67,7 @@ Warn_On_All_Unread_Out_Parameters := True; Warn_On_Assertion_Failure := True; Warn_On_Assumed_Low_Bound := True; + Warn_On_Atomic_Synchronization := True; Warn_On_Bad_Fixed_Value := True; Warn_On_Biased_Representation := True; Warn_On_Constant := True; @@ -120,6 +121,12 @@ when 'M' => Warn_On_Suspicious_Modulus_Value := False; + when 'n' => + Warn_On_Atomic_Synchronization := True; + + when 'N' => + Warn_On_Atomic_Synchronization := False; + when 'o' => Warn_On_All_Unread_Out_Parameters := True; @@ -202,6 +209,7 @@ Warn_On_All_Unread_Out_Parameters := False; Warn_On_Assertion_Failure := True; Warn_On_Assumed_Low_Bound := True; + Warn_On_Atomic_Synchronization := False; Warn_On_Bad_Fixed_Value := True; Warn_On_Biased_Representation := True; Warn_On_Constant := True; Index: exp_ch2.adb =================================================================== --- exp_ch2.adb (revision 180365) +++ exp_ch2.adb (working copy) @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Checks; use Checks; with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; @@ -354,10 +355,10 @@ elsif Is_Protected_Component (E) then if No_Run_Time_Mode then return; + else + Expand_Protected_Component (N); end if; - Expand_Protected_Component (N); - elsif Ekind (E) = E_Entry_Index_Parameter then Expand_Entry_Index_Parameter (N); @@ -398,6 +399,52 @@ Write_Eol; end if; + -- Set Atomic_Sync_Required if necessary for atomic variable + + if Is_Atomic (E) then + declare + Set : Boolean; + MLoc : Node_Id; + + begin + -- Always set if debug flag d.e is set + + if Debug_Flag_Dot_E then + Set := True; + + -- Never set if debug flag d.d is set + + elsif Debug_Flag_Dot_D then + Set := False; + + -- Otherwise setting comes from Atomic_Synchronization state + + else + Set := not Atomic_Synchronization_Disabled (E); + end if; + + -- Set flag if required + + if Set then + + -- Generate info message if requested + + if Warn_On_Atomic_Synchronization then + if Nkind (N) = N_Identifier then + MLoc := N; + else + MLoc := Selector_Name (N); + end if; + + Error_Msg_N + ("?info: atomic synchronization set for &", MLoc); + end if; + + Set_Atomic_Sync_Required (N); + end if; + end; + end if; + -- Interpret possible Current_Value for variable case if Is_Assignable (E) Index: par-prag.adb =================================================================== --- par-prag.adb (revision 180365) +++ par-prag.adb (working copy) @@ -61,8 +61,8 @@ -- that is the only case in which a non-present argument can be referenced. procedure Check_Arg_Count (Required : Int); - -- Check argument count for pragma = Required. - -- If not give error and raise Error_Resync. + -- Check argument count for pragma = Required. If not give error and raise + -- Error_Resync. procedure Check_Arg_Is_String_Literal (Arg : Node_Id); -- Check the expression of the specified argument to make sure that it @@ -1091,174 +1091,176 @@ -- For all other pragmas, checking and processing is handled -- entirely in Sem_Prag, and no further checking is done by Par. - when Pragma_Abort_Defer | - Pragma_Assertion_Policy | - Pragma_Assume_No_Invalid_Values | - Pragma_AST_Entry | - Pragma_All_Calls_Remote | - Pragma_Annotate | - Pragma_Assert | - Pragma_Asynchronous | - Pragma_Atomic | - Pragma_Atomic_Components | - Pragma_Attach_Handler | - Pragma_Check | - Pragma_Check_Name | - Pragma_Check_Policy | - Pragma_CIL_Constructor | - Pragma_Compile_Time_Error | - Pragma_Compile_Time_Warning | - Pragma_Compiler_Unit | - Pragma_Convention_Identifier | - Pragma_CPP_Class | - Pragma_CPP_Constructor | - Pragma_CPP_Virtual | - Pragma_CPP_Vtable | - Pragma_CPU | - Pragma_C_Pass_By_Copy | - Pragma_Comment | - Pragma_Common_Object | - Pragma_Complete_Representation | - Pragma_Complex_Representation | - Pragma_Component_Alignment | - Pragma_Controlled | - Pragma_Convention | - Pragma_Debug_Policy | - Pragma_Detect_Blocking | - Pragma_Default_Storage_Pool | - Pragma_Dimension | - Pragma_Discard_Names | - Pragma_Dispatching_Domain | - Pragma_Eliminate | - Pragma_Elaborate | - Pragma_Elaborate_All | - Pragma_Elaborate_Body | - Pragma_Elaboration_Checks | - Pragma_Export | - Pragma_Export_Exception | - Pragma_Export_Function | - Pragma_Export_Object | - Pragma_Export_Procedure | - Pragma_Export_Value | - Pragma_Export_Valued_Procedure | - Pragma_Extend_System | - Pragma_External | - Pragma_External_Name_Casing | - Pragma_Favor_Top_Level | - Pragma_Fast_Math | - Pragma_Finalize_Storage_Only | - Pragma_Float_Representation | - Pragma_Ident | - Pragma_Implementation_Defined | - Pragma_Implemented | - Pragma_Implicit_Packing | - Pragma_Import | - Pragma_Import_Exception | - Pragma_Import_Function | - Pragma_Import_Object | - Pragma_Import_Procedure | - Pragma_Import_Valued_Procedure | - Pragma_Independent | - Pragma_Independent_Components | - Pragma_Initialize_Scalars | - Pragma_Inline | - Pragma_Inline_Always | - Pragma_Inline_Generic | - Pragma_Inspection_Point | - Pragma_Interface | - Pragma_Interface_Name | - Pragma_Interrupt_Handler | - Pragma_Interrupt_State | - Pragma_Interrupt_Priority | - Pragma_Invariant | - Pragma_Java_Constructor | - Pragma_Java_Interface | - Pragma_Keep_Names | - Pragma_License | - Pragma_Link_With | - Pragma_Linker_Alias | - Pragma_Linker_Constructor | - Pragma_Linker_Destructor | - Pragma_Linker_Options | - Pragma_Linker_Section | - Pragma_Locking_Policy | - Pragma_Long_Float | - Pragma_Machine_Attribute | - Pragma_Main | - Pragma_Main_Storage | - Pragma_Memory_Size | - Pragma_No_Body | - Pragma_No_Return | - Pragma_No_Run_Time | - Pragma_No_Strict_Aliasing | - Pragma_Normalize_Scalars | - Pragma_Obsolescent | - Pragma_Ordered | - Pragma_Optimize | - Pragma_Optimize_Alignment | - Pragma_Pack | - Pragma_Passive | - Pragma_Preelaborable_Initialization | - Pragma_Polling | - Pragma_Persistent_BSS | - Pragma_Postcondition | - Pragma_Precondition | - Pragma_Predicate | - Pragma_Preelaborate | - Pragma_Preelaborate_05 | - Pragma_Priority | - Pragma_Priority_Specific_Dispatching | - Pragma_Profile | - Pragma_Profile_Warnings | - Pragma_Propagate_Exceptions | - Pragma_Psect_Object | - Pragma_Pure | - Pragma_Pure_05 | - Pragma_Pure_Function | - Pragma_Queuing_Policy | - Pragma_Relative_Deadline | - Pragma_Remote_Call_Interface | - Pragma_Remote_Types | - Pragma_Restricted_Run_Time | - Pragma_Ravenscar | - Pragma_Reviewable | - Pragma_Share_Generic | - Pragma_Shared | - Pragma_Shared_Passive | - Pragma_Short_Circuit_And_Or | - Pragma_Short_Descriptors | - Pragma_Storage_Size | - Pragma_Storage_Unit | - Pragma_Static_Elaboration_Desired | - Pragma_Stream_Convert | - Pragma_Subtitle | - Pragma_Suppress | - Pragma_Suppress_Debug_Info | - Pragma_Suppress_Exception_Locations | - Pragma_Suppress_Initialization | - Pragma_System_Name | - Pragma_Task_Dispatching_Policy | - Pragma_Task_Info | - Pragma_Task_Name | - Pragma_Task_Storage | - Pragma_Test_Case | - Pragma_Thread_Local_Storage | - Pragma_Time_Slice | - Pragma_Title | - Pragma_Unchecked_Union | - Pragma_Unimplemented_Unit | - Pragma_Universal_Aliasing | - Pragma_Universal_Data | - Pragma_Unmodified | - Pragma_Unreferenced | - Pragma_Unreferenced_Objects | - Pragma_Unreserve_All_Interrupts | - Pragma_Unsuppress | - Pragma_Use_VADS_Size | - Pragma_Volatile | - Pragma_Volatile_Components | - Pragma_Weak_External | - Pragma_Validity_Checks => + when Pragma_Abort_Defer | + Pragma_Assertion_Policy | + Pragma_Assume_No_Invalid_Values | + Pragma_AST_Entry | + Pragma_All_Calls_Remote | + Pragma_Annotate | + Pragma_Assert | + Pragma_Asynchronous | + Pragma_Atomic | + Pragma_Atomic_Components | + Pragma_Attach_Handler | + Pragma_Check | + Pragma_Check_Name | + Pragma_Check_Policy | + Pragma_CIL_Constructor | + Pragma_Compile_Time_Error | + Pragma_Compile_Time_Warning | + Pragma_Compiler_Unit | + Pragma_Convention_Identifier | + Pragma_CPP_Class | + Pragma_CPP_Constructor | + Pragma_CPP_Virtual | + Pragma_CPP_Vtable | + Pragma_CPU | + Pragma_C_Pass_By_Copy | + Pragma_Comment | + Pragma_Common_Object | + Pragma_Complete_Representation | + Pragma_Complex_Representation | + Pragma_Component_Alignment | + Pragma_Controlled | + Pragma_Convention | + Pragma_Debug_Policy | + Pragma_Detect_Blocking | + Pragma_Default_Storage_Pool | + Pragma_Dimension | + Pragma_Disable_Atomic_Synchronization | + Pragma_Discard_Names | + Pragma_Dispatching_Domain | + Pragma_Eliminate | + Pragma_Elaborate | + Pragma_Elaborate_All | + Pragma_Elaborate_Body | + Pragma_Elaboration_Checks | + Pragma_Enable_Atomic_Synchronization | + Pragma_Export | + Pragma_Export_Exception | + Pragma_Export_Function | + Pragma_Export_Object | + Pragma_Export_Procedure | + Pragma_Export_Value | + Pragma_Export_Valued_Procedure | + Pragma_Extend_System | + Pragma_External | + Pragma_External_Name_Casing | + Pragma_Favor_Top_Level | + Pragma_Fast_Math | + Pragma_Finalize_Storage_Only | + Pragma_Float_Representation | + Pragma_Ident | + Pragma_Implementation_Defined | + Pragma_Implemented | + Pragma_Implicit_Packing | + Pragma_Import | + Pragma_Import_Exception | + Pragma_Import_Function | + Pragma_Import_Object | + Pragma_Import_Procedure | + Pragma_Import_Valued_Procedure | + Pragma_Independent | + Pragma_Independent_Components | + Pragma_Initialize_Scalars | + Pragma_Inline | + Pragma_Inline_Always | + Pragma_Inline_Generic | + Pragma_Inspection_Point | + Pragma_Interface | + Pragma_Interface_Name | + Pragma_Interrupt_Handler | + Pragma_Interrupt_State | + Pragma_Interrupt_Priority | + Pragma_Invariant | + Pragma_Java_Constructor | + Pragma_Java_Interface | + Pragma_Keep_Names | + Pragma_License | + Pragma_Link_With | + Pragma_Linker_Alias | + Pragma_Linker_Constructor | + Pragma_Linker_Destructor | + Pragma_Linker_Options | + Pragma_Linker_Section | + Pragma_Locking_Policy | + Pragma_Long_Float | + Pragma_Machine_Attribute | + Pragma_Main | + Pragma_Main_Storage | + Pragma_Memory_Size | + Pragma_No_Body | + Pragma_No_Return | + Pragma_No_Run_Time | + Pragma_No_Strict_Aliasing | + Pragma_Normalize_Scalars | + Pragma_Obsolescent | + Pragma_Ordered | + Pragma_Optimize | + Pragma_Optimize_Alignment | + Pragma_Pack | + Pragma_Passive | + Pragma_Preelaborable_Initialization | + Pragma_Polling | + Pragma_Persistent_BSS | + Pragma_Postcondition | + Pragma_Precondition | + Pragma_Predicate | + Pragma_Preelaborate | + Pragma_Preelaborate_05 | + Pragma_Priority | + Pragma_Priority_Specific_Dispatching | + Pragma_Profile | + Pragma_Profile_Warnings | + Pragma_Propagate_Exceptions | + Pragma_Psect_Object | + Pragma_Pure | + Pragma_Pure_05 | + Pragma_Pure_Function | + Pragma_Queuing_Policy | + Pragma_Relative_Deadline | + Pragma_Remote_Call_Interface | + Pragma_Remote_Types | + Pragma_Restricted_Run_Time | + Pragma_Ravenscar | + Pragma_Reviewable | + Pragma_Share_Generic | + Pragma_Shared | + Pragma_Shared_Passive | + Pragma_Short_Circuit_And_Or | + Pragma_Short_Descriptors | + Pragma_Storage_Size | + Pragma_Storage_Unit | + Pragma_Static_Elaboration_Desired | + Pragma_Stream_Convert | + Pragma_Subtitle | + Pragma_Suppress | + Pragma_Suppress_Debug_Info | + Pragma_Suppress_Exception_Locations | + Pragma_Suppress_Initialization | + Pragma_System_Name | + Pragma_Task_Dispatching_Policy | + Pragma_Task_Info | + Pragma_Task_Name | + Pragma_Task_Storage | + Pragma_Test_Case | + Pragma_Thread_Local_Storage | + Pragma_Time_Slice | + Pragma_Title | + Pragma_Unchecked_Union | + Pragma_Unimplemented_Unit | + Pragma_Universal_Aliasing | + Pragma_Universal_Data | + Pragma_Unmodified | + Pragma_Unreferenced | + Pragma_Unreferenced_Objects | + Pragma_Unreserve_All_Interrupts | + Pragma_Unsuppress | + Pragma_Use_VADS_Size | + Pragma_Volatile | + Pragma_Volatile_Components | + Pragma_Weak_External | + Pragma_Validity_Checks => null; -------------------- Index: opt.ads =================================================================== --- opt.ads (revision 180365) +++ opt.ads (working copy) @@ -1448,6 +1448,11 @@ -- with literals or S'Length, presumably assuming a lower bound of one. Set -- False by -gnatwW. + Warn_On_Atomic_Synchronization : Boolean := False; + -- GNAT + -- Set to True to generate information messages for atomic synchronization. + -- Set True by use of -gnatw.n. + Warn_On_Bad_Fixed_Value : Boolean := False; -- GNAT -- Set to True to generate warnings for static fixed-point expression Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 180365) +++ snames.ads-tmpl (working copy) @@ -361,10 +361,12 @@ Name_Debug_Policy : constant Name_Id := N + $; -- GNAT Name_Detect_Blocking : constant Name_Id := N + $; -- Ada 05 Name_Default_Storage_Pool : constant Name_Id := N + $; -- Ada 12 + Name_Disable_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT Name_Discard_Names : constant Name_Id := N + $; Name_Dispatching_Domain : constant Name_Id := N + $; -- Ada 12 Name_Elaboration_Checks : constant Name_Id := N + $; -- GNAT Name_Eliminate : constant Name_Id := N + $; -- GNAT + Name_Enable_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT Name_Extend_System : constant Name_Id := N + $; -- GNAT Name_Extensions_Allowed : constant Name_Id := N + $; -- GNAT Name_External_Name_Casing : constant Name_Id := N + $; -- GNAT @@ -941,10 +943,14 @@ -- Names of recognized checks for pragma Suppress + -- Note: the name Atomic_Synchronization can only be specified internally + -- as a result of using pragma Enable/Disable_Atomic_Synchronization. + First_Check_Name : constant Name_Id := N + $; Name_Access_Check : constant Name_Id := N + $; Name_Accessibility_Check : constant Name_Id := N + $; Name_Alignment_Check : constant Name_Id := N + $; -- GNAT + Name_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT Name_Discriminant_Check : constant Name_Id := N + $; Name_Division_Check : constant Name_Id := N + $; Name_Elaboration_Check : constant Name_Id := N + $; @@ -1532,10 +1538,12 @@ Pragma_Debug_Policy, Pragma_Detect_Blocking, Pragma_Default_Storage_Pool, + Pragma_Disable_Atomic_Synchronization, Pragma_Discard_Names, Pragma_Dispatching_Domain, Pragma_Elaboration_Checks, Pragma_Eliminate, + Pragma_Enable_Atomic_Synchronization, Pragma_Extend_System, Pragma_Extensions_Allowed, Pragma_External_Name_Casing,