diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 16 | ||||
| -rw-r--r-- | gcc/fortran/f95-lang.c | 31 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 14 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.texi | 82 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 45 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 143 |
8 files changed, 335 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 253caa2b8d1..869cd897b27 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2008-10-02 Steven Bosscher <steven@gcc.gnu.org> + + PR fortran/37635 + * intrinsic.c (add_functions): Add LEADZ and TRAILZ as generics. + * intrinsic.h (gfc_simplify_leadz, gfc_simplify_trailz): New protos. + * gfortran.h <enum gfc_isym_id>: (GFC_ISYM_LEADZ, GFC_ISYM_TRAILZ): New. + * f95-lang (gfc_init_builtin_functions): Add BUILT_IN_CLZ, + BUILT_IN_CLZL, BUILT_IN_CLZLL, BUILT_IN_CTZ, BUILT_IN_CTZL, and + BUILT_IN_CTZLL. + * trans-intrinsic.c (gfc_conv_intrinsic_leadz, + gfc_conv_intrinsic_trails): New code-generation functions for LEADZ + and TRAILZ intrinsics. + (gfc_conv_intrinsic_function): Use them + * intrinsic.texi: Add documentation for LEADZ and TRAILZ. + * simplify.c (gfc_simplify_leadz, gfc_simplify_trailz): New functions. + 2008-09-30 Janus Weil <janus@gcc.gnu.org> PR fortran/36592 diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 30cc98e86d7..cf0dc2d48b7 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -1003,6 +1003,37 @@ gfc_init_builtin_functions (void) BUILT_IN_SINCOSF, "sincosf", false); } + /* For LEADZ / TRAILZ. */ + tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, + "__builtin_clz", true); + + tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL, + "__builtin_clzl", true); + + tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL, + "__builtin_clzll", true); + + tmp = tree_cons (NULL_TREE, unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ, + "__builtin_ctz", true); + + tmp = tree_cons (NULL_TREE, long_unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL, + "__builtin_ctzl", true); + + tmp = tree_cons (NULL_TREE, long_long_unsigned_type_node, void_list_node); + ftype = build_function_type (integer_type_node, tmp); + gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL, + "__builtin_ctzll", true); + /* Other builtin functions we use. */ tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4e9959ea5bb..60d9baccf9b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -417,6 +417,7 @@ enum gfc_isym_id GFC_ISYM_KILL, GFC_ISYM_KIND, GFC_ISYM_LBOUND, + GFC_ISYM_LEADZ, GFC_ISYM_LEN, GFC_ISYM_LEN_TRIM, GFC_ISYM_LGAMMA, @@ -503,6 +504,7 @@ enum gfc_isym_id GFC_ISYM_TIME, GFC_ISYM_TIME8, GFC_ISYM_TINY, + GFC_ISYM_TRAILZ, GFC_ISYM_TRANSFER, GFC_ISYM_TRANSPOSE, GFC_ISYM_TRIM, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 9b11db4bb64..035aef70d65 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1781,6 +1781,13 @@ add_functions (void) make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95); + add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO, + BT_INTEGER, di, GFC_STD_F2008, + gfc_check_i, gfc_simplify_leadz, NULL, + i, BT_INTEGER, di, REQUIRED); + + make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008); + add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77, gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len, @@ -2388,6 +2395,13 @@ add_functions (void) make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95); + add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO, + BT_INTEGER, di, GFC_STD_F2008, + gfc_check_i, gfc_simplify_trailz, NULL, + i, BT_INTEGER, di, REQUIRED); + + make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008); + add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer, src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED, diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 5994cf66a79..02eff464d0a 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -259,6 +259,7 @@ gfc_expr *gfc_simplify_ishft (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_kind (gfc_expr *); gfc_expr *gfc_simplify_lbound (gfc_expr *, gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_leadz (gfc_expr *); gfc_expr *gfc_simplify_len (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_len_trim (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_lgamma (gfc_expr *); @@ -310,6 +311,7 @@ gfc_expr *gfc_simplify_sqrt (gfc_expr *); gfc_expr *gfc_simplify_tan (gfc_expr *); gfc_expr *gfc_simplify_tanh (gfc_expr *); gfc_expr *gfc_simplify_tiny (gfc_expr *); +gfc_expr *gfc_simplify_trailz (gfc_expr *); gfc_expr *gfc_simplify_transfer (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_trim (gfc_expr *); gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 8337f74c522..3418d05bdf3 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -164,6 +164,7 @@ Some basic guidelines for editing this document: * @code{KILL}: KILL, Send a signal to a process * @code{KIND}: KIND, Kind of an entity * @code{LBOUND}: LBOUND, Lower dimension bounds of an array +* @code{LEADZ}: LEADZ, Number of leading zero bits of an integer * @code{LEN}: LEN, Length of a character entity * @code{LEN_TRIM}: LEN_TRIM, Length of a character entity without trailing blank characters * @code{LOG_GAMMA}: LOG_GAMMA, Logarithm of the Gamma function @@ -252,6 +253,7 @@ Some basic guidelines for editing this document: * @code{TIME}: TIME, Time function * @code{TIME8}: TIME8, Time function (64-bit) * @code{TINY}: TINY, Smallest positive number of a real kind +* @code{TRAILZ}: TRAILZ, Number of trailing zero bits of an integer * @code{TRANSFER}: TRANSFER, Transfer bit patterns * @code{TRANSPOSE}: TRANSPOSE, Transpose an array of rank two * @code{TRIM}: TRIM, Remove trailing blank characters of a string @@ -6504,6 +6506,46 @@ dimension, the lower bound is taken to be 1. +@node LEADZ +@section @code{LEADZ} --- Number of leading zero bits of an integer +@fnindex LEADZ +@cindex zero bits + +@table @asis +@item @emph{Description}: +@code{LEADZ} returns the number of leading zero bits of an integer. + +@item @emph{Standard}: +Fortran 2008 and later + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = LEADZ(I)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{I} @tab Shall be of type @code{INTEGER}. +@end multitable + +@item @emph{Return value}: +The type of the return value is the default @code{INTEGER}. +If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}. + +@item @emph{Example}: +@smallexample +PROGRAM test_leadz + WRITE (*,*) LEADZ(1) ! prints 8 if BITSIZE(I) has the value 32 +END PROGRAM +@end smallexample + +@item @emph{See also}: +@ref{BIT_SIZE}, @ref{TRAILZ} +@end table + + + @node LEN @section @code{LEN} --- Length of a character entity @fnindex LEN @@ -10642,6 +10684,46 @@ See @code{HUGE} for an example. +@node TRAILZ +@section @code{TRAILZ} --- Number of trailing zero bits of an integer +@fnindex TRAILZ +@cindex zero bits + +@table @asis +@item @emph{Description}: +@code{TRAILZ} returns the number of trailing zero bits of an integer. + +@item @emph{Standard}: +Fortran 2008 and later + +@item @emph{Class}: +Elemental function + +@item @emph{Syntax}: +@code{RESULT = TRAILZ(I)} + +@item @emph{Arguments}: +@multitable @columnfractions .15 .70 +@item @var{I} @tab Shall be of type @code{INTEGER}. +@end multitable + +@item @emph{Return value}: +The type of the return value is the default @code{INTEGER}. +If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}. + +@item @emph{Example}: +@smallexample +PROGRAM test_trailz + WRITE (*,*) TRAILZ(8) ! prints 3 +END PROGRAM +@end smallexample + +@item @emph{See also}: +@ref{BIT_SIZE}, @ref{LEADZ} +@end table + + + @node TRANSFER @section @code{TRANSFER} --- Transfer bit patterns @fnindex TRANSFER diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index c0ac0262050..429c5151d2e 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -2400,6 +2400,30 @@ gfc_simplify_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) gfc_expr * +gfc_simplify_leadz (gfc_expr *e) +{ + gfc_expr *result; + unsigned long lz, bs; + int i; + + if (e->expr_type != EXPR_CONSTANT) + return NULL; + + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); + bs = gfc_integer_kinds[i].bit_size; + if (mpz_cmp_si (e->value.integer, 0) == 0) + lz = bs; + else + lz = bs - mpz_sizeinbase (e->value.integer, 2); + + result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where); + mpz_set_ui (result->value.integer, lz); + + return result; +} + + +gfc_expr * gfc_simplify_len (gfc_expr *e, gfc_expr *kind) { gfc_expr *result; @@ -4338,6 +4362,27 @@ gfc_simplify_tiny (gfc_expr *e) gfc_expr * +gfc_simplify_trailz (gfc_expr *e) +{ + gfc_expr *result; + unsigned long tz, bs; + int i; + + if (e->expr_type != EXPR_CONSTANT) + return NULL; + + i = gfc_validate_kind (e->ts.type, e->ts.kind, false); + bs = gfc_integer_kinds[i].bit_size; + tz = mpz_scan1 (e->value.integer, 0); + + result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where); + mpz_set_ui (result->value.integer, MIN (tz, bs)); + + return result; +} + + +gfc_expr * gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) { gfc_expr *result; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index f5f9922b68d..ffe1e5b913e 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2653,6 +2653,141 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr) se->expr = fold_build3 (COND_EXPR, type, tmp, args[0], rrot); } +/* LEADZ (i) = (i == 0) ? BIT_SIZE (i) + : __builtin_clz(i) - (BIT_SIZE('int') - BIT_SIZE(i)) + + The conditional expression is necessary because the result of LEADZ(0) + is defined, but the result of __builtin_clz(0) is undefined for most + targets. + + For INTEGER kinds smaller than the C 'int' type, we have to subtract the + difference in bit size between the argument of LEADZ and the C int. */ + +static void +gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr) +{ + tree arg; + tree arg_type; + tree cond; + tree result_type; + tree leadz; + tree bit_size; + tree tmp; + int arg_kind; + int i, n, s; + + gfc_conv_intrinsic_function_args (se, expr, &arg, 1); + + /* Which variant of __builtin_clz* should we call? */ + arg_kind = expr->value.function.actual->expr->ts.kind; + i = gfc_validate_kind (BT_INTEGER, arg_kind, false); + switch (arg_kind) + { + case 1: + case 2: + case 4: + arg_type = unsigned_type_node; + n = BUILT_IN_CLZ; + break; + + case 8: + arg_type = long_unsigned_type_node; + n = BUILT_IN_CLZL; + break; + + case 16: + arg_type = long_long_unsigned_type_node; + n = BUILT_IN_CLZLL; + break; + + default: + gcc_unreachable (); + } + + /* Convert the actual argument to the proper argument type for the built-in + function. But the return type is of the default INTEGER kind. */ + arg = fold_convert (arg_type, arg); + result_type = gfc_get_int_type (gfc_default_integer_kind); + + /* Compute LEADZ for the case i .ne. 0. */ + s = TYPE_PRECISION (arg_type) - gfc_integer_kinds[i].bit_size; + tmp = fold_convert (result_type, build_call_expr (built_in_decls[n], 1, arg)); + leadz = fold_build2 (MINUS_EXPR, result_type, + tmp, build_int_cst (result_type, s)); + + /* Build BIT_SIZE. */ + bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size); + + /* ??? For some combinations of targets and integer kinds, the condition + can be avoided if CLZ_DEFINED_VALUE_AT_ZERO is used. Later. */ + cond = fold_build2 (EQ_EXPR, boolean_type_node, + arg, build_int_cst (arg_type, 0)); + se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, leadz); +} + +/* TRAILZ(i) = (i == 0) ? BIT_SIZE (i) : __builtin_ctz(i) + + The conditional expression is necessary because the result of TRAILZ(0) + is defined, but the result of __builtin_ctz(0) is undefined for most + targets. */ + +static void +gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr) +{ + tree arg; + tree arg_type; + tree cond; + tree result_type; + tree trailz; + tree bit_size; + int arg_kind; + int i, n; + + gfc_conv_intrinsic_function_args (se, expr, &arg, 1); + + /* Which variant of __builtin_clz* should we call? */ + arg_kind = expr->value.function.actual->expr->ts.kind; + i = gfc_validate_kind (BT_INTEGER, arg_kind, false); + switch (expr->ts.kind) + { + case 1: + case 2: + case 4: + arg_type = unsigned_type_node; + n = BUILT_IN_CTZ; + break; + + case 8: + arg_type = long_unsigned_type_node; + n = BUILT_IN_CTZL; + break; + + case 16: + arg_type = long_long_unsigned_type_node; + n = BUILT_IN_CTZLL; + break; + + default: + gcc_unreachable (); + } + + /* Convert the actual argument to the proper argument type for the built-in + function. But the return type is of the default INTEGER kind. */ + arg = fold_convert (arg_type, arg); + result_type = gfc_get_int_type (gfc_default_integer_kind); + + /* Compute TRAILZ for the case i .ne. 0. */ + trailz = fold_convert (result_type, build_call_expr (built_in_decls[n], 1, arg)); + + /* Build BIT_SIZE. */ + bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size); + + /* ??? For some combinations of targets and integer kinds, the condition + can be avoided if CTZ_DEFINED_VALUE_AT_ZERO is used. Later. */ + cond = fold_build2 (EQ_EXPR, boolean_type_node, + arg, build_int_cst (arg_type, 0)); + se->expr = fold_build3 (COND_EXPR, result_type, cond, bit_size, trailz); +} /* Process an intrinsic with unspecified argument-types that has an optional argument (which could be of type character), e.g. EOSHIFT. For those, we @@ -4482,6 +4617,14 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_ishftc (se, expr); break; + case GFC_ISYM_LEADZ: + gfc_conv_intrinsic_leadz (se, expr); + break; + + case GFC_ISYM_TRAILZ: + gfc_conv_intrinsic_trailz (se, expr); + break; + case GFC_ISYM_LBOUND: gfc_conv_intrinsic_bound (se, expr, 0); break; |