STATIC XPVNV*
S_new_xnv(pTHX)
{
- double* xnv;
+ NV* xnv;
LOCK_SV_MUTEX;
if (!PL_xnv_root)
more_xnv();
xnv = PL_xnv_root;
- PL_xnv_root = *(double**)xnv;
+ PL_xnv_root = *(NV**)xnv;
UNLOCK_SV_MUTEX;
return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
}
STATIC void
S_del_xnv(pTHX_ XPVNV *p)
{
- double* xnv = (double*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
+ NV* xnv = (NV*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
LOCK_SV_MUTEX;
- *(double**)xnv = PL_xnv_root;
+ *(NV**)xnv = PL_xnv_root;
PL_xnv_root = xnv;
UNLOCK_SV_MUTEX;
}
STATIC void
S_more_xnv(pTHX)
{
- register double* xnv;
- register double* xnvend;
- New(711, xnv, 1008/sizeof(double), double);
- xnvend = &xnv[1008 / sizeof(double) - 1];
- xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
+ register NV* xnv;
+ register NV* xnvend;
+ New(711, xnv, 1008/sizeof(NV), NV);
+ xnvend = &xnv[1008 / sizeof(NV) - 1];
+ xnv += (sizeof(XPVIV) - 1) / sizeof(NV) + 1; /* fudge by sizeof XPVIV */
PL_xnv_root = xnv;
while (xnv < xnvend) {
- *(double**)xnv = (double*)(xnv + 1);
+ *(NV**)xnv = (NV*)(xnv + 1);
xnv++;
}
- *(double**)xnv = 0;
+ *(NV**)xnv = 0;
}
STATIC XRV*
U32 cur;
U32 len;
IV iv;
- double nv;
+ NV nv;
MAGIC* magic;
HV* stash;
cur = 0;
len = 0;
iv = SvIVX(sv);
- nv = (double)SvIVX(sv);
+ nv = (NV)SvIVX(sv);
del_XIV(SvANY(sv));
magic = 0;
stash = 0;
cur = 0;
len = 0;
iv = (IV)pv;
- nv = (double)(unsigned long)pv;
+ nv = (NV)(unsigned long)pv;
del_XRV(SvANY(sv));
magic = 0;
stash = 0;
}
void
-Perl_sv_setnv(pTHX_ register SV *sv, double num)
+Perl_sv_setnv(pTHX_ register SV *sv, NV num)
{
SV_CHECK_THINKFIRST(sv);
switch (SvTYPE(sv)) {
}
void
-Perl_sv_setnv_mg(pTHX_ register SV *sv, double num)
+Perl_sv_setnv_mg(pTHX_ register SV *sv, NV num)
{
sv_setnv(sv,num);
SvSETMAGIC(sv);
sv_upgrade(sv, SVt_PVNV);
(void)SvIOK_on(sv);
- if (SvNVX(sv) < (double)IV_MAX + 0.5)
+ if (SvNVX(sv) < (NV)IV_MAX + 0.5)
SvIVX(sv) = I_V(SvNVX(sv));
else {
SvUVX(sv) = U_V(SvNVX(sv));
if (numtype & IS_NUMBER_NOT_IV) {
/* May be not an integer. Need to cache NV if we cache IV
* - otherwise future conversion to NV will be wrong. */
- double d;
+ NV d;
d = Atof(SvPVX(sv));
SvNVX(sv) = d;
(void)SvNOK_on(sv);
(void)SvIOK_on(sv);
- DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%lx 2nv(%g)\n",(unsigned long)sv,
- SvNVX(sv)));
- if (SvNVX(sv) < (double)IV_MAX + 0.5)
+#if defined(USE_LONG_DOUBLE)
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+ (unsigned long)sv, SvNVX(sv)));
+#else
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
+ (unsigned long)sv, SvNVX(sv)));
+#endif
+ if (SvNVX(sv) < (NV)IV_MAX + 0.5)
SvIVX(sv) = I_V(SvNVX(sv));
else {
SvUVX(sv) = U_V(SvNVX(sv));
if (numtype & IS_NUMBER_NOT_IV) {
/* May be not an integer. Need to cache NV if we cache IV
* - otherwise future conversion to NV will be wrong. */
- double d;
+ NV d;
d = Atof(SvPVX(sv)); /* XXXX 64-bit? */
SvNVX(sv) = d;
(void)SvNOK_on(sv);
(void)SvIOK_on(sv);
- DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%lx 2nv(%g)\n",(unsigned long)sv,
- SvNVX(sv)));
+#if defined(USE_LONG_DOUBLE)
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+ (unsigned long)sv, SvNVX(sv)));
+#else
+ DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
+ (unsigned long)sv, SvNVX(sv)));
+#endif
if (SvNVX(sv) < -0.5) {
SvIVX(sv) = I_V(SvNVX(sv));
goto ret_zero;
return SvIsUV(sv) ? SvUVX(sv) : (UV)SvIVX(sv);
}
-double
+NV
Perl_sv_2nv(pTHX_ register SV *sv)
{
if (!sv)
}
if (SvIOKp(sv)) {
if (SvIsUV(sv))
- return (double)SvUVX(sv);
+ return (NV)SvUVX(sv);
else
- return (double)SvIVX(sv);
+ return (NV)SvIVX(sv);
}
if (!SvROK(sv)) {
if (!(SvFLAGS(sv) & SVs_PADTMP)) {
SV* tmpstr;
if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
return SvNV(tmpstr);
- return (double)(unsigned long)SvRV(sv);
+ return (NV)(unsigned long)SvRV(sv);
}
if (SvREADONLY(sv)) {
dTHR;
}
if (SvIOKp(sv)) {
if (SvIsUV(sv))
- return (double)SvUVX(sv);
+ return (NV)SvUVX(sv);
else
- return (double)SvIVX(sv);
+ return (NV)SvIVX(sv);
}
if (ckWARN(WARN_UNINITIALIZED))
Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
sv_upgrade(sv, SVt_PVNV);
else
sv_upgrade(sv, SVt_NV);
+#if defined(USE_LONG_DOUBLE)
+ DEBUG_c({
+ RESTORE_NUMERIC_STANDARD();
+ PerlIO_printf(Perl_debug_log, "0x%lx num(%Lg)\n",
+ (unsigned long)sv, SvNVX(sv));
+ RESTORE_NUMERIC_LOCAL();
+ });
+#else
DEBUG_c({
RESTORE_NUMERIC_STANDARD();
- PerlIO_printf(Perl_debug_log,
- "0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv));
+ PerlIO_printf(Perl_debug_log, "0x%lx num(%g)\n",
+ (unsigned long)sv, SvNVX(sv));
RESTORE_NUMERIC_LOCAL();
});
+#endif
}
else if (SvTYPE(sv) < SVt_PVNV)
sv_upgrade(sv, SVt_PVNV);
if (SvIOKp(sv) &&
(!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
{
- SvNVX(sv) = SvIsUV(sv) ? (double)SvUVX(sv) : (double)SvIVX(sv);
+ SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv);
}
else if (SvPOKp(sv) && SvLEN(sv)) {
dTHR;
return 0.0;
}
SvNOK_on(sv);
+#if defined(USE_LONG_DOUBLE)
+ DEBUG_c({
+ RESTORE_NUMERIC_STANDARD();
+ PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+ (unsigned long)sv, SvNVX(sv));
+ RESTORE_NUMERIC_LOCAL();
+ });
+#else
DEBUG_c({
RESTORE_NUMERIC_STANDARD();
- PerlIO_printf(Perl_debug_log,
- "0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv));
+ PerlIO_printf(Perl_debug_log, "0x%lx 1nv(%g)\n",
+ (unsigned long)sv, SvNVX(sv));
RESTORE_NUMERIC_LOCAL();
});
+#endif
return SvNVX(sv);
}
S_asIV(pTHX_ SV *sv)
{
I32 numtype = looks_like_number(sv);
- double d;
+ NV d;
if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
return atol(SvPVX(sv)); /* XXXX 64-bit? */
if (flags & SVp_IOK) {
if (SvIsUV(sv)) {
if (SvUVX(sv) == UV_MAX)
- sv_setnv(sv, (double)UV_MAX + 1.0);
+ sv_setnv(sv, (NV)UV_MAX + 1.0);
else
(void)SvIOK_only_UV(sv);
++SvUVX(sv);
} else {
if (SvIVX(sv) == IV_MAX)
- sv_setnv(sv, (double)IV_MAX + 1.0);
+ sv_setnv(sv, (NV)IV_MAX + 1.0);
else {
(void)SvIOK_only(sv);
++SvIVX(sv);
}
} else {
if (SvIVX(sv) == IV_MIN)
- sv_setnv(sv, (double)IV_MIN - 1.0);
+ sv_setnv(sv, (NV)IV_MIN - 1.0);
else {
(void)SvIOK_only(sv);
--SvIVX(sv);
}
SV *
-Perl_newSVnv(pTHX_ double n)
+Perl_newSVnv(pTHX_ NV n)
{
register SV *sv;
return sv_2uv(sv);
}
-double
+NV
Perl_sv_nv(pTHX_ register SV *sv)
{
if (SvNOK(sv))
}
SV*
-Perl_sv_setref_nv(pTHX_ SV *rv, const char *classname, double nv)
+Perl_sv_setref_nv(pTHX_ SV *rv, const char *classname, NV nv)
{
sv_setnv(newSVrv(rv,classname), nv);
return rv;
unsigned base;
IV iv;
UV uv;
- double nv;
+ NV nv;
STRLEN have;
STRLEN need;
STRLEN gap;
/* This is evil, but floating point is even more evil */
if (args)
- nv = va_arg(*args, double);
+ nv = va_arg(*args, NV);
else
nv = (svix < svmax) ? SvNVx(svargs[svix++]) : 0.0;
eptr = ebuf + sizeof ebuf;
*--eptr = '\0';
*--eptr = c;
+#ifdef USE_LONG_DOUBLE
+ *--eptr = 'L';
+#endif
if (has_precis) {
base = precis;
do { *--eptr = '0' + (base % 10); } while (base /= 10);