Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 187501)
+++ exp_ch7.adb	(working copy)
@@ -4602,6 +4602,7 @@
    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;
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 187501)
+++ exp_ch9.adb	(working copy)
@@ -25,7 +25,6 @@
 
 with Atree;    use Atree;
 with Checks;   use Checks;
-with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
@@ -52,6 +51,7 @@
 with Sem_Aux;  use Sem_Aux;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Ch9;  use Sem_Ch9;
 with Sem_Ch11; use Sem_Ch11;
 with Sem_Elab; use Sem_Elab;
 with Sem_Eval; use Sem_Eval;
@@ -61,7 +61,6 @@
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
-with Table;
 with Targparm; use Targparm;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
@@ -77,37 +76,6 @@
 
    Entry_Family_Bound : constant Int := 2**16;
 
-   ------------------------------
-   -- 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");
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -142,20 +110,6 @@
    --    Decls is the list of declarations to be enhanced.
    --    Ent is the entity for the original entry body.
 
-   function Allows_Lock_Free_Implementation (N : Node_Id) return Boolean;
-   --  Given a protected body N, return True if N satisfies the following list
-   --  of lock-free restrictions:
-   --
-   --    1) Protected type
-   --         May not contain entries
-   --         May contain only scalar components
-   --         Component types must support atomic compare and exchange
-   --
-   --    2) Protected subprograms
-   --         May not have side effects
-   --         May not contain loop statements or procedure calls
-   --         Function calls and attribute references must be static
-
    function Build_Accept_Body (Astat : Node_Id) return Node_Id;
    --  Transform accept statement into a block with added exception handler.
    --  Used both for simple accept statements and for accept alternatives in
@@ -828,220 +782,6 @@
       Prepend_To (Decls, Decl);
    end Add_Object_Pointer;
 
-   -------------------------------------
-   -- Allows_Lock_Free_Implementation --
-   -------------------------------------
-
-   function Allows_Lock_Free_Implementation (N : Node_Id) return Boolean is
-      Spec       : constant Entity_Id := Corresponding_Spec (N);
-      Prot_Def   : constant Node_Id   := Protected_Definition (Parent (Spec));
-      Priv_Decls : constant List_Id   := Private_Declarations (Prot_Def);
-
-      function Satisfies_Lock_Free_Requirements
-        (Sub_Body : Node_Id) return Boolean;
-      --  Return True if protected subprogram body Sub_Body satisfies all
-      --  requirements of a lock-free implementation.
-
-      --------------------------------------
-      -- Satisfies_Lock_Free_Requirements --
-      --------------------------------------
-
-      function Satisfies_Lock_Free_Requirements
-        (Sub_Body : Node_Id) return Boolean
-      is
-         Comp : Entity_Id := Empty;
-         --  Track the current component which the body references
-
-         function Check_Node (N : Node_Id) return Traverse_Result;
-         --  Check that node N meets the lock free restrictions
-
-         ----------------
-         -- Check_Node --
-         ----------------
-
-         function Check_Node (N : Node_Id) return Traverse_Result is
-         begin
-            --  Function calls and attribute references must be static
-            --  ??? what about side-effects
-
-            if Nkind_In (N, N_Attribute_Reference, N_Function_Call)
-              and then not Is_Static_Expression (N)
-            then
-               return Abandon;
-
-            --  Loop statements and procedure calls are prohibited
-
-            elsif Nkind_In (N, N_Loop_Statement,
-                               N_Procedure_Call_Statement)
-            then
-               return Abandon;
-
-            --  References
-
-            elsif Nkind (N) = N_Identifier
-              and then Present (Entity (N))
-            then
-               declare
-                  Id     : constant Entity_Id := Entity (N);
-                  Sub_Id : constant Entity_Id := Corresponding_Spec (Sub_Body);
-
-               begin
-                  --  Prohibit references to non-constant entities outside the
-                  --  protected subprogram scope.
-
-                  if Ekind (Id) in Assignable_Kind
-                    and then not Scope_Within_Or_Same (Scope (Id), Sub_Id)
-                    and then not Scope_Within_Or_Same (Scope (Id),
-                                   Protected_Body_Subprogram (Sub_Id))
-                  then
-                     return Abandon;
-
-                  --  A protected subprogram may reference only one component
-                  --  of the protected type.
-
-                  elsif Ekind_In (Id, E_Constant, E_Variable)
-                    and then Present (Prival_Link (Id))
-                  then
-                     declare
-                        Comp_Decl : constant Node_Id :=
-                                      Parent (Prival_Link (Id));
-                     begin
-                        if Nkind (Comp_Decl) = N_Component_Declaration
-                          and then Is_List_Member (Comp_Decl)
-                          and then List_Containing (Comp_Decl) = Priv_Decls
-                        then
-                           if No (Comp) then
-                              Comp := Prival_Link (Id);
-
-                           --  Check if another protected component has already
-                           --  been accessed by the subprogram body.
-
-                           elsif Comp /= Prival_Link (Id) then
-                              return Abandon;
-                           end if;
-                        end if;
-                     end;
-                  end if;
-               end;
-            end if;
-
-            return OK;
-         end Check_Node;
-
-         function Check_All_Nodes is new Traverse_Func (Check_Node);
-
-      --  Start of processing for Satisfies_Lock_Free_Requirements
-
-      begin
-         if Check_All_Nodes (Sub_Body) = OK then
-
-            --  Establish a relation between the subprogram body and the unique
-            --  protected component it references.
-
-            if Present (Comp) then
-               Lock_Free_Subprogram_Table.Append
-                 (Lock_Free_Subprogram'(Sub_Body, Comp));
-            end if;
-
-            return True;
-         else
-            return False;
-         end if;
-      end Satisfies_Lock_Free_Requirements;
-
-      --  Local variables
-
-      Decls     : constant List_Id   := Declarations (N);
-      Vis_Decls : constant List_Id   := Visible_Declarations (Prot_Def);
-
-      Comp_Id       : Entity_Id;
-      Comp_Size     : Int;
-      Comp_Type     : Entity_Id;
-      Decl          : Node_Id;
-      Has_Component : Boolean := False;
-
-   --  Start of processing for Allows_Lock_Free_Implementation
-
-   begin
-      --  The lock-free implementation is currently enabled through a debug
-      --  flag.
-
-      if not Debug_Flag_9 then
-         return False;
-      end if;
-
-      --  Examine the visible declarations. Entries and entry families are not
-      --  allowed by the lock-free restrictions.
-
-      Decl := First (Vis_Decls);
-      while Present (Decl) loop
-         if Nkind (Decl) = N_Entry_Declaration then
-            return False;
-         end if;
-
-         Next (Decl);
-      end loop;
-
-      --  Examine the private declarations
-
-      Decl := First (Priv_Decls);
-      while Present (Decl) loop
-
-         --  The protected type must define at least one scalar component
-
-         if Nkind (Decl) = N_Component_Declaration then
-            Has_Component := True;
-
-            Comp_Id   := Defining_Identifier (Decl);
-            Comp_Type := Etype (Comp_Id);
-
-            if not Is_Scalar_Type (Comp_Type) then
-               return False;
-            end if;
-
-            Comp_Size := UI_To_Int (Esize (Base_Type (Comp_Type)));
-
-            --  Check that the size of the component is 8, 16, 32 or 64 bits
-
-            case Comp_Size is
-               when 8 | 16 | 32 | 64 =>
-                  null;
-               when others           =>
-                  return False;
-            end case;
-
-         --  Entries and entry families are not allowed
-
-         elsif Nkind (Decl) = N_Entry_Declaration then
-            return False;
-         end if;
-
-         Next (Decl);
-      end loop;
-
-      --  At least one scalar component must be present
-
-      if not Has_Component then
-         return False;
-      end if;
-
-      --  Ensure that all protected subprograms meet the restrictions of the
-      --  lock-free implementation.
-
-      Decl := First (Decls);
-      while Present (Decl) loop
-         if Nkind (Decl) = N_Subprogram_Body
-           and then not Satisfies_Lock_Free_Requirements (Decl)
-         then
-            return False;
-         end if;
-
-         Next (Decl);
-      end loop;
-
-      return True;
-   end Allows_Lock_Free_Implementation;
-
    -----------------------
    -- Build_Accept_Body --
    -----------------------
@@ -3228,7 +2968,8 @@
    --    begin
    --       loop
    --          declare
-   --             Saved_Comp   : constant ... := Atomic_Load (Comp'Address);
+   --             Saved_Comp   : constant ... :=
+   --                              Atomic_Load (Comp'Address, Relaxed);
    --             Current_Comp : ... := Saved_Comp;
    --          begin
    --             <original statements>
@@ -3496,19 +3237,33 @@
 
       if Present (Comp) then
          declare
-            Comp_Typ     : constant Entity_Id := Etype (Comp);
-            Typ_Size     : constant Int       := UI_To_Int (Esize (Comp_Typ));
+            Comp_Type    : constant Entity_Id := Etype (Comp);
             Block_Decls  : List_Id;
             Compare      : Entity_Id;
             Current_Comp : Entity_Id;
             Decl         : Node_Id;
             Label        : Node_Id;
             Load         : Entity_Id;
+            Load_Params  : List_Id;
             Saved_Comp   : Entity_Id;
             Stmt         : Node_Id;
+            Typ_Size     : Int;
             Unsigned     : Entity_Id;
 
          begin
+            --  Get the type size
+
+            if Known_Esize (Comp_Type) then
+               Typ_Size := UI_To_Int (Esize (Comp_Type));
+
+            --  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.
+
+            else
+               Typ_Size := UI_To_Int (RM_Size (Comp_Type));
+            end if;
+
             --  Retrieve all relevant atomic routines and types
 
             case Typ_Size is
@@ -3537,26 +3292,43 @@
             end case;
 
             --  Generate:
-            --    Saved_Comp : constant Comp_Typ :=
-            --                   Comp_Typ (Atomic_Load (Comp'Address));
+            --    For functions:
 
+            --       Saved_Comp : constant Comp_Type :=
+            --                      Comp_Type (Atomic_Load (Comp'Address));
+
+            --    For procedures:
+
+            --       Saved_Comp : constant Comp_Type :=
+            --                      Comp_Type (Atomic_Load (Comp'Address),
+            --                                             Relaxed);
+
             Saved_Comp :=
               Make_Defining_Identifier (Loc,
                 New_External_Name (Chars (Comp), Suffix => "_saved"));
 
+            Load_Params := New_List (
+              Make_Attribute_Reference (Loc,
+                Prefix         => New_Reference_To (Comp, Loc),
+                Attribute_Name => Name_Address));
+
+            --  For protected procedures, set the memory model to be relaxed
+
+            if Is_Procedure then
+               Append_To (Load_Params,
+                 New_Reference_To (RTE (RE_Relaxed), Loc));
+            end if;
+
             Decl :=
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Saved_Comp,
                 Constant_Present    => True,
-                Object_Definition   => New_Reference_To (Comp_Typ, Loc),
+                Object_Definition   => New_Reference_To (Comp_Type, Loc),
                 Expression          =>
-                  Unchecked_Convert_To (Comp_Typ,
+                  Unchecked_Convert_To (Comp_Type,
                     Make_Function_Call (Loc,
                       Name                   => New_Reference_To (Load, Loc),
-                      Parameter_Associations => New_List (
-                        Make_Attribute_Reference (Loc,
-                          Prefix         => New_Reference_To (Comp, Loc),
-                          Attribute_Name => Name_Address)))));
+                      Parameter_Associations => Load_Params)));
 
             --  Protected procedures
 
@@ -3564,7 +3336,7 @@
                Block_Decls := New_List (Decl);
 
                --  Generate:
-               --    Current_Comp : Comp_Typ := Saved_Comp;
+               --    Current_Comp : Comp_Type := Saved_Comp;
 
                Current_Comp :=
                  Make_Defining_Identifier (Loc,
@@ -3573,7 +3345,7 @@
                Append_To (Block_Decls,
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Current_Comp,
-                   Object_Definition   => New_Reference_To (Comp_Typ, Loc),
+                   Object_Definition   => New_Reference_To (Comp_Type, Loc),
                    Expression          => New_Reference_To (Saved_Comp, Loc)));
 
             --  Protected function
@@ -3645,6 +3417,9 @@
 
             if Is_Procedure then
                Stmts := New_List (
+                Make_Procedure_Call_Statement (Loc,
+                    Name =>
+                      New_Reference_To (RTE (RE_Atomic_Synchronize), Loc)),
                  Make_Loop_Statement (Loc,
                    Statements => New_List (
                      Make_Block_Statement (Loc,
@@ -8423,7 +8198,7 @@
       Loc          : constant Source_Ptr := Sloc (N);
       Pid          : constant Entity_Id  := Corresponding_Spec (N);
 
-      Lock_Free_On : constant Boolean := Allows_Lock_Free_Implementation (N);
+      Lock_Free_Active : constant Boolean := Uses_Lock_Free (Pid);
       --  This flag indicates whether the lock free implementation is active
 
       Current_Node : Node_Id;
@@ -8554,7 +8329,7 @@
                if not Is_Eliminated (Defining_Entity (Op_Body))
                  and then not Is_Eliminated (Corresponding_Spec (Op_Body))
                then
-                  if Lock_Free_On then
+                  if Lock_Free_Active then
                      New_Op_Body :=
                        Build_Lock_Free_Unprotected_Subprogram_Body
                          (Op_Body, Pid);
@@ -8581,7 +8356,7 @@
                   --  declaration in the protected body itself.
 
                   if Present (Corresponding_Spec (Op_Body)) then
-                     if Lock_Free_On then
+                     if Lock_Free_Active then
                         New_Op_Body :=
                           Build_Lock_Free_Protected_Subprogram_Body
                             (Op_Body, Pid, Specification (New_Op_Body));
@@ -8765,10 +8540,13 @@
    --  the specs refer to this type.
 
    procedure Expand_N_Protected_Type_Declaration (N : Node_Id) is
-      Loc      : constant Source_Ptr := Sloc (N);
-      Prot_Typ : constant Entity_Id  := Defining_Identifier (N);
+      Loc              : constant Source_Ptr := Sloc (N);
+      Prot_Typ         : constant Entity_Id  := Defining_Identifier (N);
 
-      Pdef : constant Node_Id := Protected_Definition (N);
+      Lock_Free_Active : constant Boolean := Uses_Lock_Free (Prot_Typ);
+      --  This flag indicates whether the lock free implementation is active
+
+      Pdef             : constant Node_Id := Protected_Definition (N);
       --  This contains two lists; one for visible and one for private decls
 
       Rec_Decl     : Node_Id;
@@ -8926,108 +8704,6 @@
 
       Collect_Entry_Families (Loc, Cdecls, Current_Node, Prot_Typ);
 
-      --  Prepend the _Object field with the right type to the component list.
-      --  We need to compute the number of entries, and in some cases the
-      --  number of Attach_Handler pragmas.
-
-      declare
-         Ritem              : Node_Id;
-         Num_Attach_Handler : Int := 0;
-         Protection_Subtype : Node_Id;
-         Entry_Count_Expr   : constant Node_Id :=
-                                Build_Entry_Count_Expression
-                                  (Prot_Typ, Cdecls, Loc);
-
-      begin
-         --  Could this be simplified using Corresponding_Runtime_Package???
-
-         if Has_Attach_Handler (Prot_Typ) then
-            Ritem := First_Rep_Item (Prot_Typ);
-            while Present (Ritem) loop
-               if Nkind (Ritem) = N_Pragma
-                 and then Pragma_Name (Ritem) = Name_Attach_Handler
-               then
-                  Num_Attach_Handler := Num_Attach_Handler + 1;
-               end if;
-
-               Next_Rep_Item (Ritem);
-            end loop;
-
-            if Restricted_Profile then
-               if Has_Entries (Prot_Typ) then
-                  Protection_Subtype :=
-                    New_Reference_To (RTE (RE_Protection_Entry), Loc);
-               else
-                  Protection_Subtype :=
-                    New_Reference_To (RTE (RE_Protection), Loc);
-               end if;
-            else
-               Protection_Subtype :=
-                 Make_Subtype_Indication
-                   (Sloc => Loc,
-                    Subtype_Mark =>
-                      New_Reference_To
-                        (RTE (RE_Static_Interrupt_Protection), Loc),
-                    Constraint =>
-                      Make_Index_Or_Discriminant_Constraint (
-                        Sloc => Loc,
-                        Constraints => New_List (
-                          Entry_Count_Expr,
-                          Make_Integer_Literal (Loc, Num_Attach_Handler))));
-            end if;
-
-         elsif Has_Interrupt_Handler (Prot_Typ)
-           and then not Restriction_Active (No_Dynamic_Attachment)
-         then
-            Protection_Subtype :=
-               Make_Subtype_Indication (
-                 Sloc => Loc,
-                 Subtype_Mark => New_Reference_To
-                   (RTE (RE_Dynamic_Interrupt_Protection), Loc),
-                 Constraint =>
-                   Make_Index_Or_Discriminant_Constraint (
-                     Sloc => Loc,
-                     Constraints => New_List (Entry_Count_Expr)));
-
-         --  Type has explicit entries or generated primitive entry wrappers
-
-         elsif Has_Entries (Prot_Typ)
-           or else (Ada_Version >= Ada_2005
-                      and then Present (Interface_List (N)))
-         then
-            case Corresponding_Runtime_Package (Prot_Typ) is
-               when System_Tasking_Protected_Objects_Entries =>
-                  Protection_Subtype :=
-                     Make_Subtype_Indication (Loc,
-                       Subtype_Mark =>
-                         New_Reference_To (RTE (RE_Protection_Entries), Loc),
-                       Constraint =>
-                         Make_Index_Or_Discriminant_Constraint (
-                           Sloc => Loc,
-                           Constraints => New_List (Entry_Count_Expr)));
-
-               when System_Tasking_Protected_Objects_Single_Entry =>
-                  Protection_Subtype :=
-                    New_Reference_To (RTE (RE_Protection_Entry), Loc);
-
-               when others =>
-                  raise Program_Error;
-            end case;
-
-         else
-            Protection_Subtype := New_Reference_To (RTE (RE_Protection), Loc);
-         end if;
-
-         Object_Comp :=
-           Make_Component_Declaration (Loc,
-             Defining_Identifier =>
-               Make_Defining_Identifier (Loc, Name_uObject),
-             Component_Definition =>
-               Make_Component_Definition (Loc,
-                 Aliased_Present    => True,
-                 Subtype_Indication => Protection_Subtype));
-      end;
-
       pragma Assert (Present (Pdef));
 
       --  Add private field components
@@ -9144,11 +8820,118 @@
          end loop;
       end if;
 
-      --  Put the _Object component after the private component so that it
-      --  be finalized early as required by 9.4 (20)
+      --  Except for the lock-free implementation, prepend the _Object field
+      --  with the right type to the component list. We need to compute the
+      --  number of entries, and in some cases the number of Attach_Handler
+      --  pragmas.
 
-      Append_To (Cdecls, Object_Comp);
+      if not Lock_Free_Active then
+         declare
+            Ritem              : Node_Id;
+            Num_Attach_Handler : Int := 0;
+            Protection_Subtype : Node_Id;
+            Entry_Count_Expr   : constant Node_Id :=
+                                   Build_Entry_Count_Expression
+                                     (Prot_Typ, Cdecls, Loc);
 
+         begin
+            --  Could this be simplified using Corresponding_Runtime_Package???
+
+            if Has_Attach_Handler (Prot_Typ) then
+               Ritem := First_Rep_Item (Prot_Typ);
+               while Present (Ritem) loop
+                  if Nkind (Ritem) = N_Pragma
+                    and then Pragma_Name (Ritem) = Name_Attach_Handler
+                  then
+                     Num_Attach_Handler := Num_Attach_Handler + 1;
+                  end if;
+
+                  Next_Rep_Item (Ritem);
+               end loop;
+
+               if Restricted_Profile then
+                  if Has_Entries (Prot_Typ) then
+                     Protection_Subtype :=
+                       New_Reference_To (RTE (RE_Protection_Entry), Loc);
+                  else
+                     Protection_Subtype :=
+                       New_Reference_To (RTE (RE_Protection), Loc);
+                  end if;
+               else
+                  Protection_Subtype :=
+                    Make_Subtype_Indication
+                      (Sloc => Loc,
+                       Subtype_Mark =>
+                         New_Reference_To
+                           (RTE (RE_Static_Interrupt_Protection), Loc),
+                       Constraint =>
+                         Make_Index_Or_Discriminant_Constraint (
+                           Sloc => Loc,
+                           Constraints => New_List (
+                             Entry_Count_Expr,
+                             Make_Integer_Literal (Loc, Num_Attach_Handler))));
+               end if;
+
+            elsif Has_Interrupt_Handler (Prot_Typ)
+              and then not Restriction_Active (No_Dynamic_Attachment)
+            then
+               Protection_Subtype :=
+                  Make_Subtype_Indication (
+                    Sloc => Loc,
+                    Subtype_Mark => New_Reference_To
+                      (RTE (RE_Dynamic_Interrupt_Protection), Loc),
+                    Constraint =>
+                      Make_Index_Or_Discriminant_Constraint (
+                        Sloc => Loc,
+                        Constraints => New_List (Entry_Count_Expr)));
+
+            --  Type has explicit entries or generated primitive entry wrappers
+
+            elsif Has_Entries (Prot_Typ)
+              or else (Ada_Version >= Ada_2005
+                         and then Present (Interface_List (N)))
+            then
+               case Corresponding_Runtime_Package (Prot_Typ) is
+                  when System_Tasking_Protected_Objects_Entries =>
+                     Protection_Subtype :=
+                        Make_Subtype_Indication (Loc,
+                          Subtype_Mark =>
+                            New_Reference_To (RTE (RE_Protection_Entries),
+                              Loc),
+                          Constraint =>
+                            Make_Index_Or_Discriminant_Constraint (
+                              Sloc => Loc,
+                              Constraints => New_List (Entry_Count_Expr)));
+
+                  when System_Tasking_Protected_Objects_Single_Entry =>
+                     Protection_Subtype :=
+                       New_Reference_To (RTE (RE_Protection_Entry), Loc);
+
+                  when others =>
+                     raise Program_Error;
+               end case;
+
+            else
+               Protection_Subtype :=
+                 New_Reference_To (RTE (RE_Protection), Loc);
+            end if;
+
+            Object_Comp :=
+              Make_Component_Declaration (Loc,
+                Defining_Identifier =>
+                  Make_Defining_Identifier (Loc, Name_uObject),
+                Component_Definition =>
+                  Make_Component_Definition (Loc,
+                    Aliased_Present    => True,
+                    Subtype_Indication => Protection_Subtype));
+         end;
+
+         --  Put the _Object component after the private component so that it
+         --  be finalized early as required by 9.4 (20)
+
+         Append_To (Cdecls, Object_Comp);
+      end if;
+
       Insert_After (Current_Node, Rec_Decl);
       Current_Node := Rec_Decl;
 
@@ -13149,9 +12932,12 @@
       end if;
 
       --  Step 2: Create the Protection object and build its declaration for
-      --  any protected entry (family) of subprogram.
+      --  any protected entry (family) of subprogram. Note for the lock-free
+      --  implementation, the Protection object is not needed anymore.
 
-      if Is_Protected then
+      if Is_Protected
+        and then not Uses_Lock_Free (Conc_Typ)
+      then
          declare
             Prot_Ent : constant Entity_Id := Make_Temporary (Loc, 'R');
             Prot_Typ : RE_Id;
@@ -13612,191 +13398,200 @@
 
       Args := New_List;
 
-      --  Object parameter. This is a pointer to the object of type
-      --  Protection used by the GNARL to control the protected object.
+      --  For lock-free implementation, skip initializations of the Protection
+      --  object.
 
-      Append_To (Args,
-        Make_Attribute_Reference (Loc,
-          Prefix =>
-            Make_Selected_Component (Loc,
-              Prefix        => Make_Identifier (Loc, Name_uInit),
-              Selector_Name => Make_Identifier (Loc, Name_uObject)),
-          Attribute_Name => Name_Unchecked_Access));
+      if not Uses_Lock_Free (Defining_Identifier (Pdec)) then
+         --  Object parameter. This is a pointer to the object of type
+         --  Protection used by the GNARL to control the protected object.
 
-      --  Priority parameter. Set to Unspecified_Priority unless there is a
-      --  priority pragma, in which case we take the value from the pragma,
-      --  or there is an interrupt pragma and no priority pragma, and we
-      --  set the ceiling to Interrupt_Priority'Last, an implementation-
-      --  defined value, see D.3(10).
+         Append_To (Args,
+           Make_Attribute_Reference (Loc,
+             Prefix =>
+               Make_Selected_Component (Loc,
+                 Prefix        => Make_Identifier (Loc, Name_uInit),
+                 Selector_Name => Make_Identifier (Loc, Name_uObject)),
+             Attribute_Name => Name_Unchecked_Access));
 
-      if Present (Pdef)
-        and then Has_Pragma_Priority (Pdef)
-      then
-         declare
-            Prio : constant Node_Id :=
-                     Expression
-                       (First
-                          (Pragma_Argument_Associations
-                             (Find_Task_Or_Protected_Pragma
-                                (Pdef, Name_Priority))));
-            Temp : Entity_Id;
+         --  Priority parameter. Set to Unspecified_Priority unless there is a
+         --  priority pragma, in which case we take the value from the pragma,
+         --  or there is an interrupt pragma and no priority pragma, and we
+         --  set the ceiling to Interrupt_Priority'Last, an implementation-
+         --  defined value, see D.3(10).
 
-         begin
-            --  If priority is a static expression, then we can duplicate it
-            --  with no problem and simply append it to the argument list.
+         if Present (Pdef)
+           and then Has_Pragma_Priority (Pdef)
+         then
+            declare
+               Prio : constant Node_Id :=
+                        Expression
+                          (First
+                             (Pragma_Argument_Associations
+                                (Find_Task_Or_Protected_Pragma
+                                   (Pdef, Name_Priority))));
+               Temp : Entity_Id;
 
-            if Is_Static_Expression (Prio) then
-               Append_To (Args,
-                          Duplicate_Subexpr_No_Checks (Prio));
+            begin
+               --  If priority is a static expression, then we can duplicate it
+               --  with no problem and simply append it to the argument list.
 
-            --  Otherwise, the priority may be a per-object expression, if it
-            --  depends on a discriminant of the type. In this case, create
-            --  local variable to capture the expression. Note that it is
-            --  really necessary to create this variable explicitly. It might
-            --  be thought that removing side effects would the appropriate
-            --  approach, but that could generate declarations improperly
-            --  placed in the enclosing scope.
+               if Is_Static_Expression (Prio) then
+                  Append_To (Args,
+                    Duplicate_Subexpr_No_Checks (Prio));
 
-            --  Note: Use System.Any_Priority as the expected type for the
-            --  non-static priority expression, in case the expression has not
-            --  been analyzed yet (as occurs for example with pragma
-            --  Interrupt_Priority).
+               --  Otherwise, the priority may be a per-object expression, if
+               --  it depends on a discriminant of the type. In this case,
+               --  create local variable to capture the expression. Note that
+               --  it is really necessary to create this variable explicitly.
+               --  It might be thought that removing side effects would the
+               --  appropriate approach, but that could generate declarations
+               --  improperly placed in the enclosing scope.
 
-            else
-               Temp := Make_Temporary (Loc, 'R', Prio);
-               Append_To (L,
-                  Make_Object_Declaration (Loc,
-                     Defining_Identifier => Temp,
-                     Object_Definition   =>
-                       New_Occurrence_Of (RTE (RE_Any_Priority), Loc),
-                     Expression          => Relocate_Node (Prio)));
+               --  Note: Use System.Any_Priority as the expected type for the
+               --  non-static priority expression, in case the expression has
+               --  not been analyzed yet (as occurs for example with pragma
+               --  Interrupt_Priority).
 
-               Append_To (Args, New_Occurrence_Of (Temp, Loc));
-            end if;
-         end;
+               else
+                  Temp := Make_Temporary (Loc, 'R', Prio);
+                  Append_To (L,
+                     Make_Object_Declaration (Loc,
+                        Defining_Identifier => Temp,
+                        Object_Definition   =>
+                          New_Occurrence_Of (RTE (RE_Any_Priority), Loc),
+                        Expression          => Relocate_Node (Prio)));
 
-      --  When no priority is specified but an xx_Handler pragma is, we default
-      --  to System.Interrupts.Default_Interrupt_Priority, see D.3(10).
+                  Append_To (Args, New_Occurrence_Of (Temp, Loc));
+               end if;
+            end;
 
-      elsif Has_Attach_Handler (Ptyp)
-        or else Has_Interrupt_Handler (Ptyp)
-      then
-         Append_To (Args,
-           New_Reference_To (RTE (RE_Default_Interrupt_Priority), Loc));
+         --  When no priority is specified but an xx_Handler pragma is, we
+         --  default to System.Interrupts.Default_Interrupt_Priority, see
+         --  D.3(10).
 
-      --  Normal case, no priority or xx_Handler specified, default priority
+         elsif Has_Attach_Handler (Ptyp)
+           or else Has_Interrupt_Handler (Ptyp)
+         then
+            Append_To (Args,
+              New_Reference_To (RTE (RE_Default_Interrupt_Priority), Loc));
 
-      else
-         Append_To (Args,
-           New_Reference_To (RTE (RE_Unspecified_Priority), Loc));
-      end if;
+         --  Normal case, no priority or xx_Handler specified, default priority
 
-      --  Test for Compiler_Info parameter. This parameter allows entry body
-      --  procedures and barrier functions to be called from the runtime. It
-      --  is a pointer to the record generated by the compiler to represent
-      --  the protected object.
+         else
+            Append_To (Args,
+              New_Reference_To (RTE (RE_Unspecified_Priority), Loc));
+         end if;
 
-      --  A protected type without entries that covers an interface and
-      --  overrides the abstract routines with protected procedures is
-      --  considered equivalent to a protected type with entries in the
-      --  context of dispatching select statements.
+         --  Test for Compiler_Info parameter. This parameter allows entry body
+         --  procedures and barrier functions to be called from the runtime. It
+         --  is a pointer to the record generated by the compiler to represent
+         --  the protected object.
 
-      if Has_Entry
-        or else Has_Interfaces (Protect_Rec)
-        or else
-          ((Has_Attach_Handler (Ptyp) or else Has_Interrupt_Handler (Ptyp))
-             and then not Restriction_Active (No_Dynamic_Attachment))
-      then
-         declare
-            Pkg_Id : constant RTU_Id  := Corresponding_Runtime_Package (Ptyp);
+         --  A protected type without entries that covers an interface and
+         --  overrides the abstract routines with protected procedures is
+         --  considered equivalent to a protected type with entries in the
+         --  context of dispatching select statements.
 
-            Called_Subp : RE_Id;
+         if Has_Entry
+           or else Has_Interfaces (Protect_Rec)
+           or else
+             ((Has_Attach_Handler (Ptyp) or else Has_Interrupt_Handler (Ptyp))
+                and then not Restriction_Active (No_Dynamic_Attachment))
+         then
+            declare
+               Pkg_Id : constant RTU_Id  :=
+                          Corresponding_Runtime_Package (Ptyp);
 
-         begin
-            case Pkg_Id is
-               when System_Tasking_Protected_Objects_Entries =>
-                  Called_Subp := RE_Initialize_Protection_Entries;
+               Called_Subp : RE_Id;
 
-               when System_Tasking_Protected_Objects =>
-                  Called_Subp := RE_Initialize_Protection;
+            begin
+               case Pkg_Id is
+                  when System_Tasking_Protected_Objects_Entries =>
+                     Called_Subp := RE_Initialize_Protection_Entries;
 
-               when System_Tasking_Protected_Objects_Single_Entry =>
-                  Called_Subp := RE_Initialize_Protection_Entry;
+                  when System_Tasking_Protected_Objects =>
+                     Called_Subp := RE_Initialize_Protection;
 
-               when others =>
-                  raise Program_Error;
-            end case;
+                  when System_Tasking_Protected_Objects_Single_Entry =>
+                     Called_Subp := RE_Initialize_Protection_Entry;
 
-            if Has_Entry
-              or else not Restricted
-              or else Has_Interfaces (Protect_Rec)
-            then
-               Append_To (Args,
-                 Make_Attribute_Reference (Loc,
-                   Prefix         => Make_Identifier (Loc, Name_uInit),
-                   Attribute_Name => Name_Address));
-            end if;
+                  when others =>
+                     raise Program_Error;
+               end case;
 
-            --  Entry_Bodies parameter. This is a pointer to an array of
-            --  pointers to the entry body procedures and barrier functions of
-            --  the object. If the protected type has no entries this object
-            --  will not exist, in this case, pass a null.
+               if Has_Entry
+                 or else not Restricted
+                 or else Has_Interfaces (Protect_Rec)
+               then
+                  Append_To (Args,
+                    Make_Attribute_Reference (Loc,
+                      Prefix         => Make_Identifier (Loc, Name_uInit),
+                      Attribute_Name => Name_Address));
+               end if;
 
-            if Has_Entry then
-               P_Arr := Entry_Bodies_Array (Ptyp);
+               --  Entry_Bodies parameter. This is a pointer to an array of
+               --  pointers to the entry body procedures and barrier functions
+               --  of the object. If the protected type has no entries this
+               --  object will not exist, in this case, pass a null.
 
-               Append_To (Args,
-                 Make_Attribute_Reference (Loc,
-                   Prefix => New_Reference_To (P_Arr, Loc),
-                   Attribute_Name => Name_Unrestricted_Access));
+               if Has_Entry then
+                  P_Arr := Entry_Bodies_Array (Ptyp);
 
-               if Pkg_Id = System_Tasking_Protected_Objects_Entries then
-
-                  --  Find index mapping function (clumsy but ok for now)
-
-                  while Ekind (P_Arr) /= E_Function loop
-                     Next_Entity (P_Arr);
-                  end loop;
-
                   Append_To (Args,
                     Make_Attribute_Reference (Loc,
-                      Prefix         => New_Reference_To (P_Arr, Loc),
+                      Prefix => New_Reference_To (P_Arr, Loc),
                       Attribute_Name => Name_Unrestricted_Access));
 
-                  --  Build_Entry_Names generation flag. When set to true, the
-                  --  runtime will allocate an array to hold the string names
-                  --  of protected entries.
+                  if Pkg_Id = System_Tasking_Protected_Objects_Entries then
 
-                  if not Restricted_Profile then
-                     if Entry_Names_OK then
-                        Append_To (Args,
-                          New_Reference_To (Standard_True, Loc));
-                     else
-                        Append_To (Args,
-                          New_Reference_To (Standard_False, Loc));
+                     --  Find index mapping function (clumsy but ok for now)
+
+                     while Ekind (P_Arr) /= E_Function loop
+                        Next_Entity (P_Arr);
+                     end loop;
+
+                     Append_To (Args,
+                       Make_Attribute_Reference (Loc,
+                         Prefix         => New_Reference_To (P_Arr, Loc),
+                         Attribute_Name => Name_Unrestricted_Access));
+
+                     --  Build_Entry_Names generation flag. When set to true,
+                     --  the runtime will allocate an array to hold the string
+                     --  names of protected entries.
+
+                     if not Restricted_Profile then
+                        if Entry_Names_OK then
+                           Append_To (Args,
+                             New_Reference_To (Standard_True, Loc));
+                        else
+                           Append_To (Args,
+                             New_Reference_To (Standard_False, Loc));
+                        end if;
                      end if;
                   end if;
-               end if;
 
-            elsif Pkg_Id = System_Tasking_Protected_Objects_Single_Entry then
-               Append_To (Args, Make_Null (Loc));
+               elsif Pkg_Id =
+                       System_Tasking_Protected_Objects_Single_Entry
+               then
+                  Append_To (Args, Make_Null (Loc));
 
-            elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then
-               Append_To (Args, Make_Null (Loc));
-               Append_To (Args, Make_Null (Loc));
-               Append_To (Args, New_Reference_To (Standard_False, Loc));
-            end if;
+               elsif Pkg_Id = System_Tasking_Protected_Objects_Entries then
+                  Append_To (Args, Make_Null (Loc));
+                  Append_To (Args, Make_Null (Loc));
+                  Append_To (Args, New_Reference_To (Standard_False, Loc));
+               end if;
 
+               Append_To (L,
+                 Make_Procedure_Call_Statement (Loc,
+                   Name => New_Reference_To (RTE (Called_Subp), Loc),
+                   Parameter_Associations => Args));
+            end;
+         else
             Append_To (L,
               Make_Procedure_Call_Statement (Loc,
-                Name => New_Reference_To (RTE (Called_Subp), Loc),
+                Name => New_Reference_To (RTE (RE_Initialize_Protection), Loc),
                 Parameter_Associations => Args));
-         end;
-      else
-         Append_To (L,
-           Make_Procedure_Call_Statement (Loc,
-             Name => New_Reference_To (RTE (RE_Initialize_Protection), Loc),
-             Parameter_Associations => Args));
+         end if;
       end if;
 
       if Has_Attach_Handler (Ptyp) then
@@ -13868,15 +13663,18 @@
                    Parameter_Associations => Args));
 
             else
-               --  First, prepends the _object argument
+               if not Uses_Lock_Free (Defining_Identifier (Pdec)) then
+                  --  First, prepends the _object argument
 
-               Prepend_To (Args,
-                 Make_Attribute_Reference (Loc,
-                   Prefix =>
-                     Make_Selected_Component (Loc,
-                       Prefix        => Make_Identifier (Loc, Name_uInit),
-                       Selector_Name => Make_Identifier (Loc, Name_uObject)),
-                   Attribute_Name => Name_Unchecked_Access));
+                  Prepend_To (Args,
+                    Make_Attribute_Reference (Loc,
+                      Prefix =>
+                        Make_Selected_Component (Loc,
+                          Prefix        => Make_Identifier (Loc, Name_uInit),
+                          Selector_Name =>
+                            Make_Identifier (Loc, Name_uObject)),
+                      Attribute_Name => Name_Unchecked_Access));
+               end if;
 
                --  Then, insert call to Install_Handlers
 
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb	(revision 187501)
+++ sem_ch9.adb	(working copy)
@@ -23,13 +23,16 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
+with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Exp_Ch9;  use Exp_Ch9;
 with Elists;   use Elists;
 with Freeze;   use Freeze;
+with Layout;   use Layout;
 with Lib.Xref; use Lib.Xref;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
@@ -64,6 +67,29 @@
    -- Local Subprograms --
    -----------------------
 
+   function Allows_Lock_Free_Implementation
+     (N        : Node_Id;
+      Complain : Boolean := False) return Boolean;
+   --  This dispatch routine return True if N satisfies the following list of
+   --  lock-free restrictions for protected type declaration and protected
+   --  body:
+   --
+   --    1) Protected type declaration
+   --         May not contain entries
+   --         Component types must support atomic compare and exchange
+   --
+   --    2) Protected Body
+   --         Each protected subprogram body within N must satisfy:
+   --            May reference only one protected component
+   --            May not reference non-constant entities outside the protected
+   --              subprogram scope.
+   --            May not reference non-scalar out parameters
+   --            May not contain loop statements or procedure calls
+   --            Function calls and attribute references must be static
+   --
+   --  If Complain is set to True, an error message is issued when return
+   --  False.
+
    procedure Check_Max_Entries (D : Node_Id; R : All_Parameter_Restrictions);
    --  Given either a protected definition or a task definition in D, check
    --  the corresponding restriction parameter identifier R, and if it is set,
@@ -91,6 +117,304 @@
    --  Utility to make visible in corresponding body the entities defined in
    --  task, protected type declaration, or entry declaration.
 
+   -------------------------------------
+   -- Allows_Lock_Free_Implementation --
+   -------------------------------------
+
+   function Allows_Lock_Free_Implementation
+     (N        : Node_Id;
+      Complain : Boolean := False) return Boolean
+   is
+   begin
+      pragma Assert (Nkind_In (N,
+                               N_Protected_Type_Declaration,
+                               N_Protected_Body));
+
+      --  The lock-free implementation is currently enabled through a debug
+      --  flag. When Complain is True, an aspect Lock_Free forces the lock-free
+      --  implementation. In that case, the debug flag is not needed.
+
+      if not Complain
+        and then not Debug_Flag_9
+      then
+         return False;
+      end if;
+
+      --  Protected type declaration case
+
+      if Nkind (N) = N_Protected_Type_Declaration then
+         declare
+            Pdef       : constant Node_Id := Protected_Definition (N);
+            Priv_Decls : constant List_Id := Private_Declarations (Pdef);
+            Vis_Decls  : constant List_Id := Visible_Declarations (Pdef);
+
+            Comp_Id    : Entity_Id;
+            Comp_Size  : Int;
+            Comp_Type  : Entity_Id;
+            Decl       : Node_Id;
+
+         begin
+            --  Examine the visible declarations. Entries and entry families
+            --  are not allowed by the lock-free restrictions.
+
+            Decl := First (Vis_Decls);
+            while Present (Decl) loop
+               if Nkind (Decl) = N_Entry_Declaration then
+                  if Complain then
+                     Error_Msg_N ("entry not allowed for lock-free " &
+                                  "implementation",
+                                  Decl);
+                  end if;
+
+                  return False;
+               end if;
+
+               Next (Decl);
+            end loop;
+
+            --  Examine the private declarations
+
+            Decl := First (Priv_Decls);
+            while Present (Decl) loop
+
+               --  The protected type must define at least one scalar component
+
+               if Nkind (Decl) = N_Component_Declaration then
+                  Comp_Id       := Defining_Identifier (Decl);
+                  Comp_Type     := Etype (Comp_Id);
+
+                  --  Make sure the protected component type has size and
+                  --  alignment fields set at this point whenever this is
+                  --  possible.
+
+                  Layout_Type (Comp_Type);
+
+                  if Known_Esize (Comp_Type) then
+                     Comp_Size := UI_To_Int (Esize (Comp_Type));
+
+                  --  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.
+
+                  else
+                     Comp_Size := UI_To_Int (RM_Size (Comp_Type));
+                  end if;
+
+                  --  Check that the size of the component is 8, 16, 32 or 64
+                  --  bits.
+
+                  case Comp_Size is
+                     when 8 | 16 | 32 | 64 =>
+                        null;
+                     when others           =>
+                        if Complain then
+                           Error_Msg_N ("must support atomic operations for " &
+                                        "lock-free implementation",
+                                         Decl);
+                        end if;
+
+                        return False;
+                  end case;
+
+               --  Entries and entry families are not allowed
+
+               elsif Nkind (Decl) = N_Entry_Declaration then
+                  if Complain then
+                     Error_Msg_N ("entry not allowed for lock-free " &
+                                  "implementation",
+                                  Decl);
+                  end if;
+
+                  return False;
+               end if;
+
+               Next (Decl);
+            end loop;
+         end;
+
+      --  Protected body case
+
+      else
+         declare
+            Decls         : constant List_Id   := Declarations (N);
+            Pid           : constant Entity_Id := Corresponding_Spec (N);
+            Prot_Typ_Decl : constant Node_Id   := Parent (Pid);
+            Prot_Def      : constant Node_Id   :=
+                              Protected_Definition (Prot_Typ_Decl);
+            Priv_Decls    : constant List_Id   :=
+                              Private_Declarations (Prot_Def);
+            Decl          : Node_Id;
+
+            function Satisfies_Lock_Free_Requirements
+              (Sub_Body : Node_Id) return Boolean;
+            --  Return True if protected subprogram body Sub_Body satisfies all
+            --  requirements of a lock-free implementation.
+
+            --------------------------------------
+            -- Satisfies_Lock_Free_Requirements --
+            --------------------------------------
+
+            function Satisfies_Lock_Free_Requirements
+              (Sub_Body : Node_Id) return Boolean
+            is
+               Comp : Entity_Id := Empty;
+               --  Track the current component which the body references
+
+               function Check_Node (N : Node_Id) return Traverse_Result;
+               --  Check that node N meets the lock free restrictions
+
+               ----------------
+               -- Check_Node --
+               ----------------
+
+               function Check_Node (N : Node_Id) return Traverse_Result is
+               begin
+                  --  Function calls and attribute references must be static
+
+                  if Nkind_In (N, N_Attribute_Reference, N_Function_Call)
+                    and then not Is_Static_Expression (N)
+                  then
+                     return Abandon;
+
+                  --  Loop statements and procedure calls are prohibited
+
+                  elsif Nkind_In (N, N_Loop_Statement,
+                                     N_Procedure_Call_Statement)
+                  then
+                     return Abandon;
+
+                  --  References
+
+                  elsif Nkind (N) = N_Identifier
+                    and then Present (Entity (N))
+                  then
+                     declare
+                        Id     : constant Entity_Id := Entity (N);
+                        Sub_Id : constant Entity_Id :=
+                                   Corresponding_Spec (Sub_Body);
+
+                     begin
+                        --  Prohibit references to non-constant entities
+                        --  outside the protected subprogram scope.
+
+                        if Ekind (Id) in Assignable_Kind
+                          and then not Scope_Within_Or_Same (Scope (Id),
+                                         Sub_Id)
+                          and then not Scope_Within_Or_Same (Scope (Id),
+                                         Protected_Body_Subprogram (Sub_Id))
+                        then
+                           return Abandon;
+
+                        --  Prohibit non-scalar out parameters (scalar
+                        --  parameters are passed by copy).
+
+                        elsif Ekind_In (Id, E_Out_Parameter,
+                                            E_In_Out_Parameter)
+                          and then not Is_Scalar_Type (Etype (Id))
+                          and then Scope_Within_Or_Same (Scope (Id), Sub_Id)
+                        then
+                           return Abandon;
+
+                        --  A protected subprogram may reference only one
+                        --  component of the protected type.
+
+                        elsif Ekind (Id) = E_Component then
+                           declare
+                              Comp_Decl : constant Node_Id := Parent (Id);
+                           begin
+                              if Nkind (Comp_Decl) = N_Component_Declaration
+                                and then Is_List_Member (Comp_Decl)
+                                and then List_Containing (Comp_Decl) =
+                                           Priv_Decls
+                              then
+                                 if No (Comp) then
+                                    Comp := Id;
+
+                                 --  Check if another protected component has
+                                 --  already been accessed by the subprogram
+                                 --  body.
+
+                                 elsif Comp /= Id then
+                                    return Abandon;
+                                 end if;
+                              end if;
+                           end;
+
+                        elsif Ekind_In (Id, E_Constant, E_Variable)
+                          and then Present (Prival_Link (Id))
+                        then
+                           declare
+                              Comp_Decl : constant Node_Id :=
+                                            Parent (Prival_Link (Id));
+                           begin
+                              if Nkind (Comp_Decl) = N_Component_Declaration
+                                and then Is_List_Member (Comp_Decl)
+                                and then List_Containing (Comp_Decl) =
+                                           Priv_Decls
+                              then
+                                 if No (Comp) then
+                                    Comp := Prival_Link (Id);
+
+                                 --  Check if another protected component has
+                                 --  already been accessed by the subprogram
+                                 --  body.
+
+                                 elsif Comp /= Prival_Link (Id) then
+                                    return Abandon;
+                                 end if;
+                              end if;
+                           end;
+                        end if;
+                     end;
+                  end if;
+
+                  return OK;
+               end Check_Node;
+
+               function Check_All_Nodes is new Traverse_Func (Check_Node);
+
+            --  Start of processing for Satisfies_Lock_Free_Requirements
+
+            begin
+               if Check_All_Nodes (Sub_Body) = OK then
+
+                  --  Establish a relation between the subprogram body and the
+                  --  unique protected component it references.
+
+                  if Present (Comp) then
+                     Lock_Free_Subprogram_Table.Append
+                       (Lock_Free_Subprogram'(Sub_Body, Comp));
+                  end if;
+
+                  return True;
+               else
+                  return False;
+               end if;
+            end Satisfies_Lock_Free_Requirements;
+
+         begin
+            Decl := First (Decls);
+
+            while Present (Decl) loop
+               if Nkind (Decl) = N_Subprogram_Body
+                 and then not Satisfies_Lock_Free_Requirements (Decl)
+               then
+                  if Complain then
+                     Error_Msg_N ("body prevents lock-free implementation",
+                                  Decl);
+                  end if;
+
+                  return False;
+               end if;
+
+               Next (Decl);
+            end loop;
+         end;
+      end if;
+
+      return True;
+   end Allows_Lock_Free_Implementation;
+
    -----------------------------
    -- Analyze_Abort_Statement --
    -----------------------------
@@ -1057,6 +1381,7 @@
 
    procedure Analyze_Protected_Body (N : Node_Id) is
       Body_Id : constant Entity_Id := Defining_Identifier (N);
+      Aspect  : Node_Id;
       Last_E  : Entity_Id;
 
       Spec_Id : Entity_Id;
@@ -1130,6 +1455,42 @@
       Check_References (Spec_Id);
       Process_End_Label (N, 't', Ref_Id);
       End_Scope;
+
+      --  Turn on/off the lock-free implementation for the protected object
+
+      --  Look for a Lock_Free aspect with a False expression that disables the
+      --  lock-free implementation.
+
+      Aspect := First (Aspect_Specifications (Parent (Spec_Id)));
+
+      while Present (Aspect) loop
+         if Get_Aspect_Id (Chars (Identifier (Aspect))) = Aspect_Lock_Free
+           and then Present (Expression (Aspect))
+           and then Entity (Expression (Aspect)) = Standard_False
+         then
+            return;
+         end if;
+
+         Next (Aspect);
+      end loop;
+
+      --  When a Lock_Free aspect forces the lock-free implementation, verify
+      --  the protected body meets all the restrictions, otherwise
+      --  Allows_Lock_Free_Implementation issues an error message.
+
+      if Uses_Lock_Free (Spec_Id) then
+         if not Allows_Lock_Free_Implementation (N, Complain => True) then
+            return;
+         end if;
+
+      --  In other cases, check both the protected declaration and body satisfy
+      --  the lock-free restrictions.
+
+      elsif Allows_Lock_Free_Implementation (Parent (Spec_Id))
+        and then Allows_Lock_Free_Implementation (N)
+      then
+         Set_Uses_Lock_Free (Spec_Id);
+      end if;
    end Analyze_Protected_Body;
 
    ----------------------------------
@@ -1347,6 +1708,16 @@
 
       End_Scope;
 
+      --  When a Lock_Free aspect forces the lock-free implementation, check N
+      --  meets all the lock-free restrictions. Otherwise,
+      --  Allows_Lock_Free_Implementation issue an error message.
+
+      if Uses_Lock_Free (Defining_Identifier (N)) then
+         if not Allows_Lock_Free_Implementation (N, Complain => True) then
+            return;
+         end if;
+      end if;
+
       --  Case of a completion of a private declaration
 
       if T /= Def_Id
@@ -1840,10 +2211,6 @@
       --  disastrous result.
 
       Analyze_Protected_Type_Declaration (N);
-
-      if Has_Aspects (N) then
-         Analyze_Aspect_Specifications (N, Id);
-      end if;
    end Analyze_Single_Protected_Declaration;
 
    -------------------------------------
Index: sem_ch9.ads
===================================================================
--- sem_ch9.ads	(revision 187501)
+++ sem_ch9.ads	(working copy)
@@ -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 @@
    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;
Index: einfo.adb
===================================================================
--- einfo.adb	(revision 187501)
+++ einfo.adb	(working copy)
@@ -452,6 +452,7 @@
    --    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 @@
    --    Has_Anonymous_Master            Flag253
    --    Is_Implementation_Defined       Flag254
 
-   --    (unused)                        Flag188
    --    (unused)                        Flag201
 
    -----------------------
@@ -2794,6 +2794,12 @@
       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 @@
       Set_Node16 (Id, V);
    end Set_Unset_Reference;
 
+   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_Used_As_Generic_Actual (Id : E; V : B := True) is
-   begin
-      Set_Flag222 (Id, V);
-   end Set_Used_As_Generic_Actual;
-
    procedure Set_Warnings_Off (Id : E; V : B := True) is
    begin
       Set_Flag96 (Id, V);
Index: einfo.ads
===================================================================
--- einfo.ads	(revision 187501)
+++ einfo.ads	(working copy)
@@ -3878,6 +3878,12 @@
 --       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 @@
    --    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 @@
    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 @@
    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 @@
    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 @@
    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);
Index: rtsfind.ads
===================================================================
--- rtsfind.ads	(revision 187501)
+++ rtsfind.ads	(working copy)
@@ -739,6 +739,8 @@
      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 @@
      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,
Index: aspects.adb
===================================================================
--- aspects.adb	(revision 187501)
+++ aspects.adb	(working copy)
@@ -242,11 +242,13 @@
     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 @@
     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 @@
     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_Invariant                    => Aspect_Invariant,
     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_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 @@
     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 @@
     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,
Index: aspects.ads
===================================================================
--- aspects.ads	(revision 187501)
+++ aspects.ads	(working copy)
@@ -142,8 +142,13 @@
       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
 
    Class_Aspect_OK : constant array (Aspect_Id) of Boolean :=
@@ -182,6 +187,7 @@
                              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 @@
      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,
Index: s-atopri.ads
===================================================================
--- s-atopri.ads	(revision 187501)
+++ s-atopri.ads	(working copy)
@@ -29,8 +29,11 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  ??? 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 @@
       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;
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb	(revision 187501)
+++ sem_ch13.adb	(working copy)
@@ -926,16 +926,40 @@
                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
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 187501)
+++ snames.ads-tmpl	(working copy)
@@ -142,6 +142,7 @@
    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 + $;
