X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/40ba680a17dc8d6a78964c98884ac1cb18695d8a..84721d614eb7d9835d9a09505b0001c7be40a865:/cop.h?ds=sidebyside diff --git a/cop.h b/cop.h index e2d85c1..b371379 100644 --- a/cop.h +++ b/cop.h @@ -175,8 +175,8 @@ associated with the key. /* =for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|const char *key|U32 flags -Like L, but takes a literal string instead of a -string/length pair, and no precomputed hash. +Like L, but takes a C-terminated literal string instead +of a string/length pair, and no precomputed hash. =cut */ @@ -281,8 +281,8 @@ be stored with referential integrity, but will be coerced to strings. /* =for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|const char *key|SV *value|U32 flags -Like L, but takes a literal string instead of a -string/length pair, and no precomputed hash. +Like L, but takes a C-terminated literal string instead +of a string/length pair, and no precomputed hash. =cut */ @@ -338,8 +338,8 @@ hash of the key string, or zero if it has not been precomputed. /* =for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|const char *key|U32 flags -Like L, but takes a literal string instead of a -string/length pair, and no precomputed hash. +Like L, but takes a C-terminated literal string instead +of a string/length pair, and no precomputed hash. =cut */ @@ -478,8 +478,8 @@ associated with the key. /* =for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|const char *key|U32 flags -Like L, but takes a literal string instead of a -string/length pair, and no precomputed hash. +Like L, but takes a C-terminated literal string +instead of a string/length pair, and no precomputed hash. =cut */ @@ -595,22 +595,8 @@ struct block_format { * The context frame holds a reference to the CV so that it can't be * freed while we're executing it */ -#define PUSHSUB_BASE(cx, cv, hasargs) \ - 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))); \ - \ - cx->blk_sub.cv = cv; \ - cx->blk_sub.olddepth = CvDEPTH(cv); \ - cx->blk_sub.prevcomppad = PL_comppad; \ - cx->cx_type |= (hasargs) ? CXp_HASARGS : 0; \ - cx->blk_sub.retop = NULL; \ - SvREFCNT_inc_simple_void_NN(cv); - -#define PUSHSUB_GET_LVALUE_MASK(func) \ + +#define CX_PUSHSUB_GET_LVALUE_MASK(func) \ /* If the context is indeterminate, then only the lvalue */ \ /* flags that the caller also has are applicable. */ \ ( \ @@ -620,38 +606,13 @@ struct block_format { ? 0 : (U8)func(aTHX) \ ) -#define PUSHSUB(cx, cv, hasargs) \ - { \ - U8 phlags = PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub); \ - PUSHSUB_BASE(cx, cv, hasargs) \ - cx->blk_u16 = PL_op->op_private & \ - (phlags|OPpDEREF); \ - } - -/* variant for use by OP_DBSTATE, where op_private holds hint bits */ -#define PUSHSUB_DB(cx, cv, hasargs) \ - PUSHSUB_BASE(cx, cv, hasargs) \ - cx->blk_u16 = 0; - - -#define PUSHFORMAT(cx, retop) \ - cx->blk_format.cv = cv; \ - cx->blk_format.gv = gv; \ - cx->blk_format.retop = (retop); \ - cx->blk_format.dfoutgv = PL_defoutgv; \ - cx->blk_format.prevcomppad = PL_comppad; \ - cx->blk_u16 = 0; \ - SvREFCNT_inc_simple_void_NN(cv); \ - CvDEPTH(cv)++; \ - SvREFCNT_inc_void(cx->blk_format.dfoutgv) - /* Restore old @_ */ #define CX_POP_SAVEARRAY(cx) \ STMT_START { \ - AV *av = GvAV(PL_defgv); \ + AV *cx_pop_savearray_av = GvAV(PL_defgv); \ GvAV(PL_defgv) = cx->blk_sub.savearray; \ cx->blk_sub.savearray = NULL; \ - SvREFCNT_dec(av); \ + SvREFCNT_dec(cx_pop_savearray_av); \ } STMT_END /* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't @@ -664,71 +625,6 @@ struct block_format { } STMT_END -/* subsets of CX_POPSUB */ - -#define CX_POPSUB_COMMON(cx) \ - STMT_START { \ - CV *cv; \ - assert(CxTYPE(cx) == CXt_SUB); \ - PL_comppad = cx->blk_sub.prevcomppad; \ - PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \ - cv = cx->blk_sub.cv; \ - CvDEPTH(cv) = cx->blk_sub.olddepth; \ - cx->blk_sub.cv = NULL; \ - SvREFCNT_dec(cv); \ - } STMT_END - -/* handle the @_ part of leaving a sub */ - -#define CX_POPSUB_ARGS(cx) \ - STMT_START { \ - AV *av; \ - assert(CxTYPE(cx) == CXt_SUB); \ - assert(AvARRAY(MUTABLE_AV( \ - PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ \ - CvDEPTH(cx->blk_sub.cv)])) == PL_curpad); \ - CX_POP_SAVEARRAY(cx); \ - av = MUTABLE_AV(PAD_SVl(0)); \ - if (UNLIKELY(AvREAL(av))) \ - /* abandon @_ if it got reified */ \ - clear_defarray(av, 0); \ - else { \ - CLEAR_ARGARRAY(av); \ - } \ - } STMT_END - -#define CX_POPSUB(cx) \ - STMT_START { \ - assert(CxTYPE(cx) == CXt_SUB); \ - 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))); \ - \ - if (CxHASARGS(cx)) { \ - CX_POPSUB_ARGS(cx); \ - } \ - CX_POPSUB_COMMON(cx); \ - } STMT_END - -#define CX_POPFORMAT(cx) \ - STMT_START { \ - CV *cv; \ - GV * const dfout = cx->blk_format.dfoutgv; \ - assert(CxTYPE(cx) == CXt_FORMAT); \ - setdefout(dfout); \ - cx->blk_format.dfoutgv = NULL; \ - SvREFCNT_dec_NN(dfout); /* the cx->defoutgv ref */ \ - PL_comppad = cx->blk_format.prevcomppad; \ - PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \ - cv = cx->blk_format.cv; \ - cx->blk_format.cv = NULL;; \ - --CvDEPTH(cv); \ - SvREFCNT_dec_NN(cv); \ - } STMT_END - /* eval context */ struct block_eval { OP * retop; /* op to execute on exit from eval */ @@ -747,35 +643,6 @@ struct block_eval { #define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F) #define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) -#define PUSHEVAL(cx,n) \ - STMT_START { \ - assert(!(PL_in_eval & ~0x7F)); \ - assert(!(PL_op->op_type & ~0x1FF)); \ - cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7); \ - cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : NULL); \ - cx->blk_eval.old_eval_root = PL_eval_root; \ - cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL; \ - cx->blk_eval.cv = NULL; /* set by doeval_compile() as applicable */ \ - cx->blk_eval.retop = NULL; \ - cx->blk_eval.cur_top_env = PL_top_env; \ - } STMT_END - -#define CX_POPEVAL(cx) \ - STMT_START { \ - SV *sv; \ - assert(CxTYPE(cx) == CXt_EVAL); \ - PL_in_eval = CxOLD_IN_EVAL(cx); \ - PL_eval_root = cx->blk_eval.old_eval_root; \ - sv = cx->blk_eval.cur_text; \ - if (sv && SvSCREAM(sv)) { \ - cx->blk_eval.cur_text = NULL; \ - SvREFCNT_dec_NN(sv); \ - } \ - sv = cx->blk_eval.old_namesv; \ - if (sv && !SvTEMP(sv))/* TEMP implies CX_POPEVAL re-entrantly called */ \ - sv_2mortal(sv); \ - } STMT_END - /* loop context */ struct block_loop { LOOP * my_op; /* My op, that contains redo, next and last ops. */ @@ -833,47 +700,6 @@ struct block_loop { #define CxLVAL(c) (0 + ((c)->blk_u16 & 0xff)) -#define PUSHLOOP_PLAIN(cx) \ - cx->blk_loop.my_op = cLOOP; - -#ifdef USE_ITHREADS -# define PUSHLOOP_FOR_setpad(c) (c)->blk_loop.oldcomppad = PL_comppad -#else -# define PUSHLOOP_FOR_setpad(c) NOOP -#endif - -#define PUSHLOOP_FOR(cx, ivar, isave) \ - cx->blk_loop.my_op = cLOOP; \ - cx->blk_loop.itervar_u.svp = (SV**)(ivar); \ - cx->blk_loop.itersave = isave; \ - PUSHLOOP_FOR_setpad(cx); - -#define CX_POPLOOP(cx) \ - assert(CxTYPE_is_LOOP(cx)); \ - if ( CxTYPE(cx) == CXt_LOOP_ARY \ - || CxTYPE(cx) == CXt_LOOP_LAZYSV) \ - { \ - /* Free ary or cur. This assumes that state_u.ary.ary \ - * aligns with state_u.lazysv.cur. See cx_dup() */ \ - SV *sv = cx->blk_loop.state_u.lazysv.cur; \ - cx->blk_loop.state_u.lazysv.cur = NULL; \ - SvREFCNT_dec_NN(sv); \ - if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \ - sv = cx->blk_loop.state_u.lazysv.end; \ - cx->blk_loop.state_u.lazysv.end = NULL; \ - SvREFCNT_dec_NN(sv); \ - } \ - } \ - if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) { \ - SV *cursv; \ - SV **svp = (cx)->blk_loop.itervar_u.svp; \ - if ((cx->cx_type & CXp_FOR_GV)) \ - svp = &GvSV((GV*)svp); \ - cursv = *svp; \ - *svp = cx->blk_loop.itersave; \ - cx->blk_loop.itersave = NULL; \ - SvREFCNT_dec(cursv); \ - } /* given/when context */ struct block_givwhen { @@ -881,35 +707,6 @@ struct block_givwhen { SV *defsv_save; /* the original $_ */ }; -#define PUSHWHEN(cx) \ - cx->blk_givwhen.leave_op = cLOGOP->op_other; - -#define PUSHGIVEN(cx, orig_var) \ - PUSHWHEN(cx); \ - cx->blk_givwhen.defsv_save = orig_var; - -#define CX_POPWHEN(cx) \ - assert(CxTYPE(cx) == CXt_WHEN); \ - NOOP; - -#define CX_POPGIVEN(cx) \ - STMT_START { \ - SV *sv = GvSV(PL_defgv); \ - assert(CxTYPE(cx) == CXt_GIVEN); \ - GvSV(PL_defgv) = cx->blk_givwhen.defsv_save; \ - cx->blk_givwhen.defsv_save = NULL; \ - SvREFCNT_dec(sv); \ - } STMT_END - - -/* basic block, i.e. pp_enter/leave */ - -#define PUSHBASICBLK(cx) \ - NOOP; - -#define CX_POPBASICBLK(cx) \ - assert(CxTYPE(cx) == CXt_BLOCK); \ - NOOP; /* context common to subroutines, evals and loops */ @@ -942,6 +739,7 @@ struct block { #define blk_gimme cx_u.cx_blk.blku_gimme #define blk_u16 cx_u.cx_blk.blku_u16 #define blk_oldsaveix cx_u.cx_blk.blku_oldsaveix +#define blk_old_tmpsfloor cx_u.cx_blk.blku_old_tmpsfloor #define blk_sub cx_u.cx_blk.blk_u.blku_sub #define blk_format cx_u.cx_blk.blk_u.blku_format #define blk_eval cx_u.cx_blk.blk_u.blku_eval @@ -960,47 +758,7 @@ struct block { (long)(cx->blk_oldsaveix), \ __FILE__, __LINE__)); -/* Enter a block. */ -#define PUSHBLOCK(cx, t, gimme, sp, saveix) \ - CXINC, \ - cx = CX_CUR(), \ - cx->cx_type = t, \ - cx->blk_oldsp = sp - PL_stack_base, \ - cx->blk_oldcop = PL_curcop, \ - cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \ - cx->blk_oldsaveix = saveix, \ - cx->blk_oldscopesp = PL_scopestack_ix, \ - cx->blk_oldpm = PL_curpm, \ - cx->blk_gimme = (U8)gimme; \ - cx->cx_u.cx_blk.blku_old_tmpsfloor = PL_tmps_floor; \ - PL_tmps_floor = PL_tmps_ix; \ - CX_DEBUG(cx, "PUSH"); - -#define _CX_POPBLOCK_COMMON(cx) \ - PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ - PL_scopestack_ix = cx->blk_oldscopesp, \ - PL_curpm = cx->blk_oldpm, - -/* Exit a block (RETURN and LAST). */ -#define CX_POPBLOCK(cx) \ - CX_DEBUG(cx, "POP"); \ - _CX_POPBLOCK_COMMON(cx) \ - /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats - * and leaves a CX entry lying around for repeated use, so - * skip for multicall */ \ - assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx)) \ - || PL_savestack_ix == cx->blk_oldsaveix); \ - PL_curcop = cx->blk_oldcop, \ - PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor; \ - -/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO). - * Whereas CX_POPBLOCK restores the state to the point just before PUSHBLOCK - * was called, CX_TOPBLOCK restores it to the point just *after* PUSHBLOCK - * was called. */ -#define CX_TOPBLOCK(cx) \ - CX_DEBUG(cx, "TOP"); \ - _CX_POPBLOCK_COMMON(cx) \ - PL_stack_sp = PL_stack_base + cx->blk_oldsp; + /* substitution context */ struct subst { @@ -1034,7 +792,7 @@ struct subst { #define sb_rx cx_u.cx_subst.sbu_rx #ifdef PERL_CORE -# define PUSHSUBST(cx) CXINC, cx = CX_CUR(), \ +# define CX_PUSHSUBST(cx) CXINC, cx = CX_CUR(), \ cx->blk_oldsaveix = oldsave, \ cx->sb_iters = iters, \ cx->sb_maxiters = maxiters, \ @@ -1089,12 +847,12 @@ struct context { /* be careful of the ordering of these five. Macros like CxTYPE_is_LOOP, * CxFOREACH compare ranges */ -#define CXt_LOOP_ARY 4 /* for (@ary) {} */ -#define CXt_LOOP_LAZYSV 5 /* for ('a'..'z') {} */ -#define CXt_LOOP_LAZYIV 6 /* for (1..9) {} */ -#define CXt_LOOP_LIST 7 /* for (1,2,3) {} */ -#define CXt_LOOP_PLAIN 8 /* {} */ - +#define CXt_LOOP_ARY 4 /* for (@ary) { ...; } */ +#define CXt_LOOP_LAZYSV 5 /* for ('a'..'z') { ...; } */ +#define CXt_LOOP_LAZYIV 6 /* for (1..9) { ...; } */ +#define CXt_LOOP_LIST 7 /* for (1,2,3) { ...; } */ +#define CXt_LOOP_PLAIN 8 /* while (...) { ...; } + or plain block { ...; } */ #define CXt_SUB 9 #define CXt_FORMAT 10 #define CXt_EVAL 11 @@ -1297,8 +1055,11 @@ typedef struct stackinfo PERL_SI; } \ } STMT_END -#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) -#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling) +#define IN_PERL_COMPILETIME cBOOL(PL_curcop == &PL_compiling) +#define IN_PERL_RUNTIME cBOOL(PL_curcop != &PL_compiling) + + + /* =head1 Multicall Functions @@ -1321,13 +1082,8 @@ See L. */ #define dMULTICALL \ - SV **newsp; /* set by CX_POPBLOCK */ \ - PERL_CONTEXT *cx; \ - CV *multicall_cv; \ - OP *multicall_cop; \ - bool multicall_oldcatch; \ - I32 saveix_floor; \ - U8 hasargs = 0 /* used by PUSHSUB */ + OP *multicall_cop; \ + bool multicall_oldcatch #define PUSH_MULTICALL(the_cv) \ PUSH_MULTICALL_FLAGS(the_cv, 0) @@ -1337,24 +1093,22 @@ See L. #define PUSH_MULTICALL_FLAGS(the_cv, flags) \ STMT_START { \ + PERL_CONTEXT *cx; \ CV * const _nOnclAshIngNamE_ = the_cv; \ CV * const cv = _nOnclAshIngNamE_; \ PADLIST * const padlist = CvPADLIST(cv); \ multicall_oldcatch = CATCH_GET; \ CATCH_SET(TRUE); \ PUSHSTACKi(PERLSI_MULTICALL); \ - PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), gimme, \ + cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), (U8)gimme, \ PL_stack_sp, PL_savestack_ix); \ - PUSHSUB(cx, cv, hasargs); \ + cx_pushsub(cx, cv, NULL, 0); \ SAVEOP(); \ - saveix_floor = PL_savestack_ix; \ if (!(flags & CXp_SUB_RE_FAKE)) \ CvDEPTH(cv)++; \ if (CvDEPTH(cv) >= 2) \ Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ - multicall_cv = cv; \ - PERL_UNUSED_VAR(multicall_cv); /* for API */ \ multicall_cop = CvSTART(cv); \ } STMT_END @@ -1362,20 +1116,17 @@ See L. STMT_START { \ PL_op = multicall_cop; \ CALLRUNOPS(aTHX); \ - cx = CX_CUR(); \ - LEAVE_SCOPE(saveix_floor); \ } STMT_END #define POP_MULTICALL \ STMT_START { \ + PERL_CONTEXT *cx; \ cx = CX_CUR(); \ CX_LEAVE_SCOPE(cx); \ - CX_POPSUB_COMMON(cx); \ - newsp = PL_stack_base + cx->blk_oldsp; \ + cx_popsub_common(cx); \ gimme = cx->blk_gimme; \ - PERL_UNUSED_VAR(newsp); /* for API */ \ PERL_UNUSED_VAR(gimme); /* for API */ \ - CX_POPBLOCK(cx); \ + cx_popblock(cx); \ CX_POP(cx); \ POPSTACK; \ CATCH_SET(multicall_oldcatch); \ @@ -1390,17 +1141,16 @@ See L. CV * const _nOnclAshIngNamE_ = the_cv; \ CV * const cv = _nOnclAshIngNamE_; \ PADLIST * const padlist = CvPADLIST(cv); \ - cx = CX_CUR(); \ + PERL_CONTEXT *cx = CX_CUR(); \ assert(CxMULTICALL(cx)); \ - CX_POPSUB_COMMON(cx); \ + cx_popsub_common(cx); \ cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \ - PUSHSUB(cx, cv, hasargs); \ + cx_pushsub(cx, cv, NULL, 0); \ if (!(flags & CXp_SUB_RE_FAKE)) \ CvDEPTH(cv)++; \ if (CvDEPTH(cv) >= 2) \ Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ - multicall_cv = cv; \ multicall_cop = CvSTART(cv); \ } STMT_END /*