From patchwork Thu Aug 5 09:19:04 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 60940 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 E3246B6ED0 for ; Thu, 5 Aug 2010 19:19:16 +1000 (EST) Received: (qmail 25397 invoked by alias); 5 Aug 2010 09:19:14 -0000 Received: (qmail 25385 invoked by uid 22791); 5 Aug 2010 09:19:12 -0000 X-SWARE-Spam-Status: No, hits=-0.9 required=5.0 tests=AWL, BAYES_40, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 05 Aug 2010 09:19:07 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id B9CC0CB0253; Thu, 5 Aug 2010 11:19:04 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id KXG1qRugxNtj; Thu, 5 Aug 2010 11:19:04 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id A2F87CB0242; Thu, 5 Aug 2010 11:19:04 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 72E08D9BB4; Thu, 5 Aug 2010 11:19:04 +0200 (CEST) Date: Thu, 5 Aug 2010 11:19:04 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Elaboration of expressions in address clauses Message-ID: <20100805091904.GA7746@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 If an object has an address clause, we defer its freeze point because a subsequent Import pragma for it may affect its elaboration. However, the address expression itself must not be deferred because it may have side-effects and this must appear at the proper place in the elaboration code. This patch creates a constant declaration for the expression in an address clause whenever this is legal, so that this expression is elaborated where it appears, and not at the freeze point of the object to which it applies. The following must compile and execute quietly: with Pack; use Pack; procedure Check_Init is begin if not Done then raise Program_Error; end if; end; --- with System; package Addr is function Find_Place return System.Address; function Report return Boolean; end Addr; --- package body Addr is Anchor : Integer := 0; function Find_Place return System.Address is begin Anchor := 111; return Anchor'Address; end Find_Place; function Report return Boolean is begin return Anchor = 111; end; end Addr; --- with Addr; use Addr; package Pack is Var1 : Integer; for Var1'address use Find_Place; Done : Boolean := Report; Var2 : Integer; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-08-05 Ed Schonberg * exp_util.ads, exp_util.adb (Needs_Constant_Address): New predicate to determine whether the expression in an address clause for an initialized object must be constant. Code moved from freeze.adb. (Remove_Side_Effects): When the temporary is initialized with a reference, indicate that the temporary is a constant as done in all other cases. * freeze.adb (Check_Address_Clause): use Needs_Constant_Address. * exp_ch13.adb (Expand_N_Attribute_Definition_Clause, case 'Address): If object does not need a constant address, remove side effects from address expression, so it is elaborated at the point of the address clause and not at the freeze point of the object, so that elaboration order is respected. Index: exp_util.adb =================================================================== --- exp_util.adb (revision 162905) +++ exp_util.adb (working copy) @@ -4159,6 +4159,61 @@ package body Exp_Util is end May_Generate_Large_Temp; ---------------------------- + -- Needs_Constant_Address -- + ---------------------------- + + function Needs_Constant_Address + (Decl : Node_Id; + Typ : Entity_Id) return Boolean + is + begin + + -- If we have no initialization of any kind, then we don't need to + -- place any restrictions on the address clause, because the object + -- will be elaborated after the address clause is evaluated. This + -- happens if the declaration has no initial expression, or the type + -- has no implicit initialization, or the object is imported. + + -- The same holds for all initialized scalar types and all access + -- types. Packed bit arrays of size up to 64 are represented using a + -- modular type with an initialization (to zero) and can be processed + -- like other initialized scalar types. + + -- If the type is controlled, code to attach the object to a + -- finalization chain is generated at the point of declaration, + -- and therefore the elaboration of the object cannot be delayed: + -- the address expression must be a constant. + + if No (Expression (Decl)) + and then not Needs_Finalization (Typ) + and then + (not Has_Non_Null_Base_Init_Proc (Typ) + or else Is_Imported (Defining_Identifier (Decl))) + then + return False; + + elsif (Present (Expression (Decl)) and then Is_Scalar_Type (Typ)) + or else Is_Access_Type (Typ) + or else + (Is_Bit_Packed_Array (Typ) + and then Is_Modular_Integer_Type (Packed_Array_Type (Typ))) + then + return False; + + else + + -- Otherwise, we require the address clause to be constant because + -- the call to the initialization procedure (or the attach code) has + -- to happen at the point of the declaration. + + -- Actually the IP call has been moved to the freeze actions + -- anyway, so maybe we can relax this restriction??? + + return True; + end if; + end Needs_Constant_Address; + + ---------------------------- -- New_Class_Wide_Subtype -- ---------------------------- @@ -4946,6 +5001,7 @@ package body Exp_Util is Make_Object_Declaration (Loc, Defining_Identifier => Def_Id, Object_Definition => New_Reference_To (Ref_Type, Loc), + Constant_Present => True, Expression => New_Exp)); end if; Index: exp_util.ads =================================================================== --- exp_util.ads (revision 162866) +++ exp_util.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -575,6 +575,13 @@ package Exp_Util is -- caller has to check whether stack checking is actually enabled in order -- to guide the expansion (typically of a function call). + function Needs_Constant_Address + (Decl : Node_Id; + Typ : Entity_Id) return Boolean; + -- Check whether the expression in an address clause is restricted to + -- consist of constants, when the object has a non-trivial initialization + -- or is controlled. + function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id; -- An anonymous access type may designate a limited view. Check whether -- non-limited view is available during expansion, to examine components Index: freeze.adb =================================================================== --- freeze.adb (revision 162866) +++ freeze.adb (working copy) @@ -544,42 +544,7 @@ package body Freeze is if Present (Addr) then Expr := Expression (Addr); - -- If we have no initialization of any kind, then we don't need to - -- place any restrictions on the address clause, because the object - -- will be elaborated after the address clause is evaluated. This - -- happens if the declaration has no initial expression, or the type - -- has no implicit initialization, or the object is imported. - - -- The same holds for all initialized scalar types and all access - -- types. Packed bit arrays of size up to 64 are represented using a - -- modular type with an initialization (to zero) and can be processed - -- like other initialized scalar types. - - -- If the type is controlled, code to attach the object to a - -- finalization chain is generated at the point of declaration, - -- and therefore the elaboration of the object cannot be delayed: - -- the address expression must be a constant. - - if (No (Expression (Decl)) - and then not Needs_Finalization (Typ) - and then (not Has_Non_Null_Base_Init_Proc (Typ) - or else Is_Imported (E))) - or else (Present (Expression (Decl)) and then Is_Scalar_Type (Typ)) - or else Is_Access_Type (Typ) - or else - (Is_Bit_Packed_Array (Typ) - and then Is_Modular_Integer_Type (Packed_Array_Type (Typ))) - then - null; - - -- Otherwise, we require the address clause to be constant because - -- the call to the initialization procedure (or the attach code) has - -- to happen at the point of the declaration. - - -- Actually the IP call has been moved to the freeze actions - -- anyway, so maybe we can relax this restriction??? - - else + if Needs_Constant_Address (Decl, Typ) then Check_Constant_Address_Clause (Expr, E); -- Has_Delayed_Freeze was set on E when the address clause was Index: exp_ch13.adb =================================================================== --- exp_ch13.adb (revision 162866) +++ exp_ch13.adb (working copy) @@ -127,6 +127,16 @@ package body Exp_Ch13 is else Set_Expression (Decl, Empty); end if; + + -- An object declaration to which an address clause applies + -- has a delayed freeze, but the address expression itself + -- must be elaborated at the point it appears. If the object + -- is controlled, additional checks apply elsewhere. + + elsif Nkind (Decl) = N_Object_Declaration + and then not Needs_Constant_Address (Decl, Typ) + then + Remove_Side_Effects (Exp); end if; end;