Upgrade to Pod-Simple-3.04

[p5sagit/p5-mst-13.2.git] / sv.c

diff --git a/sv.c b/sv.c
index d32bd99..60237b6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -177,6 +177,7 @@ Public API:
 void
 Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size)
 {
+    dVAR;
     void *new_chunk;
     U32 new_chunk_size;
     LOCK_SV_MUTEX;
@@ -236,6 +237,7 @@ Perl_offer_nice_chunk(pTHX_ void *chunk, U32 chunk_size)
 STATIC SV*
 S_more_sv(pTHX)
 {
+    dVAR;
     SV* sv;
 
     if (PL_nice_chunk) {
@@ -314,6 +316,7 @@ S_new_SV(pTHX)
 STATIC void
 S_del_sv(pTHX_ SV *p)
 {
+    dVAR;
     if (DEBUG_D_TEST) {
        SV* sva;
        bool ok = 0;
@@ -357,6 +360,7 @@ and split it into a list of free SVs.
 void
 Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 {
+    dVAR;
     SV* const sva = (SV*)ptr;
     register SV* sv;
     register SV* svend;
@@ -394,6 +398,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 STATIC I32
 S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask)
 {
+    dVAR;
     SV* sva;
     I32 visited = 0;
 
@@ -448,6 +453,7 @@ Perl_sv_report_used(pTHX)
 static void
 do_clean_objs(pTHX_ SV *ref)
 {
+    dVAR;
     if (SvROK(ref)) {
        SV * const target = SvRV(ref);
        if (SvOBJECT(target)) {
@@ -473,6 +479,7 @@ do_clean_objs(pTHX_ SV *ref)
 static void
 do_clean_named_objs(pTHX_ SV *sv)
 {
+    dVAR;
     if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) {
        if ((
 #ifdef PERL_DONT_CREATE_GVSV
@@ -503,6 +510,7 @@ Attempt to destroy all objects not yet freed
 void
 Perl_sv_clean_objs(pTHX)
 {
+    dVAR;
     PL_in_clean_objs = TRUE;
     visit(do_clean_objs, SVf_ROK, SVf_ROK);
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
@@ -517,6 +525,7 @@ Perl_sv_clean_objs(pTHX)
 static void
 do_clean_all(pTHX_ SV *sv)
 {
+    dVAR;
     DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
     SvFLAGS(sv) |= SVf_BREAK;
     if (PL_comppad == (AV*)sv) {
@@ -539,6 +548,7 @@ SVs which are in complex self-referential hierarchies.
 I32
 Perl_sv_clean_all(pTHX)
 {
+    dVAR;
     I32 cleaned;
     PL_in_clean_all = TRUE;
     cleaned = visit(do_clean_all, 0,0);
@@ -573,6 +583,7 @@ heads and bodies within the arenas must already have been freed.
 void
 Perl_sv_free_arenas(pTHX)
 {
+    dVAR;
     SV* sva;
     SV* svanext;
     int i;
@@ -640,6 +651,7 @@ Perl_sv_free_arenas(pTHX)
 STATIC void *
 S_more_bodies (pTHX_ size_t size, svtype sv_type)
 {
+    dVAR;
     void ** const arena_root   = &PL_body_arenaroots[sv_type];
     void ** const root         = &PL_body_roots[sv_type];
     char *start;
@@ -693,6 +705,7 @@ S_more_bodies (pTHX_ size_t size, svtype sv_type)
 STATIC void *
 S_new_body(pTHX_ size_t size, svtype sv_type)
 {
+    dVAR;
     void *xpv;
     new_body_inline(xpv, size, sv_type);
     return xpv;
@@ -930,6 +943,7 @@ You generally want to use the C<SvUPGRADE> macro wrapper. See also C<svtype>.
 void
 Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
 {
+    dVAR;
     void*      old_body;
     void*      new_body;
     const U32  old_type = SvTYPE(sv);
@@ -1076,14 +1090,14 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
 
        /* Could put this in the else clause below, as PVMG must have SvPVX
           0 already (the assertion above)  */
-       SvPV_set(sv, (char*)0);
+       SvPV_set(sv, NULL);
 
        if (old_type >= SVt_PVMG) {
            SvMAGIC_set(sv, ((XPVMG*)old_body)->xmg_magic);
            SvSTASH_set(sv, ((XPVMG*)old_body)->xmg_stash);
        } else {
-           SvMAGIC_set(sv, 0);
-           SvSTASH_set(sv, 0);
+           SvMAGIC_set(sv, NULL);
+           SvSTASH_set(sv, NULL);
        }
        break;
 
@@ -1124,18 +1138,22 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
 
 #ifndef NV_ZERO_IS_ALLBITS_ZERO
        /* If NV 0.0 is stores as all bits 0 then Zero() already creates a
-        * correct 0.0 for us. */
-       if (old_type_details->zero_nv)
+        * correct 0.0 for us.  Otherwise, if the old body didn't have an
+        * NV slot, but the new one does, then we need to initialise the
+        * freshly created NV slot with whatever the correct bit pattern is
+        * for 0.0  */
+       if (old_type_details->zero_nv && !new_type_details->zero_nv)
            SvNV_set(sv, 0);
 #endif
 
        if (new_type == SVt_PVIO)
            IoPAGE_LEN(sv) = 60;
        if (old_type < SVt_RV)
-           SvPV_set(sv, 0);
+           SvPV_set(sv, NULL);
        break;
     default:
-       Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu", new_type);
+       Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",
+                  (unsigned long)new_type);
     }
 
     if (old_type_details->size) {
@@ -1252,6 +1270,7 @@ Does not handle 'set' magic.  See also C<sv_setiv_mg>.
 void
 Perl_sv_setiv(pTHX_ register SV *sv, IV i)
 {
+    dVAR;
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -1352,6 +1371,7 @@ Does not handle 'set' magic.  See also C<sv_setnv_mg>.
 void
 Perl_sv_setnv(pTHX_ register SV *sv, NV num)
 {
+    dVAR;
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -1400,12 +1420,13 @@ Perl_sv_setnv_mg(pTHX_ register SV *sv, NV num)
 STATIC void
 S_not_a_number(pTHX_ SV *sv)
 {
+     dVAR;
      SV *dsv;
      char tmpbuf[64];
      const char *pv;
 
      if (DO_UTF8(sv)) {
-          dsv = sv_2mortal(newSVpvn("", 0));
+          dsv = sv_2mortal(newSVpvs(""));
           pv = sv_uni_display(dsv, sv, 10, 0);
      } else {
          char *d = tmpbuf;
@@ -1581,6 +1602,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
 STATIC int
 S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
 {
+    dVAR;
     DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%"NVgf" inttype=%"UVXf"\n", SvPVX_const(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
     if (SvNVX(sv) < (NV)IV_MIN) {
        (void)SvIOKp_on(sv);
@@ -1627,6 +1649,7 @@ S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
 
 STATIC bool
 S_sv_2iuv_common(pTHX_ SV *sv) {
+    dVAR;
     if (SvNOKp(sv)) {
        /* erm. not sure. *should* never get NOKp (without NOK) from sv_2nv
         * without also getting a cached IV/UV from it at the same time
@@ -1878,6 +1901,7 @@ Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
 IV
 Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
 {
+    dVAR;
     if (!sv)
        return 0;
     if (SvGMAGICAL(sv)) {
@@ -1957,6 +1981,7 @@ Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
 UV
 Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
 {
+    dVAR;
     if (!sv)
        return 0;
     if (SvGMAGICAL(sv)) {
@@ -2031,6 +2056,7 @@ macros.
 NV
 Perl_sv_2nv(pTHX_ register SV *sv)
 {
+    dVAR;
     if (!sv)
        return 0.0;
     if (SvGMAGICAL(sv)) {
@@ -2260,6 +2286,7 @@ S_uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
 
 static char *
 S_stringify_regexp(pTHX_ SV *sv, MAGIC *mg, STRLEN *lp) {
+    dVAR;
     const regexp * const re = (regexp *)mg->mg_obj;
 
     if (!mg->mg_ptr) {
@@ -2349,6 +2376,7 @@ usually end up here too.
 char *
 Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 {
+    dVAR;
     register char *s;
 
     if (!sv) {
@@ -2449,7 +2477,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                const SV *const referent = (SV*)SvRV(sv);
 
                if (!referent) {
-                   tsv = sv_2mortal(newSVpvn("NULLREF", 7));
+                   tsv = sv_2mortal(newSVpvs("NULLREF"));
                } else if (SvTYPE(referent) == SVt_PVMG
                           && ((SvFLAGS(referent) &
                                (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
@@ -2635,6 +2663,7 @@ sv_true() or its macro equivalent.
 bool
 Perl_sv_2bool(pTHX_ register SV *sv)
 {
+    dVAR;
     SvGETMAGIC(sv);
 
     if (!SvOK(sv))
@@ -2698,6 +2727,7 @@ use the Encode extension for that.
 STRLEN
 Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
 {
+    dVAR;
     if (sv == &PL_sv_undef)
        return 0;
     if (!SvPOK(sv)) {
@@ -2767,6 +2797,7 @@ use the Encode extension for that.
 bool
 Perl_sv_utf8_downgrade(pTHX_ register SV* sv, bool fail_ok)
 {
+    dVAR;
     if (SvPOKp(sv) && SvUTF8(sv)) {
         if (SvCUR(sv)) {
            U8 *s;
@@ -2897,6 +2928,7 @@ copy-ish functions and macros use this underneath.
 void
 Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 {
+    dVAR;
     register U32 sflags;
     register int dtype;
     register int stype;
@@ -3362,7 +3394,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 
                 SvTEMP_off(dstr);
                 (void)SvOK_off(sstr);  /* NOTE: nukes most SvFLAGS on sstr */
-                SvPV_set(sstr, Nullch);
+                SvPV_set(sstr, NULL);
                 SvLEN_set(sstr, 0);
                 SvCUR_set(sstr, 0);
                 SvTEMP_off(sstr);
@@ -3528,6 +3560,7 @@ undefined.  Does not handle 'set' magic.  See C<sv_setpvn_mg>.
 void
 Perl_sv_setpvn(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 {
+    dVAR;
     register char *dptr;
 
     SV_CHECK_THINKFIRST_COW_DROP(sv);
@@ -3578,6 +3611,7 @@ handle 'set' magic.  See C<sv_setpv_mg>.
 void
 Perl_sv_setpv(pTHX_ register SV *sv, register const char *ptr)
 {
+    dVAR;
     register STRLEN len;
 
     SV_CHECK_THINKFIRST_COW_DROP(sv);
@@ -3627,6 +3661,7 @@ See C<sv_usepvn_mg>.
 void
 Perl_sv_usepvn(pTHX_ register SV *sv, register char *ptr, register STRLEN len)
 {
+    dVAR;
     STRLEN allocate;
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     SvUPGRADE(sv, SVt_PV);
@@ -3728,6 +3763,7 @@ with flags set to 0.
 void
 Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
 {
+    dVAR;
 #ifdef PERL_OLD_COPY_ON_WRITE
     if (SvREADONLY(sv)) {
         /* At this point I believe I should acquire a global SV mutex.  */
@@ -3745,7 +3781,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
             SvFAKE_off(sv);
             SvREADONLY_off(sv);
             /* This SV doesn't own the buffer, so need to Newx() a new one:  */
-            SvPV_set(sv, (char*)0);
+            SvPV_set(sv, NULL);
             SvLEN_set(sv, 0);
             if (flags & SV_COW_DROP_PV) {
                 /* OK, so we don't need to copy our buffer.  */
@@ -3857,6 +3893,7 @@ in terms of this function.
 void
 Perl_sv_catpvn_flags(pTHX_ register SV *dsv, register const char *sstr, register STRLEN slen, I32 flags)
 {
+    dVAR;
     STRLEN dlen;
     const char * const dstr = SvPV_force_flags(dsv, dlen, flags);
 
@@ -3891,6 +3928,7 @@ and C<sv_catsv_nomg> are implemented in terms of this function.
 void
 Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags)
 {
+    dVAR;
     if (ssv) {
        STRLEN slen;
        const char *spv = SvPV_const(ssv, slen);
@@ -3939,6 +3977,7 @@ valid UTF-8.  Handles 'get' magic, but not 'set' magic.  See C<sv_catpv_mg>.
 void
 Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr)
 {
+    dVAR;
     register STRLEN len;
     STRLEN tlen;
     char *junk;
@@ -3974,9 +4013,16 @@ Perl_sv_catpv_mg(pTHX_ register SV *sv, register const char *ptr)
 /*
 =for apidoc newSV
 
-Create a new null SV, or if len > 0, create a new empty SVt_PV type SV
-with an initial PV allocation of len+1. Normally accessed via the C<NEWSV>
-macro.
+Creates a new SV.  A non-zero C<len> parameter indicates the number of
+bytes of preallocated string space the SV should have.  An extra byte for a
+trailing NUL is also reserved.  (SvPOK is not set for the SV even if string
+space is allocated.)  The reference count for the new SV is set to 1.
+
+In 5.9.3, newSV() replaces the older NEWSV() API, and drops the first
+parameter, I<x>, a debug aid which allowed callers to identify themselves.
+This aid has been superseded by a new build option, PERL_MEM_LOG (see
+L<perlhack/PERL_MEM_LOG>).  The older API is still there for use in XS
+modules supporting older perls.
 
 =cut
 */
@@ -3984,6 +4030,7 @@ macro.
 SV *
 Perl_newSV(pTHX_ STRLEN len)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -4013,9 +4060,10 @@ to contain an C<SV*> and is stored as-is with its REFCNT incremented.
 =cut
 */
 MAGIC *        
-Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
+Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
                 const char* name, I32 namlen)
 {
+    dVAR;
     MAGIC* mg;
 
     if (SvTYPE(sv) < SVt_PVMG) {
@@ -4100,7 +4148,8 @@ to add more than one instance of the same 'how'.
 void
 Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 namlen)
 {
-    const MGVTBL *vtable;
+    dVAR;
+    MGVTBL *vtable;
     MAGIC* mg;
 
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -4350,6 +4399,7 @@ Perl_sv_rvweaken(pTHX_ SV *sv)
 void
 Perl_sv_add_backref(pTHX_ SV *tsv, SV *sv)
 {
+    dVAR;
     AV *av;
 
     if (SvTYPE(tsv) == SVt_PVHV) {
@@ -4403,6 +4453,7 @@ Perl_sv_add_backref(pTHX_ SV *tsv, SV *sv)
 STATIC void
 S_sv_del_backref(pTHX_ SV *tsv, SV *sv)
 {
+    dVAR;
     AV *av = NULL;
     SV **svp;
     I32 i;
@@ -4502,6 +4553,7 @@ the Perl substr() function.
 void
 Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little, STRLEN littlelen)
 {
+    dVAR;
     register char *big;
     register char *mid;
     register char *midend;
@@ -4599,6 +4651,7 @@ time you'll want to use C<sv_setsv> or one of its many macro front-ends.
 void
 Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
 {
+    dVAR;
     const U32 refcnt = SvREFCNT(sv);
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     if (SvREFCNT(nsv) != 1) {
@@ -5385,6 +5438,7 @@ coerce its args to strings if necessary.
 I32
 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
 {
+    dVAR;
     const char *pv1;
     STRLEN cur1;
     const char *pv2;
@@ -5480,6 +5534,7 @@ coerce its args to strings if necessary.  See also C<sv_cmp_locale>.
 I32
 Perl_sv_cmp(pTHX_ register SV *sv1, register SV *sv2)
 {
+    dVAR;
     STRLEN cur1, cur2;
     const char *pv1, *pv2;
     char *tpv = Nullch;
@@ -5563,6 +5618,7 @@ if necessary.  See also C<sv_cmp_locale>.  See also C<sv_cmp>.
 I32
 Perl_sv_cmp_locale(pTHX_ register SV *sv1, register SV *sv2)
 {
+    dVAR;
 #ifdef USE_LOCALE_COLLATE
 
     char *pv1, *pv2;
@@ -5627,6 +5683,7 @@ settings.
 char *
 Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp)
 {
+    dVAR;
     MAGIC *mg;
 
     mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_collxfrm) : (MAGIC *) NULL;
@@ -5683,6 +5740,7 @@ appending to the currently-stored string.
 char *
 Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 {
+    dVAR;
     const char *rsptr;
     STRLEN rslen;
     register STDCHAR rslast;
@@ -5710,7 +5768,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
                sv_pos_u2b(sv,&append,0);
            }
        } else if (SvUTF8(sv)) {
-           SV * const tsv = NEWSV(0,0);
+           SV * const tsv = newSV(0);
            sv_gets(tsv, fp, 0);
            sv_utf8_upgrade_nomg(tsv);
            SvCUR_set(sv,append);
@@ -6038,6 +6096,7 @@ if necessary. Handles 'get' magic.
 void
 Perl_sv_inc(pTHX_ register SV *sv)
 {
+    dVAR;
     register char *d;
     int flags;
 
@@ -6194,6 +6253,7 @@ if necessary. Handles 'get' magic.
 void
 Perl_sv_dec(pTHX_ register SV *sv)
 {
+    dVAR;
     int flags;
 
     if (!sv)
@@ -6310,6 +6370,7 @@ statement boundaries.  See also C<sv_newmortal> and C<sv_2mortal>.
 SV *
 Perl_sv_mortalcopy(pTHX_ SV *oldstr)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6334,6 +6395,7 @@ See also C<sv_mortalcopy> and C<sv_2mortal>.
 SV *
 Perl_sv_newmortal(pTHX)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6382,6 +6444,7 @@ strlen().  For efficiency, consider using C<newSVpvn> instead.
 SV *
 Perl_newSVpv(pTHX_ const char *s, STRLEN len)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6403,6 +6466,7 @@ C<len> bytes long.  If the C<s> argument is NULL the new SV will be undefined.
 SV *
 Perl_newSVpvn(pTHX_ const char *s, STRLEN len)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6424,6 +6488,7 @@ SV if the hek is NULL.
 SV *
 Perl_newSVhek(pTHX_ const HEK *hek)
 {
+    dVAR;
     if (!hek) {
        SV *sv;
 
@@ -6482,6 +6547,7 @@ hash lookup will avoid string compare.
 SV *
 Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
 {
+    dVAR;
     register SV *sv;
     bool is_utf8 = FALSE;
     if (len < 0) {
@@ -6552,6 +6618,7 @@ Perl_newSVpvf(pTHX_ const char* pat, ...)
 SV *
 Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args)
 {
+    dVAR;
     register SV *sv;
     new_SV(sv);
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
@@ -6570,6 +6637,7 @@ The reference count for the SV is set to 1.
 SV *
 Perl_newSVnv(pTHX_ NV n)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6589,6 +6657,7 @@ SV is set to 1.
 SV *
 Perl_newSViv(pTHX_ IV i)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6608,6 +6677,7 @@ The reference count for the SV is set to 1.
 SV *
 Perl_newSVuv(pTHX_ UV u)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6627,6 +6697,7 @@ SV is B<not> incremented.
 SV *
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6644,6 +6715,7 @@ Perl_newRV_noinc(pTHX_ SV *tmpRef)
 SV *
 Perl_newRV(pTHX_ SV *tmpRef)
 {
+    dVAR;
     return newRV_noinc(SvREFCNT_inc(tmpRef));
 }
 
@@ -6659,6 +6731,7 @@ Creates a new SV which is an exact duplicate of the original SV.
 SV *
 Perl_newSVsv(pTHX_ register SV *old)
 {
+    dVAR;
     register SV *sv;
 
     if (!old)
@@ -6885,7 +6958,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
        if (lref && !GvCVu(gv)) {
            SV *tmpsv;
            ENTER;
-           tmpsv = NEWSV(704,0);
+           tmpsv = newSV(0);
            gv_efullname3(tmpsv, gv, Nullch);
            /* XXX this is probably not what they think they're getting.
             * It has the same effect as "sub name;", i.e. just a forward
@@ -6961,7 +7034,7 @@ C<SvPV_force> and C<SvPV_force_nomg>
 char *
 Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
 {
-
+    dVAR;
     if (SvTHINKFIRST(sv) && !SvROK(sv))
         sv_force_normal_flags(sv, 0);
 
@@ -7159,6 +7232,7 @@ reference count is 1.
 SV*
 Perl_newSVrv(pTHX_ SV *rv, const char *classname)
 {
+    dVAR;
     SV *sv;
 
     new_SV(sv);
@@ -7214,6 +7288,7 @@ Note that C<sv_setref_pvn> copies the string while this copies the pointer.
 SV*
 Perl_sv_setref_pv(pTHX_ SV *rv, const char *classname, void *pv)
 {
+    dVAR;
     if (!pv) {
        sv_setsv(rv, &PL_sv_undef);
        SvSETMAGIC(rv);
@@ -7315,6 +7390,7 @@ of the SV is unaffected.
 SV*
 Perl_sv_bless(pTHX_ SV *sv, HV *stash)
 {
+    dVAR;
     SV *tmpRef;
     if (!SvROK(sv))
         Perl_croak(aTHX_ "Can't bless non-reference value");
@@ -7354,6 +7430,7 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
 STATIC void
 S_sv_unglob(pTHX_ SV *sv)
 {
+    dVAR;
     void *xpvmg;
 
     assert(SvTYPE(sv) == SVt_PVGV);
@@ -7711,6 +7788,7 @@ Perl_sv_vsetpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 STATIC I32
 S_expect_number(pTHX_ char** pattern)
 {
+    dVAR;
     I32 var = 0;
     switch (**pattern) {
     case '1': case '2': case '3':
@@ -7778,6 +7856,7 @@ Usually used via one of its frontends C<sv_vcatpvf> and C<sv_vcatpvf_mg>.
 void
 Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *maybe_tainted)
 {
+    dVAR;
     char *p;
     char *q;
     const char *patend;
@@ -8095,6 +8174,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                 */
                if (sv_derived_from(vecsv, "version")) {
                    char *version = savesvpv(vecsv);
+                   if ( hv_exists((HV*)SvRV(vecsv), "alpha", 5 ) ) {
+                       Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+                       "vector argument not supported with alpha versions");
+                       goto unknown;
+                   }
                    vecsv = sv_newmortal();
                    /* scan_vstring is expected to be called during
                     * tokenization, so we need to fake up the end
@@ -8730,7 +8814,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                                       "\"%%\\%03"UVof"\"",
                                       (UV)c & 0xFF);
                } else
-                   sv_catpv(msg, "end of string");
+                   sv_catpvs(msg, "end of string");
                Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, msg); /* yes, this is reentrant */
            }
 
@@ -8862,8 +8946,8 @@ ptr_table_* functions.
 #define io_dup_inc(s,t)        (IO*)SvREFCNT_inc(sv_dup((SV*)s,t))
 #define gv_dup(s,t)    (GV*)sv_dup((SV*)s,t)
 #define gv_dup_inc(s,t)        (GV*)SvREFCNT_inc(sv_dup((SV*)s,t))
-#define SAVEPV(p)      (p ? savepv(p) : Nullch)
-#define SAVEPVN(p,n)   (p ? savepvn(p,n) : Nullch)
+#define SAVEPV(p)      ((p) ? savepv(p) : NULL)
+#define SAVEPVN(p,n)   ((p) ? savepvn(p,n) : NULL)
 
 
 /* Duplicate a regexp. Required reading: pregcomp() and pregfree() in
@@ -9295,7 +9379,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
        if (SvTYPE(dstr) == SVt_RV)
            SvRV_set(dstr, NULL);
        else
-           SvPV_set(dstr, 0);
+           SvPV_set(dstr, NULL);
     }
 }
 
@@ -9308,7 +9392,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
     SV *dstr;
 
     if (!sstr || SvTYPE(sstr) == SVTYPEMASK)
-       return Nullsv;
+       return NULL;
     /* look for it in the table first */
     dstr = (SV*)ptr_table_fetch(PL_ptr_table, sstr);
     if (dstr)
@@ -10567,7 +10651,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_linestart    = SvPVX(PL_linestr) + (i < 0 ? 0 : i);
     }
     else {
-        PL_linestr = NEWSV(65,79);
+        PL_linestr = newSV(79);
         sv_upgrade(PL_linestr,SVt_PVIV);
         sv_setpvn(PL_linestr,"",0);
        PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
@@ -10774,7 +10858,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
         * orphaned
         */
        for (i = 0; i<= proto_perl->Ttmps_ix; i++) {
-           SV *nsv = (SV*)ptr_table_fetch(PL_ptr_table,
+           SV * const nsv = (SV*)ptr_table_fetch(PL_ptr_table,
                    proto_perl->Ttmps_stack[i]);
            if (nsv && !SvREFCNT(nsv)) {
                EXTEND_MORTAL(1);
@@ -11097,6 +11181,7 @@ S_find_hash_subscript(pTHX_ HV *hv, SV* val)
 STATIC I32
 S_find_array_subscript(pTHX_ AV *av, SV* val)
 {
+    dVAR;
     SV** svp;
     I32 i;
     if (!av || SvMAGICAL(av) || !AvARRAY(av) ||
@@ -11161,7 +11246,7 @@ S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ,
     }
 
     if (subscript_type == FUV_SUBSCRIPT_HASH) {
-       SV * const sv = NEWSV(0,0);
+       SV * const sv = newSV(0);
        *SvPVX(name) = '$';
        Perl_sv_catpvf(aTHX_ name, "{%s}",
            pv_display(sv,SvPVX_const(keyname), SvCUR(keyname), 0, 32));
@@ -11172,7 +11257,7 @@ S_varname(pTHX_ GV *gv, const char gvtype, PADOFFSET targ,
        Perl_sv_catpvf(aTHX_ name, "[%"IVdf"]", (IV)aindex);
     }
     else if (subscript_type == FUV_SUBSCRIPT_WITHIN)
-       sv_insert(name, 0, 0,  "within ", 7);
+       Perl_sv_insert(aTHX_ name, 0, 0,  STR_WITH_LEN("within "));
 
     return name;
 }
@@ -11446,7 +11531,7 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
     case OP_SCHOMP:
     case OP_CHOMP:
        if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))
-           return sv_2mortal(newSVpvn("${$/}", 5));
+           return sv_2mortal(newSVpvs("${$/}"));
        /* FALL THROUGH */
 
     default:
@@ -11503,6 +11588,7 @@ Print appropriate "Use of uninitialized variable" warning
 void
 Perl_report_uninit(pTHX_ SV* uninit_sv)
 {
+    dVAR;
     if (PL_op) {
        SV* varname = Nullsv;
        if (uninit_sv) {