In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a5c7cb08f7954af4accf63bfffaab1bd61f1dd68?hp=603278a3967e74ac43d71246dfc5ccb5272c0bd3>
- Log ----------------------------------------------------------------- commit a5c7cb08f7954af4accf63bfffaab1bd61f1dd68 Author: David Mitchell <[email protected]> Date: Sat Nov 12 14:48:52 2016 +0000 eliminate SVpbm_VALID flag This flag is set on an SV to indicate that it has PERL_MAGIC_bm (fast Boyer-Moore) magic attached. Instead just directly check whether it has such magic. This frees up the 0x40000000 bit for anything except AVs and HVs M dump.c M ext/Devel-Peek/t/Peek.t M gv.h M mg.c M sv.c M sv.h M util.c commit b4204fb6f01f49bdf8ebb6d68e0f713a505f069a Author: David Mitchell <[email protected]> Date: Sat Nov 12 13:19:58 2016 +0000 eliminate SVpbm_TAIL/SvTAIL_on()/SvTAIL_off() (but keep SvTAIL()) This flag is only set on SVs that have Boyer-Moore magic attached. Such SVs already re-purpose the unused IVX slot of that SV to store BmUSEFUL. This commit repurposes the unused NVX slot to store this boolean value instead. Now that flag bit (0x80000000) is only used with AVs, HVs, RVs and scalar SVs with IOK. M mg.c M sv.h M util.c commit e08d24ff56cda24d8146e29d00376eb23eedbd7e Author: David Mitchell <[email protected]> Date: Sat Nov 12 11:21:43 2016 +0000 Only test SvTAIL when SvVALID Only use the SvTAIL() macro when we've already confirmed that the SV is SvVALID() - this is in preparation for removing the SVpbm_TAIL flag in the next commit M dump.c M sv.h M util.c commit e068d7ce00d1fee2864b3a347fc5eb1f6bfd6250 Author: David Mitchell <[email protected]> Date: Sat Nov 12 11:02:24 2016 +0000 S_setup_longest(): SvTAIL() used where always 0 SvTAIL() isn't set on an SV until fbm_compile() has been called, so there's no point testing it before calling fbm_compile() M regcomp.c commit 6432a58ad9a504c2dc834eb0d131a10b4b6c886b Author: David Mitchell <[email protected]> Date: Thu Nov 10 21:38:30 2016 +0000 Eliminate SVrepl_EVAL and SvEVALED() This flag is only used to indicate that the SV holding the text of the replacement part of a s/// has seen at least one /e. Instead, set the IVX field in the SV to a true value. (We already set the NVX field on that SV to indicate a multi-src-line substitution). This is to reduce the number of odd special cases for the SVpbm_VALID flag. M dump.c M ext/Devel-Peek/t/Peek.t M sv.h M toke.c commit 9a70c74b0f460b0c96e443ecdfcb551157e02b51 Author: David Mitchell <[email protected]> Date: Thu Nov 10 20:44:16 2016 +0000 remove DOES's usage of SvSCREAM Currently the SvSCREAM flag is set on a temporary SV whose string value is "isa", but where for the purposes of printing Can't call method "XXX" its name is treated as "DOES" rather than "isa". Instead, set the temp SV's PVX buffer to point to a special static string (PL_isa_DOES) whose value is "isa", but the where the error reporting code can compare the address with PL_isa_DOES and if so, print "DOES" instead. This is to reduce the number of odd special cases for the SvSCREAM flag. M pp_hot.c M sv.h M universal.c commit 4c57ced57467061af9e672665cba30edd3391432 Author: David Mitchell <[email protected]> Date: Thu Nov 10 14:44:10 2016 +0000 remove eval's usage of SvSCREAM Currently the SvSCREAM flag is set on the sv pointed to by cx->blk_eval.cur_text, to indicate that it is ref counted. Instead, use a spare bit in the blk_u16 field of the eval context. This is to reduce the number of odd special cases for the SvSCREAM flag. M cop.h M inline.h M sv.c M sv.h M toke.c commit 8efda520355126b24fb7c81c753eb2028dcc43bd Author: David Mitchell <[email protected]> Date: Sat Nov 12 08:05:53 2016 +0000 op_dump() - remove extra indentation from PMOP When dumping a PMOP, it displays the PMOP-specific fields with an extra set of braces and level of indentation, e.g. { TYPE = match ===> 1 FLAGS = (VOID,SLABBED) PRIVATE = (RTIME) { PMf_PRE /abc/ (RUNTIME) PMFLAGS = (SCANFIRST,ALL) } } This is visually confusing, because child ops are shown in the same way. This commit removes the extra indentation: { TYPE = match ===> 1 FLAGS = (VOID,SLABBED) PRIVATE = (RTIME) PMf_PRE /abc/ (RUNTIME) PMFLAGS = (SCANFIRST,ALL) } M dump.c commit e97ca23069de91e6fba421ba7674397837455073 Author: David Mitchell <[email protected]> Date: Thu Nov 10 13:58:36 2016 +0000 perlguts: add pTHX_ to magic method examples These functions all take an interpreter arg these days. M pod/perlguts.pod commit 3429ffb4f9b0e6212cf116c6f2beff44790c35a8 Author: David Mitchell <[email protected]> Date: Thu Nov 10 13:52:23 2016 +0000 dump.c: don't display an ARRAY's ARYLEN field Originally xav_arylen was an AV field and was displayed by sv_dump. In 2005, this ield was removed, and replaced by PERL_MAGIC_arylen_p magic when needed. A side effect of this is that sv_dump on a magical AV adds PERL_MAGIC_arylen_p magic to the av as a side-effect. Which is undesirable. This commit just omits displaying 'ARYLEN =' altogether. Any arylen magic will already be displayed as part of dumping the AV, so it's redundant. M dump.c M ext/Devel-Peek/Peek.pm M ext/Devel-Peek/t/Peek.t ----------------------------------------------------------------------- Summary of changes: cop.h | 8 +++-- dump.c | 19 ++---------- ext/Devel-Peek/Peek.pm | 4 +-- ext/Devel-Peek/t/Peek.t | 13 ++------- gv.h | 2 +- inline.h | 7 +++-- mg.c | 10 ++----- pod/perlguts.pod | 16 +++++----- pp_hot.c | 4 ++- regcomp.c | 6 +++- sv.c | 4 +-- sv.h | 77 +++++++++++++------------------------------------ toke.c | 27 +++++++++++++---- universal.c | 17 +++++++---- util.c | 35 +++++++--------------- 15 files changed, 102 insertions(+), 147 deletions(-) diff --git a/cop.h b/cop.h index b371379..0443e24 100644 --- a/cop.h +++ b/cop.h @@ -640,8 +640,11 @@ struct block_eval { blku_gimme is actually also only 2 bits, so could be merged with something. */ -#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F) -#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) +/* blk_u16 bit usage for eval contexts: */ + +#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x3F) /* saved PL in_eval */ +#define CxEVAL_TXT_REFCNTED(cx) (((cx)->blk_u16) & 0x40) /* cur_text rc++ */ +#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) /* type of eval op */ /* loop context */ struct block_loop { @@ -961,6 +964,7 @@ L<perlcall>. #define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */ #define EVAL_INREQUIRE 8 /* The code is being required. */ #define EVAL_RE_REPARSING 0x10 /* eval_sv() called with G_RE_REPARSING */ +/* if adding extra bits, make sure they can fit in CxOLD_OP_TYPE() */ /* Support for switching (stack and block) contexts. * This ensures magic doesn't invalidate local stack and cx pointers. diff --git a/dump.c b/dump.c index 3e1b011..1c64449 100644 --- a/dump.c +++ b/dump.c @@ -657,12 +657,8 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) PERL_ARGS_ASSERT_DO_PMOP_DUMP; - if (!pm) { - Perl_dump_indent(aTHX_ level, file, "{}\n"); + if (!pm) return; - } - Perl_dump_indent(aTHX_ level, file, "{\n"); - level++; if (pm->op_pmflags & PMf_ONCE) ch = '?'; else @@ -698,8 +694,6 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : ""); SvREFCNT_dec_NN(tmpsv); } - - Perl_dump_indent(aTHX_ level-1, file, "}\n"); } const struct flag_to_name pmflags_flags_names[] = { @@ -1514,16 +1508,11 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo } } /* FALLTHROUGH */ + case SVt_PVMG: default: - evaled_or_uv: - if (SvEVALED(sv)) sv_catpv(d, "EVALED,"); if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,"); break; - case SVt_PVMG: - if (SvTAIL(sv)) sv_catpv(d, "TAIL,"); - if (SvVALID(sv)) sv_catpv(d, "VALID,"); - /* FALLTHROUGH */ - goto evaled_or_uv; + case SVt_PVAV: break; } @@ -1675,8 +1664,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo (void)PerlIO_putc(file, '\n'); Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv)); Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv)); - Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", - SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0); SvPVCLEAR(d); if (AvREAL(sv)) sv_catpv(d, ",REAL"); if (AvREIFY(sv)) sv_catpv(d, ",REIFY"); diff --git a/ext/Devel-Peek/Peek.pm b/ext/Devel-Peek/Peek.pm index f3ce70f..4ce8b45 100644 --- a/ext/Devel-Peek/Peek.pm +++ b/ext/Devel-Peek/Peek.pm @@ -3,7 +3,7 @@ package Devel::Peek; -$VERSION = '1.25'; +$VERSION = '1.26'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -354,7 +354,6 @@ The output: ARRAY = 0xc7e820 FILL = 0 MAX = 0 - ARYLEN = 0x0 FLAGS = (REAL) Elt No. 0 SV = IV(0xc70f88) at 0xc70f98 @@ -386,7 +385,6 @@ The output: ARRAY = 0x1585820 FILL = 1 MAX = 1 - ARYLEN = 0x0 FLAGS = (REAL) Elt No. 0 SV = IV(0x1577f88) at 0x1577f98 diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 41898fe..07f6510 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -262,7 +262,6 @@ do_test('reference to array', ARRAY = $ADDR FILL = 1 MAX = 1 - ARYLEN = 0x0 FLAGS = \\(REAL\\) Elt No. 0 SV = IV\\($ADDR\\) at $ADDR @@ -936,7 +935,6 @@ SV = PVAV\($ADDR\) at $ADDR ARRAY = $ADDR FILL = 2 MAX = 3 - ARYLEN = 0x0 FLAGS = \(REAL\) Elt No. 0 SV = IV\($ADDR\) at $ADDR @@ -962,7 +960,6 @@ SV = PVAV\($ADDR\) at $ADDR ARRAY = $ADDR FILL = 2 MAX = 3 - ARYLEN = 0x0 FLAGS = \(REAL\) Elt No. 0 SV = IV\($ADDR\) at $ADDR @@ -1048,14 +1045,10 @@ unless ($Config{useithreads}) { eval 'index "", perl'; - # FIXME - really this shouldn't say EVALED. It's a false posistive on - # 0x40000000 being used for several things, not a flag for "I'm in a string - # eval" - do_test('string constant now an FBM', perl, 'SV = PVMG\\($ADDR\\) at $ADDR REFCNT = 5 - FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\) + FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\) PV = $ADDR "rule"\\\0 CUR = 4 LEN = \d+ @@ -1075,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,EVALED\\) + FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\) PV = $ADDR "rule"\\\0 CUR = 4 LEN = \d+ @@ -1115,7 +1108,7 @@ unless ($Config{useithreads}) { my $want = 'SV = PVMG\\($ADDR\\) at $ADDR REFCNT = 6 - FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\) + FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\) PV = $ADDR "foam"\\\0 CUR = 4 LEN = \d+ diff --git a/gv.h b/gv.h index e3357bc..0b08b68 100644 --- a/gv.h +++ b/gv.h @@ -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)); }) diff --git a/inline.h b/inline.h index adcd85d..5d516da 100644 --- a/inline.h +++ b/inline.h @@ -1490,9 +1490,9 @@ S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *namesv) cx->blk_eval.cv = NULL; /* later set by doeval_compile() */ cx->blk_eval.cur_top_env = PL_top_env; - assert(!(PL_in_eval & ~ 0x7F)); + assert(!(PL_in_eval & ~ 0x3F)); assert(!(PL_op->op_type & ~0x1FF)); - cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7); + cx->blk_u16 = (PL_in_eval & 0x3F) | ((U16)PL_op->op_type << 7); } @@ -1505,9 +1505,10 @@ S_cx_popeval(pTHX_ PERL_CONTEXT *cx) assert(CxTYPE(cx) == CXt_EVAL); PL_in_eval = CxOLD_IN_EVAL(cx); + assert(!(PL_in_eval & 0xc0)); PL_eval_root = cx->blk_eval.old_eval_root; sv = cx->blk_eval.cur_text; - if (sv && SvSCREAM(sv)) { + if (sv && CxEVAL_TXT_REFCNTED(cx)) { cx->blk_eval.cur_text = NULL; SvREFCNT_dec_NN(sv); } diff --git a/mg.c b/mg.c index a0ee39d..d0d3b9d 100644 --- a/mg.c +++ b/mg.c @@ -2443,13 +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) { - SvTAIL_off(sv); - 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); } diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 7f72d65..2da946c 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1124,16 +1124,16 @@ applied to that variable. The C<MGVTBL> has five (or sometimes eight) pointers to the following routine types: - int (*svt_get)(SV* sv, MAGIC* mg); - int (*svt_set)(SV* sv, MAGIC* mg); - U32 (*svt_len)(SV* sv, MAGIC* mg); - int (*svt_clear)(SV* sv, MAGIC* mg); - int (*svt_free)(SV* sv, MAGIC* mg); + int (*svt_get) (pTHX_ SV* sv, MAGIC* mg); + int (*svt_set) (pTHX_ SV* sv, MAGIC* mg); + U32 (*svt_len) (pTHX_ SV* sv, MAGIC* mg); + int (*svt_clear)(pTHX_ SV* sv, MAGIC* mg); + int (*svt_free) (pTHX_ SV* sv, MAGIC* mg); - int (*svt_copy)(SV *sv, MAGIC* mg, SV *nsv, + int (*svt_copy) (pTHX_ SV *sv, MAGIC* mg, SV *nsv, const char *name, I32 namlen); - int (*svt_dup)(MAGIC *mg, CLONE_PARAMS *param); - int (*svt_local)(SV *nsv, MAGIC *mg); + int (*svt_dup) (pTHX_ MAGIC *mg, CLONE_PARAMS *param); + int (*svt_local)(pTHX_ SV *nsv, MAGIC *mg); This MGVTBL structure is set at compile-time in F<perl.h> and there are diff --git a/pp_hot.c b/pp_hot.c index cc86d0a..ad0920c 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -4365,6 +4365,8 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) return sv; } +extern char PL_isa_DOES[]; + PERL_STATIC_INLINE HV * S_opmethod_stash(pTHX_ SV* meth) { @@ -4443,7 +4445,7 @@ S_opmethod_stash(pTHX_ SV* meth) && SvOBJECT(ob)))) { Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on unblessed reference", - SVfARG((SvSCREAM(meth) && strEQ(SvPV_nolen_const(meth),"isa")) + SVfARG((SvPVX(meth) == PL_isa_DOES) ? newSVpvs_flags("DOES", SVs_TEMP) : meth)); } diff --git a/regcomp.c b/regcomp.c index e9c7972..ac66432 100644 --- a/regcomp.c +++ b/regcomp.c @@ -6677,7 +6677,11 @@ S_setup_longest(pTHX_ RExC_state_t *pRExC_state, SV* sv_longest, calculate it.*/ ml = minlen ? *(minlen) : (SSize_t)longest_length; *rx_end_shift = ml - offset - - longest_length + (SvTAIL(sv_longest) != 0) + - longest_length + /* XXX SvTAIL is always false here - did you mean FBMcf_TAIL + * intead? - DAPM + + (SvTAIL(sv_longest) != 0) + */ + lookbehind; t = (eol/* Can't have SEOL and MULTI */ diff --git a/sv.c b/sv.c index b2403e3..2257708 100644 --- a/sv.c +++ b/sv.c @@ -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); } @@ -14150,7 +14148,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param) case CXt_EVAL: ncx->blk_eval.old_namesv = sv_dup_inc(ncx->blk_eval.old_namesv, param); - /* XXX should this sv_dup_inc? Or only if SvSCREAM ???? */ + /* XXX should this sv_dup_inc? Or only if CxEVAL_TXT_REFCNTED ???? */ ncx->blk_eval.cur_text = sv_dup(ncx->blk_eval.cur_text, param); ncx->blk_eval.cv = cv_dup(ncx->blk_eval.cv, param); /* XXX what do do with cur_top_env ???? */ diff --git a/sv.h b/sv.h index d45a4a9..b97c175 100644 --- a/sv.h +++ b/sv.h @@ -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: */ @@ -369,8 +367,7 @@ perform the upgrade if necessary. See C<L</svtype>>. #define SVp_IOK 0x00001000 /* has valid non-public integer value */ #define SVp_NOK 0x00002000 /* has valid non-public numeric value */ #define SVp_POK 0x00004000 /* has valid non-public pointer value */ -#define SVp_SCREAM 0x00008000 /* method name is DOES */ - /* eval cx text is ref counted */ +#define SVp_SCREAM 0x00008000 /* currently unused on plain scalars */ #define SVphv_CLONEABLE SVp_SCREAM /* PVHV (stashes) clone its objects */ #define SVpgv_GP SVp_SCREAM /* GV has a valid GP */ #define SVprv_PCS_IMPORTED SVp_SCREAM /* RV is a proxy for a constant @@ -438,28 +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 - 0x0000C400 method name for DOES (SvSCREAM) - 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 -/* Only used in toke.c on an SV stored in PL_lex_repl */ -#define SVrepl_EVAL 0x40000000 /* Replacement part of s///e */ /* IV, PVIV, PVNV, PVMG, PVGV and (I assume) PVLV */ #define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */ @@ -467,8 +446,6 @@ perform the upgrade if necessary. See C<L</svtype>>. #define SVpav_REIFY 0x80000000 /* can become real */ /* PVHV */ #define SVphv_HASKFLAGS 0x80000000 /* keys have flag byte after hash */ -/* PVGV when SVpbm_VALID is true */ -#define SVpbm_TAIL 0x80000000 /* string has a fake "\n" appended */ /* RV upwards. However, SVf_ROK and SVp_IOK are exclusive */ #define SVprv_WEAKREF 0x80000000 /* Weak reference */ /* pad name vars only */ @@ -488,12 +465,15 @@ union _xnvu { NV xnv_nv; /* numeric value, if any */ HV * xgv_stash; line_t xnv_lines; /* used internally by S_scan_subst() */ + bool xnv_bm_tail; /* an SvVALID (BM) SV has an implicit "\n" */ }; union _xivu { IV xivu_iv; /* integer value */ UV xivu_uv; HEK * xivu_namehek; /* xpvlv, xpvgv: GvNAME */ + bool xivu_eval_seen; /* used internally by S_scan_subst() */ + }; union _xmgu { @@ -561,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; @@ -1122,44 +1102,27 @@ object type. Exposed to perl code via Internals::SvREADONLY(). # define SvCOMPILED_off(sv) #endif -#define SvEVALED(sv) (SvFLAGS(sv) & SVrepl_EVAL) -#define SvEVALED_on(sv) (SvFLAGS(sv) |= SVrepl_EVAL) -#define SvEVALED_off(sv) (SvFLAGS(sv) &= ~SVrepl_EVAL) #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); \ - }) - # define SvTAIL(sv) ({ const SV *const _svtail = (const SV *)(sv); \ assert(SvTYPE(_svtail) != SVt_PVAV); \ assert(SvTYPE(_svtail) != SVt_PVHV); \ - assert(!SvSCREAM(_svtail)); \ - (SvFLAGS(sv) & (SVpbm_TAIL|SVpbm_VALID)) \ - == (SVpbm_TAIL|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(sv) ((SvFLAGS(sv) & (SVpbm_TAIL|SVpbm_VALID)) \ - == (SVpbm_TAIL|SVpbm_VALID)) - +# define SvTAIL(_svtail) (((XPVNV*)SvANY(_svtail))->xnv_u.xnv_bm_tail) #endif -#define SvTAIL_on(sv) (SvFLAGS(sv) |= SVpbm_TAIL) -#define SvTAIL_off(sv) (SvFLAGS(sv) &= ~SVpbm_TAIL) + +/* 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) diff --git a/toke.c b/toke.c index ac7b5f3..061b4d3 100644 --- a/toke.c +++ b/toke.c @@ -88,6 +88,11 @@ Individual members of C<PL_parser> have their own documentation. # define PL_nexttype (PL_parser->nexttype) # define PL_nextval (PL_parser->nextval) + +#define SvEVALED(sv) \ + (SvTYPE(sv) >= SVt_PVNV \ + && ((XPVIV*)SvANY(sv))->xiv_u.xivu_eval_seen) + static const char* const ident_too_long = "Identifier too long"; # define NEXTVAL_NEXTTOKE PL_nextval[PL_nexttoke] @@ -9370,6 +9375,7 @@ S_scan_subst(pTHX_ char *start) PMOP *pm; I32 first_start; line_t first_line; + line_t linediff = 0; I32 es = 0; char charset = '\0'; /* character set modifier */ unsigned int x_mod_count = 0; @@ -9433,15 +9439,24 @@ S_scan_subst(pTHX_ char *start) sv_catpvs(repl, "{"); sv_catsv(repl, PL_parser->lex_sub_repl); sv_catpvs(repl, "}"); - SvEVALED_on(repl); + ((XPVIV*)SvANY(PL_parser->lex_sub_repl))->xiv_u.xivu_eval_seen = 1; SvREFCNT_dec(PL_parser->lex_sub_repl); PL_parser->lex_sub_repl = repl; + es = 1; } - if (CopLINE(PL_curcop) != first_line) { - sv_upgrade(PL_parser->lex_sub_repl, SVt_PVNV); - ((XPVNV*)SvANY(PL_parser->lex_sub_repl))->xnv_u.xnv_lines = - CopLINE(PL_curcop) - first_line; + + + linediff = CopLINE(PL_curcop) - first_line; + if (linediff) CopLINE_set(PL_curcop, first_line); + + if (linediff || es) { + /* the IVX field indicates that the replacement string is a s///e; + * the NVX field indicates how many src code lines the replacement + * spreads over */ + sv_upgrade(PL_parser->lex_sub_repl, SVt_PVNV); + ((XPVNV*)SvANY(PL_parser->lex_sub_repl))->xnv_u.xnv_lines = 0; + ((XPVIV*)SvANY(PL_parser->lex_sub_repl))->xiv_u.xivu_eval_seen = es; } PL_lex_op = (OP*)pm; @@ -9716,7 +9731,7 @@ S_scan_heredoc(pTHX_ char *s) && cx->blk_eval.cur_text == linestr) { cx->blk_eval.cur_text = newSVsv(linestr); - SvSCREAM_on(cx->blk_eval.cur_text); + cx->blk_u16 |= 0x40; /* indicate cur_text is ref counted */ } /* Copy everything from s onwards back to d. */ Move(s,d,bufend-s + 1,char); diff --git a/universal.c b/universal.c index 345b75e..b88d3e2 100644 --- a/universal.c +++ b/universal.c @@ -184,6 +184,10 @@ The SV can be a Perl object or the name of a Perl class. #include "XSUB.h" +/* a special string address whose value is "isa", but whicb perl knows + * to treat as if it were really "DOES" */ +char PL_isa_DOES[] = "isa"; + bool Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags) { @@ -222,11 +226,14 @@ Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags) PUSHs(namesv); PUTBACK; - methodname = newSVpvs_flags("isa", SVs_TEMP); - /* ugly hack: use the SvSCREAM flag so S_method_common - * can figure out we're calling DOES() and not isa(), - * and report eventual errors correctly. --rgs */ - SvSCREAM_on(methodname); + /* create a PV with value "isa", but with a special address + * so that perl knows were' realling doing "DOES" instead */ + methodname = newSV_type(SVt_PV); + SvLEN(methodname) = 0; + SvCUR(methodname) = strlen(PL_isa_DOES); + SvPVX(methodname) = PL_isa_DOES; + SvPOK_on(methodname); + sv_2mortal(methodname); call_sv(methodname, G_SCALAR | G_METHOD); SPAGAIN; diff --git a/util.c b/util.c index a69ddad..fb2ddec 100644 --- a/util.c +++ b/util.c @@ -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); @@ -780,8 +767,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) } } BmUSEFUL(sv) = 100; /* Initial value */ - if (flags & FBMcf_TAIL) - SvTAIL_on(sv); + ((XPVNV*)SvANY(sv))->xnv_u.xnv_bm_tail = cBOOL(flags & FBMcf_TAIL); DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %"UVuf"\n", s[rarest], (UV)rarest)); } @@ -825,11 +811,12 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U const unsigned char *little = (const unsigned char *)SvPV_const(littlestr,l); STRLEN littlelen = l; const I32 multiline = flags & FBMrf_MULTILINE; + bool tail = SvVALID(littlestr) ? cBOOL(SvTAIL(littlestr)) : FALSE; PERL_ARGS_ASSERT_FBM_INSTR; if ((STRLEN)(bigend - big) < littlelen) { - if ( SvTAIL(littlestr) + if ( tail && ((STRLEN)(bigend - big) == littlelen - 1) && (littlelen == 1 || (*big == *little && @@ -843,19 +830,19 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U return (char*)big; /* Cannot be SvTAIL! */ case 1: - if (SvTAIL(littlestr) && !multiline) /* Anchor only! */ + if (tail && !multiline) /* Anchor only! */ /* [-1] is safe because we know that bigend != big. */ return (char *) (bigend - (bigend[-1] == '\n')); s = (unsigned char *)memchr((void*)big, *little, bigend-big); if (s) return (char *)s; - if (SvTAIL(littlestr)) + if (tail) return (char *) bigend; return NULL; case 2: - if (SvTAIL(littlestr) && !multiline) { + if (tail && !multiline) { /* a littlestr with SvTAIL must be of the form "X\n" (where X * is a single char). It is anchored, and can only match * "....X\n" or "....X" */ @@ -933,7 +920,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U /* failed to find 2 chars; try anchored match at end without * the \n */ - if (SvTAIL(littlestr) && bigend[0] == little[0]) + if (tail && bigend[0] == little[0]) return (char *)bigend; return NULL; } @@ -942,7 +929,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U break; /* Only lengths 0 1 and 2 have special-case code. */ } - if (SvTAIL(littlestr) && !multiline) { /* tail anchored? */ + if (tail && !multiline) { /* tail anchored? */ s = bigend - littlelen; if (s >= big && bigend[-1] == '\n' && *s == *little /* Automatically of length > 2 */ @@ -963,7 +950,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U char * const b = ninstr((char*)big,(char*)bigend, (char*)little, (char*)little + littlelen); - if (!b && SvTAIL(littlestr)) { /* Automatically multiline! */ + if (!b && tail) { /* Automatically multiline! */ /* Chop \n from littlestr: */ s = bigend - littlelen + 1; if (*s == *little @@ -1035,7 +1022,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U } check_end: if ( s == bigend - && SvTAIL(littlestr) + && tail && memEQ((char *)(bigend - littlelen), (char *)(oldlittle - littlelen), littlelen) ) return (char*)bigend - littlelen; -- Perl5 Master Repository
