X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/6a7d52ccb6c2daf79e90e6cb93bbc5f3d516509a..446f12a860e9ab9b234cd6796e937fbff85adf5c:/cop.h diff --git a/cop.h b/cop.h index ac0e8b4..5c66752 100644 --- a/cop.h +++ b/cop.h @@ -35,10 +35,24 @@ struct jmpenv { int je_ret; /* last exception thrown */ bool je_mustcatch; /* need to call longjmp()? */ U16 je_old_delaymagic; /* saved PL_delaymagic */ + SSize_t je_old_stack_hwm; }; typedef struct jmpenv JMPENV; +#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY +# define JE_OLD_STACK_HWM_zero PL_start_env.je_old_stack_hwm = 0 +# define JE_OLD_STACK_HWM_save(je) \ + (je).je_old_stack_hwm = PL_curstackinfo->si_stack_hwm +# define JE_OLD_STACK_HWM_restore(je) \ + if (PL_curstackinfo->si_stack_hwm < (je).je_old_stack_hwm) \ + PL_curstackinfo->si_stack_hwm = (je).je_old_stack_hwm +#else +# define JE_OLD_STACK_HWM_zero NOOP +# define JE_OLD_STACK_HWM_save(je) NOOP +# define JE_OLD_STACK_HWM_restore(je) NOOP +#endif + /* * How to build the first jmpenv. * @@ -57,6 +71,7 @@ typedef struct jmpenv JMPENV; PL_start_env.je_ret = -1; \ PL_start_env.je_mustcatch = TRUE; \ PL_start_env.je_old_delaymagic = 0; \ + JE_OLD_STACK_HWM_zero; \ } STMT_END /* @@ -102,7 +117,9 @@ 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; \ + JE_OLD_STACK_HWM_save(cur_env); \ cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \ + JE_OLD_STACK_HWM_restore(cur_env); \ PL_top_env = &cur_env; \ cur_env.je_mustcatch = FALSE; \ cur_env.je_old_delaymagic = PL_delaymagic; \ @@ -173,10 +190,10 @@ associated with the key. Perl_refcounted_he_fetch_pvn(aTHX_ cophh, keypv, keylen, hash, flags) /* -=for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|const char *key|U32 flags +=for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|"literal string" 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 literal string instead +of a string/length pair, and no precomputed hash. =cut */ @@ -279,10 +296,10 @@ be stored with referential integrity, but will be coerced to strings. Perl_refcounted_he_new_pvn(aTHX_ cophh, keypv, keylen, hash, value, flags) /* -=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|const char *key|SV *value|U32 flags +=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|"literal string" 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 literal string instead +of a string/length pair, and no precomputed hash. =cut */ @@ -336,10 +353,10 @@ hash of the key string, or zero if it has not been precomputed. (SV *)NULL, flags) /* -=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|const char *key|U32 flags +=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|"literal string" 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 literal string instead +of a string/length pair, and no precomputed hash. =cut */ @@ -476,10 +493,10 @@ associated with the key. cophh_fetch_pvn(CopHINTHASH_get(cop), keypv, keylen, hash, flags) /* -=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|const char *key|U32 flags +=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|"literal string" 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 literal string +instead of a string/length pair, and no precomputed hash. =cut */ @@ -609,10 +626,10 @@ struct block_format { /* 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 @@ -640,37 +657,11 @@ struct block_eval { blku_gimme is actually also only 2 bits, so could be merged with something. */ -#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F) -#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) +/* blk_u16 bit usage for eval contexts: */ -#define CX_PUSHEVAL(cx, op, 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); \ - 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 = op; \ - 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 +#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x3F) /* saved PL in_eval */ +#define CxEVAL_TXT_REFCNTED(cx) (((cx)->blk_u16) & 0x40) /* cur_text rc++ */ +#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) /* type of eval op */ /* loop context */ struct block_loop { @@ -729,47 +720,6 @@ struct block_loop { #define CxLVAL(c) (0 + ((c)->blk_u16 & 0xff)) -#define CX_PUSHLOOP_PLAIN(cx) \ - cx->blk_loop.my_op = cLOOP; - -#ifdef USE_ITHREADS -# define CX_PUSHLOOP_FOR_setpad(c) (c)->blk_loop.oldcomppad = PL_comppad -#else -# define CX_PUSHLOOP_FOR_setpad(c) NOOP -#endif - -#define CX_PUSHLOOP_FOR(cx, ivar, isave) \ - CX_PUSHLOOP_PLAIN(cx); \ - cx->blk_loop.itervar_u.svp = (SV**)(ivar); \ - cx->blk_loop.itersave = isave; \ - CX_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 { @@ -777,26 +727,6 @@ struct block_givwhen { SV *defsv_save; /* the original $_ */ }; -#define CX_PUSHWHEN(cx) \ - cx->blk_givwhen.leave_op = cLOGOP->op_other; - -#define CX_PUSHGIVEN(cx, orig_var) \ - CX_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 - /* context common to subroutines, evals and loops */ @@ -829,6 +759,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 @@ -936,12 +867,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 @@ -1050,6 +981,7 @@ L. #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 */ +/* if adding extra bits, make sure they can fit in CxOLD_OP_TYPE() */ /* Support for switching (stack and block) contexts. * This ensures magic doesn't invalidate local stack and cx pointers. @@ -1079,6 +1011,12 @@ struct stackinfo { I32 si_markoff; /* offset where markstack begins for us. * currently used only with DEBUGGING, * but not #ifdef-ed for bincompat */ +#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY +/* high water mark: for checking if the stack was correctly extended / + * tested for extension by each pp function */ + SSize_t si_stack_hwm; +#endif + }; typedef struct stackinfo PERL_SI; @@ -1094,6 +1032,12 @@ typedef struct stackinfo PERL_SI; # define SET_MARK_OFFSET NOOP #endif +#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY +# define PUSHSTACK_INIT_HWM(si) ((si)->si_stack_hwm = 0) +#else +# define PUSHSTACK_INIT_HWM(si) NOOP +#endif + #define PUSHSTACKi(type) \ STMT_START { \ PERL_SI *next = PL_curstackinfo->si_next; \ @@ -1109,6 +1053,7 @@ typedef struct stackinfo PERL_SI; } \ next->si_type = type; \ next->si_cxix = -1; \ + PUSHSTACK_INIT_HWM(next); \ AvFILLp(next->si_stack) = 0; \ SWITCHSTACK(PL_curstack,next->si_stack); \ PL_curstackinfo = next; \ @@ -1144,8 +1089,8 @@ 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) @@ -1171,13 +1116,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 CX_PUSHSUB */ + OP *multicall_cop; \ + bool multicall_oldcatch #define PUSH_MULTICALL(the_cv) \ PUSH_MULTICALL_FLAGS(the_cv, 0) @@ -1187,24 +1127,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); \ - cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), gimme, \ + cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), (U8)gimme, \ PL_stack_sp, PL_savestack_ix); \ - cx_pushsub(cx, cv, NULL, cBOOL(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 @@ -1212,18 +1150,15 @@ 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; \ gimme = cx->blk_gimme; \ - PERL_UNUSED_VAR(newsp); /* for API */ \ PERL_UNUSED_VAR(gimme); /* for API */ \ cx_popblock(cx); \ CX_POP(cx); \ @@ -1240,17 +1175,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->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \ - cx_pushsub(cx, cv, NULL, cBOOL(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 /*