diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 25 | ||||
| -rw-r--r-- | gcc/fortran/f95-lang.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/mathbuiltins.def | 26 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 129 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.c | 28 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.h | 7 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/float128_1.f90 | 28 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/random_seed_1.f90 | 13 |
10 files changed, 236 insertions, 29 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ba1ee59..b98e37c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,28 @@ +2010-08-27 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/32049 + * gfortran.h (gfc_real_info): Add c_float128 field. + * mathbuiltins.def: Indicate which builtins are const. + * trans-types.h (float128_type_node, complex_float128_type_node, + gfc_real16_is_float128): New variables. + * trans-types.c (float128_type_node, complex_float128_type_node, + gfc_real16_is_float128): New variables. + (gfc_init_kinds): Allow TFmode. + (gfc_build_real_type): Mark __float128 types as such. + (gfc_init_types): Initialize float128_type_node and + complex_float128_type_node + * f95-lang.c (gfc_init_builtin_functions): Adjust for new + argument of OTHER_BUILTIN macro. + * trans-intrinsic.c (gfc_intrinsic_map_t): Likewise. + (builtin_decl_for_precision): Special case for __float128. + (builtin_decl_for_float_kind): Likewise. + (define_quad_builtin): New function. + (gfc_build_intrinsic_lib_fndecls): Create all __float128 + library decls if necessary. Store them in the real16_decl and + complex16_decl builtin map fields. + (gfc_get_intrinsic_lib_fndecl): Handle q-suffixed __float128 + library function names. + 2010-08-27 Tobias Burnus <burnus@net-b.de> PR fortran/33197 diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 70548bf..91dc491 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -788,7 +788,7 @@ gfc_init_builtin_functions (void) build_function_type_list (void_type_node, ptype, ptype, NULL_TREE); /* Non-math builtins are defined manually, so they're not included here. */ -#define OTHER_BUILTIN(ID,NAME,TYPE) +#define OTHER_BUILTIN(ID,NAME,TYPE,CONST) #include "mathbuiltins.def" diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0a2f52f..66c378e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1822,6 +1822,7 @@ typedef struct unsigned int c_float : 1; unsigned int c_double : 1; unsigned int c_long_double : 1; + unsigned int c_float128 : 1; } gfc_real_info; diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def index 2d6e967..074390e9 100644 --- a/gcc/fortran/mathbuiltins.def +++ b/gcc/fortran/mathbuiltins.def @@ -52,19 +52,19 @@ DEFINE_MATH_BUILTIN (TGAMMA,"tgamma", 0) DEFINE_MATH_BUILTIN (LGAMMA,"lgamma", 0) DEFINE_MATH_BUILTIN (HYPOT, "hypot", 1) -/* OTHER_BUILTIN (CODE, NAME, PROTOTYPE_TYPE) +/* OTHER_BUILTIN (CODE, NAME, PROTOTYPE_TYPE, CONST) For floating-point builtins that do not directly correspond to a Fortran intrinsic. This is used to map the different variants (float, double and long double) and to build the quad-precision decls. */ -OTHER_BUILTIN (CABS, "cabs", cabs) -OTHER_BUILTIN (COPYSIGN, "copysign", 2) -OTHER_BUILTIN (FABS, "fabs", 1) -OTHER_BUILTIN (FMOD, "fmod", 2) -OTHER_BUILTIN (FREXP, "frexp", frexp) -OTHER_BUILTIN (HUGE_VAL, "huge_val", 0) -OTHER_BUILTIN (LLROUND, "llround", llround) -OTHER_BUILTIN (LROUND, "lround", lround) -OTHER_BUILTIN (NEXTAFTER, "nextafter", 2) -OTHER_BUILTIN (ROUND, "round", 1) -OTHER_BUILTIN (SCALBN, "scalbn", scalbn) -OTHER_BUILTIN (TRUNC, "trunc", 1) +OTHER_BUILTIN (CABS, "cabs", cabs, true) +OTHER_BUILTIN (COPYSIGN, "copysign", 2, true) +OTHER_BUILTIN (FABS, "fabs", 1, true) +OTHER_BUILTIN (FMOD, "fmod", 2, true) +OTHER_BUILTIN (FREXP, "frexp", frexp, false) +OTHER_BUILTIN (HUGE_VAL, "huge_val", 0, true) +OTHER_BUILTIN (LLROUND, "llround", llround, true) +OTHER_BUILTIN (LROUND, "lround", lround, true) +OTHER_BUILTIN (NEXTAFTER, "nextafter", 2, true) +OTHER_BUILTIN (ROUND, "round", 1, true) +OTHER_BUILTIN (SCALBN, "scalbn", scalbn, true) +OTHER_BUILTIN (TRUNC, "trunc", 1, true) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index e0805d0..256cd8d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -105,10 +105,10 @@ gfc_intrinsic_map_t; false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE } -#define OTHER_BUILTIN(ID, NAME, TYPE) \ +#define OTHER_BUILTIN(ID, NAME, TYPE, CONST) \ { GFC_ISYM_NONE, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \ BUILT_IN_ ## ID ## L, END_BUILTINS, END_BUILTINS, END_BUILTINS, \ - true, false, true, NAME, NULL_TREE, NULL_TREE, \ + true, false, CONST, NAME, NULL_TREE, NULL_TREE, \ NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE}, static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] = @@ -151,6 +151,12 @@ builtin_decl_for_precision (enum built_in_function base_built_in, i = m->double_built_in; else if (precision == TYPE_PRECISION (long_double_type_node)) i = m->long_double_built_in; + else if (precision == TYPE_PRECISION (float128_type_node)) + { + /* Special treatment, because it is not exactly a built-in, but + a library function. */ + return m->real16_decl; + } return (i == END_BUILTINS ? NULL_TREE : built_in_decls[i]); } @@ -160,6 +166,18 @@ static tree builtin_decl_for_float_kind (enum built_in_function double_built_in, int kind) { int i = gfc_validate_kind (BT_REAL, kind, false); + + if (gfc_real_kinds[i].c_float128) + { + /* For __float128, the story is a bit different, because we return + a decl to a library function rather than a built-in. */ + gfc_intrinsic_map_t *m; + for (m = gfc_intrinsic_map; m->double_built_in != double_built_in ; m++) + ; + + return m->real16_decl; + } + return builtin_decl_for_precision (double_built_in, gfc_real_kinds[i].mode_precision); } @@ -557,6 +575,28 @@ gfc_conv_intrinsic_conjg (gfc_se * se, gfc_expr * expr) } + +static tree +define_quad_builtin (const char *name, tree type, bool is_const) +{ + tree fndecl; + fndecl = build_decl (input_location, FUNCTION_DECL, get_identifier (name), + type); + + /* Mark the decl as external. */ + DECL_EXTERNAL (fndecl) = 1; + TREE_PUBLIC (fndecl) = 1; + + /* Mark it __attribute__((const)). */ + TREE_READONLY (fndecl) = is_const; + + rest_of_decl_compilation (fndecl, 1, 0); + + return fndecl; +} + + + /* Initialize function decls for library functions. The external functions are created as required. Builtin functions are added here. */ @@ -564,6 +604,62 @@ void gfc_build_intrinsic_lib_fndecls (void) { gfc_intrinsic_map_t *m; + tree quad_decls[(int) END_BUILTINS]; + + if (gfc_real16_is_float128) + { + /* If we have soft-float types, we create the decls for their + C99-like library functions. For now, we only handle __float128 + q-suffixed functions. */ + + tree tmp, func_0, func_1, func_2, func_cabs, func_frexp; + tree func_lround, func_llround, func_scalbn; + + memset (quad_decls, 0, sizeof(tree) * (int) END_BUILTINS); + + /* type (*) (void) */ + func_0 = build_function_type (float128_type_node, void_list_node); + /* type (*) (type) */ + tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node); + func_1 = build_function_type (float128_type_node, tmp); + /* long (*) (type) */ + func_lround = build_function_type (long_integer_type_node, tmp); + /* long long (*) (type) */ + func_llround = build_function_type (long_long_integer_type_node, tmp); + /* type (*) (type, type) */ + tmp = tree_cons (NULL_TREE, float128_type_node, tmp); + func_2 = build_function_type (float128_type_node, tmp); + /* type (*) (type, &int) */ + tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node); + tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp); + func_frexp = build_function_type (float128_type_node, tmp); + /* type (*) (type, int) */ + tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node); + tmp = tree_cons (NULL_TREE, integer_type_node, tmp); + func_scalbn = build_function_type (float128_type_node, tmp); + /* type (*) (complex type) */ + tmp = tree_cons (NULL_TREE, complex_float128_type_node, void_list_node); + func_cabs = build_function_type (float128_type_node, tmp); + +#define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE) +#define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE) +#define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX) + + /* Only these built-ins are actually needed here. These are used directly + from the code, when calling builtin_decl_for_precision() or + builtin_decl_for_float_type(). The others are all constructed by + gfc_get_intrinsic_lib_fndecl(). */ +#define OTHER_BUILTIN(ID, NAME, TYPE, CONST) \ + quad_decls[BUILT_IN_ ## ID] = define_quad_builtin (NAME "q", func_ ## TYPE, CONST); + +#include "mathbuiltins.def" + +#undef OTHER_BUILTIN +#undef LIB_FUNCTION +#undef DEFINE_MATH_BUILTIN +#undef DEFINE_MATH_BUILTIN_C + + } /* Add GCC builtin functions. */ for (m = gfc_intrinsic_map; @@ -584,12 +680,26 @@ gfc_build_intrinsic_lib_fndecls (void) if (m->complex_long_double_built_in != END_BUILTINS) m->complex10_decl = built_in_decls[m->complex_long_double_built_in]; - /* For now, we assume that if real(kind=16) exists, it is long double. - Later, we will deal with __float128 and break this assumption. */ - if (m->long_double_built_in != END_BUILTINS) - m->real16_decl = built_in_decls[m->long_double_built_in]; - if (m->complex_long_double_built_in != END_BUILTINS) - m->complex16_decl = built_in_decls[m->complex_long_double_built_in]; + if (!gfc_real16_is_float128) + { + if (m->long_double_built_in != END_BUILTINS) + m->real16_decl = built_in_decls[m->long_double_built_in]; + if (m->complex_long_double_built_in != END_BUILTINS) + m->complex16_decl = built_in_decls[m->complex_long_double_built_in]; + } + else if (quad_decls[m->double_built_in] != NULL_TREE) + { + /* Quad-precision function calls are constructed when first + needed by builtin_decl_for_precision(), except for those + that will be used directly (define by OTHER_BUILTIN). */ + m->real16_decl = quad_decls[m->double_built_in]; + } + else if (quad_decls[m->complex_double_built_in] != NULL_TREE) + { + /* Same thing for the complex ones. */ + m->complex16_decl = quad_decls[m->double_built_in]; + m->real16_decl = quad_decls[m->double_built_in]; + } } } @@ -668,6 +778,9 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr) else if (gfc_real_kinds[n].c_long_double) snprintf (name, sizeof (name), "%s%s%s", ts->type == BT_COMPLEX ? "c" : "", m->name, "l"); + else if (gfc_real_kinds[n].c_float128) + snprintf (name, sizeof (name), "%s%s%s", + ts->type == BT_COMPLEX ? "c" : "", m->name, "q"); else gcc_unreachable (); } diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index a08a7ea..348ffea 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -64,6 +64,11 @@ tree pfunc_type_node; tree gfc_charlen_type_node; +tree float128_type_node = NULL_TREE; +tree complex_float128_type_node = NULL_TREE; + +bool gfc_real16_is_float128 = false; + static GTY(()) tree gfc_desc_dim_type; static GTY(()) tree gfc_max_array_element_size; static GTY(()) tree gfc_array_descriptor_base[2 * GFC_MAX_DIMENSIONS]; @@ -403,12 +408,14 @@ gfc_init_kinds (void) if (!targetm.scalar_mode_supported_p ((enum machine_mode) mode)) continue; - /* Only let float/double/long double go through because the fortran - library assumes these are the only floating point types. */ - - if (mode != TYPE_MODE (float_type_node) + /* Only let float, double, long double and __float128 go through. + Runtime support for others is not provided, so they would be + useless. TFmode support is only enabled with option + -fsoft-float. */ + if (mode != TYPE_MODE (float_type_node) && (mode != TYPE_MODE (double_type_node)) - && (mode != TYPE_MODE (long_double_type_node))) + && (mode != TYPE_MODE (long_double_type_node)) + && (mode != TFmode)) continue; /* Let the kind equal the precision divided by 8, rounding up. Again, @@ -711,6 +718,11 @@ gfc_build_real_type (gfc_real_info *info) info->c_double = 1; if (mode_precision == LONG_DOUBLE_TYPE_SIZE) info->c_long_double = 1; + if (mode_precision != LONG_DOUBLE_TYPE_SIZE && mode_precision == 128) + { + info->c_float128 = 1; + gfc_real16_is_float128 = true; + } if (TYPE_PRECISION (float_type_node) == mode_precision) return float_type_node; @@ -835,11 +847,17 @@ gfc_init_types (void) gfc_real_kinds[index].kind); PUSH_TYPE (name_buf, type); + if (gfc_real_kinds[index].c_float128) + float128_type_node = type; + type = gfc_build_complex_type (type); gfc_complex_types[index] = type; snprintf (name_buf, sizeof(name_buf), "complex(kind=%d)", gfc_real_kinds[index].kind); PUSH_TYPE (name_buf, type); + + if (gfc_real_kinds[index].c_float128) + complex_float128_type_node = type; } for (index = 0; gfc_character_kinds[index].kind != 0; ++index) diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 63427f3..1741b9b 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -31,6 +31,8 @@ extern GTY(()) tree ppvoid_type_node; extern GTY(()) tree pvoid_type_node; extern GTY(()) tree prvoid_type_node; extern GTY(()) tree pchar_type_node; +extern GTY(()) tree float128_type_node; +extern GTY(()) tree complex_float128_type_node; /* This is the type used to hold the lengths of character variables. It must be the same as the corresponding definition in gfortran.h. */ @@ -38,6 +40,11 @@ extern GTY(()) tree pchar_type_node; and runtime library. */ extern GTY(()) tree gfc_charlen_type_node; +/* The following flags give us information on the correspondance of + real (and complex) kinds with C floating-point types long double + and __float128. */ +extern bool gfc_real16_is_float128; + typedef enum { PACKED_NO = 0, PACKED_PARTIAL, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d1f0a8c..8fc8458 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-08-27 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/32049 + * gfortran.dg/random_seed_1.f90: Adjust test. + * gfortran.dg/float128_1.f90: New test. + 2010-08-27 Tobias Burnus <burnus@net-b.de> PR fortran/33197 diff --git a/gcc/testsuite/gfortran.dg/float128_1.f90 b/gcc/testsuite/gfortran.dg/float128_1.f90 new file mode 100644 index 0000000..e045dce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/float128_1.f90 @@ -0,0 +1,28 @@ +! Check that __float128 can be used where it's supported +! +! { dg-do compile { target ia64-*-* i?86-*-* x86_64-*-* } } +! { dg-options "-fdump-tree-original" } +! { dg-final { scan-tree-dump "sqrtq" "original" } } +! { dg-final { scan-tree-dump "cabsq" "original" } } +! { dg-final { scan-tree-dump "cosl" "original" } } +! { dg-final { cleanup-tree-dump "original" } } +! + real(kind=16) :: x1, x2 + complex(kind=16) :: z1, z2 + + real(kind=10) :: y + + read (*,*) x1 + x2 = sqrt(x1) ! sqrtq + z1 = x1 + (0._16 , 1.0_16) + z2 = z1 / (1._16, 2._16) + + x1 = abs(z2) ! cabsq + + + y = 2 + y = cos(y) ! cosl + + print *, x1, x2, z1, z2, y + +end diff --git a/gcc/testsuite/gfortran.dg/random_seed_1.f90 b/gcc/testsuite/gfortran.dg/random_seed_1.f90 index 45627ff..ccbcf00 100644 --- a/gcc/testsuite/gfortran.dg/random_seed_1.f90 +++ b/gcc/testsuite/gfortran.dg/random_seed_1.f90 @@ -13,8 +13,17 @@ PROGRAM random_seed_1 IMPLICIT NONE - INTEGER, PARAMETER :: k = selected_real_kind (precision (0.0_8) + 1) - INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k == 16) + + ! Find out what the's largest kind size + INTEGER, PARAMETER :: k1 = kind (0.d0) + INTEGER, PARAMETER :: & + k2 = max (k1, selected_real_kind (precision (0._k1) + 1)) + INTEGER, PARAMETER :: & + k3 = max (k2, selected_real_kind (precision (0._k2) + 1)) + INTEGER, PARAMETER :: & + k4 = max (k3, selected_real_kind (precision (0._k3) + 1)) + + INTEGER, PARAMETER :: nbytes = MERGE(48, 32, k4 == 16) ! '+1' to avoid out-of-bounds warnings INTEGER, PARAMETER :: n = nbytes / KIND(n) + 1 |