X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/67e0a0c0fa359c21f10ed71e46ee8ffa17fcf1e9..7c3c39a3b46cd3e5b5de3b35d30dffbc83a55f73:/sv.c diff --git a/sv.c b/sv.c index 64862ea..ba09305 100644 --- a/sv.c +++ b/sv.c @@ -884,7 +884,7 @@ static const struct body_details bodies_by_type[] = { /* The bind placeholder pretends to be an RV for now. Also it's marked as "can't upgrade" to stop anyone using it before it's implemented. */ - { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 }, + { 0, 0, 0, SVt_DUMMY, TRUE, NONV, NOARENA, 0 }, /* IVs are in the head, so the allocation size is 0. */ { 0, @@ -1246,12 +1246,12 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type) assert(!SvPAD_TYPED(sv)); break; default: - if (old_type_details->cant_upgrade) + if (UNLIKELY(old_type_details->cant_upgrade)) Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf, sv_reftype(sv, 0), (UV) old_type, (UV) new_type); } - if (old_type > new_type) + if (UNLIKELY(old_type > new_type)) Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d", (int)old_type, (int)new_type); @@ -1386,7 +1386,7 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type) SvNV_set(sv, 0); #endif - if (new_type == SVt_PVIO) { + if (UNLIKELY(new_type == SVt_PVIO)) { IO * const io = MUTABLE_IO(sv); GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV); @@ -1399,7 +1399,7 @@ Perl_sv_upgrade(pTHX_ SV *const sv, svtype new_type) SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv)))); IoPAGE_LEN(sv) = 60; } - if (new_type == SVt_REGEXP) + if (UNLIKELY(new_type == SVt_REGEXP)) sv->sv_u.svu_rx = (regexp *)new_body; else if (old_type < SVt_PV) { /* referant will be NULL unless the old type was SVt_IV emulating @@ -4073,7 +4073,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) } break; - /* case SVt_BIND: */ + /* case SVt_DUMMY: */ case SVt_PVLV: case SVt_PVGV: case SVt_PVMG: @@ -6136,7 +6136,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) SvREFCNT_dec(SvSTASH(sv)); } switch (type) { - /* case SVt_BIND: */ + /* case SVt_DUMMY: */ case SVt_PVIO: if (IoIFP(sv) && IoIFP(sv) != PerlIO_stdin() && @@ -6257,6 +6257,8 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) PL_last_in_gv = NULL; else if ((const GV *)sv == PL_statgv) PL_statgv = NULL; + else if ((const GV *)sv == PL_stderrgv) + PL_stderrgv = NULL; case SVt_PVMG: case SVt_PVNV: case SVt_PVIV: @@ -6409,7 +6411,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) continue; } #endif - if (SvREADONLY(sv) && SvIMMORTAL(sv)) { + if (SvIMMORTAL(sv)) { /* make sure SvREFCNT(sv)==0 happens very seldom */ SvREFCNT(sv) = SvREFCNT_IMMORTAL; continue; @@ -6511,8 +6513,6 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { SvOBJECT_off(sv); /* Curse the object. */ SvSTASH_set(sv,0); /* SvREFCNT_dec may try to read this */ SvREFCNT_dec(stash); /* possibly of changed persuasion */ - if (SvTYPE(sv) != SVt_PVIO) - --PL_sv_objcount;/* XXX Might want something more general */ } return TRUE; } @@ -6575,7 +6575,7 @@ Perl_sv_free2(pTHX_ SV *const sv, const U32 rc) return; } #endif - if (SvREADONLY(sv) && SvIMMORTAL(sv)) { + if (SvIMMORTAL(sv)) { /* make sure SvREFCNT(sv)==0 happens very seldom */ SvREFCNT(sv) = SvREFCNT_IMMORTAL; return; @@ -6596,7 +6596,7 @@ Perl_sv_free2(pTHX_ SV *const sv, const U32 rc) return; if (PL_in_clean_all) /* All is fair */ return; - if (SvREADONLY(sv) && SvIMMORTAL(sv)) { + if (SvIMMORTAL(sv)) { /* make sure SvREFCNT(sv)==0 happens very seldom */ SvREFCNT(sv) = SvREFCNT_IMMORTAL; return; @@ -7437,7 +7437,6 @@ Perl_sv_cmp_flags(pTHX_ SV *const sv1, SV *const sv2, dVAR; STRLEN cur1, cur2; const char *pv1, *pv2; - char *tpv = NULL; I32 cmp; SV *svrecode = NULL; @@ -7501,8 +7500,6 @@ Perl_sv_cmp_flags(pTHX_ SV *const sv1, SV *const sv2, } SvREFCNT_dec(svrecode); - if (tpv) - Safefree(tpv); return cmp; } @@ -8572,7 +8569,7 @@ Perl_sv_2mortal(pTHX_ SV *const sv) dVAR; if (!sv) return NULL; - if (SvREADONLY(sv) && SvIMMORTAL(sv)) + if (SvIMMORTAL(sv)) return sv; PUSH_EXTEND_MORTAL__SV_C(sv); SvTEMP_on(sv); @@ -9409,7 +9406,7 @@ Perl_sv_reftype(pTHX_ const SV *const sv, const int ob) ? "GLOB" : "SCALAR"); case SVt_PVFM: return "FORMAT"; case SVt_PVIO: return "IO"; - case SVt_BIND: return "BIND"; + case SVt_DUMMY: return "DUMMY"; case SVt_REGEXP: return "REGEXP"; default: return "UNKNOWN"; } @@ -9695,14 +9692,10 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash) if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef)) Perl_croak_no_modify(); if (SvOBJECT(tmpRef)) { - if (SvTYPE(tmpRef) != SVt_PVIO) - --PL_sv_objcount; SvREFCNT_dec(SvSTASH(tmpRef)); } } SvOBJECT_on(tmpRef); - if (SvTYPE(tmpRef) != SVt_PVIO) - ++PL_sv_objcount; SvUPGRADE(tmpRef, SVt_PVMG); SvSTASH_set(tmpRef, MUTABLE_HV(SvREFCNT_inc_simple(stash))); @@ -11332,13 +11325,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p have = esignlen + zeros + elen; if (have < zeros) - croak_memory_wrap(); + Perl_croak_memory_wrap(); need = (have > width ? have : width); gap = need - have; if (need >= (((STRLEN)~0) - SvCUR(sv) - dotstrlen - 1)) - croak_memory_wrap(); + Perl_croak_memory_wrap(); SvGROW(sv, SvCUR(sv) + need + dotstrlen + 1); p = SvEND(sv); if (esignlen && fill == '0') { @@ -12140,7 +12133,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param) SvANY(dstr) = new_XNV(); SvNV_set(dstr, SvNVX(sstr)); break; - /* case SVt_BIND: */ + /* case SVt_DUMMY: */ default: { /* These are all the types that need complex bodies allocating. */ @@ -12438,9 +12431,6 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param) } } - if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO) - ++PL_sv_objcount; - return dstr; } @@ -13137,7 +13127,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, Zero(&PL_body_roots, 1, PL_body_roots); PL_sv_count = 0; - PL_sv_objcount = 0; PL_sv_root = NULL; PL_sv_arenaroot = NULL; @@ -13588,64 +13577,18 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_ASCII = sv_dup_inc(proto_perl->IASCII, param); PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param); - PL_PerlSpace = sv_dup_inc(proto_perl->IPerlSpace, param); - PL_XPerlSpace = sv_dup_inc(proto_perl->IXPerlSpace, param); - - PL_L1PosixAlnum = sv_dup_inc(proto_perl->IL1PosixAlnum, param); - PL_PosixAlnum = sv_dup_inc(proto_perl->IPosixAlnum, param); - - PL_L1PosixAlpha = sv_dup_inc(proto_perl->IL1PosixAlpha, param); - PL_PosixAlpha = sv_dup_inc(proto_perl->IPosixAlpha, param); - - PL_PosixBlank = sv_dup_inc(proto_perl->IPosixBlank, param); - PL_XPosixBlank = sv_dup_inc(proto_perl->IXPosixBlank, param); - - PL_L1Cased = sv_dup_inc(proto_perl->IL1Cased, param); - - PL_PosixCntrl = sv_dup_inc(proto_perl->IPosixCntrl, param); - PL_XPosixCntrl = sv_dup_inc(proto_perl->IXPosixCntrl, param); - - PL_PosixDigit = sv_dup_inc(proto_perl->IPosixDigit, param); - - PL_L1PosixGraph = sv_dup_inc(proto_perl->IL1PosixGraph, param); - PL_PosixGraph = sv_dup_inc(proto_perl->IPosixGraph, param); - - PL_L1PosixLower = sv_dup_inc(proto_perl->IL1PosixLower, param); - PL_PosixLower = sv_dup_inc(proto_perl->IPosixLower, param); - - PL_L1PosixPrint = sv_dup_inc(proto_perl->IL1PosixPrint, param); - PL_PosixPrint = sv_dup_inc(proto_perl->IPosixPrint, param); - - PL_L1PosixPunct = sv_dup_inc(proto_perl->IL1PosixPunct, param); - PL_PosixPunct = sv_dup_inc(proto_perl->IPosixPunct, param); - - PL_PosixSpace = sv_dup_inc(proto_perl->IPosixSpace, param); - PL_XPosixSpace = sv_dup_inc(proto_perl->IXPosixSpace, param); - - PL_L1PosixUpper = sv_dup_inc(proto_perl->IL1PosixUpper, param); - PL_PosixUpper = sv_dup_inc(proto_perl->IPosixUpper, param); - - PL_L1PosixWord = sv_dup_inc(proto_perl->IL1PosixWord, param); - PL_PosixWord = sv_dup_inc(proto_perl->IPosixWord, param); - - PL_PosixXDigit = sv_dup_inc(proto_perl->IPosixXDigit, param); - PL_XPosixXDigit = sv_dup_inc(proto_perl->IXPosixXDigit, param); - - PL_VertSpace = sv_dup_inc(proto_perl->IVertSpace, param); - PL_NonL1NonFinalFold = sv_dup_inc(proto_perl->INonL1NonFinalFold, param); PL_HasMultiCharFold= sv_dup_inc(proto_perl->IHasMultiCharFold, param); /* utf8 character class swashes */ - PL_utf8_alnum = sv_dup_inc(proto_perl->Iutf8_alnum, param); - PL_utf8_alnumc = sv_dup_inc(proto_perl->Iutf8_alnumc, param); - PL_utf8_alpha = sv_dup_inc(proto_perl->Iutf8_alpha, param); - PL_utf8_graph = sv_dup_inc(proto_perl->Iutf8_graph, param); - PL_utf8_digit = sv_dup_inc(proto_perl->Iutf8_digit, param); - PL_utf8_upper = sv_dup_inc(proto_perl->Iutf8_upper, param); - PL_utf8_lower = sv_dup_inc(proto_perl->Iutf8_lower, param); - PL_utf8_print = sv_dup_inc(proto_perl->Iutf8_print, param); - PL_utf8_punct = sv_dup_inc(proto_perl->Iutf8_punct, param); + for (i = 0; i < POSIX_SWASH_COUNT; i++) { + PL_utf8_swash_ptrs[i] = sv_dup_inc(proto_perl->Iutf8_swash_ptrs[i], param); + } + for (i = 0; i < POSIX_CC_COUNT; i++) { + PL_Posix_ptrs[i] = sv_dup_inc(proto_perl->IPosix_ptrs[i], param); + PL_L1Posix_ptrs[i] = sv_dup_inc(proto_perl->IL1Posix_ptrs[i], param); + PL_XPosix_ptrs[i] = sv_dup_inc(proto_perl->IXPosix_ptrs[i], param); + } PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark, param); PL_utf8_X_regular_begin = sv_dup_inc(proto_perl->Iutf8_X_regular_begin, param); PL_utf8_X_extend = sv_dup_inc(proto_perl->Iutf8_X_extend, param); @@ -13656,6 +13599,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_utf8_idstart = sv_dup_inc(proto_perl->Iutf8_idstart, param); PL_utf8_xidstart = sv_dup_inc(proto_perl->Iutf8_xidstart, param); PL_utf8_perl_idstart = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param); + PL_utf8_perl_idcont = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param); PL_utf8_idcont = sv_dup_inc(proto_perl->Iutf8_idcont, param); PL_utf8_xidcont = sv_dup_inc(proto_perl->Iutf8_xidcont, param); PL_utf8_foldable = sv_dup_inc(proto_perl->Iutf8_foldable, param);