diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2024-10-29 21:08:59 +0100 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2024-11-02 19:20:07 +0100 |
commit | 10c75e2a2a15e35bd6e70503ef7e3e119ae90775 (patch) | |
tree | e9da79b9ad9258b286b966cefbccf127ebb4b7d8 /gcc/fortran/simplify.cc | |
parent | 36a9e2b22596711455e702ea5a5a3f26e145321c (diff) | |
download | gcc-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.cc | 78 |
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) |