From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2153) id 5643C3865C1C; Tue, 11 Jan 2022 22:51:15 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 5643C3865C1C MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Jakub Jelinek To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-6498] fortran, libgfortran: -mabi=ieeelongdouble I/O X-Act-Checkin: gcc X-Git-Author: Jakub Jelinek X-Git-Refname: refs/heads/master X-Git-Oldrev: bff4226f5a01da2f93d4e096a1c9317a553438a3 X-Git-Newrev: 07c60b8e33c614a6cdd9fe3de7f409319b6a239a Message-Id: <20220111225115.5643C3865C1C@sourceware.org> Date: Tue, 11 Jan 2022 22:51:15 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 11 Jan 2022 22:51:15 -0000 https://gcc.gnu.org/g:07c60b8e33c614a6cdd9fe3de7f409319b6a239a commit r12-6498-g07c60b8e33c614a6cdd9fe3de7f409319b6a239a Author: Jakub Jelinek 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 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