diff options
| -rw-r--r-- | cv.h | 16 | ||||
| -rw-r--r-- | dump.c | 21 | ||||
| -rw-r--r-- | ext/B/B.xs | 6 | ||||
| -rw-r--r-- | ext/Devel/Peek/t/Peek.t | 18 | ||||
| -rw-r--r-- | op.c | 4 | ||||
| -rw-r--r-- | sv.c | 3 | ||||
| -rw-r--r-- | sv.h | 18 |
7 files changed, 57 insertions, 29 deletions
@@ -27,8 +27,10 @@ struct xpvcv { OP * xcv_start; ANY xcv_xsubany; } xcv_start_u; - OP * xcv_root; - void (*xcv_xsub) (pTHX_ CV*); + union { + OP * xcv_root; + void (*xcv_xsub) (pTHX_ CV*); + } xcv_root_u; GV * xcv_gv; char * xcv_file; long xcv_depth; /* >= 2 indicates recursive call */ @@ -58,8 +60,8 @@ Returns the stash of the CV. #define CvSTASH(sv) ((XPVCV*)SvANY(sv))->xcv_stash #define CvSTART(sv) ((XPVCV*)SvANY(sv))->xcv_start_u.xcv_start -#define CvROOT(sv) ((XPVCV*)SvANY(sv))->xcv_root -#define CvXSUB(sv) ((XPVCV*)SvANY(sv))->xcv_xsub +#define CvROOT(sv) ((XPVCV*)SvANY(sv))->xcv_root_u.xcv_root +#define CvXSUB(sv) ((XPVCV*)SvANY(sv))->xcv_root_u.xcv_xsub #define CvXSUBANY(sv) ((XPVCV*)SvANY(sv))->xcv_start_u.xcv_xsubany #define CvGV(sv) ((XPVCV*)SvANY(sv))->xcv_gv #define CvFILE(sv) ((XPVCV*)SvANY(sv))->xcv_file @@ -92,6 +94,7 @@ Returns the stash of the CV. (esp. useful for special XSUBs) */ #define CVf_CONST 0x0400 /* inlinable sub */ #define CVf_OLDSTYLE 0x0800 +#define CVf_ISXSUB 0x1000 /* CV is an XSUB, not pure perl. */ /* This symbol for optimised communication between toke.c and op.c: */ #define CVf_BUILTIN_ATTRS (CVf_METHOD|CVf_LOCKED|CVf_LVALUE|CVf_ASSERTION) @@ -155,7 +158,10 @@ Returns the stash of the CV. #define CvWEAKOUTSIDE_on(cv) (CvFLAGS(cv) |= CVf_WEAKOUTSIDE) #define CvWEAKOUTSIDE_off(cv) (CvFLAGS(cv) &= ~CVf_WEAKOUTSIDE) -#define CvISXSUB(cv) (CvXSUB(cv) ? TRUE : FALSE) +#define CvISXSUB(cv) (CvFLAGS(cv) & CVf_ISXSUB) +#define CvISXSUB_on(cv) (CvFLAGS(cv) |= CVf_ISXSUB) +#define CvISXSUB_off(cv) (CvFLAGS(cv) &= ~CVf_ISXSUB) + /* =head1 CV reference counts and CvOUTSIDE @@ -1486,15 +1486,22 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo /* FALL THROUGH */ case SVt_PVFM: do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); - if (!CvISXSUB(sv) && CvSTART(sv)) - Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(CvSTART(sv))); - Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv))); - if (CvROOT(sv) && dumpops) - do_op_dump(level+1, file, CvROOT(sv)); - Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv))); - if (CvISXSUB(sv)) { + if (!CvISXSUB(sv)) { + if (CvSTART(sv)) { + Perl_dump_indent(aTHX_ level, file, + " START = 0x%"UVxf" ===> %"IVdf"\n", + PTR2UV(CvSTART(sv)), + (IV)sequence_num(CvSTART(sv))); + } + Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", + PTR2UV(CvROOT(sv))); + if (CvROOT(sv) && dumpops) { + do_op_dump(level+1, file, CvROOT(sv)); + } + } else { SV *constant = cv_const_sv((CV *)sv); + Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv))); if (constant) { Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%"UVxf diff --git a/ext/B/B.xs b/ext/B/B.xs index 8271d0425d..bfccf7d273 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1644,6 +1644,10 @@ CvSTART(cv) B::OP CvROOT(cv) B::CV cv + CODE: + RETVAL = CvISXSUB(cv) ? NULL : CvROOT(cv); + OUTPUT: + RETVAL B::GV CvGV(cv) @@ -1673,7 +1677,7 @@ void CvXSUB(cv) B::CV cv CODE: - ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv)))); + ST(0) = sv_2mortal(newSViv(CvISXSUB(cv) ? PTR2IV(CvXSUB(cv)) : 0)); void diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index 6984571af5..dcd3e108e7 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -32,9 +32,13 @@ sub do_test { # handle DEBUG_LEAKING_SCALARS prefix $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg; - $pattern =~ s/^ *\$XSUBANY *\n/ - ($] < 5.009) ? " XSUBANY = 0\n" : ''; + $pattern =~ s/^ *\$XSUB *\n/ + ($] < 5.009) ? " XSUB = 0\n XSUBANY = 0\n" : ''; /mge; + $pattern =~ s/^ *\$ROOT *\n/ + ($] < 5.009) ? " ROOT = 0x0\n" : ''; + /mge; + print $pattern, "\n" if $DEBUG; @@ -220,8 +224,7 @@ do_test(13, COMP_STASH = $ADDR\\t"main" START = $ADDR ===> \\d+ ROOT = $ADDR - XSUB = 0x0 - $XSUBANY + $XSUB GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*" FILE = ".*\\b(?i:peek\\.t)" DEPTH = 0 @@ -247,8 +250,7 @@ do_test(14, COMP_STASH = $ADDR\\t"main" START = $ADDR ===> \\d+ ROOT = $ADDR - XSUB = 0x0 - $XSUBANY + $XSUB GVGV::GV = $ADDR\\t"main" :: "do_test" FILE = ".*\\b(?i:peek\\.t)" DEPTH = 1 @@ -493,7 +495,7 @@ do_test(23, NV = 0 PROTOTYPE = "" COMP_STASH = 0x0 - ROOT = 0x0 + $ROOT XSUB = $ADDR XSUBANY = $ADDR \\(CONST SV\\) SV = PV\\($ADDR\\) at $ADDR @@ -507,7 +509,7 @@ do_test(23, DEPTH = 0 (?: MUTEXP = $ADDR OWNER = $ADDR -)? FLAGS = 0x400 +)? FLAGS = 0x1400 OUTSIDE_SEQ = 0 PADLIST = 0x0 OUTSIDE = 0x0 \\(null\\)'); @@ -4295,7 +4295,7 @@ Perl_cv_undef(pTHX_ CV *cv) SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr); CvCONST_off(cv); } - if (CvXSUB(cv)) { + if (CvISXSUB(cv) && CvXSUB(cv)) { CvXSUB(cv) = 0; } /* delete all flags except WEAKOUTSIDE */ @@ -4586,6 +4586,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) CvXSUBANY(cv).any_ptr = const_sv; CvXSUB(cv) = const_sv_xsub; CvCONST_on(cv); + CvISXSUB_on(cv); } else { GvCV(gv) = NULL; @@ -4916,6 +4917,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) (void)gv_fetchfile(filename); CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be an external constant string */ + CvISXSUB_on(cv); CvXSUB(cv) = subaddr; if (name) { @@ -9824,7 +9824,8 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) /* NOTE: not refcounted */ CvSTASH(dstr) = hv_dup(CvSTASH(dstr), param); OP_REFCNT_LOCK; - CvROOT(dstr) = OpREFCNT_inc(CvROOT(dstr)); + if (!CvISXSUB(dstr)) + CvROOT(dstr) = OpREFCNT_inc(CvROOT(dstr)); OP_REFCNT_UNLOCK; if (CvCONST(dstr)) { CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(dstr)) ? @@ -434,8 +434,10 @@ struct xpvfm { OP * xcv_start; ANY xcv_xsubany; } xcv_start_u; - OP * xcv_root; - void (*xcv_xsub)(pTHX_ CV*); + union { + OP * xcv_root; + void (*xcv_xsub) (pTHX_ CV*); + } xcv_root_u; GV * xcv_gv; char * xcv_file; long xcv_depth; /* >= 2 indicates recursive call */ @@ -460,10 +462,14 @@ typedef struct { HV* xmg_stash; /* class package */ HV * xcv_stash; - OP * xcv_start; - OP * xcv_root; - void (*xcv_xsub)(pTHX_ CV*); - ANY xcv_xsubany; + union { + OP * xcv_start; + ANY xcv_xsubany; + } xcv_start_u; + union { + OP * xcv_root; + void (*xcv_xsub) (pTHX_ CV*); + } xcv_root_u; GV * xcv_gv; char * xcv_file; long xcv_depth; /* >= 2 indicates recursive call */ |