diff options
| -rw-r--r-- | embed.fnc | 3 | ||||
| -rw-r--r-- | gv.c | 22 | ||||
| -rw-r--r-- | hv.c | 28 | ||||
| -rw-r--r-- | hv.h | 8 | ||||
| -rw-r--r-- | op.c | 4 | ||||
| -rw-r--r-- | pp.c | 3 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | sv.c | 32 | ||||
| -rw-r--r-- | toke.c | 9 | ||||
| -rw-r--r-- | xsutils.c | 4 |
10 files changed, 66 insertions, 49 deletions
@@ -1434,8 +1434,7 @@ Apo |I32* |hv_riter_p |HV* hv Apo |HE** |hv_eiter_p |HV* hv Apo |void |hv_riter_set |HV* hv|I32 riter Apo |void |hv_eiter_set |HV* hv|HE* eiter -Apo |char** |hv_name_p |HV* hv -Apo |void |hv_name_set |HV* hv|const char *|STRLEN len|int flags +Apo |void |hv_name_set |HV* hv|const char *|I32 len|int flags Apo |I32* |hv_placeholders_p |HV* hv Apo |I32 |hv_placeholders_get |HV* hv Apo |void |hv_placeholders_set |HV* hv|I32 ph @@ -246,8 +246,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) /* create and re-create @.*::SUPER::ISA on demand */ if (!av || !SvMAGIC(av)) { - /* FIXME - get this from the symtab magic. */ - STRLEN packlen = strlen(hvname); + STRLEN packlen = HvNAMELEN_get(stash); if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) { HV* basestash; @@ -493,16 +492,18 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) GV* vargv; SV* varsv; const char *packname = ""; + STRLEN packname_len; if (len == S_autolen && strnEQ(name, S_autoload, S_autolen)) return Nullgv; if (stash) { if (SvTYPE(stash) < SVt_PVHV) { - packname = SvPV_nolen((SV*)stash); + packname = SvPV((SV*)stash, packname_len); stash = Nullhv; } else { packname = HvNAME_get(stash); + packname_len = HvNAMELEN_get(stash); } } if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE))) @@ -547,7 +548,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) gv_init(vargv, varstash, S_autoload, S_autolen, FALSE); LEAVE; varsv = GvSV(vargv); - sv_setpv(varsv, packname); + sv_setpvn(varsv, packname, packname_len); sv_catpvn(varsv, "::", 2); sv_catpvn(varsv, name, len); SvTAINTED_off(varsv); @@ -1126,6 +1127,7 @@ void Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain) { const char *name; + STRLEN namelen; const HV * const hv = GvSTASH(gv); if (!hv) { SvOK_off(sv); @@ -1134,11 +1136,15 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain) sv_setpv(sv, prefix ? prefix : ""); name = HvNAME_get(hv); - if (!name) + if (name) { + namelen = HvNAMELEN_get(hv); + } else { name = "__ANON__"; + namelen = 8; + } if (keepmain || strNE(name, "main")) { - sv_catpv(sv,name); + sv_catpvn(sv,name,namelen); sv_catpvn(sv,"::", 2); } sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv)); @@ -1309,10 +1315,10 @@ Perl_gp_free(pTHX_ GV *gv) /* FIXME - another reference loop GV -> symtab -> GV ? Somehow gp->gp_hv can end up pointing at freed garbage. */ if (gp->gp_hv && SvTYPE(gp->gp_hv) == SVt_PVHV) { - /* FIXME strlen HvNAME */ const char *hvname = HvNAME_get(gp->gp_hv); if (PL_stashcache && hvname) - hv_delete(PL_stashcache, hvname, strlen(hvname), G_DISCARD); + hv_delete(PL_stashcache, hvname, HvNAMELEN_get(gp->gp_hv), + G_DISCARD); SvREFCNT_dec(gp->gp_hv); } if (gp->gp_io) SvREFCNT_dec(gp->gp_io); @@ -1627,7 +1627,8 @@ S_hfreeentries(pTHX_ HV *hv) HvLAZYDEL_off(hv); hv_free_ent(hv, entry); } - Safefree(iter->xhv_name); + if (iter->xhv_name) + unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0); Safefree(iter); ((XPVHV*) SvANY(hv))->xhv_aux = 0; } @@ -1653,9 +1654,8 @@ Perl_hv_undef(pTHX_ HV *hv) hfreeentries(hv); Safefree(HvARRAY(hv)); if ((name = HvNAME_get(hv))) { - /* FIXME - strlen HvNAME */ if(PL_stashcache) - hv_delete(PL_stashcache, name, strlen(name), G_DISCARD); + hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD); Perl_hv_name_set(aTHX_ hv, 0, 0, 0); } xhv->xhv_max = 7; /* HvMAX(hv) = 7 (it's a normal hash) */ @@ -1787,32 +1787,24 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) { iter->xhv_eiter = eiter; } - -char ** -Perl_hv_name_p(pTHX_ HV *hv) -{ - struct xpvhv_aux *iter = ((XPVHV *)SvANY(hv))->xhv_aux; - - if (!iter) { - ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX); - } - return &(iter->xhv_name); -} - void -Perl_hv_name_set(pTHX_ HV *hv, const char *name, STRLEN len, int flags) +Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags) { struct xpvhv_aux *iter = ((XPVHV *)SvANY(hv))->xhv_aux; + U32 hash; if (iter) { - Safefree(iter->xhv_name); + if (iter->xhv_name) { + unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0); + } } else { if (name == 0) return; ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX); } - iter->xhv_name = savepvn(name, len); + PERL_HASH(hash, name, len); + iter->xhv_name = name ? share_hek(name, len, hash) : 0; } /* @@ -34,7 +34,7 @@ struct hek { Don't access this directly. */ struct xpvhv_aux { - char *xhv_name; /* name, if a symbol table */ + HEK *xhv_name; /* name, if a symbol table */ HE *xhv_eiter; /* current entry of iterator */ I32 xhv_riter; /* current root of iterator */ }; @@ -224,11 +224,13 @@ C<SV*>. ((struct xpvhv_aux*)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_riter : -1) #define HvEITER_get(hv) (((XPVHV *)SvANY(hv))->xhv_aux ? \ ((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_eiter : 0) -#define HvNAME(hv) (*Perl_hv_name_p(aTHX_ (HV*)hv)) +#define HvNAME(hv) HvNAME_get(hv) /* FIXME - all of these should use a UTF8 aware API, which should also involve getting the length. */ #define HvNAME_get(hv) (((XPVHV *)SvANY(hv))->xhv_aux ? \ - ((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name : 0) + (((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name) ? HEK_KEY(((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name) : 0 : 0) +#define HvNAMELEN_get(hv) (((XPVHV *)SvANY(hv))->xhv_aux ? \ + (((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name) ? HEK_LEN(((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name) : 0 : 0) /* the number of keys (including any placeholers) */ #define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys) @@ -1535,7 +1535,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my) ENTER; /* need to protect against side-effects of 'use' */ SAVEINT(PL_expect); if (stash) - stashsv = newSVpv(HvNAME_get(stash), 0); + stashsv = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash)); else stashsv = &PL_sv_no; @@ -1588,7 +1588,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) /* Build up the real arg-list. */ if (stash) - stashsv = newSVpv(HvNAME_get(stash), 0); + stashsv = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash)); else stashsv = &PL_sv_no; arg = newOP(OP_PADSV, 0); @@ -601,7 +601,8 @@ PP(pp_gelem) case 'P': if (strEQ(elem2, "ACKAGE")) { const char *name = HvNAME_get(GvSTASH(gv)); - sv = newSVpv(name ? name : "__ANON__", 0); + sv = newSVpvn(name ? name : "__ANON__", + name ? HvNAMELEN_get(GvSTASH(gv)) : 8); } break; case 'S': @@ -2530,7 +2530,7 @@ PERL_CALLCONV HE** Perl_hv_eiter_p(pTHX_ HV* hv); PERL_CALLCONV void Perl_hv_riter_set(pTHX_ HV* hv, I32 riter); PERL_CALLCONV void Perl_hv_eiter_set(pTHX_ HV* hv, HE* eiter); PERL_CALLCONV char** Perl_hv_name_p(pTHX_ HV* hv); -PERL_CALLCONV void Perl_hv_name_set(pTHX_ HV* hv, const char *, STRLEN len, int flags); +PERL_CALLCONV void Perl_hv_name_set(pTHX_ HV* hv, const char *, I32 len, int flags); PERL_CALLCONV I32* Perl_hv_placeholders_p(pTHX_ HV* hv); PERL_CALLCONV I32 Perl_hv_placeholders_get(pTHX_ HV* hv); PERL_CALLCONV void Perl_hv_placeholders_set(pTHX_ HV* hv, I32 ph); @@ -10913,16 +10913,29 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param)); SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param)); { - const char *hvname = HvNAME_get((HV*)sstr); struct xpvhv_aux *aux = ((XPVHV *)SvANY(sstr))->xhv_aux; + HEK *hvname = 0; - ((XPVHV *)SvANY(dstr))->xhv_aux = 0; if (aux) { - HvRITER_set((HV*)dstr, HvRITER_get((HV*)sstr)); - /* FIXME strlen HvNAME */ - Perl_hv_name_set(aTHX_ (HV*) dstr, hvname, - hvname ? strlen(hvname) : 0, - 0); + I32 riter = aux->xhv_riter; + + hvname = aux->xhv_name; + if (hvname || riter != -1) { + struct xpvhv_aux *d_aux; + + New(0, d_aux, 1, struct xpvhv_aux); + + d_aux->xhv_riter = riter; + d_aux->xhv_eiter = 0; + d_aux->xhv_name = hvname ? hek_dup(hvname, param) : hvname; + + ((XPVHV *)SvANY(dstr))->xhv_aux = d_aux; + } else { + ((XPVHV *)SvANY(dstr))->xhv_aux = 0; + } + } + else { + ((XPVHV *)SvANY(dstr))->xhv_aux = 0; } if (HvARRAY((HV*)sstr)) { STRLEN i = 0; @@ -11456,6 +11469,7 @@ do_mark_cloneable_stash(pTHX_ SV *sv) const char *hvname = HvNAME_get((HV*)sv); if (hvname) { GV* cloner = gv_fetchmethod_autoload((HV*)sv, "CLONE_SKIP", 0); + STRLEN len = HvNAMELEN_get((HV*)sv); SvFLAGS(sv) |= SVphv_CLONEABLE; /* clone objects by default */ if (cloner && GvCV(cloner)) { dSP; @@ -11464,7 +11478,7 @@ do_mark_cloneable_stash(pTHX_ SV *sv) ENTER; SAVETMPS; PUSHMARK(SP); - XPUSHs(sv_2mortal(newSVpv(hvname, 0))); + XPUSHs(sv_2mortal(newSVpvn(hvname, len))); PUTBACK; call_sv((SV*)GvCV(cloner), G_SCALAR); SPAGAIN; @@ -12314,7 +12328,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, ENTER; SAVETMPS; PUSHMARK(SP); - XPUSHs(sv_2mortal(newSVpv(HvNAME_get(stash), 0))); + XPUSHs(sv_2mortal(newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash)))); PUTBACK; call_sv((SV*)GvCV(cloner), G_DISCARD); FREETMPS; @@ -4346,7 +4346,8 @@ Perl_yylex(pTHX) case KEY___PACKAGE__: yylval.opval = (OP*)newSVOP(OP_CONST, 0, (PL_curstash - ? newSVpv(HvNAME_get(PL_curstash), 0) + ? newSVpvn(HvNAME_get(PL_curstash), + HvNAMELEN_get(PL_curstash)) : &PL_sv_undef)); TERM(THING); @@ -5537,7 +5538,8 @@ S_pending_ident(pTHX) /* might be an "our" variable" */ if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { /* build ops for a bareword */ - SV *sym = newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)), 0); + SV *sym = newSVpvn(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)), + HvNAMELEN_get(PAD_COMPNAME_OURSTASH(tmp))); sv_catpvn(sym, "::", 2); sv_catpv(sym, PL_tokenbuf+1); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); @@ -9738,7 +9740,8 @@ S_scan_inputsymbol(pTHX_ char *start) if ((tmp = pad_findmy(d)) != NOT_IN_PAD) { if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { SV *sym = sv_2mortal( - newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)),0)); + newSVpvn(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)), + HvNAMELEN_get(PAD_COMPNAME_OURSTASH(tmp)))); sv_catpvn(sym, "::", 2); sv_catpv(sym, d+1); d = SvPVX(sym); @@ -258,7 +258,7 @@ usage: sv = SvRV(rv); if (SvOBJECT(sv)) - sv_setpv(TARG, HvNAME_get(SvSTASH(sv))); + sv_setpvn(TARG, HvNAME_get(SvSTASH(sv)), HvNAMELEN_get(SvSTASH(sv))); #if 0 /* this was probably a bad idea */ else if (SvPADMY(sv)) sv_setsv(TARG, &PL_sv_no); /* unblessed lexical */ @@ -284,7 +284,7 @@ usage: break; } if (stash) - sv_setpv(TARG, HvNAME_get(stash)); + sv_setpvn(TARG, HvNAME_get(stash), HvNAMELEN_get(stash)); } SvSETMAGIC(TARG); |