X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=8310047b456329b732a80767e8d404b53d6ddc06;hb=55d729e4e15089064cd25ed6dce2c105389f3837;hp=f460e45b3fd485a6f2bd25e36d939828bece9cc2;hpb=4e8e7886db513516f1ffb27b8c762a5fd6831099;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index f460e45..8310047 100644 --- a/sv.c +++ b/sv.c @@ -59,6 +59,8 @@ 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 @@ -333,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 @@ -387,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; } @@ -1085,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); @@ -1102,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); @@ -1138,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) @@ -1147,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: @@ -1190,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) { @@ -1695,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); @@ -1846,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); @@ -1866,8 +1906,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) @@ -1914,7 +1957,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: @@ -1940,7 +1982,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)); @@ -1965,8 +2007,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); @@ -2029,7 +2073,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", @@ -2037,9 +2081,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); @@ -2163,17 +2212,30 @@ 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); } 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; @@ -2182,22 +2244,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; @@ -2207,8 +2278,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); @@ -2217,11 +2289,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; @@ -2237,18 +2315,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 @@ -2260,7 +2343,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); @@ -2294,6 +2377,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; @@ -2305,6 +2395,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; @@ -2324,12 +2421,15 @@ 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(I32 x, STRLEN len) -#else newSV(STRLEN len) -#endif { register SV *sv; @@ -2364,8 +2464,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); @@ -2539,10 +2638,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 */ @@ -2613,7 +2719,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)) { @@ -2638,6 +2744,7 @@ sv_replace(register SV *sv, register SV *nsv) void sv_clear(register SV *sv) { + HV* stash; assert(sv); assert(SvREFCNT(sv) == 0); @@ -2646,7 +2753,6 @@ sv_clear(register SV *sv) if (defstash) { /* Still have a symbol table? */ djSP; GV* destructor; - HV* stash; SV ref; Zero(&ref, 1, SV); @@ -2660,6 +2766,7 @@ sv_clear(register SV *sv) destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY"); if (destructor) { ENTER; + PUSHSTACK(SI_DESTROY); SvRV(&ref) = SvREFCNT_inc(sv); EXTEND(SP, 2); PUSHMARK(SP); @@ -2668,6 +2775,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); @@ -2690,6 +2798,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() && @@ -2715,7 +2824,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: @@ -2777,7 +2890,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; @@ -2796,13 +2915,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)) { @@ -2817,7 +2938,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)) { @@ -3010,9 +3132,8 @@ 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)) { @@ -3589,7 +3710,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; } @@ -3917,7 +4038,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 */ @@ -4009,6 +4130,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); @@ -4089,6 +4214,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, ...) @@ -4111,6 +4244,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, ...) @@ -4133,6 +4290,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) { @@ -4441,6 +4621,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; @@ -4467,8 +4649,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 */ @@ -4862,7 +5048,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));