X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1c98cc53150c48606faf09909b3bb3a4ebdd329f..43f197b58b234b5f912893ab0eb369af9d2f09c0:/cop.h diff --git a/cop.h b/cop.h index 2d0a459..9f3762e 100644 --- a/cop.h +++ b/cop.h @@ -92,8 +92,9 @@ typedef struct jmpenv JMPENV; * * The original patches that introduces flexible exceptions were: * - * http://public.activestate.com/cgi-bin/perlbrowse?patch=3386 - * http://public.activestate.com/cgi-bin/perlbrowse?patch=5162 + * http://perl5.git.perl.org/perl.git/commit/312caa8e97f1c7ee342a9895c2f0e749625b4929 + * http://perl5.git.perl.org/perl.git/commit/14dd3ad8c9bf82cf09798a22cc89a9862dfd6d1a + * */ #define dJMPENV JMPENV cur_env @@ -103,9 +104,8 @@ typedef struct jmpenv JMPENV; DEBUG_l({ \ int i = 0; JMPENV *p = PL_top_env; \ while (p) { i++; p = p->je_prev; } \ - Perl_deb(aTHX_ "push JUMPLEVEL %d (now %p, was %p) at %s:%d\n",\ - i, (void*)&cur_env, (void*)PL_top_env, \ - __FILE__, __LINE__);}) \ + 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); \ @@ -120,9 +120,8 @@ typedef struct jmpenv JMPENV; DEBUG_l({ \ int i = -1; JMPENV *p = PL_top_env; \ while (p) { i++; p = p->je_prev; } \ - Perl_deb(aTHX_ "pop JUMPLEVEL %d (now %p, was %p) at %s:%d\n",\ - i, (void*)cur_env.je_prev, (void*)PL_top_env, \ - __FILE__, __LINE__);}) \ + 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 @@ -132,15 +131,14 @@ typedef struct jmpenv JMPENV; DEBUG_l({ \ int i = -1; JMPENV *p = PL_top_env; \ while (p) { i++; p = p->je_prev; } \ - Perl_deb(aTHX_ "JUMP JUMPLEVEL %d (%p) at %s:%d\n", \ - i, (void*)PL_top_env, \ - __FILE__, __LINE__);}) \ + 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) \ PerlProc_exit(STATUS_EXIT); \ - PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \ + PerlIO_printf(PerlIO_stderr(), "panic: top_env, v=%d\n", (int)v); \ PerlProc_exit(1); \ } STMT_END @@ -155,6 +153,230 @@ typedef struct jmpenv JMPENV; PL_top_env->je_mustcatch = (v); \ } STMT_END +/* +=head1 COP Hint Hashes +*/ + +typedef struct refcounted_he COPHH; + +#define COPHH_KEY_UTF8 REFCOUNTED_HE_KEY_UTF8 + +/* +=for apidoc Amx|SV *|cophh_fetch_pvn|const COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|U32 flags + +Look up the entry in the cop hints hash I with the key specified by +I and I. If I has the C bit set, +the key octets are interpreted as UTF-8, otherwise they are interpreted +as Latin-1. I is a precomputed hash of the key string, or zero if +it has not been precomputed. Returns a mortal scalar copy of the value +associated with the key, or C<&PL_sv_placeholder> if there is no value +associated with the key. + +=cut +*/ + +#define cophh_fetch_pvn(cophh, keypv, keylen, hash, flags) \ + 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 + +Like L, but takes a literal string instead of a +string/length pair, and no precomputed hash. + +=cut +*/ + +#define cophh_fetch_pvs(cophh, key, flags) \ + Perl_refcounted_he_fetch_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, flags) + +/* +=for apidoc Amx|SV *|cophh_fetch_pv|const COPHH *cophh|const char *key|U32 hash|U32 flags + +Like L, but takes a nul-terminated string instead of +a string/length pair. + +=cut +*/ + +#define cophh_fetch_pv(cophh, key, hash, flags) \ + Perl_refcounted_he_fetch_pv(aTHX_ cophh, key, hash, flags) + +/* +=for apidoc Amx|SV *|cophh_fetch_sv|const COPHH *cophh|SV *key|U32 hash|U32 flags + +Like L, but takes a Perl scalar instead of a +string/length pair. + +=cut +*/ + +#define cophh_fetch_sv(cophh, key, hash, flags) \ + Perl_refcounted_he_fetch_sv(aTHX_ cophh, key, hash, flags) + +/* +=for apidoc Amx|HV *|cophh_2hv|const COPHH *cophh|U32 flags + +Generates and returns a standard Perl hash representing the full set of +key/value pairs in the cop hints hash I. I is currently +unused and must be zero. + +=cut +*/ + +#define cophh_2hv(cophh, flags) \ + Perl_refcounted_he_chain_2hv(aTHX_ cophh, flags) + +/* +=for apidoc Amx|COPHH *|cophh_copy|COPHH *cophh + +Make and return a complete copy of the cop hints hash I. + +=cut +*/ + +#define cophh_copy(cophh) Perl_refcounted_he_inc(aTHX_ cophh) + +/* +=for apidoc Amx|void|cophh_free|COPHH *cophh + +Discard the cop hints hash I, freeing all resources associated +with it. + +=cut +*/ + +#define cophh_free(cophh) Perl_refcounted_he_free(aTHX_ cophh) + +/* +=for apidoc Amx|COPHH *|cophh_new_empty + +Generate and return a fresh cop hints hash containing no entries. + +=cut +*/ + +#define cophh_new_empty() ((COPHH *)NULL) + +/* +=for apidoc Amx|COPHH *|cophh_store_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags + +Stores a value, associated with a key, in the cop hints hash I, +and returns the modified hash. The returned hash pointer is in general +not the same as the hash pointer that was passed in. The input hash is +consumed by the function, and the pointer to it must not be subsequently +used. Use L if you need both hashes. + +The key is specified by I and I. If I has the +C bit set, the key octets are interpreted as UTF-8, +otherwise they are interpreted as Latin-1. I is a precomputed +hash of the key string, or zero if it has not been precomputed. + +I is the scalar value to store for this key. I is copied +by this function, which thus does not take ownership of any reference +to it, and later changes to the scalar will not be reflected in the +value visible in the cop hints hash. Complex types of scalar will not +be stored with referential integrity, but will be coerced to strings. + +=cut +*/ + +#define cophh_store_pvn(cophh, keypv, keylen, hash, value, flags) \ + 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 + +Like L, but takes a literal string instead of a +string/length pair, and no precomputed hash. + +=cut +*/ + +#define cophh_store_pvs(cophh, key, value, flags) \ + Perl_refcounted_he_new_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, value, flags) + +/* +=for apidoc Amx|COPHH *|cophh_store_pv|const COPHH *cophh|const char *key|U32 hash|SV *value|U32 flags + +Like L, but takes a nul-terminated string instead of +a string/length pair. + +=cut +*/ + +#define cophh_store_pv(cophh, key, hash, value, flags) \ + Perl_refcounted_he_new_pv(aTHX_ cophh, key, hash, value, flags) + +/* +=for apidoc Amx|COPHH *|cophh_store_sv|const COPHH *cophh|SV *key|U32 hash|SV *value|U32 flags + +Like L, but takes a Perl scalar instead of a +string/length pair. + +=cut +*/ + +#define cophh_store_sv(cophh, key, hash, value, flags) \ + Perl_refcounted_he_new_sv(aTHX_ cophh, key, hash, value, flags) + +/* +=for apidoc Amx|COPHH *|cophh_delete_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|U32 flags + +Delete a key and its associated value from the cop hints hash I, +and returns the modified hash. The returned hash pointer is in general +not the same as the hash pointer that was passed in. The input hash is +consumed by the function, and the pointer to it must not be subsequently +used. Use L if you need both hashes. + +The key is specified by I and I. If I has the +C bit set, the key octets are interpreted as UTF-8, +otherwise they are interpreted as Latin-1. I is a precomputed +hash of the key string, or zero if it has not been precomputed. + +=cut +*/ + +#define cophh_delete_pvn(cophh, keypv, keylen, hash, flags) \ + Perl_refcounted_he_new_pvn(aTHX_ cophh, keypv, keylen, hash, \ + (SV *)NULL, flags) + +/* +=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. + +=cut +*/ + +#define cophh_delete_pvs(cophh, key, flags) \ + Perl_refcounted_he_new_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, \ + (SV *)NULL, flags) + +/* +=for apidoc Amx|COPHH *|cophh_delete_pv|const COPHH *cophh|const char *key|U32 hash|U32 flags + +Like L, but takes a nul-terminated string instead of +a string/length pair. + +=cut +*/ + +#define cophh_delete_pv(cophh, key, hash, flags) \ + Perl_refcounted_he_new_pv(aTHX_ cophh, key, hash, (SV *)NULL, flags) + +/* +=for apidoc Amx|COPHH *|cophh_delete_sv|const COPHH *cophh|SV *key|U32 hash|U32 flags + +Like L, but takes a Perl scalar instead of a +string/length pair. + +=cut +*/ + +#define cophh_delete_sv(cophh, key, hash, flags) \ + Perl_refcounted_he_new_sv(aTHX_ cophh, key, hash, (SV *)NULL, flags) #include "mydtrace.h" @@ -165,7 +387,7 @@ 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; /* package line was compiled in */ char * cop_file; /* file name the following line # is from */ #else HV * cop_stash; /* package line was compiled in */ @@ -177,7 +399,7 @@ struct cop { STRLEN * cop_warnings; /* lexical warnings bitmask */ /* compile time state of %^H. See the comment in op.c for how this is used to recreate a hash to return from caller. */ - struct refcounted_he * cop_hints_hash; + COPHH * cop_hints_hash; }; #ifdef USE_ITHREADS @@ -203,23 +425,14 @@ struct cop { # else # define CopFILEAVx(c) (GvAV(gv_fetchfile(CopFILE(c)))) # endif -# define CopSTASHPV(c) ((c)->cop_stashpv) - -# ifdef NETWARE -# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : NULL)) -# else -# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savesharedpv(pv)) -# endif -# define CopSTASH(c) (CopSTASHPV(c) \ - ? gv_stashpv(CopSTASHPV(c),GV_ADD) : NULL) -# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : NULL) -# 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 @@ -238,15 +451,91 @@ struct cop { ? SvPVX(GvSV(CopFILEGV(c))) : 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 CopLABEL(c) Perl_fetch_cop_label(aTHX_ (c)->cop_hints_hash, NULL, NULL) + +#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)) + +/* +=head1 COP Hint Reading +*/ + +/* +=for apidoc Am|SV *|cop_hints_fetch_pvn|const COP *cop|const char *keypv|STRLEN keylen|U32 hash|U32 flags + +Look up the hint entry in the cop I with the key specified by +I and I. If I has the C bit set, +the key octets are interpreted as UTF-8, otherwise they are interpreted +as Latin-1. I is a precomputed hash of the key string, or zero if +it has not been precomputed. Returns a mortal scalar copy of the value +associated with the key, or C<&PL_sv_placeholder> if there is no value +associated with the key. + +=cut +*/ + +#define cop_hints_fetch_pvn(cop, keypv, keylen, hash, flags) \ + 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 + +Like L, but takes a literal string instead of a +string/length pair, and no precomputed hash. + +=cut +*/ + +#define cop_hints_fetch_pvs(cop, key, flags) \ + cophh_fetch_pvs(CopHINTHASH_get(cop), key, flags) + +/* +=for apidoc Am|SV *|cop_hints_fetch_pv|const COP *cop|const char *key|U32 hash|U32 flags + +Like L, but takes a nul-terminated string instead +of a string/length pair. + +=cut +*/ + +#define cop_hints_fetch_pv(cop, key, hash, flags) \ + cophh_fetch_pv(CopHINTHASH_get(cop), key, hash, flags) + +/* +=for apidoc Am|SV *|cop_hints_fetch_sv|const COP *cop|SV *key|U32 hash|U32 flags + +Like L, but takes a Perl scalar instead of a +string/length pair. + +=cut +*/ + +#define cop_hints_fetch_sv(cop, key, hash, flags) \ + cophh_fetch_sv(CopHINTHASH_get(cop), key, hash, flags) + +/* +=for apidoc Am|HV *|cop_hints_2hv|const COP *cop|U32 flags + +Generates and returns a standard Perl hash representing the full set of +hint entries in the cop I. I is currently unused and must +be zero. + +=cut +*/ + +#define cop_hints_2hv(cop, flags) \ + cophh_2hv(CopHINTHASH_get(cop), flags) + +#define CopLABEL(c) Perl_cop_fetch_label(aTHX_ (c), NULL, NULL) +#define CopLABEL_len(c,len) Perl_cop_fetch_label(aTHX_ (c), len, NULL) +#define CopLABEL_len_flags(c,len,flags) Perl_cop_fetch_label(aTHX_ (c), len, flags) #define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL) #define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv)) @@ -258,32 +547,6 @@ struct cop { /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */ #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. - Setting it is ineficient due to the need to create 2 mortal SVs, but as - using $[ is highly discouraged, no sane Perl code will be using it. */ -#define CopARYBASE_get(c) \ - ((CopHINTS_get(c) & HINT_ARYBASE) \ - ? SvIV(Perl_refcounted_he_fetch(aTHX_ (c)->cop_hints_hash, 0, \ - "$[", 2, 0, 0)) \ - : 0) -#define CopARYBASE_set(c, b) STMT_START { \ - if (b || ((c)->cop_hints & HINT_ARYBASE)) { \ - (c)->cop_hints |= HINT_ARYBASE; \ - 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 - /* 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 { \ @@ -324,7 +587,8 @@ struct block_format { #define PUSHSUB_BASE(cx) \ ENTRY_PROBE(GvENAME(CvGV(cv)), \ CopFILE((const COP *)CvSTART(cv)), \ - CopLINE((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); \ @@ -338,9 +602,18 @@ struct block_format { #define PUSHSUB(cx) \ + { \ + /* 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); \ PUSHSUB_BASE(cx) \ cx->blk_u16 = PL_op->op_private & \ - (OPpLVAL_INTRO|OPpENTERSUB_INARGS); + (phlags|OPpDEREF); \ + } /* variant for use by OP_DBSTATE, where op_private holds hint bits */ #define PUSHSUB_DB(cx) \ @@ -374,7 +647,8 @@ struct block_format { STMT_START { \ RETURN_PROBE(GvENAME(CvGV((const CV*)cx->blk_sub.cv)), \ CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \ - CopLINE((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)) { \ POP_SAVEARRAY(); \ @@ -450,16 +724,11 @@ struct block_eval { struct block_loop { I32 resetsp; LOOP * my_op; /* My op, that contains redo, next and last ops. */ - /* (except for non_ithreads we need to modify next_op in pp_ctl.c, hence - why next_op is conditionally defined below.) */ -#ifdef USE_ITHREADS - PAD *oldcomppad; /* Also used for the GV, if targoffset is 0 */ - /* This is also accesible via cx->blk_loop.my_op->op_targ */ - PADOFFSET targoffset; -#else - OP * next_op; - SV ** itervar; -#endif + union { /* different ways of locating the iteration variable */ + SV **svp; + GV *gv; + PAD *oldcomppad; /* only used in ITHREADS */ + } itervar_u; union { struct { /* valid if type is LOOP_FOR or LOOP_PLAIN (but {NULL,0})*/ AV * ary; /* use the stack if this is NULL */ @@ -477,49 +746,38 @@ struct block_loop { }; #ifdef USE_ITHREADS -# define CxITERVAR(c) \ - ((c)->blk_loop.oldcomppad \ - ? (CxPADLOOP(c) \ - ? &CX_CURPAD_SV( (c)->blk_loop, (c)->blk_loop.targoffset ) \ - : &GvSV((GV*)(c)->blk_loop.oldcomppad)) \ - : (SV**)NULL) -# define CX_ITERDATA_SET(cx,idata,o) \ - if ((cx->blk_loop.targoffset = (o))) \ - CX_CURPAD_SAVE(cx->blk_loop); \ - else \ - cx->blk_loop.oldcomppad = (idata); +# define CxITERVAR_PADSV(c) \ + &CX_CURPAD_SV( (c)->blk_loop.itervar_u, (c)->blk_loop.my_op->op_targ) #else -# define CxITERVAR(c) ((c)->blk_loop.itervar) -# define CX_ITERDATA_SET(cx,ivar,o) \ - cx->blk_loop.itervar = (SV**)(ivar); +# define CxITERVAR_PADSV(c) ((c)->blk_loop.itervar_u.svp) #endif + +#define CxITERVAR(c) \ + ((c)->blk_loop.itervar_u.oldcomppad \ + ? (CxPADLOOP(c) \ + ? CxITERVAR_PADSV(c) \ + : &GvSV((c)->blk_loop.itervar_u.gv)) \ + : (SV**)NULL) + #define CxLABEL(c) (0 + CopLABEL((c)->blk_oldcop)) +#define CxLABEL_len(c,len) (0 + CopLABEL_len((c)->blk_oldcop, len)) +#define CxLABEL_len_flags(c,len,flags) (0 + CopLABEL_len_flags((c)->blk_oldcop, len, flags)) #define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS) #define CxLVAL(c) (0 + (c)->blk_u16) -#ifdef USE_ITHREADS -# define PUSHLOOP_OP_NEXT /* No need to do anything. */ -# define CX_LOOP_NEXTOP_GET(cx) ((cx)->blk_loop.my_op->op_nextop + 0) -#else -# define PUSHLOOP_OP_NEXT cx->blk_loop.next_op = cLOOP->op_nextop -# define CX_LOOP_NEXTOP_GET(cx) ((cx)->blk_loop.next_op + 0) -#endif - #define PUSHLOOP_PLAIN(cx, s) \ cx->blk_loop.resetsp = s - PL_stack_base; \ cx->blk_loop.my_op = cLOOP; \ - PUSHLOOP_OP_NEXT; \ cx->blk_loop.state_u.ary.ary = NULL; \ cx->blk_loop.state_u.ary.ix = 0; \ - CX_ITERDATA_SET(cx, NULL, 0); + cx->blk_loop.itervar_u.svp = NULL; -#define PUSHLOOP_FOR(cx, dat, s, offset) \ +#define PUSHLOOP_FOR(cx, ivar, s) \ cx->blk_loop.resetsp = s - PL_stack_base; \ cx->blk_loop.my_op = cLOOP; \ - PUSHLOOP_OP_NEXT; \ cx->blk_loop.state_u.ary.ary = NULL; \ cx->blk_loop.state_u.ary.ix = 0; \ - CX_ITERDATA_SET(cx, dat, offset); + cx->blk_loop.itervar_u.svp = (SV**)(ivar); #define POPLOOP(cx) \ if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \ @@ -572,14 +830,14 @@ struct block { #define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen #define DEBUG_CX(action) \ - DEBUG_l(WITH_THX( \ + DEBUG_l( \ 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__))); + __FILE__, __LINE__)); /* Enter a block. */ #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \ @@ -633,7 +891,6 @@ struct subst { #define sb_maxiters cx_u.cx_subst.sbu_maxiters #define sb_rflags cx_u.cx_subst.sbu_rflags #define sb_oldsave cx_u.cx_subst.sbu_oldsave -#define sb_once cx_u.cx_subst.sbu_once #define sb_rxtainted cx_u.cx_subst.sbu_rxtainted #define sb_orig cx_u.cx_subst.sbu_orig #define sb_dstr cx_u.cx_subst.sbu_dstr @@ -716,9 +973,7 @@ struct context { /* private flags for CXt_LOOP */ #define CXp_FOR_DEF 0x10 /* foreach using $_ */ -#ifdef USE_ITHREADS -# define CxPADLOOP(c) ((c)->blk_loop.targoffset) -#endif +#define CxPADLOOP(c) ((c)->blk_loop.my_op->op_targ) /* private flags for CXt_SUBST */ #define CXp_ONCE 0x10 /* What was sbu_once in struct subst */ @@ -781,11 +1036,16 @@ 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(). */ +#define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling + Perl_magic_methcall(). */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ @@ -894,18 +1154,18 @@ 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. +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. -See L. +See L. =cut */ @@ -948,8 +1208,8 @@ See L. #define POP_MULTICALL \ STMT_START { \ - LEAVESUB(multicall_cv); \ - CvDEPTH(multicall_cv)--; \ + if (! --CvDEPTH(multicall_cv)) \ + LEAVESUB(multicall_cv); \ POPBLOCK(cx,PL_curpm); \ POPSTACK; \ CATCH_SET(multicall_oldcatch); \ @@ -961,8 +1221,8 @@ See L. * 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: */