return var;
}
+/* Implement a fast "%.0f": given a pointer to the end of a buffer (caller
+ * ensures it's big enough), back fill it with the rounded integer part of
+ * nv. Returns ptr to start of string, and sets *len to its length.
+ * Returns NULL if not convertible.
+ */
+
STATIC char *
S_F0convert(NV nv, char *const endbuf, STRLEN *const len)
{
PERL_ARGS_ASSERT_F0CONVERT;
- if (UNLIKELY(Perl_isinfnan(nv))) {
- STRLEN n = S_infnan_2pv(nv, endbuf - *len, *len, 0);
- *len = n;
- return endbuf - n;
- }
+ assert(!Perl_isinfnan(nv));
if (neg)
nv = -nv;
if (nv < UV_MAX) {
sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, SV_GMAGIC|SV_SMAGIC);
}
+
+/* For the vcatpvfn code, we need a long double target in case
+ * HAS_LONG_DOUBLE, even without USE_LONG_DOUBLE, so that we can printf
+ * with long double formats, even without NV being long double. But we
+ * call the target 'fv' instead of 'nv', since most of 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) && !defined(USE_QUADMATH)
+# define VCATPVFN_FV_GF PERL_PRIgldbl
+# if defined(__VMS) && defined(__ia64) && defined(__IEEE_FLOAT)
+ /* Work around breakage in OTS$CVT_FLOAT_T_X */
+# define VCATPVFN_NV_TO_FV(nv,fv) \
+ STMT_START { \
+ double _dv = nv; \
+ fv = Perl_isnan(_dv) ? LDBL_QNAN : _dv; \
+ } STMT_END
+# else
+# define VCATPVFN_NV_TO_FV(nv,fv) (fv)=(nv)
+# endif
+ typedef long double vcatpvfn_long_double_t;
+#else
+# define VCATPVFN_FV_GF NVgf
+# define VCATPVFN_NV_TO_FV(nv,fv) (fv)=(nv)
+ typedef NV vcatpvfn_long_double_t;
+#endif
+
#ifdef LONGDOUBLE_DOUBLEDOUBLE
/* The first double can be as large as 2**1023, or '1' x '0' x 1023.
* The second double can be as small as 2**-1074, or '0' x 1073 . '1'.
# define HEXTRACT_MIX_ENDIAN
#endif
-/* S_hextract() is a helper for Perl_sv_vcatpvfn_flags, for extracting
+/* S_hextract() is a helper for S_format_hexfp, for extracting
* the hexadecimal values (for %a/%A). The nv is the NV where the value
* are being extracted from (either directly from the long double in-memory
* presentation, or from the uquad computed via frexp+ldexp). frexp also
return v;
}
+
+/* S_format_hexfp(): helper function for Perl_sv_vcatpvfn_flags().
+ *
+ * Processes the %a/%A hexadecimal floating-point format, since the
+ * built-in snprintf()s which are used for most of the f/p formats, don't
+ * universally handle %a/%A.
+ * Populates buf of length bufsize, and returns the length of the created
+ * string.
+ * The rest of the args have the same meaning as the local vars of the
+ * same name within Perl_sv_vcatpvfn_flags().
+ */
+
+static STRLEN
+S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
+ const NV nv, const vcatpvfn_long_double_t fv,
+ bool has_precis, STRLEN precis, STRLEN width,
+ bool alt, char plus, bool left, char fill)
+{
+ /* Hexadecimal floating point. */
+ char* p = buf;
+ U8 vhex[VHEX_SIZE];
+ U8* v = vhex; /* working pointer to vhex */
+ U8* vend; /* pointer to one beyond last digit of vhex */
+ U8* vfnz = NULL; /* first non-zero */
+ U8* vlnz = NULL; /* last non-zero */
+ U8* v0 = NULL; /* first output */
+ const bool lower = (c == 'a');
+ /* At output the values of vhex (up to vend) will
+ * be mapped through the xdig to get the actual
+ * human-readable xdigits. */
+ const char* xdig = PL_hexdigit;
+ int zerotail = 0; /* how many extra zeros to append */
+ int exponent = 0; /* exponent of the floating point input */
+ bool hexradix = FALSE; /* should we output the radix */
+ bool subnormal = FALSE; /* IEEE 754 subnormal/denormal */
+ bool negative = FALSE;
+ STRLEN elen;
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+
+ /* XXX: NaN, Inf -- though they are printed as "NaN" and "Inf".
+ *
+ * For example with denormals, (assuming the vanilla
+ * 64-bit double): the exponent is zero. 1xp-1074 is
+ * the smallest denormal and the smallest double, it
+ * could be output also as 0x0.0000000000001p-1022 to
+ * match its internal structure. */
+
+ vend = S_hextract(aTHX_ nv, &exponent, &subnormal, vhex, NULL);
+ S_hextract(aTHX_ nv, &exponent, &subnormal, vhex, vend);
+
+#if NVSIZE > DOUBLESIZE
+# ifdef HEXTRACT_HAS_IMPLICIT_BIT
+ /* In this case there is an implicit bit,
+ * and therefore the exponent is shifted by one. */
+ exponent--;
+# else
+# ifdef NV_X86_80_BIT
+ if (subnormal) {
+ /* The subnormals of the x86-80 have a base exponent of -16382,
+ * (while the physical exponent bits are zero) but the frexp()
+ * returned the scientific-style floating exponent. We want
+ * to map the last one as:
+ * -16831..-16384 -> -16382 (the last normal is 0x1p-16382)
+ * -16835..-16388 -> -16384
+ * since we want to keep the first hexdigit
+ * as one of the [8421]. */
+ exponent = -4 * ( (exponent + 1) / -4) - 2;
+ } else {
+ exponent -= 4;
+ }
+# endif
+ /* TBD: other non-implicit-bit platforms than the x86-80. */
+# endif
+#endif
+
+ negative = fv < 0 || Perl_signbit(nv);
+ if (negative)
+ *p++ = '-';
+ else if (plus)
+ *p++ = plus;
+ *p++ = '0';
+ if (lower) {
+ *p++ = 'x';
+ }
+ else {
+ *p++ = 'X';
+ xdig += 16; /* Use uppercase hex. */
+ }
+
+ /* Find the first non-zero xdigit. */
+ for (v = vhex; v < vend; v++) {
+ if (*v) {
+ vfnz = v;
+ break;
+ }
+ }
+
+ if (vfnz) {
+ /* Find the last non-zero xdigit. */
+ for (v = vend - 1; v >= vhex; v--) {
+ if (*v) {
+ vlnz = v;
+ break;
+ }
+ }
+
+#if NVSIZE == DOUBLESIZE
+ if (fv != 0.0)
+ exponent--;
+#endif
+
+ if (subnormal) {
+#ifndef NV_X86_80_BIT
+ if (vfnz[0] > 1) {
+ /* IEEE 754 subnormals (but not the x86 80-bit):
+ * we want "normalize" the subnormal,
+ * so we need to right shift the hex nybbles
+ * so that the output of the subnormal starts
+ * from the first true bit. (Another, equally
+ * valid, policy would be to dump the subnormal
+ * nybbles as-is, to display the "physical" layout.) */
+ int i, n;
+ U8 *vshr;
+ /* Find the ceil(log2(v[0])) of
+ * the top non-zero nybble. */
+ for (i = vfnz[0], n = 0; i > 1; i >>= 1, n++) { }
+ assert(n < 4);
+ vlnz[1] = 0;
+ for (vshr = vlnz; vshr >= vfnz; vshr--) {
+ vshr[1] |= (vshr[0] & (0xF >> (4 - n))) << (4 - n);
+ vshr[0] >>= n;
+ }
+ if (vlnz[1]) {
+ vlnz++;
+ }
+ }
+#endif
+ v0 = vfnz;
+ } else {
+ v0 = vhex;
+ }
+
+ if (has_precis) {
+ U8* ve = (subnormal ? vlnz + 1 : vend);
+ SSize_t vn = ve - v0;
+ assert(vn >= 1);
+ if (precis < (Size_t)(vn - 1)) {
+ bool overflow = FALSE;
+ if (v0[precis + 1] < 0x8) {
+ /* Round down, nothing to do. */
+ } else if (v0[precis + 1] > 0x8) {
+ /* Round up. */
+ v0[precis]++;
+ overflow = v0[precis] > 0xF;
+ v0[precis] &= 0xF;
+ } else { /* v0[precis] == 0x8 */
+ /* Half-point: round towards the one
+ * with the even least-significant digit:
+ * 08 -> 0 88 -> 8
+ * 18 -> 2 98 -> a
+ * 28 -> 2 a8 -> a
+ * 38 -> 4 b8 -> c
+ * 48 -> 4 c8 -> c
+ * 58 -> 6 d8 -> e
+ * 68 -> 6 e8 -> e
+ * 78 -> 8 f8 -> 10 */
+ if ((v0[precis] & 0x1)) {
+ v0[precis]++;
+ }
+ overflow = v0[precis] > 0xF;
+ v0[precis] &= 0xF;
+ }
+
+ if (overflow) {
+ for (v = v0 + precis - 1; v >= v0; v--) {
+ (*v)++;
+ overflow = *v > 0xF;
+ (*v) &= 0xF;
+ if (!overflow) {
+ break;
+ }
+ }
+ if (v == v0 - 1 && overflow) {
+ /* If the overflow goes all the
+ * way to the front, we need to
+ * insert 0x1 in front, and adjust
+ * the exponent. */
+ Move(v0, v0 + 1, vn - 1, char);
+ *v0 = 0x1;
+ exponent += 4;
+ }
+ }
+
+ /* The new effective "last non zero". */
+ vlnz = v0 + precis;
+ }
+ else {
+ zerotail =
+ subnormal ? precis - vn + 1 :
+ precis - (vlnz - vhex);
+ }
+ }
+
+ v = v0;
+ *p++ = xdig[*v++];
+
+ /* If there are non-zero xdigits, the radix
+ * is output after the first one. */
+ if (vfnz < vlnz) {
+ hexradix = TRUE;
+ }
+ }
+ else {
+ *p++ = '0';
+ exponent = 0;
+ zerotail = precis;
+ }
+
+ /* The radix is always output if precis, or if alt. */
+ if (precis > 0 || alt) {
+ hexradix = TRUE;
+ }
+
+ if (hexradix) {
+#ifndef USE_LOCALE_NUMERIC
+ *p++ = '.';
+#else
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+ if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
+ STRLEN n;
+ const char* r = SvPV(PL_numeric_radix_sv, n);
+ Copy(r, p, n, char);
+ p += n;
+ }
+ else {
+ *p++ = '.';
+ }
+ RESTORE_LC_NUMERIC();
+#endif
+ }
+
+ if (vlnz) {
+ while (v <= vlnz)
+ *p++ = xdig[*v++];
+ }
+
+ if (zerotail > 0) {
+ while (zerotail--) {
+ *p++ = '0';
+ }
+ }
+
+ elen = p - buf;
+ elen += my_snprintf(p, bufsize - elen,
+ "%c%+d", lower ? 'p' : 'P',
+ exponent);
+
+ if (elen < width) {
+ STRLEN gap = (STRLEN)(width - elen);
+ if (left) {
+ /* Pad the back with spaces. */
+ memset(buf + elen, ' ', gap);
+ }
+ else if (fill == '0') {
+ /* Insert the zeros after the "0x" and the
+ * the potential sign, but before the digits,
+ * otherwise we end up with "0000xH.HHH...",
+ * when we want "0x000H.HHH..." */
+ STRLEN nzero = gap;
+ char* zerox = buf + 2;
+ STRLEN nmove = elen - 2;
+ if (negative || plus) {
+ zerox++;
+ nmove--;
+ }
+ Move(zerox, zerox + nzero, nmove, char);
+ memset(zerox, fill, nzero);
+ }
+ else {
+ /* Move it to the right. */
+ Move(buf, buf + gap,
+ elen, char);
+ /* Pad the front with spaces. */
+ memset(buf, ' ', gap);
+ }
+ elen = width;
+ }
+ return elen;
+}
+
+
/* Helper for sv_vcatpvfn_flags(). */
#define FETCH_VCATPVFN_ARGUMENT(var, in_range, expr) \
STMT_START { \
}
#if !defined(USE_LONG_DOUBLE) && !defined(USE_QUADMATH)
- /* special-case "%.<number>[gf]" */
+ /* special-case "%.0f" and "%.<number>g" */
if ( !args && patlen <= 5 && pat[0] == '%' && pat[1] == '.'
&& (pat[patlen-1] == 'g' || pat[patlen-1] == 'f') ) {
unsigned digits = 0;
if (digits && digits < sizeof(ebuf) - NV_DIG - 10) {
/* 0, point, slack */
STORE_LC_NUMERIC_SET_TO_NEEDED();
- SNPRINTF_G(nv, ebuf, size, digits);
+ SNPRINTF_G(nv, ebuf, sizeof(ebuf), digits);
sv_catpv_nomg(sv, ebuf);
if (*ebuf) /* May return an empty string for digits==0 */
return;
patend = (char*)pat + patlen;
for (p = (char*)pat; p < patend; p = q) {
- bool alt = FALSE;
- bool left = FALSE;
- bool vectorize = FALSE;
- bool vectorarg = FALSE;
- bool vec_utf8 = FALSE;
- char fill = ' ';
- char plus = 0;
- char intsize = 0;
- STRLEN width = 0;
- STRLEN zeros = 0;
- bool has_precis = FALSE;
- STRLEN precis = 0;
- const I32 osvix = svix;
- bool is_utf8 = FALSE; /* is this item utf8? */
- bool used_explicit_ix = FALSE;
- bool arg_missing = FALSE;
- char esignbuf[4];
- U8 utf8buf[UTF8_MAXBYTES+1];
- STRLEN esignlen = 0;
-
- const char *eptr = NULL;
- const char *fmtstart;
- STRLEN elen = 0;
- SV *vecsv = NULL;
- const U8 *vecstr = NULL;
- STRLEN veclen = 0;
- char c = 0;
- unsigned base = 0;
- IV iv = 0;
- UV uv = 0;
- /* We need a long double target in case HAS_LONG_DOUBLE,
- * even without USE_LONG_DOUBLE, so that we can printf with
- * long double formats, even without NV being long double.
- * But we call the target 'fv' instead of 'nv', since most of
- * 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) && !defined(USE_QUADMATH)
- long double fv;
-# ifdef Perl_isfinitel
-# define FV_ISFINITE(x) Perl_isfinitel(x)
-# endif
-# define FV_GF PERL_PRIgldbl
-# if defined(__VMS) && defined(__ia64) && defined(__IEEE_FLOAT)
- /* Work around breakage in OTS$CVT_FLOAT_T_X */
-# define NV_TO_FV(nv,fv) STMT_START { \
- double _dv = nv; \
- fv = Perl_isnan(_dv) ? LDBL_QNAN : _dv; \
- } STMT_END
-# else
-# define NV_TO_FV(nv,fv) (fv)=(nv)
-# endif
-#else
- NV fv;
-# define FV_GF NVgf
-# define NV_TO_FV(nv,fv) (fv)=(nv)
-#endif
-#ifndef FV_ISFINITE
-# define FV_ISFINITE(x) Perl_isfinite((NV)(x))
-#endif
- NV nv;
- STRLEN float_need; /* what PL_efloatsize needs to become */
- const char *dotstr = ".";
- STRLEN dotstrlen = 1;
- I32 efix = 0; /* explicit format parameter index */
- I32 ewix = 0; /* explicit width index */
- I32 epix = 0; /* explicit precision index */
- I32 evix = 0; /* explicit vector index */
- bool asterisk = FALSE;
- bool infnan = FALSE;
+
+ char intsize = 0; /* size qualifier in "%hi..." etc */
+ bool alt = FALSE; /* has "%#..." */
+ bool left = FALSE; /* has "%-..." */
+ char fill = ' '; /* has "%0..." */
+ char plus = 0; /* has "%+..." */
+ STRLEN width = 0; /* value of "%NNN..." */
+ bool has_precis = FALSE; /* has "%.NNN..." */
+ STRLEN precis = 0; /* value of "%.NNN..." */
+ bool asterisk = FALSE; /* has "%*..." */
+ bool used_explicit_ix = FALSE;/* has "%$n..." */
+ unsigned base = 0; /* base to print in, e.g. 8 for %o */
+ UV uv = 0; /* the value to print of int-ish args */
+ IV iv = 0; /* ditto for signed types */
+
+ bool vectorize = FALSE; /* has "%v..." */
+ bool vectorarg = FALSE; /* has "%*v..." */
+ SV *vecsv = NULL; /* the cur arg for %v */
+ bool vec_utf8 = FALSE; /* SvUTF8(vecsv) */
+ const U8 *vecstr = NULL; /* SvPVX(vecsv) */
+ STRLEN veclen = 0; /* SvCUR(vecsv) */
+ const char *dotstr = "."; /* separator string for %v */
+ STRLEN dotstrlen = 1; /* length of separator string for %v */
+
+ I32 efix = 0; /* explicit format parameter index */
+ I32 ewix = 0; /* explicit width index */
+ I32 epix = 0; /* explicit precision index */
+ I32 evix = 0; /* explicit vector index */
+ const I32 osvix = svix; /* original index in case of bad fmt */
+
+ bool is_utf8 = FALSE; /* is this item utf8? */
+ bool arg_missing = FALSE; /* give "Missing argument" warning */
+ char esignbuf[4]; /* holds sign prefix, e.g. "-0x" */
+ STRLEN esignlen = 0; /* length of e.g. "-0x" */
+ STRLEN zeros = 0; /* how many '0' to prepend */
+
+ const char *eptr = NULL; /* the address of the element string */
+ STRLEN elen = 0; /* the length of the element string */
+
+ const char *fmtstart; /* start of current format (the '%') */
+ char c = 0; /* current character read from format */
+
+ U8 utf8buf[UTF8_MAXBYTES+1]; /* temp buf for %c */
+
/* echo everything up to the next format specification */
for (q = p; q < patend && *q != '%'; ++q) ;
}
}
- if (argsv && strchr("BbcDdiOopuUXx",*q)) {
+ c = *q++; /* c now holds the conversion type */
+
+ if (argsv && strchr("BbcDdiOopuUXx", c)) {
/* XXX va_arg(*args) case? need peek, use va_copy? */
SvGETMAGIC(argsv);
if (UNLIKELY(SvAMAGIC(argsv)))
argsv = sv_2num(argsv);
- infnan = UNLIKELY(isinfnansv(argsv));
+ if (UNLIKELY(isinfnansv(argsv)))
+ goto handle_infnan_argsv;
}
- switch (c = *q++) {
+ switch (c) {
/* STRINGS */
case 'c':
if (vectorize)
goto unknown;
- if (infnan)
- Perl_croak(aTHX_ "Cannot printf %" NVgf " with '%c'",
- /* no va_arg() case */
- SvNV_nomg(argsv), (int)c);
uv = (args) ? va_arg(*args, int) : SvIV_nomg(argsv);
if ((uv > 255 ||
(!UVCHR_IS_INVARIANT(uv) && SvUTF8(sv)))
/* INTEGERS */
case 'p':
- if (infnan) {
- goto floating_point;
- }
if (alt || vectorize)
goto unknown;
uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
/* FALLTHROUGH */
case 'd':
case 'i':
- if (infnan) {
- goto floating_point;
- }
if (vectorize) {
STRLEN ulen;
if (!veclen)
base = 16;
uns_integer:
- if (infnan) {
- goto floating_point;
- }
if (vectorize) {
STRLEN ulen;
vector:
/* FLOATING POINT */
- floating_point:
-
case 'F':
c = 'f'; /* maybe %F isn't supported here */
/* FALLTHROUGH */
case 'f':
case 'g': case 'G':
case 'a': case 'A':
+
+ {
+ bool is_simple; /* no fancy qualifiers */
+ STRLEN radix_len; /* SvCUR(PL_numeric_radix_sv) */
+ STRLEN float_need; /* what PL_efloatsize needs to become */
+
+ vcatpvfn_long_double_t fv;
+ NV nv;
+
if (vectorize)
goto unknown;
nv = fv;
} else {
nv = va_arg(*args, double);
- NV_TO_FV(nv, fv);
+ VCATPVFN_NV_TO_FV(nv, fv);
}
#else
nv = va_arg(*args, double);
}
else
{
- if (!infnan) SvGETMAGIC(argsv);
+ SvGETMAGIC(argsv);
+ /* we jump here if an int-ish format encountered an
+ * infinite/Nan argsv. After setting nv/fv, it falls
+ * into the isinfnan block which follows */
+ handle_infnan_argsv:
nv = SvNV_nomg(argsv);
- NV_TO_FV(nv, fv);
+ VCATPVFN_NV_TO_FV(nv, fv);
+ }
+
+ if (Perl_isinfnan(nv)) {
+ if (c == 'c')
+ Perl_croak(aTHX_ "Cannot printf %" NVgf " with '%c'",
+ SvNV_nomg(argsv), (int)c);
+
+ elen = S_infnan_2pv(nv, ebuf, sizeof(ebuf), plus);
+ assert(elen);
+ eptr = ebuf;
+ zeros = 0;
+ esignlen = 0;
+ dotstrlen = 0;
+ break;
+ }
+
+ /* special-case "%.0f" */
+ is_simple = ( !(width || left || plus || alt)
+ && fill != '0'
+ && has_precis
+ && intsize != 'q');
+
+ if (is_simple && c == 'f' && !precis) {
+ if ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen)))
+ break;
}
- float_need = 0;
- /* frexp() (or frexpl) has some unspecified behaviour for
- * nan/inf/-inf, so let's avoid calling that on non-finites. */
- if (isALPHA_FOLD_NE(c, 'e') && FV_ISFINITE(fv)) {
+ /* Determine the buffer size needed for the various
+ * floating-point formats.
+ *
+ * The basic possibilities are:
+ *
+ * <---P--->
+ * %f 1111111.123456789
+ * %e 1.111111123e+06
+ * %a 0x1.0f4471f9bp+20
+ * %g 1111111.12
+ * %g 1.11111112e+15
+ *
+ * where P is the value of the precision in the format, or 6
+ * if not specified. Note the two possible output formats of
+ * %g; in both cases the number of significant digits is <=
+ * precision.
+ *
+ * For most of the format types the maximum buffer size needed
+ * is precision, plus: any leading 1 or 0x1, the radix
+ * point, and an exponent. The difficult one is %f: for a
+ * large positive exponent it can have many leading digits,
+ * which needs to be calculated specially. Also %a is slightly
+ * different in that in the absence of a specified precision,
+ * it uses as many digits as necessary to distinguish
+ * different values.
+ *
+ * First, here are the constant bits. For ease of calculation
+ * we over-estimate the needed buffer size, for example by
+ * assuming all formats have an exponent and a leading 0x1.
+ */
+
+ float_need = 1 /* possible unary minus */
+ + 4 /* "0x1" plus very unlikely carry */
+ + 2 /* "e-", "p+" etc */
+ + 6 /* exponent: up to 16383 (quad fp) */
+ + 1; /* \0 */
+
+
+ /* determine the radix point len, e.g. length(".") in "1.2" */
+ radix_len = 1; /* assume '.' */
+#ifdef USE_LOCALE_NUMERIC
+ /* note that we may either explicitly use PL_numeric_radix_sv
+ * below, or implicitly, via an snprintf() variant.
+ * Note also things like ps_AF.utf8 which has
+ * "\N{ARABIC DECIMAL SEPARATOR} as a radix point */
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+ if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
+ radix_len = SvCUR(PL_numeric_radix_sv);
+ /* note that this will convert the output to utf8 even if
+ * if the radix point didn't get output */
+ is_utf8 = SvUTF8(PL_numeric_radix_sv);
+ }
+ RESTORE_LC_NUMERIC();
+#endif
+ /* this can't wrap unless PL_numeric_radix_sv is a string
+ * consuming virtually all the 32-bit or 64-bit address space
+ */
+ float_need += radix_len;
+
+ if (isALPHA_FOLD_EQ(c, 'f')) {
+ /* Determine how many digits before the radix point
+ * might be emitted. frexp() (or frexpl) has some
+ * unspecified behaviour for nan/inf/-inf, so lucky we've
+ * already handled them above */
+ STRLEN digits;
int i = PERL_INT_MIN;
(void)Perl_frexp((NV)fv, &i);
if (i == PERL_INT_MIN)
- Perl_die(aTHX_ "panic: frexp: %" FV_GF, fv);
- /* Do not set hexfp earlier since we want to printf
- * Inf/NaN for Inf/NaN, not their hexfp. */
- hexfp = isALPHA_FOLD_EQ(c, 'a');
- if (UNLIKELY(hexfp)) {
- /* This seriously overshoots in most cases, but
- * better the undershooting. Firstly, all bytes
+ Perl_die(aTHX_ "panic: frexp: %" VCATPVFN_FV_GF, fv);
+
+ if (i > 0) {
+ digits = BIT_DIGITS(i);
+ if (float_need >= ((STRLEN)~0) - digits)
+ croak_memory_wrap();
+ float_need += digits;
+ }
+ }
+ else if (UNLIKELY(isALPHA_FOLD_EQ(c, 'a'))) {
+ hexfp = TRUE;
+ if (!has_precis) {
+ /* %a in the absence of precision may print as many
+ * digits as needed to represent the entire mantissa
+ * bit pattern.
+ * This estimate seriously overshoots in most cases,
+ * but better the undershooting. Firstly, all bytes
* of the NV are not mantissa, some of them are
* exponent. Secondly, for the reasonably common
* long doubles case, the "80-bit extended", two
- * or six bytes of the NV are unused. */
- float_need +=
- (fv < 0) ? 1 : 0 + /* possible unary minus */
- 2 + /* "0x" */
- 1 + /* the very unlikely carry */
- 1 + /* "1" */
- 1 + /* "." */
- 2 * NVSIZE + /* 2 hexdigits for each byte */
- 2 + /* "p+" */
- 6 + /* exponent: sign, plus up to 16383 (quad fp) */
- 1; /* \0 */
+ * or six bytes of the NV are unused. Also, we'll
+ * still pick up an extra +6 from the default
+ * precision calculation below. */
+ STRLEN digits =
#ifdef LONGDOUBLE_DOUBLEDOUBLE
- /* However, for the "double double", we need more.
- * Since each double has their own exponent, the
- * doubles may float (haha) rather far from each
- * other, and the number of required bits is much
- * larger, up to total of DOUBLEDOUBLE_MAXBITS bits.
- * See the definition of DOUBLEDOUBLE_MAXBITS.
- *
- * Need 2 hexdigits for each byte. */
- float_need += (DOUBLEDOUBLE_MAXBITS/8 + 1) * 2;
- /* the size for the exponent already added */
-#endif
-#ifdef USE_LOCALE_NUMERIC
- STORE_LC_NUMERIC_SET_TO_NEEDED();
- if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC))
- float_need += SvCUR(PL_numeric_radix_sv);
- RESTORE_LC_NUMERIC();
+ /* For the "double double", we need more.
+ * Since each double has their own exponent, the
+ * doubles may float (haha) rather far from each
+ * other, and the number of required bits is much
+ * larger, up to total of DOUBLEDOUBLE_MAXBITS bits.
+ * See the definition of DOUBLEDOUBLE_MAXBITS.
+ *
+ * Need 2 hexdigits for each byte. */
+ (DOUBLEDOUBLE_MAXBITS/8 + 1) * 2;
+#else
+ NVSIZE * 2; /* 2 hexdigits for each byte */
#endif
+ if (float_need >= ((STRLEN)~0) - digits)
+ croak_memory_wrap();
+ float_need += digits;
}
- else if (i > 0) {
- float_need = BIT_DIGITS(i);
- } /* if i < 0, the number of digits is hard to predict. */
}
{
if (float_need < width)
float_need = width;
-#ifdef HAS_LDBL_SPRINTF_BUG
- /* This is to try to fix a bug with irix/nonstop-ux/powerux and
- with sfio - Allen <allens@cpan.org> */
-
-# ifdef DBL_MAX
-# define MY_DBL_MAX DBL_MAX
-# else /* XXX guessing! HUGE_VAL may be defined as infinity, so not using */
-# if DOUBLESIZE >= 8
-# define MY_DBL_MAX 1.7976931348623157E+308L
-# else
-# define MY_DBL_MAX 3.40282347E+38L
-# endif
-# endif
-
-# ifdef HAS_LDBL_SPRINTF_BUG_LESS1 /* only between -1L & 1L - Allen */
-# define MY_DBL_MAX_BUG 1L
-# else
-# define MY_DBL_MAX_BUG MY_DBL_MAX
-# endif
-
-# ifdef DBL_MIN
-# define MY_DBL_MIN DBL_MIN
-# else /* XXX guessing! -Allen */
-# if DOUBLESIZE >= 8
-# define MY_DBL_MIN 2.2250738585072014E-308L
-# else
-# define MY_DBL_MIN 1.17549435E-38L
-# endif
-# endif
-
- if ((intsize == 'q') && (c == 'f') &&
- ((fv < MY_DBL_MAX_BUG) && (fv > -MY_DBL_MAX_BUG)) &&
- (float_need < DBL_DIG))
- {
- bool fix_ldbl_sprintf_bug = FALSE;
-
- /* it's going to be short enough that
- * long double precision is not needed */
-
- if ((fv <= 0L) && (fv >= -0L))
- fix_ldbl_sprintf_bug = TRUE; /* 0 is 0 - easiest */
- else {
- /* would use Perl_fp_class as a double-check but not
- * functional on IRIX - see perl.h comments */
-
- if ((fv >= MY_DBL_MIN) || (fv <= -MY_DBL_MIN)) {
- /* It's within the range that a double can represent */
-#if defined(DBL_MAX) && !defined(DBL_MIN)
- if ((fv >= ((long double)1/DBL_MAX)) ||
- (fv <= (-(long double)1/DBL_MAX)))
+/* We should have correctly calculated (or indeed over-estimated) the
+ * buffer size, but you never know what strange floating-point systems
+ * there are out there. So for production use, add a little extra overhead.
+ * Under debugging don't, as it means we more more likely to quickly spot
+ * issues during development.
+ */
+#ifndef DEBUGGING
+ if (float_need >= ((STRLEN)~0) - 20)
+ croak_memory_wrap();
+ float_need += 20; /* safety fudge factor */
#endif
- fix_ldbl_sprintf_bug = TRUE;
- }
- }
-
- if (fix_ldbl_sprintf_bug == TRUE) {
- double temp;
- intsize = 0;
- temp = (double)fv;
- fv = (NV)temp;
- }
- }
-
-# undef MY_DBL_MAX
-# undef MY_DBL_MAX_BUG
-# undef MY_DBL_MIN
-
-#endif /* HAS_LDBL_SPRINTF_BUG */
-
- if (float_need >= ((STRLEN)~0) - 40)
- croak_memory_wrap();
- float_need += 40; /* fudge factor */
if (PL_efloatsize < float_need) {
Safefree(PL_efloatbuf);
PL_efloatsize = float_need;
PL_efloatbuf[0] = '\0';
}
- if ( !(width || left || plus || alt) && fill != '0'
- && has_precis && intsize != 'q' /* Shortcuts */
- && LIKELY(!Perl_isinfnan((NV)fv)) ) {
+ /* special-case "%.<number>g" */
+ if (is_simple) {
/* See earlier comment about buggy Gconvert when digits,
aka precis is 0 */
if ( c == 'g' && precis ) {
elen = strlen(PL_efloatbuf);
goto float_converted;
}
- } else if ( c == 'f' && !precis ) {
- if ((eptr = F0convert(nv, ebuf + sizeof ebuf, &elen)))
- break;
- }
+ }
}
if (UNLIKELY(hexfp)) {
- /* Hexadecimal floating point. */
- char* p = PL_efloatbuf;
- U8 vhex[VHEX_SIZE];
- U8* v = vhex; /* working pointer to vhex */
- U8* vend; /* pointer to one beyond last digit of vhex */
- U8* vfnz = NULL; /* first non-zero */
- U8* vlnz = NULL; /* last non-zero */
- U8* v0 = NULL; /* first output */
- const bool lower = (c == 'a');
- /* At output the values of vhex (up to vend) will
- * be mapped through the xdig to get the actual
- * human-readable xdigits. */
- const char* xdig = PL_hexdigit;
- int zerotail = 0; /* how many extra zeros to append */
- int exponent = 0; /* exponent of the floating point input */
- bool hexradix = FALSE; /* should we output the radix */
- bool subnormal = FALSE; /* IEEE 754 subnormal/denormal */
- bool negative = FALSE;
-
- /* XXX: NaN, Inf -- though they are printed as "NaN" and "Inf".
- *
- * For example with denormals, (assuming the vanilla
- * 64-bit double): the exponent is zero. 1xp-1074 is
- * the smallest denormal and the smallest double, it
- * could be output also as 0x0.0000000000001p-1022 to
- * match its internal structure. */
-
- vend = S_hextract(aTHX_ nv, &exponent, &subnormal, vhex, NULL);
- S_hextract(aTHX_ nv, &exponent, &subnormal, vhex, vend);
-
-#if NVSIZE > DOUBLESIZE
-# ifdef HEXTRACT_HAS_IMPLICIT_BIT
- /* In this case there is an implicit bit,
- * and therefore the exponent is shifted by one. */
- exponent--;
-# else
-# ifdef NV_X86_80_BIT
- if (subnormal) {
- /* The subnormals of the x86-80 have a base exponent of -16382,
- * (while the physical exponent bits are zero) but the frexp()
- * returned the scientific-style floating exponent. We want
- * to map the last one as:
- * -16831..-16384 -> -16382 (the last normal is 0x1p-16382)
- * -16835..-16388 -> -16384
- * since we want to keep the first hexdigit
- * as one of the [8421]. */
- exponent = -4 * ( (exponent + 1) / -4) - 2;
- } else {
- exponent -= 4;
- }
-# endif
- /* TBD: other non-implicit-bit platforms than the x86-80. */
-# endif
-#endif
-
- negative = fv < 0 || Perl_signbit(nv);
- if (negative)
- *p++ = '-';
- else if (plus)
- *p++ = plus;
- *p++ = '0';
- if (lower) {
- *p++ = 'x';
- }
- else {
- *p++ = 'X';
- xdig += 16; /* Use uppercase hex. */
- }
-
- /* Find the first non-zero xdigit. */
- for (v = vhex; v < vend; v++) {
- if (*v) {
- vfnz = v;
- break;
- }
- }
-
- if (vfnz) {
- /* Find the last non-zero xdigit. */
- for (v = vend - 1; v >= vhex; v--) {
- if (*v) {
- vlnz = v;
- break;
- }
- }
-
-#if NVSIZE == DOUBLESIZE
- if (fv != 0.0)
- exponent--;
-#endif
-
- if (subnormal) {
-#ifndef NV_X86_80_BIT
- if (vfnz[0] > 1) {
- /* IEEE 754 subnormals (but not the x86 80-bit):
- * we want "normalize" the subnormal,
- * so we need to right shift the hex nybbles
- * so that the output of the subnormal starts
- * from the first true bit. (Another, equally
- * valid, policy would be to dump the subnormal
- * nybbles as-is, to display the "physical" layout.) */
- int i, n;
- U8 *vshr;
- /* Find the ceil(log2(v[0])) of
- * the top non-zero nybble. */
- for (i = vfnz[0], n = 0; i > 1; i >>= 1, n++) { }
- assert(n < 4);
- vlnz[1] = 0;
- for (vshr = vlnz; vshr >= vfnz; vshr--) {
- vshr[1] |= (vshr[0] & (0xF >> (4 - n))) << (4 - n);
- vshr[0] >>= n;
- }
- if (vlnz[1]) {
- vlnz++;
- }
- }
-#endif
- v0 = vfnz;
- } else {
- v0 = vhex;
- }
-
- if (has_precis) {
- U8* ve = (subnormal ? vlnz + 1 : vend);
- SSize_t vn = ve - v0;
- assert(vn >= 1);
- if (precis < (Size_t)(vn - 1)) {
- bool overflow = FALSE;
- if (v0[precis + 1] < 0x8) {
- /* Round down, nothing to do. */
- } else if (v0[precis + 1] > 0x8) {
- /* Round up. */
- v0[precis]++;
- overflow = v0[precis] > 0xF;
- v0[precis] &= 0xF;
- } else { /* v0[precis] == 0x8 */
- /* Half-point: round towards the one
- * with the even least-significant digit:
- * 08 -> 0 88 -> 8
- * 18 -> 2 98 -> a
- * 28 -> 2 a8 -> a
- * 38 -> 4 b8 -> c
- * 48 -> 4 c8 -> c
- * 58 -> 6 d8 -> e
- * 68 -> 6 e8 -> e
- * 78 -> 8 f8 -> 10 */
- if ((v0[precis] & 0x1)) {
- v0[precis]++;
- }
- overflow = v0[precis] > 0xF;
- v0[precis] &= 0xF;
- }
-
- if (overflow) {
- for (v = v0 + precis - 1; v >= v0; v--) {
- (*v)++;
- overflow = *v > 0xF;
- (*v) &= 0xF;
- if (!overflow) {
- break;
- }
- }
- if (v == v0 - 1 && overflow) {
- /* If the overflow goes all the
- * way to the front, we need to
- * insert 0x1 in front, and adjust
- * the exponent. */
- Move(v0, v0 + 1, vn - 1, char);
- *v0 = 0x1;
- exponent += 4;
- }
- }
-
- /* The new effective "last non zero". */
- vlnz = v0 + precis;
- }
- else {
- zerotail =
- subnormal ? precis - vn + 1 :
- precis - (vlnz - vhex);
- }
- }
-
- v = v0;
- *p++ = xdig[*v++];
-
- /* If there are non-zero xdigits, the radix
- * is output after the first one. */
- if (vfnz < vlnz) {
- hexradix = TRUE;
- }
- }
- else {
- *p++ = '0';
- exponent = 0;
- zerotail = precis;
- }
-
- /* The radix is always output if precis, or if alt. */
- if (precis > 0 || alt) {
- hexradix = TRUE;
- }
-
- if (hexradix) {
-#ifndef USE_LOCALE_NUMERIC
- *p++ = '.';
-#else
- STORE_LC_NUMERIC_SET_TO_NEEDED();
- if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
- STRLEN n;
- const char* r = SvPV(PL_numeric_radix_sv, n);
- Copy(r, p, n, char);
- p += n;
- }
- else {
- *p++ = '.';
- }
- RESTORE_LC_NUMERIC();
-#endif
- }
-
- if (vlnz) {
- while (v <= vlnz)
- *p++ = xdig[*v++];
- }
-
- if (zerotail > 0) {
- while (zerotail--) {
- *p++ = '0';
- }
- }
-
- elen = p - PL_efloatbuf;
- elen += my_snprintf(p, PL_efloatsize - elen,
- "%c%+d", lower ? 'p' : 'P',
- exponent);
-
- if (elen < width) {
- STRLEN gap = (STRLEN)(width - elen);
- if (left) {
- /* Pad the back with spaces. */
- memset(PL_efloatbuf + elen, ' ', gap);
- }
- else if (fill == '0') {
- /* Insert the zeros after the "0x" and the
- * the potential sign, but before the digits,
- * otherwise we end up with "0000xH.HHH...",
- * when we want "0x000H.HHH..." */
- STRLEN nzero = gap;
- char* zerox = PL_efloatbuf + 2;
- STRLEN nmove = elen - 2;
- if (negative || plus) {
- zerox++;
- nmove--;
- }
- Move(zerox, zerox + nzero, nmove, char);
- memset(zerox, fill, nzero);
- }
- else {
- /* Move it to the right. */
- Move(PL_efloatbuf, PL_efloatbuf + gap,
- elen, char);
- /* Pad the front with spaces. */
- memset(PL_efloatbuf, ' ', gap);
- }
- elen = width;
- }
+ elen = S_format_hexfp(aTHX_ PL_efloatbuf, PL_efloatsize, c,
+ nv, fv, has_precis, precis, width,
+ alt, plus, left, fill);
}
else {
- elen = S_infnan_2pv(nv, PL_efloatbuf, PL_efloatsize, plus);
- if (elen) {
- /* Not affecting infnan output: precision, alt, fill. */
- if (elen < width) {
- STRLEN gap = (STRLEN)(width - elen);
- if (left) {
- /* Pack the back with spaces. */
- memset(PL_efloatbuf + elen, ' ', gap);
- } else {
- /* Move it to the right. */
- Move(PL_efloatbuf, PL_efloatbuf + gap,
- elen, char);
- /* Pad the front with spaces. */
- memset(PL_efloatbuf, ' ', gap);
- }
- elen = width;
- }
- }
- }
-
- if (elen == 0) {
char *ptr = ebuf + sizeof ebuf;
*--ptr = '\0';
*--ptr = c;
eptr = PL_efloatbuf;
assert((IV)elen > 0); /* here zero elen is bad */
-#ifdef USE_LOCALE_NUMERIC
- /* If the decimal point character in the string is UTF-8, make the
- * output utf8 */
- if (PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv)
- && instr(eptr, SvPVX_const(PL_numeric_radix_sv)))
- {
- is_utf8 = TRUE;
- }
-#endif
break;
+ }
/* SPECIAL */
https://perl5.git.perl.org / perl5.git / blobdiff