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 + + 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 * 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 + + PR fortran/40019 + * gfortran.dg/leadz_trailz_1.f90: New test. + * gfortran.dg/leadz_trailz_2.f90: New test. + 2009-05-29 Martin Jambor * 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 + + 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 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 +. */ + +#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