#define JMPENV_PUSH(v) \
STMT_START { \
DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \
- &cur_env, PL_top_env)); \
+ (void*)&cur_env, (void*)PL_top_env)); \
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); \
#define JMPENV_POP \
STMT_START { \
DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n", \
- PL_top_env, cur_env.je_prev)); \
+ (void*)PL_top_env, (void*)cur_env.je_prev)); \
PL_top_env = cur_env.je_prev; \
} STMT_END
HV * cop_stash; /* package line was compiled in */
GV * cop_filegv; /* file the following line # is from */
#endif
+ U32 cop_hints; /* hints bits from pragmata */
U32 cop_seq; /* parse sequence number */
- I32 cop_arybase; /* array base this line was compiled with */
line_t cop_line; /* line # of this command */
- SV * cop_warnings; /* lexical warnings bitmask */
- SV * cop_io; /* lexical IO defaults */
+ /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */
+ 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;
};
#ifdef USE_ITHREADS
# define OutCopFILE(c) CopFILE(c)
#endif
+/* 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) \
+ PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE; \
+ (c)->cop_hints_hash \
+ = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash, \
+ sv_2mortal(newSVpvs("$[")), \
+ 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 { \
+ (c)->cop_hints = (h); \
+ } STMT_END
+
/*
* Here we have some enormously heavy (or at least ponderous) wizardry.
*/
GV * dfoutgv;
AV * savearray;
AV * argarray;
- long olddepth;
- U8 hasargs;
- U8 lval; /* XXX merge lval and hasargs? */
+ I32 olddepth;
+ /* These are merged to to get struct context down to 64 bytes on ILP32. */
+ U8 hasargs_lval;
PAD *oldcomppad;
OP * retop; /* op to execute on exit from sub */
};
+#define CX_SUB_HASARGS_SET(cx, v) ((cx)->blk_sub.hasargs_lval = \
+ ((cx)->blk_sub.hasargs_lval & 0xFE) | ((v) ? 1 : 0))
+#define CX_SUB_HASARGS_GET(cx) ((cx)->blk_sub.hasargs_lval & 0x01)
+
+#define CX_SUB_LVAL_SET(cx, v) ((cx)->blk_sub.hasargs_lval = \
+ (((cx)->blk_sub.hasargs_lval & 0x01) | ((v) & (OPpLVAL_INTRO|OPpENTERSUB_INARGS))))
+#define CX_SUB_LVAL(cx) ((cx)->blk_sub.hasargs_lval & 0xFE)
+#define CX_SUB_LVAL_INARGS(cx) ((cx)->blk_sub.hasargs_lval & \
+ OPpENTERSUB_INARGS)
+
/* base for the next two macros. Don't use directly.
* Note that the refcnt of the cv is incremented twice; The CX one is
* decremented by LEAVESUB, the other by LEAVE. */
#define PUSHSUB_BASE(cx) \
cx->blk_sub.cv = cv; \
cx->blk_sub.olddepth = CvDEPTH(cv); \
- cx->blk_sub.hasargs = hasargs; \
+ CX_SUB_HASARGS_SET(cx, hasargs); \
cx->blk_sub.retop = NULL; \
if (!CvDEPTH(cv)) { \
- (void)SvREFCNT_inc(cv); \
- (void)SvREFCNT_inc(cv); \
+ SvREFCNT_inc_simple_void_NN(cv); \
+ SvREFCNT_inc_simple_void_NN(cv); \
SAVEFREESV(cv); \
}
#define PUSHSUB(cx) \
PUSHSUB_BASE(cx) \
- cx->blk_sub.lval = PL_op->op_private & \
- (OPpLVAL_INTRO|OPpENTERSUB_INARGS);
+ CX_SUB_LVAL_SET(cx, PL_op->op_private)
/* variant for use by OP_DBSTATE, where op_private holds hint bits */
#define PUSHSUB_DB(cx) \
PUSHSUB_BASE(cx) \
- cx->blk_sub.lval = 0;
+ CX_SUB_LVAL_SET(cx, 0)
#define PUSHFORMAT(cx) \
cx->blk_sub.cv = cv; \
cx->blk_sub.gv = gv; \
cx->blk_sub.retop = NULL; \
- cx->blk_sub.hasargs = 0; \
+ CX_SUB_HASARGS_SET(cx, 0); \
cx->blk_sub.dfoutgv = PL_defoutgv; \
- (void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
+ SvREFCNT_inc_void(cx->blk_sub.dfoutgv)
#define POP_SAVEARRAY() \
STMT_START { \
#define POPSUB(cx,sv) \
STMT_START { \
- if (cx->blk_sub.hasargs) { \
+ if (CX_SUB_HASARGS_GET(cx)) { \
POP_SAVEARRAY(); \
/* abandon @_ if it got reified */ \
if (AvREAL(cx->blk_sub.argarray)) { \
- SSize_t fill = AvFILLp(cx->blk_sub.argarray); \
+ const SSize_t fill = AvFILLp(cx->blk_sub.argarray); \
SvREFCNT_dec(cx->blk_sub.argarray); \
cx->blk_sub.argarray = newAV(); \
av_extend(cx->blk_sub.argarray, fill); \
SvREFCNT_dec(cx->blk_loop.iterlval); \
if (CxITERVAR(cx)) { \
if (SvPADMY(cx->blk_loop.itersave)) { \
- SV **s_v_p = CxITERVAR(cx); \
+ SV ** const s_v_p = CxITERVAR(cx); \
sv_2mortal(*s_v_p); \
*s_v_p = cx->blk_loop.itersave; \
} \
/* context common to subroutines, evals and loops */
struct block {
+ U16 blku_type; /* what kind of context this is */
+ U8 blku_gimme; /* is this block running in list context? */
I32 blku_oldsp; /* stack pointer to copy stuff down to */
COP * blku_oldcop; /* old curcop pointer */
I32 blku_oldmarksp; /* mark stack index */
I32 blku_oldscopesp; /* scope stack index */
PMOP * blku_oldpm; /* values of pattern match vars */
- U8 blku_gimme; /* is this block running in list context? */
union {
struct block_sub blku_sub;
/* substitution context */
struct subst {
+ U16 sbu_type; /* what kind of context this is */
+ bool sbu_once;
+ bool sbu_rxtainted;
I32 sbu_iters;
I32 sbu_maxiters;
I32 sbu_rflags;
I32 sbu_oldsave;
- bool sbu_once;
- bool sbu_rxtainted;
char * sbu_orig;
SV * sbu_dstr;
SV * sbu_targ;
cx->sb_s = s, \
cx->sb_m = m, \
cx->sb_strend = strend, \
- cx->sb_rxres = Null(void*), \
+ cx->sb_rxres = NULL, \
cx->sb_rx = rx, \
cx->cx_type = CXt_SUBST; \
- rxres_save(&cx->sb_rxres, rx)
+ rxres_save(&cx->sb_rxres, rx); \
+ (void)ReREFCNT_inc(rx)
#define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
- rxres_free(&cx->sb_rxres)
+ rxres_free(&cx->sb_rxres); \
+ ReREFCNT_dec(cx->sb_rx)
struct context {
- U32 cx_type; /* what kind of context this is */
union {
struct block cx_blk;
struct subst cx_subst;
} cx_u;
};
+#define cx_type cx_u.cx_subst.sbu_type
#define CXTYPEMASK 0xff
#define CXt_NULL 0
#define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */
#define G_NODEBUG 32 /* Disable debugging at toplevel. */
#define G_METHOD 64 /* Calling method. */
+#define G_FAKINGEVAL 256 /* Faking en eval context for call_sv or
+ fold_constants. */
/* flag bits for PL_in_eval */
#define EVAL_NULL 0 /* not in an eval */
CATCH_SET(multicall_oldcatch); \
LEAVE; \
} STMT_END
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
https://perl5.git.perl.org / perl5.git / blobdiff