aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/simplify.cc
diff options
context:
space:
mode:
authorThomas Koenig <tkoenig@gcc.gnu.org>2024-10-29 21:08:59 +0100
committerThomas Koenig <tkoenig@gcc.gnu.org>2024-11-02 19:20:07 +0100
commit10c75e2a2a15e35bd6e70503ef7e3e119ae90775 (patch)
treee9da79b9ad9258b286b966cefbccf127ebb4b7d8 /gcc/fortran/simplify.cc
parent36a9e2b22596711455e702ea5a5a3f26e145321c (diff)
downloadgcc-10c75e2a2a15e35bd6e70503ef7e3e119ae90775.zip
gcc-10c75e2a2a15e35bd6e70503ef7e3e119ae90775.tar.gz
gcc-10c75e2a2a15e35bd6e70503ef7e3e119ae90775.tar.bz2
Add UMASKR and UMASKL intrinsics.
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.
Diffstat (limited to 'gcc/fortran/simplify.cc')
-rw-r--r--gcc/fortran/simplify.cc78
1 files changed, 78 insertions, 0 deletions
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 1e2fa3e..573ec6b 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)