* but this is replaced when op is grafted in, when
* this op will point to the real next op, and the new
* parent takes over role of remembering starting op.)
+ * op_sibparent Pointer to the op's next sibling, or to the parent
+ * if there are no more siblings.
* op_ppaddr Pointer to current ppcode's function.
+ * op_targ An index into the current pad, identifying an SV
+ * that is typically used to store the OP's result
+ * (such as a lexical variable, or a SVs_PADTMP
+ * temporary intermediate value).
* op_type The type of the operation.
* op_opt Whether or not the op has been optimised by the
* peephole optimiser.
/* for efficiency, requires OPf_WANT_VOID == G_VOID etc */
#define OP_GIMME(op,dfl) \
- (((op)->op_flags & OPf_WANT) ? ((op)->op_flags & OPf_WANT) : dfl)
+ (((op)->op_flags & OPf_WANT) ? ((op)->op_flags & OPf_WANT) : dfl)
#define OP_GIMME_REVERSE(flags) ((flags) & G_WANT)
=for apidoc Amn|U32|GIMME_V
The XSUB-writer's equivalent to Perl's C<wantarray>. Returns C<G_VOID>,
-C<G_SCALAR> or C<G_ARRAY> for void, scalar or list context,
+C<G_SCALAR> or C<G_LIST> for void, scalar or list context,
respectively. See L<perlcall> for a usage example.
=for apidoc AmnD|U32|GIMME
A backward-compatible version of C<GIMME_V> which can only return
-C<G_SCALAR> or C<G_ARRAY>; in a void context, it returns C<G_SCALAR>.
+C<G_SCALAR> or C<G_LIST>; in a void context, it returns C<G_SCALAR>.
Deprecated. Use C<GIMME_V> instead.
=cut
#define OPf_WANT_LIST 3 /* Want list of any length */
#define OPf_KIDS 4 /* There is a firstborn child. */
#define OPf_PARENS 8 /* This operator was parenthesized. */
- /* (Or block needs explicit scope entry.) */
+ /* (Or block needs explicit scope entry.) */
#define OPf_REF 16 /* Certified reference. */
- /* (Return container, not containee). */
+ /* (Return container, not containee). */
#define OPf_MOD 32 /* Will modify (lvalue). */
#define OPf_STACKED 64 /* Some arg is arriving on the stack. */
*/
#define OPf_SPECIAL 128 /* Do something weird for this op: */
- /* On local LVAL, don't init local value. */
- /* On OP_SORT, subroutine is inlined. */
- /* On OP_NOT, inversion was implicit. */
- /* On OP_LEAVE, don't restore curpm, e.g.
+ /* On local LVAL, don't init local value. */
+ /* On OP_SORT, subroutine is inlined. */
+ /* On OP_NOT, inversion was implicit. */
+ /* On OP_LEAVE, don't restore curpm, e.g.
* /(...)/ while ...>; */
- /* On truncate, we truncate filehandle */
- /* On control verbs, we saw no label */
- /* On flipflop, we saw ... instead of .. */
- /* On UNOPs, saw bare parens, e.g. eof(). */
- /* On OP_CHDIR, handle (or bare parens) */
- /* On OP_NULL, saw a "do". */
- /* On OP_EXISTS, treat av as av, not avhv. */
- /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
- /* On regcomp, "use re 'eval'" was in scope */
- /* On RV2[ACGHS]V, don't create GV--in
- defined()*/
- /* On OP_DBSTATE, indicates breakpoint
- * (runtime property) */
- /* On OP_REQUIRE, was seen as CORE::require */
- /* On OP_(ENTER|LEAVE)WHEN, there's
- no condition */
- /* On OP_SMARTMATCH, an implicit smartmatch */
- /* On OP_ANONHASH and OP_ANONLIST, create a
- reference to the new anon hash or array */
- /* On OP_HELEM, OP_MULTIDEREF and OP_HSLICE,
+ /* On truncate, we truncate filehandle */
+ /* On control verbs, we saw no label */
+ /* On flipflop, we saw ... instead of .. */
+ /* On UNOPs, saw bare parens, e.g. eof(). */
+ /* On OP_CHDIR, handle (or bare parens) */
+ /* On OP_NULL, saw a "do". */
+ /* On OP_EXISTS, treat av as av, not avhv. */
+ /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
+ /* On regcomp, "use re 'eval'" was in scope */
+ /* On RV2[ACGHS]V, don't create GV--in
+ defined()*/
+ /* On OP_DBSTATE, indicates breakpoint
+ * (runtime property) */
+ /* On OP_REQUIRE, was seen as CORE::require */
+ /* On OP_(ENTER|LEAVE)WHEN, there's
+ no condition */
+ /* On OP_SMARTMATCH, an implicit smartmatch */
+ /* On OP_ANONHASH and OP_ANONLIST, create a
+ reference to the new anon hash or array */
+ /* On OP_HELEM, OP_MULTIDEREF and OP_HSLICE,
localization will be followed by assignment,
so do not wipe the target if it is special
(e.g. a glob or a magic SV) */
- /* On OP_MATCH, OP_SUBST & OP_TRANS, the
- operand of a logical or conditional
- that was optimised away, so it should
- not be bound via =~ */
- /* On OP_CONST, from a constant CV */
- /* On OP_GLOB, two meanings:
- - Before ck_glob, called as CORE::glob
- - After ck_glob, use Perl glob function
- */
+ /* On OP_MATCH, OP_SUBST & OP_TRANS, the
+ operand of a logical or conditional
+ that was optimised away, so it should
+ not be bound via =~ */
+ /* On OP_CONST, from a constant CV */
+ /* On OP_GLOB, two meanings:
+ - Before ck_glob, called as CORE::glob
+ - After ck_glob, use Perl glob function
+ */
/* On OP_PADRANGE, push @_ */
/* On OP_DUMP, has no label */
/* On OP_UNSTACK, in a C-style for loop */
#if !defined(PERL_CORE) && !defined(PERL_EXT)
# define GIMME \
- (PL_op->op_flags & OPf_WANT \
- ? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \
- ? G_ARRAY \
- : G_SCALAR) \
- : dowantarray())
+ (PL_op->op_flags & OPf_WANT \
+ ? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \
+ ? G_LIST \
+ : G_SCALAR) \
+ : dowantarray())
#endif
struct logop {
BASEOP
OP * op_first;
+
+ /* Note that op->op_other is the *next* op in execution order of the
+ * alternate branch, not the root of the subtree. I.e. imagine it being
+ * called ->op_otherfirst.
+ * To find the structural subtree root (what could be called
+ * ->op_otherroot), use OpSIBLING of ->op_first */
OP * op_other;
};
#endif
U32 op_pmflags;
union {
- OP * op_pmreplroot; /* For OP_SUBST */
- PADOFFSET op_pmtargetoff; /* For OP_SPLIT lex ary or thr GV */
- GV * op_pmtargetgv; /* For OP_SPLIT non-threaded GV */
+ OP * op_pmreplroot; /* For OP_SUBST */
+ PADOFFSET op_pmtargetoff; /* For OP_SPLIT lex ary or thr GV */
+ GV * op_pmtargetgv; /* For OP_SPLIT non-threaded GV */
} op_pmreplrootu;
union {
- OP * op_pmreplstart; /* Only used in OP_SUBST */
+ OP * op_pmreplstart; /* Only used in OP_SUBST */
#ifdef USE_ITHREADS
- PADOFFSET op_pmstashoff; /* Only used in OP_MATCH, with PMf_ONCE set */
+ PADOFFSET op_pmstashoff; /* Only used in OP_MATCH, with PMf_ONCE set */
#else
- HV * op_pmstash;
+ HV * op_pmstash;
#endif
} op_pmstashstartu;
OP * op_code_list; /* list of (?{}) code blocks */
#ifdef USE_ITHREADS
#define PM_GETRE(o) (SvTYPE(PL_regex_pad[(o)->op_pmoffset]) == SVt_REGEXP \
- ? (REGEXP*)(PL_regex_pad[(o)->op_pmoffset]) : NULL)
+ ? (REGEXP*)(PL_regex_pad[(o)->op_pmoffset]) : NULL)
/* The assignment is just to enforce type safety (or at least get a warning).
*/
/* With first class regexps not via a reference one needs to assign
#define PM_SETRE(o,r) STMT_START { \
REGEXP *const _pm_setre = (r); \
assert(_pm_setre); \
- PL_regex_pad[(o)->op_pmoffset] = MUTABLE_SV(_pm_setre); \
+ PL_regex_pad[(o)->op_pmoffset] = MUTABLE_SV(_pm_setre); \
} STMT_END
#else
#define PM_GETRE(o) ((o)->op_pmregexp)
? PL_stashpad[(o)->op_pmstashstartu.op_pmstashoff] \
: NULL)
# define PmopSTASH_set(o,hv) \
- (assert_((o)->op_pmflags & PMf_ONCE) \
- (o)->op_pmstashstartu.op_pmstashoff = \
- (hv) ? alloccopstash(hv) : 0)
+ (assert_((o)->op_pmflags & PMf_ONCE) \
+ (o)->op_pmstashstartu.op_pmstashoff = \
+ (hv) ? alloccopstash(hv) : 0)
#else
# define PmopSTASH(o) \
(((o)->op_pmflags & PMf_ONCE) ? (o)->op_pmstashstartu.op_pmstash : NULL)
# if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS)
# define PmopSTASH_set(o,hv) ({ \
- assert((o)->op_pmflags & PMf_ONCE); \
- ((o)->op_pmstashstartu.op_pmstash = (hv)); \
+ assert((o)->op_pmflags & PMf_ONCE); \
+ ((o)->op_pmstashstartu.op_pmstash = (hv)); \
})
# else
# define PmopSTASH_set(o,hv) ((o)->op_pmstashstartu.op_pmstash = (hv))
# ifndef PERL_CORE
# define IS_PADGV(v) (v && isGV(v))
# define IS_PADCONST(v) \
- (v && (SvREADONLY(v) || (SvIsCOW(v) && !SvLEN(v))))
+ (v && (SvREADONLY(v) || (SvIsCOW(v) && !SvLEN(v))))
# endif
# define cSVOPx_sv(v) (cSVOPx(v)->op_sv \
- ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ))
+ ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ))
# define cSVOPx_svp(v) (cSVOPx(v)->op_sv \
- ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ))
+ ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ))
# define cMETHOPx_rclass(v) PAD_SVl(cMETHOPx(v)->op_rclass_targ)
#else
# define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv)
#define PERL_LOADMOD_DENY 0x1 /* no Module */
#define PERL_LOADMOD_NOIMPORT 0x2 /* use Module () */
#define PERL_LOADMOD_IMPORT_OPS 0x4 /* import arguments
- are passed as a sin-
- gle op tree, not a
- list of SVs */
+ are passed as a sin-
+ gle op tree, not a
+ list of SVs */
#if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_TOKE_C)
#define ref(o, type) doref(o, type, TRUE)
#endif
#define NewOp(m,var,c,type) \
- (var = (type *) Perl_Slab_Alloc(aTHX_ c*sizeof(type)))
+ (var = (type *) Perl_Slab_Alloc(aTHX_ c*sizeof(type)))
#define NewOpSz(m,var,size) \
- (var = (OP *) Perl_Slab_Alloc(aTHX_ size))
+ (var = (OP *) Perl_Slab_Alloc(aTHX_ size))
#define FreeOp(p) Perl_Slab_Free(aTHX_ p)
/*
# define OPSLOT_HEADER STRUCT_OFFSET(OPSLOT, opslot_op)
# define OpSLOT(o) (assert_(o->op_slabbed) \
- (OPSLOT *)(((char *)o)-OPSLOT_HEADER))
+ (OPSLOT *)(((char *)o)-OPSLOT_HEADER))
/* the slab that owns this op */
# define OpMySLAB(o) \
((OPSLOT*)(((I32 **)&(slab)->opslab_slots)+(offset)))
# define OpslabREFCNT_dec(slab) \
- (((slab)->opslab_refcnt == 1) \
- ? opslab_free_nopad(slab) \
- : (void)--(slab)->opslab_refcnt)
+ (((slab)->opslab_refcnt == 1) \
+ ? opslab_free_nopad(slab) \
+ : (void)--(slab)->opslab_refcnt)
/* Variant that does not null out the pads */
# define OpslabREFCNT_dec_padok(slab) \
- (((slab)->opslab_refcnt == 1) \
- ? opslab_free(slab) \
- : (void)--(slab)->opslab_refcnt)
+ (((slab)->opslab_refcnt == 1) \
+ ? opslab_free(slab) \
+ : (void)--(slab)->opslab_refcnt)
#endif
struct block_hooks {
#define BhkENABLE(hk, which) \
STMT_START { \
- BhkFLAGS(hk) |= BHKf_ ## which; \
- assert(BhkENTRY(hk, which)); \
+ BhkFLAGS(hk) |= BHKf_ ## which; \
+ assert(BhkENTRY(hk, which)); \
} STMT_END
#define BhkDISABLE(hk, which) \
STMT_START { \
- BhkFLAGS(hk) &= ~(BHKf_ ## which); \
+ BhkFLAGS(hk) &= ~(BHKf_ ## which); \
} STMT_END
#define BhkENTRY_set(hk, which, ptr) \
STMT_START { \
- (hk)->which = ptr; \
- BhkENABLE(hk, which); \
+ (hk)->which = ptr; \
+ BhkENABLE(hk, which); \
} STMT_END
#define CALL_BLOCK_HOOKS(which, arg) \
STMT_START { \
- if (PL_blockhooks) { \
- SSize_t i; \
- for (i = av_top_index(PL_blockhooks); i >= 0; i--) { \
- SV *sv = AvARRAY(PL_blockhooks)[i]; \
- BHK *hk; \
- \
- assert(SvIOK(sv)); \
- if (SvUOK(sv)) \
- hk = INT2PTR(BHK *, SvUVX(sv)); \
- else \
- hk = INT2PTR(BHK *, SvIVX(sv)); \
- \
- if (BhkENTRY(hk, which)) \
- BhkENTRY(hk, which)(aTHX_ arg); \
- } \
- } \
+ if (PL_blockhooks) { \
+ SSize_t i; \
+ for (i = av_top_index(PL_blockhooks); i >= 0; i--) { \
+ SV *sv = AvARRAY(PL_blockhooks)[i]; \
+ BHK *hk; \
+ \
+ assert(SvIOK(sv)); \
+ if (SvUOK(sv)) \
+ hk = INT2PTR(BHK *, SvUVX(sv)); \
+ else \
+ hk = INT2PTR(BHK *, SvIVX(sv)); \
+ \
+ if (BhkENTRY(hk, which)) \
+ BhkENTRY(hk, which)(aTHX_ arg); \
+ } \
+ } \
} STMT_END
/* flags for rv2cv_op_cv */
#define XopENTRY_set(xop, which, to) \
STMT_START { \
- (xop)->which = (to); \
- (xop)->xop_flags |= XOPf_ ## which; \
+ (xop)->which = (to); \
+ (xop)->xop_flags |= XOPf_ ## which; \
} STMT_END
#define XopENTRY(xop, which) \
#define XopDISABLE(xop, which) ((xop)->xop_flags &= ~XOPf_ ## which)
#define XopENABLE(xop, which) \
STMT_START { \
- (xop)->xop_flags |= XOPf_ ## which; \
- assert(XopENTRY(xop, which)); \
+ (xop)->xop_flags |= XOPf_ ## which; \
+ assert(XopENTRY(xop, which)); \
} STMT_END
#define Perl_custom_op_xop(x) \
#define OP_NAME(o) ((o)->op_type == OP_CUSTOM \
? XopENTRYCUSTOM(o, xop_name) \
- : PL_op_name[(o)->op_type])
+ : PL_op_name[(o)->op_type])
#define OP_DESC(o) ((o)->op_type == OP_CUSTOM \
? XopENTRYCUSTOM(o, xop_desc) \
- : PL_op_desc[(o)->op_type])
+ : PL_op_desc[(o)->op_type])
#define OP_CLASS(o) ((o)->op_type == OP_CUSTOM \
- ? XopENTRYCUSTOM(o, xop_class) \
- : (PL_opargs[(o)->op_type] & OA_CLASS_MASK))
+ ? XopENTRYCUSTOM(o, xop_class) \
+ : (PL_opargs[(o)->op_type] & OA_CLASS_MASK))
#define OP_TYPE_IS(o, type) ((o) && (o)->op_type == (type))
#define OP_TYPE_IS_NN(o, type) ((o)->op_type == (type))
#define newATTRSUB(f, o, p, a, b) Perl_newATTRSUB_x(aTHX_ f, o, p, a, b, FALSE)
#define newSUB(f, o, p, b) newATTRSUB((f), (o), (p), NULL, (b))
-/*
-=for apidoc_section Hook manipulation
-*/
-
#ifdef USE_ITHREADS
# define OP_CHECK_MUTEX_INIT MUTEX_INIT(&PL_check_mutex)
# define OP_CHECK_MUTEX_LOCK MUTEX_LOCK(&PL_check_mutex)
https://perl5.git.perl.org / perl5.git / blobdiff