X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f32c7e864b6210c7dabe6a78f842c37aa73c56c3..2cc5c789bc534d97c91560f0dfc3d9cba5874437:/cop.h diff --git a/cop.h b/cop.h index 4cf9fe4..37980f0 100644 --- a/cop.h +++ b/cop.h @@ -31,21 +31,13 @@ struct jmpenv { struct jmpenv * je_prev; - Sigjmp_buf je_buf; /* only for use if !je_throw */ + Sigjmp_buf je_buf; /* uninit if je_prev is NULL */ int je_ret; /* last exception thrown */ bool je_mustcatch; /* need to call longjmp()? */ }; typedef struct jmpenv JMPENV; -#ifdef OP_IN_REGISTER -#define OP_REG_TO_MEM PL_opsave = op -#define OP_MEM_TO_REG op = PL_opsave -#else -#define OP_REG_TO_MEM NOOP -#define OP_MEM_TO_REG NOOP -#endif - /* * How to build the first jmpenv. * @@ -58,10 +50,11 @@ typedef struct jmpenv JMPENV; #define JMPENV_BOOTSTRAP \ STMT_START { \ - Zero(&PL_start_env, 1, JMPENV); \ + PERL_POISON_EXPR(PoisonNew(&PL_start_env, 1, JMPENV));\ + PL_top_env = &PL_start_env; \ + PL_start_env.je_prev = NULL; \ PL_start_env.je_ret = -1; \ PL_start_env.je_mustcatch = TRUE; \ - PL_top_env = &PL_start_env; \ } STMT_END /* @@ -107,9 +100,7 @@ typedef struct jmpenv JMPENV; Perl_deb(aTHX_ "JUMPENV_PUSH level=%d at %s:%d\n", \ i, __FILE__, __LINE__);}) \ cur_env.je_prev = PL_top_env; \ - OP_REG_TO_MEM; \ cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \ - OP_MEM_TO_REG; \ PL_top_env = &cur_env; \ cur_env.je_mustcatch = FALSE; \ (v) = cur_env.je_ret; \ @@ -133,7 +124,6 @@ typedef struct jmpenv JMPENV; while (p) { i++; p = p->je_prev; } \ Perl_deb(aTHX_ "JUMPENV_JUMP(%d) level=%d at %s:%d\n", \ (int)v, i, __FILE__, __LINE__);}) \ - OP_REG_TO_MEM; \ if (PL_top_env->je_prev) \ PerlProc_longjmp(PL_top_env->je_buf, (v)); \ if ((v) == 2) \ @@ -410,7 +400,7 @@ struct cop { # ifdef NETWARE # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) -# define CopFILE_setn(c,pv,l) ((c)->cop_file = savepv((pv),(l))) +# define CopFILE_setn(c,pv,l) ((c)->cop_file = savepvn((pv),(l))) # else # define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv)) # define CopFILE_setn(c,pv,l) ((c)->cop_file = savesharedpvn((pv),(l))) @@ -420,12 +410,8 @@ struct cop { ? GvSV(gv_fetchfile(CopFILE(c))) : NULL) # define CopFILEAV(c) (CopFILE(c) \ ? GvAV(gv_fetchfile(CopFILE(c))) : NULL) -# ifdef DEBUGGING -# define CopFILEAVx(c) (assert(CopFILE(c)), \ +# define CopFILEAVx(c) (assert_(CopFILE(c)) \ GvAV(gv_fetchfile(CopFILE(c)))) -# else -# define CopFILEAVx(c) (GvAV(gv_fetchfile(CopFILE(c)))) -# endif # define CopSTASH(c) PL_stashpad[(c)->cop_stashoff] # define CopSTASH_set(c,hv) ((c)->cop_stashoff = (hv) \ @@ -448,8 +434,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)) @@ -548,7 +534,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); \ @@ -586,7 +571,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))); \ @@ -601,16 +588,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); \ @@ -627,6 +617,7 @@ struct block_format { cx->blk_format.gv = gv; \ cx->blk_format.retop = (retop); \ cx->blk_format.dfoutgv = PL_defoutgv; \ + if (!CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv); \ CvDEPTH(cv)++; \ SvREFCNT_inc_void(cx->blk_format.dfoutgv) @@ -647,7 +638,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))); \ @@ -657,7 +651,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); \ @@ -668,20 +662,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)--; \ - 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 { @@ -719,6 +719,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 @@ -784,8 +786,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); @@ -969,6 +971,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 */ @@ -1049,6 +1053,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 */ @@ -1056,6 +1062,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. @@ -1134,8 +1141,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{} */ \ @@ -1157,14 +1163,14 @@ typedef struct stackinfo PERL_SI; =head1 Multicall Functions =for apidoc Ams||dMULTICALL -Declare local variables for a multicall. See L. +Declare local variables for a multicall. See L. =for apidoc Ams||PUSH_MULTICALL Opening bracket for a lightweight callback. See L. =for apidoc Ams||MULTICALL -Make a lightweight callback. See L. +Make a lightweight callback. See L. =for apidoc Ams||POP_MULTICALL Closing bracket for a lightweight callback. @@ -1182,24 +1188,25 @@ 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_; \ - AV * const padlist = CvPADLIST(cv); \ + PADLIST * const padlist = CvPADLIST(cv); \ ENTER; \ multicall_oldcatch = CATCH_GET; \ 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)); \ @@ -1218,7 +1225,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); \ @@ -1231,19 +1239,20 @@ 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_; \ - AV * const padlist = CvPADLIST(cv); \ + PADLIST * const padlist = CvPADLIST(cv); \ cx = &cxstack[cxstack_ix]; \ assert(cx->cx_type & CXp_MULTICALL); \ 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)); \