X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=cop.h;h=98478ae7dee2a220be707289b032447750b057ee;hb=9e5bbba0de25c01ae9355c7a97e237602a37e9f3;hp=dae356d6a00a38b29b932df459c5f0a7ff086581;hpb=c6903450838086ba02cb3a4b04bd5f6047187b9d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/cop.h b/cop.h index dae356d..98478ae 100644 --- a/cop.h +++ b/cop.h @@ -1,24 +1,25 @@ /* cop.h * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, - * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others + * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * Control ops (cops) are one of the three ops OP_NEXTSTATE, OP_DBSTATE, - * and OP_SETSTATE that (loosely speaking) are separate statements. + * Control ops (cops) are one of the two ops OP_NEXTSTATE and OP_DBSTATE, + * that (loosely speaking) are separate statements. * They hold information important for lexical state and error reporting. * At run time, PL_curcop is set to point to the most recently executed cop, * and thus can be used to determine our current state. */ /* A jmpenv packages the state required to perform a proper non-local jump. - * Note that there is a start_env initialized when perl starts, and top_env - * points to this initially, so top_env should always be non-null. + * Note that there is a PL_start_env initialized when perl starts, and + * PL_top_env points to this initially, so PL_top_env should always be + * non-null. * - * Existence of a non-null top_env->je_prev implies it is valid to call - * longjmp() at that runlevel (we make sure start_env.je_prev is always + * Existence of a non-null PL_top_env->je_prev implies it is valid to call + * longjmp() at that runlevel (we make sure PL_start_env.je_prev is always * null to ensure this). * * je_mustcatch, when set at any runlevel to TRUE, means eval ops must @@ -99,8 +100,11 @@ typedef struct jmpenv JMPENV; #define JMPENV_PUSH(v) \ STMT_START { \ - DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \ - (void*)&cur_env, (void*)PL_top_env)); \ + DEBUG_l({ \ + int i = 0; JMPENV *p = PL_top_env; \ + while (p) { i++; p = p->je_prev; } \ + 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); \ @@ -112,13 +116,22 @@ typedef struct jmpenv JMPENV; #define JMPENV_POP \ STMT_START { \ - DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n", \ - (void*)PL_top_env, (void*)cur_env.je_prev)); \ + DEBUG_l({ \ + int i = -1; JMPENV *p = PL_top_env; \ + while (p) { i++; p = p->je_prev; } \ + Perl_deb(aTHX_ "JUMPENV_POP level=%d at %s:%d\n", \ + i, __FILE__, __LINE__);}) \ + assert(PL_top_env == &cur_env); \ PL_top_env = cur_env.je_prev; \ } STMT_END #define JMPENV_JUMP(v) \ STMT_START { \ + DEBUG_l({ \ + int i = -1; JMPENV *p = PL_top_env; \ + 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)); \ @@ -129,7 +142,15 @@ typedef struct jmpenv JMPENV; } STMT_END #define CATCH_GET (PL_top_env->je_mustcatch) -#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v)) +#define CATCH_SET(v) \ + STMT_START { \ + DEBUG_l( \ + Perl_deb(aTHX_ \ + "JUMPLEVEL set catch %d => %d (for %p) at %s:%d\n", \ + PL_top_env->je_mustcatch, v, (void*)PL_top_env, \ + __FILE__, __LINE__);) \ + PL_top_env->je_mustcatch = (v); \ + } STMT_END #include "mydtrace.h" @@ -232,11 +253,7 @@ struct cop { #define CopLINE_set(c,l) (CopLINE(c) = (l)) /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */ -#ifdef MACOS_TRADITIONAL -# define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c)) -#else -# define OutCopFILE(c) CopFILE(c) -#endif +#define OutCopFILE(c) CopFILE(c) /* If $[ is non-zero, it's stored in cop_hints under the key "$[", and HINT_ARYBASE is set to indicate this. @@ -250,12 +267,17 @@ struct cop { #define CopARYBASE_set(c, b) STMT_START { \ if (b || ((c)->cop_hints & HINT_ARYBASE)) { \ (c)->cop_hints |= HINT_ARYBASE; \ - if ((c) == &PL_compiling) \ - PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE; \ - (c)->cop_hints_hash \ - = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash, \ + if ((c) == &PL_compiling) { \ + SV *val = newSViv(b); \ + (void)hv_stores(GvHV(PL_hintgv), "$[", val); \ + mg_set(val); \ + PL_hints |= HINT_ARYBASE; \ + } else { \ + (c)->cop_hints_hash \ + = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash, \ newSVpvs_flags("$[", SVs_TEMP), \ sv_2mortal(newSViv(b))); \ + } \ } \ } STMT_END @@ -546,6 +568,16 @@ struct block { #define blk_loop cx_u.cx_blk.blk_u.blku_loop #define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen +#define DEBUG_CX(action) \ + DEBUG_l(WITH_THX( \ + Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) at %s:%d\n", \ + (long)cxstack_ix, \ + action, \ + PL_block_type[CxTYPE(&cxstack[cxstack_ix])], \ + (long)PL_scopestack_ix, \ + (long)(cxstack[cxstack_ix].blk_oldscopesp), \ + __FILE__, __LINE__))); + /* Enter a block. */ #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \ cx->cx_type = t, \ @@ -555,28 +587,27 @@ struct block { cx->blk_oldscopesp = PL_scopestack_ix, \ cx->blk_oldpm = PL_curpm, \ cx->blk_gimme = (U8)gimme; \ - DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \ - (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); ) + DEBUG_CX("PUSH"); /* Exit a block (RETURN and LAST). */ -#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \ +#define POPBLOCK(cx,pm) \ + DEBUG_CX("POP"); \ + cx = &cxstack[cxstack_ix--], \ newsp = PL_stack_base + cx->blk_oldsp, \ PL_curcop = cx->blk_oldcop, \ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ PL_scopestack_ix = cx->blk_oldscopesp, \ pm = cx->blk_oldpm, \ - gimme = cx->blk_gimme; \ - DEBUG_SCOPE("POPBLOCK"); \ - DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n", \ - (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); ) + gimme = cx->blk_gimme; /* Continue a block elsewhere (NEXT and REDO). */ -#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \ +#define TOPBLOCK(cx) \ + DEBUG_CX("TOP"); \ + cx = &cxstack[cxstack_ix], \ PL_stack_sp = PL_stack_base + cx->blk_oldsp, \ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ PL_scopestack_ix = cx->blk_oldscopesp, \ - PL_curpm = cx->blk_oldpm; \ - DEBUG_SCOPE("TOPBLOCK"); + PL_curpm = cx->blk_oldpm; /* substitution context */ struct subst { @@ -610,7 +641,8 @@ struct subst { #define sb_rxres cx_u.cx_subst.sbu_rxres #define sb_rx cx_u.cx_subst.sbu_rx -#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \ +#ifdef PERL_CORE +# define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \ cx->sb_iters = iters, \ cx->sb_maxiters = maxiters, \ cx->sb_rflags = r_flags, \ @@ -628,11 +660,12 @@ struct subst { rxres_save(&cx->sb_rxres, rx); \ (void)ReREFCNT_inc(rx) -#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE) - -#define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \ +# define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \ rxres_free(&cx->sb_rxres); \ ReREFCNT_dec(cx->sb_rx) +#endif + +#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE) struct context { union { @@ -745,11 +778,14 @@ L. hash actions codes defined in hv.h */ #define G_EVAL 8 /* Assume eval {} around subroutine call. */ #define G_NOARGS 16 /* Don't construct a @_ array. */ -#define G_KEEPERR 32 /* Append errors to $@, don't overwrite it */ +#define G_KEEPERR 32 /* Warn for errors, don't overwrite $@ */ #define G_NODEBUG 64 /* Disable debugging at toplevel. */ #define G_METHOD 128 /* Calling method. */ #define G_FAKINGEVAL 256 /* Faking an eval context for call_sv or fold_constants. */ +#define G_UNDEF_FILL 512 /* Fill the stack with &PL_sv_undef + A special case for UNSHIFT in + Perl_magic_methcall(). */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ @@ -803,6 +839,11 @@ typedef struct stackinfo PERL_SI; #define PUSHSTACKi(type) \ STMT_START { \ PERL_SI *next = PL_curstackinfo->si_next; \ + DEBUG_l({ \ + int i = 0; PERL_SI *p = PL_curstackinfo; \ + while (p) { i++; p = p->si_prev; } \ + Perl_deb(aTHX_ "push STACKINFO %d at %s:%d\n", \ + i, __FILE__, __LINE__);}) \ if (!next) { \ next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \ next->si_prev = PL_curstackinfo; \ @@ -824,6 +865,11 @@ typedef struct stackinfo PERL_SI; STMT_START { \ dSP; \ PERL_SI * const prev = PL_curstackinfo->si_prev; \ + DEBUG_l({ \ + int i = -1; PERL_SI *p = PL_curstackinfo; \ + while (p) { i++; p = p->si_prev; } \ + 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); \ @@ -881,6 +927,7 @@ See L. multicall_oldcatch = CATCH_GET; \ SAVETMPS; SAVEVPTR(PL_op); \ CATCH_SET(TRUE); \ + PUSHSTACKi(PERLSI_SORT); \ PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp); \ PUSHSUB(cx); \ if (++CvDEPTH(cv) >= 2) { \ @@ -904,8 +951,10 @@ See L. LEAVESUB(multicall_cv); \ CvDEPTH(multicall_cv)--; \ POPBLOCK(cx,PL_curpm); \ + POPSTACK; \ CATCH_SET(multicall_oldcatch); \ LEAVE; \ + SPAGAIN; \ } STMT_END /*