aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog13
-rw-r--r--gcc/fortran/simplify.c5
-rw-r--r--gcc/fortran/trans-decl.c15
-rw-r--r--gcc/fortran/trans-intrinsic.c116
-rw-r--r--gcc/fortran/trans-types.c2
-rw-r--r--gcc/fortran/trans-types.h1
-rw-r--r--gcc/fortran/trans.h2
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/leadz_trailz_1.f90133
-rw-r--r--gcc/testsuite/gfortran.dg/leadz_trailz_2.f9036
-rw-r--r--libgfortran/ChangeLog8
-rw-r--r--libgfortran/Makefile.am1
-rw-r--r--libgfortran/Makefile.in21
-rw-r--r--libgfortran/gfortran.map7
-rw-r--r--libgfortran/intrinsics/bit_intrinsics.c138
15 files changed, 436 insertions, 68 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6f9e4241e47..c94b7d720a4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2009-05-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/40019
+ * trans-types.c (gfc_build_uint_type): Make nonstatic.
+ * trans.h (gfor_fndecl_clz128, gfor_fndecl_ctz128): New prototypes.
+ * trans-types.h (gfc_build_uint_type): Add prototype.
+ * trans-decl.c (gfc_build_intrinsic_function_decls): Build
+ gfor_fndecl_clz128 and gfor_fndecl_ctz128.
+ * trans-intrinsic.c (gfc_conv_intrinsic_leadz,
+ gfc_conv_intrinsic_trailz): Call the right builtins or library
+ functions, and cast arguments to unsigned types first.
+ * simplify.c (gfc_simplify_leadz): Deal with negative arguments.
+
2009-05-27 Ian Lance Taylor <iant@google.com>
* Make-lang.in (gfortran$(exeext)): Change $(COMPILER) to
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 4dd114b532f..51a3c5198e5 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2579,10 +2579,13 @@ gfc_simplify_leadz (gfc_expr *e)
bs = gfc_integer_kinds[i].bit_size;
if (mpz_cmp_si (e->value.integer, 0) == 0)
lz = bs;
+ else if (mpz_cmp_si (e->value.integer, 0) < 0)
+ lz = 0;
else
lz = bs - mpz_sizeinbase (e->value.integer, 2);
- result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &e->where);
+ result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
+ &e->where);
mpz_set_ui (result->value.integer, lz);
return result;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index ba85eddeb8a..a036aebd172 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -145,6 +145,8 @@ tree gfor_fndecl_convert_char4_to_char1;
tree gfor_fndecl_size0;
tree gfor_fndecl_size1;
tree gfor_fndecl_iargc;
+tree gfor_fndecl_clz128;
+tree gfor_fndecl_ctz128;
/* Intrinsic functions implemented in Fortran. */
tree gfor_fndecl_sc_kind;
@@ -2570,6 +2572,19 @@ gfc_build_intrinsic_function_decls (void)
gfc_build_library_function_decl (get_identifier (PREFIX ("iargc")),
gfc_int4_type_node,
0);
+
+ if (gfc_type_for_size (128, true))
+ {
+ tree uint128 = gfc_type_for_size (128, true);
+
+ gfor_fndecl_clz128 =
+ gfc_build_library_function_decl (get_identifier (PREFIX ("clz128")),
+ integer_type_node, 1, uint128);
+
+ gfor_fndecl_ctz128 =
+ gfc_build_library_function_decl (get_identifier (PREFIX ("ctz128")),
+ integer_type_node, 1, uint128);
+ }
}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 33cc7f569a3..c1409578610 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2710,53 +2710,51 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
tree leadz;
tree bit_size;
tree tmp;
- int arg_kind;
- int i, n, s;
+ tree func;
+ int s, argsize;
gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+ argsize = TYPE_PRECISION (TREE_TYPE (arg));
/* 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)
+ if (argsize <= INT_TYPE_SIZE)
{
- 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 ();
+ arg_type = unsigned_type_node;
+ func = built_in_decls[BUILT_IN_CLZ];
+ }
+ else if (argsize <= LONG_TYPE_SIZE)
+ {
+ arg_type = long_unsigned_type_node;
+ func = built_in_decls[BUILT_IN_CLZL];
+ }
+ else if (argsize <= LONG_LONG_TYPE_SIZE)
+ {
+ arg_type = long_long_unsigned_type_node;
+ func = built_in_decls[BUILT_IN_CLZLL];
+ }
+ else
+ {
+ gcc_assert (argsize == 128);
+ arg_type = gfc_build_uint_type (argsize);
+ func = gfor_fndecl_clz128;
}
- /* Convert the actual argument to the proper argument type for the built-in
+ /* Convert the actual argument twice: first, to the unsigned type of the
+ same size; then, to the proper argument type for the built-in
function. But the return type is of the default INTEGER kind. */
+ arg = fold_convert (gfc_build_uint_type (argsize), arg);
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));
+ s = TYPE_PRECISION (arg_type) - argsize;
+ tmp = fold_convert (result_type, build_call_expr (func, 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);
+ bit_size = build_int_cst (result_type, argsize);
- /* ??? 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);
@@ -2777,50 +2775,48 @@ gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr)
tree result_type;
tree trailz;
tree bit_size;
- int arg_kind;
- int i, n;
+ tree func;
+ int argsize;
gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+ argsize = TYPE_PRECISION (TREE_TYPE (arg));
- /* 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)
+ /* Which variant of __builtin_ctz* should we call? */
+ if (argsize <= INT_TYPE_SIZE)
{
- 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 ();
+ arg_type = unsigned_type_node;
+ func = built_in_decls[BUILT_IN_CTZ];
+ }
+ else if (argsize <= LONG_TYPE_SIZE)
+ {
+ arg_type = long_unsigned_type_node;
+ func = built_in_decls[BUILT_IN_CTZL];
+ }
+ else if (argsize <= LONG_LONG_TYPE_SIZE)
+ {
+ arg_type = long_long_unsigned_type_node;
+ func = built_in_decls[BUILT_IN_CTZLL];
+ }
+ else
+ {
+ gcc_assert (argsize == 128);
+ arg_type = gfc_build_uint_type (argsize);
+ func = gfor_fndecl_ctz128;
}
- /* Convert the actual argument to the proper argument type for the built-in
+ /* Convert the actual argument twice: first, to the unsigned type of the
+ same size; then, to the proper argument type for the built-in
function. But the return type is of the default INTEGER kind. */
+ arg = fold_convert (gfc_build_uint_type (argsize), arg);
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));
+ trailz = fold_convert (result_type, build_call_expr (func, 1, arg));
/* Build BIT_SIZE. */
- bit_size = build_int_cst (result_type, gfc_integer_kinds[i].bit_size);
+ bit_size = build_int_cst (result_type, argsize);
- /* ??? 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);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index e945fcbf7b5..0c439937125 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -686,7 +686,7 @@ gfc_build_int_type (gfc_integer_info *info)
return make_signed_type (mode_precision);
}
-static tree
+tree
gfc_build_uint_type (int size)
{
if (size == CHAR_TYPE_SIZE)
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index c3e51a11c8e..283d57772a0 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -68,6 +68,7 @@ tree gfc_get_function_type (gfc_symbol *);
tree gfc_type_for_size (unsigned, int);
tree gfc_type_for_mode (enum machine_mode, int);
+tree gfc_build_uint_type (int);
tree gfc_get_element_type (tree);
tree gfc_get_array_type_bounds (tree, int, tree *, tree *, int,
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 4846af245fd..906896985d1 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -590,6 +590,8 @@ extern GTY(()) tree gfor_fndecl_convert_char4_to_char1;
extern GTY(()) tree gfor_fndecl_size0;
extern GTY(()) tree gfor_fndecl_size1;
extern GTY(()) tree gfor_fndecl_iargc;
+extern GTY(()) tree gfor_fndecl_clz128;
+extern GTY(()) tree gfor_fndecl_ctz128;
/* Implemented in Fortran. */
extern GTY(()) tree gfor_fndecl_sc_kind;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7479c1a74ea..214cf74523e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-05-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/40019
+ * gfortran.dg/leadz_trailz_1.f90: New test.
+ * gfortran.dg/leadz_trailz_2.f90: New test.
+
2009-05-29 Martin Jambor <mjambor@suse.cz>
* gfortran.dg/pr25923.f90: XFAIL warning expectation.
diff --git a/gcc/testsuite/gfortran.dg/leadz_trailz_1.f90 b/gcc/testsuite/gfortran.dg/leadz_trailz_1.f90
new file mode 100644
index 00000000000..a0cd1979225
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/leadz_trailz_1.f90
@@ -0,0 +1,133 @@
+! { dg-do run }
+
+ integer(kind=1) :: i1
+ integer(kind=2) :: i2
+ integer(kind=4) :: i4
+ integer(kind=8) :: i8
+
+ i1 = -1
+ i2 = -1
+ i4 = -1
+ i8 = -1
+
+ if (leadz(i1) /= 0) call abort
+ if (leadz(i2) /= 0) call abort
+ if (leadz(i4) /= 0) call abort
+ if (leadz(i8) /= 0) call abort
+
+ if (trailz(i1) /= 0) call abort
+ if (trailz(i2) /= 0) call abort
+ if (trailz(i4) /= 0) call abort
+ if (trailz(i8) /= 0) call abort
+
+ if (leadz(-1_1) /= 0) call abort
+ if (leadz(-1_2) /= 0) call abort
+ if (leadz(-1_4) /= 0) call abort
+ if (leadz(-1_8) /= 0) call abort
+
+ if (trailz(-1_1) /= 0) call abort
+ if (trailz(-1_2) /= 0) call abort
+ if (trailz(-1_4) /= 0) call abort
+ if (trailz(-1_8) /= 0) call abort
+
+ i1 = -64
+ i2 = -64
+ i4 = -64
+ i8 = -64
+
+ if (leadz(i1) /= 0) call abort
+ if (leadz(i2) /= 0) call abort
+ if (leadz(i4) /= 0) call abort
+ if (leadz(i8) /= 0) call abort
+
+ if (trailz(i1) /= 6) call abort
+ if (trailz(i2) /= 6) call abort
+ if (trailz(i4) /= 6) call abort
+ if (trailz(i8) /= 6) call abort
+
+ if (leadz(-64_1) /= 0) call abort
+ if (leadz(-64_2) /= 0) call abort
+ if (leadz(-64_4) /= 0) call abort
+ if (leadz(-64_8) /= 0) call abort
+
+ if (trailz(-64_1) /= 6) call abort
+ if (trailz(-64_2) /= 6) call abort
+ if (trailz(-64_4) /= 6) call abort
+ if (trailz(-64_8) /= 6) call abort
+
+ i1 = -108
+ i2 = -108
+ i4 = -108
+ i8 = -108
+
+ if (leadz(i1) /= 0) call abort
+ if (leadz(i2) /= 0) call abort
+ if (leadz(i4) /= 0) call abort
+ if (leadz(i8) /= 0) call abort
+
+ if (trailz(i1) /= 2) call abort
+ if (trailz(i2) /= 2) call abort
+ if (trailz(i4) /= 2) call abort
+ if (trailz(i8) /= 2) call abort
+
+ if (leadz(-108_1) /= 0) call abort
+ if (leadz(-108_2) /= 0) call abort
+ if (leadz(-108_4) /= 0) call abort
+ if (leadz(-108_8) /= 0) call abort
+
+ if (trailz(-108_1) /= 2) call abort
+ if (trailz(-108_2) /= 2) call abort
+ if (trailz(-108_4) /= 2) call abort
+ if (trailz(-108_8) /= 2) call abort
+
+ i1 = 1
+ i2 = 1
+ i4 = 1
+ i8 = 1
+
+ if (leadz(i1) /= bit_size(i1) - 1) call abort
+ if (leadz(i2) /= bit_size(i2) - 1) call abort
+ if (leadz(i4) /= bit_size(i4) - 1) call abort
+ if (leadz(i8) /= bit_size(i8) - 1) call abort
+
+ if (trailz(i1) /= 0) call abort
+ if (trailz(i2) /= 0) call abort
+ if (trailz(i4) /= 0) call abort
+ if (trailz(i8) /= 0) call abort
+
+ if (leadz(1_1) /= bit_size(1_1) - 1) call abort
+ if (leadz(1_2) /= bit_size(1_2) - 1) call abort
+ if (leadz(1_4) /= bit_size(1_4) - 1) call abort
+ if (leadz(1_8) /= bit_size(1_8) - 1) call abort
+
+ if (trailz(1_1) /= 0) call abort
+ if (trailz(1_2) /= 0) call abort
+ if (trailz(1_4) /= 0) call abort
+ if (trailz(1_8) /= 0) call abort
+
+ i1 = 64
+ i2 = 64
+ i4 = 64
+ i8 = 64
+
+ if (leadz(i1) /= 1) call abort
+ if (leadz(i2) /= 9) call abort
+ if (leadz(i4) /= 25) call abort
+ if (leadz(i8) /= 57) call abort
+
+ if (trailz(i1) /= 6) call abort
+ if (trailz(i2) /= 6) call abort
+ if (trailz(i4) /= 6) call abort
+ if (trailz(i8) /= 6) call abort
+
+ if (leadz(64_1) /= 1) call abort
+ if (leadz(64_2) /= 9) call abort
+ if (leadz(64_4) /= 25) call abort
+ if (leadz(64_8) /= 57) call abort
+
+ if (trailz(64_1) /= 6) call abort
+ if (trailz(64_2) /= 6) call abort
+ if (trailz(64_4) /= 6) call abort
+ if (trailz(64_8) /= 6) call abort
+
+end
diff --git a/gcc/testsuite/gfortran.dg/leadz_trailz_2.f90 b/gcc/testsuite/gfortran.dg/leadz_trailz_2.f90
new file mode 100644
index 00000000000..08701d8a537
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/leadz_trailz_2.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+
+ integer(kind=16) :: i16
+
+ i16 = -1
+ if (leadz(i16) /= 0) call abort
+ if (trailz(i16) /= 0) call abort
+ if (leadz(-1_16) /= 0) call abort
+ if (trailz(-1_16) /= 0) call abort
+
+ i16 = -64
+ if (leadz(i16) /= 0) call abort
+ if (trailz(i16) /= 6) call abort
+ if (leadz(-64_16) /= 0) call abort
+ if (trailz(-64_16) /= 6) call abort
+
+ i16 = -108
+ if (leadz(i16) /= 0) call abort
+ if (trailz(i16) /= 2) call abort
+ if (leadz(-108_16) /= 0) call abort
+ if (trailz(-108_16) /= 2) call abort
+
+ i16 = 1
+ if (leadz(i16) /= bit_size(i16) - 1) call abort
+ if (trailz(i16) /= 0) call abort
+ if (leadz(1_16) /= bit_size(1_16) - 1) call abort
+ if (trailz(1_16) /= 0) call abort
+
+ i16 = 64
+ if (leadz(i16) /= 121) call abort
+ if (trailz(i16) /= 6) call abort
+ if (leadz(64_16) /= 121) call abort
+ if (trailz(64_16) /= 6) call abort
+
+end
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 7519578da6b..2d27d0321bf 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-05-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/40019
+ * intrinsics/bit_intrinsics.c: New file.
+ * gfortran.map (GFORTRAN_1.2): New list.
+ * Makefile.am: Add intrinsics/bit_intrinsics.c.
+ * Makefile.in: Regenerate.
+
2009-05-29 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/40190
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index ce73ff22e51..f5f92dfb432 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -62,6 +62,7 @@ intrinsics/associated.c \
intrinsics/abort.c \
intrinsics/access.c \
intrinsics/args.c \
+intrinsics/bit_intrinsics.c \
intrinsics/c99_functions.c \
intrinsics/chdir.c \
intrinsics/chmod.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 8d356d5f3b8..ce2b5a21cb1 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -416,9 +416,9 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \
io/size_from_kind.c io/transfer.c io/unit.c io/unix.c \
io/write.c io/fbuf.c intrinsics/associated.c \
intrinsics/abort.c intrinsics/access.c intrinsics/args.c \
- intrinsics/c99_functions.c intrinsics/chdir.c \
- intrinsics/chmod.c intrinsics/clock.c intrinsics/cpu_time.c \
- intrinsics/cshift0.c intrinsics/ctime.c \
+ intrinsics/bit_intrinsics.c intrinsics/c99_functions.c \
+ intrinsics/chdir.c intrinsics/chmod.c intrinsics/clock.c \
+ intrinsics/cpu_time.c intrinsics/cshift0.c intrinsics/ctime.c \
intrinsics/date_and_time.c intrinsics/dtime.c intrinsics/env.c \
intrinsics/eoshift0.c intrinsics/eoshift2.c \
intrinsics/erfc_scaled.c intrinsics/etime.c intrinsics/exit.c \
@@ -711,9 +711,9 @@ am__objects_35 = close.lo file_pos.lo format.lo inquire.lo \
intrinsics.lo list_read.lo lock.lo open.lo read.lo \
size_from_kind.lo transfer.lo unit.lo unix.lo write.lo fbuf.lo
am__objects_36 = associated.lo abort.lo access.lo args.lo \
- c99_functions.lo chdir.lo chmod.lo clock.lo cpu_time.lo \
- cshift0.lo ctime.lo date_and_time.lo dtime.lo env.lo \
- eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo exit.lo \
+ bit_intrinsics.lo c99_functions.lo chdir.lo chmod.lo clock.lo \
+ cpu_time.lo cshift0.lo ctime.lo date_and_time.lo dtime.lo \
+ env.lo eoshift0.lo eoshift2.lo erfc_scaled.lo etime.lo exit.lo \
fnum.lo gerror.lo getcwd.lo getlog.lo getXid.lo hostnm.lo \
ierrno.lo ishftc.lo iso_c_generated_procs.lo iso_c_binding.lo \
kill.lo link.lo malloc.lo mvbits.lo move_alloc.lo \
@@ -990,6 +990,7 @@ intrinsics/associated.c \
intrinsics/abort.c \
intrinsics/access.c \
intrinsics/args.c \
+intrinsics/bit_intrinsics.c \
intrinsics/c99_functions.c \
intrinsics/chdir.c \
intrinsics/chmod.c \
@@ -1804,6 +1805,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/args.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/associated.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backtrace.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bit_intrinsics.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c99_functions.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chdir.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chmod.Plo@am__quote@
@@ -5322,6 +5324,13 @@ args.lo: intrinsics/args.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o args.lo `test -f 'intrinsics/args.c' || echo '$(srcdir)/'`intrinsics/args.c
+bit_intrinsics.lo: intrinsics/bit_intrinsics.c
+@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bit_intrinsics.lo -MD -MP -MF "$(DEPDIR)/bit_intrinsics.Tpo" -c -o bit_intrinsics.lo `test -f 'intrinsics/bit_intrinsics.c' || echo '$(srcdir)/'`intrinsics/bit_intrinsics.c; \
+@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/bit_intrinsics.Tpo" "$(DEPDIR)/bit_intrinsics.Plo"; else rm -f "$(DEPDIR)/bit_intrinsics.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='intrinsics/bit_intrinsics.c' object='bit_intrinsics.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bit_intrinsics.lo `test -f 'intrinsics/bit_intrinsics.c' || echo '$(srcdir)/'`intrinsics/bit_intrinsics.c
+
c99_functions.lo: intrinsics/c99_functions.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT c99_functions.lo -MD -MP -MF "$(DEPDIR)/c99_functions.Tpo" -c -o c99_functions.lo `test -f 'intrinsics/c99_functions.c' || echo '$(srcdir)/'`intrinsics/c99_functions.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/c99_functions.Tpo" "$(DEPDIR)/c99_functions.Plo"; else rm -f "$(DEPDIR)/c99_functions.Tpo"; exit 1; fi
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 93973d5b338..c8de09cf055 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1090,6 +1090,13 @@ GFORTRAN_1.1 {
_gfortran_unpack1_char4;
} GFORTRAN_1.0;
+
+GFORTRAN_1.2 {
+ global:
+ _gfortran_clz128;
+ _gfortran_ctz128;
+} GFORTRAN_1.1;
+
F2C_1.0 {
global:
_gfortran_f2c_specific__abs_c4;
diff --git a/libgfortran/intrinsics/bit_intrinsics.c b/libgfortran/intrinsics/bit_intrinsics.c
new file mode 100644
index 00000000000..92f5f039be6
--- /dev/null
+++ b/libgfortran/intrinsics/bit_intrinsics.c
@@ -0,0 +1,138 @@
+/* Implementation of the bit intrinsics not implemented as GCC builtins.
+ Copyright (C) 2009 Free Software Foundation, Inc.
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public
+License as published by the Free Software Foundation; either
+version 3 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+
+
+#ifdef HAVE_GFC_INTEGER_16
+extern int clz128 (GFC_INTEGER_16);
+export_proto(clz128);
+
+int
+clz128 (GFC_INTEGER_16 x)
+{
+ int res = 127;
+
+ // We can't write 0xFFFFFFFFFFFFFFFF0000000000000000, so we work around it
+ if (x & ((__uint128_t) 0xFFFFFFFFFFFFFFFF << 64))
+ {
+ res -= 64;
+ x >>= 64;
+ }
+
+ if (x & 0xFFFFFFFF00000000)
+ {
+ res -= 32;
+ x >>= 32;
+ }
+
+ if (x & 0xFFFF0000)
+ {
+ res -= 16;
+ x >>= 16;
+ }
+
+ if (x & 0xFF00)
+ {
+ res -= 8;
+ x >>= 8;
+ }
+
+ if (x & 0xF0)
+ {
+ res -= 4;
+ x >>= 4;
+ }
+
+ if (x & 0xC)
+ {
+ res -= 2;
+ x >>= 2;
+ }
+
+ if (x & 0x2)
+ {
+ res -= 1;
+ x >>= 1;
+ }
+
+ return res;
+}
+#endif
+
+
+#ifdef HAVE_GFC_INTEGER_16
+extern int ctz128 (GFC_INTEGER_16);
+export_proto(ctz128);
+
+int
+ctz128 (GFC_INTEGER_16 x)
+{
+ int res = 0;
+
+ if ((x & 0xFFFFFFFFFFFFFFFF) == 0)
+ {
+ res += 64;
+ x >>= 64;
+ }
+
+ if ((x & 0xFFFFFFFF) == 0)
+ {
+ res += 32;
+ x >>= 32;
+ }
+
+ if ((x & 0xFFFF) == 0)
+ {
+ res += 16;
+ x >>= 16;
+ }
+
+ if ((x & 0xFF) == 0)
+ {
+ res += 8;
+ x >>= 8;
+ }
+
+ if ((x & 0xF) == 0)
+ {
+ res += 4;
+ x >>= 4;
+ }
+
+ if ((x & 0x3) == 0)
+ {
+ res += 2;
+ x >>= 2;
+ }
+
+ if ((x & 0x1) == 0)
+ {
+ res += 1;
+ x >>= 1;
+ }
+
+ return res;
+}
+#endif
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-20 19:10:47 +0000