tweak win32 config templates for cpp
[p5sagit/p5-mst-13.2.git] / sv.c
diff --git a/sv.c b/sv.c
index e9e5cfb..1e5af08 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -75,6 +75,8 @@ typedef void (*SVFUNC) _((SV*));
 
 #endif /* PERL_OBJECT */
 
+#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv)
+
 #ifdef PURIFY
 
 #define new_SV(p)                      \
@@ -94,17 +96,17 @@ typedef void (*SVFUNC) _((SV*));
     } while (0)
 
 static SV **registry;
-static I32 regsize;
+static I32 registry_size;
 
 #define REGHASH(sv,size)  ((((U32)(sv)) >> 2) % (size))
 
 #define REG_REPLACE(sv,a,b) \
     do {                               \
        void* p = sv->sv_any;           \
-       I32 h = REGHASH(sv, regsize);   \
+       I32 h = REGHASH(sv, registry_size);     \
        I32 i = h;                      \
        while (registry[i] != (a)) {    \
-           if (++i >= regsize)         \
+           if (++i >= registry_size)   \
                i = 0;                  \
            if (i == h)                 \
                die("SV registry bug"); \
@@ -119,13 +121,13 @@ static void
 reg_add(sv)
 SV* sv;
 {
-    if (sv_count >= (regsize >> 1))
+    if (sv_count >= (registry_size >> 1))
     {
        SV **oldreg = registry;
-       I32 oldsize = regsize;
+       I32 oldsize = registry_size;
 
-       regsize = regsize ? ((regsize << 2) + 1) : 2037;
-       Newz(707, registry, regsize, SV*);
+       registry_size = registry_size ? ((registry_size << 2) + 1) : 2037;
+       Newz(707, registry, registry_size, SV*);
 
        if (oldreg) {
            I32 i;
@@ -157,9 +159,9 @@ SVFUNC f;
 {
     I32 i;
 
-    for (i = 0; i < regsize; ++i) {
+    for (i = 0; i < registry_size; ++i) {
        SV* sv = registry[i];
-       if (sv)
+       if (sv && SvTYPE(sv) != SVTYPEMASK)
            (*f)(sv);
     }
 }
@@ -321,7 +323,7 @@ do_report_used(SV *sv)
 void
 sv_report_used(void)
 {
-    visit(do_report_used);
+    visit(FUNC_NAME_TO_PTR(do_report_used));
 }
 
 STATIC void
@@ -343,21 +345,29 @@ do_clean_objs(SV *sv)
 STATIC void
 do_clean_named_objs(SV *sv)
 {
-    if (SvTYPE(sv) == SVt_PVGV && GvSV(sv))
-       do_clean_objs(GvSV(sv));
+    if (SvTYPE(sv) == SVt_PVGV) {
+       if ( SvOBJECT(GvSV(sv)) ||
+            GvAV(sv) && SvOBJECT(GvAV(sv)) ||
+            GvHV(sv) && SvOBJECT(GvHV(sv)) ||
+            GvIO(sv) && SvOBJECT(GvIO(sv)) ||
+            GvCV(sv) && SvOBJECT(GvCV(sv)) )
+       {
+           DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv));)
+           SvREFCNT_dec(sv);
+       }
+    }
 }
 #endif
 
-static bool in_clean_objs = FALSE;
-
 void
 sv_clean_objs(void)
 {
     in_clean_objs = TRUE;
+    visit(FUNC_NAME_TO_PTR(do_clean_objs));
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
-    visit(do_clean_named_objs);
+    /* some barnacles may yet remain, clinging to typeglobs */
+    visit(FUNC_NAME_TO_PTR(do_clean_named_objs));
 #endif
-    visit(do_clean_objs);
     in_clean_objs = FALSE;
 }
 
@@ -369,13 +379,11 @@ do_clean_all(SV *sv)
     SvREFCNT_dec(sv);
 }
 
-static bool in_clean_all = FALSE;
-
 void
 sv_clean_all(void)
 {
     in_clean_all = TRUE;
-    visit(do_clean_all);
+    visit(FUNC_NAME_TO_PTR(do_clean_all));
     in_clean_all = FALSE;
 }
 
@@ -397,6 +405,10 @@ sv_free_arenas(void)
            Safefree((void *)sva);
     }
 
+    if (nice_chunk)
+       Safefree(nice_chunk);
+    nice_chunk = Nullch;
+    nice_chunk_size = 0;
     sv_arenaroot = 0;
     sv_root = 0;
 }
@@ -589,7 +601,7 @@ more_xpv(void)
 #  define my_safemalloc(s) safemalloc(s)
 #  define my_safefree(s) free(s)
 #else
-static void* 
+STATIC void* 
 my_safemalloc(MEM_SIZE size)
 {
     char *p;
@@ -906,10 +918,10 @@ sv_upgrade(register SV *sv, U32 mt)
     return TRUE;
 }
 
-#ifdef DEBUGGING
 char *
 sv_peek(SV *sv)
 {
+#ifdef DEBUGGING
     SV *t = sv_newmortal();
     STRLEN prevlen;
     int unref = 0;
@@ -1051,8 +1063,10 @@ sv_peek(SV *sv)
            sv_catpv(t, ")");
     }
     return SvPV(t, na);
+#else  /* DEBUGGING */
+    return "";
+#endif /* DEBUGGING */
 }
-#endif
 
 int
 sv_backoff(register SV *sv)
@@ -1095,12 +1109,24 @@ sv_grow(SV* sv, unsigned long newlen)
        s = SvPVX(sv);
        if (newlen > SvLEN(sv))
            newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
+#ifdef HAS_64K_LIMIT
+       if (newlen >= 0x10000)
+           newlen = 0xFFFF;
+#endif
     }
     else
        s = SvPVX(sv);
     if (newlen > SvLEN(sv)) {          /* need more room? */
-        if (SvLEN(sv) && s)
+       if (SvLEN(sv) && s) {
+#ifdef MYMALLOC
+           STRLEN l = malloced_size((void*)SvPVX(sv));
+           if (newlen <= l) {
+               SvLEN_set(sv, l);
+               return s;
+           } else
+#endif 
            Renew(s,newlen,char);
+       }
         else
            New(703,s,newlen,char);
        SvPV_set(sv, s);
@@ -1112,7 +1138,7 @@ sv_grow(SV* sv, unsigned long newlen)
 void
 sv_setiv(register SV *sv, IV i)
 {
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
        sv_upgrade(sv, SVt_IV);
@@ -1173,13 +1199,12 @@ sv_setuv_mg(register SV *sv, UV u)
 void
 sv_setnv(register SV *sv, double num)
 {
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
     case SVt_IV:
        sv_upgrade(sv, SVt_NV);
        break;
-    case SVt_NV:
     case SVt_RV:
     case SVt_PV:
     case SVt_PVIV:
@@ -1678,7 +1703,21 @@ sv_2pv(register SV *sv, STRLEN *lp)
            if (!sv)
                s = "NULLREF";
            else {
+               MAGIC *mg;
+               
                switch (SvTYPE(sv)) {
+               case SVt_PVMG:
+                   if ( ((SvFLAGS(sv) &
+                          (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG)) 
+                         == (SVs_OBJECT|SVs_RMG))
+                        && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp")
+                        && (mg = mg_find(sv, 'r'))) {
+                       regexp *re = (regexp *)mg->mg_obj;
+
+                       *lp = re->prelen;
+                       return re->precomp;
+                   }
+                                       /* Fall through */
                case SVt_NULL:
                case SVt_IV:
                case SVt_NV:
@@ -1686,14 +1725,13 @@ sv_2pv(register SV *sv, STRLEN *lp)
                case SVt_PV:
                case SVt_PVIV:
                case SVt_PVNV:
-               case SVt_PVBM:
-               case SVt_PVMG:  s = "SCALAR";                   break;
+               case SVt_PVBM:  s = "SCALAR";                   break;
                case SVt_PVLV:  s = "LVALUE";                   break;
                case SVt_PVAV:  s = "ARRAY";                    break;
                case SVt_PVHV:  s = "HASH";                     break;
                case SVt_PVCV:  s = "CODE";                     break;
                case SVt_PVGV:  s = "GLOB";                     break;
-               case SVt_PVFM:  s = "FORMLINE";                 break;
+               case SVt_PVFM:  s = "FORMAT";                   break;
                case SVt_PVIO:  s = "IO";                       break;
                default:        s = "UNKNOWN";                  break;
                }
@@ -1726,8 +1764,7 @@ sv_2pv(register SV *sv, STRLEN *lp)
            return "";
        }
     }
-    if (!SvUPGRADE(sv, SVt_PV))
-       return 0;
+    (void)SvUPGRADE(sv, SVt_PV);
     if (SvNOKp(sv)) {
        if (SvTYPE(sv) < SVt_PVNV)
            sv_upgrade(sv, SVt_PVNV);
@@ -1877,7 +1914,7 @@ sv_setsv(SV *dstr, register SV *sstr)
 
     if (sstr == dstr)
        return;
-    sv_check_thinkfirst(dstr);
+    SV_CHECK_THINKFIRST(dstr);
     if (!sstr)
        sstr = &sv_undef;
     stype = SvTYPE(sstr);
@@ -1897,8 +1934,11 @@ sv_setsv(SV *dstr, register SV *sstr)
 
     switch (stype) {
     case SVt_NULL:
-       (void)SvOK_off(dstr);
-       return;
+       if (dtype != SVt_PVGV) {
+           (void)SvOK_off(dstr);
+           return;
+       }
+       break;
     case SVt_IV:
        if (dtype != SVt_IV && dtype < SVt_PVIV) {
            if (dtype < SVt_IV)
@@ -1945,7 +1985,6 @@ sv_setsv(SV *dstr, register SV *sstr)
        if (dtype < SVt_PVNV)
            sv_upgrade(dstr, SVt_PVNV);
        break;
-
     case SVt_PVAV:
     case SVt_PVHV:
     case SVt_PVCV:
@@ -1971,7 +2010,7 @@ sv_setsv(SV *dstr, register SV *sstr)
                SvFAKE_on(dstr);        /* can coerce to non-glob */
            }
            /* ahem, death to those who redefine active sort subs */
-           else if (curstack == sortstack
+           else if (curstackinfo->si_type == SI_SORT
                     && GvCV(dstr) && sortcop == CvSTART(GvCV(dstr)))
                croak("Can't redefine active sort subroutine %s",
                      GvNAME(dstr));
@@ -1996,8 +2035,10 @@ sv_setsv(SV *dstr, register SV *sstr)
                    goto glob_assign;
            }
        }
-       if (dtype < stype)
-           sv_upgrade(dstr, stype);
+       if (stype == SVt_PVLV)
+           SvUPGRADE(dstr, SVt_PVNV);
+       else
+           SvUPGRADE(dstr, stype);
     }
 
     sflags = SvFLAGS(sstr);
@@ -2058,19 +2099,29 @@ sv_setsv(SV *dstr, register SV *sstr)
                            if (!GvCVGEN((GV*)dstr) &&
                                (CvROOT(cv) || CvXSUB(cv)))
                            {
+                               SV *const_sv = cv_const_sv(cv);
+                               bool const_changed = TRUE; 
+                               if(const_sv)
+                                   const_changed = sv_cmp(const_sv, 
+                                          op_const_sv(CvSTART((CV*)sref), 
+                                                      Nullcv));
                                /* ahem, death to those who redefine
                                 * active sort subs */
-                               if (curstack == sortstack &&
+                               if (curstackinfo->si_type == SI_SORT &&
                                      sortcop == CvSTART(cv))
                                    croak(
                                    "Can't redefine active sort subroutine %s",
                                          GvENAME((GV*)dstr));
-                               if (cv_const_sv(cv))
-                                   warn("Constant subroutine %s redefined",
-                                        GvENAME((GV*)dstr));
-                               else if (dowarn)
-                                   warn("Subroutine %s redefined",
-                                        GvENAME((GV*)dstr));
+                               if (dowarn || (const_changed && const_sv)) {
+                                   if (!(CvGV(cv) && GvSTASH(CvGV(cv))
+                                         && HvNAME(GvSTASH(CvGV(cv)))
+                                         && strEQ(HvNAME(GvSTASH(CvGV(cv))),
+                                                  "autouse")))
+                                       warn(const_sv ? 
+                                            "Constant subroutine %s redefined"
+                                            : "Subroutine %s redefined", 
+                                            GvENAME((GV*)dstr));
+                               }
                            }
                            cv_ckproto(cv, (GV*)dstr,
                                       SvPOK(sref) ? SvPVX(sref) : Nullch);
@@ -2194,7 +2245,12 @@ sv_setsv(SV *dstr, register SV *sstr)
        SvIVX(dstr) = SvIVX(sstr);
     }
     else {
-       (void)SvOK_off(dstr);
+       if (dtype == SVt_PVGV) {
+           if (dowarn)
+               warn("Undefined value assigned to typeglob");
+       }
+       else
+           (void)SvOK_off(dstr);
     }
     SvTAINT(dstr);
 }
@@ -2209,9 +2265,10 @@ sv_setsv_mg(SV *dstr, register SV *sstr)
 void
 sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
 {
+    register char *dptr;
     assert(len >= 0);  /* STRLEN is probably unsigned, so this may
                          elicit a warning, but it won't hurt. */
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (!ptr) {
        (void)SvOK_off(sv);
        return;
@@ -2220,12 +2277,14 @@ sv_setpvn(register SV *sv, register const char *ptr, register STRLEN len)
        if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
            sv_unglob(sv);
     }
-    else if (!sv_upgrade(sv, SVt_PV))
-       return;
+    else
+       sv_upgrade(sv, SVt_PV);
+
     SvGROW(sv, len + 1);
-    Move(ptr,SvPVX(sv),len,char);
+    dptr = SvPVX(sv);
+    Move(ptr,dptr,len,char);
+    dptr[len] = '\0';
     SvCUR_set(sv, len);
-    *SvEND(sv) = '\0';
     (void)SvPOK_only(sv);              /* validate pointer */
     SvTAINT(sv);
 }
@@ -2242,7 +2301,7 @@ sv_setpv(register SV *sv, register const char *ptr)
 {
     register STRLEN len;
 
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (!ptr) {
        (void)SvOK_off(sv);
        return;
@@ -2252,8 +2311,9 @@ sv_setpv(register SV *sv, register const char *ptr)
        if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
            sv_unglob(sv);
     }
-    else if (!sv_upgrade(sv, SVt_PV))
-       return;
+    else 
+       sv_upgrade(sv, SVt_PV);
+
     SvGROW(sv, len + 1);
     Move(ptr,SvPVX(sv),len+1,char);
     SvCUR_set(sv, len);
@@ -2271,9 +2331,8 @@ sv_setpv_mg(register SV *sv, register const char *ptr)
 void
 sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
 {
-    sv_check_thinkfirst(sv);
-    if (!SvUPGRADE(sv, SVt_PV))
-       return;
+    SV_CHECK_THINKFIRST(sv);
+    (void)SvUPGRADE(sv, SVt_PV);
     if (!ptr) {
        (void)SvOK_off(sv);
        return;
@@ -2292,22 +2351,20 @@ sv_usepvn(register SV *sv, register char *ptr, register STRLEN len)
 void
 sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len)
 {
-    sv_usepvn_mg(sv,ptr,len);
+    sv_usepvn(sv,ptr,len);
     SvSETMAGIC(sv);
 }
 
 STATIC void
 sv_check_thinkfirst(register SV *sv)
 {
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv)) {
-           dTHR;
-           if (curcop != &compiling)
-               croak(no_modify);
-       }
-       if (SvROK(sv))
-           sv_unref(sv);
+    if (SvREADONLY(sv)) {
+       dTHR;
+       if (curcop != &compiling)
+           croak(no_modify);
     }
+    if (SvROK(sv))
+       sv_unref(sv);
 }
     
 void
@@ -2319,7 +2376,7 @@ sv_chop(register SV *sv, register char *ptr)      /* like set but assuming ptr is in
 
     if (!ptr || !SvPOKp(sv))
        return;
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (SvTYPE(sv) < SVt_PVIV)
        sv_upgrade(sv,SVt_PVIV);
 
@@ -2400,16 +2457,12 @@ sv_catpv(register SV *sv, register char *ptr)
 void
 sv_catpv_mg(register SV *sv, register char *ptr)
 {
-    sv_catpv_mg(sv,ptr);
+    sv_catpv(sv,ptr);
     SvSETMAGIC(sv);
 }
 
 SV *
-#ifdef LEAKTEST
-newSV(I32 x, STRLEN len)
-#else
 newSV(STRLEN len)
-#endif
 {
     register SV *sv;
     
@@ -2444,8 +2497,7 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen)
        }
     }
     else {
-       if (!SvUPGRADE(sv, SVt_PVMG))
-           return;
+        (void)SvUPGRADE(sv, SVt_PVMG);
     }
     Newz(702,mg, 1, MAGIC);
     mg->mg_moremagic = SvMAGIC(sv);
@@ -2619,10 +2671,17 @@ sv_insert(SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN littlelen)
     register char *midend;
     register char *bigend;
     register I32 i;
+    STRLEN curlen;
+    
 
     if (!bigstr)
        croak("Can't modify non-existent substring");
-    SvPV_force(bigstr, na);
+    SvPV_force(bigstr, curlen);
+    if (offset + len > curlen) {
+       SvGROW(bigstr, offset+len+1);
+       Zero(SvPVX(bigstr)+curlen, offset+len-curlen, char);
+       SvCUR_set(bigstr, offset+len);
+    }
 
     i = littlelen - len;
     if (i > 0) {                       /* string might grow */
@@ -2693,7 +2752,7 @@ void
 sv_replace(register SV *sv, register SV *nsv)
 {
     U32 refcnt = SvREFCNT(sv);
-    sv_check_thinkfirst(sv);
+    SV_CHECK_THINKFIRST(sv);
     if (SvREFCNT(nsv) != 1)
        warn("Reference miscount in sv_replace()");
     if (SvMAGICAL(sv)) {
@@ -2718,6 +2777,7 @@ sv_replace(register SV *sv, register SV *nsv)
 void
 sv_clear(register SV *sv)
 {
+    HV* stash;
     assert(sv);
     assert(SvREFCNT(sv) == 0);
 
@@ -2726,7 +2786,6 @@ sv_clear(register SV *sv)
        if (defstash) {         /* Still have a symbol table? */
            djSP;
            GV* destructor;
-           HV* stash;
            SV tmpref;
 
            Zero(&tmpref, 1, SV);
@@ -2740,6 +2799,7 @@ sv_clear(register SV *sv)
                destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
                if (destructor) {
                    ENTER;
+                   PUSHSTACK(SI_DESTROY);
                    SvRV(&tmpref) = SvREFCNT_inc(sv);
                    EXTEND(SP, 2);
                    PUSHMARK(SP);
@@ -2748,6 +2808,7 @@ sv_clear(register SV *sv)
                    perl_call_sv((SV*)GvCV(destructor),
                                 G_DISCARD|G_EVAL|G_KEEPERR);
                    SvREFCNT(sv)--;
+                   POPSTACK();
                    LEAVE;
                }
            } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
@@ -2770,6 +2831,7 @@ sv_clear(register SV *sv)
     }
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
        mg_free(sv);
+    stash = NULL;
     switch (SvTYPE(sv)) {
     case SVt_PVIO:
        if (IoIFP(sv) != PerlIO_stdin() &&
@@ -2795,7 +2857,11 @@ sv_clear(register SV *sv)
     case SVt_PVGV:
        gp_free((GV*)sv);
        Safefree(GvNAME(sv));
-       SvREFCNT_dec(GvSTASH(sv));
+       /* cannot decrease stash refcount yet, as we might recursively delete
+          ourselves when the refcnt drops to zero. Delay SvREFCNT_dec
+          of stash until current sv is completely gone.
+          -- JohnPC, 27 Mar 1998 */
+       stash = GvSTASH(sv);
        /* FALL THROUGH */
     case SVt_PVLV:
     case SVt_PVMG:
@@ -2857,7 +2923,13 @@ sv_clear(register SV *sv)
        break;
     case SVt_PVGV:
        del_XPVGV(SvANY(sv));
-       break;
+       /* code duplication for increased performance. */
+       SvFLAGS(sv) &= SVf_BREAK;
+       SvFLAGS(sv) |= SVTYPEMASK;
+       /* decrease refcount of the stash that owns this GV, if any */
+       if (stash)
+           SvREFCNT_dec(stash);
+       return; /* not break, SvFLAGS reset already happened */
     case SVt_PVBM:
        del_XPVBM(SvANY(sv));
        break;
@@ -2876,13 +2948,15 @@ SV *
 sv_newref(SV *sv)
 {
     if (sv)
-       SvREFCNT(sv)++;
+       ATOMIC_INC(SvREFCNT(sv));
     return sv;
 }
 
 void
 sv_free(SV *sv)
 {
+    int refcount_is_zero;
+
     if (!sv)
        return;
     if (SvREADONLY(sv)) {
@@ -2897,7 +2971,8 @@ sv_free(SV *sv)
        warn("Attempt to free unreferenced scalar");
        return;
     }
-    if (--SvREFCNT(sv) > 0)
+    ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
+    if (!refcount_is_zero)
        return;
 #ifdef DEBUGGING
     if (SvTEMP(sv)) {
@@ -3090,15 +3165,39 @@ sv_gets(register SV *sv, register PerlIO *fp, I32 append)
     register I32 cnt;
     I32 i;
 
-    sv_check_thinkfirst(sv);
-    if (!SvUPGRADE(sv, SVt_PV))
-       return 0;
+    SV_CHECK_THINKFIRST(sv);
+    (void)SvUPGRADE(sv, SVt_PV);
     SvSCREAM_off(sv);
 
     if (RsSNARF(rs)) {
        rsptr = NULL;
        rslen = 0;
     }
+    else if (RsRECORD(rs)) {
+      I32 recsize, bytesread;
+      char *buffer;
+
+      /* Grab the size of the record we're getting */
+      recsize = SvIV(SvRV(rs));
+      (void)SvPOK_only(sv);    /* Validate pointer */
+      /* Make sure we've got the room to yank in the whole thing */
+      if (SvLEN(sv) <= recsize + 3) {
+        /* No, so make it bigger */
+        SvGROW(sv, recsize + 3);
+      }
+      buffer = SvPVX(sv); /* Get the location of the final buffer */
+      /* Go yank in */
+#ifdef VMS
+      /* VMS wants read instead of fread, because fread doesn't respect */
+      /* RMS record boundaries. This is not necessarily a good thing to be */
+      /* doing, but we've got no other real choice */
+      bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize);
+#else
+      bytesread = PerlIO_read(fp, buffer, recsize);
+#endif
+      SvCUR_set(sv, bytesread);
+      return(SvCUR(sv) ? SvPVX(sv) : Nullch);
+    }
     else if (RsPARA(rs)) {
        rsptr = "\n\n";
        rslen = 2;
@@ -3528,9 +3627,7 @@ newSVpv(char *s, STRLEN len)
 }
 
 SV *
-newSVpvn(s,len)
-char *s;
-STRLEN len;
+newSVpvn(char *s, STRLEN len)
 {
     register SV *sv;
 
@@ -3542,16 +3639,8 @@ STRLEN len;
     return sv;
 }
 
-#ifdef I_STDARG
 SV *
 newSVpvf(const char* pat, ...)
-#else
-/*VARARGS0*/
-SV *
-newSVpvf(pat, va_alist)
-const char *pat;
-va_dcl
-#endif
 {
     register SV *sv;
     va_list args;
@@ -3560,11 +3649,7 @@ va_dcl
     SvANY(sv) = 0;
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
     return sv;
@@ -3669,7 +3754,7 @@ sv_reset(register char *s, HV *stash)
 
     if (!*s) {         /* reset ?? searches */
        for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
-           pm->op_pmflags &= ~PMf_USED;
+           pm->op_pmdynflags &= ~PMdf_USED;
        }
        return;
     }
@@ -3949,7 +4034,7 @@ sv_reftype(SV *sv, int ob)
        case SVt_PVHV:          return "HASH";
        case SVt_PVCV:          return "CODE";
        case SVt_PVGV:          return "GLOB";
-       case SVt_PVFM:          return "FORMLINE";
+       case SVt_PVFM:          return "FORMAT";
        default:                return "UNKNOWN";
        }
     }
@@ -3997,7 +4082,7 @@ newSVrv(SV *rv, char *classname)
     SvREFCNT(sv) = 0;
     SvFLAGS(sv) = 0;
 
-    sv_check_thinkfirst(rv);
+    SV_CHECK_THINKFIRST(rv);
 #ifdef OVERLOAD
     SvAMAGIC_off(rv);
 #endif /* OVERLOAD */
@@ -4089,6 +4174,10 @@ sv_unglob(SV *sv)
     SvFAKE_off(sv);
     if (GvGP(sv))
        gp_free((GV*)sv);
+    if (GvSTASH(sv)) {
+       SvREFCNT_dec(GvSTASH(sv));
+       GvSTASH(sv) = Nullhv;
+    }
     sv_unmagic(sv, '*');
     Safefree(GvNAME(sv));
     GvMULTI_off(sv);
@@ -4177,92 +4266,40 @@ sv_setpviv_mg(SV *sv, IV iv)
     SvSETMAGIC(sv);
 }
 
-#ifdef I_STDARG
 void
 sv_setpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf(sv, pat, va_alist)
-    SV *sv;
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
 }
 
 
-#ifdef I_STDARG
 void
 sv_setpvf_mg(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_setpvf_mg(sv, pat, va_alist)
-    SV *sv;
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
     SvSETMAGIC(sv);
 }
 
-#ifdef I_STDARG
 void
 sv_catpvf(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf(sv, pat, va_alist)
-    SV *sv;
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
 }
 
-#ifdef I_STDARG
 void
 sv_catpvf_mg(SV *sv, const char* pat, ...)
-#else
-/*VARARGS0*/
-void
-sv_catpvf_mg(sv, pat, va_alist)
-    SV *sv;
-    const char *pat;
-    va_dcl
-#endif
 {
     va_list args;
-#ifdef I_STDARG
     va_start(args, pat);
-#else
-    va_start(args);
-#endif
     sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
     va_end(args);
     SvSETMAGIC(sv);
@@ -4576,6 +4613,8 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs,
            switch (base) {
                unsigned dig;
            case 16:
+               if (!uv)
+                   alt = FALSE;
                p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef";
                do {
                    dig = uv & 15;
@@ -4602,8 +4641,12 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs,
                break;
            }
            elen = (ebuf + sizeof ebuf) - eptr;
-           if (has_precis && precis > elen)
-               zeros = precis - elen;
+           if (has_precis) {
+               if (precis > elen)
+                   zeros = precis - elen;
+               else if (precis == 0 && elen == 1 && *eptr == '0')
+                   elen = 0;
+           }
            break;
 
            /* FLOATING POINT */
@@ -4765,10 +4808,10 @@ sv_vcatpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs,
     }
 }
 
-#ifdef DEBUGGING
 void
 sv_dump(SV *sv)
 {
+#ifdef DEBUGGING
     SV *d = sv_newmortal();
     char *s;
     U32 flags;
@@ -4997,7 +5040,8 @@ sv_dump(SV *sv)
     case SVt_PVGV:
        PerlIO_printf(Perl_debug_log, "  NAME = \"%s\"\n", GvNAME(sv));
        PerlIO_printf(Perl_debug_log, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
-       PerlIO_printf(Perl_debug_log, "  STASH = \"%s\"\n", HvNAME(GvSTASH(sv)));
+       PerlIO_printf(Perl_debug_log, "  STASH = \"%s\"\n",
+           SvTYPE(GvSTASH(sv)) == SVt_PVHV ? HvNAME(GvSTASH(sv)) : "(deleted)");
        PerlIO_printf(Perl_debug_log, "  GP = 0x%lx\n", (long)GvGP(sv));
        PerlIO_printf(Perl_debug_log, "    SV = 0x%lx\n", (long)GvSV(sv));
        PerlIO_printf(Perl_debug_log, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
@@ -5031,14 +5075,5 @@ sv_dump(SV *sv)
        PerlIO_printf(Perl_debug_log, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
        break;
     }
+#endif /* DEBUGGING */
 }
-#else
-void
-sv_dump(SV *sv)
-{
-}
-#endif
-
-
-
-