[gcc(refs/users/meissner/heads/work071)] Second patch for PowerPC Fortran KIND=16.

Michael Meissner meissner@gcc.gnu.org
Fri Oct 29 22:36:02 GMT 2021


https://gcc.gnu.org/g:80d617264d80eb86806aecb2db5f37adb9b37ff6

commit 80d617264d80eb86806aecb2db5f37adb9b37ff6
Author: Michael Meissner <meissner@linux.ibm.com>
Date:   Fri Oct 29 18:35:42 2021 -0400

    Second patch for PowerPC Fortran KIND=16.
    
    This replaces the first patch, and it is a work in progress.  This patch
    adds two 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  <meissner@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  <meissner@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.

Diff:
---
 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]


More information about the Gcc-cvs mailing list