[multiple changes]

2012-05-15  Robert Dewar  <dewar@adacore.com>

	* g-comlin.adb, g-comlin.ads: Minor reformatting.

2012-05-15  Vincent Pucci  <pucci@adacore.com>

	* aspects.adb, aspects.adb: Reordering of the Aspect_Idi list. New
	aspect Aspect_Lock_Free.
	* einfo.adb, einfo.ads: New flag Uses_Lock_Free (flag 188).
	(Set_Uses_Lock_Free): New routine.
	(Uses_Lock_Free): New routine.
	* exp_ch7.adb (Is_Simple_Protected_Type): Return False for
	lock-free implementation.
	* exp_ch9.adb (Allows_Lock_Free_Implementation): Moved to Sem_Ch9.
	(Build_Lock_Free_Unprotected_Subprogram_Body): Protected
	procedure uses __sync_synchronise. Check both Object_Size
	and Value_Size.
	(Expand_N_Protected_Body): Lock_Free_Active
	renames Lock_Free_On.
	(Expand_N_Protected_Type_Declaration):
	_Object field removed for lock-free implementation.
	(Install_Private_Data_Declarations): Protection object removed
	for lock-free implementation.
	(Make_Initialize_Protection):
	Protection object initialization removed for lock-free implementation.
	* rtsfind.ads: RE_Atomic_Synchronize and RE_Relaxed added.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Aspect_Lock_Free
	analysis added.
	* sem_ch9.adb (Allows_Lock_Free_Implementation): New routine.
	(Analyze_Protected_Body): Allows_Lock_Free_Implementation call added.
	(Analyze_Protected_Type_Declaration):
	Allows_Lock_Free_Implementation call added.
	(Analyze_Single_Protected_Declaration): Second analysis of
	aspects removed.
	* s-atopri.ads: Header added.
	(Atomic_Synchronize): New routine.

2012-05-15  Robert Dewar  <dewar@adacore.com>

	* exp_ch7.ads: Add comment.

From-SVN: r187505

gcc/ada/ChangeLog

+2012-05-15  Robert Dewar  <dewar@adacore.com>
+
+	* g-comlin.adb, g-comlin.ads: Minor reformatting.
+
+2012-05-15  Vincent Pucci  <pucci@adacore.com>
+
+	* aspects.adb, aspects.adb: Reordering of the Aspect_Idi list. New
+	aspect Aspect_Lock_Free.
+	* einfo.adb, einfo.ads: New flag Uses_Lock_Free (flag 188).
+	(Set_Uses_Lock_Free): New routine.
+	(Uses_Lock_Free): New routine.
+	* exp_ch7.adb (Is_Simple_Protected_Type): Return False for
+	lock-free implementation.
+	* exp_ch9.adb (Allows_Lock_Free_Implementation): Moved to Sem_Ch9.
+	(Build_Lock_Free_Unprotected_Subprogram_Body): Protected
+	procedure uses __sync_synchronise. Check both Object_Size
+	and Value_Size.
+	(Expand_N_Protected_Body): Lock_Free_Active
+	renames Lock_Free_On.
+	(Expand_N_Protected_Type_Declaration):
+	_Object field removed for lock-free implementation.
+	(Install_Private_Data_Declarations): Protection object removed
+	for lock-free implementation.
+	(Make_Initialize_Protection):
+	Protection object initialization removed for lock-free implementation.
+	* rtsfind.ads: RE_Atomic_Synchronize and RE_Relaxed added.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Aspect_Lock_Free
+	analysis added.
+	* sem_ch9.adb (Allows_Lock_Free_Implementation): New routine.
+	(Analyze_Protected_Body): Allows_Lock_Free_Implementation call added.
+	(Analyze_Protected_Type_Declaration):
+	Allows_Lock_Free_Implementation call added.
+	(Analyze_Single_Protected_Declaration): Second analysis of
+	aspects removed.
+	* s-atopri.ads: Header added.
+	(Atomic_Synchronize): New routine.
+
+2012-05-15  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch7.ads: Add comment.
+
 2012-05-15  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* a-calend.adb (Day_Of_Week): The routine once again treats

gcc/ada/aspects.adb

@@ -242,11 +242,13 @@ package body Aspects is
     Aspect_Ada_2012                     => Aspect_Ada_2005,
     Aspect_Address                      => Aspect_Address,
     Aspect_Alignment                    => Aspect_Alignment,
+    Aspect_All_Calls_Remote             => Aspect_All_Calls_Remote,
     Aspect_Asynchronous                 => Aspect_Asynchronous,
     Aspect_Atomic                       => Aspect_Atomic,
     Aspect_Atomic_Components            => Aspect_Atomic_Components,
     Aspect_Attach_Handler               => Aspect_Attach_Handler,
     Aspect_Bit_Order                    => Aspect_Bit_Order,
+    Aspect_Compiler_Unit                => Aspect_Compiler_Unit,
     Aspect_Component_Size               => Aspect_Component_Size,
     Aspect_Constant_Indexing            => Aspect_Constant_Indexing,
     Aspect_Contract_Case                => Aspect_Contract_Case,
@@ -259,6 +261,7 @@ package body Aspects is
     Aspect_Discard_Names                => Aspect_Discard_Names,
     Aspect_Dispatching_Domain           => Aspect_Dispatching_Domain,
     Aspect_Dynamic_Predicate            => Aspect_Predicate,
+    Aspect_Elaborate_Body               => Aspect_Elaborate_Body,
     Aspect_External_Tag                 => Aspect_External_Tag,
     Aspect_Favor_Top_Level              => Aspect_Favor_Top_Level,
     Aspect_Implicit_Dereference         => Aspect_Implicit_Dereference,
@@ -266,24 +269,12 @@ package body Aspects is
     Aspect_Independent_Components       => Aspect_Independent_Components,
     Aspect_Inline                       => Aspect_Inline,
     Aspect_Inline_Always                => Aspect_Inline,
+    Aspect_Input                        => Aspect_Input,
     Aspect_Interrupt_Handler            => Aspect_Interrupt_Handler,
     Aspect_Interrupt_Priority           => Aspect_Interrupt_Priority,
-    Aspect_Iterator_Element             => Aspect_Iterator_Element,
-    Aspect_All_Calls_Remote             => Aspect_All_Calls_Remote,
-    Aspect_Compiler_Unit                => Aspect_Compiler_Unit,
-    Aspect_Elaborate_Body               => Aspect_Elaborate_Body,
-    Aspect_Preelaborate                 => Aspect_Preelaborate,
-    Aspect_Preelaborate_05              => Aspect_Preelaborate_05,
-    Aspect_Pure                         => Aspect_Pure,
-    Aspect_Pure_05                      => Aspect_Pure_05,
-    Aspect_Pure_12                      => Aspect_Pure_12,
-    Aspect_Remote_Call_Interface        => Aspect_Remote_Call_Interface,
-    Aspect_Remote_Types                 => Aspect_Remote_Types,
-    Aspect_Scalar_Storage_Order         => Aspect_Scalar_Storage_Order,
-    Aspect_Shared_Passive               => Aspect_Shared_Passive,
-    Aspect_Universal_Data               => Aspect_Universal_Data,
-    Aspect_Input                        => Aspect_Input,
     Aspect_Invariant                    => Aspect_Invariant,
+    Aspect_Iterator_Element             => Aspect_Iterator_Element,
+    Aspect_Lock_Free                    => Aspect_Lock_Free,
     Aspect_Machine_Radix                => Aspect_Machine_Radix,
     Aspect_No_Return                    => Aspect_No_Return,
     Aspect_Object_Size                  => Aspect_Object_Size,
@@ -295,12 +286,21 @@ package body Aspects is
     Aspect_Pre                          => Aspect_Pre,
     Aspect_Precondition                 => Aspect_Pre,
     Aspect_Predicate                    => Aspect_Predicate,
+    Aspect_Preelaborate                 => Aspect_Preelaborate,
+    Aspect_Preelaborate_05              => Aspect_Preelaborate_05,
     Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
     Aspect_Priority                     => Aspect_Priority,
+    Aspect_Pure                         => Aspect_Pure,
+    Aspect_Pure_05                      => Aspect_Pure_05,
+    Aspect_Pure_12                      => Aspect_Pure_12,
     Aspect_Pure_Function                => Aspect_Pure_Function,
     Aspect_Remote_Access_Type           => Aspect_Remote_Access_Type,
+    Aspect_Remote_Call_Interface        => Aspect_Remote_Call_Interface,
+    Aspect_Remote_Types                 => Aspect_Remote_Types,
     Aspect_Read                         => Aspect_Read,
+    Aspect_Scalar_Storage_Order         => Aspect_Scalar_Storage_Order,
     Aspect_Shared                       => Aspect_Atomic,
+    Aspect_Shared_Passive               => Aspect_Shared_Passive,
     Aspect_Simple_Storage_Pool          => Aspect_Simple_Storage_Pool,
     Aspect_Simple_Storage_Pool_Type     => Aspect_Simple_Storage_Pool_Type,
     Aspect_Size                         => Aspect_Size,
@@ -316,6 +316,7 @@ package body Aspects is
     Aspect_Type_Invariant               => Aspect_Invariant,
     Aspect_Unchecked_Union              => Aspect_Unchecked_Union,
     Aspect_Universal_Aliasing           => Aspect_Universal_Aliasing,
+    Aspect_Universal_Data               => Aspect_Universal_Data,
     Aspect_Unmodified                   => Aspect_Unmodified,
     Aspect_Unreferenced                 => Aspect_Unreferenced,
     Aspect_Unreferenced_Objects         => Aspect_Unreferenced_Objects,

gcc/ada/aspects.ads

@@ -142,7 +142,12 @@ package Aspects is
       Aspect_Unreferenced,                  -- GNAT
       Aspect_Unreferenced_Objects,          -- GNAT
       Aspect_Volatile,
-      Aspect_Volatile_Components);
+      Aspect_Volatile_Components,
+
+      --  Aspects that have a static boolean value but don't correspond to
+      --  pragmas
+
+      Aspect_Lock_Free);
 
    --  The following array indicates aspects that accept 'Class
 
@@ -182,6 +187,7 @@ package Aspects is
                              Aspect_Dimension_System         => True,
                              Aspect_Favor_Top_Level          => True,
                              Aspect_Inline_Always            => True,
+                             Aspect_Lock_Free                => True,
                              Aspect_Object_Size              => True,
                              Aspect_Persistent_BSS           => True,
                              Aspect_Predicate                => True,
@@ -352,6 +358,7 @@ package Aspects is
      Aspect_Interrupt_Priority           => Name_Interrupt_Priority,
      Aspect_Invariant                    => Name_Invariant,
      Aspect_Iterator_Element             => Name_Iterator_Element,
+     Aspect_Lock_Free                    => Name_Lock_Free,
      Aspect_Machine_Radix                => Name_Machine_Radix,
      Aspect_No_Return                    => Name_No_Return,
      Aspect_Object_Size                  => Name_Object_Size,

gcc/ada/einfo.adb

@@ -452,6 +452,7 @@ package body Einfo is
    --    Is_Ada_2005_Only                Flag185
    --    Is_Interface                    Flag186
    --    Has_Constrained_Partial_View    Flag187
+   --    Uses_Lock_Free                  Flag188
    --    Is_Pure_Unit_Access_Type        Flag189
    --    Has_Specified_Stream_Input      Flag190
 
@@ -525,7 +526,6 @@ package body Einfo is
    --    Has_Anonymous_Master            Flag253
    --    Is_Implementation_Defined       Flag254
 
-   --    (unused)                        Flag188
    --    (unused)                        Flag201
 
    -----------------------
@@ -2794,6 +2794,12 @@ package body Einfo is
       return Flag222 (Id);
    end Used_As_Generic_Actual;
 
+   function Uses_Lock_Free (Id : E) return B is
+   begin
+      pragma Assert (Is_Protected_Type (Id));
+      return Flag188 (Id);
+   end Uses_Lock_Free;
+
    function Uses_Sec_Stack (Id : E) return B is
    begin
       return Flag95 (Id);
@@ -5358,16 +5364,22 @@ package body Einfo is
       Set_Node16 (Id, V);
    end Set_Unset_Reference;
 
-   procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
-   begin
-      Set_Flag95 (Id, V);
-   end Set_Uses_Sec_Stack;
-
    procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
    begin
       Set_Flag222 (Id, V);
    end Set_Used_As_Generic_Actual;
 
+   procedure Set_Uses_Lock_Free (Id : E; V : B := True) is
+   begin
+      pragma Assert (Ekind (Id) = E_Protected_Type);
+      Set_Flag188 (Id, V);
+   end Set_Uses_Lock_Free;
+
+   procedure Set_Uses_Sec_Stack (Id : E; V : B := True) is
+   begin
+      Set_Flag95 (Id, V);
+   end Set_Uses_Sec_Stack;
+
    procedure Set_Warnings_Off (Id : E; V : B := True) is
    begin
       Set_Flag96 (Id, V);

gcc/ada/einfo.ads

@@ -3878,6 +3878,12 @@ package Einfo is
 --       Present in all entities, set if the entity is used as an argument to
 --       a generic instantiation. Used to tune certain warning messages.
 
+--    Uses_Lock_Free (Flag188)
+--       Present in protected type entities. Set to True when the Lock Free
+--       implementation is used for the protected type. This implemenatation is
+--       based on atomic transactions and doesn't require anymore the use of
+--       Protection object (see System.Tasking.Protected_Objects).
+
 --    Uses_Sec_Stack (Flag95)
 --       Present in scope entities (blocks,functions, procedures, tasks,
 --       entries). Set to True when secondary stack is used in this scope and
@@ -5601,6 +5607,7 @@ package Einfo is
    --    Stored_Constraint                   (Elist23)
    --    Has_Interrupt_Handler               (synth)
    --    Sec_Stack_Needed_For_Return         (Flag167)  ???
+   --    Uses_Lock_Free                      (Flag188)
    --    Uses_Sec_Stack                      (Flag95)   ???
    --    Has_Entries                         (synth)
    --    Number_Entries                      (synth)
@@ -6405,6 +6412,7 @@ package Einfo is
    function Universal_Aliasing                  (Id : E) return B;
    function Unset_Reference                     (Id : E) return N;
    function Used_As_Generic_Actual              (Id : E) return B;
+   function Uses_Lock_Free                      (Id : E) return B;
    function Uses_Sec_Stack                      (Id : E) return B;
    function Vax_Float                           (Id : E) return B;
    function Warnings_Off                        (Id : E) return B;
@@ -7001,6 +7009,7 @@ package Einfo is
    procedure Set_Universal_Aliasing              (Id : E; V : B := True);
    procedure Set_Unset_Reference                 (Id : E; V : N);
    procedure Set_Used_As_Generic_Actual          (Id : E; V : B := True);
+   procedure Set_Uses_Lock_Free                  (Id : E; V : B := True);
    procedure Set_Uses_Sec_Stack                  (Id : E; V : B := True);
    procedure Set_Warnings_Off                    (Id : E; V : B := True);
    procedure Set_Warnings_Off_Used               (Id : E; V : B := True);
@@ -7746,6 +7755,7 @@ package Einfo is
    pragma Inline (Universal_Aliasing);
    pragma Inline (Unset_Reference);
    pragma Inline (Used_As_Generic_Actual);
+   pragma Inline (Uses_Lock_Free);
    pragma Inline (Uses_Sec_Stack);
    pragma Inline (Warnings_Off);
    pragma Inline (Warnings_Off_Used);
@@ -8148,6 +8158,7 @@ package Einfo is
    pragma Inline (Set_Universal_Aliasing);
    pragma Inline (Set_Unset_Reference);
    pragma Inline (Set_Used_As_Generic_Actual);
+   pragma Inline (Set_Uses_Lock_Free);
    pragma Inline (Set_Uses_Sec_Stack);
    pragma Inline (Set_Warnings_Off);
    pragma Inline (Set_Warnings_Off_Used);

gcc/ada/exp_ch7.adb

@@ -4602,6 +4602,7 @@ package body Exp_Ch7 is
    begin
       return
         Is_Protected_Type (T)
+          and then not Uses_Lock_Free (T)
           and then not Has_Entries (T)
           and then Is_RTE (Find_Protection_Type (T), RE_Protection);
    end Is_Simple_Protected_Type;

gcc/ada/exp_ch7.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -272,6 +272,8 @@ package Exp_Ch7 is
    function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
    --  Determine whether T denotes a protected type without entires whose
    --  _object field is of type System.Tasking.Protected_Objects.Protection.
+   --  Something wrong here, implementation was changed to test Lock_Free
+   --  but this spec does not mention that ???
 
    --------------------------------
    -- Transient Scope Management --

gcc/ada/g-comlin.adb

@@ -1343,7 +1343,7 @@ package body GNAT.Command_Line is
    begin
       if Switch /= "" or else Long_Switch /= "" then
          Initialize_Switch_Def
-            (Def, Switch, Long_Switch, Help, Section, Argument);
+           (Def, Switch, Long_Switch, Help, Section, Argument);
          Add (Config, Def);
       end if;
    end Define_Switch;
@@ -1390,7 +1390,7 @@ package body GNAT.Command_Line is
    begin
       if Switch /= "" or else Long_Switch /= "" then
          Initialize_Switch_Def
-            (Def, Switch, Long_Switch, Help, Section, Argument);
+           (Def, Switch, Long_Switch, Help, Section, Argument);
          Def.Integer_Output  := Output.all'Unchecked_Access;
          Def.Integer_Default := Default;
          Def.Integer_Initial := Initial;
@@ -1415,7 +1415,7 @@ package body GNAT.Command_Line is
    begin
       if Switch /= "" or else Long_Switch /= "" then
          Initialize_Switch_Def
-            (Def, Switch, Long_Switch, Help, Section, Argument);
+           (Def, Switch, Long_Switch, Help, Section, Argument);
          Def.String_Output  := Output.all'Unchecked_Access;
          Add (Config, Def);
       end if;
@@ -3233,7 +3233,9 @@ package body GNAT.Command_Line is
                   end if;
                end if;
 
-            else  --  Long_Switch necessarily not null
+            --  Def.Switch is null (Long_Switch must be non-null)
+
+            else
                Decompose_Switch (Def.Long_Switch.all, P2, Last2);
                Append (Result,
                        Def.Long_Switch (Def.Long_Switch'First .. Last2));

gcc/ada/g-comlin.ads

@@ -181,16 +181,20 @@
 --     ...
 
 --  Specifying the help message is optional, but makes it easy to then call
---  the function
+--  the function:
+
 --     Display_Help (Config);
+
 --  that will display a properly formatted help message for your application,
 --  listing all possible switches. That way you have a single place in which
 --  to maintain the list of switches and their meaning, rather than maintaining
 --  both the string to pass to Getopt and a subprogram to display the help.
 --  Both will properly stay synchronized.
 
---  Once you have this Config, you just have to call
+--  Once you have this Config, you just have to call:
+
 --     Getopt (Config, Callback'Access);
+
 --  to parse the command line. The Callback will be called for each switch
 --  found on the command line (in the case of our example, that is "-gnatwu"
 --  and then "-gnatwv", not "-gnatwa" itself). This simplifies command line
@@ -203,13 +207,13 @@
 
 --     Optimization : aliased Integer;
 --     Verbose      : aliased Boolean;
---
+
 --     Define_Switch (Config, Verbose'Access,
 --                    "-v", Long_Switch => "--verbose",
 --                    Help => "Output extra verbose information");
 --     Define_Switch (Config, Optimization'Access,
 --                    "-O?", Help => "Optimization level");
---
+
 --     Getopt (Config);  --  No callback
 
 --  Since all switches are handled automatically, we don't even need to pass
@@ -263,8 +267,8 @@
 --  Some command line arguments can have parameters, which on a command line
 --  appear as a separate argument that must immediately follow the switch.
 --  Since the subprograms in this package will reorganize the switches to group
---  them, you need to indicate what is a command line
---  parameter, and what is a switch argument.
+--  them, you need to indicate what is a command line parameter, and what is a
+--  switch argument.
 
 --  This is done by passing an extra argument to Add_Switch, as in:
 
@@ -308,18 +312,18 @@ package GNAT.Command_Line is
       Stop_At_First_Non_Switch : Boolean := False;
       Section_Delimiters       : String := "");
    --  The first procedure resets the internal state of the package to prepare
-   --  to rescan the parameters. It does not need to be called before the first
-   --  use of Getopt (but it could be), but it must be called if you want to
-   --  start rescanning the command line parameters from the start. The
-   --  optional parameter Switch_Char can be used to reset the switch
+   --  to rescan the parameters. It does not need to be called before the
+   --  first use of Getopt (but it could be), but it must be called if you
+   --  want to start rescanning the command line parameters from the start.
+   --  The optional parameter Switch_Char can be used to reset the switch
    --  character, e.g. to '/' for use in DOS-like systems.
    --
-   --  The second subprogram initializes a parser that takes its arguments from
-   --  an array of strings rather than directly from the command line. In this
-   --  case, the parser is responsible for freeing the strings stored in
+   --  The second subprogram initializes a parser that takes its arguments
+   --  from an array of strings rather than directly from the command line. In
+   --  this case, the parser is responsible for freeing the strings stored in
    --  Command_Line. If you pass null to Command_Line, this will in fact create
    --  a second parser for Ada.Command_Line, which doesn't share any data with
-   --  the default parser. This parser must be free-ed.
+   --  the default parser. This parser must be free'ed.
    --
    --  The optional parameter Stop_At_First_Non_Switch indicates if Getopt is
    --  to look for switches on the whole command line, or if it has to stop as
@@ -451,9 +455,9 @@ package GNAT.Command_Line is
    --  spaces.
    --
    --    Example
-   --       Getopt ("a b", Concatenate => False)
-   --       If the command line is '-ab', exception Invalid_Switch will be
-   --       raised and Full_Switch will return "ab".
+   --      Getopt ("a b", Concatenate => False)
+   --      If the command line is '-ab', exception Invalid_Switch will be
+   --      raised and Full_Switch will return "ab".
 
    function Get_Argument
      (Do_Expansion : Boolean := False;
@@ -559,8 +563,8 @@ package GNAT.Command_Line is
    --  The section name should not include the leading '-'. So for instance in
    --  the case of gnatmake we would use:
    --
-   --      Define_Section (Config, "cargs");
-   --      Define_Section (Config, "bargs");
+   --    Define_Section (Config, "cargs");
+   --    Define_Section (Config, "bargs");
 
    procedure Define_Alias
      (Config   : in out Command_Line_Configuration;
@@ -609,9 +613,9 @@ package GNAT.Command_Line is
    --
    --  Switch and Long_Switch (when specified) are aliases and can be used
    --  interchangeably. There is no check that they both take an argument or
-   --  both take no argument.
-   --  Switch can be set to "*" to indicate that any switch is supported (in
-   --  which case Getopt will return '*', see its documentation).
+   --  both take no argument. Switch can be set to "*" to indicate that any
+   --  switch is supported (in which case Getopt will return '*', see its
+   --  documentation).
    --
    --  Help is used by the Display_Help procedure to describe the supported
    --  switches.
@@ -633,11 +637,13 @@ package GNAT.Command_Line is
    --  See Define_Switch for a description of the parameters.
    --  When the switch is found on the command line, Getopt will set
    --  Output.all to Value.
+   --
    --  Output is always initially set to "not Value", so that if the switch is
    --  not found on the command line, Output still has a valid value.
    --  The switch must not take any parameter.
-   --  Output must exist at least as long as Config, otherwise erroneous memory
-   --  access may happen.
+   --
+   --  Output must exist at least as long as Config, otherwise an erroneous
+   --  memory access may occur.
 
    procedure Define_Switch
      (Config      : in out Command_Line_Configuration;
@@ -649,14 +655,14 @@ package GNAT.Command_Line is
       Initial     : Integer := 0;
       Default     : Integer := 1;
       Argument    : String := "ARG");
-   --  See Define_Switch for a description of the parameters.
-   --  When the switch is found on the command line, Getopt will set
-   --  Output.all to the value of the switch's parameter. If the parameter is
-   --  not an integer, Invalid_Parameter is raised.
+   --  See Define_Switch for a description of the parameters. When the
+   --  switch is found on the command line, Getopt will set Output.all to the
+   --  value of the switch's parameter. If the parameter is not an integer,
+   --  Invalid_Parameter is raised.
+
    --  Output is always initialized to Initial. If the switch has an optional
    --  argument which isn't specified by the user, then Output will be set to
-   --  Default.
-   --  The switch must accept an argument.
+   --  Default. The switch must accept an argument.
 
    procedure Define_Switch
      (Config      : in out Command_Line_Configuration;
@@ -667,11 +673,10 @@ package GNAT.Command_Line is
       Section     : String := "";
       Argument    : String := "ARG");
    --  Set Output to the value of the switch's parameter when the switch is
-   --  found on the command line.
-   --  Output is always initialized to the empty string if it does not have
-   --  a value already (otherwise it is left as is so that you can specify the
-   --  default value directly in the declaration of the variable).
-   --  The switch must accept an argument.
+   --  found on the command line. Output is always initialized to the empty
+   --  string if it does not have a value already (otherwise it is left as is
+   --  so that you can specify the default value directly in the declaration
+   --  of the variable). The switch must accept an argument.
 
    procedure Set_Usage
      (Config   : in out Command_Line_Configuration;
@@ -705,15 +710,14 @@ package GNAT.Command_Line is
      (Switch    : String;
       Parameter : String;
       Section   : String);
-   --  Called when a switch is found on the command line.
-   --  [Switch] includes any leading '-' that was specified in Define_Switch.
-   --  This is slightly different from the functional version of Getopt above,
-   --  for which Full_Switch omits the first leading '-'.
+   --  Called when a switch is found on the command line. Switch includes
+   --  any leading '-' that was specified in Define_Switch. This is slightly
+   --  different from the functional version of Getopt above, for which
+   --  Full_Switch omits the first leading '-'.
 
    Exit_From_Command_Line : exception;
-   --  Emitted when the program should exit.
-   --  This is called when Getopt below has seen -h, --help or an invalid
-   --  switch.
+   --  Emitted when the program should exit. This is called when Getopt below
+   --  has seen -h, --help or an invalid switch.
 
    procedure Getopt
      (Config      : Command_Line_Configuration;
@@ -823,7 +827,7 @@ package GNAT.Command_Line is
    --  If the command line has sections (such as -bargs -cargs), then they
    --  should be listed in the Sections parameter (as "-bargs -cargs").
    --
-   --  This function can be used to reset Cmd by passing an empty string.
+   --  This function can be used to reset Cmd by passing an empty string
    --
    --  If an invalid switch is found on the command line (ie wasn't defined in
    --  the configuration via Define_Switch), and the configuration wasn't set
@@ -947,6 +951,7 @@ package GNAT.Command_Line is
    ---------------
    -- Iteration --
    ---------------
+
    --  When a command line was created with the above, you can then iterate
    --  over its contents using the following iterator.
 
@@ -992,6 +997,7 @@ package GNAT.Command_Line is
    --  create an Opt_Parser.
    --
    --  Args must be freed by the caller.
+   --
    --  Expanded has the same meaning as in Start.
 
 private

gcc/ada/rtsfind.ads

@@ -739,6 +739,8 @@ package Rtsfind is
      RE_Atomic_Load_16,                  -- System.Atomic_Primitives
      RE_Atomic_Load_32,                  -- System.Atomic_Primitives
      RE_Atomic_Load_64,                  -- System.Atomic_Primitives
+     RE_Atomic_Synchronize,              -- System.Atomic_Primitives
+     RE_Relaxed,                         -- System.Atomic_Primitives
      RE_Uint8,                           -- System.Atomic_Primitives
      RE_Uint16,                          -- System.Atomic_Primitives
      RE_Uint32,                          -- System.Atomic_Primitives
@@ -1960,6 +1962,8 @@ package Rtsfind is
      RE_Atomic_Load_16                   => System_Atomic_Primitives,
      RE_Atomic_Load_32                   => System_Atomic_Primitives,
      RE_Atomic_Load_64                   => System_Atomic_Primitives,
+     RE_Atomic_Synchronize               => System_Atomic_Primitives,
+     RE_Relaxed                          => System_Atomic_Primitives,
      RE_Uint8                            => System_Atomic_Primitives,
      RE_Uint16                           => System_Atomic_Primitives,
      RE_Uint32                           => System_Atomic_Primitives,

gcc/ada/s-atopri.ads

@@ -29,7 +29,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  ??? Need header saying what this unit is!!!
+--  This package contains atomic primitives defined from gcc built-in functions
+
+--  For now, these operations are only used by the compiler to generate the
+--  lock-free implementation of protected objects.
 
 package System.Atomic_Primitives is
    pragma Preelaborate;
@@ -119,4 +122,6 @@ package System.Atomic_Primitives is
       Model : Mem_Model := Seq_Cst) return uint64;
    pragma Import (Intrinsic, Atomic_Load_64, "__atomic_load_8");
 
+   procedure Atomic_Synchronize;
+   pragma Import (Intrinsic, Atomic_Synchronize, "__sync_synchronize");
 end System.Atomic_Primitives;

gcc/ada/sem_ch13.adb

@@ -926,16 +926,40 @@ package body Sem_Ch13 is
                when No_Aspect =>
                   raise Program_Error;
 
-               --  Aspects taking an optional boolean argument. For all of
-               --  these we just create a matching pragma and insert it, if
-               --  the expression is missing or set to True. If the expression
-               --  is False, we can ignore the aspect with the exception that
-               --  in the case of a derived type, we must check for an illegal
-               --  attempt to cancel an inherited aspect.
+               --  Aspects taking an optional boolean argument
 
                when Boolean_Aspects =>
                   Set_Is_Boolean_Aspect (Aspect);
 
+                  --  Special treatment for Aspect_Lock_Free since it is the
+                  --  only Boolean_Aspect that doesn't correspond to a pragma.
+
+                  if A_Id = Aspect_Lock_Free then
+                     if Ekind (E) /= E_Protected_Type then
+                        Error_Msg_N
+                          ("aspect % only applies to protected objects",
+                           Aspect);
+                     end if;
+
+                     --  Set the Uses_Lock_Free flag to True if there is no
+                     --  expression or if the expression is True.
+
+                     if No (Expr)
+                       or else Is_True (Static_Boolean (Expr))
+                     then
+                        Set_Uses_Lock_Free (E);
+                     end if;
+
+                     goto Continue;
+                  end if;
+
+                  --  For all of these aspects we just create a matching pragma
+                  --  and insert it, if the expression is missing or set to
+                  --  True. If the expression is False, we can ignore the
+                  --  aspect with the exception that in the case of a derived
+                  --  type, we must check for an illegal attempt to cancel an
+                  --  inherited aspect.
+
                   if Present (Expr)
                     and then Is_False (Static_Boolean (Expr))
                   then

gcc/ada/sem_ch9.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Table;
 with Types; use Types;
 
 package Sem_Ch9  is
@@ -52,4 +53,35 @@ package Sem_Ch9  is
    procedure Analyze_Terminate_Alternative              (N : Node_Id);
    procedure Analyze_Timed_Entry_Call                   (N : Node_Id);
    procedure Analyze_Triggering_Alternative             (N : Node_Id);
+
+   ------------------------------
+   -- Lock Free Data Structure --
+   ------------------------------
+
+   --  A lock-free subprogram is a protected routine which references a unique
+   --  protected scalar component and does not contain statements that cause
+   --  side effects. Due to this restricted behavior, all references to shared
+   --  data from within the subprogram can be synchronized through the use of
+   --  atomic operations rather than relying on locks.
+
+   type Lock_Free_Subprogram is record
+      Sub_Body : Node_Id;
+      --  Reference to the body of a protected subprogram which meets the lock-
+      --  free requirements.
+
+      Comp_Id : Entity_Id;
+      --  Reference to the scalar component referenced from within Sub_Body
+   end record;
+
+   --  This table establishes a relation between a protected subprogram body
+   --  and a unique component it references. The table is used when building
+   --  the lock-free versions of a protected subprogram body.
+
+   package Lock_Free_Subprogram_Table is new Table.Table (
+     Table_Component_Type => Lock_Free_Subprogram,
+     Table_Index_Type     => Nat,
+     Table_Low_Bound      => 1,
+     Table_Initial        => 5,
+     Table_Increment      => 5,
+     Table_Name           => "Lock_Free_Subprogram_Table");
 end Sem_Ch9;

gcc/ada/snames.ads-tmpl

@@ -142,6 +142,7 @@ package Snames is
    Name_Dimension                      : constant Name_Id := N + $;
    Name_Dimension_System               : constant Name_Id := N + $;
    Name_Dynamic_Predicate              : constant Name_Id := N + $;
+   Name_Lock_Free                      : constant Name_Id := N + $;
    Name_Post                           : constant Name_Id := N + $;
    Name_Pre                            : constant Name_Id := N + $;
    Name_Static_Predicate               : constant Name_Id := N + $;