From: Nicholas Clark Date: Wed, 13 Dec 2006 08:35:43 +0000 (+0000) Subject: Eliminate PVBM. Store fast Boyer-Moore tables in PVGV. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cecf5685359d1599cf3a31ed49f95b583ac5f0da;p=p5sagit%2Fp5-mst-13.2.git Eliminate PVBM. Store fast Boyer-Moore tables in PVGV. Add the placeholder for new type, temporarily named BIND, for binding and aliasing in 6 on 5. p4raw-id: //depot/perl@29544 --- diff --git a/dump.c b/dump.c index cfa4a9b..1853691 100644 --- a/dump.c +++ b/dump.c @@ -32,11 +32,11 @@ static const char* const svtypenames[SVt_LAST] = { "IV", "NV", "RV", + "BIND", "PV", "PVIV", "PVNV", "PVMG", - "PVBM", "PVGV", "PVLV", "PVAV", @@ -52,11 +52,11 @@ static const char* const svshorttypenames[SVt_LAST] = { "IV", "NV", "RV", + "BIND", "PV", "PVIV", "PVNV", "PVMG", - "BM", "GV", "PVLV", "AV", @@ -1429,16 +1429,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo sv_catpv(d, " ),"); } } + if (SvTAIL(sv)) sv_catpv(d, "TAIL,"); + if (SvVALID(sv)) sv_catpv(d, "VALID,"); /* FALL THROUGH */ default: evaled_or_uv: if (SvEVALED(sv)) sv_catpv(d, "EVALED,"); if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,"); break; - case SVt_PVBM: - if (SvTAIL(sv)) sv_catpv(d, "TAIL,"); - if (SvVALID(sv)) sv_catpv(d, "VALID,"); - break; case SVt_PVMG: if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,"); if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,"); @@ -2341,8 +2339,8 @@ Perl_sv_xmlpeek(pTHX_ SV *sv) case SVt_PVGV: sv_catpv(t, " GV=\""); break; - case SVt_PVBM: - sv_catpv(t, " BM=\""); + case SVt_BIND: + sv_catpv(t, " BIND=\""); break; case SVt_PVFM: sv_catpv(t, " FM=\""); diff --git a/ext/B/B.xs b/ext/B/B.xs index 0b021bf..a75c692 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -24,11 +24,16 @@ static const char* const svclassnames[] = { "B::IV", "B::NV", "B::RV", +#if PERL_VERSION >= 9 + "B::BIND", +#endif "B::PV", "B::PVIV", "B::PVNV", "B::PVMG", +#if PERL_VERSION <= 8 "B::BM", +#endif #if PERL_VERSION >= 9 "B::GV", #endif diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index 17a7b5c..aa4b57d 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -3457,7 +3457,9 @@ static int sv_type(pTHX_ SV *sv) if (SvRMAGICAL(sv) && (mg_find(sv, 'p'))) return svis_TIED_ITEM; /* FALL THROUGH */ +#if PERL_VERSION < 9 case SVt_PVBM: +#endif if (SvRMAGICAL(sv) && (mg_find(sv, 'q'))) return svis_TIED; return SvROK(sv) ? svis_REF : svis_SCALAR; @@ -3471,6 +3473,9 @@ static int sv_type(pTHX_ SV *sv) return svis_HASH; case SVt_PVCV: return svis_CODE; +#if PERL_VERSION > 8 + /* case SVt_BIND: */ +#endif default: break; } diff --git a/op.h b/op.h index 5c12c77..d2369df 100644 --- a/op.h +++ b/op.h @@ -460,7 +460,8 @@ struct loop { #ifdef USE_ITHREADS # define cGVOPx_gv(o) ((GV*)PAD_SVl(cPADOPx(o)->op_padix)) -# define IS_PADGV(v) (v && SvTYPE(v) == SVt_PVGV && GvIN_PAD(v)) +# define IS_PADGV(v) (v && SvTYPE(v) == SVt_PVGV && isGV_with_GP(v) \ + && GvIN_PAD(v)) # define IS_PADCONST(v) (v && SvREADONLY(v)) # define cSVOPx_sv(v) (cSVOPx(v)->op_sv \ ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ)) diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 8626f2a..be9fd79 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -405,15 +405,6 @@ These tasks would need C knowledge, and roughly the level of knowledge of the perl API that comes from writing modules that use XS to interface to C. -=head2 shrink Cs - -By removing unused elements and careful re-ordering, the structures for Cs, -Cs, Cs and Cs have recently been shrunk considerably. Cs -probably aren't worth it, as typical programs don't use more than 8, and -(at least) C uses C/C/C on a C, -so it would mean code changes to modules on CPAN. Cs might have some -savings to win. - =head2 autovivification Make all autovivification consistent w.r.t LVALUE/RVALUE and strict/no strict; diff --git a/pp_hot.c b/pp_hot.c index 0b03721..9fe7c70 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -2120,7 +2120,8 @@ PP(pp_subst) !is_cow && #endif (SvREADONLY(TARG) - || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV) + || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) + || SvTYPE(TARG) > SVt_PVLV) && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) DIE(aTHX_ PL_no_modify); PUTBACK; diff --git a/sv.c b/sv.c index b6be97c..e94629d 100644 --- a/sv.c +++ b/sv.c @@ -904,6 +904,9 @@ static const struct body_details bodies_by_type[] = { /* RVs are in the head now. */ { 0, 0, 0, SVt_RV, FALSE, NONV, NOARENA, 0 }, + /* The bind placeholder pretends to be an RV for now. */ + { 0, 0, 0, SVt_BIND, FALSE, NONV, NOARENA, 0 }, + /* 8 bytes on most ILP32 with IEEE doubles */ { sizeof(xpv_allocated), copy_length(XPV, xpv_len) @@ -926,10 +929,6 @@ static const struct body_details bodies_by_type[] = { { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(XPVMG)) }, - /* 36 */ - { sizeof(XPVBM), sizeof(XPVBM), 0, SVt_PVBM, TRUE, HADNV, - HASARENA, FIT_ARENA(0, sizeof(XPVBM)) }, - /* 48 */ { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV, HASARENA, FIT_ARENA(0, sizeof(XPVGV)) }, @@ -1293,7 +1292,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type) assert(!SvNOK(sv)); case SVt_PVIO: case SVt_PVFM: - case SVt_PVBM: case SVt_PVGV: case SVt_PVCV: case SVt_PVLV: @@ -2159,8 +2157,8 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags) dVAR; if (!sv) return 0; - if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) { - /* PVBMs use the same flag bit as SVf_IVisUV, so must let them + if (SvGMAGICAL(sv) || (SvTYPE(sv) == SVt_PVGV && SvVALID(sv))) { + /* FBMs use the same flag bit as SVf_IVisUV, so must let them cache IVs just in case. In practice it seems that they never actually anywhere accessible by user Perl code, let alone get used in anything other than a string context. */ @@ -2243,8 +2241,8 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags) dVAR; if (!sv) return 0; - if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) { - /* PVBMs use the same flag bit as SVf_IVisUV, so must let them + if (SvGMAGICAL(sv) || (SvTYPE(sv) == SVt_PVGV && SvVALID(sv))) { + /* FBMs use the same flag bit as SVf_IVisUV, so must let them cache IVs just in case. */ if (flags & SV_GMAGIC) mg_get(sv); @@ -2320,8 +2318,8 @@ Perl_sv_2nv(pTHX_ register SV *sv) dVAR; if (!sv) return 0.0; - if (SvGMAGICAL(sv) || SvTYPE(sv) == SVt_PVBM) { - /* PVBMs use the same flag bit as SVf_IVisUV, so must let them + if (SvGMAGICAL(sv) || (SvTYPE(sv) == SVt_PVGV && SvVALID(sv))) { + /* FBMs use the same flag bit as SVf_IVisUV, so must let them cache IVs just in case. */ mg_get(sv); if (SvNOKp(sv)) @@ -3453,21 +3451,22 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) } break; + /* case SVt_BIND: */ case SVt_PVGV: - if (dtype <= SVt_PVGV) { + if (isGV_with_GP(sstr) && dtype <= SVt_PVGV) { glob_assign_glob(dstr, sstr, dtype); return; } + /* SvVALID means that this PVGV is playing at being an FBM. */ /*FALLTHROUGH*/ case SVt_PVMG: case SVt_PVLV: - case SVt_PVBM: if (SvGMAGICAL(sstr) && (flags & SV_GMAGIC)) { mg_get(sstr); if (SvTYPE(sstr) != stype) { stype = SvTYPE(sstr); - if (stype == SVt_PVGV && dtype <= SVt_PVGV) { + if (isGV_with_GP(sstr) && stype == SVt_PVGV && dtype <= SVt_PVGV) { glob_assign_glob(dstr, sstr, dtype); return; } @@ -3498,7 +3497,8 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) SvOK_off(dstr); } } else if (sflags & SVf_ROK) { - if (dtype == SVt_PVGV && SvTYPE(SvRV(sstr)) == SVt_PVGV) { + if (isGV_with_GP(dstr) && dtype == SVt_PVGV + && SvTYPE(SvRV(sstr)) == SVt_PVGV) { sstr = SvRV(sstr); if (sstr == dstr) { if (GvIMPORTED(dstr) != GVf_IMPORTED @@ -3532,7 +3532,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) assert(!(sflags & SVf_NOK)); assert(!(sflags & SVf_IOK)); } - else if (dtype == SVt_PVGV) { + else if (dtype == SVt_PVGV && isGV_with_GP(dstr)) { if (!(sflags & SVf_OK)) { if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_MISC), @@ -5106,8 +5106,7 @@ Perl_sv_clear(pTHX_ register SV *sv) } } if (type >= SVt_PVMG) { - if ((type == SVt_PVMG || type == SVt_PVGV) && SvPAD_OUR(sv)) { - assert(type != SVt_PVGV); + if (type == SVt_PVMG && SvPAD_OUR(sv)) { SvREFCNT_dec(OURSTASH(sv)); } else if (SvMAGIC(sv)) mg_free(sv); @@ -5115,6 +5114,7 @@ Perl_sv_clear(pTHX_ register SV *sv) SvREFCNT_dec(SvSTASH(sv)); } switch (type) { + /* case SVt_BIND: */ case SVt_PVIO: if (IoIFP(sv) && IoIFP(sv) != PerlIO_stdin() && @@ -5130,8 +5130,6 @@ Perl_sv_clear(pTHX_ register SV *sv) Safefree(IoFMT_NAME(sv)); Safefree(IoBOTTOM_NAME(sv)); goto freescalar; - case SVt_PVBM: - goto freescalar; case SVt_PVCV: case SVt_PVFM: cv_undef((CV*)sv); @@ -5153,14 +5151,15 @@ Perl_sv_clear(pTHX_ register SV *sv) SvREFCNT_dec(LvTARG(sv)); goto freescalar; case SVt_PVGV: - gp_free((GV*)sv); - if (GvNAME_HEK(sv)) { - unshare_hek(GvNAME_HEK(sv)); - } + if (isGV_with_GP(sv)) { + gp_free((GV*)sv); + if (GvNAME_HEK(sv)) + unshare_hek(GvNAME_HEK(sv)); /* If we're in a stash, we don't own a reference to it. However it does have a back reference to us, which needs to be cleared. */ - if (GvSTASH(sv)) - sv_del_backref((SV*)GvSTASH(sv), sv); + if (!SvVALID(sv) && GvSTASH(sv)) + sv_del_backref((SV*)GvSTASH(sv), sv); + } case SVt_PVMG: case SVt_PVNV: case SVt_PVIV: @@ -7637,7 +7636,6 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob) case SVt_PVIV: case SVt_PVNV: case SVt_PVMG: - case SVt_PVBM: if (SvVOK(sv)) return "VSTRING"; if (SvROK(sv)) @@ -7656,6 +7654,7 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob) case SVt_PVGV: return "GLOB"; case SVt_PVFM: return "FORMAT"; case SVt_PVIO: return "IO"; + case SVt_BIND: return "BIND"; default: return "UNKNOWN"; } } @@ -9877,6 +9876,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) SvANY(dstr) = &(dstr->sv_u.svu_rv); Perl_rvpv_dup(aTHX_ dstr, sstr, param); break; + /* case SVt_BIND: */ default: { /* These are all the types that need complex bodies allocating. */ @@ -9898,7 +9898,6 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) case SVt_PVFM: case SVt_PVHV: case SVt_PVAV: - case SVt_PVBM: case SVt_PVCV: case SVt_PVLV: case SVt_PVMG: @@ -9955,8 +9954,6 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) break; case SVt_PVMG: break; - case SVt_PVBM: - break; case SVt_PVLV: /* XXX LvTARGOFF sometimes holds PMOP* when DEBUGGING */ if (LvTYPE(dstr) == 't') /* for tie: unrefcnted fake (SV**) */ @@ -9967,12 +9964,15 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param); break; case SVt_PVGV: - if (GvNAME_HEK(dstr)) - GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param); + if(isGV_with_GP(sstr)) { + if (GvNAME_HEK(dstr)) + GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param); + } /* Don't call sv_add_backref here as it's going to be created as part of the magic cloning of the symbol table. */ - GvSTASH(dstr) = hv_dup(GvSTASH(dstr), param); + if(!SvVALID(dstr)) + GvSTASH(dstr) = hv_dup(GvSTASH(dstr), param); if(isGV_with_GP(sstr)) { /* Danger Will Robinson - GvGP(dstr) isn't initialised at the point of this comment. */ diff --git a/sv.h b/sv.h index 0519db5..78e8d1b 100644 --- a/sv.h +++ b/sv.h @@ -48,11 +48,12 @@ typedef enum { SVt_IV, /* 1 */ SVt_NV, /* 2 */ SVt_RV, /* 3 */ - SVt_PV, /* 4 */ - SVt_PVIV, /* 5 */ - SVt_PVNV, /* 6 */ - SVt_PVMG, /* 7 */ - SVt_PVBM, /* 8 */ + SVt_BIND, /* 4 */ + SVt_PV, /* 5 */ + SVt_PVIV, /* 6 */ + SVt_PVNV, /* 7 */ + SVt_PVMG, /* 8 */ + /* PVBM was here, before BIND replaced it. */ SVt_PVGV, /* 9 */ SVt_PVLV, /* 10 */ SVt_PVAV, /* 11 */ @@ -63,6 +64,13 @@ typedef enum { SVt_LAST /* keep last in enum. used to size arrays */ } svtype; +#ifndef PERL_CORE +/* Although Fast Boyer Moore tables are now being stored in PVGVs, for most + purposes eternal code wanting to consider PVBM probably needs to think of + PVMG instead. */ +# define SVt_PVBM SVt_PVMG +#endif + /* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL and SVt_IV, so never reaches the clause at the end that uses sv_type_details->body_size to determine whether to call safefree(). Hence @@ -349,7 +357,7 @@ perform the upgrade if necessary. See C. #define SVpav_REAL 0x40000000 /* free old entries */ /* PVHV */ #define SVphv_LAZYDEL 0x40000000 /* entry in xhv_eiter must be deleted */ -/* Not just PVBM - basically anything that can be a regular scalar */ +/* Not just "PVBM" (PVGV) - basically anything that can be a regular scalar */ #define SVpbm_VALID 0x40000000 /* ??? */ #define SVrepl_EVAL 0x40000000 /* Replacement part of s///e */ @@ -363,7 +371,7 @@ perform the upgrade if necessary. See C. #define SVphv_HASKFLAGS 0x80000000 /* keys have flag byte after hash */ /* PVFM */ #define SVpfm_COMPILED 0x80000000 /* FORMLINE is compiled */ -/* PVBM */ +/* PVGV when SVpbm_VALID is true */ #define SVpbm_TAIL 0x80000000 /* RV upwards. However, SVf_ROK and SVp_IOK are exclusive */ #define SVprv_WEAKREF 0x80000000 /* Weak reference */ @@ -503,6 +511,8 @@ struct xpvlv { * y=alem/helem/iter t=tie T=tied HE */ }; +/* This structure works in 3 ways - regular scalar, GV with GP, or fast + Boyer-Moore. */ struct xpvgv { union { NV xnv_nv; @@ -514,7 +524,7 @@ struct xpvgv { IV xivu_iv; UV xivu_uv; void * xivu_p1; - I32 xivu_i32; + I32 xivu_i32; /* is this constant pattern being useful? */ HEK * xivu_namehek; /* GvNAME */ } xiv_u; union { @@ -525,27 +535,6 @@ struct xpvgv { }; -struct xpvbm { - union { - NV xnv_nv; /* numeric value, if any */ - HV * xgv_stash; - } xnv_u; - STRLEN xpv_cur; /* length of svu_pv as a C string */ - STRLEN xpv_len; /* allocated size */ - union { - IV xivu_iv; /* integer value or pv offset */ - UV xivu_uv; - void * xivu_p1; - I32 xivu_i32; /* is this constant pattern being useful? */ - HEK * xivu_namehek; - } xiv_u; - union { - MAGIC* xmg_magic; /* linked list of magicalness */ - HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */ - } xmg_u; - HV* xmg_stash; /* class package */ -}; - /* This structure must match XPVCV in cv.h */ typedef U16 cv_flags_t; @@ -1353,7 +1342,7 @@ the scalar's value cannot change unless written to. #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define BmRARE(sv) \ (*({ SV *const uggh = (SV *) (sv); \ - assert(SvTYPE(uggh) == SVt_PVBM); \ + assert(SvTYPE(uggh) == SVt_PVGV); \ assert(SvVALID(uggh)); \ assert(SvCUR(uggh) + PERL_FBM_TABLE_OFFSET \ + PERL_FBM_RARE_OFFSET_FROM_TABLE <= SvLEN(uggh)); \ @@ -1363,14 +1352,14 @@ the scalar's value cannot change unless written to. })) # define BmUSEFUL(sv) \ (*({ SV *const uggh = (SV *) (sv); \ - assert(SvTYPE(uggh) == SVt_PVBM); \ + assert(SvTYPE(uggh) == SVt_PVGV); \ assert(SvVALID(uggh)); \ assert(!SvIOK(uggh)); \ - &(((XPVBM*) SvANY(uggh))->xiv_u.xivu_i32); \ + &(((XPVGV*) SvANY(uggh))->xiv_u.xivu_i32); \ })) # define BmPREVIOUS(sv) \ ({ SV *const uggh = (SV *) (sv); \ - assert(SvTYPE(uggh) == SVt_PVBM); \ + assert(SvTYPE(uggh) == SVt_PVGV); \ assert(SvVALID(uggh)); \ assert(SvPOKp(uggh)); \ assert(SvCUR(uggh) + PERL_FBM_TABLE_OFFSET <= SvLEN(uggh)); \ @@ -1384,7 +1373,7 @@ the scalar's value cannot change unless written to. (*(U8*)(SvEND(sv) \ + PERL_FBM_TABLE_OFFSET + PERL_FBM_RARE_OFFSET_FROM_TABLE)) -# define BmUSEFUL(sv) ((XPVBM*) SvANY(sv))->xiv_u.xivu_i32 +# define BmUSEFUL(sv) ((XPVGV*) SvANY(sv))->xiv_u.xivu_i32 # define BmPREVIOUS(sv) \ ((*(U8*)(SvEND(sv) + PERL_FBM_TABLE_OFFSET \ + PERL_FBM_PREVIOUS_H_OFFSET_FROM_TABLE) << 8) \ @@ -1393,7 +1382,7 @@ the scalar's value cannot change unless written to. #endif #define BmPREVIOUS_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) == SVt_PVBM); \ + STMT_START { assert(SvTYPE(sv) == SVt_PVGV); \ assert(SvVALID(sv)); \ assert(SvPOKp(sv)); \ assert(SvCUR(sv) + PERL_FBM_TABLE_OFFSET <= SvLEN(sv)); \ diff --git a/util.c b/util.c index 3cd98c0..8dfe417 100644 --- a/util.c +++ b/util.c @@ -490,7 +490,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) s = (U8*)SvPV_force_mutable(sv, len); if (len == 0) /* TAIL might be on a zero-length string. */ return; - SvUPGRADE(sv, SVt_PVBM); + SvUPGRADE(sv, SVt_PVGV); SvIOK_off(sv); if (len > 2) { const unsigned char *sb; @@ -665,7 +665,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit } return NULL; } - if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) { + if (!SvVALID(littlestr)) { char * const b = ninstr((char*)big,(char*)bigend, (char*)little, (char*)little + littlelen); @@ -760,7 +760,8 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift register const unsigned char *littleend; I32 found = 0; - assert(SvTYPE(littlestr) == SVt_PVBM); + assert(SvTYPE(littlestr) == SVt_PVGV); + assert(SvVALID(littlestr)); if (*old_posp == -1 ? (pos = PL_screamfirst[BmRARE(littlestr)]) < 0