X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/6379d4a9afb32e86e55704579c9ac81237309672..2cc5c789bc534d97c91560f0dfc3d9cba5874437:/cop.h diff --git a/cop.h b/cop.h index 0cfeb44..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) \ @@ -387,9 +377,9 @@ struct cop { line_t cop_line; /* line # of this command */ /* label for this construct is now stored in cop_hints_hash */ #ifdef USE_ITHREADS - char * cop_stashpv; /* package line was compiled in */ + PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the + package the line was compiled in */ char * cop_file; /* file name the following line # is from */ - I32 cop_stashlen; /* negative for UTF8 */ #else HV * cop_stash; /* package line was compiled in */ GV * cop_filegv; /* file the following line # is from */ @@ -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,47 +410,16 @@ 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 CopSTASHPV(c) ((c)->cop_stashpv) - -# ifdef NETWARE -# define CopSTASHPV_set(c,pv,n) ((c)->cop_stashpv = \ - ((pv) ? savepvn(pv,n) : NULL)) -# else -# define CopSTASHPV_set(c,pv,n) ((c)->cop_stashpv = (pv) \ - ? savesharedpvn(pv,n) : NULL) -# endif -# define CopSTASH_len_set(c,n) ((c)->cop_stashlen = (n)) -# define CopSTASH_len(c) ((c)->cop_stashlen) - -# define CopSTASH(c) (CopSTASHPV(c) \ - ? gv_stashpvn(CopSTASHPV(c), \ - CopSTASH_len(c) < 0 \ - ? -CopSTASH_len(c) \ - : CopSTASH_len(c), \ - GV_ADD|SVf_UTF8*(CopSTASH_len(c) < 0) \ - ) \ - : NULL) -# define CopSTASH_set(c,hv) (CopSTASHPV_set(c, \ - (hv) ? HvNAME_get(hv) : NULL, \ - (hv) ? HvNAMELEN(hv) : 0), \ - CopSTASH_len_set(c, \ - (hv) ? HvNAMEUTF8(hv) \ - ? -HvNAMELEN(hv) \ - : HvNAMELEN(hv) \ - : 0)) -# define CopSTASH_eq(c,hv) ((hv) && stashpv_hvname_match(c,hv)) +# define CopSTASH(c) PL_stashpad[(c)->cop_stashoff] +# define CopSTASH_set(c,hv) ((c)->cop_stashoff = (hv) \ + ? alloccopstash(hv) \ + : 0) # ifdef NETWARE -# define CopSTASH_free(c) SAVECOPSTASH_FREE(c) # define CopFILE_free(c) SAVECOPFILE_FREE(c) # else -# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c)) # define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL)) # endif #else @@ -475,19 +434,19 @@ 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 CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL) - /* cop_stash is not refcounted */ -# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) -# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) -# define CopSTASH_free(c) # define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL)) #endif /* USE_ITHREADS */ +#define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL) + /* cop_stash is not refcounted */ +#define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +#define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) + #define CopHINTHASH_get(c) ((COPHH*)((c)->cop_hints_hash)) #define CopHINTHASH_set(c,h) ((c)->cop_hints_hash = (h)) @@ -575,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); \ @@ -613,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))); \ @@ -628,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); \ @@ -654,6 +617,8 @@ 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) #define POP_SAVEARRAY() \ @@ -673,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))); \ @@ -683,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); \ @@ -694,19 +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); \ - 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 { @@ -744,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 @@ -809,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); @@ -994,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 */ @@ -1074,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 */ @@ -1081,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. @@ -1159,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{} */ \ @@ -1182,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. @@ -1207,18 +1188,26 @@ See L. U8 hasargs = 0 /* used by PUSHSUB */ #define PUSH_MULTICALL(the_cv) \ + PUSH_MULTICALL_FLAGS(the_cv, 0) + +/* 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_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); \ - if (++CvDEPTH(cv) >= 2) { \ + if (!(flags & CXp_SUB_RE_FAKE)) \ + CvDEPTH(cv)++; \ + if (CvDEPTH(cv) >= 2) { \ PERL_STACK_OVERFLOW_CHECK(); \ Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ } \ @@ -1236,8 +1225,10 @@ See L. #define POP_MULTICALL \ STMT_START { \ - if (! --CvDEPTH(multicall_cv)) \ - LEAVESUB(multicall_cv); \ + cx = &cxstack[cxstack_ix]; \ + if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) { \ + LEAVESUB(multicall_cv); \ + } \ POPBLOCK(cx,PL_curpm); \ POPSTACK; \ CATCH_SET(multicall_oldcatch); \ @@ -1245,12 +1236,38 @@ See L. SPAGAIN; \ } STMT_END +/* Change the CV of an already-pushed MULTICALL CxSUB block. + * (this isn't part of the public API) */ + +#define CHANGE_MULTICALL_FLAGS(the_cv, flags) \ + STMT_START { \ + CV * const _nOnclAshIngNamE_ = the_cv; \ + CV * const cv = _nOnclAshIngNamE_; \ + 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 = (CXt_SUB|CXp_MULTICALL|flags); \ + PUSHSUB(cx); \ + if (!(flags & CXp_SUB_RE_FAKE)) \ + CvDEPTH(cv)++; \ + if (CvDEPTH(cv) >= 2) { \ + PERL_STACK_OVERFLOW_CHECK(); \ + Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ + } \ + SAVECOMPPAD(); \ + PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ + multicall_cv = cv; \ + multicall_cop = CvSTART(cv); \ + } STMT_END /* * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */