Patchwork [Ada] Elaboration of expressions in address clauses

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 5, 2010, 9:19 a.m.
Message ID <20100805091904.GA7746@adacore.com>
Download mbox | patch
Permalink /patch/60940/
State New
Headers show

Comments

Arnaud Charlet - Aug. 5, 2010, 9:19 a.m.
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  <schonberg@adacore.com>

	* 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.

Patch

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;