This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
slightly tweaked version of suggested patch
authorDan Sugalski <dan@sidhe.org>
Tue, 8 Jun 1999 14:09:38 +0000 (07:09 -0700)
committerGurusamy Sarathy <gsar@cpan.org>
Tue, 6 Jul 1999 07:00:01 +0000 (07:00 +0000)
Message-Id: <3.0.6.32.19990608140938.030f12e0@ous.edu>
Subject: [PATCH 5.005_57]Use NV instead of double in the core

p4raw-id: //depot/perl@3602

23 files changed:
av.h
bytecode.pl
cv.h
doio.c
dump.c
embed.pl
ext/ByteLoader/bytecode.h
ext/ByteLoader/byterun.c
hv.h
intrpvar.h
mg.c
op.c
perl.h
pp.c
pp.h
pp_ctl.c
pp_sys.c
proto.h
sv.c
sv.h
toke.c
universal.c
util.c

diff --git a/av.h b/av.h
index bef763d..bacf614 100644 (file)
--- 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 */
 
index 1e18d55..4d318ff 100644 (file)
@@ -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 e060dc8..7042708 100644 (file)
--- 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 0fc139c..39e2e9f 100644 (file)
--- 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 3d3a55c..9c7d3a9 100644 (file)
--- 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);
index d7c5a87..ad91f80 100755 (executable)
--- 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
index 9d597fb..04a05e4 100644 (file)
@@ -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 {  \
index 544a59f..035578f 100644 (file)
@@ -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 e9772d4..3977b1c 100644 (file)
--- 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 */
 
index 0bf826e..5cff858 100644 (file)
@@ -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 a21ea57..0e9ca19 100644 (file)
--- 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 25b17dc..091a768 100644 (file)
--- 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 558d423..5eb7b1d 100644 (file)
--- 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 adf3d73..e688848 100644 (file)
--- 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 ca8dc35..9fd3365 100644 (file)
--- a/pp.h
+++ b/pp.h
 #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);                            \
index 64e695b..21d0335 100644 (file)
--- 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;
index 5bb0ca3..a2ed109 100644 (file)
--- 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 95ffda5..eae128a 100644 (file)
--- 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 282baf9..e44c533 100644 (file)
--- 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 8eddc57..5787da3 100644 (file)
--- 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 dd8742b..7849152 100644 (file)
--- 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);
index 3e5547a..032a536 100644 (file)
@@ -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 3655cef..99415f0 100644 (file)
--- 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
 }