X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/486ec47ab73770ab60bf9cfb6d398a4371463266..43f197b58b234b5f912893ab0eb369af9d2f09c0:/cop.h diff --git a/cop.h b/cop.h index 5b5a79e..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 @@ -137,7 +138,7 @@ typedef struct jmpenv JMPENV; 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 @@ -386,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 */ @@ -424,23 +425,14 @@ struct cop { # else # define CopFILEAVx(c) (GvAV(gv_fetchfile(CopFILE(c)))) # endif -# define CopSTASHPV(c) ((c)->cop_stashpv) +# define CopSTASH(c) PL_stashpad[(c)->cop_stashoff] +# define CopSTASH_set(c,hv) ((c)->cop_stashoff = (hv) \ + ? alloccopstash(hv) \ + : 0) # 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)) -# 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 @@ -459,15 +451,15 @@ 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 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)) @@ -541,7 +533,9 @@ be zero. #define cop_hints_2hv(cop, flags) \ cophh_2hv(CopHINTHASH_get(cop), flags) -#define CopLABEL(c) Perl_fetch_cop_label(aTHX_ (c), NULL, NULL) +#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)) @@ -553,30 +547,6 @@ be zero. /* 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 inefficient 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(cop_hints_fetch_pvs((c), "$[", 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 { \ - CopHINTHASH_set((c), \ - cophh_store_pvs(CopHINTHASH_get((c)), "$[", \ - sv_2mortal(newSViv(b)), 0)); \ - } \ - } \ - } 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 { \ @@ -632,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) \ @@ -781,6 +760,8 @@ struct block_loop { : (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) @@ -910,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 @@ -1064,6 +1044,8 @@ L. #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 */ @@ -1172,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 */ @@ -1239,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: */