GE_COWBUF_WASTE_THRESHOLD((cur),(len)) && \
GE_COWBUF_WASTE_FACTOR_THRESHOLD((cur),(len)) \
)
-/* void Gconvert: on Linux at least, gcvt (which Gconvert gets deffed to),
- * has a mandatory return value, even though that value is just the same
- * as the buf arg */
#ifdef PERL_UTF8_CACHE_ASSERT
/* if adding more checks watch out for the following tests:
return ptr;
}
+/* Helper for sv_2pv_flags and sv_vcatpvfn_flags. If the NV is an
+ * infinity or a not-a-number, writes the approrpriate strings to the
+ * buffer, including a zero byte. Returns the written length,
+ * excluding the zero byte, or zero. */
+STATIC size_t
+S_infnan_copy(NV nv, char* buffer, size_t maxlen) {
+ if (maxlen < 4)
+ return 0;
+ else {
+ char* s = buffer;
+ if (Perl_isinf(nv)) {
+ if (nv < 0) {
+ if (maxlen < 5)
+ return 0;
+ *s++ = '-';
+ }
+ *s++ = 'I';
+ *s++ = 'n';
+ *s++ = 'f';
+ }
+ else if (Perl_isnan(nv)) {
+ *s++ = 'N';
+ *s++ = 'a';
+ *s++ = 'N';
+ /* XXX output the payload mantissa bits as "(hhh...)" */
+ }
+ else
+ return 0;
+ *s++ = 0;
+ return s - buffer - 1;
+ }
+}
+
/*
=for apidoc sv_2pv_flags
*s++ = '0';
*s = '\0';
} else {
- dSAVE_ERRNO;
+ STRLEN len;
/* The +20 is pure guesswork. Configure test needed. --jhi */
s = SvGROW_mutable(sv, NV_DIG + 20);
- /* some Xenix systems wipe out errno here */
+
+ len = S_infnan_copy(SvNVX(sv), s, SvLEN(sv));
+ if (len > 0)
+ s += len;
+ else {
+ dSAVE_ERRNO;
+ /* some Xenix systems wipe out errno here */
#ifndef USE_LOCALE_NUMERIC
- PERL_UNUSED_RESULT(Gconvert(SvNVX(sv), NV_DIG, 0, s));
- SvPOK_on(sv);
-#else
- {
- DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
PERL_UNUSED_RESULT(Gconvert(SvNVX(sv), NV_DIG, 0, s));
-
- /* If the radix character is UTF-8, and actually is in the
- * output, turn on the UTF-8 flag for the scalar */
- if (PL_numeric_local
- && PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv)
- && instr(s, SvPVX_const(PL_numeric_radix_sv)))
+ SvPOK_on(sv);
+#else
{
- SvUTF8_on(sv);
+ DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED();
+ PERL_UNUSED_RESULT(Gconvert(SvNVX(sv), NV_DIG, 0, s));
+
+ /* If the radix character is UTF-8, and actually is in the
+ * output, turn on the UTF-8 flag for the scalar */
+ if (PL_numeric_local
+ && PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv)
+ && instr(s, SvPVX_const(PL_numeric_radix_sv)))
+ {
+ SvUTF8_on(sv);
+ }
+ RESTORE_LC_NUMERIC();
}
- RESTORE_LC_NUMERIC();
- }
- /* We don't call SvPOK_on(), because it may come to pass that the
- * locale changes so that the stringification we just did is no
- * longer correct. We will have to re-stringify every time it is
- * needed */
+ /* We don't call SvPOK_on(), because it may come to
+ * pass that the locale changes so that the
+ * stringification we just did is no longer correct. We
+ * will have to re-stringify every time it is needed */
#endif
- RESTORE_ERRNO;
- while (*s) s++;
+ RESTORE_ERRNO;
+ }
+ while (*s) s++;
}
}
else if (isGV_with_GP(sv)) {
* arranged in order (although not consecutively) and that only
* [A-Za-z] are accepted by isALPHA in the C locale.
*/
- if (*d != 'z' && *d != 'Z') {
+ if (isALPHA_FOLD_NE(*d, 'z')) {
do { ++*d; } while (!isALPHA(*d));
return;
}
case SVt_PVLV: return (char *) (SvROK(sv) ? "REF"
/* tied lvalues should appear to be
* scalars for backwards compatibility */
- : (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
+ : (isALPHA_FOLD_EQ(LvTYPE(sv), 't'))
? "SCALAR" : "LVALUE");
case SVt_PVAV: return "ARRAY";
case SVt_PVHV: return "HASH";
else
HEXTRACT_COUNT(ix, 2);
}
- *exponent -= 4;
# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
/* Used in e.g. Solaris Sparc and HP-UX PA-RISC, e.g. -0.1L:
* bf fb 99 99 99 99 99 99 99 99 99 99 99 99 99 9a */
else
HEXTRACT_COUNT(ix, 2);
}
- *exponent -= 4;
# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
/* x86 80-bit "extended precision", 64 bits of mantissa / fraction /
* significand, 15 bits of exponent, 1 bit of sign. NVSIZE can
else
HEXTRACT_COUNT(ix, 2);
}
- *exponent -= 4;
# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
- /* The last 8 bytes are the mantissa/fraction.
- * (does this format ever happen?) */
+ /* (does this format ever happen?) */
/* There explicitly is *no* implicit bit in this case. */
- for (ix = LONGDBLSIZE - 8; ix < LONGDBLSIZE; ix++) {
+ for (ix = 0; ix < 8; ix++) {
if (vend)
HEXTRACT_OUTPUT(ix);
else
HEXTRACT_COUNT(ix, 2);
}
- *exponent -= 4;
# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
/* Where is this used?
* 9a 99 99 99 99 99 59 bc 9a 99 99 99 99 99 b9 3f */
else
HEXTRACT_COUNT(ix, 2);
}
+ /* XXX not extracting from the second double -- see the discussion
+ * below for the big endian double double. */
+# if 0
if (vend)
HEXTRACT_OUTPUT_LO(6);
else
else
HEXTRACT_COUNT(ix, 2);
}
- (*exponent)--;
+# endif
# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
/* Used in e.g. PPC/Power (AIX) and MIPS.
*
else
HEXTRACT_COUNT(ix, 2);
}
+ /* XXX not extracting the second double mantissa bits- this is not
+ * right nor ideal (we effectively reduce the output format to
+ * that of a "single double", only 53 bits), but we do not know
+ * exactly how to do the extraction correctly so that it matches
+ * the semantics of, say, the IEEE quadruple float. */
+# if 0
if (vend)
HEXTRACT_OUTPUT_LO(9);
else
else
HEXTRACT_COUNT(ix, 2);
}
- (*exponent)--;
+# endif
# else
Perl_croak(aTHX_
"Hexadecimal float: unsupported long double format");
: SvNV(argsv);
need = 0;
- /* nv * 0 will be NaN for NaN, +Inf and -Inf, and 0 for anything
- else. frexp() has some unspecified behaviour for those three */
- if (c != 'e' && c != 'E' && (nv * 0) == 0) {
+ /* frexp() (or frexpl) has some unspecified behaviour for
+ * nan/inf/-inf, so let's avoid calling that on those
+ * three values. nv * 0 will be NaN for NaN, +Inf and -Inf,
+ * and 0 for anything else. */
+ if (isALPHA_FOLD_NE(c, 'e') && (nv * 0) == 0) {
i = PERL_INT_MIN;
- /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
- will cast our (long double) to (double) */
(void)Perl_frexp(nv, &i);
if (i == PERL_INT_MIN)
Perl_die(aTHX_ "panic: frexp");
- hexfp = (c == 'a' || c == 'A');
+ hexfp = isALPHA_FOLD_EQ(c, 'a');
if (UNLIKELY(hexfp)) {
/* Hexadecimal floating point: this size
* computation probably overshoots, but that is
int zerotail = 0; /* how many extra zeros to append */
int exponent = 0; /* exponent of the floating point input */
+ /* XXX: denormals, NaN, 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
+ * should be output as 0x0.0000000000001p-1022 to
+ * match its internal structure. */
+
vend = S_hextract(aTHX_ nv, &exponent, vhex, NULL);
S_hextract(aTHX_ nv, &exponent, vhex, vend);
+#if NVSIZE > DOUBLESIZE && defined(LONG_DOUBLEKIND)
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+ exponent -= 4;
+# else
+ exponent--;
+# endif
+#endif
+
if (nv < 0)
*p++ = '-';
else if (plus)
}
#if NVSIZE == DOUBLESIZE
- /* For long doubles S_hextract() took care of this. */
exponent--;
#endif
elen = width;
}
}
- else {
- char *ptr = ebuf + sizeof ebuf;
- *--ptr = '\0';
- *--ptr = c;
- /* FIXME: what to do if HAS_LONG_DOUBLE but not PERL_PRIfldbl? */
+ else
+ elen = S_infnan_copy(nv, PL_efloatbuf, PL_efloatsize);
+ if (elen == 0) {
+ char *ptr = ebuf + sizeof ebuf;
+ *--ptr = '\0';
+ *--ptr = c;
+ /* FIXME: what to do if HAS_LONG_DOUBLE but not PERL_PRIfldbl? */
#if defined(HAS_LONG_DOUBLE) && defined(PERL_PRIfldbl)
if (intsize == 'q') {
/* Copy the one or more characters in a long double
https://perl5.git.perl.org / perl5.git / blobdiff