summaryrefslogtreecommitdiffstats
path: root/libgfortran
diff options
context:
space:
mode:
authorJakub Jelinek <jakub@redhat.com>2022-01-04 10:37:48 +0100
committerJakub Jelinek <jakub@redhat.com>2022-01-11 23:49:48 +0100
commit07c60b8e33c614a6cdd9fe3de7f409319b6a239a (patch)
tree67f8ad50f7a5163e2ff5f9c1b1936decc874e1e0 /libgfortran
parentlibquadmath: Use -mno-gnu-attribute in libquadmath (diff)
downloadgcc-07c60b8e33c614a6cdd9fe3de7f409319b6a239a.tar.gz
gcc-07c60b8e33c614a6cdd9fe3de7f409319b6a239a.tar.bz2
gcc-07c60b8e33c614a6cdd9fe3de7f409319b6a239a.tar.xz
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.
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/Makefile.am22
-rw-r--r--libgfortran/Makefile.in22
-rw-r--r--libgfortran/gfortran.map10
-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
-rw-r--r--libgfortran/libgfortran.h70
10 files changed, 193 insertions, 46 deletions
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)
8 8
9## Symbol versioning (copied from libssp). 9## Symbol versioning (copied from libssp).
10if LIBGFOR_USE_SYMVER 10if LIBGFOR_USE_SYMVER
11# -Wc is only a libtool option.
12comma = ,
13PREPROCESS = $(subst -Wc$(comma), , $(COMPILE)) -E
14
15gfortran.ver: $(srcdir)/gfortran.map kinds.inc
16 $(EGREP) -v '#(#| |$$)' $< | \
17 $(PREPROCESS) -P -include config.h -include kinds.inc - > $@ || (rm -f $@ ; exit 1)
18
11if LIBGFOR_USE_SYMVER_GNU 19if LIBGFOR_USE_SYMVER_GNU
12version_arg = -Wl,--version-script=$(srcdir)/gfortran.map 20version_arg = -Wl,--version-script=gfortran.ver
13version_dep = $(srcdir)/gfortran.map 21version_dep = gfortran.ver
14endif 22endif
15if LIBGFOR_USE_SYMVER_SUN 23if LIBGFOR_USE_SYMVER_SUN
16version_arg = -Wl,-M,gfortran.map-sun 24version_arg = -Wl,-M,gfortran.ver-sun
17version_dep = gfortran.map-sun 25version_dep = gfortran.ver-sun gfortran.ver
18gfortran.map-sun : $(srcdir)/gfortran.map \ 26gfortran.map-sun : gfortran.ver \
19 $(top_srcdir)/../contrib/make_sunver.pl \ 27 $(top_srcdir)/../contrib/make_sunver.pl \
20 $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD) 28 $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD)
21 perl $(top_srcdir)/../contrib/make_sunver.pl \ 29 perl $(top_srcdir)/../contrib/make_sunver.pl \
22 $(srcdir)/gfortran.map \ 30 gfortran.ver \
23 $(libgfortran_la_OBJECTS:%.lo=.libs/%.o) \ 31 $(libgfortran_la_OBJECTS:%.lo=.libs/%.o) \
24 `echo $(libgfortran_la_LIBADD) | \ 32 `echo $(libgfortran_la_LIBADD) | \
25 sed 's,/\([^/.]*\)\.la,/.libs/\1.a,g'` \ 33 sed 's,/\([^/.]*\)\.la,/.libs/\1.a,g'` \
@@ -1110,7 +1118,7 @@ ieee_arithmetic.mod: ieee_arithmetic.lo
1110 : 1118 :
1111 1119
1112BUILT_SOURCES=$(gfor_built_src) $(gfor_built_specific_src) \ 1120BUILT_SOURCES=$(gfor_built_src) $(gfor_built_specific_src) \
1113 $(gfor_built_specific2_src) $(gfor_misc_specifics) 1121 $(gfor_built_specific2_src) $(gfor_misc_specifics) $(version_dep)
1114 1122
1115prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ 1123prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
1116 $(gfor_helper_src) $(gfor_ieee_src) $(gfor_io_headers) $(gfor_specific_src) 1124 $(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@
738top_srcdir = @top_srcdir@ 738top_srcdir = @top_srcdir@
739ACLOCAL_AMFLAGS = -I .. -I ../config 739ACLOCAL_AMFLAGS = -I .. -I ../config
740gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER) 740gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
741
742# -Wc is only a libtool option.
743@LIBGFOR_USE_SYMVER_TRUE@comma = ,
744@LIBGFOR_USE_SYMVER_TRUE@PREPROCESS = $(subst -Wc$(comma), , $(COMPILE)) -E
741@LIBGFOR_USE_SYMVER_FALSE@version_arg = 745@LIBGFOR_USE_SYMVER_FALSE@version_arg =
742@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,--version-script=$(srcdir)/gfortran.map 746@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,--version-script=gfortran.ver
743@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,-M,gfortran.map-sun 747@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_arg = -Wl,-M,gfortran.ver-sun
744@LIBGFOR_USE_SYMVER_FALSE@version_dep = 748@LIBGFOR_USE_SYMVER_FALSE@version_dep =
745@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = $(srcdir)/gfortran.map 749@LIBGFOR_USE_SYMVER_GNU_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.ver
746@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.map-sun 750@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@version_dep = gfortran.ver-sun gfortran.ver
747gfor_c_HEADERS = ISO_Fortran_binding.h 751gfor_c_HEADERS = ISO_Fortran_binding.h
748gfor_cdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include 752gfor_cdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include
749LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \ 753LTLDFLAGS = $(shell $(SHELL) $(top_srcdir)/../libtool-ldflags $(LDFLAGS)) \
@@ -1648,7 +1652,7 @@ intrinsics/random_init.f90
1648 1652
1649BUILT_SOURCES = $(gfor_built_src) $(gfor_built_specific_src) \ 1653BUILT_SOURCES = $(gfor_built_src) $(gfor_built_specific_src) \
1650 $(gfor_built_specific2_src) $(gfor_misc_specifics) \ 1654 $(gfor_built_specific2_src) $(gfor_misc_specifics) \
1651 $(am__append_7) 1655 $(version_dep) $(am__append_7)
1652prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \ 1656prereq_SRC = $(gfor_src) $(gfor_built_src) $(gfor_io_src) \
1653 $(gfor_helper_src) $(gfor_ieee_src) $(gfor_io_headers) $(gfor_specific_src) 1657 $(gfor_helper_src) $(gfor_ieee_src) $(gfor_io_headers) $(gfor_specific_src)
1654 1658
@@ -7607,11 +7611,15 @@ uninstall-am: uninstall-cafexeclibLTLIBRARIES uninstall-gfor_cHEADERS \
7607 7611
7608.PRECIOUS: Makefile 7612.PRECIOUS: Makefile
7609 7613
7610@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@gfortran.map-sun : $(srcdir)/gfortran.map \ 7614
7615@LIBGFOR_USE_SYMVER_TRUE@gfortran.ver: $(srcdir)/gfortran.map kinds.inc
7616@LIBGFOR_USE_SYMVER_TRUE@ $(EGREP) -v '#(#| |$$)' $< | \
7617@LIBGFOR_USE_SYMVER_TRUE@ $(PREPROCESS) -P -include config.h -include kinds.inc - > $@ || (rm -f $@ ; exit 1)
7618@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@gfortran.map-sun : gfortran.ver \
7611@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(top_srcdir)/../contrib/make_sunver.pl \ 7619@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(top_srcdir)/../contrib/make_sunver.pl \
7612@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD) 7620@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(libgfortran_la_OBJECTS) $(libgfortran_la_LIBADD)
7613@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ perl $(top_srcdir)/../contrib/make_sunver.pl \ 7621@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ perl $(top_srcdir)/../contrib/make_sunver.pl \
7614@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(srcdir)/gfortran.map \ 7622@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ gfortran.ver \
7615@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(libgfortran_la_OBJECTS:%.lo=.libs/%.o) \ 7623@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ $(libgfortran_la_OBJECTS:%.lo=.libs/%.o) \
7616@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ `echo $(libgfortran_la_LIBADD) | \ 7624@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ `echo $(libgfortran_la_LIBADD) | \
7617@LIBGFOR_USE_SYMVER_SUN_TRUE@@LIBGFOR_USE_SYMVER_TRUE@ sed 's,/\([^/.]*\)\.la,/.libs/\1.a,g'` \ 7625@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 {
1295 _gfortran_transfer_character_wide; 1295 _gfortran_transfer_character_wide;
1296 _gfortran_transfer_character_wide_write; 1296 _gfortran_transfer_character_wide_write;
1297 _gfortran_transfer_character_write; 1297 _gfortran_transfer_character_write;
1298#ifndef HAVE_GFC_REAL_17
1298 _gfortran_transfer_complex128; 1299 _gfortran_transfer_complex128;
1299 _gfortran_transfer_complex128_write; 1300 _gfortran_transfer_complex128_write;
1301#endif
1300 _gfortran_transfer_complex; 1302 _gfortran_transfer_complex;
1301 _gfortran_transfer_complex_write; 1303 _gfortran_transfer_complex_write;
1302 _gfortran_transfer_derived; 1304 _gfortran_transfer_derived;
@@ -1304,8 +1306,10 @@ GFORTRAN_8 {
1304 _gfortran_transfer_integer_write; 1306 _gfortran_transfer_integer_write;
1305 _gfortran_transfer_logical; 1307 _gfortran_transfer_logical;
1306 _gfortran_transfer_logical_write; 1308 _gfortran_transfer_logical_write;
1309#ifndef HAVE_GFC_REAL_17
1307 _gfortran_transfer_real128; 1310 _gfortran_transfer_real128;
1308 _gfortran_transfer_real128_write; 1311 _gfortran_transfer_real128_write;
1312#endif
1309 _gfortran_transfer_real; 1313 _gfortran_transfer_real;
1310 _gfortran_transfer_real_write; 1314 _gfortran_transfer_real_write;
1311 _gfortran_ttynam; 1315 _gfortran_ttynam;
@@ -1748,4 +1752,10 @@ GFORTRAN_12 {
1748 _gfortran_sproduct_c17; 1752 _gfortran_sproduct_c17;
1749 _gfortran_ssum_c17; 1753 _gfortran_ssum_c17;
1750 _gfortran_sum_c17; 1754 _gfortran_sum_c17;
1755#ifdef HAVE_GFC_REAL_17
1756 _gfortran_transfer_complex128;
1757 _gfortran_transfer_complex128_write;
1758 _gfortran_transfer_real128;
1759 _gfortran_transfer_real128_write;
1760#endif
1751} GFORTRAN_10.2; 1761} 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)
1063 { 1063 {
1064 case 4: return 15; 1064 case 4: return 15;
1065 case 8: return 25; 1065 case 8: return 25;
1066 case 16: return 42; 1066 case 16:
1067 case 17: return 42;
1067 default: return 0; 1068 default: return 0;
1068 } 1069 }
1069} 1070}
@@ -1075,7 +1076,8 @@ default_precision_for_float (int kind)
1075 { 1076 {
1076 case 4: return 7; 1077 case 4: return 7;
1077 case 8: return 16; 1078 case 8: return 16;
1078 case 16: return 33; 1079 case 16:
1080 case 17: return 33;
1079 default: return 0; 1081 default: return 0;
1080 } 1082 }
1081} 1083}
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)
46 switch (length) 46 switch (length)
47 { 47 {
48#ifdef HAVE_GFC_INTEGER_16 48#ifdef HAVE_GFC_INTEGER_16
49#ifdef HAVE_GFC_REAL_17
50 case 17:
51 {
52 GFC_INTEGER_16 tmp = value;
53 memcpy (dest, (void *) &tmp, 16);
54 }
55 break;
56#endif
49/* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */ 57/* length=10 comes about for kind=10 real/complex BOZ, cf. PR41711. */
50 case 10: 58 case 10:
51 case 16: 59 case 16:
@@ -95,7 +103,14 @@ si_max (int length)
95#endif 103#endif
96 104
97 switch (length) 105 switch (length)
98 { 106 {
107#if defined HAVE_GFC_REAL_17
108 case 17:
109 value = 1;
110 for (int n = 1; n < 4 * 16; n++)
111 value = (value << 2) + 3;
112 return value;
113#endif
99#if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10 114#if defined HAVE_GFC_REAL_16 || defined HAVE_GFC_REAL_10
100 case 16: 115 case 16:
101 case 10: 116 case 10:
@@ -180,6 +195,15 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
180# endif 195# endif
181#endif 196#endif
182 197
198#if defined(HAVE_GFC_REAL_17)
199 case 17:
200# if defined(POWER_IEEE128)
201 *((GFC_REAL_17*) dest) = __strtoieee128 (buffer, &endptr);
202# else
203 *((GFC_REAL_17*) dest) = __qmath_(strtoflt128) (buffer, &endptr);
204# endif
205#endif
206
183 default: 207 default:
184 internal_error (&dtp->common, "Unsupported real kind during IO"); 208 internal_error (&dtp->common, "Unsupported real kind during IO");
185 } 209 }
@@ -259,6 +283,15 @@ convert_infnan (st_parameter_dt *dtp, void *dest, const char *buffer,
259# endif 283# endif
260#endif 284#endif
261 285
286#if defined(HAVE_GFC_REAL_17)
287 case 17:
288 if (is_inf)
289 *((GFC_REAL_17*) dest) = plus ? __builtin_infl () : -__builtin_infl ();
290 else
291 *((GFC_REAL_17*) dest) = plus ? __builtin_nanl ("") : -__builtin_nanl ("");
292 break;
293#endif
294
262 default: 295 default:
263 internal_error (&dtp->common, "Unsupported real kind during IO"); 296 internal_error (&dtp->common, "Unsupported real kind during IO");
264 } 297 }
@@ -1224,6 +1257,12 @@ zero:
1224 break; 1257 break;
1225#endif 1258#endif
1226 1259
1260#ifdef HAVE_GFC_REAL_17
1261 case 17:
1262 *((GFC_REAL_17 *) dest) = 0.0;
1263 break;
1264#endif
1265
1227 default: 1266 default:
1228 internal_error (&dtp->common, "Unsupported real kind during IO"); 1267 internal_error (&dtp->common, "Unsupported real kind during IO");
1229 } 1268 }
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
@@ -49,6 +49,10 @@ size_from_real_kind (int kind)
49 case 16: 49 case 16:
50 return sizeof (GFC_REAL_16); 50 return sizeof (GFC_REAL_16);
51#endif 51#endif
52#ifdef HAVE_GFC_REAL_17
53 case 17:
54 return sizeof (GFC_REAL_17);
55#endif
52 default: 56 default:
53 return kind; 57 return kind;
54 } 58 }
@@ -76,6 +80,10 @@ size_from_complex_kind (int kind)
76 case 16: 80 case 16:
77 return sizeof (GFC_COMPLEX_16); 81 return sizeof (GFC_COMPLEX_16);
78#endif 82#endif
83#ifdef HAVE_GFC_COMPLEX_17
84 case 17:
85 return sizeof (GFC_COMPLEX_17);
86#endif
79 default: 87 default:
80 return 2 * kind; 88 return 2 * kind;
81 } 89 }
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
28#include "io.h" 28#include "io.h"
29 29
30 30
31#if defined(GFC_REAL_16_IS_FLOAT128) 31#if defined(GFC_REAL_16_IS_FLOAT128) || defined(HAVE_GFC_REAL_17)
32 32
33/* The prototypes for the called procedures in transfer.c. */ 33/* The prototypes for the called procedures in transfer.c. */
34 34
@@ -65,8 +65,10 @@ export_proto(transfer_complex128_write);
65 write_float; the pointer assignment with USED attribute make sure 65 write_float; the pointer assignment with USED attribute make sure
66 that there is a non-weakref dependence if the quadmath functions 66 that there is a non-weakref dependence if the quadmath functions
67 are used. That avoids segfault when libquadmath is statically linked. */ 67 are used. That avoids segfault when libquadmath is statically linked. */
68# if !defined(HAVE_GFC_REAL_17) || !defined(POWER_IEEE128)
68static void __attribute__((used)) *tmp1 = strtoflt128; 69static void __attribute__((used)) *tmp1 = strtoflt128;
69static void __attribute__((used)) *tmp2 = quadmath_snprintf; 70static void __attribute__((used)) *tmp2 = quadmath_snprintf;
71# endif
70 72
71void 73void
72transfer_real128 (st_parameter_dt *dtp, void *p, int kind) 74transfer_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)
648 i = (GFC_UINTEGER_16) tmp; 648 i = (GFC_UINTEGER_16) tmp;
649 } 649 }
650 break; 650 break;
651# ifdef HAVE_GFC_REAL_17
652 case 17:
653 {
654 GFC_INTEGER_16 tmp = 0;
655 memcpy ((void *) &tmp, p, 16);
656 i = (GFC_UINTEGER_16) tmp;
657 }
658 break;
659# endif
651#endif 660#endif
652 default: 661 default:
653 internal_error (NULL, "bad integer kind"); 662 internal_error (NULL, "bad integer kind");
@@ -1543,6 +1552,9 @@ size_from_kind (st_parameter_dt *dtp, const fnode *f, int kind)
1543 size = 4932 + 3; 1552 size = 4932 + 3;
1544 break; 1553 break;
1545 case 16: 1554 case 16:
1555#ifdef HAVE_GFC_REAL_17
1556 case 17:
1557#endif
1546 size = 4932 + 3; 1558 size = 4932 + 3;
1547 break; 1559 break;
1548 default: 1560 default:
@@ -1699,6 +1711,13 @@ set_fnode_default (st_parameter_dt *dtp, fnode *f, int length)
1699 f->u.real.e = 4; 1711 f->u.real.e = 4;
1700#endif 1712#endif
1701 break; 1713 break;
1714#ifdef HAVE_GFC_REAL_17
1715 case 17:
1716 f->u.real.w = 45;
1717 f->u.real.d = 36;
1718 f->u.real.e = 4;
1719 break;
1720#endif
1702 default: 1721 default:
1703 internal_error (&dtp->common, "bad real kind"); 1722 internal_error (&dtp->common, "bad real kind");
1704 break; 1723 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))
834snprintf (buffer, size, "%+-#.*Le", (prec), (val)) 834snprintf (buffer, size, "%+-#.*Le", (prec), (val))
835 835
836 836
837#if defined(GFC_REAL_16_IS_FLOAT128) 837#if defined(HAVE_GFC_REAL_17)
838#define DTOA2Q(prec,val) \ 838# if defined(POWER_IEEE128)
839# define DTOA2Q(prec,val) \
840__snprintfieee128 (buffer, size, "%+-#.*Le", (prec), (val))
841# else
842# define DTOA2Q(prec,val) \
843quadmath_snprintf (buffer, size, "%+-#.*Qe", (prec), (val))
844# endif
845#elif defined(GFC_REAL_16_IS_FLOAT128)
846# define DTOA2Q(prec,val) \
839quadmath_snprintf (buffer, size, "%+-#.*Qe", (prec), (val)) 847quadmath_snprintf (buffer, size, "%+-#.*Qe", (prec), (val))
840#endif 848#endif
841 849
@@ -849,10 +857,17 @@ snprintf (buffer, size, "%+-#.*f", (prec), (val))
849snprintf (buffer, size, "%+-#.*Lf", (prec), (val)) 857snprintf (buffer, size, "%+-#.*Lf", (prec), (val))
850 858
851 859
852#if defined(GFC_REAL_16_IS_FLOAT128) 860#if defined(HAVE_GFC_REAL_17)
853#define FDTOA2Q(prec,val) \ 861# if defined(POWER_IEEE128)
854quadmath_snprintf (buffer, size, "%+-#.*Qf", \ 862# define FDTOA2Q(prec,val) \
855 (prec), (val)) 863__snprintfieee128 (buffer, size, "%+-#.*Lf", (prec), (val))
864# else
865# define FDTOA2Q(prec,val) \
866quadmath_snprintf (buffer, size, "%+-#.*Qf", (prec), (val))
867# endif
868#elif defined(GFC_REAL_16_IS_FLOAT128)
869# define FDTOA2Q(prec,val) \
870quadmath_snprintf (buffer, size, "%+-#.*Qf", (prec), (val))
856#endif 871#endif
857 872
858 873
@@ -925,6 +940,11 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
925# endif 940# endif
926 break; 941 break;
927#endif 942#endif
943#ifdef HAVE_GFC_REAL_17
944 case 17:
945 EN_PREC(16,Q)
946#endif
947 break;
928 default: 948 default:
929 internal_error (NULL, "bad real kind"); 949 internal_error (NULL, "bad real kind");
930 } 950 }
@@ -1128,6 +1148,11 @@ get_float_string (st_parameter_dt *dtp, const fnode *f, const char *source,
1128# endif 1148# endif
1129 break; 1149 break;
1130#endif 1150#endif
1151#ifdef HAVE_GFC_REAL_17
1152 case 17:
1153 FORMAT_FLOAT(16,Q)
1154 break;
1155#endif
1131 default: 1156 default:
1132 internal_error (NULL, "bad real kind"); 1157 internal_error (NULL, "bad real kind");
1133 } 1158 }
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);
1948 1948
1949/* Prototypes for the POWER __ieee128 functions. */ 1949/* Prototypes for the POWER __ieee128 functions. */
1950#ifdef POWER_IEEE128 1950#ifdef POWER_IEEE128
1951extern __float128 __acoshieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1951extern __float128 __acoshieee128 (__float128)
1952extern __float128 __acosieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1952 __attribute__ ((__nothrow__, __leaf__));
1953extern __float128 __asinhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1953extern __float128 __acosieee128 (__float128)
1954extern __float128 __asinieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1954 __attribute__ ((__nothrow__, __leaf__));
1955extern __float128 __atan2ieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1955extern __float128 __asinhieee128 (__float128)
1956extern __float128 __atanhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1956 __attribute__ ((__nothrow__, __leaf__));
1957extern __float128 __atanieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1957extern __float128 __asinieee128 (__float128)
1958extern __float128 __coshieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1958 __attribute__ ((__nothrow__, __leaf__));
1959extern __float128 __cosieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1959extern __float128 __atan2ieee128 (__float128)
1960extern __float128 __erfieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1960 __attribute__ ((__nothrow__, __leaf__));
1961extern __float128 __expieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1961extern __float128 __atanhieee128 (__float128)
1962extern __float128 __fabsieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1962 __attribute__ ((__nothrow__, __leaf__));
1963extern __float128 __jnieee128 (int, __float128) __attribute__ ((__nothrow__, __leaf__)); 1963extern __float128 __atanieee128 (__float128)
1964extern __float128 __log10ieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1964 __attribute__ ((__nothrow__, __leaf__));
1965extern __float128 __logieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1965extern __float128 __coshieee128 (__float128)
1966extern __float128 __powieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1966 __attribute__ ((__nothrow__, __leaf__));
1967extern __float128 __sinhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1967extern __float128 __cosieee128 (__float128)
1968extern __float128 __sinieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1968 __attribute__ ((__nothrow__, __leaf__));
1969extern __float128 __sqrtieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1969extern __float128 __erfieee128 (__float128)
1970extern __float128 __tanhieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1970 __attribute__ ((__nothrow__, __leaf__));
1971extern __float128 __tanieee128 (__float128) __attribute__ ((__nothrow__, __leaf__)); 1971extern __float128 __expieee128 (__float128)
1972extern __float128 __ynieee128 (int , __float128) __attribute__ ((__nothrow__, __leaf__)); 1972 __attribute__ ((__nothrow__, __leaf__));
1973extern __float128 __fabsieee128 (__float128)
1974 __attribute__ ((__nothrow__, __leaf__));
1975extern __float128 __jnieee128 (int, __float128)
1976 __attribute__ ((__nothrow__, __leaf__));
1977extern __float128 __log10ieee128 (__float128)
1978 __attribute__ ((__nothrow__, __leaf__));
1979extern __float128 __logieee128 (__float128)
1980 __attribute__ ((__nothrow__, __leaf__));
1981extern __float128 __powieee128 (__float128)
1982 __attribute__ ((__nothrow__, __leaf__));
1983extern __float128 __sinhieee128 (__float128)
1984 __attribute__ ((__nothrow__, __leaf__));
1985extern __float128 __sinieee128 (__float128)
1986 __attribute__ ((__nothrow__, __leaf__));
1987extern __float128 __sqrtieee128 (__float128)
1988 __attribute__ ((__nothrow__, __leaf__));
1989extern __float128 __tanhieee128 (__float128)
1990 __attribute__ ((__nothrow__, __leaf__));
1991extern __float128 __tanieee128 (__float128)
1992 __attribute__ ((__nothrow__, __leaf__));
1993extern __float128 __ynieee128 (int , __float128)
1994 __attribute__ ((__nothrow__, __leaf__));
1995extern __float128 __strtoieee128 (const char *, char **)
1996 __attribute__ ((__nothrow__, __leaf__));
1997extern int __snprintfieee128 (char *, size_t, const char *, ...)
1998 __attribute__ ((__nothrow__));
1973 1999
1974#endif 2000#endif
1975 2001