X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/b70d55581aad461af858eb07a2e80ed5fcc653c1..61bbb4863a849ae88b9ea67d187db62a76837553:/cop.h diff --git a/cop.h b/cop.h index 7f0dbbd..0741d92 100644 --- a/cop.h +++ b/cop.h @@ -444,8 +444,8 @@ struct cop { # else # define CopFILEAVx(c) (GvAV(CopFILEGV(c))) # endif -# define CopFILE(c) (CopFILEGV(c) && GvSV(CopFILEGV(c)) \ - ? SvPVX(GvSV(CopFILEGV(c))) : NULL) +# define CopFILE(c) (CopFILEGV(c) \ + ? GvNAME(CopFILEGV(c))+2 : NULL) # define CopSTASH(c) ((c)->cop_stash) # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) # define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL)) @@ -544,7 +544,6 @@ be zero. /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */ #define OutCopFILE(c) CopFILE(c) -/* FIXME NATIVE_HINTS if this is changed from op_private (see perl.h) */ #define CopHINTS_get(c) ((c)->cop_hints + 0) #define CopHINTS_set(c, h) STMT_START { \ (c)->cop_hints = (h); \ @@ -582,7 +581,9 @@ struct block_format { * decremented by LEAVESUB, the other by LEAVE. */ #define PUSHSUB_BASE(cx) \ - ENTRY_PROBE(GvENAME(CvGV(cv)), \ + ENTRY_PROBE(CvNAMED(cv) \ + ? HEK_KEY(CvNAME_HEK(cv)) \ + : GvENAME(CvGV(cv)), \ CopFILE((const COP *)CvSTART(cv)), \ CopLINE((const COP *)CvSTART(cv)), \ CopSTASHPV((const COP *)CvSTART(cv))); \ @@ -597,16 +598,19 @@ struct block_format { SAVEFREESV(cv); \ } - -#define PUSHSUB(cx) \ - { \ +#define PUSHSUB_GET_LVALUE_MASK(func) \ /* If the context is indeterminate, then only the lvalue */ \ /* flags that the caller also has are applicable. */ \ - U8 phlags = \ + ( \ (PL_op->op_flags & OPf_WANT) \ ? OPpENTERSUB_LVAL_MASK \ : !(PL_op->op_private & OPpENTERSUB_LVAL_MASK) \ - ? 0 : Perl_was_lvalue_sub(aTHX); \ + ? 0 : (U8)func(aTHX) \ + ) + +#define PUSHSUB(cx) \ + { \ + U8 phlags = PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub); \ PUSHSUB_BASE(cx) \ cx->blk_u16 = PL_op->op_private & \ (phlags|OPpDEREF); \ @@ -644,7 +648,10 @@ struct block_format { #define POPSUB(cx,sv) \ STMT_START { \ - RETURN_PROBE(GvENAME(CvGV((const CV*)cx->blk_sub.cv)), \ + const I32 olddepth = cx->blk_sub.olddepth; \ + RETURN_PROBE(CvNAMED(cx->blk_sub.cv) \ + ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv)) \ + : GvENAME(CvGV(cx->blk_sub.cv)), \ CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \ CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \ CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv))); \ @@ -654,7 +661,7 @@ struct block_format { /* abandon @_ if it got reified */ \ if (AvREAL(cx->blk_sub.argarray)) { \ const SSize_t fill = AvFILLp(cx->blk_sub.argarray); \ - SvREFCNT_dec(cx->blk_sub.argarray); \ + SvREFCNT_dec_NN(cx->blk_sub.argarray); \ cx->blk_sub.argarray = newAV(); \ av_extend(cx->blk_sub.argarray, fill); \ AvREIFY_only(cx->blk_sub.argarray); \ @@ -665,21 +672,26 @@ struct block_format { } \ } \ sv = MUTABLE_SV(cx->blk_sub.cv); \ - if (sv && (CvDEPTH((const CV*)sv) = cx->blk_sub.olddepth)) \ + LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \ + if (sv && (CvDEPTH((const CV*)sv) = olddepth)) \ sv = NULL; \ } STMT_END #define LEAVESUB(sv) \ STMT_START { \ - if (sv) \ - SvREFCNT_dec(sv); \ + SvREFCNT_dec(sv); \ } STMT_END #define POPFORMAT(cx) \ - setdefout(cx->blk_format.dfoutgv); \ - CvDEPTH(cx->blk_format.cv)--; \ - if (!CvDEPTH(cx->blk_format.cv)) SvREFCNT_dec(cx->blk_format.cv); \ - SvREFCNT_dec(cx->blk_format.dfoutgv); + STMT_START { \ + CV * const cv = cx->blk_format.cv; \ + GV * const dfuot = cx->blk_format.dfoutgv; \ + setdefout(dfuot); \ + LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \ + if (!--CvDEPTH(cv)) \ + SvREFCNT_dec_NN(cx->blk_format.cv); \ + SvREFCNT_dec_NN(dfuot); \ + } STMT_END /* eval context */ struct block_eval { @@ -717,6 +729,8 @@ struct block_eval { PL_in_eval = CxOLD_IN_EVAL(cx); \ optype = CxOLD_OP_TYPE(cx); \ PL_eval_root = cx->blk_eval.old_eval_root; \ + if (cx->blk_eval.cur_text && SvSCREAM(cx->blk_eval.cur_text)) \ + SvREFCNT_dec_NN(cx->blk_eval.cur_text); \ if (cx->blk_eval.old_namesv) \ sv_2mortal(cx->blk_eval.old_namesv); \ } STMT_END @@ -782,8 +796,8 @@ struct block_loop { #define POPLOOP(cx) \ if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \ - SvREFCNT_dec(cx->blk_loop.state_u.lazysv.cur); \ - SvREFCNT_dec(cx->blk_loop.state_u.lazysv.end); \ + SvREFCNT_dec_NN(cx->blk_loop.state_u.lazysv.cur); \ + SvREFCNT_dec_NN(cx->blk_loop.state_u.lazysv.end); \ } \ if (CxTYPE(cx) == CXt_LOOP_FOR) \ SvREFCNT_dec(cx->blk_loop.state_u.ary.ary); @@ -967,6 +981,8 @@ struct context { /* private flags for CXt_SUB and CXt_FORMAT */ #define CXp_HASARGS 0x20 +#define CXp_SUB_RE 0x40 /* code called within regex, i.e. (?{}) */ +#define CXp_SUB_RE_FAKE 0x80 /* fake sub CX for (?{}) in current scope */ /* private flags for CXt_EVAL */ #define CXp_REAL 0x20 /* truly eval'', not a lookalike */ @@ -1047,6 +1063,8 @@ L. Perl_magic_methcall(). */ #define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling Perl_magic_methcall(). */ +#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */ +#define G_METHOD_NAMED 4096 /* calling named method, eg without :: or ' */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ @@ -1054,6 +1072,7 @@ L. #define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */ #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 */ /* Support for switching (stack and block) contexts. * This ensures magic doesn't invalidate local stack and cx pointers. @@ -1132,8 +1151,7 @@ typedef struct stackinfo PERL_SI; Perl_deb(aTHX_ "pop STACKINFO %d at %s:%d\n", \ i, __FILE__, __LINE__);}) \ if (!prev) { \ - PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \ - my_exit(1); \ + Perl_croak_popstack(); \ } \ SWITCHSTACK(PL_curstack,prev->si_stack); \ /* don't free prev here, free them all at the END{} */ \ @@ -1180,12 +1198,12 @@ See L. U8 hasargs = 0 /* used by PUSHSUB */ #define PUSH_MULTICALL(the_cv) \ - PUSH_MULTICALL_WITHDEPTH(the_cv, 1); + PUSH_MULTICALL_FLAGS(the_cv, 0) -/* Like PUSH_MULTICALL, but allows you to specify the CvDEPTH increment, - * rather than the default of 1 (this isn't part of the public API) */ +/* Like PUSH_MULTICALL, but allows you to specify extra flags + * for the CX stack entry (this isn't part of the public API) */ -#define PUSH_MULTICALL_WITHDEPTH(the_cv, depth) \ +#define PUSH_MULTICALL_FLAGS(the_cv, flags) \ STMT_START { \ CV * const _nOnclAshIngNamE_ = the_cv; \ CV * const cv = _nOnclAshIngNamE_; \ @@ -1195,9 +1213,10 @@ See L. SAVETMPS; SAVEVPTR(PL_op); \ CATCH_SET(TRUE); \ PUSHSTACKi(PERLSI_SORT); \ - PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp); \ + PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), PL_stack_sp); \ PUSHSUB(cx); \ - CvDEPTH(cv) += depth; \ + if (!(flags & CXp_SUB_RE_FAKE)) \ + CvDEPTH(cv)++; \ if (CvDEPTH(cv) >= 2) { \ PERL_STACK_OVERFLOW_CHECK(); \ Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ @@ -1216,7 +1235,8 @@ See L. #define POP_MULTICALL \ STMT_START { \ - if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) { \ + cx = &cxstack[cxstack_ix]; \ + if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) { \ LEAVESUB(multicall_cv); \ } \ POPBLOCK(cx,PL_curpm); \ @@ -1229,7 +1249,7 @@ See L. /* Change the CV of an already-pushed MULTICALL CxSUB block. * (this isn't part of the public API) */ -#define CHANGE_MULTICALL_WITHDEPTH(the_cv, depth) \ +#define CHANGE_MULTICALL_FLAGS(the_cv, flags) \ STMT_START { \ CV * const _nOnclAshIngNamE_ = the_cv; \ CV * const cv = _nOnclAshIngNamE_; \ @@ -1239,9 +1259,10 @@ See L. if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) { \ LEAVESUB(multicall_cv); \ } \ - cx->cx_type &= ~CXp_HASARGS; \ + cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \ PUSHSUB(cx); \ - CvDEPTH(cv) += depth; \ + if (!(flags & CXp_SUB_RE_FAKE)) \ + CvDEPTH(cv)++; \ if (CvDEPTH(cv) >= 2) { \ PERL_STACK_OVERFLOW_CHECK(); \ Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \