aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/io
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/io')
-rw-r--r--libgfortran/io/io.h6
-rw-r--r--libgfortran/io/read.c41
-rw-r--r--libgfortran/io/size_from_kind.c8
-rw-r--r--libgfortran/io/transfer128.c4
-rw-r--r--libgfortran/io/write.c19
-rw-r--r--libgfortran/io/write_float.def37
6 files changed, 105 insertions, 10 deletions
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index b2267d5..23f63d4 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 52e98fb..49d7983a 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:
@@ -180,6 +195,15 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
# 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:
internal_error (&dtp->common, "Unsupported real kind during IO");
}
@@ -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 6601a0f..f09e340 100644
--- a/libgfortran/io/size_from_kind.c
+++ b/libgfortran/io/size_from_kind.c
@@ -49,6 +49,10 @@ size_from_real_kind (int kind)
case 16:
return sizeof (GFC_REAL_16);
#endif
+#ifdef HAVE_GFC_REAL_17
+ case 17:
+ return sizeof (GFC_REAL_17);
+#endif
default:
return kind;
}
@@ -76,6 +80,10 @@ size_from_complex_kind (int kind)
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 cb1a2bc..7372ad7 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 ce5da0b..5e025a1 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 c2ba6fc..5dadf7b 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");
}
@@ -1128,6 +1148,11 @@ get_float_string (st_parameter_dt *dtp, const fnode *f, const char *source,
# endif
break;
#endif
+#ifdef HAVE_GFC_REAL_17
+ case 17:
+ FORMAT_FLOAT(16,Q)
+ break;
+#endif
default:
internal_error (NULL, "bad real kind");
}
generated by cgit v1.1 at 2025-04-18 11:44:11 +0000