=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,
-respectively. See L<perlcall> for a usage example.
+respectively.
See L<perlcall> for a usage example.
=for apidoc Amn|U32|GIMME
A backward-compatible version of C<GIMME_V> which can only return
#define OPpOPEN_OUT_RAW 64 /* binmode(F,":raw") on output fh */
#define OPpOPEN_OUT_CRLF 128 /* binmode(F,":crlf") on output fh */
-/* Private for OP_EXIT, HUSH also for OP_DIE */
-#define OPpHUSH_VMSISH 64 /* hush DCL exit msg vmsish mode*/
-#define OPpEXIT_VMSISH 128 /* exit(0) vs. exit(1) vmsish mode*/
+/* Private for COPs */
+#define OPpHUSH_VMSISH 32 /* hush DCL exit msg vmsish mode*/
+/* Note: Used for NATIVE_HINTS (shifted from the values in PL_hints),
+ currently defined by vms/vmsish.h:
+ 64
+ 128
+ */
/* Private for OP_FTXXX */
#define OPpFT_ACCESS 2 /* use filetest 'access' */
#define PERL_LOADMOD_NOIMPORT 0x2 /* use Module () */
#define PERL_LOADMOD_IMPORT_OPS 0x4 /* use Module (...) */
-#if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C)
+#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
=for apidoc Am|OP*|LINKLIST|OP *o
Given the root of an optree, link the tree in execution order using the
-C<op_next> pointers and return the first op executed. If this has
+C<op_next> pointers and return the first op executed. If this has
already been done, it will not be redone, and C<< o->op_next >> will be
-returned. If C<< o->op_next >> is not already set, I<o> should be at
+returned. If C<< o->op_next >> is not already set, I<o> should be at
least an C<UNOP>.
=cut
Return the BHK's flags.
=for apidoc mx|void *|BhkENTRY|BHK *hk|which
-Return an entry from the BHK structure. I<which> is a preprocessor token
-indicating which entry to return. If the appropriate flag is not set
-this will return NULL. The type of the return value depends on which
+Return an entry from the BHK structure. I<which> is a preprocessor token
+indicating which entry to return. If the appropriate flag is not set
+this will return NULL. The type of the return value depends on which
entry you ask for.
=for apidoc Amx|void|BhkENTRY_set|BHK *hk|which|void *ptr
Set an entry in the BHK structure, and set the flags to indicate it is
-valid. I<which> is a preprocessing token indicating which entry to set.
+valid. I<which> is a preprocessing token indicating which entry to set.
The type of I<ptr> depends on the entry.
=for apidoc Amx|void|BhkDISABLE|BHK *hk|which
Temporarily disable an entry in this BHK structure, by clearing the
-appropriate flag. I<which> is a preprocessor token indicating which
+appropriate flag. I<which> is a preprocessor token indicating which
entry to disable.
=for apidoc Amx|void|BhkENABLE|BHK *hk|which
Re-enable an entry in this BHK structure, by setting the appropriate
-flag. I<which> is a preprocessor token indicating which entry to enable.
+flag. I<which> is a preprocessor token indicating which entry to enable.
This will assert (under -DDEBUGGING) if the entry doesn't contain a valid
pointer.
=for apidoc mx|void|CALL_BLOCK_HOOKS|which|arg
-Call all the registered block hooks for type I<which>. I<which> is a
+Call all the registered block hooks for type I<which>. I<which> is a
preprocessing token; the type of I<arg> depends on I<which>.
=cut
STMT_START { \
if (PL_blockhooks) { \
SSize_t i; \
- for (i = av_len(PL_blockhooks); i >= 0; i--) { \
+ for (i = av_tindex(PL_blockhooks); i >= 0; i--) { \
SV *sv = AvARRAY(PL_blockhooks)[i]; \
BHK *hk; \
\
Return the XOP's flags.
=for apidoc Am||XopENTRY|XOP *xop|which
-Return a member of the XOP structure. I<which> is a cpp token indicating
-which entry to return. If the member is not set this will return a
-default value. The return type depends on I<which>.
+Return a member of the XOP structure. I<which> is a cpp token
+indicating which entry to return. If the member is not set
+this will return a default value. The return type depends
+on I<which>. This macro evaluates its arguments more than
+once. If you are using C<Perl_custom_op_xop> to retreive a
+C<XOP *> from a C<OP *>, use the more efficient L</XopENTRYCUSTOM> instead.
+
+=for apidoc Am||XopENTRYCUSTOM|const OP *o|which
+Exactly like C<XopENTRY(XopENTRY(Perl_custom_op_xop(aTHX_ o), which)> but more
+efficient. The I<which> parameter is identical to L</XopENTRY>.
=for apidoc Am|void|XopENTRY_set|XOP *xop|which|value
-Set a member of the XOP structure. I<which> is a cpp token indicating
-which entry to set. See L<perlguts/"Custom Operators"> for details about
-the available members and how they are used.
+Set a member of the XOP structure. I<which> is a cpp token
+indicating which entry to set. See L<perlguts/"Custom Operators">
+for details about the available members and how
+they are used. This macro evaluates its argument
+more than once.
=for apidoc Am|void|XopDISABLE|XOP *xop|which
Temporarily disable a member of the XOP, by clearing the appropriate flag.
void (*xop_peep)(pTHX_ OP *o, OP *oldop);
};
+/* return value of Perl_custom_op_get_field, similar to void * then casting but
+ the U32 doesn't need truncation on 64 bit platforms in the caller, also
+ for easier macro writing */
+typedef union {
+ const char *xop_name;
+ const char *xop_desc;
+ U32 xop_class;
+ void (*xop_peep)(pTHX_ OP *o, OP *oldop);
+ XOP *xop_ptr;
+} XOPRETANY;
+
#define XopFLAGS(xop) ((xop)->xop_flags)
#define XOPf_xop_name 0x01
#define XOPf_xop_class 0x04
#define XOPf_xop_peep 0x08
+/* used by Perl_custom_op_get_field for option checking */
+typedef enum {
+ XOPe_xop_ptr = 0, /* just get the XOP *, don't look inside it */
+ XOPe_xop_name = XOPf_xop_name,
+ XOPe_xop_desc = XOPf_xop_desc,
+ XOPe_xop_class = XOPf_xop_class,
+ XOPe_xop_peep = XOPf_xop_peep
+} xop_flags_enum;
+
#define XOPd_xop_name PL_op_name[OP_CUSTOM]
#define XOPd_xop_desc PL_op_desc[OP_CUSTOM]
#define XOPd_xop_class OA_BASEOP
#define XopENTRY(xop, which) \
((XopFLAGS(xop) & XOPf_ ## which) ? (xop)->which : XOPd_ ## which)
+#define XopENTRYCUSTOM(o, which) \
+ (Perl_custom_op_get_field(aTHX_ o, XOPe_ ## which).which)
+
#define XopDISABLE(xop, which) ((xop)->xop_flags &= ~XOPf_ ## which)
#define XopENABLE(xop, which) \
STMT_START { \
assert(XopENTRY(xop, which)); \
} STMT_END
+#define Perl_custom_op_xop(x) \
+ (Perl_custom_op_get_field(x, XOPe_xop_ptr).xop_ptr)
+
/*
=head1 Optree Manipulation Functions
=for apidoc Am|const char *|OP_NAME|OP *o
-Return the name of the provided OP. For core ops this looks up the name
+Return the name of the provided OP. For core ops this looks up the name
from the op_type; for custom ops from the op_ppaddr.
=for apidoc Am|const char *|OP_DESC|OP *o
=for apidoc Am|U32|OP_CLASS|OP *o
Return the class of the provided OP: that is, which of the *OP
-structures it uses. For core ops this currently gets the information out
+structures it uses. For core ops this currently gets the information out
of PL_opargs, which does not always accurately reflect the type used.
For custom ops the type is returned from the registration, and it is up
-to the registree to ensure it is accurate. The value returned will be
+to the registree to ensure it is accurate. The value returned will be
one of the OA_* constants from op.h.
+=for apidoc Am|bool|OP_TYPE_IS|OP *o, Optype type
+Returns true if the given OP is not a NULL pointer
+and if it is of the given type.
+
+The negation of this macro, C<OP_TYPE_ISNT> is also available
+as well as C<OP_TYPE_IS_NN> and C<OP_TYPE_ISNT_NN> which elide
+the NULL pointer check.
+
+=for apidoc Am|bool|OP_TYPE_IS_OR_WAS|OP *o, Optype type
+Returns true if the given OP is not a NULL pointer and
+if it is of the given type or used to be before being
+replaced by an OP of type OP_NULL.
+
+The negation of this macro, C<OP_TYPE_ISNT_AND_WASNT>
+is also available as well as C<OP_TYPE_IS_OR_WAS_NN>
+and C<OP_TYPE_ISNT_AND_WASNT_NN> which elide
+the NULL pointer check.
+
=cut
*/
#define OP_NAME(o) ((o)->op_type == OP_CUSTOM \
- ? XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_name) \
+ ? XopENTRYCUSTOM(o, xop_name) \
: PL_op_name[(o)->op_type])
#define OP_DESC(o) ((o)->op_type == OP_CUSTOM \
- ? XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_desc) \
+ ? XopENTRYCUSTOM(o, xop_desc) \
: PL_op_desc[(o)->op_type])
#define OP_CLASS(o) ((o)->op_type == OP_CUSTOM \
- ? XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_class) \
+ ? XopENTRYCUSTOM(o, xop_class) \
: (PL_opargs[(o)->op_type] & OA_CLASS_MASK))
-#define newSUB(f, o, p, b) Perl_newATTRSUB(aTHX_ (f), (o), (p), NULL, (b))
+#define OP_TYPE_IS(o, type) ((o) && (o)->op_type == (type))
+#define OP_TYPE_IS_NN(o, type) ((o)->op_type == (type))
+#define OP_TYPE_ISNT(o, type) ((o) && (o)->op_type != (type))
+#define OP_TYPE_ISNT_NN(o, type) ((o)->op_type != (type))
+
+#define OP_TYPE_IS_OR_WAS_NN(o, type) \
+ ( ((o)->op_type == OP_NULL \
+ ? (o)->op_targ \
+ : (o)->op_type) \
+ == (type) )
+
+#define OP_TYPE_IS_OR_WAS(o, type) \
+ ( (o) && OP_TYPE_IS_OR_WAS_NN(o, type) )
+
+#define OP_TYPE_ISNT_AND_WASNT_NN(o, type) \
+ ( ((o)->op_type == OP_NULL \
+ ? (o)->op_targ \
+ : (o)->op_type) \
+ != (type) )
+
+#define OP_TYPE_ISNT_AND_WASNT(o, type) \
+ ( (o) && OP_TYPE_ISNT_AND_WASNT_NN(o, 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))
#ifdef PERL_MAD
# define MAD_NULL 1
https://perl5.git.perl.org / perl5.git / blobdiff