POSIX and Fcntl both export the same constants derived from the same

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

diff --git a/sv.c b/sv.c
index cb3e193..b2cd1d8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1,7 +1,7 @@
 /*    sv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -125,7 +125,7 @@ following functions (specified as [function that calls visit()] / [function
 called by visit() for each SV]):
 
     sv_report_used() / do_report_used()
-                       dump all remaining SVs (debugging aid)
+                       dump all remaining SVs (debugging aid)
 
     sv_clean_objs() / do_clean_objs(),do_clean_named_objs()
                        Attempt to free all objects pointed to by RVs,
@@ -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);
@@ -1123,19 +1137,23 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
        }
 
 #ifndef NV_ZERO_IS_ALLBITS_ZERO
-    /* If NV 0.0 is store as all bits 0 then Zero() already creates a correct
-       0.0 for us.  */
-       if (old_type_details->zero_nv)
+       /* If NV 0.0 is stores as all bits 0 then Zero() already creates a
+        * 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;
+           IoPAGE_LEN(sv) = 60;
        if (old_type < SVt_RV)
            SvPV_set(sv, 0);
        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
@@ -1727,7 +1750,7 @@ S_sv_2iuv_common(pTHX_ SV *sv) {
        } else if (SvTYPE(sv) < SVt_PVNV)
            sv_upgrade(sv, SVt_PVNV);
 
-       /* If NV preserves UV then we only use the UV value if we know that
+       /* If NVs preserve UVs then we only use the UV value if we know that
           we aren't going to call atof() below. If NVs don't preserve UVs
           then the value returned may have more precision than atof() will
           return, even though value isn't perfectly accurate.  */
@@ -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;
@@ -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.  */
@@ -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;
@@ -3984,6 +4023,7 @@ macro.
 SV *
 Perl_newSV(pTHX_ STRLEN len)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -4016,6 +4056,7 @@ MAGIC *
 Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable,
                 const char* name, I32 namlen)
 {
+    dVAR;
     MAGIC* mg;
 
     if (SvTYPE(sv) < SVt_PVMG) {
@@ -4100,6 +4141,7 @@ 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)
 {
+    dVAR;
     const MGVTBL *vtable;
     MAGIC* mg;
 
@@ -4350,6 +4392,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 +4446,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 +4546,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 +4644,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 +5431,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 +5527,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 +5611,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 +5676,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 +5733,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;
@@ -6038,6 +6089,7 @@ if necessary. Handles 'get' magic.
 void
 Perl_sv_inc(pTHX_ register SV *sv)
 {
+    dVAR;
     register char *d;
     int flags;
 
@@ -6194,6 +6246,7 @@ if necessary. Handles 'get' magic.
 void
 Perl_sv_dec(pTHX_ register SV *sv)
 {
+    dVAR;
     int flags;
 
     if (!sv)
@@ -6310,6 +6363,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 +6388,7 @@ See also C<sv_mortalcopy> and C<sv_2mortal>.
 SV *
 Perl_sv_newmortal(pTHX)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6382,6 +6437,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 +6459,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 +6481,7 @@ SV if the hek is NULL.
 SV *
 Perl_newSVhek(pTHX_ const HEK *hek)
 {
+    dVAR;
     if (!hek) {
        SV *sv;
 
@@ -6482,6 +6540,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 +6611,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 +6630,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 +6650,7 @@ SV is set to 1.
 SV *
 Perl_newSViv(pTHX_ IV i)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6608,6 +6670,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 +6690,7 @@ SV is B<not> incremented.
 SV *
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
+    dVAR;
     register SV *sv;
 
     new_SV(sv);
@@ -6644,6 +6708,7 @@ Perl_newRV_noinc(pTHX_ SV *tmpRef)
 SV *
 Perl_newRV(pTHX_ SV *tmpRef)
 {
+    dVAR;
     return newRV_noinc(SvREFCNT_inc(tmpRef));
 }
 
@@ -6659,6 +6724,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)
@@ -6961,7 +7027,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 +7225,7 @@ reference count is 1.
 SV*
 Perl_newSVrv(pTHX_ SV *rv, const char *classname)
 {
+    dVAR;
     SV *sv;
 
     new_SV(sv);
@@ -7214,6 +7281,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 +7383,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 +7423,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 +7781,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 +7849,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 +8167,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 +8807,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 */
            }
 
@@ -9333,11 +9410,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
     dstr->sv_debug_line = sstr->sv_debug_line;
     dstr->sv_debug_inpad = sstr->sv_debug_inpad;
     dstr->sv_debug_cloned = 1;
-#  ifdef NETWARE
     dstr->sv_debug_file = savepv(sstr->sv_debug_file);
-#  else
-    dstr->sv_debug_file = savesharedpv(sstr->sv_debug_file);
-#  endif
 #endif
 
     ptr_table_store(PL_ptr_table, sstr, dstr);
@@ -10771,6 +10844,20 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     else {
        init_stacks();
        ENTER;                  /* perl_destruct() wants to LEAVE; */
+
+       /* although we're not duplicating the tmps stack, we should still
+        * add entries for any SVs on the tmps stack that got cloned by a
+        * non-refcount means (eg a temp in @_); otherwise they will be
+        * orphaned
+        */
+       for (i = 0; i<= proto_perl->Ttmps_ix; i++) {
+           SV *nsv = (SV*)ptr_table_fetch(PL_ptr_table,
+                   proto_perl->Ttmps_stack[i]);
+           if (nsv && !SvREFCNT(nsv)) {
+               EXTEND_MORTAL(1);
+               PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc(nsv);
+           }
+       }
     }
 
     PL_start_env       = proto_perl->Tstart_env;       /* XXXXXX */
@@ -11087,6 +11174,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) ||
@@ -11162,7 +11250,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;
 }
@@ -11436,7 +11524,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:
@@ -11493,6 +11581,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) {