+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
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"
unsigned int c_float : 1;
unsigned int c_double : 1;
unsigned int c_long_double : 1;
+ unsigned int c_float128 : 1;
}
gfc_real_info;
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)
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[] =
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]);
}
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);
}
}
+
+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. */
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;
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];
+ }
}
}
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 ();
}
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];
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,
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;
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)
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. */
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,
+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
--- /dev/null
+! 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
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
projects / thirdparty / gcc.git / commitdiff
