re PR fortran/32049 (Support on x86_64 also kind=16)
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. * gfortran.dg/random_seed_1.f90: Adjust test. * gfortran.dg/float128_1.f90: New test. From-SVN: r163597
This commit is contained in:
Francois-Xavier Coudert
François-Xavier Coudert
parent
6ba2db5e33
commit
a3c85b7499
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 ();
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue