This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Fix pessimization with constants


Ada has the equivalent of the C "const" keyword, namely "constant", and a 
special circuitry is implemented in Gigi to propagate such constants when
it is deemed safe and profitable to do so.  It was recently enhanced to
also propagate constant aggregates, which in turn required counter-measures
to avoid duplicating big chunks of data.

One of these counter-measures introduced a pessimization, whereby

   Val : constant Integer := 1;

would not be propagated into

   type Vars_Array is array (Integer range 1 .. 2) of Integer;
   Vars : Vars_Array;
   
   A : System.Address := Vars (Val)'Address;

anymore because of the 'Address attribute.


The fix is to disregard 'Address for the index of an array reference.


Bootstrapped/regtested on i586-suse-linux, applied on the mainline.


2007-12-05  Eric Botcazou  <ebotcazou@adacore.com>

        * trans.c (lvalue_required_p): Take base node directly instead
        of its parent.  Rename second parameter to 'gnu_type'.
        <N_Indexed_Component>: Return 0 if the node isn't the prefix.
        <N_Slice>: Likewise.
        (Identifier_to_gnu): Rename parent_requires_lvalue to require_lvalue.
        Adjust calls to lvalue_required_p.


2007-12-05  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/elab1.ads: New test.


-- 
Eric Botcazou
Index: trans.c
===================================================================
--- trans.c	(revision 130581)
+++ trans.c	(working copy)
@@ -379,22 +379,29 @@ gigi (Node_Id gnat_root, int max_gnat_no
   error_gnat_node = Empty;
 }
 
-/* Returns a positive value if GNAT_NODE requires an lvalue for an
-   operand of OPERAND_TYPE, whose aliasing is specified by ALIASED,
-   zero otherwise.  This is int instead of bool to facilitate usage
-   in non purely binary logic contexts.  */
+/* Return a positive value if an lvalue is required for GNAT_NODE.
+   GNU_TYPE is the type that will be used for GNAT_NODE in the
+   translated GNU tree.  ALIASED indicates whether the underlying
+   object represented by GNAT_NODE is aliased in the Ada sense.
+
+   The function climbs up the GNAT tree starting from the node and
+   returns 1 upon encountering a node that effectively requires an
+   lvalue downstream.  It returns int instead of bool to facilitate
+   usage in non purely binary logic contexts.  */
 
 static int
-lvalue_required_p (Node_Id gnat_node, tree operand_type, int aliased)
+lvalue_required_p (Node_Id gnat_node, tree gnu_type, int aliased)
 {
-  switch (Nkind (gnat_node))
+  Node_Id gnat_parent = Parent (gnat_node), gnat_temp;
+
+  switch (Nkind (gnat_parent))
     {
     case N_Reference:
       return 1;
 
     case N_Attribute_Reference:
       {
-	unsigned char id = Get_Attribute_Id (Attribute_Name (gnat_node));
+	unsigned char id = Get_Attribute_Id (Attribute_Name (gnat_parent));
 	return id == Attr_Address
 	       || id == Attr_Access
 	       || id == Attr_Unchecked_Access
@@ -404,32 +411,36 @@ lvalue_required_p (Node_Id gnat_node, tr
     case N_Parameter_Association:
     case N_Function_Call:
     case N_Procedure_Call_Statement:
-      return must_pass_by_ref (operand_type)
-	     || default_pass_by_ref (operand_type);
+      return (must_pass_by_ref (gnu_type) || default_pass_by_ref (gnu_type));
 
     case N_Indexed_Component:
-      {
-	Node_Id gnat_temp;
-	/* ??? Consider that referencing an indexed component with a
-	   non-constant index forces the whole aggregate to memory.
-	   Note that N_Integer_Literal is conservative, any static
-	   expression in the RM sense could probably be accepted.  */
-	for (gnat_temp = First (Expressions (gnat_node));
-	     Present (gnat_temp);
-	     gnat_temp = Next (gnat_temp))
-	  if (Nkind (gnat_temp) != N_Integer_Literal)
-	    return 1;
-      }
+      /* Only the array expression can require an lvalue.  */
+      if (Prefix (gnat_parent) != gnat_node)
+	return 0;
+
+      /* ??? Consider that referencing an indexed component with a
+	 non-constant index forces the whole aggregate to memory.
+	 Note that N_Integer_Literal is conservative, any static
+	 expression in the RM sense could probably be accepted.  */
+      for (gnat_temp = First (Expressions (gnat_parent));
+	   Present (gnat_temp);
+	   gnat_temp = Next (gnat_temp))
+	if (Nkind (gnat_temp) != N_Integer_Literal)
+	  return 1;
 
       /* ... fall through ... */
 
     case N_Slice:
-      aliased |= Has_Aliased_Components (Etype (Prefix (gnat_node)));
-      return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
+      /* Only the array expression can require an lvalue.  */
+      if (Prefix (gnat_parent) != gnat_node)
+	return 0;
+
+      aliased |= Has_Aliased_Components (Etype (gnat_node));
+      return lvalue_required_p (gnat_parent, gnu_type, aliased);
 
     case N_Selected_Component:
-      aliased |= Is_Aliased (Entity (Selector_Name (gnat_node)));
-      return lvalue_required_p (Parent (gnat_node), operand_type, aliased);
+      aliased |= Is_Aliased (Entity (Selector_Name (gnat_parent)));
+      return lvalue_required_p (gnat_parent, gnu_type, aliased);
 
     case N_Object_Renaming_Declaration:
       /* We need to make a real renaming only if the constant object is
@@ -439,8 +450,8 @@ lvalue_required_p (Node_Id gnat_node, tr
 	 attached to the CONST_DECL.  */
       return (aliased != 0
 	      /* This should match the constant case of the renaming code.  */
-	      || Is_Composite_Type (Etype (Name (gnat_node)))
-	      || Nkind (Name (gnat_node)) == N_Identifier);
+	      || Is_Composite_Type (Etype (Name (gnat_parent)))
+	      || Nkind (Name (gnat_parent)) == N_Identifier);
 
     default:
       return 0;
@@ -450,20 +461,19 @@ lvalue_required_p (Node_Id gnat_node, tr
 }
 
 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
-   to a GCC tree, which is returned.  GNU_RESULT_TYPE_P is a pointer to
-   where we should place the result type.  */
+   to a GCC tree, which is returned.  GNU_RESULT_TYPE_P is a pointer
+   to where we should place the result type.  */
 
 static tree
 Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 {
-  tree gnu_result_type;
-  tree gnu_result;
   Node_Id gnat_temp, gnat_temp_type;
+  tree gnu_result, gnu_result_type;
 
-  /* Whether the parent of gnat_node requires an lvalue.  Needed in
-     specific circumstances only, so evaluated lazily.  < 0 means unknown,
-     > 0 means known true, 0 means known false.  */
-  int parent_requires_lvalue = -1;
+  /* Whether we should require an lvalue for GNAT_NODE.  Needed in
+     specific circumstances only, so evaluated lazily.  < 0 means
+     unknown, > 0 means known true, 0 means known false.  */
+  int require_lvalue = -1;
 
   /* If GNAT_NODE is a constant, whether we should use the initialization
      value instead of the constant entity, typically for scalars with an
@@ -539,9 +549,9 @@ Identifier_to_gnu (Node_Id gnat_node, tr
   gnu_result_type = get_unpadded_type (gnat_temp_type);
 
   /* If this is a non-imported scalar constant with an address clause,
-     retrieve the value instead of a pointer to be dereferenced unless the
-     parent requires an lvalue.  This is generally more efficient and
-     actually required if this is a static expression because it might be used
+     retrieve the value instead of a pointer to be dereferenced unless
+     an lvalue is required.  This is generally more efficient and actually
+     required if this is a static expression because it might be used
      in a context where a dereference is inappropriate, such as a case
      statement alternative or a record discriminant.  There is no possible
      volatile-ness shortciruit here since Volatile constants must be imported
@@ -550,10 +560,9 @@ Identifier_to_gnu (Node_Id gnat_node, tr
       && !Is_Imported (gnat_temp)
       && Present (Address_Clause (gnat_temp)))
     {
-      parent_requires_lvalue
-	= lvalue_required_p (Parent (gnat_node), gnu_result_type,
-			     Is_Aliased (gnat_temp));
-      use_constant_initializer = !parent_requires_lvalue;
+      require_lvalue = lvalue_required_p (gnat_node, gnu_result_type,
+					  Is_Aliased (gnat_temp));
+      use_constant_initializer = !require_lvalue;
     }
 
   if (use_constant_initializer)
@@ -646,21 +655,21 @@ Identifier_to_gnu (Node_Id gnat_node, tr
      of places and the need of elaboration code if this Id is used as
      an initializer itself.  */
   if (TREE_CONSTANT (gnu_result)
-      && DECL_P (gnu_result) && DECL_INITIAL (gnu_result))
+      && DECL_P (gnu_result)
+      && DECL_INITIAL (gnu_result))
     {
       tree object
 	= (TREE_CODE (gnu_result) == CONST_DECL
 	   ? DECL_CONST_CORRESPONDING_VAR (gnu_result) : gnu_result);
 
-      /* If there is a corresponding variable, we only want to return the CST
-	 value if the parent doesn't require an lvalue.  Evaluate this now if
-	 we have not already done so.  */
-      if (object && parent_requires_lvalue < 0)
-	parent_requires_lvalue
-	  = lvalue_required_p (Parent (gnat_node), gnu_result_type,
-			       Is_Aliased (gnat_temp));
+      /* If there is a corresponding variable, we only want to return
+	 the CST value if an lvalue is not required.  Evaluate this
+	 now if we have not already done so.  */
+      if (object && require_lvalue < 0)
+	require_lvalue = lvalue_required_p (gnat_node, gnu_result_type,
+					    Is_Aliased (gnat_temp));
 
-      if (!object || !parent_requires_lvalue)
+      if (!object || !require_lvalue)
 	gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
     }
 
-- { dg-do compile }

pragma Restrictions(No_Elaboration_Code);

with System;

package Elab1 is

   type Ptrs_Type is array (Integer range 1 .. 2) of System.Address;
   type Vars_Array is array (Integer range 1 .. 2) of Integer;

   Vars : Vars_Array;

   Val1 : constant Integer := 1;
   Val2 : constant Integer := 2;

   Ptrs : constant Ptrs_Type :=
     (1  => Vars (Val1)'Address,
      2  => Vars (Val2)'Address);

end Elab1;

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]