/* cop.h
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 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.
#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
+#include "mydtrace.h"
struct cop {
BASEOP
+ /* On LP64 putting this here takes advantage of the fact that BASEOP isn't
+ an exact multiple of 8 bytes to save structure padding. */
+ line_t cop_line; /* line # of this command */
char * cop_label; /* label for this construct */
#ifdef USE_ITHREADS
char * cop_stashpv; /* package line was compiled in */
#endif
U32 cop_hints; /* hints bits from pragmata */
U32 cop_seq; /* parse sequence number */
- line_t cop_line; /* line # of this command */
/* 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
# ifdef NETWARE
# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+# define CopFILE_setn(c,pv,l) ((c)->cop_file = savepv((pv),(l)))
# else
# define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
+# define CopFILE_setn(c,pv,l) ((c)->cop_file = savesharedpvn((pv),(l)))
# endif
# define CopFILESV(c) (CopFILE(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 CopLABEL(c) ((c)->cop_label)
+# define CopLABEL_set(c,pv) (CopLABEL(c) = (pv))
# ifdef NETWARE
# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
# define CopFILE_free(c) SAVECOPFILE_FREE(c)
+# define CopLABEL_free(c) SAVECOPLABEL_FREE(c)
+# define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
# else
# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
+# define CopLABEL_free(c) (PerlMemShared_free(CopLABEL(c)),(CopLABEL(c) = NULL))
+# define CopLABEL_alloc(pv) ((pv)?savesharedpv(pv):NULL)
# endif
#else
# define CopFILEGV(c) ((c)->cop_filegv)
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+# define CopFILE_setn(c,pv,l) CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0))
# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
# ifdef DEBUGGING
# else
# define CopFILEAVx(c) (GvAV(CopFILEGV(c)))
# endif
-# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : NULL)
+# define CopFILE(c) (CopFILEGV(c) && GvSV(CopFILEGV(c)) \
+ ? SvPVX(GvSV(CopFILEGV(c))) : NULL)
# define CopSTASH(c) ((c)->cop_stash)
+# define CopLABEL(c) ((c)->cop_label)
# 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 CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
+# define CopLABEL_set(c,pv) (CopLABEL(c) = (pv))
# define CopSTASH_free(c)
# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
+# define CopLABEL_free(c) (Safefree(CopLABEL(c)),(CopLABEL(c) = NULL))
#endif /* USE_ITHREADS */
PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE; \
(c)->cop_hints_hash \
= Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash, \
- sv_2mortal(newSVpvs("$[")), \
+ newSVpvs_flags("$[", SVs_TEMP), \
sv_2mortal(newSViv(b))); \
} \
} STMT_END
/* subroutine context */
struct block_sub {
+ OP * retop; /* op to execute on exit from sub */
+ /* Above here is the same for sub, format and eval. */
CV * cv;
- GV * gv;
- GV * dfoutgv;
+ /* Above here is the same for sub and format. */
AV * savearray;
AV * argarray;
I32 olddepth;
- U8 hasargs;
- U8 lval; /* XXX merge lval and hasargs? */
PAD *oldcomppad;
+};
+
+
+/* format context */
+struct block_format {
OP * retop; /* op to execute on exit from sub */
+ /* Above here is the same for sub, format and eval. */
+ CV * cv;
+ /* Above here is the same for sub and format. */
+ GV * gv;
+ GV * dfoutgv;
};
/* base for the next two macros. Don't use directly.
* decremented by LEAVESUB, the other by LEAVE. */
#define PUSHSUB_BASE(cx) \
+ ENTRY_PROBE(GvENAME(CvGV(cv)), \
+ CopFILE((COP*)CvSTART(cv)), \
+ CopLINE((COP*)CvSTART(cv))); \
+ \
cx->blk_sub.cv = cv; \
cx->blk_sub.olddepth = CvDEPTH(cv); \
- cx->blk_sub.hasargs = hasargs; \
+ cx->cx_type |= (hasargs) ? CXp_HASARGS : 0; \
cx->blk_sub.retop = NULL; \
if (!CvDEPTH(cv)) { \
SvREFCNT_inc_simple_void_NN(cv); \
#define PUSHSUB(cx) \
PUSHSUB_BASE(cx) \
- cx->blk_sub.lval = PL_op->op_private & \
+ cx->blk_u16 = PL_op->op_private & \
(OPpLVAL_INTRO|OPpENTERSUB_INARGS);
/* 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->blk_u16 = 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->blk_sub.dfoutgv = PL_defoutgv; \
- SvREFCNT_inc_void(cx->blk_sub.dfoutgv)
+#define PUSHFORMAT(cx, retop) \
+ cx->blk_format.cv = cv; \
+ cx->blk_format.gv = gv; \
+ cx->blk_format.retop = (retop); \
+ cx->blk_format.dfoutgv = PL_defoutgv; \
+ SvREFCNT_inc_void(cx->blk_format.dfoutgv)
#define POP_SAVEARRAY() \
STMT_START { \
#define CLEAR_ARGARRAY(ary) \
STMT_START { \
AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \
- SvPV_set(ary, (char*)AvALLOC(ary)); \
+ AvARRAY(ary) = AvALLOC(ary); \
AvFILLp(ary) = -1; \
} STMT_END
#define POPSUB(cx,sv) \
STMT_START { \
- if (cx->blk_sub.hasargs) { \
+ RETURN_PROBE(GvENAME(CvGV((CV*)cx->blk_sub.cv)), \
+ CopFILE((COP*)CvSTART((CV*)cx->blk_sub.cv)), \
+ CopLINE((COP*)CvSTART((CV*)cx->blk_sub.cv))); \
+ \
+ if (CxHASARGS(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); \
} STMT_END
#define POPFORMAT(cx) \
- setdefout(cx->blk_sub.dfoutgv); \
- SvREFCNT_dec(cx->blk_sub.dfoutgv);
+ setdefout(cx->blk_format.dfoutgv); \
+ SvREFCNT_dec(cx->blk_format.dfoutgv);
/* eval context */
struct block_eval {
- I32 old_in_eval;
- I32 old_op_type;
+ OP * retop; /* op to execute on exit from eval */
+ /* Above here is the same for sub, format and eval. */
+ U8 old_in_eval;
+ U16 old_op_type;
SV * old_namesv;
OP * old_eval_root;
SV * cur_text;
CV * cv;
- OP * retop; /* op to execute on exit from eval */
JMPENV * cur_top_env; /* value of PL_top_env when eval CX created */
};
cx->blk_eval.old_op_type = PL_op->op_type; \
cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : NULL); \
cx->blk_eval.old_eval_root = PL_eval_root; \
- cx->blk_eval.cur_text = PL_linestr; \
+ cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL; \
cx->blk_eval.cv = NULL; /* set by doeval(), as applicable */ \
cx->blk_eval.retop = NULL; \
cx->blk_eval.cur_top_env = PL_top_env; \
/* loop context */
struct block_loop {
- char * label;
I32 resetsp;
- OP * redo_op;
- OP * next_op;
- OP * last_op;
+ 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
void * iterdata;
PAD *oldcomppad;
#else
+ OP * next_op;
SV ** itervar;
#endif
SV * itersave;
+ /* (from inspection of source code) for a .. range of strings this is the
+ current string. */
SV * iterlval;
+ /* (from inspection of source code) for a foreach loop this is the array
+ being iterated over. For a .. range of numbers it's the current value.
+ A check is often made on the SvTYPE of iterary to determine whether
+ we are iterating over an array or a range. (numbers or strings) */
AV * iterary;
IV iterix;
+ /* (from inspection of source code) for a .. range of numbers this is the
+ maximum value. */
IV itermax;
};
+/* It might be possible to squeeze this structure further. As best I can tell
+ itermax and iterlval are never used at the same time, so it might be possible
+ to make them into a union. However, I'm not confident that there are enough
+ flag bits/NULLable pointers in this structure alone to encode which is
+ active. There is, however, U8 of space free in struct block, which could be
+ used. Right now it may not be worth squeezing this structure further, as it's
+ the largest part of struct block, and currently struct block is 64 bytes on
+ an ILP32 system, which will give good cache alignment.
+*/
#ifdef USE_ITHREADS
# define CxITERVAR(c) \
else \
cx->blk_loop.itersave = NULL;
#endif
+#define CxLABEL(c) (0 + (c)->blk_oldcop->cop_label)
+#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(cx, dat, s) \
- cx->blk_loop.label = PL_curcop->cop_label; \
cx->blk_loop.resetsp = s - PL_stack_base; \
- cx->blk_loop.redo_op = cLOOP->op_redoop; \
- cx->blk_loop.next_op = cLOOP->op_nextop; \
- cx->blk_loop.last_op = cLOOP->op_lastop; \
+ cx->blk_loop.my_op = cLOOP; \
+ PUSHLOOP_OP_NEXT; \
cx->blk_loop.iterlval = NULL; \
cx->blk_loop.iterary = NULL; \
cx->blk_loop.iterix = -1; \
/* context common to subroutines, evals and loops */
struct block {
+ U8 blku_type; /* what kind of context this is */
+ U8 blku_gimme; /* is this block running in list context? */
+ U16 blku_u16; /* U16 of space used by block_sub */
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;
+ struct block_format blku_format;
struct block_eval blku_eval;
struct block_loop blku_loop;
struct block_givwhen blku_givwhen;
#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
#define blk_oldpm cx_u.cx_blk.blku_oldpm
#define blk_gimme cx_u.cx_blk.blku_gimme
+#define blk_u16 cx_u.cx_blk.blku_u16
#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
#define blk_loop cx_u.cx_blk.blk_u.blku_loop
#define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen
/* substitution context */
struct subst {
+ U8 sbu_type; /* what kind of context this is */
+ U8 sbu_once; /* Actually both booleans, but U8/U16 */
+ U16 sbu_rxtainted; /* matches struct block */
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_rx = rx, \
cx->cx_type = CXt_SUBST; \
rxres_save(&cx->sb_rxres, rx); \
- ReREFCNT_inc(rx)
+ (void)ReREFCNT_inc(rx)
#define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
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 CXTYPEMASK 0xf
#define CXt_NULL 0
#define CXt_SUB 1
#define CXt_EVAL 2
#define CXt_GIVEN 7
#define CXt_WHEN 8
-/* private flags for CXt_SUB and CXt_NULL */
-#define CXp_MULTICALL 0x00000400 /* part of a multicall (so don't
+/* private flags for CXt_SUB and CXt_NULL
+ However, this is checked in many places which do not check the type, so
+ this bit needs to be kept clear for most everything else. For reasons I
+ haven't investigated, it can coexist with CXp_FOR_DEF */
+#define CXp_MULTICALL 0x0000040 /* part of a multicall (so don't
tear down context on exit). */
+/* private flags for CXt_SUB and CXt_FORMAT */
+#define CXp_HASARGS 0x00000020
+
/* private flags for CXt_EVAL */
-#define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */
-#define CXp_TRYBLOCK 0x00000200 /* eval{}, not eval'' or similar */
+#define CXp_REAL 0x00000010 /* truly eval'', not a lookalike */
+#define CXp_TRYBLOCK 0x00000020 /* eval{}, not eval'' or similar */
/* private flags for CXt_LOOP */
-#define CXp_FOREACH 0x00000200 /* a foreach loop */
-#define CXp_FOR_DEF 0x00000400 /* foreach using $_ */
+#define CXp_FOREACH 0x00000020 /* a foreach loop */
+#define CXp_FOR_DEF 0x00000040 /* foreach using $_ */
#ifdef USE_ITHREADS
-# define CXp_PADVAR 0x00000100 /* itervar lives on pad, iterdata
+# define CXp_PADVAR 0x00000010 /* itervar lives on pad, iterdata
has pad offset; if not set,
iterdata holds GV* */
# define CxPADLOOP(c) (((c)->cx_type & (CXt_LOOP|CXp_PADVAR)) \
#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
#define CxMULTICALL(c) (((c)->cx_type & CXp_MULTICALL) \
== CXp_MULTICALL)
-#define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) \
+#define CxREALEVAL(c) (((c)->cx_type & (CXTYPEMASK|CXp_REAL)) \
== (CXt_EVAL|CXp_REAL))
-#define CxTRYBLOCK(c) (((c)->cx_type & (CXt_EVAL|CXp_TRYBLOCK)) \
+#define CxTRYBLOCK(c) (((c)->cx_type & (CXTYPEMASK|CXp_TRYBLOCK)) \
== (CXt_EVAL|CXp_TRYBLOCK))
-#define CxFOREACH(c) (((c)->cx_type & (CXt_LOOP|CXp_FOREACH)) \
+#define CxFOREACH(c) (((c)->cx_type & (CXTYPEMASK|CXp_FOREACH)) \
== (CXt_LOOP|CXp_FOREACH))
-#define CxFOREACHDEF(c) (((c)->cx_type & (CXt_LOOP|CXp_FOREACH|CXp_FOR_DEF))\
+#define CxFOREACHDEF(c) (((c)->cx_type & (CXTYPEMASK|CXp_FOREACH|CXp_FOR_DEF))\
== (CXt_LOOP|CXp_FOREACH|CXp_FOR_DEF))
#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
=cut
*/
-#define G_SCALAR 0
-#define G_ARRAY 1
-#define G_VOID 128 /* skip this bit when adding flags below */
+#define G_SCALAR 2
+#define G_ARRAY 3
+#define G_VOID 1
+#define G_WANT 3
/* extra flags for Perl_call_* routines */
-#define G_DISCARD 2 /* Call FREETMPS. */
-#define G_EVAL 4 /* Assume eval {} around subroutine call. */
-#define G_NOARGS 8 /* Don't construct a @_ array. */
-#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
+#define G_DISCARD 4 /* Call FREETMPS.
+ Don't change this without consulting the
+ 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_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. */
/* flag bits for PL_in_eval */
struct stackinfo {
AV * si_stack; /* stack for current runlevel */
PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
+ struct stackinfo * si_prev;
+ struct stackinfo * si_next;
I32 si_cxix; /* current context index */
I32 si_cxmax; /* maximum allocated index */
I32 si_type; /* type of runlevel */
- struct stackinfo * si_prev;
- struct stackinfo * si_next;
I32 si_markoff; /* offset where markstack begins for us.
* currently used only with DEBUGGING,
* but not #ifdef-ed for bincompat */
https://perl5.git.perl.org / perl5.git / blobdiff