From patchwork Wed Apr 25 15:15:29 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 154968 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id C276CB6F62 for ; Thu, 26 Apr 2012 01:16:12 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1335971773; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=hGNnqhjX68sjOtEVp1wY qrT8FvI=; b=oagA2W+z63TQMq06x6lst9Zg4fy8TbowQMUdN5jIxmp1HLscOj4x DG1gb0wtsnyuldh9iYfS47xUdJgzSLT/ORklPXbfA7aO19DU8cv1XS6RqjYAff5X oY/AZHknVAqcb8VeKvlxLJfRNqngimM1kIKPNBjLygWxUBq2EGyGBWE= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=DiznIf6hDK+PeZcVTrPzySQhtWRX/ElKo5gihlfKipNfPVh2e+kb822bV7nohP h++2yG7vMPqWZBDCy1thjmeTmcgJ/HpD04n5EBuVRHyJEZcjDUS93EozCuafAYt6 J73s3Bl625qNLIVgFedK3de7hNht5VblaqkDqXpyF/LW8=; Received: (qmail 27166 invoked by alias); 25 Apr 2012 15:16:06 -0000 Received: (qmail 27135 invoked by uid 22791); 25 Apr 2012 15:15:52 -0000 X-SWARE-Spam-Status: No, hits=-3.4 required=5.0 tests=AWL, BAYES_00, KHOP_RCVD_UNTRUST, RCVD_IN_HOSTKARMA_NO, RCVD_IN_HOSTKARMA_W, RCVD_IN_HOSTKARMA_WL, TW_TM X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 25 Apr 2012 15:15:30 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E32EE1C6EC4; Wed, 25 Apr 2012 11:15:29 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id uVxHJdj6pFhB; Wed, 25 Apr 2012 11:15:29 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 9C9291C6EC3; Wed, 25 Apr 2012 11:15:29 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 9985B3FEE8; Wed, 25 Apr 2012 11:15:29 -0400 (EDT) Date: Wed, 25 Apr 2012 11:15:29 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Atomic protected types Message-ID: <20120425151529.GA17963@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This patch cleans up the implementation of atomic protected types. No changes in behavior. Tested on x86_64-pc-linux-gnu, committed on trunk 2012-04-25 Hristian Kirtchev * exp_ch9.adb: Rename Lock_Free_Sub_Type to Lock_Free_Subprogram. Remove type Subprogram_Id. Rename LF_Sub_Table to Lock_Free_Subprogram_Table. (Allow_Lock_Free_Implementation): Renamed to Allows_Lock_Free_Implementation. Update the comment on lock-free restrictions. Code clean up and restructuring. (Build_Lock_Free_Protected_Subprogram_Body): Update the profile and related comments. Code clean up and restructuring. (Build_Lock_Free_Unprotected_Subprogram_Body): Update the profile and related comments. Code clean up and restructuring. (Comp_Of): Removed. Index: exp_ch9.adb =================================================================== --- exp_ch9.adb (revision 186823) +++ exp_ch9.adb (working copy) @@ -81,29 +81,24 @@ -- Lock Free Data Structure -- ------------------------------ - -- A data structure used for the Lock Free (LF) implementation of protected - -- objects. Since a protected subprogram can only access a single protected - -- component in the LF implementation, this structure stores each protected - -- subprogram and its accessed protected component when the protected - -- object allows the LF implementation. - - type Lock_Free_Sub_Type is record + type Lock_Free_Subprogram is record Sub_Body : Node_Id; Comp_Id : Entity_Id; end record; + -- This data structure and its fields must be documented, ALL global + -- data structures must be documented. We never rely on guessing what + -- things mean from their names. - subtype Subprogram_Id is Nat; + -- The following table establishes a relation between a subprogram body and + -- an unique protected component referenced in this body. - -- The following table used for the Lock Free implementation of protected - -- objects maps Lock_Free_Sub_Type to Subprogram_Id. - - package LF_Sub_Table is new Table.Table ( - Table_Component_Type => Lock_Free_Sub_Type, - Table_Index_Type => Subprogram_Id, + 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 => "LF_Sub_Table"); + Table_Name => "Lock_Free_Subprogram_Table"); ----------------------- -- Local Subprograms -- @@ -139,9 +134,19 @@ -- Decls is the list of declarations to be enhanced. -- Ent is the entity for the original entry body. - function Allow_Lock_Free_Implementation (N : Node_Id) return Boolean; - -- Given a protected body N, return True if N permits a lock free - -- implementation. + 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. @@ -189,20 +194,20 @@ -- Build subprogram declaration for previous one function Build_Lock_Free_Protected_Subprogram_Body - (N : Node_Id; - Pid : Node_Id; - N_Op_Spec : Node_Id) return Node_Id; - -- This function is used to construct the lock free version of a protected - -- subprogram when the protected type denoted by Pid allows the lock free - -- implementation. It only contains a call to the unprotected version of - -- the subprogram body. + (N : Node_Id; + Prot_Typ : Node_Id; + Unprot_Spec : Node_Id) return Node_Id; + -- N denotes a subprogram body of protected type Prot_Typ. Unprot_Spec is + -- the subprogram specification of the unprotected version of N. Transform + -- N such that it invokes the unprotected version of the body. function Build_Lock_Free_Unprotected_Subprogram_Body - (N : Node_Id; - Pid : Node_Id) return Node_Id; - -- This function is used to construct the lock free version of an - -- unprotected subprogram when the protected type denoted by Pid allows the - -- lock free implementation. + (N : Node_Id; + Prot_Typ : Node_Id) return Node_Id; + -- N denotes a subprogram body of protected type Prot_Typ. Build a version + -- of N where the original statements of N are synchronized through atomic + -- actions such as compare and exchange. Prior to invoking this routine, it + -- has been established that N can be implemented in a lock-free fashion. function Build_Parameter_Block (Loc : Source_Ptr; @@ -349,10 +354,6 @@ -- For each entry family in a concurrent type, create an anonymous array -- type of the right size, and add a component to the corresponding_record. - function Comp_Of (Sub_Body : Node_Id) return Entity_Id; - -- For the lock free implementation, return the protected component entity - -- referenced in Sub_Body using LF_Sub_Table. - function Concurrent_Object (Spec_Id : Entity_Id; Conc_Typ : Entity_Id) return Entity_Id; @@ -819,221 +820,180 @@ Prepend_To (Decls, Decl); end Add_Object_Pointer; - ------------------------------------ - -- Allow_Lock_Free_Implementation -- - ------------------------------------ + ------------------------------------- + -- Allows_Lock_Free_Implementation -- + ------------------------------------- - -- Here are the restrictions for the 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); - -- Implementation Restrictions on protected declaration + 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. - -- There must be only protected scalar components (at least one) + -------------------------------------- + -- Satisfies_Lock_Free_Requirements -- + -------------------------------------- - -- Component types must support an atomic compare_exchange primitive - -- (size equals to 1, 2, 4 or 8 bytes). + function Satisfies_Lock_Free_Requirements + (Sub_Body : Node_Id) return Boolean + is + Comp : Entity_Id := Empty; + -- Track the current component which the body references - -- No entries - - -- Implementation Restrictions on protected operations - - -- Cannot refer to non-constant outside of the scope of the protected - -- operation. - - -- Can only access a single protected component: all protected - -- component names appearing in a scope (including nested scopes) - -- must statically denote the same protected component. - - -- Fundamental Restrictions on protected operations - - -- No loop and procedure call statements - - -- Any function call and attribute reference must be static - - function Allow_Lock_Free_Implementation (N : Node_Id) return Boolean is - Decls : constant List_Id := Declarations (N); - Spec : constant Entity_Id := Corresponding_Spec (N); - Pro_Def : constant Node_Id := Protected_Definition (Parent (Spec)); - Pri_Decls : constant List_Id := Private_Declarations (Pro_Def); - Vis_Decls : constant List_Id := Visible_Declarations (Pro_Def); - - Comp_Id : Entity_Id; - Comp_Size : Int; - Comp_Type : Entity_Id; - No_Component : Boolean := True; - N_Decl : Node_Id; - - function Permit_Lock_Free (Sub_Body : Node_Id) return Boolean; - -- Return True if the protected subprogram body Sub_Body doesn't - -- prevent the lock free code expansion, i.e. Sub_Body meets all the - -- restrictions listed below that allow the lock free implementation. - -- - -- Can only access a single protected component - -- - -- No loop and procedure call statements - - -- Any function call and attribute reference must be static - - -- Cannot refer to non-constant outside of the scope of the protected - -- subprogram. - - ---------------------- - -- Permit_Lock_Free -- - ---------------------- - - function Permit_Lock_Free (Sub_Body : Node_Id) return Boolean is - Sub_Id : constant Entity_Id := Corresponding_Spec (Sub_Body); - Comp_Id : Entity_Id := Empty; - LF_Sub : Lock_Free_Sub_Type; - function Check_Node (N : Node_Id) return Traverse_Result; - -- Check the node N meet the lock free restrictions + -- Check that node N meets the lock free restrictions - function Check_All_Nodes is new Traverse_Func (Check_Node); - ---------------- -- Check_Node -- ---------------- function Check_Node (N : Node_Id) return Traverse_Result is - Comp_Decl : Node_Id; - Id : Entity_Id; - begin - case Nkind (N) is + -- Function calls and attribute references must be static + -- ??? what about side-effects - -- Function call or attribute reference case + if Nkind_In (N, N_Attribute_Reference, N_Function_Call) + and then not Is_Static_Expression (N) + then + return Abandon; - when N_Function_Call | N_Attribute_Reference => + -- Loop statements and procedure calls are prohibited - -- Any function call and attribute reference must be static + elsif Nkind_In (N, N_Loop_Statement, + N_Procedure_Call_Statement) + then + return Abandon; - if not Is_Static_Expression (N) then - return Abandon; - end if; + -- References - -- Loop and procedure call statement case + 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); - when N_Procedure_Call_Statement | N_Loop_Statement => - -- No loop and procedure call statements - return Abandon; + begin + -- Prohibit references to non-constant entities outside the + -- protected subprogram scope. - -- Identifier case + 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; - when N_Identifier => - if Present (Entity (N)) then - Id := Entity (N); + -- A protected subprogram may reference only one component + -- of the protected type. - -- Cannot refer to non-constant entities outside of the - -- scope of the protected subprogram. - - if Ekind (Id) in Assignable_Kind - and then Sloc (Scope (Id)) > No_Location - 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; - end if; - - -- Can only access a single protected component - - if Ekind_In (Id, E_Constant, E_Variable) - and then Present (Prival_Link (Id)) - then - Comp_Decl := Parent (Prival_Link (Id)); - + 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) = Pri_Decls + 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. - if Present (Comp_Id) - and then Comp_Id /= Prival_Link (Id) - then + elsif Comp /= Prival_Link (Id) then return Abandon; - - elsif not Present (Comp_Id) then - Comp_Id := Prival_Link (Id); end if; end if; - end if; + end; end if; + end; + end if; - -- Ok for all other nodes - - when others => return OK; - end case; - return OK; end Check_Node; - -- Start of processing for Permit_Lock_Free + 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 - -- Fill LF_Sub with Sub_Body and its corresponding protected - -- component entity and then store LF_Sub in the lock free - -- subprogram table LF_Sub_Table. + -- Establish a relation between the subprogram body and the unique + -- protected component it references. - LF_Sub.Sub_Body := Sub_Body; - LF_Sub.Comp_Id := Comp_Id; - LF_Sub_Table.Append (LF_Sub); - return True; + 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 Permit_Lock_Free; + end Satisfies_Lock_Free_Requirements; - -- Start of processing for Allow_Lock_Free_Implementation + -- 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 - -- Debug switch -gnatd9 enables Lock Free implementation + -- The lock-free implementation is currently enabled through a debug + -- flag. if not Debug_Flag_9 then return False; end if; - -- Look for any entries declared in the visible part of the protected - -- declaration. + -- Examine the visible declarations. Entries and entry families are not + -- allowed by the lock-free restrictions. - N_Decl := First (Vis_Decls); - while Present (N_Decl) loop - if Nkind (N_Decl) = N_Entry_Declaration then + Decl := First (Vis_Decls); + while Present (Decl) loop + if Nkind (Decl) = N_Entry_Declaration then return False; end if; - N_Decl := Next (N_Decl); + Next (Decl); end loop; - -- Look for any entry, plus look for any scalar component declared in - -- the private part of the protected declaration. + -- Examine the private declarations - N_Decl := First (Pri_Decls); - while Present (N_Decl) loop + Decl := First (Priv_Decls); + while Present (Decl) loop - -- Check at least one scalar component is declared + -- The protected type must define at least one scalar component - if Nkind (N_Decl) = N_Component_Declaration then - if No_Component then - No_Component := False; - end if; + if Nkind (Decl) = N_Component_Declaration then + Has_Component := True; - Comp_Id := Defining_Identifier (N_Decl); + Comp_Id := Defining_Identifier (Decl); Comp_Type := Etype (Comp_Id); - -- Verify the component is a scalar - if not Is_Scalar_Type (Comp_Type) then return False; end if; Comp_Size := UI_To_Int (Esize (Base_Type (Comp_Type))); - -- Check the size of the component is 8, 16, 32 or 64 bits + -- Check that the size of the component is 8, 16, 32 or 64 bits case Comp_Size is when 8 | 16 | 32 | 64 => @@ -1042,39 +1002,37 @@ return False; end case; - -- Check there is no entry declared in the private part. + -- Entries and entry families are not allowed - else - if Nkind (N_Decl) = N_Entry_Declaration then - return False; - end if; + elsif Nkind (Decl) = N_Entry_Declaration then + return False; end if; - N_Decl := Next (N_Decl); + Next (Decl); end loop; - -- One scalar component must be present + -- At least one scalar component must be present - if No_Component then + if not Has_Component then return False; end if; - -- Ensure all protected subprograms meet the restrictions that allow the - -- lock free implementation. + -- Ensure that all protected subprograms meet the restrictions of the + -- lock-free implementation. - N_Decl := First (Decls); - while Present (N_Decl) loop - if Nkind (N_Decl) = N_Subprogram_Body - and then not Permit_Lock_Free (N_Decl) + 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 (N_Decl); + Next (Decl); end loop; return True; - end Allow_Lock_Free_Implementation; + end Allows_Lock_Free_Implementation; ----------------------- -- Build_Accept_Body -- @@ -3189,293 +3147,271 @@ ----------------------------------------------- function Build_Lock_Free_Protected_Subprogram_Body - (N : Node_Id; - Pid : Node_Id; - N_Op_Spec : Node_Id) return Node_Id + (N : Node_Id; + Prot_Typ : Node_Id; + Unprot_Spec : Node_Id) return Node_Id is - Loc : constant Source_Ptr := Sloc (N); - Op_Spec : Node_Id; - P_Op_Spec : Node_Id; - Uactuals : List_Id; - Pformal : Node_Id; - Unprot_Call : Node_Id; - R : Node_Id; - Return_Stmt : Node_Id := Empty; -- init to avoid gcc 3 warning - Exc_Safe : Boolean; + Actuals : constant List_Id := New_List; + Loc : constant Source_Ptr := Sloc (N); + Spec : constant Node_Id := Specification (N); + Unprot_Id : constant Entity_Id := Defining_Unit_Name (Unprot_Spec); + Formal : Node_Id; + Prot_Spec : Node_Id; + Stmt : Node_Id; begin - Op_Spec := Specification (N); - Exc_Safe := Is_Exception_Safe (N); + -- Create the protected version of the body - P_Op_Spec := - Build_Protected_Sub_Specification (N, Pid, Protected_Mode); + Prot_Spec := + Build_Protected_Sub_Specification (N, Prot_Typ, Protected_Mode); - -- Build a list of the formal parameters of the protected version of - -- the subprogram to use as the actual parameters of the unprotected - -- version. + -- Build the actual parameters which appear in the call to the + -- unprotected version of the body. - Uactuals := New_List; - Pformal := First (Parameter_Specifications (P_Op_Spec)); - while Present (Pformal) loop - Append_To (Uactuals, - Make_Identifier (Loc, Chars (Defining_Identifier (Pformal)))); - Next (Pformal); + Formal := First (Parameter_Specifications (Prot_Spec)); + while Present (Formal) loop + Append_To (Actuals, + Make_Identifier (Loc, Chars (Defining_Identifier (Formal)))); + + Next (Formal); end loop; - -- Make a call to the unprotected version of the subprogram built above - -- for use by the protected version built below. + -- Function case, generate: + -- return ; - if Nkind (Op_Spec) = N_Function_Specification then - if Exc_Safe then - R := Make_Temporary (Loc, 'R'); - Unprot_Call := - Make_Object_Declaration (Loc, - Defining_Identifier => R, - Constant_Present => True, - Object_Definition => New_Copy (Result_Definition (N_Op_Spec)), - Expression => - Make_Function_Call (Loc, - Name => Make_Identifier (Loc, - Chars => Chars (Defining_Unit_Name (N_Op_Spec))), - Parameter_Associations => Uactuals)); + if Nkind (Spec) = N_Function_Specification then + Stmt := + Make_Simple_Return_Statement (Loc, + Expression => + Make_Function_Call (Loc, + Name => + Make_Identifier (Loc, Chars (Unprot_Id)), + Parameter_Associations => Actuals)); - Return_Stmt := - Make_Simple_Return_Statement (Loc, - Expression => New_Reference_To (R, Loc)); + -- Procedure case, call the unprotected version - else - Unprot_Call := Make_Simple_Return_Statement (Loc, - Expression => Make_Function_Call (Loc, - Name => - Make_Identifier (Loc, - Chars => Chars (Defining_Unit_Name (N_Op_Spec))), - Parameter_Associations => Uactuals)); - end if; - else - Unprot_Call := + Stmt := Make_Procedure_Call_Statement (Loc, - Name => - Make_Identifier (Loc, Chars (Defining_Unit_Name (N_Op_Spec))), - Parameter_Associations => Uactuals); + Name => + Make_Identifier (Loc, Chars (Unprot_Id)), + Parameter_Associations => Actuals); end if; - if Nkind (Op_Spec) = N_Function_Specification - and then Exc_Safe - then - Unprot_Call := - Make_Block_Statement (Loc, - Declarations => New_List (Unprot_Call), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Return_Stmt))); - end if; - return Make_Subprogram_Body (Loc, - Declarations => Empty_List, - Specification => P_Op_Spec, + Declarations => Empty_List, + Specification => Prot_Spec, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Unprot_Call))); + Statements => New_List (Stmt))); end Build_Lock_Free_Protected_Subprogram_Body; ------------------------------------------------- -- Build_Lock_Free_Unprotected_Subprogram_Body -- ------------------------------------------------- - function Build_Lock_Free_Unprotected_Subprogram_Body - (N : Node_Id; - Pid : Node_Id) return Node_Id - is - Decls : constant List_Id := Declarations (N); - Is_Procedure : constant Boolean := - Ekind (Corresponding_Spec (N)) = E_Procedure; - Loc : constant Source_Ptr := Sloc (N); + -- Procedures which meet the lock-free implementation requirements and + -- reference a unique scalar component Comp are expanded in the following + -- manner: - function Ren_Comp_Id (Decls : List_Id) return Entity_Id; - -- Given the list of delaration Decls, return the renamed entity - -- of the protected component accessed by the subprogram body. + -- procedure P (...) is + -- + -- begin + -- loop + -- declare + -- Saved_Comp : constant ... := Atomic_Load (Comp'Address); + -- Current_Comp : ... := Saved_Comp; + -- begin + -- + -- exit when Atomic_Compare (Comp, Saved_Comp, Current_Comp); + -- end; + -- <> + -- end loop; + -- end P; - ----------------- - -- Ren_Comp_Id -- - ----------------- + -- References to Comp which appear in the original statements are replaced + -- with references to Current_Comp. Each return and raise statement of P is + -- transformed into an atomic status check: - function Ren_Comp_Id (Decls : List_Id) return Entity_Id is - N_Decl : Node_Id; - Pri_Link : Node_Id; + -- if Atomic_Compare (Comp, Saved_Comp, Current_Comp) then + -- + -- else + -- goto L0; + -- end if; - begin - N_Decl := First (Decls); - while Present (N_Decl) loop + -- Functions which meet the lock-free implementation requirements and + -- reference a unique scalar component Comp are expanded in the following + -- manner: - -- Look for a renaming declaration + -- function F (...) return ... is + -- + -- Saved_Comp : constant ... := Atomic_Load (Comp'Address); + -- begin + -- + -- end F; - if Nkind (N_Decl) = N_Object_Renaming_Declaration then - Pri_Link := Prival_Link (Defining_Identifier (N_Decl)); + -- References to Comp which appear in the original statements are replaced + -- with references to Saved_Comp. - -- Compare the renamed entity and the accessed component entity - -- in the LF_Sub_Table. + function Build_Lock_Free_Unprotected_Subprogram_Body + (N : Node_Id; + Prot_Typ : Node_Id) return Node_Id + is + Is_Procedure : constant Boolean := + Ekind (Corresponding_Spec (N)) = E_Procedure; + Loc : constant Source_Ptr := Sloc (N); + Label_Id : Entity_Id := Empty; - if Present (Pri_Link) and then Pri_Link = Comp_Of (N) then - return Defining_Identifier (N_Decl); - end if; - end if; + procedure Process_Stmts + (Stmts : List_Id; + Compare : Entity_Id; + Unsigned : Entity_Id; + Comp : Entity_Id; + Saved_Comp : Entity_Id; + Current_Comp : Entity_Id); + -- Given a statement sequence Stmts, wrap any return or raise statements + -- in the following manner: + -- + -- if System.Atomic_Primitives.Atomic_Compare_Exchange + -- (Comp'Address, + -- Interfaces.Unsigned (Saved_Comp), + -- Interfaces.Unsigned (Current_Comp)) + -- then + -- ; + -- else + -- goto L0; + -- end if; + -- + -- Replace all references to Comp with a reference to Current_Comp. - Next (N_Decl); - end loop; + function Referenced_Component (N : Node_Id) return Entity_Id; + -- Subprograms which meet the lock-free implementation criteria are + -- allowed to reference only one unique component. Return the prival + -- of the said component. - return Empty; - end Ren_Comp_Id; + ------------------- + -- Process_Stmts -- + ------------------- - Obj_Id : constant Entity_Id := Ren_Comp_Id (Decls); - At_Comp_Id : Entity_Id; - At_Load_Id : Entity_Id; - Copy_Id : Entity_Id; - Exit_Stmt : Node_Id; - Label : Node_Id := Empty; - Label_Id : Entity_Id; - New_Body : Node_Id; - New_Decls : List_Id; - New_Stmts : List_Id; - Obj_Typ : Entity_Id; - Old_Id : Entity_Id; - Typ_Size : Int; - Unsigned_Id : Entity_Id; + procedure Process_Stmts + (Stmts : List_Id; + Compare : Entity_Id; + Unsigned : Entity_Id; + Comp : Entity_Id; + Saved_Comp : Entity_Id; + Current_Comp : Entity_Id) + is + function Process_Node (N : Node_Id) return Traverse_Result; + -- Transform a single node if it is a return statement, a raise + -- statement or a reference to Comp. - function Make_If (Stmt : Node_Id) return Node_Id; - -- Given the statement Stmt, return an if statement with Stmt at the end - -- of the list of statements. + ------------------ + -- Process_Node -- + ------------------ - procedure Process_Stmts (Stmts : List_Id); - -- Wrap each return and raise statements in Stmts into an if statement - -- generated by Make_If. Replace all references to the protected object - -- Obj by a reference to its copy Obj_Copy. + function Process_Node (N : Node_Id) return Traverse_Result is - ------------- - -- Make_If -- - ------------- + procedure Wrap_Statement (Stmt : Node_Id); + -- Wrap an arbitrary statement inside an if statement where the + -- condition does an atomic check on the state of the object. - function Make_If (Stmt : Node_Id) return Node_Id is - begin - -- Generate (for Typ_Size = 32): + -------------------- + -- Wrap_Statement -- + -------------------- - -- if System.Atomic_Primitives.Atomic_Compare_Exchange_32 - -- (Obj'Address, - -- Interfaces.Unsigned_32! (Obj_Old), - -- Interfaces.Unsigned_32! (Obj_Copy)); - -- then - -- < Stmt > - -- else - -- goto L0; - -- end if; + procedure Wrap_Statement (Stmt : Node_Id) is + begin + -- The first time through, create the declaration of a label + -- which is used to skip the remainder of source statements if + -- the state of the object has changed. - -- Check whether a label has already been created + if No (Label_Id) then + Label_Id := + Make_Identifier (Loc, New_External_Name ('L', 0)); + Set_Entity (Label_Id, + Make_Defining_Identifier (Loc, Chars (Label_Id))); + end if; - if not Present (Label) then + -- Generate: - -- Create a label which will point just after the last - -- statement of the loop statement generated in step 3. + -- if System.Atomic_Primitives.Atomic_Compare_Exchange + -- (Comp'Address, + -- Interfaces.Unsigned (Saved_Comp), + -- Interfaces.Unsigned (Current_Comp)) + -- then + -- ; + -- else + -- goto L0; + -- end if; - -- Generate: + Rewrite (Stmt, + Make_If_Statement (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Reference_To (Compare, Loc), + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Comp, Loc), + Attribute_Name => Name_Address), - -- L0 : Label; + Unchecked_Convert_To (Unsigned, + New_Reference_To (Saved_Comp, Loc)), - Label_Id := - Make_Identifier (Loc, New_External_Name ('L', 0)); + Unchecked_Convert_To (Unsigned, + New_Reference_To (Current_Comp, Loc)))), - Set_Entity (Label_Id, - Make_Defining_Identifier (Loc, Chars (Label_Id))); - Label := Make_Label (Loc, Label_Id); + Then_Statements => New_List (Relocate_Node (Stmt)), - Append_To (Decls, - Make_Implicit_Label_Declaration (Loc, - Defining_Identifier => Entity (Label_Id), - Label_Construct => Label)); - end if; + Else_Statements => New_List ( + Make_Goto_Statement (Loc, + Name => New_Reference_To (Entity (Label_Id), Loc))))); + end Wrap_Statement; - return - Make_If_Statement (Loc, - Condition => - Make_Function_Call (Loc, - Name => New_Reference_To (At_Comp_Id, Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Obj_Id, Loc), - Attribute_Name => Name_Address), - Unchecked_Convert_To (Unsigned_Id, - New_Reference_To (Old_Id, Loc)), - Unchecked_Convert_To (Unsigned_Id, - New_Reference_To (Copy_Id, Loc)))), + -- Start of processing for Process_Node - Then_Statements => New_List ( - Relocate_Node (Stmt)), - - Else_Statements => New_List ( - Make_Goto_Statement (Loc, - Name => New_Reference_To (Entity (Label_Id), Loc)))); - end Make_If; - - ------------------- - -- Process_Stmts -- - ------------------- - - procedure Process_Stmts (Stmts : List_Id) is - Stmt : Node_Id; - - function Check_Node (N : Node_Id) return Traverse_Result; - -- Recognize a return and raise statement and wrap it into an if - -- statement. Replace all references to the protected object by - -- a reference to its copy. Reset all Analyzed flags in order to - -- reanalyze statments inside the new unprotected subprogram body. - - procedure Process_Nodes is - new Traverse_Proc (Check_Node); - - ---------------- - -- Check_Node -- - ---------------- - - function Check_Node (N : Node_Id) return Traverse_Result is begin - -- In case of a procedure, wrap each return and raise statements - -- inside an if statement created by Make_If. + -- Wrap each return and raise statement that appear inside a + -- procedure. Skip the last return statement which is added by + -- default since it is transformed into an exit statement. if Is_Procedure - and then Nkind_In (N, N_Simple_Return_Statement, - N_Extended_Return_Statement, - N_Raise_Statement) - and then - (Nkind (N) /= N_Simple_Return_Statement - or else N /= Last (Stmts)) + and then Nkind_In (N, N_Simple_Return_Statement, + N_Extended_Return_Statement, + N_Raise_Statement) + and then Nkind (Last (Stmts)) /= N_Simple_Return_Statement then - Rewrite (N, Make_If (N)); + Wrap_Statement (N); return Skip; - -- Replace all references to the protected object by a reference - -- to the new copy. + -- Replace all references to the original component by a reference + -- to the current state of the component. elsif Nkind (N) = N_Identifier and then Present (Entity (N)) - and then Entity (N) = Obj_Id + and then Entity (N) = Comp then - Rewrite (N, Make_Identifier (Loc, Chars (Copy_Id))); + Rewrite (N, Make_Identifier (Loc, Chars (Current_Comp))); return Skip; end if; - -- We mark the node as unanalyzed in order to reanalyze it inside - -- the unprotected subprogram body. + -- Force reanalysis Set_Analyzed (N, False); return OK; - end Check_Node; + end Process_Node; + procedure Process_Nodes is new Traverse_Proc (Process_Node); + + -- Local variables + + Stmt : Node_Id; + -- Start of processing for Process_Stmts begin - -- Process_Nodes for each statement in Stmts - Stmt := First (Stmts); while Present (Stmt) loop Process_Nodes (Stmt); @@ -3483,210 +3419,237 @@ end loop; end Process_Stmts; - -- Start of processing for Build_Lock_Free_Unprotected_Subprogram_Body + -------------------------- + -- Referenced_Component -- + -------------------------- - begin - New_Stmts := New_Copy_List (Statements (Handled_Statement_Sequence (N))); + function Referenced_Component (N : Node_Id) return Entity_Id is + Comp : Entity_Id; + Decl : Node_Id; + Source_Comp : Entity_Id := Empty; - -- Do the transformation only if the subprogram accesses a protected - -- component. + begin + -- Find the unique source component which N references in its + -- statements. - if not Present (Obj_Id) then - goto Continue; - end if; + for Index in 1 .. Lock_Free_Subprogram_Table.Last loop + declare + Element : Lock_Free_Subprogram renames + Lock_Free_Subprogram_Table.Table (Index); + begin + if Element.Sub_Body = N then + Source_Comp := Element.Comp_Id; + exit; + end if; + end; + end loop; - Copy_Id := - Make_Defining_Identifier (Loc, - Chars => New_External_Name (Chars (Obj_Id), Suffix => "_copy")); + if No (Source_Comp) then + return Empty; + end if; - Obj_Typ := Etype (Obj_Id); - Typ_Size := UI_To_Int (Esize (Base_Type (Obj_Typ))); + -- Find the prival which corresponds to the source component within + -- the declarations of N. - Process_Stmts (New_Stmts); + Decl := First (Declarations (N)); + while Present (Decl) loop - -- Procedure case + -- Privals appear as object renamings - if Is_Procedure then - case Typ_Size is - when 8 => - At_Comp_Id := RTE (RE_Atomic_Compare_Exchange_8); - At_Load_Id := RTE (RE_Atomic_Load_8); - Unsigned_Id := RTE (RE_Uint8); + if Nkind (Decl) = N_Object_Renaming_Declaration then + Comp := Defining_Identifier (Decl); - when 16 => - At_Comp_Id := RTE (RE_Atomic_Compare_Exchange_16); - At_Load_Id := RTE (RE_Atomic_Load_16); - Unsigned_Id := RTE (RE_Uint16); + if Present (Prival_Link (Comp)) + and then Prival_Link (Comp) = Source_Comp + then + return Comp; + end if; + end if; - when 32 => - At_Comp_Id := RTE (RE_Atomic_Compare_Exchange_32); - At_Load_Id := RTE (RE_Atomic_Load_32); - Unsigned_Id := RTE (RE_Uint32); + Next (Decl); + end loop; - when 64 => - At_Comp_Id := RTE (RE_Atomic_Compare_Exchange_64); - At_Load_Id := RTE (RE_Atomic_Load_64); - Unsigned_Id := RTE (RE_Uint64); - when others => null; - end case; + return Empty; + end Referenced_Component; - -- Generate (e.g. for Typ_Size = 32): + -- Local variables - -- begin - -- loop - -- declare - -- Obj_Old : constant Obj_Typ := - -- Obj_Typ! - -- (System.Atomic_Primitives.Atomic_Load_32 - -- (Obj'Address)); - -- Obj_Copy : Obj_Typ := Obj_Old; - -- begin - -- < New_Stmts > - -- exit when - -- System.Atomic_Primitives.Atomic_Compare_Exchange_32 - -- (Obj'Address, - -- Interfaces.Unsigned_32! (Obj_Old), - -- Interfaces.Unsigned_32! (Obj_Copy)); - -- end; - -- end loop; - -- end; + Comp : constant Entity_Id := Referenced_Component (N); + Decls : constant List_Id := Declarations (N); + Stmts : List_Id; - -- Step 1: Define a copy and save the old value of the protected - -- object. The copy replaces all the references to the object present - -- in the body of the procedure. + -- Start of processing for Build_Lock_Free_Unprotected_Subprogram_Body - -- Generate: + begin + Stmts := New_Copy_List (Statements (Handled_Statement_Sequence (N))); - -- Obj_Old : constant Obj_Typ := - -- Obj_Typ! - -- (System.Atomic_Primitives.Atomic_Load_32 - -- (Obj'Address)); - -- Obj_Copy : Obj_Typ := Obj_Old; + -- Perform the lock-free expansion when the subprogram references a + -- protected component. - Old_Id := Make_Defining_Identifier (Loc, - New_External_Name (Chars (Obj_Id), Suffix => "_old")); + if Present (Comp) then + declare + Comp_Typ : constant Entity_Id := Etype (Comp); + Typ_Size : constant Int := UI_To_Int (Esize (Comp_Typ)); + Block_Decls : List_Id; + Compare : Entity_Id; + Current_Comp : Entity_Id; + Decl : Node_Id; + Label : Node_Id; + Load : Entity_Id; + Saved_Comp : Entity_Id; + Stmt : Node_Id; + Unsigned : Entity_Id; - New_Decls := New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => Old_Id, - Constant_Present => True, - Object_Definition => New_Reference_To (Obj_Typ, Loc), - Expression => Unchecked_Convert_To (Obj_Typ, - Make_Function_Call (Loc, - Name => New_Reference_To (At_Load_Id, Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Obj_Id, Loc), - Attribute_Name => Name_Address))))), - Make_Object_Declaration (Loc, - Defining_Identifier => Copy_Id, - Object_Definition => New_Reference_To (Obj_Typ, Loc), - Expression => New_Reference_To (Old_Id, Loc))); + begin + -- Retrieve all relevant atomic routines and types - -- Step 2: Create an exit statement of the loop statement generated - -- in step 3. + case Typ_Size is + when 8 => + Compare := RTE (RE_Atomic_Compare_Exchange_8); + Load := RTE (RE_Atomic_Load_8); + Unsigned := RTE (RE_Uint8); - -- Generate (for Typ_Size = 32): + when 16 => + Compare := RTE (RE_Atomic_Compare_Exchange_16); + Load := RTE (RE_Atomic_Load_16); + Unsigned := RTE (RE_Uint16); - -- exit when System.Atomic_Primitives.Atomic_Compare_Exchange_32 - -- (Obj'Address, - -- Interfaces.Unsigned_32! (Obj_Old), - -- Interfaces.Unsigned_32! (Obj_Copy)); + when 32 => + Compare := RTE (RE_Atomic_Compare_Exchange_32); + Load := RTE (RE_Atomic_Load_32); + Unsigned := RTE (RE_Uint32); - Exit_Stmt := - Make_Exit_Statement (Loc, - Condition => - Make_Function_Call (Loc, - Name => New_Reference_To (At_Comp_Id, Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Obj_Id, Loc), - Attribute_Name => Name_Address), - Unchecked_Convert_To (Unsigned_Id, - New_Reference_To (Old_Id, Loc)), - Unchecked_Convert_To (Unsigned_Id, - New_Reference_To (Copy_Id, Loc))))); + when 64 => + Compare := RTE (RE_Atomic_Compare_Exchange_64); + Load := RTE (RE_Atomic_Load_64); + Unsigned := RTE (RE_Uint64); - -- Check the last statement is a return statement + when others => + raise Program_Error; + end case; - if Nkind (Last (New_Stmts)) = N_Simple_Return_Statement then - Rewrite (Last (New_Stmts), Exit_Stmt); - else - Append_To (New_Stmts, Exit_Stmt); - end if; + -- Generate: + -- Saved_Comp : constant Comp_Typ := + -- Comp_Typ (Atomic_Load (Comp'Address)); - -- Step 3: Create the loop statement which encloses a block - -- declaration that contains all the statements of the original - -- procedure body. + Saved_Comp := + Make_Defining_Identifier (Loc, + New_External_Name (Chars (Comp), Suffix => "_saved")); - -- Generate: + Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Saved_Comp, + Constant_Present => True, + Object_Definition => New_Reference_To (Comp_Typ, Loc), + Expression => + Unchecked_Convert_To (Comp_Typ, + 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))))); - -- loop - -- declare - -- < New_Decls > - -- begin - -- < New_Stmts > - -- end; - -- end loop; + -- Protected procedures - New_Stmts := New_List ( - Make_Loop_Statement (Loc, - Statements => New_List ( - Make_Block_Statement (Loc, - Declarations => New_Decls, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_Stmts))), - End_Label => Empty)); + if Is_Procedure then + Block_Decls := New_List (Decl); - -- Append the label to the statements of the loop when needed + -- Generate: + -- Current_Comp : Comp_Typ := Saved_Comp; - if Present (Label) then - Append_To (Statements (First (New_Stmts)), Label); - end if; + Current_Comp := + Make_Defining_Identifier (Loc, + New_External_Name (Chars (Comp), Suffix => "_current")); - -- Function case + Append_To (Block_Decls, + Make_Object_Declaration (Loc, + Defining_Identifier => Current_Comp, + Object_Definition => New_Reference_To (Comp_Typ, Loc), + Expression => New_Reference_To (Saved_Comp, Loc))); - else - case Typ_Size is - when 8 => - At_Load_Id := RTE (RE_Atomic_Load_8); - when 16 => - At_Load_Id := RTE (RE_Atomic_Load_16); - when 32 => - At_Load_Id := RTE (RE_Atomic_Load_32); - when 64 => - At_Load_Id := RTE (RE_Atomic_Load_64); - when others => null; - end case; + -- Protected function - -- Define a copy of the protected object which replaces all the - -- references to the object present in the body of the function. + else + Append_To (Decls, Decl); + Current_Comp := Saved_Comp; + end if; - -- Generate: + Process_Stmts + (Stmts, Compare, Unsigned, Comp, Saved_Comp, Current_Comp); - -- Obj_Copy : constant Obj_Typ := - -- Obj_Typ! - -- (System.Atomic_Primitives.Atomic_Load_32 - -- (Obj'Address)); + -- Generate: + -- exit when System.Atomic_Primitives.Atomic_Compare_Exchange + -- (Comp'Address, + -- Interfaces.Unsigned (Saved_Comp), + -- Interfaces.Unsigned (Current_Comp)) - Append_To (Decls, - Make_Object_Declaration (Loc, - Defining_Identifier => Copy_Id, - Constant_Present => True, - Object_Definition => New_Reference_To (Obj_Typ, Loc), - Expression => Unchecked_Convert_To (Obj_Typ, - Make_Function_Call (Loc, - Name => New_Reference_To (At_Load_Id, Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Obj_Id, Loc), - Attribute_Name => Name_Address)))))); - end if; + if Is_Procedure then + Stmt := + Make_Exit_Statement (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Reference_To (Compare, Loc), + Parameter_Associations => New_List ( + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Comp, Loc), + Attribute_Name => Name_Address), - << Continue >> + Unchecked_Convert_To (Unsigned, + New_Reference_To (Saved_Comp, Loc)), - -- Add renamings for the Protection object, discriminals, privals and + Unchecked_Convert_To (Unsigned, + New_Reference_To (Current_Comp, Loc))))); + + -- Small optimization: transform the default return statement + -- of a procedure into the atomic exit statement. + + if Nkind (Last (Stmts)) = N_Simple_Return_Statement then + Rewrite (Last (Stmts), Stmt); + else + Append_To (Stmts, Stmt); + end if; + end if; + + -- Create the declaration of the label used to skip the rest of + -- the source statements when the object state changes. + + if Present (Label_Id) then + Label := Make_Label (Loc, Label_Id); + + Append_To (Decls, + Make_Implicit_Label_Declaration (Loc, + Defining_Identifier => Entity (Label_Id), + Label_Construct => Label)); + + Append_To (Stmts, Label); + end if; + + -- Generate: + -- loop + -- declare + -- + -- begin + -- + -- end; + -- end loop; + + if Is_Procedure then + Stmts := New_List ( + Make_Loop_Statement (Loc, + Statements => New_List ( + Make_Block_Statement (Loc, + Declarations => Block_Decls, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Stmts))), + End_Label => Empty)); + end if; + end; + end if; + + -- Add renamings for the protection object, discriminals, privals and -- the entry index constant for use by debugger. Debug_Private_Data_Declarations (Decls); @@ -3694,15 +3657,14 @@ -- Make an unprotected version of the subprogram for use within the same -- object, with new name and extra parameter representing the object. - New_Body := + return Make_Subprogram_Body (Loc, Specification => - Build_Protected_Sub_Specification (N, Pid, Unprotected_Mode), + Build_Protected_Sub_Specification (N, Prot_Typ, Unprotected_Mode), Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_Stmts)); - return New_Body; + Statements => Stmts)); end Build_Lock_Free_Unprotected_Subprogram_Body; ------------------------- @@ -5436,21 +5398,6 @@ end loop; end Collect_Entry_Families; - ------------- - -- Comp_Of -- - ------------- - - function Comp_Of (Sub_Body : Node_Id) return Entity_Id is - begin - for Sub_Id in 1 .. LF_Sub_Table.Last loop - if Sub_Body = LF_Sub_Table.Table (Sub_Id).Sub_Body then - return LF_Sub_Table.Table (Sub_Id).Comp_Id; - end if; - end loop; - - return Empty; - end Comp_Of; - ----------------------- -- Concurrent_Object -- ----------------------- @@ -8468,7 +8415,7 @@ Loc : constant Source_Ptr := Sloc (N); Pid : constant Entity_Id := Corresponding_Spec (N); - Lock_Free_On : constant Boolean := Allow_Lock_Free_Implementation (N); + Lock_Free_On : constant Boolean := Allows_Lock_Free_Implementation (N); -- This flag indicates whether the lock free implementation is active Current_Node : Node_Id;