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 <ebotca...@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.
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,
