From patchwork Fri Feb 20 14:36:07 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 441991 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id B7B3D1401AB for ; Sat, 21 Feb 2015 01:36:27 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=l+/luthqvzv77OFTP1Ue/NCZbbZbN/ybaAcvrcdBJyU065lKN+ NNqs+vYs47J3O/wFDrGCgTBvq/Vw5pvDUDSHYYX9J+lFTxrM20r1bj4jx+yTzTtc pqC834a37NZg2vVKJmjaBN8nKwAidfgqf5Ou3oV0B1Ip+LX3exxkeJJvc= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=UIencXJE6ZrYm9dh0zoZPa0Teig=; b=yp8/v/XQxO4SQ+JXlXJi B6KRiteD1DJLHCfW0t7Qhl4KsMplrWDpSF8nqLLD5Qob07Xwwu4RN8XGQRckFvsT qbVyzpf1469s1aP9npM72YoM9cG6syGLQ2H63WeVeGuowkKe6GKMUbxFJvPZCEr7 CU1f0EoFLqn8AmwvqzEMWUI= Received: (qmail 12073 invoked by alias); 20 Feb 2015 14:36:11 -0000 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 Received: (qmail 12029 invoked by uid 89); 20 Feb 2015 14:36:11 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.7 required=5.0 tests=AWL, BAYES_00 autolearn=ham version=3.3.2 X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Fri, 20 Feb 2015 14:36:09 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id C79A9116856; Fri, 20 Feb 2015 09:36:07 -0500 (EST) 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 uasdBs0vw6+X; Fri, 20 Feb 2015 09:36:07 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id B7D6D116854; Fri, 20 Feb 2015 09:36:07 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id B670791A8C; Fri, 20 Feb 2015 09:36:07 -0500 (EST) Date: Fri, 20 Feb 2015 09:36:07 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] Indirect calls are always external Message-ID: <20150220143607.GA5338@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.21 (2010-09-15) an indirect call through an access-to-protected-subprogram value is always considered an external call. This patch makes that happen (previously, the compiler was using internal calls in some cases). The following test should run to completion, silently. (Before the bug fix, it would hang, because the call "V_Acc.all;" was not reevaluating the barriers, so the call "PO.P;" would never proceed.) package External_Indirect_Calls is protected PO is procedure Init; entry P; procedure V; private B : Boolean := True; end PO; V_Acc : access protected procedure; end External_Indirect_Calls; package body External_Indirect_Calls is protected body PO is procedure Init is begin V_Acc := V'Access; end Init; entry P when not B is begin B := True; end P; procedure V is begin B := False; end V; end PO; end External_Indirect_Calls; procedure External_Indirect_Calls.Main is task T; task body T is begin PO.P; end T; begin PO.Init; delay 0.001; V_Acc.all; end External_Indirect_Calls.Main; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-02-20 Bob Duff * exp_attr.adb (May_Be_External_Call): Remove this. There is no need for the compiler to guess whether the call is internal or external -- it is always external. (Expand_Access_To_Protected_Op): For P'Access, where P is a protected subprogram, always create a pointer to the External_Subprogram. Index: exp_attr.adb =================================================================== --- exp_attr.adb (revision 220835) +++ exp_attr.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -690,41 +690,6 @@ Obj_Ref : Node_Id; Curr : Entity_Id; - function May_Be_External_Call return Boolean; - -- If the 'Access is to a local operation, but appears in a context - -- where it may lead to a call from outside the object, we must treat - -- this as an external call. Clearly we cannot tell without full - -- flow analysis, and a subsequent call that uses this 'Access may - -- lead to a bounded error (trying to seize locks twice, e.g.). For - -- now we treat 'Access as a potential external call if it is an actual - -- in a call to an outside subprogram. - - -------------------------- - -- May_Be_External_Call -- - -------------------------- - - function May_Be_External_Call return Boolean is - Subp : Entity_Id; - Par : Node_Id := Parent (N); - - begin - -- Account for the case where the Access attribute is part of a - -- named parameter association. - - if Nkind (Par) = N_Parameter_Association then - Par := Parent (Par); - end if; - - if Nkind (Par) in N_Subprogram_Call - and then Is_Entity_Name (Name (Par)) - then - Subp := Entity (Name (Par)); - return not In_Open_Scopes (Scope (Subp)); - else - return False; - end if; - end May_Be_External_Call; - -- Start of processing for Expand_Access_To_Protected_Op begin @@ -733,15 +698,15 @@ -- protected body of the current enclosing operation. if Is_Entity_Name (Pref) then - if May_Be_External_Call then - Sub := - New_Occurrence_Of (External_Subprogram (Entity (Pref)), Loc); - else - Sub := - New_Occurrence_Of - (Protected_Body_Subprogram (Entity (Pref)), Loc); - end if; + -- All indirect calls are external calls, so must do locking and + -- barrier reevaluation, even if the 'Access occurs within the + -- protected body. Hence the call to External_Subprogram, as opposed + -- to Protected_Body_Subprogram, below. See RM-9.5(5). This means + -- that indirect calls from within the same protected body will + -- deadlock, as allowed by RM-9.5.1(8,15,17). + Sub := New_Occurrence_Of (External_Subprogram (Entity (Pref)), Loc); + -- Don't traverse the scopes when the attribute occurs within an init -- proc, because we directly use the _init formal of the init proc in -- that case.