In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/991b13da7e9cdf615715d5db6bc310cd9ca936fb?hp=688d9ed14d976fe7ce810427ec76afcdd23d4757>

- Log -----------------------------------------------------------------
commit 991b13da7e9cdf615715d5db6bc310cd9ca936fb
Author: Jarkko Hietaniemi <[email protected]>
Date:   Wed Sep 10 17:42:04 2014 -0400

    darwin can have libfoo.0.dylib, as opposed to libfoo.dylib.0
    
    Configure was changed similarly in d98292cc
    
    cpan module; patch submitted upstream:
    https://rt.cpan.org/Ticket/Display.html?id=98766
    and has been applied.

M       cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm

commit b9ea91dc907159c9f5c3910cfc7befc339cfb9ce
Author: Jarkko Hietaniemi <[email protected]>
Date:   Wed Sep 10 22:21:39 2014 -0400

    quadmath NVs cannot be cast to double etc.

M       ext/XS-APItest/t/printf.t

commit 3ff98fcfbb5423d8e1fb77f1e5eaa96761e9ae29
Author: Jarkko Hietaniemi <[email protected]>
Date:   Sat Sep 13 21:16:55 2014 -0400

    quadmath strtoflt128 accepts false infinities.

M       t/op/infnan.t

commit 435847ca4606aec9adb049a368cde586bfb84262
Author: Jarkko Hietaniemi <[email protected]>
Date:   Wed Sep 10 18:40:11 2014 -0400

    quadmath doesn't do locale radixes.

M       lib/locale.t

commit 507244c8329b328e3794bf5d6aa5f141c91c23ed
Author: Jarkko Hietaniemi <[email protected]>
Date:   Wed Sep 10 14:30:44 2014 -0400

    quadmath and gconvert do not mix.

M       ext/XS-APItest/t/locale.t

commit 4d7e5849b3146a278e74b69a1d9a1a066f250b5c
Author: Jarkko Hietaniemi <[email protected]>
Date:   Wed Sep 10 14:03:37 2014 -0400

    quadmath has expq instead of expl.

M       t/porting/libperl.t

commit 068eadbdb12099f35c35e927558b2bcfc28aa79f
Author: Jarkko Hietaniemi <[email protected]>
Date:   Sun Sep 14 18:44:27 2014 -0400

    quadmath helpers export list.

M       makedef.pl

commit 78e91e3f8a5c269162712a52608b3b727352d602
Author: Jarkko Hietaniemi <[email protected]>
Date:   Sun Sep 14 17:39:15 2014 -0400

    quadmath Q format specifier and gcc -Wformat do not mix.

M       cflags.SH

commit a4eca1d4e93229f61c43cff9ccf327446a06c800
Author: Jarkko Hietaniemi <[email protected]>
Date:   Sun Sep 14 15:43:55 2014 -0400

    quadmath NV formatted I/O.

M       embed.fnc
M       embed.h
M       numeric.c
M       perl.h
M       pp_ctl.c
M       proto.h
M       sv.c
M       util.c

commit 257c99f5ec2cc6330d621f7477dad58761748499
Author: Jarkko Hietaniemi <[email protected]>
Date:   Tue Aug 26 20:49:09 2014 -0400

    quadmath INSTALL.

M       INSTALL

commit dbfbd36aab98acfcd2da555b98ce71d252238301
Author: Jarkko Hietaniemi <[email protected]>
Date:   Tue Sep 2 06:50:38 2014 -0400

    quadmath_snprintf formats.

M       Configure

commit 05b4a618e0f17cd89317fce1e24846b2bd34afca
Author: Jarkko Hietaniemi <[email protected]>
Date:   Sun Sep 14 15:41:45 2014 -0400

    quadmath interfaces and constants

M       ext/POSIX/POSIX.xs
M       perl.h

commit aae2249550bb0b153b0d4e295133e42fb5921cef
Author: Jarkko Hietaniemi <[email protected]>
Date:   Fri Aug 22 21:02:23 2014 -0400

    quadmath needs gcc, at least 4.6.

M       Configure

commit 9c75d918805f7766855958e1eff74f6379d8b069
Author: Jarkko Hietaniemi <[email protected]>
Date:   Fri Aug 22 11:55:33 2014 -0400

    quadmath __float128 as NVTYPE.

M       Configure

commit 97eac949b0a5801c6ea6dfa29f54d0e6ecbb7137
Author: Jarkko Hietaniemi <[email protected]>
Date:   Fri Aug 22 11:35:34 2014 -0400

    quadmath __float128 for longdblkind.

M       Configure

commit d6d36205af417d227110bac72e1801d73862770f
Author: Jarkko Hietaniemi <[email protected]>
Date:   Fri Aug 22 11:05:52 2014 -0400

    Configure -Dusequadmath.

M       Configure
M       Cross/config.sh-arm-linux
M       NetWare/config.wc
M       Porting/Glossary
M       Porting/config.sh
M       config_h.SH
M       configure.com
M       plan9/config_sh.sample
M       symbian/config.sh
M       uconfig.h
M       uconfig.sh
M       uconfig64.sh
M       win32/config.ce
M       win32/config.gc
M       win32/config.vc

commit 4e5044f034f5b5d064c8d998817c4476bf4842a3
Author: Jarkko Hietaniemi <[email protected]>
Date:   Fri Aug 22 10:51:18 2014 -0400

    Configure for <quadmath.h>

M       Configure
M       Cross/config.sh-arm-linux
M       NetWare/config.wc
M       Porting/Glossary
M       Porting/config.sh
M       config_h.SH
M       configure.com
M       plan9/config_sh.sample
M       symbian/config.sh
M       uconfig.h
M       uconfig.sh
M       uconfig64.sh
M       win32/config.ce
M       win32/config.gc
M       win32/config.vc
-----------------------------------------------------------------------

Summary of changes:
 Configure                                          | 179 ++++++++++++++++++++-
 Cross/config.sh-arm-linux                          |   2 +
 INSTALL                                            |  16 ++
 NetWare/config.wc                                  |   2 +
 Porting/Glossary                                   |   9 ++
 Porting/config.sh                                  |   2 +
 cflags.SH                                          |  15 ++
 config_h.SH                                        |  14 ++
 configure.com                                      |   9 +-
 .../ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm |   6 +-
 embed.fnc                                          |   6 +
 embed.h                                            |  12 +-
 ext/POSIX/POSIX.xs                                 | 159 +++++++++++++-----
 ext/XS-APItest/t/locale.t                          |  12 +-
 ext/XS-APItest/t/printf.t                          |   8 +
 lib/locale.t                                       |  55 +++++--
 makedef.pl                                         |   5 +
 numeric.c                                          |  64 +++++---
 perl.h                                             | 156 ++++++++++++------
 plan9/config_sh.sample                             |   2 +
 pp_ctl.c                                           |  16 +-
 proto.h                                            |  20 ++-
 sv.c                                               |  49 +++++-
 symbian/config.sh                                  |   2 +
 t/op/infnan.t                                      |   8 +-
 t/porting/libperl.t                                |   6 +-
 uconfig.h                                          |  18 ++-
 uconfig.sh                                         |   2 +
 uconfig64.sh                                       |   2 +
 util.c                                             | 163 ++++++++++++++++++-
 win32/config.ce                                    |   2 +
 win32/config.gc                                    |   2 +
 win32/config.vc                                    |   2 +
 33 files changed, 867 insertions(+), 158 deletions(-)

diff --git a/Configure b/Configure
index 835bf21..343e062 100755
--- a/Configure
+++ b/Configure
@@ -957,6 +957,7 @@ d_pwgecos=''
 d_pwpasswd=''
 d_pwquota=''
 i_pwd=''
+i_quadmath=''
 i_shadow=''
 i_socks=''
 i_stdbool=''
@@ -1259,6 +1260,7 @@ libswanted_uselargefiles=''
 uselargefiles=''
 uselongdouble=''
 usemorebits=''
+usequadmath=''
 usemultiplicity=''
 nm_opt=''
 nm_so_opt=''
@@ -4444,6 +4446,16 @@ esac
 set usemultiplicity
 eval $setvar
 
+: Check if usequadmath is requested
+case "$usequadmath" in
+"$define"|true|[yY]*)
+       usequadmath="$define"
+        # if usequadmath enabled also enable uselongdouble
+       uselongdouble="$define"
+       ;;
+*)     usequadmath="$undef" ;;
+esac
+
 : Check if morebits is requested
 case "$usemorebits" in
 "$define"|true|[yY]*)
@@ -5167,6 +5179,9 @@ esac
 case "$usecbacktrace" in
 "$define") libswanted="$libswanted bfd" ;;
 esac
+case "$usequadmath" in
+"$define") libswanted="$libswanted quadmath" ;;
+esac
 libsfound=''
 libsfiles=''
 libsdirs=''
@@ -6794,6 +6809,10 @@ eval $setvar
 set ldexpl d_ldexpl
 eval $inlibc
 
+: see if this is a quadmath.h system
+set quadmath.h i_quadmath
+eval $inhdr
+
 : check for length of long double
 case "${d_longdbl}${longdblsize}" in
 $define)
@@ -6841,11 +6860,18 @@ $cat <<EOP >try.c
 #ifdef I_STDLIB
 #include <stdlib.h>
 #endif
-#include <stdio.h>
+#$usequadmath USE_QUADMATH
+#$i_quadmath I_QUADMATH
+#if defined(USE_QUADMATH) && defined(I_QUADMATH)
+#include <quadmath.h>
+static const __float128 d = -0.1Q;
+#else
 static const long double d = -0.1L;
+#endif
+#include <stdio.h>
 int main() {
   unsigned const char* b = (unsigned const char*)(&d);
-#if LDBL_MANT_DIG == 113 && LONGDBLSIZE == 16
+#if (LDBL_MANT_DIG == 113 || FLT128_MANT_DIG == 113) && LONGDBLSIZE == 16
   if (b[0] == 0x9A && b[1] == 0x99 && b[15] == 0xBF) {
     /* IEEE 754 128-bit little-endian */
     printf("1\n");
@@ -15683,6 +15709,98 @@ EOCP
 
     esac
 
+: check for fpclassify
+echo " "
+echo "Checking to see if you have fpclassify..." >&4
+$cat >try.c <<EOCP
+#$i_math I_MATH
+#ifdef I_MATH
+#include <math.h>
+#endif
+int main() { return fpclassify(1.0) == FP_NORMAL ? 0 : 1; }
+EOCP
+set try
+if eval $compile; then
+       val="$define"
+       echo "You have fpclassify."
+else
+       val="$undef"
+       echo "You do not have fpclassify."
+fi
+$rm_try
+set d_fpclassify
+eval $setvar
+
+: check for isfinite
+echo " "
+echo "Checking to see if you have isfinite..." >&4
+$cat >try.c <<EOCP
+#$i_math I_MATH
+#ifdef I_MATH
+#include <math.h>
+#endif
+int main() { return isfinite(0.0); }
+EOCP
+set try
+if eval $compile; then
+       val="$define"
+       echo "You have isfinite."
+else
+       val="$undef"
+       echo "You do not have isfinite."
+fi
+$rm_try
+set d_isfinite
+eval $setvar
+
+: check for isinf
+echo " "
+echo "Checking to see if you have isinf..." >&4
+$cat >try.c <<EOCP
+#$i_math I_MATH
+#ifdef I_MATH
+#include <math.h>
+#endif
+int main() { return isinf(0.0); }
+EOCP
+set try
+if eval $compile; then
+       val="$define"
+       echo "You have isinf."
+else
+       val="$undef"
+       echo "You do not have isinf."
+fi
+$rm_try
+set d_isinf
+eval $setvar
+
+: check for isnan
+echo " "
+echo "Checking to see if you have isnan..." >&4
+$cat >try.c <<EOCP
+#$i_math I_MATH
+#ifdef I_MATH
+#include <math.h>
+#endif
+int main() { return isnan(0.0); }
+EOCP
+set try
+if eval $compile; then
+       val="$define"
+       echo "You have isnan."
+else
+       val="$undef"
+       echo "You do not have isnan."
+fi
+$rm_try
+set d_isnan
+eval $setvar
+
+: see if this is a quadmath.h system
+set quadmath.h i_quadmath
+eval $inhdr
+
 : see if link exists
 set link d_link
 eval $inlibc
@@ -16190,6 +16308,48 @@ define:define)
        ;;
 esac
 
+case "$usequadmath:$i_quadmath" in
+define:define)
+  nvtype="__float128"
+  nvsize=16
+  case "$libs" in
+  *quadmath*) ;;
+  *) $cat <<EOM >&4
+
+*** You requested the use of the quadmath library, but you
+*** do not seem to have the quadmath library installed.
+*** Cannot continue, aborting.
+EOM
+    exit 1
+    ;;
+  esac
+  ;;
+define:*) $cat <<EOM >&4
+
+*** You requested the use of the quadmath library, but you
+*** do not seem to have the required header, <quadmath.h>.
+EOM
+  case "$gccversion" in
+  [23].*|4.[0-5]*)
+   $cat <<EOM >&4
+*** Your gcc looks a bit old:
+*** $gccversion
+EOM
+    ;;
+  '')
+   $cat <<EOM >&4
+*** You are not running a gcc.
+EOM
+    ;;
+  esac
+  $cat <<EOM >&4
+*** For the quadmath library you need at least gcc 4.6.
+*** Cannot continue, aborting.
+EOM
+  exit 1
+  ;;
+esac
+
 $echo "(IV will be "$ivtype", $ivsize bytes)"
 $echo "(UV will be "$uvtype", $uvsize bytes)"
 $echo "(NV will be "$nvtype", $nvsize bytes)"
@@ -20491,20 +20651,29 @@ else
        fi
 fi
 
-if $test X"$uselongdouble" = X"$define" -a X"$d_longdbl" = X"$define" -a 
X"$d_PRIgldbl" = X"$define"; then
+if $test X"$usequadmath" = X"$define"; then
+    nveformat='"Qe"'
+    nvfformat='"Qf"'
+    nvgformat='"Qg"'
+    nvEUformat='"QE"'
+    nvFUformat='"QF"'
+    nvGUformat='"QG"'
+else
+    if $test X"$uselongdouble" = X"$define" -a X"$d_longdbl" = X"$define" -a 
X"$d_PRIgldbl" = X"$define"; then
        nveformat="$sPRIeldbl"
        nvfformat="$sPRIfldbl"
        nvgformat="$sPRIgldbl"
        nvEUformat="$sPRIEUldbl"
        nvFUformat="$sPRIFUldbl"
        nvGUformat="$sPRIGUldbl"
-else
+    else
        nveformat='"e"'
        nvfformat='"f"'
        nvgformat='"g"'
        nvEUformat='"E"'
        nvFUformat='"F"'
        nvGUformat='"G"'
+    fi
 fi
 
 case "$ivdformat" in
@@ -23869,6 +24038,7 @@ i_poll='$i_poll'
 i_prot='$i_prot'
 i_pthread='$i_pthread'
 i_pwd='$i_pwd'
+i_quadmath='$i_quadmath'
 i_rpcsvcdbm='$i_rpcsvcdbm'
 i_sgtty='$i_sgtty'
 i_shadow='$i_shadow'
@@ -24247,6 +24417,7 @@ usensgetexecutablepath='$usensgetexecutablepath'
 useopcode='$useopcode'
 useperlio='$useperlio'
 useposix='$useposix'
+usequadmath='$usequadmath'
 usereentrant='$usereentrant'
 userelocatableinc='$userelocatableinc'
 useshrplib='$useshrplib'
diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
index b3c8aa9..ca36a55 100644
--- a/Cross/config.sh-arm-linux
+++ b/Cross/config.sh-arm-linux
@@ -693,6 +693,7 @@ i_poll='define'
 i_prot='undef'
 i_pthread='define'
 i_pwd='define'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='define'
@@ -1062,6 +1063,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='define'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='true'
diff --git a/INSTALL b/INSTALL
index 4c01ca9..9448a85 100644
--- a/INSTALL
+++ b/INSTALL
@@ -332,12 +332,28 @@ this support (if it is available).
 Note that the exact format and range of long doubles varies:
 the most common is the x86 80-bit (64 bits of mantissa) format,
 but there are others, with different mantissa and exponent ranges.
+In fact, the type may not be called "long double" at C level, and
+therefore the C<uselongdouble> means "using floating point larger
+than double".
 
 =head3 "more bits"
 
 You can "Configure -Dusemorebits" to turn on both the 64-bit support
 and the long double support.
 
+=head3 quadmath
+
+Another option for long doubles is that gcc 4.6 and later have library
+called quadmath, which implements the IEEE 754 quadruple precision
+(128-bit, 113 bits of mantissa) floating point numbers.  The library
+works at least on x86 and ia64 platforms.  It may be part of your gcc
+installation, or you may need to install it separately.
+
+With "Configure -Dusequadmath" you can enable its use, but note the
+compiler dependency, you may need to also add "-Dcc=..."  This option
+also turns on -Duselongdouble.  At C level the type is called C<__float128>,
+(note, not "long double") but Perl source knows it as NV.
+
 =head3 Algorithmic Complexity Attacks on Hashes
 
 Perl 5.18 reworked the measures used to secure its hash function
diff --git a/NetWare/config.wc b/NetWare/config.wc
index b9c7943..1407c44 100644
--- a/NetWare/config.wc
+++ b/NetWare/config.wc
@@ -675,6 +675,7 @@ i_poll='undef'
 i_prot='undef'
 i_pthread='undef'
 i_pwd='undef'
+i_quadmath='undef'
 i_rpcsvcdbm='define'
 i_sgtty='undef'
 i_shadow='undef'
@@ -1025,6 +1026,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='undef'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='true'
diff --git a/Porting/Glossary b/Porting/Glossary
index 2e8542b..e28bb56 100644
--- a/Porting/Glossary
+++ b/Porting/Glossary
@@ -3255,6 +3255,10 @@ i_pwd (i_pwd.U):
        This variable conditionally defines I_PWD, which indicates
        to the C program that it should include <pwd.h>.
 
+i_quadmath (i_quadmath.U):
+       This variable conditionally defines I_QUADMATH, which indicates
+       to the C program that it should include <quadmath.h>.
+
 i_rpcsvcdbm (i_dbm.U):
        This variable conditionally defines the I_RPCSVC_DBM symbol, which
        indicates to the C program that <rpcsvc/dbm.h> exists and should
@@ -5244,6 +5248,11 @@ useposix (Extensions.U):
        for hints files to indicate that POSIX will not compile
        on a particular system.
 
+usequadmath (usequadmath.U):
+       This variable conditionally defines the USE_QUADMATH symbol,
+       and indicates that the quadmath library __float128 long doubles
+       should be used when available.
+
 usereentrant (usethreads.U):
        This variable conditionally defines the USE_REENTRANT_API symbol,
        which indicates that the thread code may try to use the various
diff --git a/Porting/config.sh b/Porting/config.sh
index e00e50a..cda4fc5 100644
--- a/Porting/config.sh
+++ b/Porting/config.sh
@@ -708,6 +708,7 @@ i_poll='define'
 i_prot='undef'
 i_pthread='define'
 i_pwd='define'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='define'
@@ -1087,6 +1088,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='define'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='false'
diff --git a/cflags.SH b/cflags.SH
index 6bfa188..031b780 100755
--- a/cflags.SH
+++ b/cflags.SH
@@ -317,6 +317,21 @@ case "$gccversion" in
   ;;
 esac
 
+# The quadmath Q format specifier will cause -Wformat to whine.
+case "$gccversion" in
+'') ;;
+*) case "$usequadmath" in
+   define)
+     for f in -Wno-format
+     do
+       echo "cflags.SH: Adding $f because of usequadmath."
+       warn="$warn $f"
+     done
+    ;;
+  esac
+  ;;
+esac
+
 case "$cc" in
 *g++*)
   # Extra paranoia in case people have bad canned ccflags:
diff --git a/config_h.SH b/config_h.SH
index 1af5d4c..7aae94f 100755
--- a/config_h.SH
+++ b/config_h.SH
@@ -2882,6 +2882,12 @@ sed <<!GROK!THIS! >$CONFIG_H -e 
's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
 #$d_pwgecos PWGECOS    /**/
 #$d_pwpasswd PWPASSWD  /**/
 
+/* I_QUADMATH:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <quadmath.h>.
+ */
+#$i_quadmath   I_QUADMATH                /**/
+
 /* I_SYS_ACCESS:
  *     This symbol, if defined, indicates to the C program that it should
  *     include <sys/access.h>.
@@ -4843,6 +4849,14 @@ sed <<!GROK!THIS! >$CONFIG_H -e 
's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
 #$uselongdouble        USE_LONG_DOUBLE         /**/
 #endif
 
+/* USE_QUADMATH:
+ *     This symbol, if defined, indicates that the quadmath library should
+ *     be used when available.
+ */
+#ifndef USE_QUADMATH
+#$usequadmath  USE_QUADMATH            /**/
+#endif
+
 /* USE_MORE_BITS:
  *     This symbol, if defined, indicates that 64-bit interfaces and
  *     long doubles should be used when available.
diff --git a/configure.com b/configure.com
index 5d73245..11eb024 100644
--- a/configure.com
+++ b/configure.com
@@ -52,6 +52,7 @@ $ use64bitall = "n"
 $ use64bitint = "n"
 $ uselongdouble = "n"
 $ uselargefiles = "y"
+$ usequadmath = "n"
 $ usestdstat = "n"
 $ usesitecustomize = "n"
 $ C_Compiler_Replace = "CC="
@@ -925,7 +926,7 @@ $!
 $   config_symbols0 
="|archlib|archlibexp|bin|binexp|builddir|cf_email|config_sh|installarchlib|installbin|installman1dir|installman3dir|"
 $   config_symbols1 
="|installprivlib|installscript|installsitearch|installsitelib|most|oldarchlib|oldarchlibexp|osname|pager|perl_symbol|perl_verb|"
 $   config_symbols2 
="|prefix|privlib|privlibexp|scriptdir|sitearch|sitearchexp|sitebin|sitelib|sitelib_stem|sitelibexp|usecxx|use64bitall|use64bitint|"
-$   config_symbols3 
="|usecasesensitive|usedefaulttypes|usedevel|useieee|useithreads|uselongdouble|usemultiplicity|usemymalloc|usedebugging_perl|"
+$   config_symbols3 
="|usecasesensitive|usedefaulttypes|usedevel|useieee|useithreads|uselongdouble|usequadmath|usemultiplicity|usemymalloc|usedebugging_perl|"
 $   config_symbols4 
="|usesecurelog|usethreads|usevmsdebug|usefaststdio|usemallocwrap|unlink_all_versions|uselargefiles|usesitecustomize|"
 $   config_symbols5 
="|buildmake|builder|usethreadupcalls|usekernelthreads|useshortenedsymbols|useversionedarchname"
 $!  
@@ -6449,6 +6450,7 @@ $ WC "i_poll='" + i_poll + "'"
 $ WC "i_prot='undef'"
 $ WC "i_pthread='define'"
 $ WC "i_pwd='undef'"
+$ WC "i_quadmath='undef'"
 $ WC "i_rpcsvcdbm='undef'"
 $ WC "i_sgtty='undef'"
 $ WC "i_shadow='" + i_shadow + "'"
@@ -6729,6 +6731,7 @@ $ WC "usemultiplicity='" + usemultiplicity + "'"
 $ WC "usemymalloc='" + usemymalloc + "'"
 $ WC "useperlio='define'"
 $ WC "useposix='false'"
+$ WC "usequadmath='" + usequadmath + "'"
 $ WC "usereentrant='undef'"
 $ WC "userelocatableinc='undef'"
 $ WC "usesecurelog='" + usesecurelog + "'"  ! VMS-specific
@@ -6966,6 +6969,10 @@ $ IF uselongdouble .OR. uselongdouble .EQS. "define"
 $ THEN
 $   WC "#define USE_LONG_DOUBLE"
 $ ENDIF
+$ IF usequadmath .OR. usequadmath .EQS. "define"
+$ THEN
+$   WC "#define USE_QUADMATH"
+$ ENDIF
 $ IF use64bitall .OR. use64bitall .EQS. "define" THEN -
     WC "#define USE_64_BIT_ALL"
 $ IF be_case_sensitive THEN WC "#define VMS_WE_ARE_CASE_SENSITIVE"
diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm 
b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm
index e39c8b2..ca12afd 100644
--- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm
+++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm
@@ -106,8 +106,10 @@ sub _unix_os2_ext {
             # For gcc-2.6.2 on linux (March 1995), DLD can not load
             # .sa libraries, with the exception of libm.sa, so we
             # deliberately skip them.
-            if ( @fullname = $self->lsdir( $thispth, 
"^\Qlib$thislib.$so.\E[0-9]+" ) ) {
-
+            if ((@fullname =
+                 $self->lsdir($thispth, "^\Qlib$thislib.$so.\E[0-9]+")) ||
+                (@fullname =
+                 $self->lsdir($thispth, "^\Qlib$thislib.\E[0-9]+\Q\.$so"))) {
                 # Take care that libfoo.so.10 wins against libfoo.so.9.
                 # Compare two libraries to find the most recent version
                 # number.  E.g.  if you have libfoo.so.9.0.7 and
diff --git a/embed.fnc b/embed.fnc
index 1214bf7..a8789ac 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2433,8 +2433,10 @@ sn       |void   |mem_log_common |enum mem_log_type 
mlt|const UV n|const UV typesize \
 #endif
 
 #if defined(PERL_IN_NUMERIC_C)
+#ifndef USE_QUADMATH
 sn     |NV|mulexp10    |NV value|I32 exponent
 #endif
+#endif
 
 #if defined(PERL_IN_UTF8_C)
 sRM    |UV     |check_locale_boundary_crossing|NN const U8* const p|const UV 
result|NN U8* const ustrp|NN STRLEN *lenp
@@ -2644,6 +2646,10 @@ Apnod    |int    |my_sprintf     |NN char *buffer|NN 
const char *pat|...
 
 Apnodf |int    |my_snprintf    |NN char *buffer|const Size_t len|NN const char 
*format|...
 Apnod  |int    |my_vsnprintf   |NN char *buffer|const Size_t len|NN const char 
*format|va_list ap
+#ifdef USE_QUADMATH
+Apnd   |const char*    |quadmath_format_single|NN const char* format
+Apnd   |bool|quadmath_format_needed|NN const char* format
+#endif
 
 : Used in mg.c, sv.c
 px     |void   |my_clearenv
diff --git a/embed.h b/embed.h
index c658570..cd5c1d2 100644
--- a/embed.h
+++ b/embed.h
@@ -878,6 +878,10 @@
 #define PerlIO_unread(a,b,c)   Perl_PerlIO_unread(aTHX_ a,b,c)
 #define PerlIO_write(a,b,c)    Perl_PerlIO_write(aTHX_ a,b,c)
 #endif
+#if defined(USE_QUADMATH)
+#define quadmath_format_needed Perl_quadmath_format_needed
+#define quadmath_format_single Perl_quadmath_format_single
+#endif
 #if defined(WIN32)
 #define my_setlocale(a,b)      Perl_my_setlocale(aTHX_ a,b)
 #endif
@@ -1355,6 +1359,11 @@
 #define utf16_textfilter(a,b,c)        S_utf16_textfilter(aTHX_ a,b,c)
 #    endif
 #  endif
+#  if !defined(USE_QUADMATH)
+#    if defined(PERL_IN_NUMERIC_C)
+#define mulexp10               S_mulexp10
+#    endif
+#  endif
 #  if !defined(WIN32)
 #define do_exec3(a,b,c)                Perl_do_exec3(aTHX_ a,b,c)
 #  endif
@@ -1486,9 +1495,6 @@
 #define mro_gather_and_rename(a,b,c,d,e)       S_mro_gather_and_rename(aTHX_ 
a,b,c,d,e)
 #define mro_get_linear_isa_dfs(a,b)    S_mro_get_linear_isa_dfs(aTHX_ a,b)
 #  endif
-#  if defined(PERL_IN_NUMERIC_C)
-#define mulexp10               S_mulexp10
-#  endif
 #  if defined(PERL_IN_OP_C)
 #define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a)
 #define apply_attrs(a,b,c)     S_apply_attrs(aTHX_ a,b,c)
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index fb60d57..dcda631 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -57,44 +57,78 @@
 #include <unistd.h>
 #endif
 
-#ifndef M_E
-#  define M_E          2.71828182845904523536028747135266250
-#endif
-#ifndef M_LOG2E
-#  define M_LOG2E      1.44269504088896340735992468100189214
-#endif
-#ifndef M_LOG10E
-#  define M_LOG10E     0.434294481903251827651128918916605082
-#endif
-#ifndef M_LN2
-#  define M_LN2                0.693147180559945309417232121458176568
-#endif
-#ifndef M_LN10
-#  define M_LN10       2.30258509299404568401799145468436421
-#endif
-#ifndef M_PI
-#  define M_PI         3.14159265358979323846264338327950288
-#endif
-#ifndef M_PI_2
-#  define M_PI_2       1.57079632679489661923132169163975144
-#endif
-#ifndef M_PI_4
-#  define M_PI_4       0.785398163397448309615660845819875721
-#endif
-#ifndef M_1_PI
-#  define M_1_PI       0.318309886183790671537767526745028724
-#endif
-#ifndef M_2_PI
-#  define M_2_PI       0.636619772367581343075535053490057448
-#endif
-#ifndef M_2_SQRTPI
-#  define M_2_SQRTPI   1.12837916709551257389615890312154517
-#endif
-#ifndef M_SQRT2
-#  define M_SQRT2      1.41421356237309504880168872420969808
-#endif
-#ifndef M_SQRT1_2
-#  define M_SQRT1_2    0.707106781186547524400844362104849039
+#if defined(USE_QUADMATH) && defined(I_QUADMATH)
+
+#  undef M_E
+#  undef M_LOG2E
+#  undef M_LOG10E
+#  undef M_LN2
+#  undef M_LN10
+#  undef M_PI
+#  undef M_PI_2
+#  undef M_PI_4
+#  undef M_1_PI
+#  undef M_2_PI
+#  undef M_2_SQRTPI
+#  undef M_SQRT2
+#  undef M_SQRT1_2
+
+#  define M_E        M_Eq
+#  define M_LOG2E    M_LOG2Eq
+#  define M_LOG10E   M_LOG10Eq
+#  define M_LN2      M_LN2q
+#  define M_LN10     M_LN10q
+#  define M_PI       M_PIq
+#  define M_PI_2     M_PI_2q
+#  define M_PI_4     M_PI_4q
+#  define M_1_PI     M_1_PIq
+#  define M_2_PI     M_2_PIq
+#  define M_2_SQRTPI M_2_SQRTPIq
+#  define M_SQRT2    M_SQRT2q
+#  define M_SQRT1_2  M_SQRT1_2q
+
+#else
+
+#  ifndef M_E
+#    define M_E                2.71828182845904523536028747135266250
+#  endif
+#  ifndef M_LOG2E
+#    define M_LOG2E    1.44269504088896340735992468100189214
+#  endif
+#  ifndef M_LOG10E
+#    define M_LOG10E   0.434294481903251827651128918916605082
+#  endif
+#  ifndef M_LN2
+#    define M_LN2      0.693147180559945309417232121458176568
+#  endif
+#  ifndef M_LN10
+#    define M_LN10     2.30258509299404568401799145468436421
+#  endif
+#  ifndef M_PI
+#    define M_PI       3.14159265358979323846264338327950288
+#  endif
+#  ifndef M_PI_2
+#    define M_PI_2     1.57079632679489661923132169163975144
+#  endif
+#  ifndef M_PI_4
+#    define M_PI_4     0.785398163397448309615660845819875721
+#  endif
+#  ifndef M_1_PI
+#    define M_1_PI     0.318309886183790671537767526745028724
+#  endif
+#  ifndef M_2_PI
+#    define M_2_PI     0.636619772367581343075535053490057448
+#  endif
+#  ifndef M_2_SQRTPI
+#    define M_2_SQRTPI 1.12837916709551257389615890312154517
+#  endif
+#  ifndef M_SQRT2
+#    define M_SQRT2    1.41421356237309504880168872420969808
+#  endif
+#  ifndef M_SQRT1_2
+#    define M_SQRT1_2  0.707106781186547524400844362104849039
+#  endif
+
 #endif
 
 #if !defined(INFINITY) && defined(NV_INF)
@@ -193,10 +227,53 @@
 #    define NO_C99_LONG_DOUBLE_MATH
 #  endif
 
+#  if defined(USE_QUADMATH) && defined(I_QUADMATH)
+#    define c99_acosh  acoshq
+#    define c99_asinh  asinhq
+#    define c99_atanh  atanhq
+#    define c99_cbrt   cbrtq
+#    define c99_copysign       copysignq
+#    define c99_erf    erfq
+#    define c99_erfc   erfcq
+/* no exp2q */
+#    define c99_expm1  expm1q
+#    define c99_fdim   fdimq
+#    define c99_fma    fmaq
+#    define c99_fmax   fmaxq
+#    define c99_fmin   fminq
+#    define c99_hypot  hypotq
+#    define c99_ilogb  ilogbq
+#    define c99_lgamma lgammaq
+#    define c99_log1p  log1pq
+#    define c99_log2   log2q
+/* no logbq */
+/* no llrintq */
+/* no llroundq */
+#    define c99_lrint  lrintq
+#    define c99_lround lroundq
+#    define c99_nan    nanq
+#    define c99_nearbyint      nearbyintq
+#    define c99_nextafter      nextafterq
+/* no nexttowardq */
+#    define c99_remainder      remainderq
+#    define c99_remquo remquoq
+#    define c99_rint   rintq
+#    define c99_round  roundq
+#    define c99_scalbn scalbnq
+#    define c99_signbit        signbitq
+#    define c99_tgamma tgammal
+#    define c99_trunc  truncq
+#    define bessel_j0 j0q
+#    define bessel_j1 j1q
+#    define bessel_jn jnq
+#    define bessel_y0 y0q
+#    define bessel_y1 y1q
+#    define bessel_yn ynq
+#  elif defined(USE_LONG_DOUBLE) && \
+     !defined(NO_C99_LONG_DOUBLE_MATH) && \
+      defined(HAS_ILOGBL)
 /* There's already a symbol for ilogbl, we will use its truthiness
  * as the canary for all the *l variants being defined. */
-#  if defined(USE_LONG_DOUBLE) && defined(HAS_ILOGBL) && \
-     !defined(NO_C99_LONG_DOUBLE_MATH)
 #    define c99_acosh  acoshl
 #    define c99_asinh  asinhl
 #    define c99_atanh  atanhl
@@ -479,7 +556,7 @@
 #endif
 
 /* The Bessel functions: BSD, SVID, XPG4, and POSIX.  But not C99. */
-#ifdef HAS_J0
+#if defined(HAS_J0) && !defined(bessel_j0)
 #  if defined(USE_LONG_DOUBLE) && defined(HAS_J0L)
 #    define bessel_j0 j0l
 #    define bessel_j1 j1l
diff --git a/ext/XS-APItest/t/locale.t b/ext/XS-APItest/t/locale.t
index 900fe74..42fdab8 100644
--- a/ext/XS-APItest/t/locale.t
+++ b/ext/XS-APItest/t/locale.t
@@ -4,6 +4,7 @@ BEGIN {
 }
 
 use XS::APItest;
+use Config;
 
 BEGIN {
     eval { require POSIX; POSIX->import("locale_h") };
@@ -30,6 +31,11 @@ skip_all("no non-dot radix locales available") unless 
$non_dot_locale;
 
 plan tests => 2;
 
-is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize underlying 
locale outside 'use locale'");
-use locale;
-is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize underlying 
locale inside 'use locale'");
+SKIP: {
+      if ($Config{usequadmath}) {
+            skip "no gconvert with usequadmath", 2;
+      }
+      is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize 
underlying locale outside 'use locale'");
+      use locale;
+      is(test_Gconvert(4.179, 2), "4.2", "Gconvert doesn't recognize 
underlying locale inside 'use locale'");
+}
diff --git a/ext/XS-APItest/t/printf.t b/ext/XS-APItest/t/printf.t
index 76cc19f..8f43ee2 100644
--- a/ext/XS-APItest/t/printf.t
+++ b/ext/XS-APItest/t/printf.t
@@ -1,3 +1,11 @@
+BEGIN {
+  require Config; import Config;
+  if ($Config{usequadmath}) {
+     print "1..0 # Skip: usequadmath\n";
+     exit(0);
+  }
+}
+
 use Test::More tests => 11;
 
 BEGIN { use_ok('XS::APItest') };
diff --git a/lib/locale.t b/lib/locale.t
index 31b40f9..f59e17b 100644
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -1910,13 +1910,23 @@ foreach my $Locale (@Locale) {
 
     my $first_c_test = $locales_test_number;
 
-    report_result($Locale, ++$locales_test_number, $ok3);
-    $test_names{$locales_test_number} = 'Verify that a different locale radix 
works when doing "==" with a constant';
-    $problematical_tests{$locales_test_number} = 1;
+    $test_names{++$locales_test_number} = 'Verify that a different locale 
radix works when doing "==" with a constant';
+    if ($Config{usequadmath}) {
+        print "# Skip: no locale radix with usequadmath 
($test_names{$locales_test_number})\n";
+        report_result($Locale, $locales_test_number, 1);
+    } else {
+        report_result($Locale, $locales_test_number, $ok3);
+        $problematical_tests{$locales_test_number} = 1;
+    }
 
-    report_result($Locale, ++$locales_test_number, $ok4);
-    $test_names{$locales_test_number} = 'Verify that a different locale radix 
works when doing "==" with a scalar';
-    $problematical_tests{$locales_test_number} = 1;
+    $test_names{++$locales_test_number} = 'Verify that a different locale 
radix works when doing "==" with a scalar';
+    if ($Config{usequadmath}) {
+        print "# Skip: no locale radix with usequadmath 
($test_names{$locales_test_number})\n";
+        report_result($Locale, $locales_test_number, 1);
+    } else {
+        report_result($Locale, $locales_test_number, $ok4);
+        $problematical_tests{$locales_test_number} = 1;
+    }
 
     report_result($Locale, ++$locales_test_number, $ok5);
     $test_names{$locales_test_number} = 'Verify that a different locale radix 
works when doing "==" with a scalar and an intervening sprintf';
@@ -1931,9 +1941,14 @@ foreach my $Locale (@Locale) {
     report_result($Locale, ++$locales_test_number, $ok7);
     $test_names{$locales_test_number} = 'Verify that "==" with a scalar still 
works in inner no locale';
 
-    report_result($Locale, ++$locales_test_number, $ok8);
-    $test_names{$locales_test_number} = 'Verify that "==" with a scalar and an 
intervening sprintf still works in inner no locale';
-    $problematical_tests{$locales_test_number} = 1;
+    $test_names{++$locales_test_number} = 'Verify that "==" with a scalar and 
an intervening sprintf still works in inner no locale';
+    if ($Config{usequadmath}) {
+        print "# Skip: no locale radix with usequadmath 
($test_names{$locales_test_number})\n";
+        report_result($Locale, $locales_test_number, 1);
+    } else {
+        report_result($Locale, $locales_test_number, $ok8);
+        $problematical_tests{$locales_test_number} = 1;
+    }
 
     debug "$first_e_test..$locales_test_number: \$e = $e, no locale\n";
 
@@ -1946,9 +1961,14 @@ foreach my $Locale (@Locale) {
     $test_names{$locales_test_number} = 'Verify that after a no-locale block, 
a different locale radix still works when doing "==" with a scalar';
     $problematical_tests{$locales_test_number} = 1;
 
-    report_result($Locale, ++$locales_test_number, $ok11);
-    $test_names{$locales_test_number} = 'Verify that after a no-locale block, 
a different locale radix still works when doing "==" with a scalar and an 
intervening sprintf';
-    $problematical_tests{$locales_test_number} = 1;
+    $test_names{++$locales_test_number} = 'Verify that after a no-locale 
block, a different locale radix still works when doing "==" with a scalar and 
an intervening sprintf';
+    if ($Config{usequadmath}) {
+        print "# Skip: no locale radix with usequadmath 
($test_names{$locales_test_number})\n";
+        report_result($Locale, $locales_test_number, 1);
+    } else {
+        report_result($Locale, $locales_test_number, $ok11);
+        $problematical_tests{$locales_test_number} = 1;
+    }
 
     report_result($Locale, ++$locales_test_number, $ok12);
     $test_names{$locales_test_number} = 'Verify that after a no-locale block, 
a different locale radix can participate in an addition and function call as 
numeric';
@@ -2186,9 +2206,14 @@ foreach my $Locale (@Locale) {
             }
         }
 
-       report_result($Locale, $locales_test_number, @f == 0);
-       if (@f) {
-           print "# failed $locales_test_number locale '$Locale' numbers @f\n"
+        if ($Config{usequadmath}) {
+            print "# Skip: no locale radix with usequadmath ($Locale)\n";
+            report_result($Locale, $locales_test_number, 1);
+        } else {
+            report_result($Locale, $locales_test_number, @f == 0);
+            if (@f) {
+                print "# failed $locales_test_number locale '$Locale' numbers 
@f\n"
+            }
        }
     }
 }
diff --git a/makedef.pl b/makedef.pl
index 83f0c91..2cfd3c4 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -662,6 +662,11 @@ if ($define{'USE_PERLIO'}) {
        # Remaining remnants that _may_ be functions are handled below.
 }
 
+unless ($define{'USE_QUADMATH'}) {
+  ++$skip{Perl_quadmath_format_needed};
+  ++$skip{Perl_quadmath_format_single};
+}
+
 ###############################################################################
 
 # At this point all skip lists should be completed, as we are about to test
diff --git a/numeric.c b/numeric.c
index 427900b..5691120 100644
--- a/numeric.c
+++ b/numeric.c
@@ -965,6 +965,7 @@ Perl_grok_atou(const char *pv, const char** endptr)
     return val;
 }
 
+#ifndef USE_QUADMATH
 STATIC NV
 S_mulexp10(NV value, I32 exponent)
 {
@@ -1043,12 +1044,17 @@ S_mulexp10(NV value, I32 exponent)
     }
     return negative ? value / result : value * result;
 }
+#endif /* #ifndef USE_QUADMATH */
 
 NV
 Perl_my_atof(pTHX_ const char* s)
 {
     NV x = 0.0;
-#ifdef USE_LOCALE_NUMERIC
+#ifdef USE_QUADMATH
+    Perl_my_atof2(aTHX_ s, &x);
+    return x;
+#else
+#  ifdef USE_LOCALE_NUMERIC
     PERL_ARGS_ASSERT_MY_ATOF;
 
     {
@@ -1081,8 +1087,9 @@ Perl_my_atof(pTHX_ const char* s)
             Perl_atof2(s, x);
         RESTORE_LC_NUMERIC();
     }
-#else
+#  else
     Perl_atof2(s, x);
+#  endif
 #endif
     return x;
 }
@@ -1162,12 +1169,14 @@ S_my_atof_infnan(const char* s, bool negative, const 
char* send, NV* value)
 char*
 Perl_my_atof2(pTHX_ const char* orig, NV* value)
 {
-    NV result[3] = {0.0, 0.0, 0.0};
     const char* s = orig;
-#ifdef USE_PERL_ATOF
-    UV accumulator[2] = {0,0}; /* before/after dp */
-    bool negative = 0;
+    NV result[3] = {0.0, 0.0, 0.0};
+#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
     const char* send = s + strlen(orig); /* one past the last */
+    bool negative = 0;
+#endif
+#if defined(USE_PERL_ATOF) && !defined(USE_QUADMATH)
+    UV accumulator[2] = {0,0}; /* before/after dp */
     bool seen_digit = 0;
     I32 exp_adjust[2] = {0,0};
     I32 exp_acc[2] = {-1, -1};
@@ -1177,9 +1186,39 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     I32 digit = 0;
     I32 old_digit = 0;
     I32 sig_digits = 0; /* noof significant digits seen so far */
+#endif
 
+#if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
     PERL_ARGS_ASSERT_MY_ATOF2;
 
+    /* leading whitespace */
+    while (isSPACE(*s))
+       ++s;
+
+    /* sign */
+    switch (*s) {
+       case '-':
+           negative = 1;
+           /* FALLTHROUGH */
+       case '+':
+           ++s;
+    }
+#endif
+
+#ifdef USE_QUADMATH
+    {
+        char* endp;
+        if ((endp = S_my_atof_infnan(s, negative, send, value)))
+            return endp;
+        result[2] = strtoflt128(s, &endp);
+        if (s != endp) {
+            *value = negative ? -result[2] : result[2];
+            return endp;
+        }
+        return NULL;
+    }
+#elif defined(USE_PERL_ATOF)
+
 /* There is no point in processing more significant digits
  * than the NV can hold. Note that NV_DIG is a lower-bound value,
  * while we need an upper-bound value. We add 2 to account for this;
@@ -1209,19 +1248,6 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 /* the max number we can accumulate in a UV, and still safely do 10*N+9 */
 #define MAX_ACCUMULATE ( (UV) ((UV_MAX - 9)/10))
 
-    /* leading whitespace */
-    while (isSPACE(*s))
-       ++s;
-
-    /* sign */
-    switch (*s) {
-       case '-':
-           negative = 1;
-           /* FALLTHROUGH */
-       case '+':
-           ++s;
-    }
-
     {
         const char* endp;
         if ((endp = S_my_atof_infnan(s, negative, send, value)))
diff --git a/perl.h b/perl.h
index 8e81724..d711b20 100644
--- a/perl.h
+++ b/perl.h
@@ -1562,6 +1562,10 @@ EXTERN_C char *crypt(const char *, const char *);
 
 #define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && 
(Size_t)len >= (max)) Perl_croak_nocontext("panic: %s buffer overflow", 
STRINGIFY(api)); } STMT_END
 
+#ifdef USE_QUADMATH
+#  define my_snprintf Perl_my_snprintf
+#  define PERL_MY_SNPRINTF_GUARDED
+#else
 #if defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && 
!(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && 
!defined(PERL_GCC_PEDANTIC)
 #  ifdef PERL_USE_GCC_BRACE_GROUPS
 #      define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, 
__VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; })
@@ -1573,7 +1577,10 @@ EXTERN_C char *crypt(const char *, const char *);
 #  define my_snprintf  Perl_my_snprintf
 #  define PERL_MY_SNPRINTF_GUARDED
 #endif
+#endif
 
+/* There is no quadmath_vsnprintf, and therefore my_vsnprintf()
+ * dies if called under USE_QUADMATH. */
 #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && 
!(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && 
!defined(PERL_GCC_PEDANTIC)
 #  ifdef PERL_USE_GCC_BRACE_GROUPS
 #      define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, 
max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; })
@@ -1854,45 +1861,83 @@ typedef NVTYPE NV;
 #   ifdef I_SUNMATH
 #       include <sunmath.h>
 #   endif
-#   define NV_DIG LDBL_DIG
-#   ifdef LDBL_MANT_DIG
-#       define NV_MANT_DIG LDBL_MANT_DIG
-#   endif
-#   ifdef LDBL_MIN
-#       define NV_MIN LDBL_MIN
-#   endif
-#   ifdef LDBL_MAX
-#       define NV_MAX LDBL_MAX
-#   endif
-#   ifdef LDBL_MIN_EXP
-#       define NV_MIN_EXP LDBL_MIN_EXP
-#   endif
-#   ifdef LDBL_MAX_EXP
-#       define NV_MAX_EXP LDBL_MAX_EXP
-#   endif
-#   ifdef LDBL_MIN_10_EXP
-#       define NV_MIN_10_EXP LDBL_MIN_10_EXP
+#   if defined(USE_QUADMATH) && defined(I_QUADMATH)
+#       include <quadmath.h>
 #   endif
-#   ifdef LDBL_MAX_10_EXP
-#       define NV_MAX_10_EXP LDBL_MAX_10_EXP
-#   endif
-#   ifdef LDBL_EPSILON
-#       define NV_EPSILON LDBL_EPSILON
-#   endif
-#   ifdef LDBL_MAX
-#       define NV_MAX LDBL_MAX
+#   ifdef FLT128_DIG
+#       define NV_DIG FLT128_DIG
+#       define NV_MANT_DIG FLT128_MANT_DIG
+#       define NV_MIN FLT128_MIN
+#       define NV_MAX FLT128_MAX
+#       define NV_MIN_EXP FLT128_MIN_EXP
+#       define NV_MAX_EXP FLT128_MAX_EXP
+#       define NV_EPSILON FLT128_EPSILON
+#       define NV_MIN_10_EXP FLT128_MIN_10_EXP
+#       define NV_MAX_10_EXP FLT128_MAX_10_EXP
+#       define NV_INF HUGE_VALQ
+#       define NV_NAN nanq("0")
+#   elif defined(LDBL_DIG)
+#       define NV_DIG LDBL_DIG
+#       ifdef LDBL_MANT_DIG
+#           define NV_MANT_DIG LDBL_MANT_DIG
+#       endif
+#       ifdef LDBL_MIN
+#           define NV_MIN LDBL_MIN
+#       endif
+#       ifdef LDBL_MAX
+#           define NV_MAX LDBL_MAX
+#       endif
+#       ifdef LDBL_MIN_EXP
+#           define NV_MIN_EXP LDBL_MIN_EXP
+#       endif
+#       ifdef LDBL_MAX_EXP
+#           define NV_MAX_EXP LDBL_MAX_EXP
+#       endif
+#       ifdef LDBL_MIN_10_EXP
+#           define NV_MIN_10_EXP LDBL_MIN_10_EXP
+#       endif
+#       ifdef LDBL_MAX_10_EXP
+#           define NV_MAX_10_EXP LDBL_MAX_10_EXP
+#       endif
+#       ifdef LDBL_EPSILON
+#           define NV_EPSILON LDBL_EPSILON
+#       endif
+#       ifdef LDBL_MAX
+#           define NV_MAX LDBL_MAX
 /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */
-#   else
-#       ifdef HUGE_VALL
-#           define NV_MAX HUGE_VALL
 #       else
-#           ifdef HUGE_VAL
-#               define NV_MAX ((NV)HUGE_VAL)
+#           ifdef HUGE_VALL
+#               define NV_MAX HUGE_VALL
 #           endif
 #       endif
 #   endif
-#   ifdef HAS_SQRTL
-/* These math interfaces are the long double cousins of the C89 math. */
+#   if defined(USE_QUADMATH) && defined(I_QUADMATH)
+#       define Perl_acos acosq
+#       define Perl_asin asinq
+#       define Perl_atan atanq
+#       define Perl_atan2 atan2q
+#       define Perl_ceil ceilq
+#       define Perl_cos cosq
+#       define Perl_cosh coshq
+#       define Perl_exp expq
+/* no Perl_fabs, but there's PERL_ABS */
+#       define Perl_floor floorq
+#       define Perl_fmod fmodq
+#       define Perl_log logq
+#       define Perl_log10 log10q
+#       define Perl_pow powq
+#       define Perl_sin sinq
+#       define Perl_sinh sinhq
+#       define Perl_sqrt sqrtq
+#       define Perl_tan tanq
+#       define Perl_tanh tanhq
+#       define Perl_modf(x,y) modfq(x,y)
+#       define Perl_frexp(x,y) frexpq(x,y)
+#       define Perl_ldexp(x, y) ldexpq(x,y)
+#       define Perl_isinf(x) isinfq(x)
+#       define Perl_isnan(x) isnanq(x)
+#       define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
+#   elif defined(HAS_SQRTL)
 #       define Perl_acos acosl
 #       define Perl_asin asinl
 #       define Perl_atan atanl
@@ -1914,30 +1959,36 @@ typedef NVTYPE NV;
 #       define Perl_tanh tanhl
 #   endif
 /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
-#   ifdef HAS_MODFL
-#       define Perl_modf(x,y) modfl(x,y)
+#   ifndef Perl_modf
+#       ifdef HAS_MODFL
+#           define Perl_modf(x,y) modfl(x,y)
 /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no
    prototype in <math.h> */
-#       ifndef HAS_MODFL_PROTO
+#           ifndef HAS_MODFL_PROTO
 EXTERN_C long double modfl(long double, long double *);
-#      endif
-#   elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && defined(HAS_COPYSIGNL)
+#          endif
+#       elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && 
defined(HAS_COPYSIGNL)
         extern long double Perl_my_modfl(long double x, long double *ip);
 #           define Perl_modf(x,y) Perl_my_modfl(x,y)
+#       endif
 #   endif
-#   ifdef HAS_FREXPL
-#       define Perl_frexp(x,y) frexpl(x,y)
-#   else
-#       if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
-        extern long double Perl_my_frexpl(long double x, int *e);
-#           define Perl_frexp(x,y) Perl_my_frexpl(x,y)
+#   ifndef Perl_frexp
+#       ifdef HAS_FREXPL
+#           define Perl_frexp(x,y) frexpl(x,y)
+#       else
+#           if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
+extern long double Perl_my_frexpl(long double x, int *e);
+#               define Perl_frexp(x,y) Perl_my_frexpl(x,y)
+#           endif
 #       endif
 #   endif
-#   ifdef HAS_LDEXPL
-#       define Perl_ldexp(x, y) ldexpl(x,y)
-#   else
-#       if defined(HAS_SCALBNL) && FLT_RADIX == 2
-#           define Perl_ldexp(x,y) scalbnl(x,y)
+#   ifndef Perl_ldexp
+#       ifdef HAS_LDEXPL
+#           define Perl_ldexp(x, y) ldexpl(x,y)
+#       else
+#           if defined(HAS_SCALBNL) && FLT_RADIX == 2
+#               define Perl_ldexp(x,y) scalbnl(x,y)
+#           endif
 #       endif
 #   endif
 #   ifndef Perl_isnan
@@ -4993,6 +5044,9 @@ EXTCONST char PL_bincompat_options[] =
 #  ifdef USE_PERLIO
                             " USE_PERLIO"
 #  endif
+#  ifdef USE_QUADMATH
+                            " USE_QUADMATH"
+#  endif
 #  ifdef USE_REENTRANT_API
                             " USE_REENTRANT_API"
 #  endif
@@ -5765,7 +5819,9 @@ typedef struct am_table_short AMTS;
 
 #endif /* !USE_LOCALE_NUMERIC */
 
-#if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
+#ifdef USE_QUADMATH
+#  define Perl_strtod(s, e) strtoflt128(s, e)
+#elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
 #  if defined(HAS_STRTOLD)
 #    define Perl_strtod(s, e) strtold(s, e)
 #  elif defined(HAS_STRTOD)
diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
index 180584b..67cc84f 100644
--- a/plan9/config_sh.sample
+++ b/plan9/config_sh.sample
@@ -687,6 +687,7 @@ i_poll='undef'
 i_prot='undef'
 i_pthread='undef'
 i_pwd='define'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='undef'
@@ -1033,6 +1034,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='define'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='false'
diff --git a/pp_ctl.c b/pp_ctl.c
index db125b8..5036eda 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -825,11 +825,25 @@ PP(pp_formline)
                 int len;
                 DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
                 arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK);
+#ifdef USE_QUADMATH
+                {
+                    const char* qfmt = quadmath_format_single(fmt);
+                    int len;
+                    if (!qfmt)
+                        Perl_croak_nocontext("panic: quadmath invalid format 
\"%s\"", fmt);
+                    len = quadmath_snprintf(t, max, qfmt, (int) fieldsize, 
(int) arg, value);
+                    if (len == -1)
+                        Perl_croak_nocontext("panic: quadmath_snprintf failed, 
format \"%s\"", qfmt);
+                    if (qfmt != fmt)
+                        Safefree(fmt);
+                }
+#else
                 /* we generate fmt ourselves so it is safe */
                 GCC_DIAG_IGNORE(-Wformat-nonliteral);
                 len = my_snprintf(t, max, fmt, (int) fieldsize, (int) arg, 
value);
-                PERL_MY_SNPRINTF_POST_GUARD(len, max);
                 GCC_DIAG_RESTORE;
+#endif
+                PERL_MY_SNPRINTF_POST_GUARD(len, max);
                 RESTORE_LC_NUMERIC();
            }
            t += fieldsize;
diff --git a/proto.h b/proto.h
index a0b5c43..d6d3a86 100644
--- a/proto.h
+++ b/proto.h
@@ -5336,6 +5336,11 @@ PERL_CALLCONV int        Perl_my_sprintf(char *buffer, 
const char *pat, ...)
        assert(buffer); assert(pat)
 
 #endif
+#if !defined(USE_QUADMATH)
+#  if defined(PERL_IN_NUMERIC_C)
+STATIC NV      S_mulexp10(NV value, I32 exponent);
+#  endif
+#endif
 #if !defined(WIN32)
 PERL_CALLCONV bool     Perl_do_exec3(pTHX_ const char *incmd, int fd, int 
do_report)
                        __attribute__nonnull__(pTHX_1);
@@ -6120,9 +6125,6 @@ STATIC AV*        S_mro_get_linear_isa_dfs(pTHX_ HV* 
stash, U32 level)
        assert(stash)
 
 #endif
-#if defined(PERL_IN_NUMERIC_C)
-STATIC NV      S_mulexp10(NV value, I32 exponent);
-#endif
 #if defined(PERL_IN_OP_C)
 PERL_STATIC_INLINE bool        S_aassign_common_vars(pTHX_ OP* o);
 STATIC void    S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
@@ -8068,6 +8070,18 @@ PERL_CALLCONV SSize_t    Perl_PerlIO_write(pTHX_ PerlIO 
*f, const void *vbuf, Size_
        assert(vbuf)
 
 #endif
+#if defined(USE_QUADMATH)
+PERL_CALLCONV bool     Perl_quadmath_format_needed(const char* format)
+                       __attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_QUADMATH_FORMAT_NEEDED        \
+       assert(format)
+
+PERL_CALLCONV const char*      Perl_quadmath_format_single(const char* format)
+                       __attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_QUADMATH_FORMAT_SINGLE        \
+       assert(format)
+
+#endif
 #if defined(WIN32)
 PERL_CALLCONV char*    Perl_my_setlocale(pTHX_ int category, const char* 
locale)
                        __attribute__pure__;
diff --git a/sv.c b/sv.c
index 3f7fce6..04c2826 100644
--- a/sv.c
+++ b/sv.c
@@ -40,6 +40,14 @@
   char *gconvert(double, int, int,  char *);
 #endif
 
+#ifdef USE_QUADMATH
+#  define SNPRINTF_G(nv, buffer, size, ndig) \
+    quadmath_snprintf(buffer, size, "%.*Qg", (int)ndig, (NV)(nv))
+#else
+#  define SNPRINTF_G(nv, buffer, size, ndig) \
+    PERL_UNUSED_RESULT(Gconvert((NV)(nv), (int)ndig, 0, buffer))
+#endif
+
 #ifdef PERL_NEW_COPY_ON_WRITE
 #   ifndef SV_COW_THRESHOLD
 #    define SV_COW_THRESHOLD                    0   /* COW iff len > K */
@@ -3045,12 +3053,13 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, 
const I32 flags)
                 /* some Xenix systems wipe out errno here */
 
 #ifndef USE_LOCALE_NUMERIC
-                PERL_UNUSED_RESULT(Gconvert(SvNVX(sv), NV_DIG, 0, s));
+                SNPRINTF_G(SvNVX(sv), s, SvLEN(sv), NV_DIG);
+
                 SvPOK_on(sv);
 #else
                 {
                     DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
-                    PERL_UNUSED_RESULT(Gconvert(SvNVX(sv), NV_DIG, 0, s));
+                    SNPRINTF_G(SvNVX(sv), s, SvLEN(sv), NV_DIG);
 
                     /* If the radix character is UTF-8, and actually is in the
                      * output, turn on the UTF-8 flag for the scalar */
@@ -11023,9 +11032,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
                     if (digits && digits < sizeof(ebuf) - NV_DIG - 10) {
                         /* 0, point, slack */
                         STORE_LC_NUMERIC_SET_TO_NEEDED();
-                        PERL_UNUSED_RESULT(Gconvert(nv, (int)digits, 0, ebuf));
+                        SNPRINTF_G(nv, ebuf, size, digits);
                         sv_catpv_nomg(sv, ebuf);
-                        if (*ebuf) /* May return an empty string for digits==0 
*/
+                        if (*ebuf)     /* May return an empty string for 
digits==0 */
                             return;
                     }
                 } else if (!digits) {
@@ -11088,7 +11097,8 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
          * the time it is not (most compilers these days recognize
          * "long double", even if only as a synonym for "double").
        */
-#if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE > DOUBLESIZE && 
defined(PERL_PRIgldbl)
+#if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE > DOUBLESIZE && \
+       defined(PERL_PRIgldbl) && !defined(USE_QUADMATH)
        long double fv;
 #  define FV_ISFINITE(x) Perl_isfinitel(x)
 #  define FV_GF PERL_PRIgldbl
@@ -11394,6 +11404,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
 #if IVSIZE >= 8 || defined(HAS_LONG_DOUBLE)
        case 'L':                       /* Ld */
            /* FALLTHROUGH */
+#ifdef USE_QUADMATH
+        case 'Q':
+           /* FALLTHROUGH */
+#endif
 #if IVSIZE >= 8
        case 'q':                       /* qd */
 #endif
@@ -11823,7 +11837,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
                  * The only case where you can pull off long doubles
                  * is when the format specifier explicitly asks so with
                  * e.g. "%Lg". */
-#if LONG_DOUBLESIZE > DOUBLESIZE
+#ifdef USE_QUADMATH
+                fv = intsize == 'q' ?
+                    va_arg(*args, NV) : va_arg(*args, double);
+#elif LONG_DOUBLESIZE > DOUBLESIZE
                 fv = intsize == 'q' ?
                     va_arg(*args, long double) : va_arg(*args, double);
 #else
@@ -11973,7 +11990,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
                   aka precis is 0  */
                if ( c == 'g' && precis ) {
                     STORE_LC_NUMERIC_SET_TO_NEEDED();
-                   PERL_UNUSED_RESULT(Gconvert((NV)fv, (int)precis, 0, 
PL_efloatbuf));
+                    SNPRINTF_G(fv, PL_efloatbuf, PL_efloatsize, precis);
                    /* May return an empty string for digits==0 */
                    if (*PL_efloatbuf) {
                        elen = strlen(PL_efloatbuf);
@@ -12178,9 +12195,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
                    /* Copy the one or more characters in a long double
                     * format before the 'base' ([efgEFG]) character to
                     * the format string. */
+#ifdef USE_QUADMATH
+                    *--ptr = 'Q';
+#else
                    static char const ldblf[] = PERL_PRIfldbl;
                    char const *p = ldblf + sizeof(ldblf) - 3;
                    while (p >= ldblf) { *--ptr = *p--; }
+#endif
                }
 #endif
                if (has_precis) {
@@ -12211,7 +12232,19 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
                 /* hopefully the above makes ptr a very constrained format
                  * that is safe to use, even though it's not literal */
                 GCC_DIAG_IGNORE(-Wformat-nonliteral);
-#if defined(HAS_LONG_DOUBLE)
+#ifdef USE_QUADMATH
+                {
+                    const char* qfmt = quadmath_format_single(ptr);
+                    if (!qfmt)
+                        Perl_croak_nocontext("panic: quadmath invalid format 
\"%s\"", ptr);
+                    elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
+                                             qfmt, fv);
+                    if ((IV)elen == -1)
+                        Perl_croak_nocontext("panic: quadmath_snprintf failed, 
format \"%s|'", qfmt);
+                    if (qfmt != ptr)
+                        Safefree(qfmt);
+                }
+#elif defined(HAS_LONG_DOUBLE)
                 elen = ((intsize == 'q')
                         ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
                         : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, 
(double)fv));
diff --git a/symbian/config.sh b/symbian/config.sh
index 8229f17..193b8db 100644
--- a/symbian/config.sh
+++ b/symbian/config.sh
@@ -614,6 +614,7 @@ i_poll='undef'
 i_prot='undef'
 i_pthread='undef'
 i_pwd='define'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='undef'
@@ -848,6 +849,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='define'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='false'
diff --git a/t/op/infnan.t b/t/op/infnan.t
index 101fc24..8cb177d 100644
--- a/t/op/infnan.t
+++ b/t/op/infnan.t
@@ -139,10 +139,14 @@ SKIP: {
   }
 }
 
-{
+SKIP: {
+    my @FInf = qw(Info Infiniti Infinityz);
+    if ($Config{usequadmath}) {
+        skip "quadmath strtoflt128() accepts false infinities", scalar @FInf;
+    }
     # Silence "isn't numeric in addition", that's kind of the point.
     local $^W = 0;
-    for my $i (qw(Info Infiniti Infinityz)) {
+    for my $i (@FInf) {
         cmp_ok("$i" + 0, '==', 0, "false infinity $i");
     }
 }
diff --git a/t/porting/libperl.t b/t/porting/libperl.t
index f52beb3..6b441e5 100644
--- a/t/porting/libperl.t
+++ b/t/porting/libperl.t
@@ -430,7 +430,11 @@ my %expected = (
     );
 
 if ($Config{uselongdouble} && $Config{longdblsize} > $Config{doublesize}) {
-    $expected{expl} = undef; # There is no Configure symbol for expl.
+    if ($Config{usequadmath}) {
+        $expected{expq} = undef; # There is no Configure symbol for expq.
+    } else {
+        $expected{expl} = undef; # There is no Configure symbol for expl.
+    }
 } else {
     $expected{exp} = undef; # There is no Configure symbol for exp.
 }
diff --git a/uconfig.h b/uconfig.h
index 3429c99..81d5e06 100644
--- a/uconfig.h
+++ b/uconfig.h
@@ -2847,6 +2847,12 @@
 /*#define PWGECOS      / **/
 /*#define PWPASSWD     / **/
 
+/* I_QUADMATH:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <quadmath.h>.
+ */
+/*#define   I_QUADMATH                / **/
+
 /* I_SYS_ACCESS:
  *     This symbol, if defined, indicates to the C program that it should
  *     include <sys/access.h>.
@@ -4808,6 +4814,14 @@
 /*#define      USE_LONG_DOUBLE         / **/
 #endif
 
+/* USE_QUADMATH:
+ *     This symbol, if defined, indicates that the quadmath library should
+ *     be used when available.
+ */
+#ifndef USE_QUADMATH
+/*#define      USE_QUADMATH            / **/
+#endif
+
 /* USE_MORE_BITS:
  *     This symbol, if defined, indicates that 64-bit interfaces and
  *     long doubles should be used when available.
@@ -4851,6 +4865,6 @@
 #endif
 
 /* Generated from:
- * 8d61fec9ecb01eecea08d68eef7ee547e6ec951a411600e1e178c1270ba17d89 config_h.SH
- * 6039ef141e931b6582a919f2049d2e4d68a5f977e2cf27b898966e83d5f3ed62 uconfig.sh
+ * d7da79ac72d2191d6814ec98688e342f20eba70c64292c2e0b6b5622cdf3b6e6 config_h.SH
+ * a3cd0b705a952f6915cc1424cc116d4183481f54ba9605415baf93bc57e12122 uconfig.sh
  * ex: set ro: */
diff --git a/uconfig.sh b/uconfig.sh
index 7589c0b..0341bda 100644
--- a/uconfig.sh
+++ b/uconfig.sh
@@ -600,6 +600,7 @@ i_poll='undef'
 i_prot='undef'
 i_pthread='undef'
 i_pwd='undef'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='undef'
@@ -815,6 +816,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='undef'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='false'
diff --git a/uconfig64.sh b/uconfig64.sh
index 6c5445d..00fa9d0 100644
--- a/uconfig64.sh
+++ b/uconfig64.sh
@@ -601,6 +601,7 @@ i_poll='undef'
 i_prot='undef'
 i_pthread='undef'
 i_pwd='undef'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='undef'
@@ -816,6 +817,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='undef'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='false'
diff --git a/util.c b/util.c
index e87813b..ae3b833 100644
--- a/util.c
+++ b/util.c
@@ -4908,6 +4908,112 @@ Perl_my_sprintf(char *buffer, const char* pat, ...)
 #endif
 
 /*
+=for apidoc quadmath_format_single
+
+quadmath_snprintf() is very strict about its format string and will
+fail, returning -1, if the format is invalid.  It acccepts exactly
+one format spec.
+
+quadmath_format_single() checks that the intended single spec looks
+sane: begins with C<%>, has only one C<%>, ends with C<[efgaEFGA]>,
+and has C<Q> before it.  This is not a full "printf syntax check",
+just the basics.
+
+Returns the format if it is valid, NULL if not.
+
+quadmath_format_single() can and will actually patch in the missing
+C<Q>, if necessary.  In this case it will return the modified copy of
+the format, B<which the caller will need to free.>
+
+See also L</quadmath_format_needed>.
+
+=cut
+*/
+#ifdef USE_QUADMATH
+const char*
+Perl_quadmath_format_single(const char* format)
+{
+    STRLEN len;
+
+    PERL_ARGS_ASSERT_QUADMATH_FORMAT_SINGLE;
+
+    if (format[0] != '%' || strchr(format + 1, '%'))
+        return NULL;
+    len = strlen(format);
+    /* minimum length three: %Qg */
+    if (len < 3 || strchr("efgaEFGA", format[len - 1]) == NULL)
+        return NULL;
+    if (format[len - 2] != 'Q') {
+        char* fixed;
+        Newx(fixed, len + 1, char);
+        memcpy(fixed, format, len - 1);
+        fixed[len - 1] = 'Q';
+        fixed[len    ] = format[len - 1];
+        fixed[len + 1] = 0;
+        return (const char*)fixed;
+    }
+    return format;
+}
+#endif
+
+/*
+=for apidoc quadmath_format_needed
+
+quadmath_format_needed() returns true if the format string seems to
+contain at least one non-Q-prefixed %[efgaEFGA] format specifier,
+or returns false otherwise.
+
+The format specifier detection is not complete printf-syntax detection,
+but it should catch most common cases.
+
+If true is returned, those arguments B<should> in theory be processed
+with quadmath_snprintf(), but in case there is more than one such
+format specifier (see L</quadmath_format_single>), and if there is
+anything else beyond that one (even just a single byte), they
+B<cannot> be processed because quadmath_snprintf() is very strict,
+accepting only one format spec, and nothing else.
+In this case, the code should probably fail.
+
+=cut
+*/
+#ifdef USE_QUADMATH
+bool
+Perl_quadmath_format_needed(const char* format)
+{
+  const char *p = format;
+  const char *q;
+
+  PERL_ARGS_ASSERT_QUADMATH_FORMAT_NEEDED;
+
+  while ((q = strchr(p, '%'))) {
+    q++;
+    if (*q == '+') /* plus */
+      q++;
+    if (*q == '#') /* alt */
+      q++;
+    if (*q == '*') /* width */
+      q++;
+    else {
+      if (isDIGIT(*q)) {
+        while (isDIGIT(*q)) q++;
+      }
+    }
+    if (*q == '.' && (q[1] == '*' || isDIGIT(q[1]))) { /* prec */
+      q++;
+      if (*q == '*')
+        q++;
+      else
+        while (isDIGIT(*q)) q++;
+    }
+    if (strchr("efgaEFGA", *q)) /* Would have needed 'Q' in front. */
+      return TRUE;
+    p = q + 1;
+  }
+  return FALSE;
+}
+#endif
+
+/*
 =for apidoc my_snprintf
 
 The C library C<snprintf> functionality, if available and
@@ -4922,17 +5028,59 @@ getting C<vsnprintf>.
 int
 Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
 {
-    int retval;
+    int retval = -1;
     va_list ap;
     PERL_ARGS_ASSERT_MY_SNPRINTF;
 #ifndef HAS_VSNPRINTF
     PERL_UNUSED_VAR(len);
 #endif
     va_start(ap, format);
+#ifdef USE_QUADMATH
+    {
+        const char* qfmt = quadmath_format_single(format);
+        bool quadmath_valid = FALSE;
+        if (qfmt) {
+            /* If the format looked promising, use it as quadmath. */
+            retval = quadmath_snprintf(buffer, len, qfmt, va_arg(ap, NV));
+            if (retval == -1)
+                Perl_croak_nocontext("panic: quadmath_snprintf failed, format 
\"%s\"", qfmt);
+            quadmath_valid = TRUE;
+            if (qfmt != format)
+                Safefree(qfmt);
+            qfmt = NULL;
+        }
+        assert(qfmt == NULL);
+        /* quadmath_format_single() will return false for example for
+         * "foo = %g", or simply "%g".  We could handle the %g by
+         * using quadmath for the NV args.  More complex cases of
+         * course exist: "foo = %g, bar = %g", or "foo=%Qg" (otherwise
+         * quadmath-valid but has stuff in front).
+         *
+         * Handling the "Q-less" cases right would require walking
+         * through the va_list and rewriting the format, calling
+         * quadmath for the NVs, building a new va_list, and then
+         * letting vsnprintf/vsprintf to take care of the other
+         * arguments.  This may be doable.
+         *
+         * We do not attempt that now.  But for paranoia, we here try
+         * to detect some common (but not all) cases where the
+         * "Q-less" %[efgaEFGA] formats are present, and die if
+         * detected.  This doesn't fix the problem, but it stops the
+         * vsnprintf/vsprintf pulling doubles off the va_list when
+         * __float128 NVs should be pulled off instead.
+         *
+         * If quadmath_format_needed() returns false, we are reasonably
+         * certain that we can call vnsprintf() or vsprintf() safely. */
+        if (!quadmath_valid && quadmath_format_needed(format))
+          Perl_croak_nocontext("panic: quadmath_snprintf failed, format 
\"%s\"", format);
+
+    }
+#endif
+    if (retval == -1)
 #ifdef HAS_VSNPRINTF
-    retval = vsnprintf(buffer, len, format, ap);
+        retval = vsnprintf(buffer, len, format, ap);
 #else
-    retval = vsprintf(buffer, format, ap);
+        retval = vsprintf(buffer, format, ap);
 #endif
     va_end(ap);
     /* vsprintf() shows failure with < 0 */
@@ -4961,6 +5109,14 @@ C<sv_vcatpvf> instead, or getting C<vsnprintf>.
 int
 Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list 
ap)
 {
+#ifdef USE_QUADMATH
+    PERL_UNUSED_ARG(buffer);
+    PERL_UNUSED_ARG(len);
+    PERL_UNUSED_ARG(format);
+    PERL_UNUSED_ARG(ap);
+    Perl_croak_nocontext("panic: my_vsnprintf not available with quadmath");
+    return 0;
+#else
     int retval;
 #ifdef NEED_VA_COPY
     va_list apc;
@@ -4993,6 +5149,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const 
char *format, va_list ap
     )
        Perl_croak_nocontext("panic: my_vsnprintf buffer overflow");
     return retval;
+#endif
 }
 
 void
diff --git a/win32/config.ce b/win32/config.ce
index d6ff63d..e1083af 100644
--- a/win32/config.ce
+++ b/win32/config.ce
@@ -671,6 +671,7 @@ i_poll='undef'
 i_prot='undef'
 i_pthread='undef'
 i_pwd='undef'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='undef'
@@ -1015,6 +1016,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='~USE_PERLIO~'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='true'
diff --git a/win32/config.gc b/win32/config.gc
index 6d7b9d3..d83ab2a 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -683,6 +683,7 @@ i_poll='undef'
 i_prot='undef'
 i_pthread='undef'
 i_pwd='undef'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='undef'
@@ -1056,6 +1057,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='undef'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='true'
diff --git a/win32/config.vc b/win32/config.vc
index 0c0d829..454ff88 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -682,6 +682,7 @@ i_poll='undef'
 i_prot='undef'
 i_pthread='undef'
 i_pwd='undef'
+i_quadmath='undef'
 i_rpcsvcdbm='undef'
 i_sgtty='undef'
 i_shadow='undef'
@@ -1055,6 +1056,7 @@ usensgetexecutablepath='undef'
 useopcode='true'
 useperlio='undef'
 useposix='true'
+usequadmath='undef'
 usereentrant='undef'
 userelocatableinc='undef'
 useshrplib='true'

--
Perl5 Master Repository

Reply via email to