diff options
| -rw-r--r-- | dump.c | 10 | ||||
| -rw-r--r-- | ext/Devel-Peek/t/Peek.t | 6 | ||||
| -rw-r--r-- | gv.h | 2 | ||||
| -rw-r--r-- | mg.c | 9 | ||||
| -rw-r--r-- | sv.c | 2 | ||||
| -rw-r--r-- | sv.h | 55 | ||||
| -rw-r--r-- | util.c | 15 |
7 files changed, 24 insertions, 75 deletions
@@ -1508,17 +1508,11 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo } } /* FALLTHROUGH */ + case SVt_PVMG: default: - do_uv: if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,"); break; - case SVt_PVMG: - if (SvVALID(sv)) { - sv_catpv(d, "VALID,"); - if (SvTAIL(sv)) - sv_catpv(d, "TAIL,"); - } - goto do_uv; + case SVt_PVAV: break; } diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 52f75bfd60..07f651073b 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -1048,7 +1048,7 @@ unless ($Config{useithreads}) { do_test('string constant now an FBM', perl, 'SV = PVMG\\($ADDR\\) at $ADDR REFCNT = 5 - FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK,VALID\\) + FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\) PV = $ADDR "rule"\\\0 CUR = 4 LEN = \d+ @@ -1068,7 +1068,7 @@ unless ($Config{useithreads}) { do_test('string constant still an FBM', perl, 'SV = PVMG\\($ADDR\\) at $ADDR REFCNT = 5 - FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK,VALID\\) + FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\) PV = $ADDR "rule"\\\0 CUR = 4 LEN = \d+ @@ -1108,7 +1108,7 @@ unless ($Config{useithreads}) { my $want = 'SV = PVMG\\($ADDR\\) at $ADDR REFCNT = 6 - FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK,VALID\\) + FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\) PV = $ADDR "foam"\\\0 CUR = 4 LEN = \d+ @@ -52,7 +52,7 @@ struct gp { (*({ GV * const _gvname_hek = (GV *) (gv); \ assert(isGV_with_GP(_gvname_hek)); \ assert(SvTYPE(_gvname_hek) == SVt_PVGV || SvTYPE(_gvname_hek) >= SVt_PVLV); \ - assert(!SvVALID(_gvname_hek)); \ + assert(!SvVALID((SV*)_gvname_hek)); \ &(GvXPVGV(_gvname_hek)->xiv_u.xivu_namehek); \ })) # define GvNAME_get(gv) ({ assert(GvNAME_HEK(gv)); (char *)HEK_KEY(GvNAME_HEK(gv)); }) @@ -2443,12 +2443,9 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_SETREGEXP; - if (type == PERL_MAGIC_qr) { - } else if (type == PERL_MAGIC_bm) { - SvVALID_off(sv); - } else { - assert(type == PERL_MAGIC_fm); - } + assert( type == PERL_MAGIC_fm + || type == PERL_MAGIC_qr + || type == PERL_MAGIC_bm); return sv_unmagic(sv, type); } @@ -4741,8 +4741,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) } if (sflags & SVp_IOK) { SvIV_set(dstr, SvIVX(sstr)); - /* Must do this otherwise some other overloaded use of 0x80000000 - gets confused. I guess SVpbm_VALID */ if (sflags & SVf_IVisUV) SvIsUV_on(dstr); } @@ -160,9 +160,7 @@ typedef enum { #define SVt_MASK 0xf /* smallest bitmask that covers all types */ #ifndef PERL_CORE -/* Although Fast Boyer Moore tables are now being stored in PVGVs, for most - purposes external code wanting to consider PVBM probably needs to think of - PVMG instead. */ +/* Fast Boyer Moore tables are now stored in magic attached to PVMGs */ # define SVt_PVBM SVt_PVMG /* Anything wanting to create a reference from clean should ensure that it has a scalar of type SVt_IV now: */ @@ -437,25 +435,10 @@ perform the upgrade if necessary. See C<L</svtype>>. /* Some private flags. */ -/* The SVp_SCREAM|SVpbm_VALID (0x40008000) combination is up for grabs. - Formerly it was used for pad names, but now it is available. The core - is careful to avoid setting both flags. - - SVf_POK, SVp_POK also set: - 0x00004400 Normal - 0x40004400 FBM compiled (SvVALID) - 0x4000C400 *** Formerly used for pad names *** - - 0x00008000 GV with GP - 0x00008800 RV with PCS imported -*/ /* PVAV */ #define SVpav_REAL 0x40000000 /* free old entries */ /* PVHV */ #define SVphv_LAZYDEL 0x40000000 /* entry in xhv_eiter must be deleted */ -/* This is only set true on a PVGV when it's playing "PVBM", but is tested for - on any regular scalar (anything <= PVLV) */ -#define SVpbm_VALID 0x40000000 /* IV, PVIV, PVNV, PVMG, PVGV and (I assume) PVLV */ #define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */ @@ -558,8 +541,8 @@ struct xpvinvlist { the list, merely toggle this flag */ }; -/* This structure works in 3 ways - regular scalar, GV with GP, or fast - Boyer-Moore. */ +/* This structure works in 2 ways - regular scalar, or GV with GP */ + struct xpvgv { _XPV_HEAD; union _xivu xiv_u; @@ -1119,38 +1102,28 @@ object type. Exposed to perl code via Internals::SvREADONLY(). # define SvCOMPILED_off(sv) #endif -#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define SvVALID(sv) ({ const SV *const _svvalid = (const SV*)(sv); \ - if (SvFLAGS(_svvalid) & SVpbm_VALID && !SvSCREAM(_svvalid)) \ - assert(!isGV_with_GP(_svvalid)); \ - (SvFLAGS(_svvalid) & SVpbm_VALID); \ - }) -# define SvVALID_on(sv) ({ SV *const _svvalid = MUTABLE_SV(sv); \ - assert(!isGV_with_GP(_svvalid)); \ - assert(!SvSCREAM(_svvalid)); \ - (SvFLAGS(_svvalid) |= SVpbm_VALID); \ - }) -# define SvVALID_off(sv) ({ SV *const _svvalid = MUTABLE_SV(sv); \ - assert(!isGV_with_GP(_svvalid)); \ - assert(!SvSCREAM(_svvalid)); \ - (SvFLAGS(_svvalid) &= ~SVpbm_VALID); \ - }) +#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define SvTAIL(sv) ({ const SV *const _svtail = (const SV *)(sv); \ assert(SvTYPE(_svtail) != SVt_PVAV); \ assert(SvTYPE(_svtail) != SVt_PVHV); \ - assert((SvFLAGS(_svtail) & SVpbm_VALID)); \ assert(!(SvFLAGS(_svtail) & (SVf_NOK|SVp_NOK))); \ + assert(SvVALID(_svtail)); \ ((XPVNV*)SvANY(_svtail))->xnv_u.xnv_bm_tail; \ }) #else -# define SvVALID(sv) ((SvFLAGS(sv) & SVpbm_VALID) && !SvSCREAM(sv)) -# define SvVALID_on(sv) (SvFLAGS(sv) |= SVpbm_VALID) -# define SvVALID_off(sv) (SvFLAGS(sv) &= ~SVpbm_VALID) # define SvTAIL(_svtail) (((XPVNV*)SvANY(_svtail))->xnv_u.xnv_bm_tail) - #endif +/* Does the SV have a Boyer-Moore table attached as magic? + * 'VALID' is a poor name, but is kept for historical reasons. */ +#define SvVALID(_svvalid) ( \ + SvSMAGICAL(_svvalid) \ + && SvMAGIC(_svvalid) \ + && (SvMAGIC(_svvalid)->mg_type == PERL_MAGIC_bm \ + || mg_find(_svvalid, PERL_MAGIC_bm)) \ + ) + #define SvRVx(sv) SvRV(sv) #ifdef PERL_DEBUG_COW @@ -731,21 +731,8 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) SvUPGRADE(sv, SVt_PVMG); SvIOK_off(sv); SvNOK_off(sv); - SvVALID_on(sv); - /* "deep magic", the comment used to add. The use of MAGIC itself isn't - really. MAGIC was originally added in 79072805bf63abe5 (perl 5.0 alpha 2) - to call SvVALID_off() if the scalar was assigned to. - - The comment itself (and "deeper magic" below) date back to - 378cc40b38293ffc (perl 2.0). "deep magic" was an annotation on - str->str_pok |= 2; - where the magic (presumably) was that the scalar had a BM table hidden - inside itself. - - As MAGIC is always present on BMs [in Perl 5 :-)], we can use it to store - the table instead of the previous (somewhat hacky) approach of co-opting - the string buffer and storing it after the string. */ + /* add PERL_MAGIC_bm magic holding the FBM lookup table */ assert(!mg_find(sv, PERL_MAGIC_bm)); mg = sv_magicext(sv, NULL, PERL_MAGIC_bm, &PL_vtbl_bm, NULL, 0); |