From patchwork Sun Oct 27 14:05:54 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 2002954 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; unprotected) header.d=netcologne.de header.i=@netcologne.de header.a=rsa-sha256 header.s=nc1116a header.b=XsFqVMuw; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4XbyxP5p6lz1xtp for ; Mon, 28 Oct 2024 01:06:30 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id DA4AE385840B for ; Sun, 27 Oct 2024 14:06:28 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout2.netcologne.de (cc-smtpout2.netcologne.de [IPv6:2001:4dd0:100:1062:25:2:0:2]) by sourceware.org (Postfix) with ESMTPS id 1784E3858D26; Sun, 27 Oct 2024 14:05:59 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1784E3858D26 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=netcologne.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=netcologne.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 1784E3858D26 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2001:4dd0:100:1062:25:2:0:2 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1730037962; cv=none; b=fZoPehOLWb/oIl2eAulCIhMAlWBXXczqk4XDQumqHVoy2o7TmchTi7eipHeAnAyzevAuHY5CAf19rTqS6Xz4tQqTSqmma9fv53BVDSrrCdZ4CpckZIoaxcb3w/hcILuiDyV4bT6Nf0e5ySJp8kYIt4qbhzsMSTt5KwvjbGVFMBA= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1730037962; c=relaxed/simple; bh=eyYmgHWaUUkFOFVHsCjafhJbQY1oGEm4Su+HTrMMSRA=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:From:Subject; b=xqmG/mTrFo8eE/GXAISmKdWkRHB2zDQZSthCp7GLdsMIWAe9iFaylr9ADRh3g5lwPDbsURkX3zZ3XUwUZO+nS7m4kjkYKR+SRGooEHVhDrDTaLx18IZnmYBNfqTYh/B4Os7zJX3s7xmcdo7G0Cdk8BmMkxEkDt/gRqB/9YoTfkY= ARC-Authentication-Results: i=1; server2.sourceware.org Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id ABD7C125C6; Sun, 27 Oct 2024 15:05:57 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=netcologne.de; s=nc1116a; t=1730037957; bh=eyYmgHWaUUkFOFVHsCjafhJbQY1oGEm4Su+HTrMMSRA=; h=Message-ID:Date:To:From:Subject:From; b=XsFqVMuwDsBTw/rSoAHF0ZNtuLN2k+MQh2JbFHMMbWGdh0AqHf9Iq4bVppu5BiA6t F6iKiIXChvmG/lbbiTdnGB1r/IP1dmNjkgM24RLd7azqUVP26BZ+cYQ6c8kezKXHV7 BDNALHanmNMLyOtQuF4mJTV90h/xJ5dam5MrIcJ6TD1zXd+jJEUeyZTlMZMOU6OeJc UEjnO5gFAz0hgQvnUhbIBcLd6ZNl85h0Caz1vsO5Vl01PAkzRFQ+b8ftAcPsMNQSsE 3LwdJ0EQ2CkVWuRk17HaoUezZE3XbHKryigLzHztdMxz55Om3FV18BnV+bIM+y/udI iMsj8UtC7OPtQ== Received: from [IPV6:2001:4dd7:5cd8:0:7767:ce5c:171:bf01] (2001-4dd7-5cd8-0-7767-ce5c-171-bf01.ipv6dyn.netcologne.de [IPv6:2001:4dd7:5cd8:0:7767:ce5c:171:bf01]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA id 61E8311D87; Sun, 27 Oct 2024 15:05:55 +0100 (CET) Message-ID: Date: Sun, 27 Oct 2024 15:05:54 +0100 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird Content-Language: en-US, de-DE To: "fortran@gcc.gnu.org" , gcc-patches , Peter Klausler From: Thomas Koenig Subject: [patch, Fortran] Introduce unsigned versions of MASKL and MASKR X-NetCologne-Spam: L X-Rspamd-Queue-Id: 61E8311D87 X-Spamd-Bar: / X-Rspamd-Action: no action X-Spam-Status: No, score=-9.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org Hello world, MASKR and MASKL are obvious candidates for unsigned, too; in the previous version of the doc patch, I had promised that these would take unsigned arguments in the future. What I had in mind was they could take an unsigned argument and return an unsigned result. Thinking about this a bit more, I realized that this was actually a bad idea; nowhere else do we allow UNSIGNED for bit counting, and things like checking for negative number of bits (which is illegal) would not work. Hence, two new intrinsics, UMASKL and UMASKR. Regressoin-tesed (and this time, I added the intrinsics to the list, so no trouble expected there :-) OK for trunk? Best regards Thomas gcc/fortran/ChangeLog: * check.cc (gfc_check_mask): Handle BT_INSIGNED. * gfortran.h (enum gfc_isym_id): Add GFC_ISYM_UMASKL and GFC_ISYM_UMASKR. * gfortran.texi: List UMASKL and UMASKR, remove unsigned future unsigned arguments for MASKL and MASKR. * intrinsic.cc (add_functions): Add UMASKL and UMASKR. * intrinsic.h (gfc_simplify_umaskl): New function. (gfc_simplify_umaskr): New function. (gfc_resolve_umasklr): New function. * intrinsic.texi: Document UMASKL and UMASKR. * iresolve.cc (gfc_resolve_umasklr): New function. * simplify.cc (gfc_simplify_umaskr): New function. (gfc_simplify_umaskl): New function. gcc/testsuite/ChangeLog: * gfortran.dg/unsigned_39.f90: New test. diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc index 304ca1b9ae8..2d4af8e7df3 100644 --- a/gcc/fortran/check.cc +++ b/gcc/fortran/check.cc @@ -4466,7 +4466,12 @@ gfc_check_mask (gfc_expr *i, gfc_expr *kind) { int k; - if (!type_check (i, 0, BT_INTEGER)) + if (flag_unsigned) + { + if (!type_check2 (i, 0, BT_INTEGER, BT_UNSIGNED)) + return false; + } + else if (!type_check (i, 0, BT_INTEGER)) return false; if (!nonnegative_check ("I", i)) @@ -4478,7 +4483,7 @@ gfc_check_mask (gfc_expr *i, gfc_expr *kind) if (kind) gfc_extract_int (kind, &k); else - k = gfc_default_integer_kind; + k = i->ts.type == BT_UNSIGNED ? gfc_default_unsigned_kind : gfc_default_integer_kind; if (!less_than_bitsizekind ("I", i, k)) return false; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index dd599bc97a2..309095d74d5 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -699,6 +699,8 @@ enum gfc_isym_id GFC_ISYM_UBOUND, GFC_ISYM_UCOBOUND, GFC_ISYM_UMASK, + GFC_ISYM_UMASKL, + GFC_ISYM_UMASKR, GFC_ISYM_UNLINK, GFC_ISYM_UNPACK, GFC_ISYM_VERIFY, diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index 3b2691649b0..429d8461f8f 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -2825,16 +2825,11 @@ The following intrinsics take unsigned arguments: The following intinsics are enabled with @option{-funsigned}: @itemize @bullet @item @code{UINT}, @pxref{UINT} +@item @code{UMASKL}, @pxref{UMASKL} +@item @code{UMASKR}, @pxref{UMASKR} @item @code{SELECTED_UNSIGNED_KIND}, @pxref{SELECTED_UNSIGNED_KIND} @end itemize -The following intrinsics will take unsigned arguments -in the future: -@itemize @bullet -@item @code{MASKL}, @pxref{MASKL} -@item @code{MASKR}, @pxref{MASKR} -@end itemize - The following intrinsics are not yet implemented in GNU Fortran, but will take unsigned arguments once they have been: @itemize @bullet diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc index 83b65d34e43..3fb1c63bbd4 100644 --- a/gcc/fortran/intrinsic.cc +++ b/gcc/fortran/intrinsic.cc @@ -2568,6 +2568,22 @@ add_functions (void) make_generic ("maskr", GFC_ISYM_MASKR, GFC_STD_F2008); + add_sym_2 ("umaskl", GFC_ISYM_UMASKL, CLASS_ELEMENTAL, ACTUAL_NO, + BT_INTEGER, di, GFC_STD_F2008, + gfc_check_mask, gfc_simplify_umaskl, gfc_resolve_umasklr, + i, BT_INTEGER, di, REQUIRED, + kind, BT_INTEGER, di, OPTIONAL); + + make_generic ("umaskl", GFC_ISYM_UMASKL, GFC_STD_F2008); + + add_sym_2 ("umaskr", GFC_ISYM_UMASKR, CLASS_ELEMENTAL, ACTUAL_NO, + BT_INTEGER, di, GFC_STD_F2008, + gfc_check_mask, gfc_simplify_umaskr, gfc_resolve_umasklr, + i, BT_INTEGER, di, REQUIRED, + kind, BT_INTEGER, di, OPTIONAL); + + make_generic ("umaskr", GFC_ISYM_UMASKR, GFC_STD_F2008); + add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul, ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index ea29219819d..61d85eedc69 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -434,6 +434,8 @@ gfc_expr *gfc_simplify_transpose (gfc_expr *); gfc_expr *gfc_simplify_trim (gfc_expr *); gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ucobound (gfc_expr *, gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_umaskl (gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_umaskr (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_unpack (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_xor (gfc_expr *, gfc_expr *); @@ -566,6 +568,7 @@ void gfc_resolve_maxval (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_mclock (gfc_expr *); void gfc_resolve_mclock8 (gfc_expr *); void gfc_resolve_mask (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_umasklr (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_merge (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_min (gfc_expr *, gfc_actual_arglist *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index f47fa3bbd5e..9d0b752670b 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -323,6 +323,8 @@ Some basic guidelines for editing this document: * @code{UCOBOUND}: UCOBOUND, Upper codimension bounds of an array * @code{UINT}: UINT, Convert to an unsigned integer type * @code{UMASK}: UMASK, Set the file creation mask +* @code{UMASKL}: UMASKL, Unsigned left justified mask +* @code{UMASKR}: UMASKR, Unsigned right justified mask * @code{UNLINK}: UNLINK, Remove a file from the file system * @code{UNPACK}: UNPACK, Unpack an array of rank one into an array * @code{VERIFY}: VERIFY, Scan a string for the absence of a set of characters @@ -14964,6 +14966,79 @@ Subroutine, function @end table +@node UMASKL +@section @code{UMASKL} --- Unsigned left justified mask +@fnindex UMASKL +@cindex mask, left justified + +@table @asis +@item @emph{Description}: +@code{UMASKL(I[, KIND])} has its leftmost @var{I} bits set to 1, and the +remaining bits set to 0. + +@item @emph{Standard}: +Extension (@pxref{Unsigned integers}) + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = UMASKL(I[, KIND])} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{I} @tab Shall be of type @code{UNSIGNED}. +@item @var{KIND} @tab Shall be a scalar constant expression of type +@code{INTEGER}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{UNSIGNED}. If @var{KIND} is present, it +specifies the kind value of the return type; otherwise, it is of the +default unsigned kind. + +@item @emph{See also}: +@ref{MASKL}, @* +@ref{MASKR}, @* +@ref{UMASKR} +@end table + +@node UMASKR +@section @code{UMASKR} --- Unsigned right justified mask +@fnindex UMASKR +@cindex mask, right justified + +@table @asis +@item @emph{Description}: +@code{UMASKL(I[, KIND])} has its rightmost @var{I} bits set to 1, and the +remaining bits set to 0. + +@item @emph{Standard}: +Extension (@pxref{Unsigned integers}) + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = MASKR(I[, KIND])} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{I} @tab Shall be of type @code{UNSIGNED}. +@item @var{KIND} @tab Shall be a scalar constant expression of type +@code{INTEGER}. +@end multitable + +@item @emph{Return value}: +The return value is of type @code{UNSIGNED}. If @var{KIND} is present, it +specifies the kind value of the return type; otherwise, it is of the +default integer kind. + +@item @emph{See also}: +@ref{MASKL}, @* +@ref{MASKR}, @* +@ref{UMASKL} +@end table @node UNLINK diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc index d8b216bcc67..6adc63043eb 100644 --- a/gcc/fortran/iresolve.cc +++ b/gcc/fortran/iresolve.cc @@ -2012,6 +2012,20 @@ gfc_resolve_mask (gfc_expr *f, gfc_expr *i ATTRIBUTE_UNUSED, f->value.function.name = gfc_get_string ("__maskr_i%d", f->ts.kind); } +void +gfc_resolve_umasklr (gfc_expr *f, gfc_expr *i ATTRIBUTE_UNUSED, + gfc_expr *kind) +{ + f->ts.type = BT_UNSIGNED; + f->ts.kind = kind ? mpz_get_si (kind->value.integer) + : gfc_default_unsigned_kind; + + if (f->value.function.isym->id == GFC_ISYM_UMASKL) + f->value.function.name = gfc_get_string ("__maskl_m%d", f->ts.kind); + else + f->value.function.name = gfc_get_string ("__maskr_m%d", f->ts.kind); +} + void gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource, diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 1e2fa3eb8ea..573ec6bd3a8 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -5200,6 +5200,84 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg) return result; } +/* Similar to gfc_simplify_maskr, but code paths are different enough to make + this into a separate function. */ + +gfc_expr * +gfc_simplify_umaskr (gfc_expr *i, gfc_expr *kind_arg) +{ + gfc_expr *result; + int kind, arg, k; + + if (i->expr_type != EXPR_CONSTANT) + return NULL; + + kind = get_kind (BT_UNSIGNED, kind_arg, "UMASKR", gfc_default_unsigned_kind); + if (kind == -1) + return &gfc_bad_expr; + k = gfc_validate_kind (BT_UNSIGNED, kind, false); + + bool fail = gfc_extract_int (i, &arg); + gcc_assert (!fail); + + if (!gfc_check_mask (i, kind_arg)) + return &gfc_bad_expr; + + result = gfc_get_constant_expr (BT_UNSIGNED, kind, &i->where); + + /* MASKR(n) = 2^n - 1 */ + mpz_set_ui (result->value.integer, 1); + mpz_mul_2exp (result->value.integer, result->value.integer, arg); + mpz_sub_ui (result->value.integer, result->value.integer, 1); + + gfc_convert_mpz_to_unsigned (result->value.integer, + gfc_unsigned_kinds[k].bit_size, + false); + + return result; +} + +/* Likewise, similar to gfc_simplify_maskl. */ + +gfc_expr * +gfc_simplify_umaskl (gfc_expr *i, gfc_expr *kind_arg) +{ + gfc_expr *result; + int kind, arg, k; + mpz_t z; + + if (i->expr_type != EXPR_CONSTANT) + return NULL; + + kind = get_kind (BT_UNSIGNED, kind_arg, "UMASKL", gfc_default_integer_kind); + if (kind == -1) + return &gfc_bad_expr; + k = gfc_validate_kind (BT_UNSIGNED, kind, false); + + bool fail = gfc_extract_int (i, &arg); + gcc_assert (!fail); + + if (!gfc_check_mask (i, kind_arg)) + return &gfc_bad_expr; + + result = gfc_get_constant_expr (BT_UNSIGNED, kind, &i->where); + + /* MASKL(n) = 2^bit_size - 2^(bit_size - n) */ + mpz_init_set_ui (z, 1); + mpz_mul_2exp (z, z, gfc_unsigned_kinds[k].bit_size); + mpz_set_ui (result->value.integer, 1); + mpz_mul_2exp (result->value.integer, result->value.integer, + gfc_integer_kinds[k].bit_size - arg); + mpz_sub (result->value.integer, z, result->value.integer); + mpz_clear (z); + + gfc_convert_mpz_to_unsigned (result->value.integer, + gfc_unsigned_kinds[k].bit_size, + false); + + return result; +} + gfc_expr * gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask) diff --git a/gcc/testsuite/gfortran.dg/unsigned_39.f90 b/gcc/testsuite/gfortran.dg/unsigned_39.f90 new file mode 100644 index 00000000000..47c2174b1cc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unsigned_39.f90 @@ -0,0 +1,29 @@ +! { dg-do run } +! { dg-options "-funsigned" } +program memain + use iso_fortran_env, only : uint8, uint32 + implicit none + call test1 + call test2 +contains + subroutine test1 + unsigned(uint32) :: u1, u2 + unsigned(uint8), dimension(3,3) :: v1, v2 + u1 = umaskr(3) + if (u1 /= 7u) error stop 1 + u2 = umaskl(2) + if (u2 /= 3221225472u) error stop 2 + v1 = umaskr(5,uint8) + if (any(v1 /= 31u)) error stop 3 + v2 = umaskl(5,uint8) + if (any(v2 /= 248u_uint8)) error stop 4 + end subroutine test1 + subroutine test2 + unsigned(uint32), parameter :: u1 = umaskr(3), u2=umaskl(2) + unsigned(uint8), dimension(3,3) :: v1 = umaskr(5,uint8), v2 = umaskl(5,uint8) + if (u1 /= 7u) error stop 11 + if (u2 /= 3221225472u) error stop 12 + if (any(v1 /= 31u)) error stop 13 + if (any(v2 /= 248u_uint8)) error stop 14 + end subroutine test2 +end program memain