summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--av.h2
-rw-r--r--bytecode.pl2
-rw-r--r--cv.h2
-rw-r--r--doio.c2
-rw-r--r--dump.c2
-rwxr-xr-xembed.pl22
-rw-r--r--ext/ByteLoader/bytecode.h4
-rw-r--r--ext/ByteLoader/byterun.c4
-rw-r--r--hv.h2
-rw-r--r--intrpvar.h2
-rw-r--r--mg.c14
-rw-r--r--op.c8
-rw-r--r--perl.h51
-rw-r--r--pp.c78
-rw-r--r--pp.h16
-rw-r--r--pp_ctl.c27
-rw-r--r--pp_sys.c16
-rw-r--r--proto.h22
-rw-r--r--sv.c103
-rw-r--r--sv.h14
-rw-r--r--toke.c4
-rw-r--r--universal.c2
-rw-r--r--util.c27
23 files changed, 248 insertions, 178 deletions
diff --git a/av.h b/av.h
index bef763d3b1..bacf614390 100644
--- a/av.h
+++ b/av.h
@@ -12,7 +12,7 @@ struct xpvav {
SSize_t xav_fill; /* Index of last element present */
SSize_t xav_max; /* Number of elements for which array has space */
IV xof_off; /* ptr is incremented by offset */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* magic for scalar array */
HV* xmg_stash; /* class package */
diff --git a/bytecode.pl b/bytecode.pl
index 1e18d55990..4d318ff4fa 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -312,7 +312,7 @@ xrv SvRV(bytecode_sv) svindex
xpv bytecode_sv none x
xiv32 SvIVX(bytecode_sv) I32
xiv64 SvIVX(bytecode_sv) IV64
-xnv SvNVX(bytecode_sv) double
+xnv SvNVX(bytecode_sv) NV
xlv_targoff LvTARGOFF(bytecode_sv) STRLEN
xlv_targlen LvTARGLEN(bytecode_sv) STRLEN
xlv_targ LvTARG(bytecode_sv) svindex
diff --git a/cv.h b/cv.h
index e060dc8abd..704270871c 100644
--- a/cv.h
+++ b/cv.h
@@ -14,7 +14,7 @@ struct xpvcv {
STRLEN xpv_cur; /* length of xp_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xof_off; /* integer value */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* magic for scalar array */
HV* xmg_stash; /* class package */
diff --git a/doio.c b/doio.c
index 0fc139cbfc..39e2e9f6ac 100644
--- a/doio.c
+++ b/doio.c
@@ -898,7 +898,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvIOK(sv) && SvIVX(sv) != 0) {
- PerlIO_printf(fp, PL_ofmt, (double)SvIVX(sv));
+ PerlIO_printf(fp, PL_ofmt, (NV)SvIVX(sv));
return !PerlIO_error(fp);
}
if ( (SvNOK(sv) && SvNVX(sv) != 0.0)
diff --git a/dump.c b/dump.c
index 3d3a55c497..9c7d3a9764 100644
--- a/dump.c
+++ b/dump.c
@@ -972,7 +972,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
int i;
int max = 0;
U32 pow2 = 2, keys = HvKEYS(sv);
- double theoret, sum = 0;
+ NV theoret, sum = 0;
PerlIO_printf(file, " (");
Zero(freq, FREQ_MAX + 1, int);
diff --git a/embed.pl b/embed.pl
index d7c5a87e2d..ad91f80962 100755
--- a/embed.pl
+++ b/embed.pl
@@ -781,10 +781,10 @@ p |int |block_start |int full
p |void |boot_core_UNIVERSAL
p |void |call_list |I32 oldscope|AV* av_list
p |I32 |cando |I32 bit|I32 effective|Stat_t* statbufp
-p |U32 |cast_ulong |double f
-p |I32 |cast_i32 |double f
-p |IV |cast_iv |double f
-p |UV |cast_uv |double f
+p |U32 |cast_ulong |NV f
+p |I32 |cast_i32 |NV f
+p |IV |cast_iv |NV f
+p |UV |cast_uv |NV f
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
p |I32 |my_chsize |int fd|Off_t length
#endif
@@ -1058,7 +1058,7 @@ p |I32 |mg_size |SV* sv
p |OP* |mod |OP* o|I32 type
p |char* |moreswitches |char* s
p |OP* |my |OP* o
-p |double |my_atof |const char *s
+p |NV |my_atof |const char *s
#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
p |char* |my_bcopy |const char* from|char* to|I32 len
#endif
@@ -1127,7 +1127,7 @@ p |SV* |newSV |STRLEN len
p |OP* |newSVREF |OP* o
p |OP* |newSVOP |I32 type|I32 flags|SV* sv
p |SV* |newSViv |IV i
-p |SV* |newSVnv |double n
+p |SV* |newSVnv |NV n
p |SV* |newSVpv |const char* s|STRLEN len
p |SV* |newSVpvn |const char* s|STRLEN len
p |SV* |newSVpvf |const char* pat|...
@@ -1289,12 +1289,12 @@ p |CV* |sv_2cv |SV* sv|HV** st|GV** gvp|I32 lref
p |IO* |sv_2io |SV* sv
p |IV |sv_2iv |SV* sv
p |SV* |sv_2mortal |SV* sv
-p |double |sv_2nv |SV* sv
+p |NV |sv_2nv |SV* sv
p |char* |sv_2pv |SV* sv|STRLEN* lp
p |UV |sv_2uv |SV* sv
p |IV |sv_iv |SV* sv
p |UV |sv_uv |SV* sv
-p |double |sv_nv |SV* sv
+p |NV |sv_nv |SV* sv
p |char* |sv_pvn |SV *sv|STRLEN *len
p |I32 |sv_true |SV *sv
p |void |sv_add_arena |char* ptr|U32 size|U32 flags
@@ -1346,9 +1346,9 @@ p |void |sv_setpvf |SV* sv|const char* pat|...
p |void |sv_setiv |SV* sv|IV num
p |void |sv_setpviv |SV* sv|IV num
p |void |sv_setuv |SV* sv|UV num
-p |void |sv_setnv |SV* sv|double num
+p |void |sv_setnv |SV* sv|NV num
p |SV* |sv_setref_iv |SV* rv|const char* classname|IV iv
-p |SV* |sv_setref_nv |SV* rv|const char* classname|double nv
+p |SV* |sv_setref_nv |SV* rv|const char* classname|NV nv
p |SV* |sv_setref_pv |SV* rv|const char* classname|void* pv
p |SV* |sv_setref_pvn |SV* rv|const char* classname|char* pv \
|STRLEN n
@@ -1445,7 +1445,7 @@ p |void |sv_setpvf_mg |SV *sv|const char* pat|...
p |void |sv_setiv_mg |SV *sv|IV i
p |void |sv_setpviv_mg |SV *sv|IV iv
p |void |sv_setuv_mg |SV *sv|UV u
-p |void |sv_setnv_mg |SV *sv|double num
+p |void |sv_setnv_mg |SV *sv|NV num
p |void |sv_setpv_mg |SV *sv|const char *ptr
p |void |sv_setpvn_mg |SV *sv|const char *ptr|STRLEN len
p |void |sv_setsv_mg |SV *dstr|SV *sstr
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 9d597fbed2..04a05e4251 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -70,10 +70,10 @@ typedef IV IV64;
arg = PL_tokenbuf; \
} STMT_END
-#define BGET_double(arg) STMT_START { \
+#define BGET_NV(arg) STMT_START { \
char *str; \
BGET_strconst(str); \
- arg = atof(str); \
+ arg = Perl_atonv(str); \
} STMT_END
#define BGET_objindex(arg, type) STMT_START { \
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index 544a59f042..035578f424 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -221,8 +221,8 @@ byterun(pTHXo_ struct bytestream bs)
}
case INSN_XNV: /* 21 */
{
- double arg;
- BGET_double(arg);
+ NV arg;
+ BGET_NV(arg);
SvNVX(bytecode_sv) = arg;
break;
}
diff --git a/hv.h b/hv.h
index e9772d4440..3977b1c395 100644
--- a/hv.h
+++ b/hv.h
@@ -28,7 +28,7 @@ struct xpvhv {
STRLEN xhv_fill; /* how full xhv_array currently is */
STRLEN xhv_max; /* subscript of last element of xhv_array */
IV xhv_keys; /* how many elements in the array */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* magic for scalar array */
HV* xmg_stash; /* class package */
diff --git a/intrpvar.h b/intrpvar.h
index 0bf826e79a..5cff858675 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -219,7 +219,7 @@ PERLVAR(Isighandlerp, Sighandler_t)
PERLVAR(Ixiv_arenaroot, XPV*) /* list of allocated xiv areas */
PERLVAR(Ixiv_root, IV *) /* free xiv list--shared by interpreters */
-PERLVAR(Ixnv_root, double *) /* free xnv list--shared by interpreters */
+PERLVAR(Ixnv_root, NV *) /* free xnv list--shared by interpreters */
PERLVAR(Ixrv_root, XRV *) /* free xrv list--shared by interpreters */
PERLVAR(Ixpv_root, XPV *) /* free xpv list--shared by interpreters */
PERLVAR(Ihe_root, HE *) /* free he list--shared by interpreters */
diff --git a/mg.c b/mg.c
index a21ea5730e..0e9ca198e7 100644
--- a/mg.c
+++ b/mg.c
@@ -498,7 +498,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
# include <starlet.h>
char msg[255];
$DESCRIPTOR(msgdsc,msg);
- sv_setnv(sv,(double) vaxc$errno);
+ sv_setnv(sv,(NV) vaxc$errno);
if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
else
@@ -507,7 +507,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
#else
#ifdef OS2
if (!(_emx_env & 0x200)) { /* Under DOS */
- sv_setnv(sv, (double)errno);
+ sv_setnv(sv, (NV)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
} else {
if (errno != errno_isOS2) {
@@ -515,14 +515,14 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
if (tmp) /* 2nd call to _syserrno() makes it 0 */
Perl_rc = tmp;
}
- sv_setnv(sv, (double)Perl_rc);
+ sv_setnv(sv, (NV)Perl_rc);
sv_setpv(sv, os2error(Perl_rc));
}
#else
#ifdef WIN32
{
DWORD dwErr = GetLastError();
- sv_setnv(sv, (double)dwErr);
+ sv_setnv(sv, (NV)dwErr);
if (dwErr)
{
PerlProc_GetOSError(sv, dwErr);
@@ -532,7 +532,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
SetLastError(dwErr);
}
#else
- sv_setnv(sv, (double)errno);
+ sv_setnv(sv, (NV)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
#endif
#endif
@@ -701,12 +701,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
break;
case '!':
#ifdef VMS
- sv_setnv(sv, (double)((errno == EVMSERR) ? vaxc$errno : errno));
+ sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno));
sv_setpv(sv, errno ? Strerror(errno) : "");
#else
{
int saveerrno = errno;
- sv_setnv(sv, (double)errno);
+ sv_setnv(sv, (NV)errno);
#ifdef OS2
if (errno == errno_isOS2) sv_setpv(sv, os2error(Perl_rc));
else
diff --git a/op.c b/op.c
index 25b17dc1e1..091a768dcd 100644
--- a/op.c
+++ b/op.c
@@ -192,7 +192,7 @@ Perl_pad_allocmy(pTHX_ char *name)
PL_sv_objcount++;
}
av_store(PL_comppad_name, off, sv);
- SvNVX(sv) = (double)PAD_MAX;
+ SvNVX(sv) = (NV)PAD_MAX;
SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
if (!PL_min_intro_pending)
PL_min_intro_pending = off;
@@ -255,7 +255,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
sv_upgrade(namesv, SVt_PVNV);
sv_setpv(namesv, name);
av_store(PL_comppad_name, newoff, namesv);
- SvNVX(namesv) = (double)PL_curcop->cop_seq;
+ SvNVX(namesv) = (NV)PL_curcop->cop_seq;
SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */
SvFAKE_on(namesv); /* A ref, not a real var */
if (SvOBJECT(sv)) { /* A typed var */
@@ -1899,7 +1899,7 @@ Perl_fold_constants(pTHX_ register OP *o)
type != OP_NEGATE)
{
IV iv = SvIV(sv);
- if ((double)iv == SvNV(sv)) {
+ if ((NV)iv == SvNV(sv)) {
SvREFCNT_dec(sv);
sv = newSViv(iv);
}
@@ -3083,7 +3083,7 @@ Perl_intro_my(pTHX)
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
- SvNVX(sv) = (double)PL_cop_seqmax;
+ SvNVX(sv) = (NV)PL_cop_seqmax;
}
}
PL_min_intro_pending = 0;
diff --git a/perl.h b/perl.h
index 558d423dab..5eb7b1dbe1 100644
--- a/perl.h
+++ b/perl.h
@@ -997,6 +997,43 @@ Free_t Perl_mfree (Malloc_t where);
# endif
#endif
+#ifdef USE_LONG_DOUBLE
+# if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)
+# define LDoub_t long double
+# endif
+#endif
+
+#ifdef USE_LONG_DOUBLE
+# define HAS_LDOUB
+ typedef LDoub_t NV;
+# define Perl_modf modfl
+# define Perl_frexp frexpl
+# define Perl_cos cosl
+# define Perl_sin sinl
+# define Perl_sqrt sqrtl
+# define Perl_exp expl
+# define Perl_log logl
+# define Perl_atan2 atan2l
+# define Perl_pow powl
+# define Perl_floor floorl
+# define Perl_atof atof
+# define Perl_fmod fmodl
+#else
+ typedef double NV;
+# define Perl_modf modf
+# define Perl_frexp frexp
+# define Perl_cos cos
+# define Perl_sin sin
+# define Perl_sqrt sqrt
+# define Perl_exp exp
+# define Perl_log log
+# define Perl_atan2 atan2
+# define Perl_pow pow
+# define Perl_floor floor
+# define Perl_atof atof /* At some point there may be an atolf */
+# define Perl_fmod fmod
+#endif
+
/* Previously these definitions used hardcoded figures.
* It is hoped these formula are more portable, although
* no data one way or another is presently known to me.
@@ -1728,9 +1765,9 @@ typedef I32 CHECKPOINT;
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
-#define U_S(what) ((U16)cast_ulong((double)(what)))
-#define U_I(what) ((unsigned int)cast_ulong((double)(what)))
-#define U_L(what) (cast_ulong((double)(what)))
+#define U_S(what) ((U16)cast_ulong((NV)(what)))
+#define U_I(what) ((unsigned int)cast_ulong((NV)(what)))
+#define U_L(what) (cast_ulong((NV)(what)))
#endif
#ifdef CASTI32
@@ -1738,9 +1775,9 @@ typedef I32 CHECKPOINT;
#define I_V(what) ((IV)(what))
#define U_V(what) ((UV)(what))
#else
-#define I_32(what) (cast_i32((double)(what)))
-#define I_V(what) (cast_iv((double)(what)))
-#define U_V(what) (cast_uv((double)(what)))
+#define I_32(what) (cast_i32((NV)(what)))
+#define I_V(what) (cast_iv((NV)(what)))
+#define U_V(what) (cast_uv((NV)(what)))
#endif
/* Used with UV/IV arguments: */
@@ -2879,7 +2916,7 @@ typedef struct am_table_short AMTS;
#define IS_NUMERIC_RADIX(c) (0)
#define RESTORE_NUMERIC_LOCAL() /**/
#define RESTORE_NUMERIC_STANDARD() /**/
-#define Atof atof
+#define Atof Perl_atof
#endif /* !USE_LOCALE_NUMERIC */
diff --git a/pp.c b/pp.c
index adf3d7308b..e688848d9c 100644
--- a/pp.c
+++ b/pp.c
@@ -943,15 +943,15 @@ PP(pp_divide)
djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPPOPnnrl;
- double value;
+ NV value;
if (right == 0.0)
DIE(aTHX_ "Illegal division by zero");
#ifdef SLOPPYDIVIDE
/* insure that 20./5. == 4. */
{
IV k;
- if ((double)I_V(left) == left &&
- (double)I_V(right) == right &&
+ if ((NV)I_V(left) == left &&
+ (NV)I_V(right) == right &&
(k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
value = k;
}
@@ -976,8 +976,8 @@ PP(pp_modulo)
bool left_neg;
bool right_neg;
bool use_double = 0;
- double dright;
- double dleft;
+ NV dright;
+ NV dleft;
if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
IV i = SvIVX(POPs);
@@ -1007,7 +1007,7 @@ PP(pp_modulo)
}
if (use_double) {
- double dans;
+ NV dans;
#if 1
/* Somehow U_V is pessimized even if CASTFLAGS is 0 */
@@ -1034,7 +1034,7 @@ PP(pp_modulo)
if (!dright)
DIE(aTHX_ "Illegal modulus zero");
- dans = fmod(dleft, dright);
+ dans = Perl_fmod(dleft, dright);
if ((left_neg != right_neg) && dans)
dans = dright - dans;
if (right_neg)
@@ -1057,7 +1057,7 @@ PP(pp_modulo)
if (ans <= ~((UV)IV_MAX)+1)
sv_setiv(TARG, ~ans+1);
else
- sv_setnv(TARG, -(double)ans);
+ sv_setnv(TARG, -(NV)ans);
}
else
sv_setuv(TARG, ans);
@@ -1624,7 +1624,7 @@ PP(pp_atan2)
djSP; dTARGET; tryAMAGICbin(atan2,0);
{
dPOPTOPnnrl;
- SETn(atan2(left, right));
+ SETn(Perl_atan2(left, right));
RETURN;
}
}
@@ -1633,9 +1633,9 @@ PP(pp_sin)
{
djSP; dTARGET; tryAMAGICun(sin);
{
- double value;
+ NV value;
value = POPn;
- value = sin(value);
+ value = Perl_sin(value);
XPUSHn(value);
RETURN;
}
@@ -1645,9 +1645,9 @@ PP(pp_cos)
{
djSP; dTARGET; tryAMAGICun(cos);
{
- double value;
+ NV value;
value = POPn;
- value = cos(value);
+ value = Perl_cos(value);
XPUSHn(value);
RETURN;
}
@@ -1671,7 +1671,7 @@ extern double drand48 (void);
PP(pp_rand)
{
djSP; dTARGET;
- double value;
+ NV value;
if (MAXARG < 1)
value = 1.0;
else
@@ -1787,9 +1787,9 @@ PP(pp_exp)
{
djSP; dTARGET; tryAMAGICun(exp);
{
- double value;
+ NV value;
value = POPn;
- value = exp(value);
+ value = Perl_exp(value);
XPUSHn(value);
RETURN;
}
@@ -1799,13 +1799,13 @@ PP(pp_log)
{
djSP; dTARGET; tryAMAGICun(log);
{
- double value;
+ NV value;
value = POPn;
if (value <= 0.0) {
RESTORE_NUMERIC_STANDARD();
DIE(aTHX_ "Can't take log of %g", value);
}
- value = log(value);
+ value = Perl_log(value);
XPUSHn(value);
RETURN;
}
@@ -1815,13 +1815,13 @@ PP(pp_sqrt)
{
djSP; dTARGET; tryAMAGICun(sqrt);
{
- double value;
+ NV value;
value = POPn;
if (value < 0.0) {
RESTORE_NUMERIC_STANDARD();
DIE(aTHX_ "Can't take sqrt of %g", value);
}
- value = sqrt(value);
+ value = Perl_sqrt(value);
XPUSHn(value);
RETURN;
}
@@ -1831,7 +1831,7 @@ PP(pp_int)
{
djSP; dTARGET;
{
- double value = TOPn;
+ NV value = TOPn;
IV iv;
if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
@@ -1840,9 +1840,9 @@ PP(pp_int)
}
else {
if (value >= 0.0)
- (void)modf(value, &value);
+ (void)Perl_modf(value, &value);
else {
- (void)modf(-value, &value);
+ (void)Perl_modf(-value, &value);
value = -value;
}
iv = I_V(value);
@@ -1859,7 +1859,7 @@ PP(pp_abs)
{
djSP; dTARGET; tryAMAGICun(abs);
{
- double value = TOPn;
+ NV value = TOPn;
IV iv;
if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
@@ -3301,7 +3301,7 @@ PP(pp_unpack)
double adouble;
I32 checksum = 0;
register U32 culong;
- double cdouble;
+ NV cdouble;
int commas = 0;
#ifdef PERL_NATINT_PACK
int natint; /* native integer */
@@ -3565,7 +3565,7 @@ PP(pp_unpack)
auint = utf8_to_uv((U8*)s, &along);
s += along;
if (checksum > 32)
- cdouble += (double)auint;
+ cdouble += (NV)auint;
else
culong += auint;
}
@@ -3725,7 +3725,7 @@ PP(pp_unpack)
Copy(s, &aint, 1, int);
s += sizeof(int);
if (checksum > 32)
- cdouble += (double)aint;
+ cdouble += (NV)aint;
else
culong += aint;
}
@@ -3776,7 +3776,7 @@ PP(pp_unpack)
Copy(s, &auint, 1, unsigned int);
s += sizeof(unsigned int);
if (checksum > 32)
- cdouble += (double)auint;
+ cdouble += (NV)auint;
else
culong += auint;
}
@@ -3815,7 +3815,7 @@ PP(pp_unpack)
COPYNN(s, &along, sizeof(long));
s += sizeof(long);
if (checksum > 32)
- cdouble += (double)along;
+ cdouble += (NV)along;
else
culong += along;
}
@@ -3831,7 +3831,7 @@ PP(pp_unpack)
#endif
s += SIZE32;
if (checksum > 32)
- cdouble += (double)along;
+ cdouble += (NV)along;
else
culong += along;
}
@@ -3885,7 +3885,7 @@ PP(pp_unpack)
COPYNN(s, &aulong, sizeof(unsigned long));
s += sizeof(unsigned long);
if (checksum > 32)
- cdouble += (double)aulong;
+ cdouble += (NV)aulong;
else
culong += aulong;
}
@@ -3905,7 +3905,7 @@ PP(pp_unpack)
aulong = vtohl(aulong);
#endif
if (checksum > 32)
- cdouble += (double)aulong;
+ cdouble += (NV)aulong;
else
culong += aulong;
}
@@ -4037,7 +4037,7 @@ PP(pp_unpack)
if (aquad >= IV_MIN && aquad <= IV_MAX)
sv_setiv(sv, (IV)aquad);
else
- sv_setnv(sv, (double)aquad);
+ sv_setnv(sv, (NV)aquad);
PUSHs(sv_2mortal(sv));
}
break;
@@ -4058,7 +4058,7 @@ PP(pp_unpack)
if (auquad <= UV_MAX)
sv_setuv(sv, (UV)auquad);
else
- sv_setnv(sv, (double)auquad);
+ sv_setnv(sv, (NV)auquad);
PUSHs(sv_2mortal(sv));
}
break;
@@ -4083,7 +4083,7 @@ PP(pp_unpack)
Copy(s, &afloat, 1, float);
s += sizeof(float);
sv = NEWSV(47, 0);
- sv_setnv(sv, (double)afloat);
+ sv_setnv(sv, (NV)afloat);
PUSHs(sv_2mortal(sv));
}
}
@@ -4107,7 +4107,7 @@ PP(pp_unpack)
Copy(s, &adouble, 1, double);
s += sizeof(double);
sv = NEWSV(48, 0);
- sv_setnv(sv, (double)adouble);
+ sv_setnv(sv, (NV)adouble);
PUSHs(sv_2mortal(sv));
}
}
@@ -4175,7 +4175,7 @@ PP(pp_unpack)
sv = NEWSV(42, 0);
if (strchr("fFdD", datumtype) ||
(checksum > 32 && strchr("iIlLNU", datumtype)) ) {
- double trouble;
+ NV trouble;
adouble = 1.0;
while (checksum >= 16) {
@@ -4191,7 +4191,7 @@ PP(pp_unpack)
along = (1 << checksum) - 1;
while (cdouble < 0.0)
cdouble += adouble;
- cdouble = modf(cdouble / adouble, &trouble) * adouble;
+ cdouble = Perl_modf(cdouble / adouble, &trouble) * adouble;
sv_setnv(sv, cdouble);
}
else {
@@ -4668,7 +4668,7 @@ PP(pp_pack)
case 'w':
while (len-- > 0) {
fromstr = NEXTFROM;
- adouble = floor(SvNV(fromstr));
+ adouble = Perl_floor(SvNV(fromstr));
if (adouble < 0)
Perl_croak(aTHX_ "Cannot compress negative numbers");
diff --git a/pp.h b/pp.h
index ca8dc35640..9fd3365361 100644
--- a/pp.h
+++ b/pp.h
@@ -88,43 +88,43 @@
#define PUSHs(s) (*++sp = (s))
#define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END
#define PUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
-#define PUSHn(n) STMT_START { sv_setnv(TARG, (double)(n)); PUSHTARG; } STMT_END
+#define PUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); PUSHTARG; } STMT_END
#define PUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END
#define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
#define XPUSHs(s) STMT_START { EXTEND(sp,1); (*++sp = (s)); } STMT_END
#define XPUSHTARG STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END
#define XPUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END
-#define XPUSHn(n) STMT_START { sv_setnv(TARG, (double)(n)); XPUSHTARG; } STMT_END
+#define XPUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); XPUSHTARG; } STMT_END
#define XPUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
#define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
#define SETs(s) (*sp = s)
#define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
#define SETp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
-#define SETn(n) STMT_START { sv_setnv(TARG, (double)(n)); SETTARG; } STMT_END
+#define SETn(n) STMT_START { sv_setnv(TARG, (NV)(n)); SETTARG; } STMT_END
#define SETi(i) STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END
#define SETu(u) STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END
#define dTOPss SV *sv = TOPs
#define dPOPss SV *sv = POPs
-#define dTOPnv double value = TOPn
-#define dPOPnv double value = POPn
+#define dTOPnv NV value = TOPn
+#define dPOPnv NV value = POPn
#define dTOPiv IV value = TOPi
#define dPOPiv IV value = POPi
#define dTOPuv UV value = TOPu
#define dPOPuv UV value = POPu
#define dPOPXssrl(X) SV *right = POPs; SV *left = CAT2(X,s)
-#define dPOPXnnrl(X) double right = POPn; double left = CAT2(X,n)
+#define dPOPXnnrl(X) NV right = POPn; NV left = CAT2(X,n)
#define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i)
#define USE_LEFT(sv) \
(SvOK(sv) || SvGMAGICAL(sv) || !(PL_op->op_flags & OPf_STACKED))
#define dPOPXnnrl_ul(X) \
- double right = POPn; \
+ NV right = POPn; \
SV *leftsv = CAT2(X,s); \
- double left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0
+ NV left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0
#define dPOPXiirl_ul(X) \
IV right = POPi; \
SV *leftsv = CAT2(X,s); \
diff --git a/pp_ctl.c b/pp_ctl.c
index 64e695bc2e..21d03351ef 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -276,7 +276,7 @@ PP(pp_formline)
bool chopspace = (strchr(PL_chopset, ' ') != Nullch);
char *chophere;
char *linemark;
- double value;
+ NV value;
bool gotsome;
STRLEN len;
STRLEN fudge = SvCUR(tmpForm) * (IN_UTF8 ? 3 : 1) + 1;
@@ -569,6 +569,14 @@ PP(pp_formline)
/* Formats aren't yet marked for locales, so assume "yes". */
{
RESTORE_NUMERIC_LOCAL();
+#if defined(USE_LONG_DOUBLE)
+ if (arg & 256) {
+ sprintf(t, "%#*.*Lf",
+ (int) fieldsize, (int) arg & 255, value);
+ } else {
+ sprintf(t, "%*.0Lf", (int) fieldsize, value);
+ }
+#else
if (arg & 256) {
sprintf(t, "%#*.*f",
(int) fieldsize, (int) arg & 255, value);
@@ -576,6 +584,7 @@ PP(pp_formline)
sprintf(t, "%*.0f",
(int) fieldsize, value);
}
+#endif
RESTORE_NUMERIC_STANDARD();
}
t += fieldsize;
@@ -749,8 +758,8 @@ PP(pp_mapwhile)
STATIC I32
S_sv_ncmp(pTHX_ SV *a, SV *b)
{
- double nv1 = SvNV(a);
- double nv2 = SvNV(b);
+ NV nv1 = SvNV(a);
+ NV nv2 = SvNV(b);
return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
}
@@ -778,7 +787,7 @@ S_amagic_ncmp(pTHX_ register SV *a, register SV *b)
SV *tmpsv;
tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
if (tmpsv) {
- double d;
+ NV d;
if (SvIOK(tmpsv)) {
I32 i = SvIVX(tmpsv);
@@ -800,7 +809,7 @@ S_amagic_i_ncmp(pTHX_ register SV *a, register SV *b)
SV *tmpsv;
tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
if (tmpsv) {
- double d;
+ NV d;
if (SvIOK(tmpsv)) {
I32 i = SvIVX(tmpsv);
@@ -822,7 +831,7 @@ S_amagic_cmp(pTHX_ register SV *str1, register SV *str2)
SV *tmpsv;
tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
if (tmpsv) {
- double d;
+ NV d;
if (SvIOK(tmpsv)) {
I32 i = SvIVX(tmpsv);
@@ -844,7 +853,7 @@ S_amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2)
SV *tmpsv;
tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
if (tmpsv) {
- double d;
+ NV d;
if (SvIOK(tmpsv)) {
I32 i = SvIVX(tmpsv);
@@ -2464,11 +2473,11 @@ PP(pp_exit)
PP(pp_nswitch)
{
djSP;
- double value = SvNVx(GvSV(cCOP->cop_gv));
+ NV value = SvNVx(GvSV(cCOP->cop_gv));
register I32 match = I_32(value);
if (value < 0.0) {
- if (((double)match) > value)
+ if (((NV)match) > value)
--match; /* was fractional--truncate other way */
}
match -= cCOP->uop.scop.scop_offset;
diff --git a/pp_sys.c b/pp_sys.c
index 5bb0ca30d4..a2ed109a4d 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -906,7 +906,7 @@ PP(pp_sselect)
register I32 j;
register char *s;
register SV *sv;
- double value;
+ NV value;
I32 maxlen = 0;
I32 nfound;
struct timeval timebuf;
@@ -969,7 +969,7 @@ PP(pp_sselect)
if (value < 0.0)
value = 0.0;
timebuf.tv_sec = (long)value;
- value -= (double)timebuf.tv_sec;
+ value -= (NV)timebuf.tv_sec;
timebuf.tv_usec = (long)(value * 1000000.0);
}
else
@@ -1028,8 +1028,8 @@ PP(pp_sselect)
PUSHi(nfound);
if (GIMME == G_ARRAY && tbuf) {
- value = (double)(timebuf.tv_sec) +
- (double)(timebuf.tv_usec) / 1000000.0;
+ value = (NV)(timebuf.tv_sec) +
+ (NV)(timebuf.tv_usec) / 1000000.0;
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
sv_setnv(sv, value);
}
@@ -3826,11 +3826,11 @@ PP(pp_tms)
/* is returned. */
#endif
- PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_utime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_utime)/HZ)));
if (GIMME == G_ARRAY) {
- PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_stime)/HZ)));
- PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_cutime)/HZ)));
- PUSHs(sv_2mortal(newSVnv(((double)PL_timesbuf.tms_cstime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_stime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cutime)/HZ)));
+ PUSHs(sv_2mortal(newSVnv(((NV)PL_timesbuf.tms_cstime)/HZ)));
}
RETURN;
#endif /* HAS_TIMES */
diff --git a/proto.h b/proto.h
index 95ffda5132..eae128ac0e 100644
--- a/proto.h
+++ b/proto.h
@@ -39,10 +39,10 @@ VIRTUAL int Perl_block_start(pTHX_ int full);
VIRTUAL void Perl_boot_core_UNIVERSAL(pTHX);
VIRTUAL void Perl_call_list(pTHX_ I32 oldscope, AV* av_list);
VIRTUAL I32 Perl_cando(pTHX_ I32 bit, I32 effective, Stat_t* statbufp);
-VIRTUAL U32 Perl_cast_ulong(pTHX_ double f);
-VIRTUAL I32 Perl_cast_i32(pTHX_ double f);
-VIRTUAL IV Perl_cast_iv(pTHX_ double f);
-VIRTUAL UV Perl_cast_uv(pTHX_ double f);
+VIRTUAL U32 Perl_cast_ulong(pTHX_ NV f);
+VIRTUAL I32 Perl_cast_i32(pTHX_ NV f);
+VIRTUAL IV Perl_cast_iv(pTHX_ NV f);
+VIRTUAL UV Perl_cast_uv(pTHX_ NV f);
#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
VIRTUAL I32 Perl_my_chsize(pTHX_ int fd, Off_t length);
#endif
@@ -307,7 +307,7 @@ VIRTUAL I32 Perl_mg_size(pTHX_ SV* sv);
VIRTUAL OP* Perl_mod(pTHX_ OP* o, I32 type);
VIRTUAL char* Perl_moreswitches(pTHX_ char* s);
VIRTUAL OP* Perl_my(pTHX_ OP* o);
-VIRTUAL double Perl_my_atof(pTHX_ const char *s);
+VIRTUAL NV Perl_my_atof(pTHX_ const char *s);
#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
VIRTUAL char* Perl_my_bcopy(pTHX_ const char* from, char* to, I32 len);
#endif
@@ -375,7 +375,7 @@ VIRTUAL SV* Perl_newSV(pTHX_ STRLEN len);
VIRTUAL OP* Perl_newSVREF(pTHX_ OP* o);
VIRTUAL OP* Perl_newSVOP(pTHX_ I32 type, I32 flags, SV* sv);
VIRTUAL SV* Perl_newSViv(pTHX_ IV i);
-VIRTUAL SV* Perl_newSVnv(pTHX_ double n);
+VIRTUAL SV* Perl_newSVnv(pTHX_ NV n);
VIRTUAL SV* Perl_newSVpv(pTHX_ const char* s, STRLEN len);
VIRTUAL SV* Perl_newSVpvn(pTHX_ const char* s, STRLEN len);
VIRTUAL SV* Perl_newSVpvf(pTHX_ const char* pat, ...);
@@ -527,12 +527,12 @@ VIRTUAL CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref);
VIRTUAL IO* Perl_sv_2io(pTHX_ SV* sv);
VIRTUAL IV Perl_sv_2iv(pTHX_ SV* sv);
VIRTUAL SV* Perl_sv_2mortal(pTHX_ SV* sv);
-VIRTUAL double Perl_sv_2nv(pTHX_ SV* sv);
+VIRTUAL NV Perl_sv_2nv(pTHX_ SV* sv);
VIRTUAL char* Perl_sv_2pv(pTHX_ SV* sv, STRLEN* lp);
VIRTUAL UV Perl_sv_2uv(pTHX_ SV* sv);
VIRTUAL IV Perl_sv_iv(pTHX_ SV* sv);
VIRTUAL UV Perl_sv_uv(pTHX_ SV* sv);
-VIRTUAL double Perl_sv_nv(pTHX_ SV* sv);
+VIRTUAL NV Perl_sv_nv(pTHX_ SV* sv);
VIRTUAL char* Perl_sv_pvn(pTHX_ SV *sv, STRLEN *len);
VIRTUAL I32 Perl_sv_true(pTHX_ SV *sv);
VIRTUAL void Perl_sv_add_arena(pTHX_ char* ptr, U32 size, U32 flags);
@@ -582,9 +582,9 @@ VIRTUAL void Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...);
VIRTUAL void Perl_sv_setiv(pTHX_ SV* sv, IV num);
VIRTUAL void Perl_sv_setpviv(pTHX_ SV* sv, IV num);
VIRTUAL void Perl_sv_setuv(pTHX_ SV* sv, UV num);
-VIRTUAL void Perl_sv_setnv(pTHX_ SV* sv, double num);
+VIRTUAL void Perl_sv_setnv(pTHX_ SV* sv, NV num);
VIRTUAL SV* Perl_sv_setref_iv(pTHX_ SV* rv, const char* classname, IV iv);
-VIRTUAL SV* Perl_sv_setref_nv(pTHX_ SV* rv, const char* classname, double nv);
+VIRTUAL SV* Perl_sv_setref_nv(pTHX_ SV* rv, const char* classname, NV nv);
VIRTUAL SV* Perl_sv_setref_pv(pTHX_ SV* rv, const char* classname, void* pv);
VIRTUAL SV* Perl_sv_setref_pvn(pTHX_ SV* rv, const char* classname, char* pv, STRLEN n);
VIRTUAL void Perl_sv_setpv(pTHX_ SV* sv, const char* ptr);
@@ -674,7 +674,7 @@ VIRTUAL void Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...);
VIRTUAL void Perl_sv_setiv_mg(pTHX_ SV *sv, IV i);
VIRTUAL void Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv);
VIRTUAL void Perl_sv_setuv_mg(pTHX_ SV *sv, UV u);
-VIRTUAL void Perl_sv_setnv_mg(pTHX_ SV *sv, double num);
+VIRTUAL void Perl_sv_setnv_mg(pTHX_ SV *sv, NV num);
VIRTUAL void Perl_sv_setpv_mg(pTHX_ SV *sv, const char *ptr);
VIRTUAL void Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
VIRTUAL void Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr);
diff --git a/sv.c b/sv.c
index 282baf9259..e44c533bf3 100644
--- a/sv.c
+++ b/sv.c
@@ -435,12 +435,12 @@ S_more_xiv(pTHX)
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));
}
@@ -448,9 +448,9 @@ S_new_xnv(pTHX)
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;
}
@@ -458,17 +458,17 @@ S_del_xnv(pTHX_ XPVNV *p)
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*
@@ -631,7 +631,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
U32 cur;
U32 len;
IV iv;
- double nv;
+ NV nv;
MAGIC* magic;
HV* stash;
@@ -656,7 +656,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
cur = 0;
len = 0;
iv = SvIVX(sv);
- nv = (double)SvIVX(sv);
+ nv = (NV)SvIVX(sv);
del_XIV(SvANY(sv));
magic = 0;
stash = 0;
@@ -683,7 +683,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
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;
@@ -1017,7 +1017,7 @@ Perl_sv_setuv_mg(pTHX_ register SV *sv, UV u)
}
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)) {
@@ -1049,7 +1049,7 @@ Perl_sv_setnv(pTHX_ register SV *sv, double num)
}
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);
@@ -1181,7 +1181,7 @@ Perl_sv_2iv(pTHX_ register SV *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));
@@ -1208,7 +1208,7 @@ Perl_sv_2iv(pTHX_ register SV *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));
@@ -1218,9 +1218,14 @@ Perl_sv_2iv(pTHX_ register SV *sv)
(void)SvNOK_on(sv);
(void)SvIOK_on(sv);
DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%lx 2nv(%g)\n",(unsigned long)sv,
+#if defined(USE_LONG_DOUBLE)
+ "0x%lx 2nv(%Lg)\n",
+#else
+ "0x%lx 2nv(%g)\n",
+#endif
+ (unsigned long)sv,
SvNVX(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));
@@ -1348,7 +1353,7 @@ Perl_sv_2uv(pTHX_ register SV *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? */
@@ -1358,7 +1363,12 @@ Perl_sv_2uv(pTHX_ register SV *sv)
(void)SvNOK_on(sv);
(void)SvIOK_on(sv);
DEBUG_c(PerlIO_printf(Perl_debug_log,
- "0x%lx 2nv(%g)\n",(unsigned long)sv,
+#if defined(USE_LONG_DOUBLE)
+ "0x%lx 2nv(%Lg)\n",
+#else
+ "0x%lx 2nv(%g)\n",
+#endif
+ (unsigned long)sv,
SvNVX(sv)));
if (SvNVX(sv) < -0.5) {
SvIVX(sv) = I_V(SvNVX(sv));
@@ -1420,7 +1430,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
return SvIsUV(sv) ? SvUVX(sv) : (UV)SvIVX(sv);
}
-double
+NV
Perl_sv_2nv(pTHX_ register SV *sv)
{
if (!sv)
@@ -1437,9 +1447,9 @@ Perl_sv_2nv(pTHX_ register SV *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)) {
@@ -1455,7 +1465,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
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;
@@ -1466,9 +1476,9 @@ Perl_sv_2nv(pTHX_ register SV *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 (ckWARN(WARN_UNINITIALIZED))
Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
@@ -1483,7 +1493,12 @@ Perl_sv_2nv(pTHX_ register SV *sv)
DEBUG_c({
RESTORE_NUMERIC_STANDARD();
PerlIO_printf(Perl_debug_log,
- "0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv));
+#if defined(USE_LONG_DOUBLE)
+ "0x%lx num(%Lg)\n",
+#else
+ "0x%lx num(%g)\n",
+#endif
+ (unsigned long)sv,SvNVX(sv)));
RESTORE_NUMERIC_LOCAL();
});
}
@@ -1492,7 +1507,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
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;
@@ -1513,7 +1528,12 @@ Perl_sv_2nv(pTHX_ register SV *sv)
DEBUG_c({
RESTORE_NUMERIC_STANDARD();
PerlIO_printf(Perl_debug_log,
- "0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv));
+#if defined(USE_LONG_DOUBLE)
+ "0x%lx 2nv(%Lg)\n",
+#else
+ "0x%lx 1nv(%g)\n",
+#endif
+ (unsigned long)sv,SvNVX(sv)));
RESTORE_NUMERIC_LOCAL();
});
return SvNVX(sv);
@@ -1523,7 +1543,7 @@ STATIC IV
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? */
@@ -3754,13 +3774,13 @@ Perl_sv_inc(pTHX_ register SV *sv)
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);
@@ -3863,7 +3883,7 @@ Perl_sv_dec(pTHX_ register SV *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);
@@ -3981,7 +4001,7 @@ Perl_newSVpvf(pTHX_ const char* pat, ...)
}
SV *
-Perl_newSVnv(pTHX_ double n)
+Perl_newSVnv(pTHX_ NV n)
{
register SV *sv;
@@ -4273,7 +4293,7 @@ Perl_sv_uv(pTHX_ register SV *sv)
return sv_2uv(sv);
}
-double
+NV
Perl_sv_nv(pTHX_ register SV *sv)
{
if (SvNOK(sv))
@@ -4449,7 +4469,7 @@ Perl_sv_setref_iv(pTHX_ SV *rv, const char *classname, IV iv)
}
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;
@@ -4733,7 +4753,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
unsigned base;
IV iv;
UV uv;
- double nv;
+ NV nv;
STRLEN have;
STRLEN need;
STRLEN gap;
@@ -5051,7 +5071,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
/* 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;
@@ -5078,6 +5098,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
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);
diff --git a/sv.h b/sv.h
index 8eddc57a11..5787da383a 100644
--- a/sv.h
+++ b/sv.h
@@ -196,7 +196,7 @@ struct xpvnv {
STRLEN xpv_cur; /* length of xpv_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
};
/* These structure must match the beginning of struct xpvhv in hv.h. */
@@ -205,7 +205,7 @@ struct xpvmg {
STRLEN xpv_cur; /* length of xpv_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* linked list of magicalness */
HV* xmg_stash; /* class package */
};
@@ -215,7 +215,7 @@ struct xpvlv {
STRLEN xpv_cur; /* length of xpv_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* linked list of magicalness */
HV* xmg_stash; /* class package */
@@ -230,7 +230,7 @@ struct xpvgv {
STRLEN xpv_cur; /* length of xpv_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* linked list of magicalness */
HV* xmg_stash; /* class package */
@@ -246,7 +246,7 @@ struct xpvbm {
STRLEN xpv_cur; /* length of xpv_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* linked list of magicalness */
HV* xmg_stash; /* class package */
@@ -264,7 +264,7 @@ struct xpvfm {
STRLEN xpv_cur; /* length of xpv_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* linked list of magicalness */
HV* xmg_stash; /* class package */
@@ -292,7 +292,7 @@ struct xpvio {
STRLEN xpv_cur; /* length of xpv_pv as a C string */
STRLEN xpv_len; /* allocated size */
IV xiv_iv; /* integer value or pv offset */
- double xnv_nv; /* numeric value, if any */
+ NV xnv_nv; /* numeric value, if any */
MAGIC* xmg_magic; /* linked list of magicalness */
HV* xmg_stash; /* class package */
diff --git a/toke.c b/toke.c
index dd8742b02d..78491529ba 100644
--- a/toke.c
+++ b/toke.c
@@ -5953,7 +5953,7 @@ Perl_scan_num(pTHX_ char *start)
register char *d; /* destination in temp buffer */
register char *e; /* end of temp buffer */
I32 tryiv; /* used to see if it can be an int */
- double value; /* number read, as a double */
+ NV value; /* number read, as a double */
SV *sv; /* place to put the converted number */
I32 floatit; /* boolean: int or float? */
char *lastub = 0; /* position of last underbar */
@@ -6169,7 +6169,7 @@ Perl_scan_num(pTHX_ char *start)
conversion at all.
*/
tryiv = I_V(value);
- if (!floatit && (double)tryiv == value)
+ if (!floatit && (NV)tryiv == value)
sv_setiv(sv, tryiv);
else
sv_setnv(sv, value);
diff --git a/universal.c b/universal.c
index 3e5547a58d..032a536e55 100644
--- a/universal.c
+++ b/universal.c
@@ -183,7 +183,7 @@ XS(XS_UNIVERSAL_VERSION)
GV *gv;
SV *sv;
char *undef;
- double req;
+ NV req;
if(SvROK(ST(0))) {
sv = (SV*)SvRV(ST(0));
diff --git a/util.c b/util.c
index 3655cefada..99415f0918 100644
--- a/util.c
+++ b/util.c
@@ -2630,7 +2630,7 @@ Perl_repeatcpy(pTHX_ register char *to, register const char *from, I32 len, regi
}
U32
-Perl_cast_ulong(pTHX_ double f)
+Perl_cast_ulong(pTHX_ NV f)
{
long along;
@@ -2667,7 +2667,7 @@ Perl_cast_ulong(pTHX_ double f)
#endif
I32
-Perl_cast_i32(pTHX_ double f)
+Perl_cast_i32(pTHX_ NV f)
{
if (f >= I32_MAX)
return (I32) I32_MAX;
@@ -2677,12 +2677,12 @@ Perl_cast_i32(pTHX_ double f)
}
IV
-Perl_cast_iv(pTHX_ double f)
+Perl_cast_iv(pTHX_ NV f)
{
if (f >= IV_MAX) {
UV uv;
- if (f >= (double)UV_MAX)
+ if (f >= (NV)UV_MAX)
return (IV) UV_MAX;
uv = (UV) f;
return (IV)uv;
@@ -2693,7 +2693,7 @@ Perl_cast_iv(pTHX_ double f)
}
UV
-Perl_cast_uv(pTHX_ double f)
+Perl_cast_uv(pTHX_ NV f)
{
if (f >= MY_UV_MAX)
return (UV) MY_UV_MAX;
@@ -3303,7 +3303,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
* So it is in perl for (say) POSIX to use.
* Needed for SunOS with Sun's 'acc' for example.
*/
-double
+NV
Perl_huge(void)
{
return HUGE_VAL;
@@ -3506,22 +3506,23 @@ Perl_my_fflush_all(pTHX)
#endif
}
-double
+NV
Perl_my_atof(pTHX_ const char* s) {
#ifdef USE_LOCALE_NUMERIC
if ((PL_hints & HINT_LOCALE) && PL_numeric_local) {
- double x, y;
+ NV x, y;
- x = atof(s);
+ x = Perl_atof(s);
SET_NUMERIC_STANDARD();
- y = atof(s);
+ y = Perl_atof(s);
SET_NUMERIC_LOCAL();
if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
return y;
return x;
- } else
- return atof(s);
+ }
+ else
+ return Perl_atof(s);
#else
- return atof(s);
+ return Perl_atof(s);
#endif
}