X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=ff9986771e9ecfcefe3623f55ee656c25279a339;hb=6a6688c3248cc554873f9452385ea9db777811fb;hp=b0d7f973b1e9fb51a5e918b31849cb05a66e9225;hpb=189b2af51bf236b53a02db0b105a3de423d3fff4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index b0d7f97..ff99867 100644 --- a/sv.c +++ b/sv.c @@ -59,24 +59,30 @@ static void sv_mortalgrow _((void)); static void sv_unglob _((SV* sv)); static void sv_check_thinkfirst _((SV *sv)); +#define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) sv_check_thinkfirst(sv) + +#ifndef PURIFY +static void *my_safemalloc(MEM_SIZE size); +#endif + typedef void (*SVFUNC) _((SV*)); #ifdef PURIFY #define new_SV(p) \ do { \ - MUTEX_LOCK(&sv_mutex); \ + LOCK_SV_MUTEX; \ (p) = (SV*)safemalloc(sizeof(SV)); \ reg_add(p); \ - MUTEX_UNLOCK(&sv_mutex); \ + UNLOCK_SV_MUTEX; \ } while (0) #define del_SV(p) \ do { \ - MUTEX_LOCK(&sv_mutex); \ + LOCK_SV_MUTEX; \ reg_remove(p); \ - free((char*)(p)); \ - MUTEX_UNLOCK(&sv_mutex); \ + Safefree((char*)(p)); \ + UNLOCK_SV_MUTEX; \ } while (0) static SV **registry; @@ -111,8 +117,7 @@ SV* sv; I32 oldsize = regsize; regsize = regsize ? ((regsize << 2) + 1) : 2037; - registry = (SV**)safemalloc(regsize * sizeof(SV*)); - memzero(registry, regsize * sizeof(SV*)); + Newz(707, registry, regsize, SV*); if (oldreg) { I32 i; @@ -158,7 +163,7 @@ U32 size; U32 flags; { if (!(flags & SVf_FAKE)) - free(ptr); + Safefree(ptr); } #else /* ! PURIFY */ @@ -183,24 +188,24 @@ U32 flags; ++sv_count; \ } while (0) -#define new_SV(p) do { \ - MUTEX_LOCK(&sv_mutex); \ - if (sv_root) \ - uproot_SV(p); \ - else \ - (p) = more_sv(); \ - MUTEX_UNLOCK(&sv_mutex); \ +#define new_SV(p) do { \ + LOCK_SV_MUTEX; \ + if (sv_root) \ + uproot_SV(p); \ + else \ + (p) = more_sv(); \ + UNLOCK_SV_MUTEX; \ } while (0) #ifdef DEBUGGING -#define del_SV(p) do { \ - MUTEX_LOCK(&sv_mutex); \ - if (debug & 32768) \ - del_sv(p); \ - else \ - plant_SV(p); \ - MUTEX_UNLOCK(&sv_mutex); \ +#define del_SV(p) do { \ + LOCK_SV_MUTEX; \ + if (debug & 32768) \ + del_sv(p); \ + else \ + plant_SV(p); \ + UNLOCK_SV_MUTEX; \ } while (0) static void @@ -330,8 +335,19 @@ 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); + } + else if (GvSV(sv)) + do_clean_objs(GvSV(sv)); + } } #endif @@ -384,6 +400,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; } @@ -416,7 +436,8 @@ more_xiv(void) { register IV** xiv; register IV** xivend; - XPV* ptr = (XPV*)safemalloc(1008); + XPV* ptr; + New(705, ptr, 1008/sizeof(XPV), XPV); ptr->xpv_pv = (char*)xiv_arenaroot; /* linked list of xiv arenas */ xiv_arenaroot = ptr; /* to keep Purify happy */ @@ -457,7 +478,7 @@ more_xnv(void) { register double* xnv; register double* xnvend; - xnv = (double*)safemalloc(1008); + New(711, xnv, 1008/sizeof(double), double); xnvend = &xnv[1008 / sizeof(double) - 1]; xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */ xnv_root = xnv; @@ -493,7 +514,7 @@ more_xrv(void) { register XRV* xrv; register XRV* xrvend; - xrv_root = (XRV*)safemalloc(1008); + New(712, xrv_root, 1008/sizeof(XRV), XRV); xrv = xrv_root; xrvend = &xrv[1008 / sizeof(XRV) - 1]; while (xrv < xrvend) { @@ -528,7 +549,7 @@ more_xpv(void) { register XPV* xpv; register XPV* xpvend; - xpv_root = (XPV*)safemalloc(1008); + New(713, xpv_root, 1008/sizeof(XPV), XPV); xpv = xpv_root; xpvend = &xpv[1008 / sizeof(XPV) - 1]; while (xpv < xpvend) { @@ -541,7 +562,7 @@ more_xpv(void) #ifdef PURIFY #define new_XIV() (void*)safemalloc(sizeof(XPVIV)) -#define del_XIV(p) free((char*)p) +#define del_XIV(p) Safefree((char*)p) #else #define new_XIV() (void*)new_xiv() #define del_XIV(p) del_xiv((XPVIV*) p) @@ -549,7 +570,7 @@ more_xpv(void) #ifdef PURIFY #define new_XNV() (void*)safemalloc(sizeof(XPVNV)) -#define del_XNV(p) free((char*)p) +#define del_XNV(p) Safefree((char*)p) #else #define new_XNV() (void*)new_xnv() #define del_XNV(p) del_xnv((XPVNV*) p) @@ -557,7 +578,7 @@ more_xpv(void) #ifdef PURIFY #define new_XRV() (void*)safemalloc(sizeof(XRV)) -#define del_XRV(p) free((char*)p) +#define del_XRV(p) Safefree((char*)p) #else #define new_XRV() (void*)new_xrv() #define del_XRV(p) del_xrv((XRV*) p) @@ -565,44 +586,58 @@ more_xpv(void) #ifdef PURIFY #define new_XPV() (void*)safemalloc(sizeof(XPV)) -#define del_XPV(p) free((char*)p) +#define del_XPV(p) Safefree((char*)p) #else #define new_XPV() (void*)new_xpv() #define del_XPV(p) del_xpv((XPV *)p) #endif -#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV)) -#define del_XPVIV(p) free((char*)p) - -#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV)) -#define del_XPVNV(p) free((char*)p) - -#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG)) -#define del_XPVMG(p) free((char*)p) - -#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV)) -#define del_XPVLV(p) free((char*)p) - -#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV)) -#define del_XPVAV(p) free((char*)p) - -#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV)) -#define del_XPVHV(p) free((char*)p) - -#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV)) -#define del_XPVCV(p) free((char*)p) - -#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV)) -#define del_XPVGV(p) free((char*)p) - -#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM)) -#define del_XPVBM(p) free((char*)p) - -#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM)) -#define del_XPVFM(p) free((char*)p) - -#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO)) -#define del_XPVIO(p) free((char*)p) +#ifdef PURIFY +# define my_safemalloc(s) safemalloc(s) +# define my_safefree(s) free(s) +#else +static void* +my_safemalloc(MEM_SIZE size) +{ + char *p; + New(717, p, size, char); + return (void*)p; +} +# 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) + +#define new_XPVAV() (void*)my_safemalloc(sizeof(XPVAV)) +#define del_XPVAV(p) my_safefree((char*)p) + +#define new_XPVHV() (void*)my_safemalloc(sizeof(XPVHV)) +#define del_XPVHV(p) my_safefree((char*)p) + +#define new_XPVCV() (void*)my_safemalloc(sizeof(XPVCV)) +#define del_XPVCV(p) my_safefree((char*)p) + +#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) + +#define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM)) +#define del_XPVFM(p) my_safefree((char*)p) + +#define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO)) +#define del_XPVIO(p) my_safefree((char*)p) bool sv_upgrade(register SV *sv, U32 mt) @@ -785,7 +820,7 @@ sv_upgrade(register SV *sv, U32 mt) Safefree(pv); SvPVX(sv) = 0; AvMAX(sv) = -1; - AvFILL(sv) = -1; + AvFILLp(sv) = -1; SvIVX(sv) = 0; SvNVX(sv) = 0.0; SvMAGIC(sv) = magic; @@ -1067,6 +1102,10 @@ 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); @@ -1084,7 +1123,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); @@ -1120,6 +1159,13 @@ sv_setiv(register SV *sv, IV i) } void +sv_setiv_mg(register SV *sv, IV i) +{ + sv_setiv(sv,i); + SvSETMAGIC(sv); +} + +void sv_setuv(register SV *sv, UV u) { if (u <= IV_MAX) @@ -1129,15 +1175,21 @@ sv_setuv(register SV *sv, UV u) } void +sv_setuv_mg(register SV *sv, UV u) +{ + sv_setuv(sv,u); + SvSETMAGIC(sv); +} + +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: @@ -1172,6 +1224,13 @@ sv_setnv(register SV *sv, double num) SvTAINT(sv); } +void +sv_setnv_mg(register SV *sv, double num) +{ + sv_setnv(sv,num); + SvSETMAGIC(sv); +} + static void not_a_number(SV *sv) { @@ -1644,7 +1703,7 @@ sv_2pv(register SV *sv, STRLEN *lp) case SVt_PVHV: s = "HASH"; break; case SVt_PVCV: s = "CODE"; break; case SVt_PVGV: s = "GLOB"; break; - case SVt_PVFM: s = "FORMATLINE"; break; + case SVt_PVFM: s = "FORMLINE"; break; case SVt_PVIO: s = "IO"; break; default: s = "UNKNOWN"; break; } @@ -1677,8 +1736,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); @@ -1828,7 +1886,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); @@ -1896,7 +1954,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: @@ -1916,13 +1973,13 @@ sv_setsv(SV *dstr, register SV *sstr) STRLEN len = GvNAMELEN(sstr); sv_upgrade(dstr, SVt_PVGV); sv_magic(dstr, dstr, '*', name, len); - GvSTASH(dstr) = GvSTASH(sstr); + GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr)); GvNAME(dstr) = savepvn(name, len); GvNAMELEN(dstr) = len; 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)); @@ -1947,8 +2004,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); @@ -2011,7 +2070,7 @@ sv_setsv(SV *dstr, register SV *sstr) { /* 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", @@ -2019,9 +2078,14 @@ sv_setsv(SV *dstr, register SV *sstr) if (cv_const_sv(cv)) warn("Constant subroutine %s redefined", GvENAME((GV*)dstr)); - else if (dowarn) - warn("Subroutine %s redefined", - GvENAME((GV*)dstr)); + else if (dowarn) { + if (!(CvGV(cv) && GvSTASH(CvGV(cv)) + && HvNAME(GvSTASH(CvGV(cv))) + && strEQ(HvNAME(GvSTASH(CvGV(cv))), + "autouse"))) + warn("Subroutine %s redefined", + GvENAME((GV*)dstr)); + } } cv_ckproto(cv, (GV*)dstr, SvPOK(sref) ? SvPVX(sref) : Nullch); @@ -2151,11 +2215,19 @@ sv_setsv(SV *dstr, register SV *sstr) } void +sv_setsv_mg(SV *dstr, register SV *sstr) +{ + sv_setsv(dstr,sstr); + SvSETMAGIC(dstr); +} + +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; @@ -2164,22 +2236,31 @@ 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); } void +sv_setpvn_mg(register SV *sv, register const char *ptr, register STRLEN len) +{ + sv_setpvn(sv,ptr,len); + SvSETMAGIC(sv); +} + +void 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; @@ -2189,8 +2270,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); @@ -2199,11 +2281,17 @@ sv_setpv(register SV *sv, register const char *ptr) } void +sv_setpv_mg(register SV *sv, register const char *ptr) +{ + sv_setpv(sv,ptr); + SvSETMAGIC(sv); +} + +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; @@ -2219,18 +2307,23 @@ sv_usepvn(register SV *sv, register char *ptr, register STRLEN len) SvTAINT(sv); } +void +sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN 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 @@ -2242,7 +2335,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); @@ -2276,6 +2369,13 @@ sv_catpvn(register SV *sv, register char *ptr, register STRLEN len) } void +sv_catpvn_mg(register SV *sv, register char *ptr, register STRLEN len) +{ + sv_catpvn(sv,ptr,len); + SvSETMAGIC(sv); +} + +void sv_catsv(SV *dstr, register SV *sstr) { char *s; @@ -2287,6 +2387,13 @@ sv_catsv(SV *dstr, register SV *sstr) } void +sv_catsv_mg(SV *dstr, register SV *sstr) +{ + sv_catsv(dstr,sstr); + SvSETMAGIC(dstr); +} + +void sv_catpv(register SV *sv, register char *ptr) { register STRLEN len; @@ -2306,14 +2413,19 @@ sv_catpv(register SV *sv, register char *ptr) SvTAINT(sv); } +void +sv_catpv_mg(register SV *sv, register char *ptr) +{ + sv_catpv(sv,ptr); + SvSETMAGIC(sv); +} + SV * #ifdef LEAKTEST -newSV(x,len) -I32 x; +newSV(I32 x, STRLEN len) #else newSV(STRLEN len) #endif - { register SV *sv; @@ -2348,8 +2460,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); @@ -2597,7 +2708,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)) { @@ -2622,6 +2733,7 @@ sv_replace(register SV *sv, register SV *nsv) void sv_clear(register SV *sv) { + HV* stash; assert(sv); assert(SvREFCNT(sv) == 0); @@ -2630,37 +2742,38 @@ sv_clear(register SV *sv) if (defstash) { /* Still have a symbol table? */ djSP; GV* destructor; + SV ref; - ENTER; - SAVEFREESV(SvSTASH(sv)); - - destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); - if (destructor) { - SV ref; - - Zero(&ref, 1, SV); - sv_upgrade(&ref, SVt_RV); - SvRV(&ref) = SvREFCNT_inc(sv); - SvROK_on(&ref); - SvREFCNT(&ref) = 1; /* Fake, but otherwise - creating+destructing a ref - leads to disaster. */ - - EXTEND(SP, 2); - PUSHMARK(SP); - PUSHs(&ref); - PUTBACK; - perl_call_sv((SV*)GvCV(destructor), - G_DISCARD|G_EVAL|G_KEEPERR); - del_XRV(SvANY(&ref)); - SvREFCNT(sv)--; - } + Zero(&ref, 1, SV); + sv_upgrade(&ref, SVt_RV); + SvROK_on(&ref); + SvREADONLY_on(&ref); /* DESTROY() could be naughty */ + SvREFCNT(&ref) = 1; - LEAVE; + do { + stash = SvSTASH(sv); + destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); + if (destructor) { + ENTER; + PUSHSTACK(SI_DESTROY); + SvRV(&ref) = SvREFCNT_inc(sv); + EXTEND(SP, 2); + PUSHMARK(SP); + PUSHs(&ref); + PUTBACK; + perl_call_sv((SV*)GvCV(destructor), + G_DISCARD|G_EVAL|G_KEEPERR); + SvREFCNT(sv)--; + POPSTACK(); + LEAVE; + } + } while (SvOBJECT(sv) && SvSTASH(sv) != stash); + + del_XRV(SvANY(&ref)); } - else - SvREFCNT_dec(SvSTASH(sv)); + if (SvOBJECT(sv)) { + SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */ SvOBJECT_off(sv); /* Curse the object. */ if (SvTYPE(sv) != SVt_PVIO) --sv_objcount; /* XXX Might want something more general */ @@ -2674,6 +2787,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() && @@ -2699,6 +2813,11 @@ sv_clear(register SV *sv) case SVt_PVGV: gp_free((GV*)sv); Safefree(GvNAME(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: @@ -2760,7 +2879,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; @@ -2779,13 +2904,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)) { @@ -2800,7 +2927,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)) { @@ -2983,7 +3111,7 @@ sv_collxfrm(SV *sv, STRLEN *nxp) #endif /* USE_LOCALE_COLLATE */ char * -sv_gets(register SV *sv, register FILE *fp, I32 append) +sv_gets(register SV *sv, register PerlIO *fp, I32 append) { dTHR; char *rsptr; @@ -2993,9 +3121,8 @@ sv_gets(register SV *sv, register FILE *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)) { @@ -3430,6 +3557,21 @@ newSVpv(char *s, STRLEN len) return sv; } +SV * +newSVpvn(s,len) +char *s; +STRLEN len; +{ + register SV *sv; + + new_SV(sv); + SvANY(sv) = 0; + SvREFCNT(sv) = 1; + SvFLAGS(sv) = 0; + sv_setpvn(sv,s,len); + return sv; +} + #ifdef I_STDARG SV * newSVpvf(const char* pat, ...) @@ -3552,6 +3694,9 @@ sv_reset(register char *s, HV *stash) register I32 max; char todo[256]; + if (!stash) + return; + if (!*s) { /* reset ?? searches */ for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) { pm->op_pmflags &= ~PMf_USED; @@ -3703,8 +3848,6 @@ sv_true(register SV *sv) dTHR; if (!sv) return 0; - if (SvGMAGICAL(sv)) - mg_get(sv); if (SvPOK(sv)) { register XPV* tXpv; if ((tXpv = (XPV*)SvANY(sv)) && @@ -3884,7 +4027,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 */ @@ -3976,6 +4119,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); @@ -4056,6 +4203,14 @@ sv_setpviv(SV *sv, IV iv) SvCUR(sv) = p - SvPVX(sv); } + +void +sv_setpviv_mg(SV *sv, IV iv) +{ + sv_setpviv(sv,iv); + SvSETMAGIC(sv); +} + #ifdef I_STDARG void sv_setpvf(SV *sv, const char* pat, ...) @@ -4078,6 +4233,30 @@ sv_setpvf(sv, pat, va_alist) 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, ...) @@ -4100,6 +4279,29 @@ sv_catpvf(sv, pat, va_alist) 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); +} + void sv_vsetpvfn(SV *sv, const char *pat, STRLEN patlen, va_list *args, SV **svargs, I32 svmax, bool *used_locale) { @@ -4408,6 +4610,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; @@ -4434,8 +4638,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 */ @@ -4774,7 +4982,7 @@ sv_dump(SV *sv) case SVt_PVAV: PerlIO_printf(Perl_debug_log, " ARRAY = 0x%lx\n", (long)AvARRAY(sv)); PerlIO_printf(Perl_debug_log, " ALLOC = 0x%lx\n", (long)AvALLOC(sv)); - PerlIO_printf(Perl_debug_log, " FILL = %ld\n", (long)AvFILL(sv)); + PerlIO_printf(Perl_debug_log, " FILL = %ld\n", (long)AvFILLp(sv)); PerlIO_printf(Perl_debug_log, " MAX = %ld\n", (long)AvMAX(sv)); PerlIO_printf(Perl_debug_log, " ARYLEN = 0x%lx\n", (long)AvARYLEN(sv)); flags = AvFLAGS(sv); @@ -4829,7 +5037,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));