[Ada] Extend efficient array reset to all elementary types

Message ID 20170908133620.GA100539@adacore.com
State New
Headers show
Series
  • [Ada] Extend efficient array reset to all elementary types
Related show

Commit Message

Arnaud Charlet Sept. 8, 2017, 1:36 p.m.
This change extends the efficient handling of an array reset to 0 by means
of an aggregate with a single Others choice from a discrete component type
to any elementary type.

The 3 instances of the Reset procedure below must invoke memset:

with G;

package P is

  subtype Index is Positive range 1 .. 128;

  type Ptr is access all Integer;

  package My_G_I is new G (Index, Integer, 0);

  package My_G_F is new G (Index, Float, 0.0);

  package My_G_P is new G (Index, Ptr, null);

end P;

generic

  type Header_Num is range <>;

  type Element is private;

  Null_Element : Element;

package G is

  procedure Reset;

end G;

package body G is

  Table : array (Header_Num) of Element;

  procedure Reset is
  begin
    Table := (others => Null_Element);
  end;
  
end G;

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-09-08  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb: Add with & use clause for Urealp.
	(Aggr_Assignment_OK_For_Backend): Accept (almost all)
	elementary types instead of just discrete types.
	* sem_eval.adb (Expr_Value): Deal with N_Null for access types.
	* gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>:
	Be prepared for the FP zero value in the memset case.  Add small
	guard.

Patch

Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb	(revision 251893)
+++ exp_aggr.adb	(working copy)
@@ -61,6 +61,7 @@ 
 with Stringt;  use Stringt;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
+with Urealp;   use Urealp;
 
 package body Exp_Aggr is
 
@@ -4894,7 +4895,7 @@ 
       --    4. The array type has no null ranges (the purpose of this is to
       --       avoid a bogus warning for an out-of-range value).
 
-      --    5. The component type is discrete
+      --    5. The component type is elementary
 
       --    6. The component size is Storage_Unit or the value is of the form
       --       M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)
@@ -4970,7 +4971,13 @@ 
             return False;
          end if;
 
-         if not Is_Discrete_Type (Ctyp) then
+         --  All elementary types are supported except for fat pointers
+         --  because they are not really elementary for the backend.
+
+         if not Is_Elementary_Type (Ctyp)
+           or else (Is_Access_Type (Ctyp)
+                     and then Esize (Ctyp) /= System_Address_Size)
+         then
             return False;
          end if;
 
@@ -4990,6 +4997,14 @@ 
             return False;
          end if;
 
+         --  The only supported value for floating point is 0.0
+
+         if Is_Floating_Point_Type (Ctyp) then
+            return Expr_Value_R (Expr) = Ureal_0;
+         end if;
+
+         --  For other types, we can look into the value as an integer
+
          Value := Expr_Value (Expr);
 
          if Has_Biased_Representation (Ctyp) then
Index: sem_eval.adb
===================================================================
--- sem_eval.adb	(revision 251892)
+++ sem_eval.adb	(working copy)
@@ -4199,6 +4199,12 @@ 
          pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N))));
          Val := Corresponding_Integer_Value (N);
 
+      --  The NULL access value
+
+      elsif Kind = N_Null then
+         pragma Assert (Is_Access_Type (Underlying_Type (Etype (N))));
+         Val := Uint_0;
+
       --  Otherwise must be character literal
 
       else
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 251892)
+++ gcc-interface/trans.c	(working copy)
@@ -7037,14 +7037,17 @@ 
 	  /* Or else, use memset when the conditions are met.  */
 	  else if (use_memset_p)
 	    {
-	      tree value = fold_convert (integer_type_node, gnu_rhs);
+	      tree value
+		= real_zerop (gnu_rhs)
+		  ? integer_zero_node
+		  : fold_convert (integer_type_node, gnu_rhs);
 	      tree to = gnu_lhs;
 	      tree type = TREE_TYPE (to);
 	      tree size
 	        = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (type), to);
 	      tree to_ptr = build_fold_addr_expr (to);
 	      tree t = builtin_decl_explicit (BUILT_IN_MEMSET);
-	      if (TREE_CODE (value) == INTEGER_CST)
+	      if (TREE_CODE (value) == INTEGER_CST && !integer_zerop (value))
 		{
 		  tree mask
 		    = build_int_cst (integer_type_node,