public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-6498] fortran, libgfortran: -mabi=ieeelongdouble I/O
@ 2022-01-11 22:51 Jakub Jelinek
  0 siblings, 0 replies; only message in thread
From: Jakub Jelinek @ 2022-01-11 22:51 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:07c60b8e33c614a6cdd9fe3de7f409319b6a239a

commit r12-6498-g07c60b8e33c614a6cdd9fe3de7f409319b6a239a
Author: Jakub Jelinek <jakub@redhat.com>
Date:   Tue Jan 4 10:37:48 2022 +0100

    fortran, libgfortran: -mabi=ieeelongdouble I/O
    
    The following patch adds the compiler and library side of -mabi=ieeelongdouble
    I/O support.
    
    2022-01-04  Jakub Jelinek  <jakub@redhat.com>
    
    gcc/fortran/
            * trans-io.c (transfer_namelist_element): Use gfc_type_abi_kind,
            formatting fixes.
            (transfer_expr): Use gfc_type_abi_kind, use *REAL128* APIs even
            for abi_kind == 17.
    libgfortran/
            * libgfortran.h (__acoshieee128, __acosieee128, __asinhieee128,
            __asinieee128, __atan2ieee128, __atanhieee128, __atanieee128,
            __coshieee128, __cosieee128, __erfieee128, __expieee128,
            __fabsieee128, __jnieee128, __log10ieee128, __logieee128,
            __powieee128, __sinhieee128, __sinieee128, __sqrtieee128,
            __tanhieee128, __tanieee128, __ynieee128): Formatting fixes.
            (__strtoieee128, __snprintfieee128): Declare.
            * io/io.h (default_width_for_float, default_precision_for_float):
            Handle kind == 17.
            * io/size_from_kind.c (size_from_real_kind, size_from_complex_kind):
            Likewise.
            * io/read.c (set_integer, si_max, convert_real, convert_infnan,
            read_f): Likewise.
            * io/write.c (extract_uint, size_from_kind, set_fnode_default):
            Likewise.
            * io/write_float.def (DTOA2Q, FDTOA2Q): Define for HAVE_GFC_REAL_17.
            (determine_en_precision, get_float_string): Handle kind == 17.
            * io/transfer128.c: Use also for HAVE_GFC_REAL_17, but don't drag in
            libquadmath if POWER_IEEE128.
            * Makefile.am (comma, PREPROCESS): New variables.
            (gfortran.ver): New goal.
            (version_arg, version_dep): Use gfortran.ver instead of
            $(srcdir)/gfortran.map.
            (gfortran.map-sun): Depend on and use gfortran.ver instead of
            $(srcdir)/gfortran.map.
            (BUILT_SOURCES): Add $(version_dep).
            * Makefile.in: Regenerated.
            * gfortran.map (GFORTRAN_8): Don't export
            _gfortran_transfer_complex128, _gfortran_transfer_complex128_write,
            _gfortran_transfer_real128 and _gfortran_transfer_real128_write if
            HAVE_GFC_REAL_17 is defined.
            (GFORTRAN_12): Export those here instead.

Diff:
---
 gcc/fortran/trans-io.c          | 29 +++++++++--------
 libgfortran/Makefile.am         | 22 ++++++++-----
 libgfortran/Makefile.in         | 22 ++++++++-----
 libgfortran/gfortran.map        | 10 ++++++
 libgfortran/io/io.h             |  6 ++--
 libgfortran/io/read.c           | 41 +++++++++++++++++++++++-
 libgfortran/io/size_from_kind.c |  8 +++++
 libgfortran/io/transfer128.c    |  4 ++-
 libgfortran/io/write.c          | 19 +++++++++++
 libgfortran/io/write_float.def  | 37 ++++++++++++++++++----
 libgfortran/libgfortran.h       | 70 ++++++++++++++++++++++++++++-------------
 11 files changed, 207 insertions(+), 61 deletions(-)

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 92b66be746b..2730b47501b 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1765,18 +1765,17 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
   else
     tmp = build_int_cst (gfc_charlen_type_node, 0);
 
+  int abi_kind = gfc_type_abi_kind (ts);
   if (dtio_proc == null_pointer_node)
-    tmp = build_call_expr_loc (input_location,
-			   iocall[IOCALL_SET_NML_VAL], 6,
-			   dt_parm_addr, addr_expr, string,
-			   build_int_cst (gfc_int4_type_node, ts->kind),
-			   tmp, dtype);
+    tmp = build_call_expr_loc (input_location, iocall[IOCALL_SET_NML_VAL], 6,
+			       dt_parm_addr, addr_expr, string,
+			       build_int_cst (gfc_int4_type_node, abi_kind),
+			       tmp, dtype);
   else
-    tmp = build_call_expr_loc (input_location,
-			   iocall[IOCALL_SET_NML_DTIO_VAL], 8,
-			   dt_parm_addr, addr_expr, string,
-			   build_int_cst (gfc_int4_type_node, ts->kind),
-			   tmp, dtype, dtio_proc, vtable);
+    tmp = build_call_expr_loc (input_location, iocall[IOCALL_SET_NML_DTIO_VAL],
+			       8, dt_parm_addr, addr_expr, string,
+			       build_int_cst (gfc_int4_type_node, abi_kind),
+			       tmp, dtype, dtio_proc, vtable);
   gfc_add_expr_to_block (block, tmp);
 
   /* If the object is an array, transfer rank times:
@@ -2298,7 +2297,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
       ts->kind = gfc_index_integer_kind;
     }
 
-  kind = ts->kind;
+  kind = gfc_type_abi_kind (ts);
   function = NULL;
   arg2 = NULL;
   arg3 = NULL;
@@ -2318,14 +2317,14 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
       arg2 = build_int_cst (integer_type_node, kind);
       if (last_dt == READ)
 	{
-	  if (gfc_real16_is_float128 && ts->kind == 16)
+	  if ((gfc_real16_is_float128 && kind == 16) || kind == 17)
 	    function = iocall[IOCALL_X_REAL128];
 	  else
 	    function = iocall[IOCALL_X_REAL];
 	}
       else
 	{
-	  if (gfc_real16_is_float128 && ts->kind == 16)
+	  if ((gfc_real16_is_float128 && kind == 16) || kind == 17)
 	    function = iocall[IOCALL_X_REAL128_WRITE];
 	  else
 	    function = iocall[IOCALL_X_REAL_WRITE];
@@ -2337,14 +2336,14 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
       arg2 = build_int_cst (integer_type_node, kind);
       if (last_dt == READ)
 	{
-	  if (gfc_real16_is_float128 && ts->kind == 16)
+	  if ((gfc_real16_is_float128 && kind == 16) || kind == 17)
 	    function = iocall[IOCALL_X_COMPLEX128];
 	  else
 	    function = iocall[IOCALL_X_COMPLEX];
 	}
       else
 	{
-	  if (gfc_real16_is_float128 && ts->kind == 16)
+	  if ((gfc_real16_is_float128 && kind == 16) || kind == 17)
 	    function = iocall[IOCALL_X_COMPLEX128_WRITE];
 	  else
 	    function = iocall[IOCALL_X_COMPLEX_WRITE];
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 26b9eb1b186..9fb12ba3d7f 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -8,18 +8,26 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
 
 ## Symbol versioning (copied from libssp).
 if LIBGFOR_USE_SYMVER
+# -Wc is only a libtool option.
+comma = ,
+PREPROCESS = $(subst -Wc$(comma), , $(COMPILE)) -E
+
+gfortran.ver: $(srcdir)/gfortran.map kinds.inc
+	$(EGREP) -v '#(#| |$$)' $< | \
+	  $(PREPROCESS) -P -include config.h -include kinds.inc - > $@ || (rm -f $@ ; exit 1)
+
 if LIBGFOR_USE_SYMVER_GNU
-version_arg = -Wl,--version-script=$(srcdir)/gfortran.map
-version_dep = $(srcdir)/gfortran.map
+version_arg = -Wl,--version-script=gfortran.ver
+version_dep = gfortran.ver
 endif
 if LIBGFOR_USE_SYMVER_SUN
-version_arg = -Wl,-M,gfortran.map-sun
-version_dep = gfortran.map-sun
-gfortran.map-sun : $(srcdir)/gfortran.map \
+version_arg = -Wl,-M,gfortran.ver-sun
+version_dep = gfortran.ver-sun gfortran.ver
+gfortran.map-sun : gfortran.ver \
 		$(top_srcdir)/../contrib/make_sunver.pl \
 		$(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD)
 	perl $(top_srcdir)/../contrib/make_sunver.pl \
-	  $(srcdir)/gfortran.map \
+	  gfortran.ver \
 	  $(libgfortran_la_OBJECTS:%.lo=.libs/%.o) \
 	 `echo $(libgfortran_la_LIBADD) | \
 	    sed 's,/\([^/.]*\)\.la,/.libs/\1.a,g'` \
@@ -1110,7 +1118,7 @@ ieee_arithmetic.mod: ieee_arithmetic.lo
 	:
 
 BUILT_SOURCES=$(gfor_built_src) $(gfor_built_specific_src) \
-	$(gfor_built_specific2_src) $(gfor_misc_specifics)
+	$(gfor_built_specific2_src) $(gfor_misc_specifics) $(version_dep)
 
 prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
 	$(gfor_helper_src) $(gfor_ieee_src) $(gfor_io_headers) $(gfor_specific_src)
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 1bfb07dda6c..da0ad684d21 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -738,12 +738,16 @@ top_builddir = @top_builddir@
 top_srcdir = @top_srcdir@
 ACLOCAL_AMFLAGS = -I .. -I ../config
 gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
+
+# -Wc is only a libtool option.
+@LIBGFOR_USE_SYMVER_TRUE@comma = ,
+@LIBGFOR_USE_SYMVER_TRUE@PREPROCESS = $(subst -Wc$(comma), , $(COMPILE)) -E
 @LIBGFOR_USE_SYMVER_FALSE@version_arg = 
-@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,--version-script=$(srcdir)/gfortran.map
-@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,-M,gfortran.map-sun
+@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,--version-script=gfortran.ver
+@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,-M,gfortran.ver-sun
 @LIBGFOR_USE_SYMVER_FALSE@version_dep = 
-@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = $(srcdir)/gfortran.map
-@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.map-sun
+@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.ver
+@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.ver-sun gfortran.ver
 gfor_c_HEADERS = ISO_Fortran_binding.h
 gfor_cdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include
 LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \
@@ -1648,7 +1652,7 @@ intrinsics/random_init.f90
 
 BUILT_SOURCES = $(gfor_built_src) $(gfor_built_specific_src) \
 	$(gfor_built_specific2_src) $(gfor_misc_specifics) \
-	$(am__append_7)
+	$(version_dep) $(am__append_7)
 prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
 	$(gfor_helper_src) $(gfor_ieee_src) $(gfor_io_headers) $(gfor_specific_src)
 
@@ -7607,11 +7611,15 @@ uninstall-am: uninstall-cafexeclibLTLIBRARIES uninstall-gfor_cHEADERS \
 
 .PRECIOUS: Makefile
 
-@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@gfortran.map-sun : $(srcdir)/gfortran.map \
+
+@LIBGFOR_USE_SYMVER_TRUE@gfortran.ver: $(srcdir)/gfortran.map kinds.inc
+@LIBGFOR_USE_SYMVER_TRUE@	$(EGREP) -v '#(#| |$$)' $< | \
+@LIBGFOR_USE_SYMVER_TRUE@	  $(PREPROCESS) -P -include config.h -include kinds.inc - > $@ || (rm -f $@ ; exit 1)
+@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@gfortran.map-sun : gfortran.ver \
 @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@		$(top_srcdir)/../contrib/make_sunver.pl \
 @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@		$(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD)
 @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@	perl $(top_srcdir)/../contrib/make_sunver.pl \
-@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@	  $(srcdir)/gfortran.map \
+@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@	  gfortran.ver \
 @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@	  $(libgfortran_la_OBJECTS:%.lo=.libs/%.o) \
 @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@	 `echo $(libgfortran_la_LIBADD) | \
 @LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@	    sed 's,/\([^/.]*\)\.la,/.libs/\1.a,g'` \
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 8937b4a2903..e0e795c3d48 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1295,8 +1295,10 @@ GFORTRAN_8 {
     _gfortran_transfer_character_wide;
     _gfortran_transfer_character_wide_write;
     _gfortran_transfer_character_write;
+#ifndef HAVE_GFC_REAL_17
     _gfortran_transfer_complex128;
     _gfortran_transfer_complex128_write;
+#endif
     _gfortran_transfer_complex;
     _gfortran_transfer_complex_write;
     _gfortran_transfer_derived;
@@ -1304,8 +1306,10 @@ GFORTRAN_8 {
     _gfortran_transfer_integer_write;
     _gfortran_transfer_logical;
     _gfortran_transfer_logical_write;
+#ifndef HAVE_GFC_REAL_17
     _gfortran_transfer_real128;
     _gfortran_transfer_real128_write;
+#endif
     _gfortran_transfer_real;
     _gfortran_transfer_real_write;
     _gfortran_ttynam;
@@ -1748,4 +1752,10 @@ GFORTRAN_12 {
   _gfortran_sproduct_c17;
   _gfortran_ssum_c17;
   _gfortran_sum_c17;
+#ifdef HAVE_GFC_REAL_17
+  _gfortran_transfer_complex128;
+  _gfortran_transfer_complex128_write;
+  _gfortran_transfer_real128;
+  _gfortran_transfer_real128_write;
+#endif
 } GFORTRAN_10.2;
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index b2267d52579..23f63d4593c 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -1063,7 +1063,8 @@ default_width_for_float (int kind)
     {
     case 4:  return 15;
     case 8:  return 25;
-    case 16: return 42;
+    case 16:
+    case 17: return 42;
     default: return  0;
     }
 }
@@ -1075,7 +1076,8 @@ default_precision_for_float (int kind)
     {
     case 4:  return 7;
     case 8:  return 16;
-    case 16: return 33;
+    case 16:
+    case 17: return 33;
     default: return 0;
     }
 }
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 52e98fb2593..49d7983a037 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -46,6 +46,14 @@ set_integer (void *dest, GFC_INTEGER_LARGEST value, int length)
   switch (length)
     {
 #ifdef HAVE_GFC_INTEGER_16
+#ifdef HAVE_GFC_REAL_17
+    case 17:
+      {
+	GFC_INTEGER_16 tmp = value;
+	memcpy (dest, (void *) &tmp, 16);
+      }
+      break;
+#endif
 /* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */
     case 10:
     case 16:
@@ -95,7 +103,14 @@ si_max (int length)
 #endif
 
   switch (length)
-      {
+    {
+#if defined HAVE_GFC_REAL_17
+    case 17:
+      value = 1;
+      for (int n = 1; n < 4 * 16; n++)
+	value = (value << 2) + 3;
+      return value;
+#endif
 #if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10
     case 16:
     case 10:
@@ -178,6 +193,15 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
       *((GFC_REAL_16*) dest) = gfc_strtold (buffer, &endptr);
       break;
 # endif
+#endif
+
+#if defined(HAVE_GFC_REAL_17)
+    case 17:
+# if defined(POWER_IEEE128)
+      *((GFC_REAL_17*) dest) = __strtoieee128 (buffer, &endptr);
+# else
+      *((GFC_REAL_17*) dest) = __qmath_(strtoflt128) (buffer, &endptr);
+# endif
 #endif
 
     default:
@@ -259,6 +283,15 @@ convert_infnan (st_parameter_dt *dtp, void *dest, const char *buffer,
 # endif
 #endif
 
+#if defined(HAVE_GFC_REAL_17)
+    case 17:
+      if (is_inf)
+	*((GFC_REAL_17*) dest) = plus ? __builtin_infl () : -__builtin_infl ();
+      else
+	*((GFC_REAL_17*) dest) = plus ? __builtin_nanl ("") : -__builtin_nanl ("");
+      break;
+#endif
+
     default:
       internal_error (&dtp->common, "Unsupported real kind during IO");
     }
@@ -1224,6 +1257,12 @@ zero:
 	break;
 #endif
 
+#ifdef HAVE_GFC_REAL_17
+      case 17:
+	*((GFC_REAL_17 *) dest) = 0.0;
+	break;
+#endif
+
       default:
 	internal_error (&dtp->common, "Unsupported real kind during IO");
     }
diff --git a/libgfortran/io/size_from_kind.c b/libgfortran/io/size_from_kind.c
index 6601a0f9a44..f09e3409de4 100644
--- a/libgfortran/io/size_from_kind.c
+++ b/libgfortran/io/size_from_kind.c
@@ -48,6 +48,10 @@ size_from_real_kind (int kind)
 #ifdef HAVE_GFC_REAL_16
     case 16:
       return sizeof (GFC_REAL_16);
+#endif
+#ifdef HAVE_GFC_REAL_17
+    case 17:
+      return sizeof (GFC_REAL_17);
 #endif
     default:
       return kind;
@@ -75,6 +79,10 @@ size_from_complex_kind (int kind)
 #ifdef HAVE_GFC_COMPLEX_16
     case 16:
       return sizeof (GFC_COMPLEX_16);
+#endif
+#ifdef HAVE_GFC_COMPLEX_17
+    case 17:
+      return sizeof (GFC_COMPLEX_17);
 #endif
     default:
       return 2 * kind;
diff --git a/libgfortran/io/transfer128.c b/libgfortran/io/transfer128.c
index cb1a2bc226c..7372ad7b7be 100644
--- a/libgfortran/io/transfer128.c
+++ b/libgfortran/io/transfer128.c
@@ -28,7 +28,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "io.h"
 
 
-#if defined(GFC_REAL_16_IS_FLOAT128)
+#if defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_GFC_REAL_17)
 
 /* The prototypes for the called procedures in transfer.c.  */
 
@@ -65,8 +65,10 @@ export_proto(transfer_complex128_write);
    write_float; the pointer assignment with USED attribute make sure
    that there is a non-weakref dependence if the quadmath functions
    are used. That avoids segfault when libquadmath is statically linked.  */
+# if !defined(HAVE_GFC_REAL_17) || !defined(POWER_IEEE128)
 static void __attribute__((used)) *tmp1 = strtoflt128;
 static void __attribute__((used)) *tmp2 = quadmath_snprintf;
+# endif
 
 void
 transfer_real128 (st_parameter_dt *dtp, void *p, int kind)
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index ce5da0b35e5..5e025a108b3 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -648,6 +648,15 @@ extract_uint (const void *p, int len)
 	i = (GFC_UINTEGER_16) tmp;
       }
       break;
+# ifdef HAVE_GFC_REAL_17
+    case 17:
+      {
+	GFC_INTEGER_16 tmp = 0;
+	memcpy ((void *) &tmp, p, 16);
+	i = (GFC_UINTEGER_16) tmp;
+      }
+      break;
+# endif
 #endif
     default:
       internal_error (NULL, "bad integer kind");
@@ -1543,6 +1552,9 @@ size_from_kind (st_parameter_dt *dtp, const fnode *f, int kind)
 	  size = 4932 + 3;
 	  break;
 	case 16:
+#ifdef HAVE_GFC_REAL_17
+	case 17:
+#endif
 	  size = 4932 + 3;
 	  break;
 	default:
@@ -1699,6 +1711,13 @@ set_fnode_default (st_parameter_dt *dtp, fnode *f, int length)
       f->u.real.e = 4;
 #endif
       break;
+#ifdef HAVE_GFC_REAL_17
+    case 17:
+      f->u.real.w = 45;
+      f->u.real.d = 36;
+      f->u.real.e = 4;
+      break;
+#endif
     default:
       internal_error (&dtp->common, "bad real kind");
       break;
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index c2ba6fcffe7..5dadf7bf766 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -834,8 +834,16 @@ snprintf (buffer, size, "%+-#.*e", (prec), (val))
 snprintf (buffer, size, "%+-#.*Le", (prec), (val))
 
 
-#if defined(GFC_REAL_16_IS_FLOAT128)
-#define DTOA2Q(prec,val) \
+#if defined(HAVE_GFC_REAL_17)
+# if defined(POWER_IEEE128)
+#  define DTOA2Q(prec,val) \
+__snprintfieee128 (buffer, size, "%+-#.*Le", (prec), (val))
+# else
+#  define DTOA2Q(prec,val) \
+quadmath_snprintf (buffer, size, "%+-#.*Qe", (prec), (val))
+# endif
+#elif defined(GFC_REAL_16_IS_FLOAT128)
+# define DTOA2Q(prec,val) \
 quadmath_snprintf (buffer, size, "%+-#.*Qe", (prec), (val))
 #endif
 
@@ -849,10 +857,17 @@ snprintf (buffer, size, "%+-#.*f", (prec), (val))
 snprintf (buffer, size, "%+-#.*Lf", (prec), (val))
 
 
-#if defined(GFC_REAL_16_IS_FLOAT128)
-#define FDTOA2Q(prec,val) \
-quadmath_snprintf (buffer, size, "%+-#.*Qf", \
-			     (prec), (val))
+#if defined(HAVE_GFC_REAL_17)
+# if defined(POWER_IEEE128)
+#  define FDTOA2Q(prec,val) \
+__snprintfieee128 (buffer, size, "%+-#.*Lf", (prec), (val))
+# else
+# define FDTOA2Q(prec,val) \
+quadmath_snprintf (buffer, size, "%+-#.*Qf", (prec), (val))
+# endif
+#elif defined(GFC_REAL_16_IS_FLOAT128)
+# define FDTOA2Q(prec,val) \
+quadmath_snprintf (buffer, size, "%+-#.*Qf", (prec), (val))
 #endif
 
 
@@ -925,6 +940,11 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
 # endif
       break;
 #endif
+#ifdef HAVE_GFC_REAL_17
+    case 17:
+      EN_PREC(16,Q)
+#endif
+      break;
     default:
       internal_error (NULL, "bad real kind");
     }
@@ -1127,6 +1147,11 @@ get_float_string (st_parameter_dt *dtp, const fnode *f, const char *source,
       FORMAT_FLOAT(16,L)
 # endif
       break;
+#endif
+#ifdef HAVE_GFC_REAL_17
+    case 17:
+      FORMAT_FLOAT(16,Q)
+      break;
 #endif
     default:
       internal_error (NULL, "bad real kind");
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index e11a06e0c34..f4fd8aec078 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -1948,28 +1948,54 @@ internal_proto(cshift1_16_c17);
 
 /* Prototypes for the POWER __ieee128 functions.  */
 #ifdef POWER_IEEE128
-extern __float128 __acoshieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __acosieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __asinhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __asinieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __atan2ieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __atanhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __atanieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __coshieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __cosieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __erfieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __expieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __fabsieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __jnieee128 (int, __float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __log10ieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __logieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __powieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __sinhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __sinieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __sqrtieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __tanhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __tanieee128 (__float128) __attribute__ ((__nothrow__, __leaf__));
-extern __float128 __ynieee128 (int , __float128) __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __acoshieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __acosieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __asinhieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __asinieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __atan2ieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __atanhieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __atanieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __coshieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __cosieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __erfieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __expieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __fabsieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __jnieee128 (int, __float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __log10ieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __logieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __powieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __sinhieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __sinieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __sqrtieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __tanhieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __tanieee128 (__float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __ynieee128 (int , __float128)
+  __attribute__ ((__nothrow__, __leaf__));
+extern __float128 __strtoieee128 (const char *, char **)
+  __attribute__ ((__nothrow__, __leaf__));
+extern int __snprintfieee128 (char *, size_t, const char *, ...)
+  __attribute__ ((__nothrow__));
 
 #endif


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-01-11 22:51 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-01-11 22:51 [gcc r12-6498] fortran, libgfortran: -mabi=ieeelongdouble I/O Jakub Jelinek

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).