X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f2b5be74500fffd3dc232fca7cb3c51bc3b9abf9..328826784b2a898fc3c4e57c47657410cb6f5559:/sv.c

diff --git a/sv.c b/sv.c
index 0c48260..30de6af 100644
--- a/sv.c
+++ b/sv.c
@@ -15,34 +15,6 @@
 #define PERL_IN_SV_C
 #include "perl.h"
 
-#ifdef OVR_DBL_DIG
-/* Use an overridden DBL_DIG */
-# ifdef DBL_DIG
-#  undef DBL_DIG
-# endif
-# define DBL_DIG OVR_DBL_DIG
-#else
-/* The following is all to get DBL_DIG, in order to pick a nice
-   default value for printing floating point numbers in Gconvert.
-   (see config.h)
-*/
-#ifdef I_LIMITS
-#include <limits.h>
-#endif
-#ifdef I_FLOAT
-#include <float.h>
-#endif
-#ifndef HAS_DBL_DIG
-#define DBL_DIG	15   /* A guess that works lots of places */
-#endif
-#endif
-
-#ifdef PERL_OBJECT
-#define VTBL this->*vtbl
-#else /* !PERL_OBJECT */
-#define VTBL *vtbl
-#endif /* PERL_OBJECT */
-
 #define FCALL *f
 #define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_force_normal(sv)
 
@@ -503,6 +475,321 @@ S_more_xpv(pTHX)
     xpv->xpv_pv = 0;
 }
 
+STATIC XPVIV*
+S_new_xpviv(pTHX)
+{
+    XPVIV* xpviv;
+    LOCK_SV_MUTEX;
+    if (!PL_xpviv_root)
+	more_xpviv();
+    xpviv = PL_xpviv_root;
+    PL_xpviv_root = (XPVIV*)xpviv->xpv_pv;
+    UNLOCK_SV_MUTEX;
+    return xpviv;
+}
+
+STATIC void
+S_del_xpviv(pTHX_ XPVIV *p)
+{
+    LOCK_SV_MUTEX;
+    p->xpv_pv = (char*)PL_xpviv_root;
+    PL_xpviv_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
+
+STATIC void
+S_more_xpviv(pTHX)
+{
+    register XPVIV* xpviv;
+    register XPVIV* xpvivend;
+    New(714, PL_xpviv_root, 1008/sizeof(XPVIV), XPVIV);
+    xpviv = PL_xpviv_root;
+    xpvivend = &xpviv[1008 / sizeof(XPVIV) - 1];
+    while (xpviv < xpvivend) {
+	xpviv->xpv_pv = (char*)(xpviv + 1);
+	xpviv++;
+    }
+    xpviv->xpv_pv = 0;
+}
+
+
+STATIC XPVNV*
+S_new_xpvnv(pTHX)
+{
+    XPVNV* xpvnv;
+    LOCK_SV_MUTEX;
+    if (!PL_xpvnv_root)
+	more_xpvnv();
+    xpvnv = PL_xpvnv_root;
+    PL_xpvnv_root = (XPVNV*)xpvnv->xpv_pv;
+    UNLOCK_SV_MUTEX;
+    return xpvnv;
+}
+
+STATIC void
+S_del_xpvnv(pTHX_ XPVNV *p)
+{
+    LOCK_SV_MUTEX;
+    p->xpv_pv = (char*)PL_xpvnv_root;
+    PL_xpvnv_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
+
+STATIC void
+S_more_xpvnv(pTHX)
+{
+    register XPVNV* xpvnv;
+    register XPVNV* xpvnvend;
+    New(715, PL_xpvnv_root, 1008/sizeof(XPVNV), XPVNV);
+    xpvnv = PL_xpvnv_root;
+    xpvnvend = &xpvnv[1008 / sizeof(XPVNV) - 1];
+    while (xpvnv < xpvnvend) {
+	xpvnv->xpv_pv = (char*)(xpvnv + 1);
+	xpvnv++;
+    }
+    xpvnv->xpv_pv = 0;
+}
+
+
+
+STATIC XPVCV*
+S_new_xpvcv(pTHX)
+{
+    XPVCV* xpvcv;
+    LOCK_SV_MUTEX;
+    if (!PL_xpvcv_root)
+	more_xpvcv();
+    xpvcv = PL_xpvcv_root;
+    PL_xpvcv_root = (XPVCV*)xpvcv->xpv_pv;
+    UNLOCK_SV_MUTEX;
+    return xpvcv;
+}
+
+STATIC void
+S_del_xpvcv(pTHX_ XPVCV *p)
+{
+    LOCK_SV_MUTEX;
+    p->xpv_pv = (char*)PL_xpvcv_root;
+    PL_xpvcv_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
+
+STATIC void
+S_more_xpvcv(pTHX)
+{
+    register XPVCV* xpvcv;
+    register XPVCV* xpvcvend;
+    New(716, PL_xpvcv_root, 1008/sizeof(XPVCV), XPVCV);
+    xpvcv = PL_xpvcv_root;
+    xpvcvend = &xpvcv[1008 / sizeof(XPVCV) - 1];
+    while (xpvcv < xpvcvend) {
+	xpvcv->xpv_pv = (char*)(xpvcv + 1);
+	xpvcv++;
+    }
+    xpvcv->xpv_pv = 0;
+}
+
+
+
+STATIC XPVAV*
+S_new_xpvav(pTHX)
+{
+    XPVAV* xpvav;
+    LOCK_SV_MUTEX;
+    if (!PL_xpvav_root)
+	more_xpvav();
+    xpvav = PL_xpvav_root;
+    PL_xpvav_root = (XPVAV*)xpvav->xav_array;
+    UNLOCK_SV_MUTEX;
+    return xpvav;
+}
+
+STATIC void
+S_del_xpvav(pTHX_ XPVAV *p)
+{
+    LOCK_SV_MUTEX;
+    p->xav_array = (char*)PL_xpvav_root;
+    PL_xpvav_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
+
+STATIC void
+S_more_xpvav(pTHX)
+{
+    register XPVAV* xpvav;
+    register XPVAV* xpvavend;
+    New(717, PL_xpvav_root, 1008/sizeof(XPVAV), XPVAV);
+    xpvav = PL_xpvav_root;
+    xpvavend = &xpvav[1008 / sizeof(XPVAV) - 1];
+    while (xpvav < xpvavend) {
+	xpvav->xav_array = (char*)(xpvav + 1);
+	xpvav++;
+    }
+    xpvav->xav_array = 0;
+}
+
+
+
+STATIC XPVHV*
+S_new_xpvhv(pTHX)
+{
+    XPVHV* xpvhv;
+    LOCK_SV_MUTEX;
+    if (!PL_xpvhv_root)
+	more_xpvhv();
+    xpvhv = PL_xpvhv_root;
+    PL_xpvhv_root = (XPVHV*)xpvhv->xhv_array;
+    UNLOCK_SV_MUTEX;
+    return xpvhv;
+}
+
+STATIC void
+S_del_xpvhv(pTHX_ XPVHV *p)
+{
+    LOCK_SV_MUTEX;
+    p->xhv_array = (char*)PL_xpvhv_root;
+    PL_xpvhv_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
+
+STATIC void
+S_more_xpvhv(pTHX)
+{
+    register XPVHV* xpvhv;
+    register XPVHV* xpvhvend;
+    New(718, PL_xpvhv_root, 1008/sizeof(XPVHV), XPVHV);
+    xpvhv = PL_xpvhv_root;
+    xpvhvend = &xpvhv[1008 / sizeof(XPVHV) - 1];
+    while (xpvhv < xpvhvend) {
+	xpvhv->xhv_array = (char*)(xpvhv + 1);
+	xpvhv++;
+    }
+    xpvhv->xhv_array = 0;
+}
+
+
+STATIC XPVMG*
+S_new_xpvmg(pTHX)
+{
+    XPVMG* xpvmg;
+    LOCK_SV_MUTEX;
+    if (!PL_xpvmg_root)
+	more_xpvmg();
+    xpvmg = PL_xpvmg_root;
+    PL_xpvmg_root = (XPVMG*)xpvmg->xpv_pv;
+    UNLOCK_SV_MUTEX;
+    return xpvmg;
+}
+
+STATIC void
+S_del_xpvmg(pTHX_ XPVMG *p)
+{
+    LOCK_SV_MUTEX;
+    p->xpv_pv = (char*)PL_xpvmg_root;
+    PL_xpvmg_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
+
+STATIC void
+S_more_xpvmg(pTHX)
+{
+    register XPVMG* xpvmg;
+    register XPVMG* xpvmgend;
+    New(719, PL_xpvmg_root, 1008/sizeof(XPVMG), XPVMG);
+    xpvmg = PL_xpvmg_root;
+    xpvmgend = &xpvmg[1008 / sizeof(XPVMG) - 1];
+    while (xpvmg < xpvmgend) {
+	xpvmg->xpv_pv = (char*)(xpvmg + 1);
+	xpvmg++;
+    }
+    xpvmg->xpv_pv = 0;
+}
+
+
+
+STATIC XPVLV*
+S_new_xpvlv(pTHX)
+{
+    XPVLV* xpvlv;
+    LOCK_SV_MUTEX;
+    if (!PL_xpvlv_root)
+	more_xpvlv();
+    xpvlv = PL_xpvlv_root;
+    PL_xpvlv_root = (XPVLV*)xpvlv->xpv_pv;
+    UNLOCK_SV_MUTEX;
+    return xpvlv;
+}
+
+STATIC void
+S_del_xpvlv(pTHX_ XPVLV *p)
+{
+    LOCK_SV_MUTEX;
+    p->xpv_pv = (char*)PL_xpvlv_root;
+    PL_xpvlv_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
+
+STATIC void
+S_more_xpvlv(pTHX)
+{
+    register XPVLV* xpvlv;
+    register XPVLV* xpvlvend;
+    New(720, PL_xpvlv_root, 1008/sizeof(XPVLV), XPVLV);
+    xpvlv = PL_xpvlv_root;
+    xpvlvend = &xpvlv[1008 / sizeof(XPVLV) - 1];
+    while (xpvlv < xpvlvend) {
+	xpvlv->xpv_pv = (char*)(xpvlv + 1);
+	xpvlv++;
+    }
+    xpvlv->xpv_pv = 0;
+}
+
+
+STATIC XPVBM*
+S_new_xpvbm(pTHX)
+{
+    XPVBM* xpvbm;
+    LOCK_SV_MUTEX;
+    if (!PL_xpvbm_root)
+	more_xpvbm();
+    xpvbm = PL_xpvbm_root;
+    PL_xpvbm_root = (XPVBM*)xpvbm->xpv_pv;
+    UNLOCK_SV_MUTEX;
+    return xpvbm;
+}
+
+STATIC void
+S_del_xpvbm(pTHX_ XPVBM *p)
+{
+    LOCK_SV_MUTEX;
+    p->xpv_pv = (char*)PL_xpvbm_root;
+    PL_xpvbm_root = p;
+    UNLOCK_SV_MUTEX;
+}
+
+
+STATIC void
+S_more_xpvbm(pTHX)
+{
+    register XPVBM* xpvbm;
+    register XPVBM* xpvbmend;
+    New(721, PL_xpvbm_root, 1008/sizeof(XPVBM), XPVBM);
+    xpvbm = PL_xpvbm_root;
+    xpvbmend = &xpvbm[1008 / sizeof(XPVBM) - 1];
+    while (xpvbm < xpvbmend) {
+	xpvbm->xpv_pv = (char*)(xpvbm + 1);
+	xpvbm++;
+    }
+    xpvbm->xpv_pv = 0;
+}
+
 #ifdef PURIFY
 #define new_XIV() (void*)safemalloc(sizeof(XPVIV))
 #define del_XIV(p) Safefree((char*)p)
@@ -549,32 +836,73 @@ S_my_safemalloc(MEM_SIZE size)
 #  define my_safefree(s) Safefree(s)
 #endif 
 
-#define new_XPVIV() (void*)my_safemalloc(sizeof(XPVIV))
-#define del_XPVIV(p) my_safefree((char*)p)
-  
-#define new_XPVNV() (void*)my_safemalloc(sizeof(XPVNV))
-#define del_XPVNV(p) my_safefree((char*)p)
-  
-#define new_XPVMG() (void*)my_safemalloc(sizeof(XPVMG))
-#define del_XPVMG(p) my_safefree((char*)p)
-  
-#define new_XPVLV() (void*)my_safemalloc(sizeof(XPVLV))
-#define del_XPVLV(p) my_safefree((char*)p)
+#ifdef PURIFY
+#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
+#define del_XPVIV(p) Safefree((char*)p)
+#else
+#define new_XPVIV() (void*)new_xpviv()
+#define del_XPVIV(p) del_xpviv((XPVIV *)p)
+#endif
   
-#define new_XPVAV() (void*)my_safemalloc(sizeof(XPVAV))
-#define del_XPVAV(p) my_safefree((char*)p)
+#ifdef PURIFY
+#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
+#define del_XPVNV(p) Safefree((char*)p)
+#else
+#define new_XPVNV() (void*)new_xpvnv()
+#define del_XPVNV(p) del_xpvnv((XPVNV *)p)
+#endif
+
+
+#ifdef PURIFY
+#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
+#define del_XPVCV(p) Safefree((char*)p)
+#else
+#define new_XPVCV() (void*)new_xpvcv()
+#define del_XPVCV(p) del_xpvcv((XPVCV *)p)
+#endif
+
+#ifdef PURIFY
+#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
+#define del_XPVAV(p) Safefree((char*)p)
+#else
+#define new_XPVAV() (void*)new_xpvav()
+#define del_XPVAV(p) del_xpvav((XPVAV *)p)
+#endif
+
+#ifdef PURIFY
+#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
+#define del_XPVHV(p) Safefree((char*)p)
+#else
+#define new_XPVHV() (void*)new_xpvhv()
+#define del_XPVHV(p) del_xpvhv((XPVHV *)p)
+#endif
   
-#define new_XPVHV() (void*)my_safemalloc(sizeof(XPVHV))
-#define del_XPVHV(p) my_safefree((char*)p)
+#ifdef PURIFY
+#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
+#define del_XPVMG(p) Safefree((char*)p)
+#else
+#define new_XPVMG() (void*)new_xpvmg()
+#define del_XPVMG(p) del_xpvmg((XPVMG *)p)
+#endif
   
-#define new_XPVCV() (void*)my_safemalloc(sizeof(XPVCV))
-#define del_XPVCV(p) my_safefree((char*)p)
+#ifdef PURIFY
+#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
+#define del_XPVLV(p) Safefree((char*)p)
+#else
+#define new_XPVLV() (void*)new_xpvlv()
+#define del_XPVLV(p) del_xpvlv((XPVLV *)p)
+#endif
   
 #define new_XPVGV() (void*)my_safemalloc(sizeof(XPVGV))
 #define del_XPVGV(p) my_safefree((char*)p)
   
-#define new_XPVBM() (void*)my_safemalloc(sizeof(XPVBM))
-#define del_XPVBM(p) my_safefree((char*)p)
+#ifdef PURIFY
+#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
+#define del_XPVBM(p) Safefree((char*)p)
+#else
+#define new_XPVBM() (void*)new_xpvbm()
+#define del_XPVBM(p) del_xpvbm((XPVBM *)p)
+#endif
   
 #define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM))
 #define del_XPVFM(p) my_safefree((char*)p)
@@ -640,8 +968,8 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
 	pv	= (char*)SvRV(sv);
 	cur	= 0;
 	len	= 0;
-	iv	= (IV)pv;
-	nv	= (NV)(unsigned long)pv;
+	iv	= PTR2IV(pv);
+	nv	= PTR2NV(pv);
 	del_XRV(SvANY(sv));
 	magic	= 0;
 	stash	= 0;
@@ -1062,13 +1390,15 @@ S_not_a_number(pTHX_ SV *sv)
     *d = '\0';
 
     if (PL_op)
-	Perl_warner(aTHX_ WARN_NUMERIC, "Argument \"%s\" isn't numeric in %s", tmpbuf,
-		PL_op_name[PL_op->op_type]);
+	Perl_warner(aTHX_ WARN_NUMERIC,
+		    "Argument \"%s\" isn't numeric in %s", tmpbuf,
+		PL_op_desc[PL_op->op_type]);
     else
-	Perl_warner(aTHX_ WARN_NUMERIC, "Argument \"%s\" isn't numeric", tmpbuf);
+	Perl_warner(aTHX_ WARN_NUMERIC,
+		    "Argument \"%s\" isn't numeric", tmpbuf);
 }
 
-/* the number can be converted to _integer_ with atol() */
+/* the number can be converted to integer with atol() or atoll() */
 #define IS_NUMBER_TO_INT_BY_ATOL 0x01
 #define IS_NUMBER_TO_INT_BY_ATOF 0x02 /* atol() may be != atof() */
 #define IS_NUMBER_NOT_IV	 0x04 /* (IV)atof() may be != atof() */
@@ -1105,7 +1435,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	  SV* tmpstr;
 	  if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
 	      return SvIV(tmpstr);
-	  return (IV)SvRV(sv);
+	  return PTR2IV(SvRV(sv));
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    dTHR;
@@ -1125,7 +1455,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
     if (SvNOKp(sv)) {
 	/* We can cache the IV/UV value even if it not good enough
 	 * to reconstruct NV, since the conversion to PV will prefer
-	 * NV over IV/UV.				XXXX 64-bit?
+	 * NV over IV/UV.
 	 */
 
 	if (SvTYPE(sv) == SVt_NV)
@@ -1139,9 +1469,10 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    SvIsUV_on(sv);
 	  ret_iv_max:
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, 
-				  "0x%lx 2iv(%lu => %ld) (as unsigned)\n",
-				  (unsigned long)sv,
-				  (unsigned long)SvUVX(sv), (long)(IV)SvUVX(sv)));
+				  "0x%"UVxf" 2iv(%"UVuf" => %"IVdf") (as unsigned)\n",
+				  PTR2UV(sv),
+				  SvUVX(sv),
+				  SvUVX(sv)));
 	    return (IV)SvUVX(sv);
 	}
     }
@@ -1169,7 +1500,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    (void)SvNOK_on(sv);
 	    (void)SvIOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
 				  (unsigned long)sv, SvNVX(sv)));
 #else
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
@@ -1189,7 +1520,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
 	    if (SvTYPE(sv) == SVt_PV)
 		sv_upgrade(sv, SVt_PVIV);
 	    (void)SvIOK_on(sv);
-	    SvIVX(sv) = atol(SvPVX(sv)); /* XXXX 64-bit? */
+	    SvIVX(sv) = Atol(SvPVX(sv));
 	}
 	else {				/* Not a number.  Cache 0. */
 	    dTHR;
@@ -1243,7 +1574,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	  SV* tmpstr;
 	  if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
 	      return SvUV(tmpstr);
-	  return (UV)SvRV(sv);
+	  return PTR2UV(SvRV(sv));
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    dTHR;
@@ -1263,7 +1594,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
     if (SvNOKp(sv)) {
 	/* We can cache the IV/UV value even if it not good enough
 	 * to reconstruct NV, since the conversion to PV will prefer
-	 * NV over IV/UV.				XXXX 64-bit?
+	 * NV over IV/UV.
 	 */
 	if (SvTYPE(sv) == SVt_NV)
 	    sv_upgrade(sv, SVt_PVNV);
@@ -1276,9 +1607,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    SvIVX(sv) = I_V(SvNVX(sv));
 	  ret_zero:
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, 
-				  "0x%lx 2uv(%ld => %lu) (as signed)\n",
-				  (unsigned long)sv,(long)SvIVX(sv),
-				  (long)(UV)SvIVX(sv)));
+				  "0x%"UVxf" 2uv(%"IVdf" => %"IVdf") (as signed)\n",
+				  PTR2UV(sv),
+				  SvIVX(sv),
+				  (IV)(UV)SvIVX(sv)));
 	    return (UV)SvIVX(sv);
 	}
     }
@@ -1298,7 +1630,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	     * - otherwise future conversion to NV will be wrong.  */
 	    NV d;
 
-	    d = Atof(SvPVX(sv));	/* XXXX 64-bit? */
+	    d = Atof(SvPVX(sv));
 
 	    if (SvTYPE(sv) < SVt_PVNV)
 		sv_upgrade(sv, SVt_PVNV);
@@ -1306,7 +1638,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    (void)SvNOK_on(sv);
 	    (void)SvIOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
-	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
 				  (unsigned long)sv, SvNVX(sv)));
 #else
 	    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
@@ -1326,7 +1658,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    if (SvTYPE(sv) == SVt_PV)
 		sv_upgrade(sv, SVt_PVIV);
 	    (void)SvIOK_on(sv);
-	    SvIVX(sv) = (IV)atol(SvPVX(sv)); /* XXXX 64-bit? */
+	    SvIVX(sv) = (IV)Atol(SvPVX(sv));
 	}
 	else if (numtype) {		/* Non-negative */
 	    /* The NV may be reconstructed from UV - safe to cache UV,
@@ -1336,10 +1668,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
 	    (void)SvIOK_on(sv);
 	    (void)SvIsUV_on(sv);
 #ifdef HAS_STRTOUL
-	    SvUVX(sv) = strtoul(SvPVX(sv), Null(char**), 10); /* XXXX 64-bit? */
+	    SvUVX(sv) = Strtoul(SvPVX(sv), Null(char**), 10);
 #else			/* no atou(), but we know the number fits into IV... */
 	    		/* The only problem may be if it is negative... */
-	    SvUVX(sv) = (UV)atol(SvPVX(sv)); /* XXXX 64-bit? */
+	    SvUVX(sv) = (UV)Atol(SvPVX(sv));
 #endif
 	}
 	else {				/* Not a number.  Cache 0. */
@@ -1407,7 +1739,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 	  SV* tmpstr;
 	  if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
 	      return SvNV(tmpstr);
-	  return (NV)(unsigned long)SvRV(sv);
+	  return PTR2NV(SvRV(sv));
 	}
 	if (SvREADONLY(sv) && !SvOK(sv)) {
 	    dTHR;
@@ -1424,7 +1756,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #if defined(USE_LONG_DOUBLE)
 	DEBUG_c({
 	    RESTORE_NUMERIC_STANDARD();
-	    PerlIO_printf(Perl_debug_log, "0x%lx num(%Lg)\n",
+	    PerlIO_printf(Perl_debug_log, "0x%lx num(%" PERL_PRIgldbl ")\n",
 			  (unsigned long)sv, SvNVX(sv));
 	    RESTORE_NUMERIC_LOCAL();
 	});
@@ -1463,7 +1795,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #if defined(USE_LONG_DOUBLE)
     DEBUG_c({
 	RESTORE_NUMERIC_STANDARD();
-	PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+	PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
 		      (unsigned long)sv, SvNVX(sv));
 	RESTORE_NUMERIC_LOCAL();
     });
@@ -1485,7 +1817,7 @@ S_asIV(pTHX_ SV *sv)
     NV d;
 
     if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
-	return atol(SvPVX(sv));		/* XXXX 64-bit? */
+	return Atol(SvPVX(sv));
     if (!numtype) {
 	dTHR;
 	if (ckWARN(WARN_NUMERIC))
@@ -1502,7 +1834,7 @@ S_asUV(pTHX_ SV *sv)
 
 #ifdef HAS_STRTOUL
     if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
-	return strtoul(SvPVX(sv), Null(char**), 10);
+	return Strtoul(SvPVX(sv), Null(char**), 10);
 #endif
     if (!numtype) {
 	dTHR;
@@ -1528,8 +1860,6 @@ S_asUV(pTHX_ SV *sv)
 I32
 Perl_looks_like_number(pTHX_ SV *sv)
 {
-    /* XXXX 64-bit?  It may be not IS_NUMBER_TO_INT_BY_ATOL, but
-     * using atof() may lose precision. */
     register char *s;
     register char *send;
     register char *sbegin;
@@ -1683,16 +2013,16 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	    *lp = SvCUR(sv);
 	    return SvPVX(sv);
 	}
-	if (SvIOKp(sv)) {		/* XXXX 64-bit? */
+	if (SvIOKp(sv)) {
 	    if (SvIsUV(sv)) 
-		(void)sprintf(tmpbuf,"%lu",(unsigned long)SvUVX(sv));
+		(void)sprintf(tmpbuf,"%"UVuf, (UV)SvUVX(sv));
 	    else
-		(void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv));
+		(void)sprintf(tmpbuf,"%"IVdf, (IV)SvIVX(sv));
 	    tsv = Nullsv;
 	    goto tokensave;
 	}
 	if (SvNOKp(sv)) {
-	    Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
+	    Gconvert(SvNVX(sv), NV_DIG, 0, tmpbuf);
 	    tsv = Nullsv;
 	    goto tokensave;
 	}
@@ -1785,8 +2115,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 		    Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
 		else
 		    sv_setpv(tsv, s);
-		/* XXXX 64-bit? */
-		Perl_sv_catpvf(aTHX_ tsv, "(0x%lx)", (unsigned long)sv);
+		Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
 		goto tokensaveref;
 	    }
 	    *lp = strlen(s);
@@ -1802,6 +2131,9 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
     }
     if (SvNOKp(sv)) {			/* See note in sv_2uv() */
 	/* XXXX 64-bit?  IV may have better precision... */
+	/* I tried changing this for to be 64-bit-aware and
+	 * the t/op/numconvert.t became very, very, angry.
+	 * --jhi Sep 1999 */
 	if (SvTYPE(sv) < SVt_PVNV)
 	    sv_upgrade(sv, SVt_PVNV);
 	SvGROW(sv, 28);
@@ -1813,7 +2145,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 	else
 #endif /*apollo*/
 	{
-	    Gconvert(SvNVX(sv), DBL_DIG, 0, s);
+	    Gconvert(SvNVX(sv), NV_DIG, 0, s);
 	}
 	errno = olderrno;
 #ifdef FIXNEGATIVEZERO
@@ -2721,7 +3053,7 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type)
 	    MGVTBL* vtbl = mg->mg_virtual;
 	    *mgp = mg->mg_moremagic;
 	    if (vtbl && (vtbl->svt_free != NULL))
-		(VTBL->svt_free)(aTHX_ sv, mg);
+		CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
 	    if (mg->mg_ptr && mg->mg_type != 'g')
 		if (mg->mg_len >= 0)
 		    Safefree(mg->mg_ptr);
@@ -3694,7 +4026,7 @@ Perl_sv_inc(pTHX_ register SV *sv)
 	    IV i;
 	    if (SvAMAGIC(sv) && AMG_CALLun(sv,inc))
 		return;
-	    i = (IV)SvRV(sv);
+	    i = PTR2IV(SvRV(sv));
 	    sv_unref(sv);
 	    sv_setiv(sv, i);
 	}
@@ -3794,7 +4126,7 @@ Perl_sv_dec(pTHX_ register SV *sv)
 	    IV i;
 	    if (SvAMAGIC(sv) && AMG_CALLun(sv,dec))
 		return;
-	    i = (IV)SvRV(sv);
+	    i = PTR2IV(SvRV(sv));
 	    sv_unref(sv);
 	    sv_setiv(sv, i);
 	}
@@ -4014,7 +4346,7 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
     register I32 i;
     register PMOP *pm;
     register I32 max;
-    char todo[256];
+    char todo[PERL_UCHAR_MAX+1];
 
     if (!stash)
 	return;
@@ -4033,11 +4365,11 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
 
     Zero(todo, 256, char);
     while (*s) {
-	i = *s;
+	i = (unsigned char)*s;
 	if (s[1] == '-') {
 	    s += 2;
 	}
-	max = *s++;
+	max = (unsigned char)*s++;
 	for ( ; i <= max; i++) {
 	    todo[i] = 1;
 	}
@@ -4398,7 +4730,7 @@ Perl_sv_setref_pv(pTHX_ SV *rv, const char *classname, void *pv)
 	SvSETMAGIC(rv);
     }
     else
-	sv_setiv(newSVrv(rv,classname), (IV)pv);
+	sv_setiv(newSVrv(rv,classname), PTR2IV(pv));
     return rv;
 }
 
@@ -4648,14 +4980,14 @@ Perl_sv_vcatpvf_mg(pTHX_ SV *sv, const char* pat, va_list* args)
 }
 
 void
-Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale)
+Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
 {
     sv_setpvn(sv, "", 0);
-    sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale);
+    sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
 }
 
 void
-Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale)
+Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
 {
     dTHR;
     char *p;
@@ -4709,7 +5041,12 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
 	char *eptr = Nullch;
 	STRLEN elen = 0;
-	char ebuf[TYPE_DIGITS(int) * 2 + 16]; /* large enough for "%#.#f" */
+	/* Times 4: a decimal digit takes more than 3 binary digits.
+	 * NV_DIG: mantissa takes than many decimal digits.
+	 * Plus 32: Playing safe. */
+	char ebuf[IV_DIG * 4 + NV_DIG + 32];
+        /* large enough for "%#.#f" --chip */
+	/* what about long double NVs? --jhi */
 	char c;
 	int i;
 	unsigned base;
@@ -4802,16 +5139,24 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	/* SIZE */
 
 	switch (*q) {
+#ifdef HAS_QUAD
+	case 'L':			/* Ld */
+	case 'q':			/* qd */
+	    intsize = 'q';
+	    q++;
+	    break;
+#endif
 	case 'l':
-#if 0  /* when quads have better support within Perl */
-	    if (*(q + 1) == 'l') {
+#ifdef HAS_QUAD
+             if (*(q + 1) == 'l') {	/* lld */
 		intsize = 'q';
 		q += 2;
 		break;
-	    }
+	     }
 #endif
 	    /* FALL THROUGH */
 	case 'h':
+	    /* FALL THROUGH */
 	case 'V':
 	    intsize = *q++;
 	    break;
@@ -4891,14 +5236,18 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
 	case 'p':
 	    if (args)
-		uv = (UV)va_arg(*args, void*);
+		uv = PTR2UV(va_arg(*args, void*));
 	    else
-		uv = (svix < svmax) ? (UV)svargs[svix++] : 0;
+		uv = (svix < svmax) ? PTR2UV(svargs[svix++]) : 0;
 	    base = 16;
 	    goto integer;
 
 	case 'D':
+#ifdef IV_IS_QUAD
+	    intsize = 'q';
+#else
 	    intsize = 'l';
+#endif
 	    /* FALL THROUGH */
 	case 'd':
 	case 'i':
@@ -4908,6 +5257,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	iv = va_arg(*args, int); break;
 		case 'l':	iv = va_arg(*args, long); break;
 		case 'V':	iv = va_arg(*args, IV); break;
+#ifdef HAS_QUAD
+		case 'q':	iv = va_arg(*args, Quad_t); break;
+#endif
 		}
 	    }
 	    else {
@@ -4917,6 +5269,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	iv = (int)iv; break;
 		case 'l':	iv = (long)iv; break;
 		case 'V':	break;
+#ifdef HAS_QUAD
+		case 'q':	iv = (Quad_t)iv; break;
+#endif
 		}
 	    }
 	    if (iv >= 0) {
@@ -4932,7 +5287,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    goto integer;
 
 	case 'U':
+#ifdef IV_IS_QUAD
+	    intsize = 'q';
+#else
 	    intsize = 'l';
+#endif
 	    /* FALL THROUGH */
 	case 'u':
 	    base = 10;
@@ -4943,7 +5302,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    goto uns_integer;
 
 	case 'O':
+#ifdef IV_IS_QUAD
+	    intsize = 'q';
+#else
 	    intsize = 'l';
+#endif
 	    /* FALL THROUGH */
 	case 'o':
 	    base = 8;
@@ -4960,6 +5323,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:   uv = va_arg(*args, unsigned); break;
 		case 'l':  uv = va_arg(*args, unsigned long); break;
 		case 'V':  uv = va_arg(*args, UV); break;
+#ifdef HAS_QUAD
+		case 'q':  uv = va_arg(*args, Quad_t); break;
+#endif
 		}
 	    }
 	    else {
@@ -4969,6 +5335,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	uv = (unsigned)uv; break;
 		case 'l':	uv = (unsigned long)uv; break;
 		case 'V':	break;
+#ifdef HAS_QUAD
+		case 'q':	uv = (Quad_t)uv; break;
+#endif
 		}
 	    }
 
@@ -5002,10 +5371,25 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		    dig = uv & 1;
 		    *--eptr = '0' + dig;
 		} while (uv >>= 1);
-		if (alt && *eptr != '0')
-		    *--eptr = '0';
+		if (alt) {
+		    esignbuf[esignlen++] = '0';
+		    esignbuf[esignlen++] = 'b';
+		}
 		break;
 	    default:		/* it had better be ten or less */
+#if defined(PERL_Y2KWARN)
+		if (ckWARN(WARN_MISC)) {
+		    STRLEN n;
+		    char *s = SvPV(sv,n);
+		    if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
+			&& (n == 2 || !isDIGIT(s[n-3])))
+		    {
+			Perl_warner(aTHX_ WARN_MISC,
+				    "Possible Y2K bug: %%%c %s",
+				    c, "format string following '19'");
+		    }
+		}
+#endif
 		do {
 		    dig = uv % base;
 		    *--eptr = '0' + dig;
@@ -5055,13 +5439,17 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		Safefree(PL_efloatbuf);
 		PL_efloatsize = need + 20; /* more fudge */
 		New(906, PL_efloatbuf, PL_efloatsize, char);
+		PL_efloatbuf[0] = '\0';
 	    }
 
 	    eptr = ebuf + sizeof ebuf;
 	    *--eptr = '\0';
 	    *--eptr = c;
 #ifdef USE_LONG_DOUBLE
-	    *--eptr = 'L';
+	    {
+		char* p = PERL_PRIfldbl + sizeof(PERL_PRIfldbl) - 3;
+		while (p >= PERL_PRIfldbl) { *--eptr = *p--; }
+	    }
 #endif
 	    if (has_precis) {
 		base = precis;
@@ -5091,15 +5479,36 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    eptr = PL_efloatbuf;
 	    elen = strlen(PL_efloatbuf);
 
-#ifdef LC_NUMERIC
+#ifdef USE_LOCALE_NUMERIC
 	    /*
 	     * User-defined locales may include arbitrary characters.
-	     * And, unfortunately, some system may alloc the "C" locale
-	     * to be overridden by a malicious user.
+	     * And, unfortunately, some (broken) systems may allow the
+	     * "C" locale to be overridden by a malicious user.
+	     * XXX This is an extreme way to cope with broken systems.
 	     */
-	    if (used_locale)
-		*used_locale = TRUE;
-#endif /* LC_NUMERIC */
+	    if (maybe_tainted && PL_tainting) {
+		/* safe if it matches /[-+]?\d*(\.\d*)?([eE][-+]?\d*)?/ */
+		if (*eptr == '-' || *eptr == '+')
+		    ++eptr;
+		while (isDIGIT(*eptr))
+		    ++eptr;
+		if (*eptr == '.') {
+		    ++eptr;
+		    while (isDIGIT(*eptr))
+			++eptr;
+		}
+		if (*eptr == 'e' || *eptr == 'E') {
+		    ++eptr;
+		    if (*eptr == '-' || *eptr == '+')
+			++eptr;
+		    while (isDIGIT(*eptr))
+			++eptr;
+		}
+		if (*eptr)
+		    *maybe_tainted = TRUE;	/* results are suspect */
+		eptr = PL_efloatbuf;
+	    }
+#endif /* USE_LOCALE_NUMERIC */
 
 	    break;
 
@@ -5113,6 +5522,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		default:	*(va_arg(*args, int*)) = i; break;
 		case 'l':	*(va_arg(*args, long*)) = i; break;
 		case 'V':	*(va_arg(*args, IV*)) = i; break;
+#ifdef HAS_QUAD
+		case 'q':	*(va_arg(*args, Quad_t*)) = i; break;
+#endif
 		}
 	    }
 	    else if (svix < svmax)
@@ -5128,10 +5540,15 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		SV *msg = sv_newmortal();
 		Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %s: ",
 			  (PL_op->op_type == OP_PRTF) ? "printf" : "sprintf");
-		if (c)
-		    Perl_sv_catpvf(aTHX_ msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"",
-			      c & 0xFF);
-		else
+		if (c) {
+		    if (isPRINT(c))
+			Perl_sv_catpvf(aTHX_ msg, 
+				       "\"%%%c\"", c & 0xFF);
+		    else
+			Perl_sv_catpvf(aTHX_ msg,
+				       "\"%%\\%03"UVof"\"",
+				       (UV)c & 0xFF);
+		} else
 		    sv_catpv(msg, "end of string");
 		Perl_warner(aTHX_ WARN_PRINTF, "%_", msg); /* yes, this is reentrant */
 	    }
@@ -5197,8 +5614,7 @@ static void
 do_report_used(pTHXo_ SV *sv)
 {
     if (SvTYPE(sv) != SVTYPEMASK) {
-	/* XXX Perhaps this ought to go to Perl_debug_log, if DEBUGGING. */
-	PerlIO_printf(PerlIO_stderr(), "****\n");
+	PerlIO_printf(Perl_debug_log, "****\n");
 	sv_dump(sv);
     }
 }