Apda |SV* |newSVsv |NULLOK SV *const old
Apda |SV* |newSV_type |const svtype type
Apda |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first
+Apda |OP* |newUNOP_AUX |I32 type|I32 flags|NULLOK OP* first \
+ |NULLOK UNOP_AUX_item *aux
Apda |OP* |newWHENOP |NULLOK OP* cond|NN OP* block
Apda |OP* |newWHILEOP |I32 flags|I32 debuggable|NULLOK LOOP* loop \
|NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \
#define newSVsv(a) Perl_newSVsv(aTHX_ a)
#define newSVuv(a) Perl_newSVuv(aTHX_ a)
#define newUNOP(a,b,c) Perl_newUNOP(aTHX_ a,b,c)
+#define newUNOP_AUX(a,b,c,d) Perl_newUNOP_AUX(aTHX_ a,b,c,d)
#define newWHENOP(a,b) Perl_newWHENOP(aTHX_ a,b)
#define newWHILEOP(a,b,c,d,e,f,g) Perl_newWHILEOP(aTHX_ a,b,c,d,e,f,g)
#define newXS(a,b,c) Perl_newXS(aTHX_ a,b,c)
@B::OP::ISA = 'B::OBJECT';
@B::UNOP::ISA = 'B::OP';
+@B::UNOP_AUX::ISA = 'B::UNOP';
@B::BINOP::ISA = 'B::UNOP';
@B::LOGOP::ISA = 'B::UNOP';
@B::LISTOP::ISA = 'B::BINOP';
@B::SPECIAL::ISA = 'B::OBJECT';
-@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP METHOP);
+@B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP
+ METHOP UNOP_AUX);
# bytecode.pl contained the following comment:
# Nullsv *must* come first in the following so that the condition
# ($$sv == 0) can continue to be used to test (sv == Nullsv).
=head2 OP-RELATED CLASSES
-C<B::OP>, C<B::UNOP>, C<B::BINOP>, C<B::LOGOP>, C<B::LISTOP>, C<B::PMOP>,
-C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>, C<B::COP>, C<B::METHOP>.
+C<B::OP>, C<B::UNOP>, C<B::UNOP_AUX>, C<B::BINOP>, C<B::LOGOP>,
+C<B::LISTOP>, C<B::PMOP>, C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>,
+C<B::COP>, C<B::METHOP>.
These classes correspond in the obvious way to the underlying C
structures of similar names. The inheritance hierarchy mimics the
+----------+---------+--------+-------+---------+
| | | | | |
B::UNOP B::SVOP B::PADOP B::COP B::PVOP B::METHOP
- ,' `-.
- / `--.
- B::BINOP B::LOGOP
+ |
+ +---+---+---------+
+ | | |
+ B::BINOP B::LOGOP B::UNOP_AUX
|
|
B::LISTOP
- ,' `.
- / \
- B::LOOP B::PMOP
+ |
+ +---+---+
+ | |
+ B::LOOP B::PMOP
Access methods correspond to the underlying C structure field names,
with the leading "class indication" prefix (C<"op_">) removed.
=back
+=head2 B::UNOP_AUX METHODS (since 5.22)
+
+=over 4
+
+=item aux_list(cv)
+
+This returns a list of the elements of the op's aux data structure,
+or a null list if there is no aux. What will be returned depends on the
+object's type, but will typically be a collection of C<B::IV>, C<B::GV>,
+etc. objects. C<cv> is the C<B::CV> object representing the sub that the
+op is contained within.
+
+=item string(cv)
+
+This returns a textual representation of the object (likely to b useful
+for deparsing and debugging), or an empty string if the op type doesn't
+support this. C<cv> is the C<B::CV> object representing the sub that the
+op is contained within.
+
+=back
+
=head2 B::BINOP METHOD
=over 4
OPc_PVOP, /* 9 */
OPc_LOOP, /* 10 */
OPc_COP, /* 11 */
- OPc_METHOP /* 12 */
+ OPc_METHOP, /* 12 */
+ OPc_UNOP_AUX /* 13 */
} opclass;
static const char* const opclassnames[] = {
"B::PVOP",
"B::LOOP",
"B::COP",
- "B::METHOP"
+ "B::METHOP",
+ "B::UNOP_AUX"
};
static const size_t opsizes[] = {
sizeof(PVOP),
sizeof(LOOP),
sizeof(COP),
- sizeof(METHOP)
+ sizeof(METHOP),
+ sizeof(UNOP_AUX),
};
#define MY_CXT_KEY "B::_guts" XS_VERSION
return OPc_PVOP;
case OA_METHOP:
return OPc_METHOP;
+ case OA_UNOP_AUX:
+ return OPc_UNOP_AUX;
}
warn("can't determine class of operator %s, assuming BASEOP\n",
OP_NAME(o));
SP = oplist(aTHX_ o, SP);
+
+MODULE = B PACKAGE = B::UNOP_AUX
+
+# UNOP_AUX class ops are like UNOPs except that they have an extra
+# op_aux pointer that points to an array of UNOP_AUX_item unions.
+# Element -1 of the array contains the length
+
+
+# return a string representation of op_aux where possible The op's CV is
+# needed as an extra arg to allow GVs and SVs moved into the pad to be
+# accessed okay.
+
+void
+string(o, cv)
+ B::OP o
+ B::CV cv
+ PREINIT:
+ SV *ret;
+ PPCODE:
+ switch (o->op_type) {
+ default:
+ ret = sv_2mortal(newSVpvn("", 0));
+ }
+ ST(0) = ret;
+ XSRETURN(1);
+
+
+# Return the contents of the op_aux array as a list of IV/GV/etc objects.
+# How to interpret each array element is op-dependent. The op's CV is
+# needed as an extra arg to allow GVs and SVs which have been moved into
+# the pad to be accessed okay.
+
+void
+aux_list(o, cv)
+ B::OP o
+ B::CV cv
+ PPCODE:
+ switch (o->op_type) {
+ default:
+ XSRETURN(0); /* by default, an empty list */
+ } /* switch */
+
+
+
MODULE = B PACKAGE = B::SV
#define MAGICAL_FLAG_BITS (SVs_GMG|SVs_SMG|SVs_RMG)
my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*",
'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#",
- 'METHOP' => '.');
+ 'METHOP' => '.', UNOP_AUX => '+');
no warnings 'qw'; # "Possible attempt to put comments..."; use #7
my @linenoise =
}
}
}
+ elsif ($h{class} eq "UNOP_AUX") {
+ $h{arg} = "(" . $op->string . ")";
+ }
+
$h{seq} = $h{hyphseq} = seq($op);
$h{seq} = "" if $h{seq} eq "-";
$h{opt} = $op->opt;
0 OP (aka BASEOP) An OP with no children
1 UNOP An OP with one child
+ + UNOP_AUX A UNOP with auxillary fields
2 BINOP An OP with two children
| LOGOP A control branch OP
@ LISTOP An OP that could have lots of children
assert( has_last /* has op_first and op_last, or ...
... has (or may have) op_first: */
|| family == OA_UNOP
+ || family == OA_UNOP_AUX
|| family == OA_LOGOP
|| family == OA_BASEOP_OR_UNOP
|| family == OA_FILESTATOP
}
/*
+=for apidoc
+
+Similar to C<newUNOP>, but creates an UNOP_AUX struct instead, with op_aux
+initialised to aux
+
+=cut
+*/
+
+OP *
+Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP *first, UNOP_AUX_item *aux)
+{
+ dVAR;
+ UNOP_AUX *unop;
+
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP_AUX);
+
+ NewOp(1101, unop, 1, UNOP_AUX);
+ unop->op_type = (OPCODE)type;
+ unop->op_ppaddr = PL_ppaddr[type];
+ unop->op_first = first;
+ unop->op_flags = (U8)(flags | (first ? OPf_KIDS : 0));
+ unop->op_private = (U8)((first ? 1 : 0) | (flags >> 8));
+ unop->op_aux = aux;
+
+#ifdef PERL_OP_PARENT
+ if (first && !OP_HAS_SIBLING(first)) /* true unless weird syntax error */
+ first->op_sibling = (OP*)unop;
+#endif
+
+ unop = (UNOP_AUX*) CHECKOP(type, unop);
+ if (unop->op_next)
+ return (OP*)unop;
+
+ return fold_constants(op_integerize(op_std_init((OP *) unop)));
+}
+
+/*
=for apidoc Am|OP *|newMETHOP|I32 type|I32 flags|OP *first
Constructs, checks, and returns an op of method type with a method name
#define OPpENTERSUB_LVAL_MASK (OPpLVAL_INTRO|OPpENTERSUB_INARGS)
+/* things that can be elements of op_aux */
+typedef union {
+ PADOFFSET pad_offset;
+ SV *sv;
+ IV iv;
+ UV uv;
+} UNOP_AUX_item;
+
struct op {
BASEOP
OP * op_first;
};
+struct unop_aux {
+ BASEOP
+ OP *op_first;
+ UNOP_AUX_item *op_aux;
+};
+
struct binop {
BASEOP
OP * op_first;
};
#define cUNOPx(o) ((UNOP*)o)
+#define cUNOP_AUXx(o) ((UNOP_AUX*)o)
#define cBINOPx(o) ((BINOP*)o)
#define cLISTOPx(o) ((LISTOP*)o)
#define cLOGOPx(o) ((LOGOP*)o)
#define cMETHOPx(o) ((METHOP*)o)
#define cUNOP cUNOPx(PL_op)
+#define cUNOP_AUX cUNOP_AUXx(PL_op)
#define cBINOP cBINOPx(PL_op)
#define cLISTOP cLISTOPx(PL_op)
#define cLOGOP cLOGOPx(PL_op)
#define cLOOP cLOOPx(PL_op)
#define cUNOPo cUNOPx(o)
+#define cUNOP_AUXo cUNOP_AUXx(o)
#define cBINOPo cBINOPx(o)
#define cLISTOPo cLISTOPx(o)
#define cLOGOPo cLOGOPx(o)
#define cLOOPo cLOOPx(o)
#define kUNOP cUNOPx(kid)
+#define kUNOP_AUX cUNOP_AUXx(kid)
#define kBINOP cBINOPx(kid)
#define kLISTOP cLISTOPx(kid)
#define kLOGOP cLOGOPx(kid)
#define OA_FILESTATOP (12 << OCSHIFT)
#define OA_LOOPEXOP (13 << OCSHIFT)
#define OA_METHOP (14 << OCSHIFT)
+#define OA_UNOP_AUX (15 << OCSHIFT)
/* Each remaining nybble of PL_opargs (i.e. bits 12..15, 16..19 etc)
* encode the type for each arg */
typedef struct op OP;
typedef struct cop COP;
typedef struct unop UNOP;
+typedef struct unop_aux UNOP_AUX;
typedef struct binop BINOP;
typedef struct listop LISTOP;
typedef struct logop LOGOP;
__attribute__malloc__
__attribute__warn_unused_result__;
+PERL_CALLCONV OP* Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP* first, UNOP_AUX_item *aux)
+ __attribute__malloc__
+ __attribute__warn_unused_result__;
+
PERL_CALLCONV OP* Perl_newWHENOP(pTHX_ OP* cond, OP* block)
__attribute__malloc__
__attribute__warn_unused_result__
qw(reverse), # ck_fun(), but most bits stolen
grep !$maxarg{$_} && !$args0{$_},
ops_with_flag('1'), # UNOP
+ ops_with_flag('+'), # UNOP_AUX
ops_with_flag('%'), # BASEOP/UNOP
ops_with_flag('|'), # LOGOP
ops_with_flag('-'), # FILESTATOP
'-', 12, # filestatop
'}', 13, # loopexop
'.', 14, # methop
+ '+', 15, # unop_aux
);
my %opflags = (
# padop/svop - $ padop - # (unused) loop - {
# baseop/unop - % loopexop - } filestatop - -
# pvop/svop - " cop - ; methop - .
+# unop_aux - +
# Other options are:
# needs stack mark - m (OA_MARK)
https://perl5.git.perl.org / perl5.git / commitdiff