This patch replaces the first patch.
Instead of disallowing long double and only dealing with float128 types, this
patch tries to accommodate the two.
It adds target hooks so the back end can overwrite the kind number for types.
I made the IBM long double type use KIND=15 instead of KIND=16, and Float128
uses KIND=16 as we've discussed. The tests for long double are still
failing, so I suspect we will need some way of signalling about the long double
which uses a funky kind (king=15).
Again, this patch may be completely wild and crazy, as I don't really grok the
Fortran internals. But perhaps it will help somebody to take the concepts and
come up with a more workable solution.
Note, the fleshing out of full F128 support is only partially done. I
discovered that we don't have a complete set of FLOAT128 built-in functions
defined, so I couldn't just add code to DO_DEFINE_MATH_BUILTIN to make every
math function have the float128 counterpart declared. Note, that code is
probably not used right now, since the float128 support uses the 'q' functions
in libquadmath. Too fully utilize the f128 functions, you will need glibc 2.34
or later.
> From 80d617264d80eb86806aecb2db5f37adb9b37ff6 Mon Sep 17 00:00:00 2001
> From: Michael Meissner <meiss...@linux.ibm.com>
> Date: Fri, 29 Oct 2021 18:35:42 -0400
> Subject: [PATCH] Second patch for PowerPC Fortran KIND=16.
This replaces the first patch, and it is a work in progress. This patch
adds three target hooks to allow the backend to control the fortran KIND
numbers. I have modified the PowerPC back end so that KIND==16 is always
IEEE 128-bit on systems support IEEE 128-bit, and KIND=15 is the long
double type if long double is IBM 128-bit.
gcc/
2021-10-29 Michael Meissner <meiss...@the-meissners.org>
* config/rs6000/rs6000.c (TARGET_FORTRAN_REAL_KIND_NUMBER): Set
target hook.
(TARGET_FORTRAN_REAL_KIND_TYPE): Likewise.
(TARGET_FORTRAN_REAL_KIND_FLOAT128_P): Likewise.
(rs6000_fortran_real_kind_number): New target hook.
(rs6000_fortran_real_kind_type): Likewise.
(rs6000_fortran_real_kind_float128_p): Likewise.
* target.def (fortran_real_kind_number): New target hook.
(fortran_real_kind_type): Likewise.
(fortran_real_kind_float128_p): Likewise.
* targhooks.c (default_fortran_real_kind_number): New default
target hooks for Fortran kind support.
(default_fortran_real_kind_type): Likewise.
(default_fortran_real_kind_float128_p): Likewise.
* targhooks.h (default_fortran_real_kind_number): New
declaration.
(default_fortran_real_kind_type): Likewise.
(default_fortran_real_kind_float128_p): Likewise.
* tree.h (complex_float128_type_node): New define.
* doc/tm.texi.in (TARGET_FORTRAN_REAL_KIND_*): Document new target
hooks.
* doc/tm.texi: Regenerate.
gcc/fortran/
2021-10-29 Michael Meissner <meiss...@the-meissners.org>
* f95-lang.c (gfc_init_builtin_functions): Flesh out more Float128
support.
* trans-types.c (gfc_init_kinds): Add support for using target
hooks to allow the backend to control KIND numbers.
(gfc_build_real_type): Likewise.
(gfc_build_complex_type): Add support for complex Float128.
---
gcc/config/rs6000/rs6000.c | 101 +++++++++++++++++++++++++++++++++++++
gcc/doc/tm.texi | 17 +++++++
gcc/doc/tm.texi.in | 6 +++
gcc/fortran/f95-lang.c | 28 ++++++++++
gcc/fortran/trans-types.c | 32 ++++++++----
gcc/target.def | 22 +++++++-
gcc/targhooks.c | 37 ++++++++++++++
gcc/targhooks.h | 3 ++
gcc/tree.h | 2 +
9 files changed, 236 insertions(+), 12 deletions(-)
diff --git a/gcc/config/rs6000/rs6000.c b/gcc/config/rs6000/rs6000.c
index 22f5d701908..70595e58ac2 100644
--- a/gcc/config/rs6000/rs6000.c
+++ b/gcc/config/rs6000/rs6000.c
@@ -1787,6 +1787,15 @@ static const struct attribute_spec
rs6000_attribute_table[] =
#undef TARGET_INVALID_CONVERSION
#define TARGET_INVALID_CONVERSION rs6000_invalid_conversion
+
+#undef TARGET_FORTRAN_REAL_KIND_NUMBER
+#define TARGET_FORTRAN_REAL_KIND_NUMBER rs6000_fortran_real_kind_number
+
+#undef TARGET_FORTRAN_REAL_KIND_TYPE
+#define TARGET_FORTRAN_REAL_KIND_TYPE rs6000_fortran_real_kind_type
+
+#undef TARGET_FORTRAN_REAL_KIND_FLOAT128_P
+#define TARGET_FORTRAN_REAL_KIND_FLOAT128_P rs6000_fortran_real_kind_float128_p
/* Processor table. */
@@ -28376,6 +28385,98 @@ rs6000_globalize_decl_name (FILE * stream, tree decl)
}
#endif
+
+
+/* PowerPC support for Fortran KIND support. Given a MODE, return a kind
+ number to be used for real modes. If we support IEEE 128-bit, make KIND=16
+ always be IEEE 128-bit, and make KIND=15 be the IBM 128-bit double-double
+ format. */
+
+static int
+rs6000_fortran_real_kind_number (machine_mode mode)
+{
+ if (TARGET_FLOAT128_TYPE)
+ {
+ /* If long double is IEEE 128-bit, return 16 for long double and 15 for
+ __ibm128, and ignore the explicit __float128 type. Otherwise return
+ 15 for long double, 16 for __float128, and ignore __ibm128. */
+ if (FLOAT128_IEEE_P (TFmode))
+ {
+ if (mode == TFmode)
+ return 16;
+ else if (mode == IFmode)
+ return 15;
+ }
+ else
+ {
+ if (mode == KFmode)
+ return 16;
+ else if (mode == TFmode)
+ return 15;
+ }
+ }
+
+ return 0;
+}
+
+/* PowerPC support for Fortran KIND support. Return a type given a precision
+ that Fortran will handle for kind support. We don't have to support the
+ standard types. */
+static tree
+rs6000_fortran_real_kind_type (int precision)
+{
+ if (TARGET_FLOAT128_TYPE)
+ {
+ switch (precision)
+ {
+ case FLOAT_PRECISION_TFmode:
+ return long_double_type_node;
+
+ case FLOAT_PRECISION_IFmode:
+ return (FLOAT128_IBM_P (TFmode)
+ ? long_double_type_node
+ : ibm128_float_type_node);
+
+ case FLOAT_PRECISION_KFmode:
+ return (FLOAT128_IEEE_P (TFmode)
+ ? long_double_type_node
+ : float128_type_node);
+
+ default:
+ break;
+ }
+ }
+
+ return NULL_TREE;
+}
+
+/* PowerPC support for Fortran KIND support. Return true given a precision for
+ a floating point scalar type that Fortran will handle for kind support. We
+ don't have to handle the standard types here. */
+static bool
+rs6000_fortran_real_kind_float128_p (int precision)
+{
+ if (TARGET_FLOAT128_TYPE)
+ {
+ switch (precision)
+ {
+ case FLOAT_PRECISION_TFmode:
+ return FLOAT128_IEEE_P (TFmode);
+
+ case FLOAT_PRECISION_IFmode:
+ return false;
+
+ case FLOAT_PRECISION_KFmode:
+ return true;
+
+ default:
+ break;
+ }
+ }
+
+ return NULL_TREE;
+}
+
/* On 64-bit Linux and Freebsd systems, possibly switch the long double library
function names from <foo>l to <foo>f128 if the default long double type is
diff --git a/gcc/doc/tm.texi b/gcc/doc/tm.texi
index 902402d7503..e9743d791d2 100644
--- a/gcc/doc/tm.texi
+++ b/gcc/doc/tm.texi
@@ -12612,3 +12612,20 @@ counters are incremented using atomic operations.
Targets not supporting
64-bit atomic operations may override the default value and request a 32-bit
type.
@end deftypefn
+
+@deftypefn {Target Hook} int TARGET_FORTRAN_REAL_KIND_NUMBER (machine_mode
@var{mode})
+Returns an integer from a @code{MODE} that would be the Fortran kind
+number for target specific modes. @code{MODE} is a scalar floating point
+mode. If the mode cannot be represented, a 0 is returned.
+@end deftypefn
+
+@deftypefn {Target Hook} tree TARGET_FORTRAN_REAL_KIND_TYPE (int
@var{precision})
+Returns a floating point scalar type with precision @code{PRECISION} that
+can be used for a Fortran kind type. If the precision cannot be represented,
+a @code{NULL_TREE} is returned.
+@end deftypefn
+
+@deftypefn {Target Hook} bool TARGET_FORTRAN_REAL_KIND_FLOAT128_P (int
@var{precision})
+Returns true if the floating point scalar type with precision
+@code{PRECISION} is an IEEE 128-bit floating point value.
+@end deftypefn
diff --git a/gcc/doc/tm.texi.in b/gcc/doc/tm.texi.in
index 86352dc9bd2..28ae369e588 100644
--- a/gcc/doc/tm.texi.in
+++ b/gcc/doc/tm.texi.in
@@ -8187,3 +8187,9 @@ maintainer is familiar with.
@hook TARGET_MEMTAG_UNTAGGED_POINTER
@hook TARGET_GCOV_TYPE_SIZE
+
+@hook TARGET_FORTRAN_REAL_KIND_NUMBER
+
+@hook TARGET_FORTRAN_REAL_KIND_TYPE
+
+@hook TARGET_FORTRAN_REAL_KIND_FLOAT128_P
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 58dcaf01d75..b8117dc72b4 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -674,9 +674,11 @@ gfc_init_builtin_functions (void)
tree mfunc_float[6];
tree mfunc_double[6];
tree mfunc_longdouble[6];
+ tree mfunc_float128[6];
tree mfunc_cfloat[6];
tree mfunc_cdouble[6];
tree mfunc_clongdouble[6];
+ tree mfunc_cfloat128[6];
tree func_cfloat_float, func_float_cfloat;
tree func_cdouble_double, func_double_cdouble;
tree func_clongdouble_longdouble, func_longdouble_clongdouble;
@@ -691,9 +693,11 @@ gfc_init_builtin_functions (void)
build_builtin_fntypes (mfunc_float, float_type_node);
build_builtin_fntypes (mfunc_double, double_type_node);
build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
+ build_builtin_fntypes (mfunc_float128, float128_type_node);
build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
+ build_builtin_fntypes (mfunc_cfloat128, complex_float128_type_node);
func_cfloat_float = build_function_type_list (float_type_node,
complex_float_type_node,
@@ -736,6 +740,8 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0],
BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
+ gfc_define_builtin ("__builtin_roundf128", mfunc_float128[0],
+ BUILT_IN_ROUNDF128, "roundf128",
ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_round", mfunc_double[0],
BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_roundf", mfunc_float[0],
@@ -743,6 +749,8 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
+ gfc_define_builtin ("__builtin_truncf128", mfunc_float128[0],
+ BUILT_IN_TRUNCF128, "truncl",
ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
@@ -750,6 +758,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble,
BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_cabsf128. */
gfc_define_builtin ("__builtin_cabs", func_cdouble_double,
BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_cabsf", func_cfloat_float,
@@ -758,6 +767,9 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1],
BUILT_IN_COPYSIGNL, "copysignl",
ATTR_CONST_NOTHROW_LEAF_LIST);
+ gfc_define_builtin ("__builtin_copysignf128", mfunc_longdouble[1],
+ BUILT_IN_COPYSIGNF128, "copysignf128",
+ ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_copysign", mfunc_double[1],
BUILT_IN_COPYSIGN, "copysign",
ATTR_CONST_NOTHROW_LEAF_LIST);
@@ -768,6 +780,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1],
BUILT_IN_NEXTAFTERL, "nextafterl",
ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_nextafterf128. */
gfc_define_builtin ("__builtin_nextafter", mfunc_double[1],
BUILT_IN_NEXTAFTER, "nextafter",
ATTR_CONST_NOTHROW_LEAF_LIST);
@@ -781,6 +794,8 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_rintl", mfunc_longdouble[0],
BUILT_IN_RINTL, "rintl", attr);
+ gfc_define_builtin ("__builtin_rintf128", mfunc_float128[0],
+ BUILT_IN_RINTF128, "rintf128", attr);
gfc_define_builtin ("__builtin_rint", mfunc_double[0],
BUILT_IN_RINT, "rint", attr);
gfc_define_builtin ("__builtin_rintf", mfunc_float[0],
@@ -788,6 +803,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_remainderl", mfunc_longdouble[1],
BUILT_IN_REMAINDERL, "remainderl", attr);
+ /* no __builtin_remainderf128. */
gfc_define_builtin ("__builtin_remainder", mfunc_double[1],
BUILT_IN_REMAINDER, "remainder", attr);
gfc_define_builtin ("__builtin_remainderf", mfunc_float[1],
@@ -795,6 +811,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_logbl", mfunc_longdouble[0],
BUILT_IN_LOGBL, "logbl", ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_logbf128. */
gfc_define_builtin ("__builtin_logb", mfunc_double[0],
BUILT_IN_LOGB, "logb", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_logbf", mfunc_float[0],
@@ -803,6 +820,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4],
BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
+ /* no __builtin_frexpf128. */
gfc_define_builtin ("__builtin_frexp", mfunc_double[4],
BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_frexpf", mfunc_float[4],
@@ -810,6 +828,8 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0],
BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
+ gfc_define_builtin ("__builtin_fabsf128", mfunc_float128[0],
+ BUILT_IN_FABSF128, "fabsf128",
ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_fabs", mfunc_double[0],
BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_fabsf", mfunc_float[0],
@@ -817,6 +837,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[2],
BUILT_IN_SCALBNL, "scalbnl",
ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_scalbnf128. */
gfc_define_builtin ("__builtin_scalbn", mfunc_double[2],
BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_scalbnf", mfunc_float[2],
@@ -824,6 +845,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1],
BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_fmodf128. */
gfc_define_builtin ("__builtin_fmod", mfunc_double[1],
BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_fmodf", mfunc_float[1],
@@ -872,18 +894,21 @@ gfc_init_builtin_functions (void)
/* These are used to implement the ** operator. */
gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1],
BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_powf128. */
gfc_define_builtin ("__builtin_pow", mfunc_double[1],
BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_powf", mfunc_float[1],
BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1],
BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_cpowf128. */
gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1],
BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1],
BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2],
BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_powif128. */
gfc_define_builtin ("__builtin_powi", mfunc_double[2],
BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_powif", mfunc_float[2],
@@ -895,6 +920,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
BUILT_IN_CBRTL, "cbrtl",
ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_cbrtf128. */
gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
BUILT_IN_CBRT, "cbrt",
ATTR_CONST_NOTHROW_LEAF_LIST);
@@ -904,6 +930,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble,
BUILT_IN_CEXPIL, "cexpil",
ATTR_CONST_NOTHROW_LEAF_LIST);
+ /* no __builtin_cexpif128. */
gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
BUILT_IN_CEXPI, "cexpi",
ATTR_CONST_NOTHROW_LEAF_LIST);
@@ -917,6 +944,7 @@ gfc_init_builtin_functions (void)
gfc_define_builtin ("__builtin_sincosl",
func_longdouble_longdoublep_longdoublep,
BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
+ /* no __builtin_sincosf128. */
gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1c78a906397..4b2885de3f1 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -451,14 +451,6 @@ gfc_init_kinds (void)
useless. */
if (!targetm.libgcc_floating_mode_supported_p (mode))
continue;
- if (mode != TYPE_MODE (float_type_node)
- && (mode != TYPE_MODE (double_type_node))
- && (mode != TYPE_MODE (long_double_type_node))
-#if defined(HAVE_TFmode) && defined(ENABLE_LIBQUADMATH_SUPPORT)
- && (mode != TFmode)
-#endif
- )
- continue;
/* Let the kind equal the precision divided by 8, rounding up. Again,
this insulates the programmer from the underlying byte size.
@@ -480,7 +472,9 @@ gfc_init_kinds (void)
reach this code.
*/
- kind = (GET_MODE_PRECISION (mode) + 7) / 8;
+ kind = targetm.fortran_real_kind_number (mode);
+ if (kind == 0)
+ kind = (GET_MODE_PRECISION (mode) + 7) / 8;
if (kind == 4)
saw_r4 = true;
@@ -856,12 +850,26 @@ 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)
- {
+
+#if defined(HAVE_TFmode) && defined(ENABLE_LIBQUADMATH_SUPPORT)
+ if (TYPE_PRECISION (float128_type_node) == mode_precision)
+ {
/* TODO: see PR101835. */
info->c_float128 = 1;
gfc_real16_is_float128 = true;
}
+#endif
+
+ tree type = targetm.fortran_real_kind_type (mode_precision);
+ if (type)
+ {
+ if (type == float128_type_node)
+ {
+ info->c_float128 = 1;
+ gfc_real16_is_float128 = true;
+ }
+ return type;
+ }
if (TYPE_PRECISION (float_type_node) == mode_precision)
return float_type_node;
@@ -889,6 +897,8 @@ gfc_build_complex_type (tree scalar_type)
return complex_double_type_node;
if (scalar_type == long_double_type_node)
return complex_long_double_type_node;
+ if (scalar_type == float128_type_node)
+ return complex_float128_type_node;
new_type = make_node (COMPLEX_TYPE);
TREE_TYPE (new_type) = scalar_type;
diff --git a/gcc/target.def b/gcc/target.def
index c5d90cace80..308649779fa 100644
--- a/gcc/target.def
+++ b/gcc/target.def
@@ -7129,6 +7129,26 @@ counters are incremented using atomic operations.
Targets not supporting\n\
type.",
HOST_WIDE_INT, (void), default_gcov_type_size)
-/* Close the 'struct gcc_target' definition. */
+DEFHOOK
+(fortran_real_kind_number,
+ "Returns an integer from a @code{MODE} that would be the Fortran kind\n\
+number for target specific modes. @code{MODE} is a scalar floating point\n\
+mode. If the mode cannot be represented, a 0 is returned.",
+ int, (machine_mode mode), default_fortran_real_kind_number)
+
+DEFHOOK
+(fortran_real_kind_type,
+ "Returns a floating point scalar type with precision @code{PRECISION} that\n\
+can be used for a Fortran kind type. If the precision cannot be
represented,\n\
+a @code{NULL_TREE} is returned.",
+ tree, (int precision), default_fortran_real_kind_type)
+
+DEFHOOK
+(fortran_real_kind_float128_p,
+ "Returns true if the floating point scalar type with precision\n\
+@code{PRECISION} is an IEEE 128-bit floating point value.",
+ bool, (int precision), default_fortran_real_kind_float128_p)
+
+ /* Close the 'struct gcc_target' definition. */
HOOK_VECTOR_END (C90_EMPTY_HACK)
diff --git a/gcc/targhooks.c b/gcc/targhooks.c
index cbbcedf790f..cc15539ffdb 100644
--- a/gcc/targhooks.c
+++ b/gcc/targhooks.c
@@ -2661,4 +2661,41 @@ default_gcov_type_size (void)
return TYPE_PRECISION (long_long_integer_type_node) > 32 ? 64 : 32;
}
+/* The default implementation of TARGET_FORTRAN_REAL_KIND_NUMBER. */
+
+int
+default_fortran_real_kind_number (machine_mode mode ATTRIBUTE_UNUSED)
+{
+#if defined(HAVE_TFmode) && defined(ENABLE_LIBQUADMATH_SUPPORT)
+ if (mode == TFmode)
+ return GET_MODE_SIZE (TFmode);
+#endif
+
+ return 0;
+}
+
+/* The default implementation of TARGET_FORTRAN_REAL_KIND_TYPE. */
+tree
+default_fortran_real_kind_type (int precision ATTRIBUTE_UNUSED)
+{
+#if defined(HAVE_TFmode) && defined(ENABLE_LIBQUADMATH_SUPPORT)
+ if (precision == TYPE_PRECISION (float128_type_node))
+ return float128_type_node;
+#endif
+
+ return NULL_TREE;
+}
+
+/* The default implementation of TARGET_FORTRAN_REAL_KIND_FLOAT128_p. */
+bool
+default_fortran_real_kind_float128_p (int precision ATTRIBUTE_UNUSED)
+{
+#if defined(HAVE_TFmode) && defined(ENABLE_LIBQUADMATH_SUPPORT)
+ if (precision == TYPE_PRECISION (float128_type_node))
+ return true;
+#endif
+
+ return false;
+}
+
#include "gt-targhooks.h"
diff --git a/gcc/targhooks.h b/gcc/targhooks.h
index 92d51992e62..c5f9cd08450 100644
--- a/gcc/targhooks.h
+++ b/gcc/targhooks.h
@@ -304,4 +304,7 @@ extern rtx default_memtag_untagged_pointer (rtx, rtx);
extern HOST_WIDE_INT default_gcov_type_size (void);
+extern int default_fortran_real_kind_number (machine_mode);
+extern tree default_fortran_real_kind_type (int);
+extern bool default_fortran_real_kind_float128_p (int);
#endif /* GCC_TARGHOOKS_H */
diff --git a/gcc/tree.h b/gcc/tree.h
index 7542d97ce12..f3b47f81a09 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -4225,6 +4225,8 @@ tree_strip_any_location_wrapper (tree exp)
#define complex_double_type_node global_trees[TI_COMPLEX_DOUBLE_TYPE]
#define complex_long_double_type_node
global_trees[TI_COMPLEX_LONG_DOUBLE_TYPE]
+#define complex_float128_type_node global_trees[TI_COMPLEX_FLOAT128_TYPE]
+
#define COMPLEX_FLOATN_NX_TYPE_NODE(IDX)
global_trees[TI_COMPLEX_FLOATN_NX_TYPE_FIRST + (IDX)]
#define void_type_node global_trees[TI_VOID_TYPE]
--
2.31.1
--
Michael Meissner, IBM
PO Box 98, Ayer, Massachusetts, USA, 01432
email: meiss...@linux.ibm.com
