X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=bd49a28e2287156c4e36256904762ce0ab38281a;hb=97972285a7cc3296dc99230fa10f7a030afa733f;hp=85751576dd551feadac5ed271d0fd9464ef801b0;hpb=50adf7d25d4fa2ebde52a8067c5d9b35f5c7c054;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index 8575157..bd49a28 100644 --- a/sv.c +++ b/sv.c @@ -758,15 +758,12 @@ S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ, else { U32 u; CV *cv = find_runcv(&u); - STRLEN len; - const char *str; if (!cv || !CvPADLIST(cv)) return Nullsv;; av = (AV*)(*av_fetch(CvPADLIST(cv), 0, FALSE)); sv = *av_fetch(av, targ, FALSE); /* SvLEN in a pad name is not to be trusted */ - str = SvPV_const(sv,len); - sv_setpvn(name, str, len); + sv_setpv(name, SvPV_nolen_const(sv)); } if (subscript_type == FUV_SUBSCRIPT_HASH) { @@ -1757,7 +1754,7 @@ You generally want to use the C macro wrapper. See also C. =cut */ -bool +void Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) { @@ -1774,7 +1771,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) } if (SvTYPE(sv) == mt) - return TRUE; + return; pv = NULL; cur = 0; @@ -1969,7 +1966,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) SvLEN_set(sv, len); break; } - return TRUE; } /* @@ -3779,7 +3775,7 @@ char * Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) { sv_utf8_downgrade(sv,0); - return SvPV(sv,*lp); + return lp ? SvPV(sv,*lp) : SvPV_nolen(sv); } /* @@ -3943,11 +3939,11 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags) } if (hibit) { STRLEN len = SvCUR(sv) + 1; /* Plus the \0 */ - char *recoded = bytes_to_utf8((U8*)s, &len); + U8 *recoded = bytes_to_utf8((U8*)s, &len); SvPV_free(sv); /* No longer using what was there before. */ - SvPV_set(sv, recoded); + SvPV_set(sv, (char*)recoded); SvCUR_set(sv, len - 1); SvLEN_set(sv, len); /* No longer know the real size. */ } @@ -4562,16 +4558,13 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) #endif { /* SvIsCOW_shared_hash */ - UV hash = SvSHARED_HASH(sstr); DEBUG_C(PerlIO_printf(Perl_debug_log, "Copy on write: Sharing hash\n")); - assert (SvTYPE(dstr) >= SVt_PVIV); + assert (SvTYPE(dstr) >= SVt_PV); SvPV_set(dstr, - sharepvn(SvPVX_const(sstr), - (sflags & SVf_UTF8?-cur:cur), hash)); - SvUV_set(dstr, hash); - } + HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr))))); + } SvLEN_set(dstr, len); SvCUR_set(dstr, cur); SvREADONLY_on(dstr); @@ -4708,11 +4701,9 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr) if (SvLEN(sstr) == 0) { /* source is a COW shared hash key. */ - UV hash = SvSHARED_HASH(sstr); DEBUG_C(PerlIO_printf(Perl_debug_log, "Fast copy on write: Sharing hash\n")); - SvUV_set(dstr, hash); - new_pv = sharepvn(SvPVX_const(sstr), (SvUTF8(sstr)?-cur:cur), hash); + new_pv = HEK_KEY(share_hek_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)))); goto common_exit; } SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr)); @@ -4896,8 +4887,7 @@ Perl_sv_usepvn_mg(pTHX_ register SV *sv, register char *ptr, register STRLEN len (which it can do by means other than releasing copy-on-write Svs) or by changing the other copy-on-write SVs in the loop. */ STATIC void -S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN cur, STRLEN len, - U32 hash, SV *after) +S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN len, SV *after) { if (len) { /* this SV was SvIsCOW_normal(sv) */ /* we need to find the SV pointing to us. */ @@ -4924,7 +4914,7 @@ S_sv_release_COW(pTHX_ register SV *sv, const char *pvx, STRLEN cur, STRLEN len, SV_COW_NEXT_SV_SET(current, after); } } else { - unsharepvn(pvx, SvUTF8(sv) ? -(I32)cur : cur, hash); + unshare_hek(SvSHARED_HEK_FROM_PV(pvx)); } } @@ -4963,7 +4953,6 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) const char *pvx = SvPVX_const(sv); const STRLEN len = SvLEN(sv); const STRLEN cur = SvCUR(sv); - const U32 hash = SvSHARED_HASH(sv); SV * const next = SV_COW_NEXT_SV(sv); /* next COW sv in the loop. */ if (DEBUG_C_TEST) { PerlIO_printf(Perl_debug_log, @@ -4985,7 +4974,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) SvCUR_set(sv, cur); *SvEND(sv) = '\0'; } - sv_release_COW(sv, pvx, cur, len, hash, next); + sv_release_COW(sv, pvx, len, next); if (DEBUG_C_TEST) { sv_dump(sv); } @@ -4998,9 +4987,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) if (SvREADONLY(sv)) { if (SvFAKE(sv)) { const char *pvx = SvPVX_const(sv); - const int is_utf8 = SvUTF8(sv); const STRLEN len = SvCUR(sv); - const U32 hash = SvSHARED_HASH(sv); SvFAKE_off(sv); SvREADONLY_off(sv); SvPV_set(sv, Nullch); @@ -5008,7 +4995,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) SvGROW(sv, len + 1); Move(pvx,SvPVX_const(sv),len,char); *SvEND(sv) = '\0'; - unsharepvn(pvx, is_utf8 ? -(I32)len : len, hash); + unshare_hek(SvSHARED_HEK_FROM_PV(pvx)); } else if (IN_PERL_RUNTIME) Perl_croak(aTHX_ PL_no_modify); @@ -6004,8 +5991,8 @@ Perl_sv_clear(pTHX_ register SV *sv) PerlIO_printf(Perl_debug_log, "Copy on write: clear\n"); sv_dump(sv); } - sv_release_COW(sv, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), - SvUVX(sv), SV_COW_NEXT_SV(sv)); + sv_release_COW(sv, SvPVX_const(sv), SvLEN(sv), + SV_COW_NEXT_SV(sv)); /* And drop it here. */ SvFAKE_off(sv); } else if (SvLEN(sv)) { @@ -6016,9 +6003,7 @@ Perl_sv_clear(pTHX_ register SV *sv) else if (SvPVX_const(sv) && SvLEN(sv)) Safefree(SvPVX_const(sv)); else if (SvPVX_const(sv) && SvREADONLY(sv) && SvFAKE(sv)) { - unsharepvn(SvPVX_const(sv), - SvUTF8(sv) ? -(I32)SvCUR(sv) : SvCUR(sv), - SvUVX(sv)); + unshare_hek(SvSHARED_HEK_FROM_PV(SvPVX_const(sv))); SvFAKE_off(sv); } #endif @@ -7729,10 +7714,9 @@ Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash) if (!hash) PERL_HASH(hash, src, len); new_SV(sv); - sv_upgrade(sv, SVt_PVIV); + sv_upgrade(sv, SVt_PV); SvPV_set(sv, sharepvn(src, is_utf8?-len:len, hash)); SvCUR_set(sv, len); - SvUV_set(sv, hash); SvLEN_set(sv, 0); SvREADONLY_on(sv); SvFAKE_on(sv); @@ -10752,22 +10736,11 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param) } else { /* Special case - not normally malloced for some reason */ - if (SvREADONLY(sstr) && SvFAKE(sstr)) { - /* A "shared" PV - clone it as unshared string */ - if(SvPADTMP(sstr)) { - /* However, some of them live in the pad - and they should not have these flags - turned off */ - - SvPV_set(dstr, sharepvn(SvPVX_const(sstr), SvCUR(sstr), - SvUVX(sstr))); - SvUV_set(dstr, SvUVX(sstr)); - } else { - - SvPV_set(dstr, SAVEPVN(SvPVX_const(sstr), SvCUR(sstr))); - SvFAKE_off(dstr); - SvREADONLY_off(dstr); - } + if ((SvREADONLY(sstr) && SvFAKE(sstr))) { + /* A "shared" PV - clone it as "shared" PV */ + SvPV_set(dstr, + HEK_KEY(hek_dup(SvSHARED_HEK_FROM_PV(SvPVX_const(sstr)), + param))); } else { /* Some other special case - random pointer */ @@ -11799,8 +11772,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* create SV map for pointer relocation */ PL_ptr_table = ptr_table_new(); - /* and one for finding shared hash keys quickly */ - PL_shared_hek_table = ptr_table_new(); /* initialize these special pointers as early as possible */ SvANY(&PL_sv_undef) = NULL; @@ -12430,8 +12401,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, if (!(flags & CLONEf_KEEP_PTR_TABLE)) { ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; - ptr_table_free(PL_shared_hek_table); - PL_shared_hek_table = NULL; } /* Call the ->CLONE method, if it exists, for each of the stashes