From patchwork Fri Sep 8 13:36:20 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 811595 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-461728-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="v2BkCyUF"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3xpddX66jfz9s7p for ; Fri, 8 Sep 2017 23:36:32 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=kK2DoIYQXs8vTQvq/+psPiHk00ddR20NiEJ/Ez6FVGXLCb4ywa 3X2siYdvs4Aqfw29nCbzUFVzQ2I6sqMzmzrGM7ME9SdfQQLAtBVEIq3DAOitCAy9 KbexWfVhCzmcA7nm7DfC+HyEul0QqHb76ATAxMw3VPnaKQKtFiQRQElZc= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=DYBujd9RTqNpAVw4nUNbu8FF8z0=; b=v2BkCyUFmlYtZl+W/xOF Ll57Q8QlX9SwFuidQXYweUpRvVSxKcgRdJsVjnmgkd4Ejg4TyETaAQVP2TabNZWp EZGAwI/E8/aQHvVe7sg81dUcsC505uLWjIXIwLfgyaxod2wVdzYnvtQKP9igrkv5 8FmhUYj+mSzkercWZkqzHVY= Received: (qmail 44283 invoked by alias); 8 Sep 2017 13:36:23 -0000 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 Received: (qmail 44052 invoked by uid 89); 8 Sep 2017 13:36:23 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.5 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy= X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 08 Sep 2017 13:36:21 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 80F275628A; Fri, 8 Sep 2017 09:36:20 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id VmPmCWbg0mG4; Fri, 8 Sep 2017 09:36:20 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 7065856285; Fri, 8 Sep 2017 09:36:20 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 6F5964A4; Fri, 8 Sep 2017 09:36:20 -0400 (EDT) Date: Fri, 8 Sep 2017 09:36:20 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Extend efficient array reset to all elementary types Message-ID: <20170908133620.GA100539@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) 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 * 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) : 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,