From patchwork Mon Aug 29 08:52:07 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 111993 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 A110AB6F82 for ; Mon, 29 Aug 2011 18:52:26 +1000 (EST) Received: (qmail 6010 invoked by alias); 29 Aug 2011 08:52:23 -0000 Received: (qmail 6000 invoked by uid 22791); 29 Aug 2011 08:52:22 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 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; Mon, 29 Aug 2011 08:52:07 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 343432BB137 for ; Mon, 29 Aug 2011 04:52:07 -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 1k3aOEqwnBlA for ; Mon, 29 Aug 2011 04:52:07 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 1F99D2BB01A for ; Mon, 29 Aug 2011 04:52:07 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 10A3C3FEE8; Mon, 29 Aug 2011 04:52:07 -0400 (EDT) Date: Mon, 29 Aug 2011 04:52:07 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Subject: [Ada] Add new attribute 'Elab_Subp_Body Message-ID: <20110829085207.GA7238@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 new attribute, similar to 'Elab_Body for a subprogram is used only in CodePeer mode, and corresponds to CodePeer's 'Elab_Subp_Body special init procedure. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-29 Arnaud Charlet * bindgen.adb (Gen_Elab_Calls): Generate calls to subp'Elab_Subp_Body in CodePeer mode. * sem_attr.ads, sem_attr.adb, exp_Attr.adb, sem_ch6.adb: Add handling of Attribute_Elab_Subp_Body. * snames.ads-tmpl (Attribute_Elab_Subp_Body, Name_Elab_Subp_Body): New. * sem_util.adb: Update comments. Index: exp_attr.adb =================================================================== --- exp_attr.adb (revision 178155) +++ exp_attr.adb (working copy) @@ -1813,13 +1813,14 @@ -- and then the Elab_Body/Spec attribute is replaced by a reference -- to this defining identifier. - when Attribute_Elab_Body | - Attribute_Elab_Spec => + when Attribute_Elab_Body | + Attribute_Elab_Subp_Body | + Attribute_Elab_Spec => -- Leave attribute unexpanded in CodePeer mode: the gnat2scil -- back-end knows how to handle this attribute directly. - if CodePeer_Mode then + if CodePeer_Mode or else Id = Attribute_Elab_Subp_Body then return; end if; Index: bindgen.adb =================================================================== --- bindgen.adb (revision 178155) +++ bindgen.adb (working copy) @@ -984,7 +984,12 @@ -- Case of no elaboration code - elsif U.No_Elab then + elsif U.No_Elab + and then (not CodePeer_Mode + or else U.Utype = Is_Spec + or else U.Utype = Is_Spec_Only + or else U.Unit_Kind /= 's') + then -- The only case in which we have to do something is if this -- is a body, with a separate spec, where the separate spec @@ -1019,10 +1024,7 @@ -- The uname_E increment is skipped if this is a separate spec, -- since it will be done when we process the body. - -- Ignore subprograms in CodePeer mode, since no useful - -- elaboration subprogram is needed by CodePeer. - - elsif U.Unit_Kind /= 's' or else not CodePeer_Mode then + else Check_Elab_Flag := not CodePeer_Mode and then (Force_Checking_Of_Elaboration_Flags @@ -1055,12 +1057,18 @@ if Name_Buffer (Name_Len) = 's' then Name_Buffer (Name_Len - 1 .. Name_Len + 8) := "'elab_spec"; + Name_Len := Name_Len + 8; + + elsif U.Unit_Kind = 's' and CodePeer_Mode then + Name_Buffer (Name_Len - 1 .. Name_Len + 13) := + "'elab_subp_body"; + Name_Len := Name_Len + 13; + else Name_Buffer (Name_Len - 1 .. Name_Len + 8) := "'elab_body"; + Name_Len := Name_Len + 8; end if; - - Name_Len := Name_Len + 8; end if; Set_Casing (U.Icasing); Index: sem_util.adb =================================================================== --- sem_util.adb (revision 178157) +++ sem_util.adb (working copy) @@ -7584,9 +7584,9 @@ begin -- Verify that prefix is analyzed and has the proper form. Note that - -- the attributes Elab_Spec, Elab_Body, and UET_Address, which also - -- produce the address of an entity, do not analyze their prefix - -- because they denote entities that are not necessarily visible. + -- the attributes Elab_Spec, Elab_Body, Elab_Subp_Body and UET_Address, + -- which also produce the address of an entity, do not analyze their + -- prefix because they denote entities that are not necessarily visible. -- Neither of them can apply to a protected type. return Ada_Version >= Ada_2005 Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 178155) +++ sem_attr.adb (working copy) @@ -1945,6 +1945,8 @@ and then Aname /= Name_Elab_Spec and then + Aname /= Name_Elab_Subp_Body + and then Aname /= Name_UET_Address and then Aname /= Name_Enabled @@ -3014,7 +3016,10 @@ -- Also handles processing for Elab_Spec - when Attribute_Elab_Body | Attribute_Elab_Spec => + when Attribute_Elab_Body | + Attribute_Elab_Spec | + Attribute_Elab_Subp_Body => + Check_E0; Check_Unit_Name (P); Set_Etype (N, Standard_Void_Type); @@ -7712,6 +7717,7 @@ Attribute_Elaborated | Attribute_Elab_Body | Attribute_Elab_Spec | + Attribute_Elab_Subp_Body | Attribute_Enabled | Attribute_External_Tag | Attribute_Fast_Math | Index: sem_attr.ads =================================================================== --- sem_attr.ads (revision 178155) +++ sem_attr.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -172,6 +172,17 @@ -- Ada code, e.g. if it is necessary to do selective reelaboration to -- fix some error. + -------------------- + -- Elab_Subp_Body -- + -------------------- + + Attribute_Elab_Subp_Body => True, + -- This attribute can only be applied to a library level subprogram + -- name and is only relevant in CodePeer mode. It returns the entity + -- for the corresponding elaboration procedure for elaborating the body + -- of the referenced subprogram unit. This is used in the main generated + -- elaboration procedure by the binder in CodePeer mode only. + --------------- -- Elab_Spec -- --------------- Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 178156) +++ sem_ch6.adb (working copy) @@ -1156,11 +1156,12 @@ end loop; end if; - -- Special processing for Elab_Spec and Elab_Body calls + -- Special processing for Elab_Spec, Elab_Body and Elab_Subp_Body calls if Nkind (P) = N_Attribute_Reference and then (Attribute_Name (P) = Name_Elab_Spec - or else Attribute_Name (P) = Name_Elab_Body) + or else Attribute_Name (P) = Name_Elab_Body + or else Attribute_Name (P) = Name_Elab_Subp_Body) then if Present (Actuals) then Error_Msg_N Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 178156) +++ snames.ads-tmpl (working copy) @@ -882,6 +882,7 @@ First_Entity_Attribute_Name : constant Name_Id := N + $; Name_Elab_Body : constant Name_Id := N + $; -- GNAT Name_Elab_Spec : constant Name_Id := N + $; -- GNAT + Name_Elab_Subp_Body : constant Name_Id := N + $; -- GNAT Name_Storage_Pool : constant Name_Id := N + $; -- These attributes are the ones that return types @@ -1414,6 +1415,7 @@ Attribute_Elab_Body, Attribute_Elab_Spec, + Attribute_Elab_Subp_Body, Attribute_Storage_Pool, -- Type attributes