Here are the patches I worked on today.  It does seem to fix KIND=16 to use
Float128, but by not considering long double for KIND processing, it breaks the
tests that want to do ISO C binding to long double.

Feel free to completely ignore the patches and go off in a different
direction.  But I thought it would be useful to share what I've done.

> From 443773ac040383311384577b48ecc0bd957ff328 Mon Sep 17 00:00:00 2001
> From: Michael Meissner <meiss...@linux.ibm.com>
> Date: Thu, 28 Oct 2021 23:23:53 -0400
> Subject: [PATCH] Initial patch for PowerPC Fortran KIND=16

This is a work in progress patch.  It attempts to make Fortran KIND=16 to
always mean Float128 on PowerPC VSX systems.  Unfortunately, in changing
KIND=16 to Float128, it breaks all of the ISO C bindings for long double
support in Fortran.

gcc/

2021-10-28  Michael Meissner  <meiss...@the-meissners.org>

        * config/rs6000/rs6000.h (FORTRAN_USE_FLOAT128): New macro.
        (FORTRAN_USE_LONG_DOUBLE): New macro.
        * tree.h (complex_float128_type_node): Define.
        * doc/tm.texi.in (FORTRAN_USE_FLOAT128): Add documentation.
        (FORTRAN_USE_LONG_DOUBLE): Likewise.
        * doc/tm.texi: Regenerate.

gcc/fortran/

2021-10-28  Michael Meissner  <meiss...@the-meissners.org>

        * f95-lang.c (gfc_init_builtin_functions): Flesh out more Float128
        support.
        * gfortran.h (FORTRAN_USE_LONG_DOUBLE): Provide default
        definition.
        (FORTRAN_USE_FLOAT128): Likewise.
        * trans-types.c (gfc_init_kinds): Add support for
        FORTRAN_USE_LONG_DOUBLE and FORTRAN_USE_FLOAT128.
        (gfc_build_real_type): Likewise.
        (gfc_build_complex_type): Add support for Float128 complex.
---
 gcc/config/rs6000/rs6000.h | 10 ++++++++++
 gcc/doc/tm.texi            | 13 +++++++++++++
 gcc/doc/tm.texi.in         | 13 +++++++++++++
 gcc/fortran/f95-lang.c     | 28 ++++++++++++++++++++++++++++
 gcc/fortran/gfortran.h     | 13 +++++++++++++
 gcc/fortran/trans-types.c  | 24 +++++++++++++++++-------
 gcc/tree.h                 |  2 ++
 7 files changed, 96 insertions(+), 7 deletions(-)

diff --git a/gcc/config/rs6000/rs6000.h b/gcc/config/rs6000/rs6000.h
index 3eba1c072cf..4e016e548db 100644
--- a/gcc/config/rs6000/rs6000.h
+++ b/gcc/config/rs6000/rs6000.h
@@ -2691,3 +2691,13 @@ while (0)
        rs6000_asm_output_opcode (STREAM);                              \
     }                                                                  \
   while (0)
+
+/* Whether Fortran should use long double or __float128 for KIND=16.  If we
+   support IEEE 128-bit and long double is not IEEE 128-bit, then use the
+   _Float128 type for KIND=16.  Otherwise use long double.  */
+#undef FORTRAN_USE_FLOAT128
+#define FORTRAN_USE_FLOAT128   (TARGET_FLOAT128_TYPE && !TARGET_IEEEQUAD)
+
+#undef FORTRAN_USE_LONG_DOUBLE
+#define FORTRAN_USE_LONG_DOUBLE        (!FORTRAN_USE_FLOAT128)
+
diff --git a/gcc/doc/tm.texi b/gcc/doc/tm.texi
index 902402d7503..13ecca2605c 100644
--- a/gcc/doc/tm.texi
+++ b/gcc/doc/tm.texi
@@ -12612,3 +12612,16 @@ 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
+
+@defmac FORTRAN_USE_LONG_DOUBLE
+Define this macro to return true if Fortran should enable @code{long
+double} support for @code{KIND} processing.  If you do not define this
+macro, Fortran always uses the @code{long double} type.
+@end defmac
+
+@defmac FORTRAN_USE_LONG_DOUBLE
+Define this macro to return true if Fortran should enable
+@code{_Float128} support for @code{KIND} processing.  If you do not
+define this macro, Fortran will enable @code{_Float128} support if the
+quadmath library is built, and the mode @code{TFmode} is enabled.
+@end defmac
diff --git a/gcc/doc/tm.texi.in b/gcc/doc/tm.texi.in
index 86352dc9bd2..012ef1ecc98 100644
--- a/gcc/doc/tm.texi.in
+++ b/gcc/doc/tm.texi.in
@@ -8187,3 +8187,16 @@ maintainer is familiar with.
 @hook TARGET_MEMTAG_UNTAGGED_POINTER
 
 @hook TARGET_GCOV_TYPE_SIZE
+
+@defmac FORTRAN_USE_LONG_DOUBLE
+Define this macro to return true if Fortran should enable @code{long
+double} support for @code{KIND} processing.  If you do not define this
+macro, Fortran always uses the @code{long double} type.
+@end defmac
+
+@defmac FORTRAN_USE_LONG_DOUBLE
+Define this macro to return true if Fortran should enable
+@code{_Float128} support for @code{KIND} processing.  If you do not
+define this macro, Fortran will enable @code{_Float128} support if the
+quadmath library is built, and the mode @code{TFmode} is enabled.
+@end defmac
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/gfortran.h b/gcc/fortran/gfortran.h
index c25d1cca3a8..15c940b0f31 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3791,4 +3791,17 @@ bool gfc_is_reallocatable_lhs (gfc_expr *);
 void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool);
 void gfc_adjust_builtins (void);
 
+/* Whether to enable long double and/or float128 processing.  */
+#ifndef FORTRAN_USE_LONG_DOUBLE
+#define FORTRAN_USE_LONG_DOUBLE                1
+#endif
+
+#ifndef FORTRAN_USE_FLOAT128
+#if defined(HAVE_TFmode) && defined(ENABLE_LIBQUADMATH_SUPPORT)
+#define FORTRAN_USE_FLOAT128           1
+#else
+#define FORTRAN_USE_FLOAT128           0
+#endif
+#endif
+
 #endif /* GCC_GFORTRAN_H  */
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1c78a906397..6803b832183 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -453,10 +453,10 @@ gfc_init_kinds (void)
        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
+           && (!FORTRAN_USE_LONG_DOUBLE
+               || mode != TYPE_MODE (long_double_type_node))
+           && (!FORTRAN_USE_FLOAT128
+               || mode != TYPE_MODE (float128_type_node))
           )
        continue;
 
@@ -854,9 +854,14 @@ gfc_build_real_type (gfc_real_info *info)
     info->c_float = 1;
   if (mode_precision == DOUBLE_TYPE_SIZE)
     info->c_double = 1;
-  if (mode_precision == LONG_DOUBLE_TYPE_SIZE)
+  if (FORTRAN_USE_LONG_DOUBLE && mode_precision == LONG_DOUBLE_TYPE_SIZE)
     info->c_long_double = 1;
-  if (mode_precision != LONG_DOUBLE_TYPE_SIZE && mode_precision == 128)
+
+  /* Don't check for just mode_precision == 128 for Float128.  On the PowerPC,
+     there are 3 different 128-bit floating point types (IEEE 128-bit, IBM
+     128-bit, and the default long double, which is either of the other types).
+     The precision is used to differentiate between the types.  */
+  if (FORTRAN_USE_FLOAT128 && IN_RANGE (mode_precision, 126, 128))
     {
       /* TODO: see PR101835.  */
       info->c_float128 = 1;
@@ -867,8 +872,11 @@ gfc_build_real_type (gfc_real_info *info)
     return float_type_node;
   if (TYPE_PRECISION (double_type_node) == mode_precision)
     return double_type_node;
-  if (TYPE_PRECISION (long_double_type_node) == mode_precision)
+  if (FORTRAN_USE_LONG_DOUBLE
+      && TYPE_PRECISION (long_double_type_node) == mode_precision)
     return long_double_type_node;
+  if (FORTRAN_USE_FLOAT128 && IN_RANGE (mode_precision, 126, 128))
+    return float128_type_node;
 
   new_type = make_node (REAL_TYPE);
   TYPE_PRECISION (new_type) = mode_precision;
@@ -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/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

Reply via email to