for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) == SVt_PVCV) {
CV *cv = (CV*)sv;
- PADLIST* padlist = CvPADLIST(cv);
+ PADLIST* padlist;
AV *argav;
SV** svp;
SV** pad;
PerlIO_printf(Perl_debug_log, " busy\n");
continue;
}
+ padlist = CvPADLIST(cv);
svp = (SV**) PadlistARRAY(padlist);
while (++i <= PadlistMAX(padlist)) { /* Depth. */
SV **args;
SV **svp;
int type;
- svp = hv_fetch(hv, "topbucket", 9, 1);
+ svp = hv_fetchs(hv, "topbucket", 1);
sv_setiv(*svp, b->buffer.topbucket);
- svp = hv_fetch(hv, "topbucket_ev", 12, 1);
+ svp = hv_fetchs(hv, "topbucket_ev", 1);
sv_setiv(*svp, b->buffer.topbucket_ev);
- svp = hv_fetch(hv, "topbucket_odd", 13, 1);
+ svp = hv_fetchs(hv, "topbucket_odd", 1);
sv_setiv(*svp, b->buffer.topbucket_odd);
- svp = hv_fetch(hv, "totfree", 7, 1);
+ svp = hv_fetchs(hv, "totfree", 1);
sv_setiv(*svp, b->buffer.totfree);
- svp = hv_fetch(hv, "total", 5, 1);
+ svp = hv_fetchs(hv, "total", 1);
sv_setiv(*svp, b->buffer.total);
- svp = hv_fetch(hv, "total_chain", 11, 1);
+ svp = hv_fetchs(hv, "total_chain", 1);
sv_setiv(*svp, b->buffer.total_chain);
- svp = hv_fetch(hv, "total_sbrk", 10, 1);
+ svp = hv_fetchs(hv, "total_sbrk", 1);
sv_setiv(*svp, b->buffer.total_sbrk);
- svp = hv_fetch(hv, "sbrks", 5, 1);
+ svp = hv_fetchs(hv, "sbrks", 1);
sv_setiv(*svp, b->buffer.sbrks);
- svp = hv_fetch(hv, "sbrk_good", 9, 1);
+ svp = hv_fetchs(hv, "sbrk_good", 1);
sv_setiv(*svp, b->buffer.sbrk_good);
- svp = hv_fetch(hv, "sbrk_slack", 10, 1);
+ svp = hv_fetchs(hv, "sbrk_slack", 1);
sv_setiv(*svp, b->buffer.sbrk_slack);
- svp = hv_fetch(hv, "start_slack", 11, 1);
+ svp = hv_fetchs(hv, "start_slack", 1);
sv_setiv(*svp, b->buffer.start_slack);
- svp = hv_fetch(hv, "sbrked_remains", 14, 1);
+ svp = hv_fetchs(hv, "sbrked_remains", 1);
sv_setiv(*svp, b->buffer.sbrked_remains);
- svp = hv_fetch(hv, "minbucket", 9, 1);
+ svp = hv_fetchs(hv, "minbucket", 1);
sv_setiv(*svp, b->buffer.minbucket);
- svp = hv_fetch(hv, "nbuckets", 8, 1);
+ svp = hv_fetchs(hv, "nbuckets", 1);
sv_setiv(*svp, b->buffer.nbuckets);
if (_NBUCKETS < b->buffer.nbuckets)
parent = entersubop;
pm = cUNOPx(entersubop)->op_first;
- if (!OP_HAS_SIBLING(pm)) {
+ if (!OpHAS_SIBLING(pm)) {
parent = pm;
pm = cUNOPx(pm)->op_first;
}
- first = OP_SIBLING(pm);
- second = OP_SIBLING(first);
+ first = OpSIBLING(pm);
+ second = OpSIBLING(first);
if (!second) {
/* It doesn’t really matter what we return here, as this only
occurs after yyerror. */
/* we either have Dump($x): [pushmark]->[first]->[ex-cvop]
* or Dump($x,1); [pushmark]->[first]->[second]->[ex-cvop]
*/
- if (!OP_HAS_SIBLING(second))
+ if (!OpHAS_SIBLING(second))
second = NULL;
if (first->op_type == OP_RV2AV ||
NewOp(1234, newop, 1, BINOP);
newop->op_type = OP_CUSTOM;
newop->op_ppaddr = S_pp_dump;
- newop->op_first = first;
- newop->op_last = second;
newop->op_private= second ? 2 : 1;
newop->op_flags = OPf_KIDS|OPf_WANT_SCALAR;
+ op_sibling_splice((OP*)newop, NULL, 0, first);
return (OP *)newop;
}
-static XOP my_xop;
+static const XOP my_xop = {
+ XOPf_xop_name|XOPf_xop_desc|XOPf_xop_class, /* xop_flags */
+ "Devel_Peek_Dump", /* xop_name */
+ "Dump", /* xop_desc */
+ OA_BINOP, /* xop_class */
+ NULL /* xop_peep */
+};
MODULE = Devel::Peek PACKAGE = Devel::Peek
CV * const cv = get_cvn_flags("Devel::Peek::Dump", 17, 0);
assert(cv);
cv_set_call_checker(cv, S_ck_dump, (SV *)cv);
-
- XopENTRY_set(&my_xop, xop_name, "Dump");
- XopENTRY_set(&my_xop, xop_desc, "Dump");
- XopENTRY_set(&my_xop, xop_class, OA_BINOP);
Perl_custom_op_register(aTHX_ S_pp_dump, &my_xop);
}